Vendor import Perl 5.6.1

6 files changed, 966 insertions, 1085 deletions

diff --git a/contrib/perl5/utils/Makefile b/contrib/perl5/utils/Makefile
index 944cbe8..ec26cd8 100644
--- a/contrib/perl5/utils/Makefile
+++ b/contrib/perl5/utils/Makefile
@@ -7,12 +7,20 @@ REALPERL = ../perl
 
 pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL
 plextract  = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc dprofpp
-plextractexe  = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe dprofpp.exe
+plextractexe  = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./pl2pm ./splain ./perlcc ./dprofpp
 
 all: $(plextract) 
 
-compile: all
-	$(REALPERL) -I../lib perlcc -opt -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog;
+compile: all $(plextract)
+	$(REALPERL) -I../lib perlcc c2ph -o c2ph.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc h2ph -o h2ph.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc h2xs -o h2xs.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc perlbug -o perlbug.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc perldoc -o perldoc.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc pl2pm -o pl2pm.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc splain -o splain.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc perlcc -o perlcc.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc dprofpp -o dprofpp.exe -v 10 -log ../compilelog;
 
 $(plextract):
 	$(PERL) -I../lib $@.PL
@@ -44,3 +52,6 @@ realclean:
 clobber:	realclean
 
 distclean:	clobber
+
+veryclean:	distclean
+	-rm -f *~ *.org
diff --git a/contrib/perl5/utils/h2ph.PL b/contrib/perl5/utils/h2ph.PL
index 0b0208b..855a899 100644
--- a/contrib/perl5/utils/h2ph.PL
+++ b/contrib/perl5/utils/h2ph.PL
@@ -36,13 +36,16 @@ $Config{startperl}
 
 print OUT <<'!NO!SUBS!';
 
+use strict;
+
 use Config;
 use File::Path qw(mkpath);
 use Getopt::Std;
 
 getopts('Dd:rlhaQ');
+use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q);
 die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
-@inc_dirs = inc_dirs() if $opt_a;
+my @inc_dirs = inc_dirs() if $opt_a;
 
 my $Exit = 0;
 
@@ -50,7 +53,7 @@ my $Dest_dir = $opt_d || $Config{installsitearch};
 die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
     unless -d $Dest_dir;
 
-@isatype = split(' ',<<END);
+my @isatype = split(' ',<<END);
 	char	uchar	u_char
 	short	ushort	u_short
 	int	uint	u_int
@@ -58,14 +61,18 @@ die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
 	FILE	key_t	caddr_t
 END
 
+my %isatype;
 @isatype{@isatype} = (1) x @isatype;
-$inif = 0;
+my $inif = 0;
+my %Is_converted;
 
 @ARGV = ('-') unless @ARGV;
 
 build_preamble_if_necessary();
 
-while (defined ($file = next_file())) {
+my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
+my ($incl, $next);
+while (defined (my $file = next_file())) {
     if (-l $file and -d $file) {
         link_if_possible($file) if ($opt_l);
         next;
@@ -129,7 +136,7 @@ while (defined ($file = next_file())) {
     	    	    my $proto = '() ';
 		    if ($args ne '') {
     	    	    	$proto = '';
-			foreach $arg (split(/,\s*/,$args)) {
+			foreach my $arg (split(/,\s*/,$args)) {
 			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
 			    $curargs{$arg} = 1;
 			}
@@ -257,11 +264,11 @@ while (defined ($file = next_file())) {
 	    s@/\*.*?\*/@@g;
 	    s/\s+/ /g;
 	    /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
-	    ($enum_subs = $3) =~ s/\s//g;
-	    @enum_subs = split(/,/, $enum_subs);
-	    $enum_val = -1;
-	    for $enum (@enum_subs) {
-		($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
+	    (my $enum_subs = $3) =~ s/\s//g;
+	    my @enum_subs = split(/,/, $enum_subs);
+	    my $enum_val = -1;
+	    foreach my $enum (@enum_subs) {
+		my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
 		$enum_value =~ s/^=//;
 		$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
 		if ($opt_h) {
@@ -280,12 +287,13 @@ while (defined ($file = next_file())) {
     }
     print OUT "1;\n";
 
-    $is_converted{$file} = 1;
+    $Is_converted{$file} = 1;
     queue_includes_from($file) if ($opt_a);
 }
 
 exit $Exit;
 
+
 sub reindent($) {
     my($text) = shift;
     $text =~ s/\n/\n    /g;
@@ -293,9 +301,11 @@ sub reindent($) {
     $text;
 }
 
+
 sub expr {
+    my $joined_args;
     if(keys(%curargs)) {
-	my($joined_args) = join('|', keys(%curargs));
+	$joined_args = join('|', keys(%curargs));
     }
     while ($_ ne '') {
 	s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
@@ -347,7 +357,7 @@ sub expr {
 	};
 	# struct/union member, including arrays:
 	s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
-	    $id = $1;
+	    my $id = $1;
 	    $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
 	    $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
 	    while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
@@ -363,7 +373,7 @@ sub expr {
 	    $new .= " (\$$id)";
 	};
 	s/^([_a-zA-Z]\w*)//	&& do {
-	    $id = $1;
+	    my $id = $1;
 	    if ($id eq 'struct') {
 		s/^\s+(\w+)//;
 		$id .= ' ' . $1;
@@ -505,7 +515,7 @@ sub queue_includes_from
             }
 
             if ($line =~ /^#\s*include\s+<(.*?)>/) {
-                push(@ARGV, $1) unless $is_converted{$1};
+                push(@ARGV, $1) unless $Is_converted{$1};
             }
         }
     close HEADER;
@@ -575,7 +585,8 @@ sub build_preamble_if_necessary
 sub _extract_cc_defines
 {
     my %define;
-    my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
+    my $allsymbols  = join " ",
+        @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
 
     # Split compiler pre-definitions into `key=value' pairs:
     foreach (split /\s+/, $allsymbols) {
@@ -708,8 +719,6 @@ that it can translate.
 It's only intended as a rough tool.
 You may need to dicker with the files produced.
 
-Doesn't run with C<use strict>
-
 You have to run this program by hand; it's not run as part of the Perl
 installation.
 
diff --git a/contrib/perl5/utils/h2xs.PL b/contrib/perl5/utils/h2xs.PL
index ca0e7cb..edc2bb5 100644
--- a/contrib/perl5/utils/h2xs.PL
+++ b/contrib/perl5/utils/h2xs.PL
@@ -13,9 +13,9 @@ use Cwd;
 
 # This forces PL files to create target in same directory as PL file.
 # This is so that make depend always knows where to find PL derivatives.
-$origdir = cwd;
+my $origdir = cwd;
 chdir dirname($0);
-$file = basename($0, '.PL');
+my $file = basename($0, '.PL');
 $file .= '.com' if $^O eq 'VMS';
 
 open OUT,">$file" or die "Can't create $file: $!";
@@ -41,7 +41,7 @@ h2xs - convert .h C header files to Perl extensions
 
 =head1 SYNOPSIS
 
-B<h2xs> [B<-ACOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]]
+B<h2xs> [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [headerfile ... [extra_libraries]]
 
 B<h2xs> B<-h>
 
@@ -78,7 +78,7 @@ S<C<use AutoLoader>> statement from the .pm file.
 Omits creation of the F<Changes> file, and adds a HISTORY section to
 the POD template.
 
-=item B<-F>
+=item B<-F> I<addflags>
 
 Additional flags to specify to C preprocessor when scanning header for
 function declarations.  Should not be used without B<-x>.
@@ -191,6 +191,18 @@ hand-editing. Such may be objects which cannot be converted from/to a
 pointer (like C<long long>), pointers to functions, or arrays.  See
 also the section on L<LIMITATIONS of B<-x>>.
 
+=item B<-b> I<version>
+
+Generates a .pm file which is backwards compatible with the specified
+perl version.
+
+For versions < 5.6.0, the changes are.
+    - no use of 'our' (uses 'use vars' instead)
+    - no 'use warnings'
+
+Specifying a compatibility version higher than the version of perl you
+are using to run h2xs will have no effect.
+
 =back
 
 =head1 EXAMPLES
@@ -248,6 +260,68 @@ also the section on L<LIMITATIONS of B<-x>>.
 	# Same but treat SV* etc as "opaque" types
 	h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h
 
+=head2 Extension based on F<.h> and F<.c> files
+
+Suppose that you have some C files implementing some functionality,
+and the corresponding header files.  How to create an extension which
+makes this functionality accessable in Perl?  The example below
+assumes that the header files are F<interface_simple.h> and
+I<interface_hairy.h>, and you want the perl module be named as
+C<Ext::Ension>.  If you need some preprocessor directives and/or
+linking with external libraries, see the flags C<-F>, C<-L> and C<-l>
+in L<"OPTIONS">.
+
+=over
+
+=item Find the directory name
+
+Start with a dummy run of h2xs:
+
+  h2xs -Afn Ext::Ension
+
+The only purpose of this step is to create the needed directories, and
+let you know the names of these directories.  From the output you can
+see that the directory for the extension is F<Ext/Ension>.
+
+=item Copy C files
+
+Copy your header files and C files to this directory F<Ext/Ension>.
+
+=item Create the extension
+
+Run h2xs, overwriting older autogenerated files:
+
+  h2xs -Oxan Ext::Ension interface_simple.h interface_hairy.h
+
+h2xs looks for header files I<after> changing to the extension
+directory, so it will find your header files OK.
+
+=item Archive and test
+
+As usual, run
+
+  cd Ext/Ension
+  perl Makefile.PL
+  make dist
+  make
+  make test
+
+=item Hints
+
+It is important to do C<make dist> as early as possible.  This way you
+can easily merge(1) your changes to autogenerated files if you decide
+to edit your C<.h> files and rerun h2xs.
+
+Do not forget to edit the documentation in the generated F<.pm> file.
+
+Consider the autogenerated files as skeletons only, you may invent
+better interfaces than what h2xs could guess.
+
+Consider this section as a guideline only, some other options of h2xs
+may better suit your needs.
+
+=back
+
 =head1 ENVIRONMENT
 
 No environment variables are used.
@@ -329,15 +403,16 @@ See L<perlxs> and L<perlxstut> for additional details.
 use strict;
 
 
-my( $H2XS_VERSION ) = ' $Revision: 1.20 $ ' =~ /\$Revision:\s+([^\s]+)/;
+my( $H2XS_VERSION ) = ' $Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/;
 my $TEMPLATE_VERSION = '0.01';
 my @ARGS = @ARGV;
+my $compat_version = $];
 
 use Getopt::Std;
 
 sub usage{
 	warn "@_\n" if @_;
-    die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
+    die "h2xs [-ACOPXacdfhkmx] [-F addflags] [-M fmask] [-n module_name] [-o tmask] [-p prefix] [-s subs] [-v version] [headerfile [extra_libraries]]
 version: $H2XS_VERSION
     -A   Omit all autoloading facilities (implies -c).
     -C   Omit creating the Changes file, add HISTORY heading to stub POD.
@@ -359,6 +434,7 @@ version: $H2XS_VERSION
     -s   Create subroutines for specified macros.
     -v   Specify a version number for this extension.
     -x   Autogenerate XSUBs using C::Scan.
+    -b   Specify a perl version to be backwards compatibile with
 extra_libraries
          are any libraries that might be needed for loading the
          extension, e.g. -lm would try to link in the math library.
@@ -366,12 +442,22 @@ extra_libraries
 }
 
 
-getopts("ACF:M:OPXacdfhkmn:o:p:s:v:x") || usage;
+getopts("ACF:M:OPXacdfhkmn:o:p:s:v:xb:") || usage;
 use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_a $opt_c $opt_d
-	    $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x);
+	    $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x 
+	    $opt_b);
 
 usage if $opt_h;
 
+if( $opt_b ){
+    usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m);
+    $opt_b =~ /^\d+\.\d+\.\d+/ ||
+	usage "You must provide the backwards compatibility version in X.Y.Z form. " .
+	    "(i.e. 5.5.0)\n";
+    my ($maj,$min,$sub) = split(/\./,$opt_b,3);
+    $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub);
+} 
+
 if( $opt_v ){
 	$TEMPLATE_VERSION = $opt_v;
 }
@@ -438,6 +524,8 @@ EOD
 my @path_h_ini = @path_h;
 my ($name, %fullpath, %prefix, %seen_define, %prefixless, %const_names);
 
+my $module = $opt_n;
+
 if( @path_h ){
     use Config;
     use File::Spec;
@@ -456,6 +544,15 @@ if( @path_h ){
     }
     foreach my $path_h (@path_h) {
         $name ||= $path_h;
+    $module ||= do {
+      $name =~ s/\.h$//;
+      if ( $name !~ /::/ ) {
+	$name =~ s#^.*/##;
+	$name = "\u$name";
+      }
+      $name;
+    };
+
     if( $path_h =~ s#::#/#g && $opt_n ){
 	warn "Nesting of headerfile ignored with -n\n";
     }
@@ -464,19 +561,36 @@ if( @path_h ){
     $path_h =~ s/,.*$// if $opt_x;
     $fullpath{$path_h} = $fullpath;
 
+    # Minor trickery: we can't chdir() before we processed the headers
+    # (so know the name of the extension), but the header may be in the
+    # extension directory...
+    my $tmp_path_h = $path_h;
+    my $rel_path_h = $path_h;
+    my @dirs = @paths;
     if (not -f $path_h) {
-      my $tmp_path_h = $path_h;
+      my $found;
       for my $dir (@paths) {
-	last if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h));
+	$found++, last
+	  if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h));
+      }
+      if ($found) {
+	$rel_path_h = $path_h;
+      } else {
+	(my $epath = $module) =~ s,::,/,g;
+	$epath = File::Spec->catdir('ext', $epath) if -d 'ext';
+	$rel_path_h = File::Spec->catfile($epath, $tmp_path_h);
+	$path_h = $tmp_path_h;	# Used during -x
+	push @dirs, $epath;
       }
     }
 
     if (!$opt_c) {
-      die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
+      die "Can't find $tmp_path_h in @dirs\n" 
+	if ( ! $opt_f && ! -f "$rel_path_h" );
       # Scan the header file (we should deal with nested header files)
       # Record the names of simple #define constants into const_names
             # Function prototypes are processed below.
-      open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
+      open(CH, "<$rel_path_h") || die "Can't open $rel_path_h: $!\n";
     defines:
       while (<CH>) {
 	if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) {
@@ -517,14 +631,6 @@ if( @path_h ){
 }
 
 
-my $module = $opt_n || do {
-	$name =~ s/\.h$//;
-	if( $name !~ /::/ ){
-		$name =~ s#^.*/##;
-		$name = "\u$name";
-	}
-	$name;
-};
 
 my ($ext, $nested, @modparts, $modfname, $modpname);
 (chdir 'ext', $ext = 'ext/') if -d 'ext';
@@ -685,13 +791,23 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"
 $" = "\n\t";
 warn "Writing $ext$modpname/$modfname.pm\n";
 
+if ( $compat_version < 5.006 ) {
 print PM <<"END";
 package $module;
 
-require 5.005_62;
+use $compat_version;
+use strict;
+END
+} 
+else {
+print PM <<"END";
+package $module;
+
+use 5.006;
 use strict;
 use warnings;
 END
+}
 
 unless( $opt_X || $opt_c || $opt_A ){
 	# we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
@@ -721,15 +837,25 @@ unless ($opt_A) { # no autoloader whatsoever.
 	}
 }
 
+if ( $compat_version < 5.006 ) {
+    if ( $opt_X || $opt_c || $opt_A ) {
+	print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);';
+    } else {
+	print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);';
+    }
+}
+
 # Determine @ISA.
 my $myISA = 'our @ISA = qw(Exporter';	# We seem to always want this.
 $myISA .= ' DynaLoader' 	unless $opt_X;  # no XS
 $myISA .= ');';
+$myISA =~ s/^our // if $compat_version < 5.006;
+
 print PM "\n$myISA\n\n";
 
 my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls);
 
-print PM<<"END";
+my $tmp=<<"END";
 # Items to export into callers namespace by default. Note: do not export
 # names by default without a very good reason. Use EXPORT_OK instead.
 # Do not simply export all your public functions/methods/constants.
@@ -750,10 +876,15 @@ our \$VERSION = '$TEMPLATE_VERSION';
 
 END
 
+$tmp =~ s/^our //mg if $compat_version < 5.006;
+print PM $tmp;
+
 if (@vdecls) {
     printf PM "our(@{[ join ', ', map '$'.$_, @vdecls ]});\n\n";
 }
 
+
+$tmp = ( $compat_version < 5.006 ?  "" : "our \$AUTOLOAD;" );
 print PM <<"END" unless $opt_c or $opt_X;
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -761,7 +892,7 @@ sub AUTOLOAD {
     # to the AUTOLOAD in AutoLoader.
 
     my \$constname;
-    our \$AUTOLOAD;
+    $tmp
     (\$constname = \$AUTOLOAD) =~ s/.*:://;
     croak "&$module::constant not defined" if \$constname eq 'constant';
     my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
@@ -834,51 +965,62 @@ my $email = 'a.u.thor@a.galaxy.far.far.away';
 
 my $revhist = '';
 $revhist = <<EOT if $opt_C;
-
-=head1 HISTORY
-
-=over 8
-
-=item $TEMPLATE_VERSION
-
-Original version; created by h2xs $H2XS_VERSION with options
-
-  @ARGS
-
-=back
-
+#
+#=head1 HISTORY
+#
+#=over 8
+#
+#=item $TEMPLATE_VERSION
+#
+#Original version; created by h2xs $H2XS_VERSION with options
+#
+#  @ARGS
+#
+#=back
+#
 EOT
 
 my $exp_doc = <<EOD;
-
-=head2 EXPORT
-
-None by default.
-
+#
+#=head2 EXPORT
+#
+#None by default.
+#
 EOD
+
 if (@const_names and not $opt_P) {
   $exp_doc .= <<EOD;
-=head2 Exportable constants
-
-  @{[join "\n  ", @const_names]}
-
+#=head2 Exportable constants
+#
+#  @{[join "\n  ", @const_names]}
+#
 EOD
 }
+
 if (defined $fdecls and @$fdecls and not $opt_P) {
   $exp_doc .= <<EOD;
-=head2 Exportable functions
-
+#=head2 Exportable functions
+#
 EOD
-  $exp_doc .= <<EOD if $opt_p;
-When accessing these functions from Perl, prefix C<$opt_p> should be removed.
 
-EOD
+#  $exp_doc .= <<EOD if $opt_p;
+#When accessing these functions from Perl, prefix C<$opt_p> should be removed.
+#
+#EOD
   $exp_doc .= <<EOD;
-  @{[join "\n  ", @known_fnames{@fnames}]}
-
+#  @{[join "\n  ", @known_fnames{@fnames}]}
+#
 EOD
 }
 
+my $meth_doc = '';
+
+if ($opt_x && $opt_a) {
+  my($name, $struct);
+  $meth_doc .= accessor_docs($name, $struct)
+    while ($name, $struct) = each %structs;
+}
+
 my $pod = <<"END" unless $opt_P;
 ## Below is stub documentation for your module. You better edit it!
 #
@@ -898,14 +1040,14 @@ my $pod = <<"END" unless $opt_P;
 #unedited.
 #
 #Blah blah blah.
-#$exp_doc$revhist
+$exp_doc$meth_doc$revhist
 #=head1 AUTHOR
 #
-#$author, $email
+#$author, E<lt>${email}E<gt>
 #
 #=head1 SEE ALSO
 #
-#perl(1).
+#L<perl>.
 #
 #=cut
 END
@@ -1357,6 +1499,72 @@ EOF
   }
 }
 
+sub accessor_docs {
+  my($name, $struct) = @_;
+  return unless defined $struct && $name !~ /\s|_ANON/;
+  $name = normalize_type($name);
+  my $ptrname = $name . 'Ptr';
+  my @items = @$struct;
+  my @list;
+  while (@items) {
+    my $item = shift @items;
+    if ($item->[0] =~ /_ANON/) {
+      if (defined $item->[2]) {
+	push @items, map [
+	  @$_[0, 1], "$item->[2]_$_->[2]", "$item->[2].$_->[2]",
+	], @{ $structs{$item->[0]} };
+      } else {
+	push @items, @{ $structs{$item->[0]} };
+      }
+    } else {
+      push @list, $item->[2];
+    }
+  }
+  my $methods = (join '(...)>, C<', @list) . '(...)';
+
+  my $pod = <<"EOF";
+#
+#=head2 Object and class methods for C<$name>/C<$ptrname>
+#
+#The principal Perl representation of a C object of type C<$name> is an
+#object of class C<$ptrname> which is a reference to an integer
+#representation of a C pointer.  To create such an object, one may use
+#a combination
+#
+#  my \$buffer = $name->new();
+#  my \$obj = \$buffer->_to_ptr();
+#
+#This exersizes the following two methods, and an additional class
+#C<$name>, the internal representation of which is a reference to a
+#packed string with the C structure.  Keep in mind that \$buffer should
+#better survive longer than \$obj.
+#
+#=over
+#
+#=item C<\$object_of_type_$name-E<gt>_to_ptr()>
+#
+#Converts an object of type C<$name> to an object of type C<$ptrname>.
+#
+#=item C<$name-E<gt>new()>
+#
+#Creates an empty object of type C<$name>.  The corresponding packed
+#string is zeroed out.
+#
+#=item C<$methods>
+#
+#return the current value of the corresponding element if called
+#without additional arguments.  Set the element to the supplied value
+#(and return the new value) if called with an additional argument.
+#
+#Applicable to objects of type C<$ptrname>.
+#
+#=back
+#
+EOF
+  $pod =~ s/^\#//gm;
+  return $pod;
+}
+
 # Should be called before any actual call to normalize_type().
 sub get_typemap {
   # We do not want to read ./typemap by obvios reasons.
@@ -1509,44 +1717,106 @@ WriteMakefile(
     'NAME'		=> '$module',
     'VERSION_FROM'	=> '$modfname.pm', # finds \$VERSION
     'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    (\$] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module
+       AUTHOR     => '$author <$email>') : ()),
 END
 if (!$opt_X) { # print C stuff, unless XS is disabled
   $opt_F = '' unless defined $opt_F;
+  my $I = (((glob '*.h') || (glob '*.hh')) ? '-I.' : '');
+  my $Ihelp = ($I ? '-I. ' : '');
+  my $Icomment = ($I ? '' : <<EOC);
+	# Insert -I. if you add *.h files later:
+EOC
+
   print PL <<END;
     'LIBS'		=> ['$extralibs'], # e.g., '-lm'
     'DEFINE'		=> '$opt_F', # e.g., '-DHAVE_SOMETHING'
-    'INC'		=> '', # e.g., '-I/usr/include/other'
+$Icomment    'INC'		=> '$I', # e.g., '$Ihelp-I/usr/include/other'
+END
+
+  my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C');
+  my $Cpre = ($C ? '' : '# ');
+  my $Ccomment = ($C ? '' : <<EOC);
+	# Un-comment this if you add C files to link with later:
+EOC
+
+  print PL <<END;
+$Ccomment    $Cpre\'OBJECT'		=> '\$(O_FILES)', # link all the C files too
 END
 }
 print PL ");\n";
 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
 
+# Create a simple README since this is a CPAN requirement
+# and it doesnt hurt to have one
+warn "Writing $ext$modpname/README\n";
+open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n";
+my $thisyear = (gmtime)[5] + 1900;
+my $rmhead = "$modpname version $TEMPLATE_VERSION";
+my $rmheadeq = "=" x length($rmhead);
+print RM <<_RMEND_;
+$rmhead
+$rmheadeq
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) $thisyear $author blah blah blah
+
+_RMEND_
+close(RM) || die "Can't close $ext$modpname/README: $!\n";
+
 warn "Writing $ext$modpname/test.pl\n";
 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
 print EX <<'_END_';
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
-######################### We start with some black magic to print on failure.
+#########################
 
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
+# change 'tests => 1' to 'tests => last_test_to_print';
 
-BEGIN { $| = 1; print "1..1\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Test;
+BEGIN { plan tests => 1 };
 _END_
 print EX <<_END_;
 use $module;
 _END_
 print EX <<'_END_';
-$loaded = 1;
-print "ok 1\n";
+ok(1); # If we made it this far, we're ok.
 
-######################### End of black magic.
+#########################
 
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
 
 _END_
 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
diff --git a/contrib/perl5/utils/perlbug.PL b/contrib/perl5/utils/perlbug.PL
index 208da36..d323913 100644
--- a/contrib/perl5/utils/perlbug.PL
+++ b/contrib/perl5/utils/perlbug.PL
@@ -45,7 +45,7 @@ while (<PATCH_LEVEL>) {
 my $patch_desc = "'" . join("',\n    '", @patches) . "'";
 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
 
-close PATCH_LEVEL;
+close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
 
 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
 # used, compare $Config::config_sh with the stored version. If they differ then
@@ -91,7 +91,7 @@ BEGIN {
     $::HaveUtil = ($@ eq "");
 };
 
-my $Version = "1.28";
+my $Version = "1.33";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -124,6 +124,11 @@ my $Version = "1.28";
 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
 # Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
+# Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
+# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
+# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
+# Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
+# Changed in 1.33 Don't require -t STDOUT for -ok.
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is
@@ -131,7 +136,7 @@ my $Version = "1.28";
 #       - Test -b option
 
 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
-    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity, 
+    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
     $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 
 my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
@@ -149,7 +154,6 @@ include a file, you can use the -f switch.
 EOF
     die "\n";
 }
-if (!-t STDOUT && !$outfile) { Dump(*STDOUT); exit; }
 
 Query();
 Edit() unless $usefile || ($ok and not $::opt_n);
@@ -158,30 +162,45 @@ Send();
 
 exit;
 
-sub ask_for_alternatives {
+sub ask_for_alternatives { # (category|severity)
     my $name = shift;
-    my $default = shift;
-    my @alts = @_;
+    my %alts = (
+	'category' => {
+	    'default' => 'core',
+	    'ok'      => 'install',
+	    'opts'    => [qw(core docs install library utilities)], # patch, notabug
+	},
+	'severity' => {
+	    'default' => 'low',
+	    'ok'      => 'none',
+	    'opts'    => [qw(critical high medium low wishlist none)], # zero
+	},
+    );
+    die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
     my $alt = "";
-    paraprint <<EOF;
+    if ($ok) {
+	$alt = $alts{$name}{'ok'};
+    } else {
+ 	my @alts = @{$alts{$name}{'opts'}};
+	paraprint <<EOF;
 Please pick a \u$name from the following:
 
     @alts
 
 EOF
-    my $err = 0;
-    my $joined_alts = join('|', @alts);
-    do {
-	if ($err++ > 5) {
-	    die "Invalid $name: aborting.\n";
-	}
-	print "Please enter a \u$name [$default]: ";
-	$alt = <>;
-	chomp $alt;
-	if ($alt =~ /^\s*$/) {
-	    $alt = $default;
-	}
-    } while ($alt !~ /^($joined_alts)$/i);
+	my $err = 0;
+	do {
+	    if ($err++ > 5) {
+		die "Invalid $name: aborting.\n";
+	    }
+	    print "Please enter a \u$name [$alts{$name}{'default'}]: ";
+	    $alt = <>;
+	    chomp $alt;
+	    if ($alt =~ /^\s*$/) {
+		$alt = $alts{$name}{'default'};
+	    }
+	} while !((($alt) = grep(/^$alt/i, @alts)));
+    }
     lc $alt;
 }
 
@@ -196,7 +215,7 @@ sub Init {
         MacPerl::Ask('Provide command-line args here (-h for help):')
         if $Is_MacOS && $MacPerl::Version =~ /App/;
 
-    if (!getopts("dhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
+    if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
 
     # This comment is needed to notify metaconfig that we are
     # using the $perladmin, $cf_by, and $cf_time definitions.
@@ -204,7 +223,7 @@ sub Init {
     # -------- Configuration ---------
 
     # perlbug address
-    $perlbug = 'perlbug@perl.com';
+    $perlbug = 'perlbug@perl.org';
 
     # Test address
     $testaddress = 'perlbug-test@perl.com';
@@ -276,8 +295,6 @@ EOF
 	    $subject = ($::opt_n ? 'Not ' : '')
 		    . "OK: perl $perl_version ${patch_tags}on"
 		    ." $::Config{'archname'} $::Config{'osvers'} $subject";
-	    $category = "install";
-	    $severity = "none";
 	    $ok = 1;
 	} else {
 	    Help();
@@ -468,14 +485,10 @@ EOF
     }
 
     # Prompt for category of bug
-    $category ||= ask_for_alternatives("category", "core",
-				     qw(core docs install
-					library utilities));
+    $category ||= ask_for_alternatives('category');
 
     # Prompt for severity of bug
-    $severity ||= ask_for_alternatives("severity", "low",
-				       qw(critical high medium
-					  low wishlist none));
+    $severity ||= ask_for_alternatives('severity');
 
     # Generate scratch file to edit report in
     $filename = filename();
@@ -509,7 +522,7 @@ EOF
     }
 
     # Generate report
-    open(REP,">$filename");
+    open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
     my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
 
     print REP <<EOF;
@@ -526,7 +539,7 @@ EOF
 	while (<F>) {
 	    print REP $_
 	}
-	close(F);
+	close(F) or die "Error closing `$file': $!";
     } else {
 	print REP <<EOF;
 
@@ -540,17 +553,17 @@ EOF
 EOF
     }
     Dump(*REP);
-    close(REP);
+    close(REP) or die "Error closing report file: $!";
 
     # read in the report template once so that
     # we can track whether the user does any editing.
     # yes, *all* whitespace is ignored.
-    open(REP, "<$filename");
+    open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n";
     while (<REP>) {
 	s/\s+//g;
 	$REP{$_}++;
     }
-    close(REP);
+    close(REP) or die "Error closing report file `$filename': $!";
 } # sub Query
 
 sub Dump {
@@ -561,6 +574,13 @@ sub Dump {
 Flags:
     category=$category
     severity=$severity
+EFF
+    if ($::opt_A) {
+	print OUT <<EFF;
+    ack=no
+EFF
+    }
+    print OUT <<EFF;
 ---
 EFF
     print OUT "This perlbug was built using Perl $config_tag1\n",
@@ -630,7 +650,8 @@ EOF
     }
 
 tryagain:
-    my $sts = system("$ed $filename") unless $Is_MacOS;
+    my $sts;
+    $sts = system("$ed $filename") unless $Is_MacOS;
     if ($Is_MacOS) {
         require ExtUtils::MakeMaker;
         ExtUtils::MM_MacOS::launch_file($filename);
@@ -664,7 +685,7 @@ EOF
     # Check that we have a report that has some, eh, report in it.
     my $unseen = 0;
 
-    open(REP, "<$filename");
+    open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
     # a strange way to check whether any significant editing
     # have been done: check whether any new non-empty lines
     # have been added. Yes, the below code ignores *any* space
@@ -719,22 +740,22 @@ EOF
 		    print "\nError opening $file: $!\n\n";
 		    goto retry;
 		}
-		open(REP, "<$filename");
+		open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
 		print FILE "To: $address\nSubject: $subject\n";
 		print FILE "Cc: $cc\n" if $cc;
 		print FILE "Reply-To: $from\n" if $from;
 		print FILE "\n";
 		while (<REP>) { print FILE }
-		close(REP);
-		close(FILE);
+		close(REP) or die "Error closing report file `$filename': $!";
+		close(FILE) or die "Error closing $file: $!";
 
 		print "\nMessage saved in `$file'.\n";
 		exit;
 	    } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 		# Display the message
-		open(REP, "<$filename");
+		open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
 		while (<REP>) { print $_ }
-		close(REP);
+		close(REP) or die "Error closing report file `$filename': $!";
 	    } elsif ($action =~ /^se/i) { # <S>end
 		# Send the message
 		print "Are you certain you want to send this message?\n"
@@ -755,7 +776,7 @@ EOF
 		Edit();
 	    } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
 		Cancel();
-	    } elsif ($action =~ /^s/) {
+	    } elsif ($action =~ /^s/i) {
 		paraprint <<EOF;
 I'm sorry, but I didn't understand that. Please type "send" or "save".
 EOF
@@ -776,9 +797,9 @@ sub Send {
 	$msg->add("Reply-To",$from) if $from;
 
 	$fh = $msg->open;
-	open(REP, "<$filename");
+	open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
 	while (<REP>) { print $fh $_ }
-	close(REP);
+	close(REP) or die "Error closing $filename: $!";
 	$fh->close;
 
 	print "\nMessage sent.\n";
@@ -823,16 +844,16 @@ report. We apologize for the inconvenience.
 So you may attempt to find some way of sending your message, it has
 been left in the file `$filename'.
 EOF
-	open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
+	open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
 sendout:
 	print SENDMAIL "To: $address\n";
 	print SENDMAIL "Subject: $subject\n";
 	print SENDMAIL "Cc: $cc\n" if $cc;
 	print SENDMAIL "Reply-To: $from\n" if $from;
 	print SENDMAIL "\n\n";
-	open(REP, "<$filename");
+	open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
 	while (<REP>) { print SENDMAIL $_ }
-	close(REP);
+	close(REP) or die "Error closing $filename: $!";
 
 	if (close(SENDMAIL)) {
 	    printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
@@ -853,7 +874,7 @@ be needed.
 Usage:
 $0  [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
-$0  [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
+$0  [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
 
 Simplest usage:  run "$0", and follow the prompts.
 
@@ -875,9 +896,9 @@ Options:
         this if you don't give it here.
   -e    Editor to use.
   -t    Test mode. The target address defaults to `$testaddress'.
-  -d    Data mode (the default if you redirect or pipe output.)
-        This prints out your configuration data, without mailing
+  -d    Data mode.  This prints out your configuration data, without mailing
         anything. You can use this with -v to get more complete data.
+  -A    Don't send a bug received acknowledgement to the return address.
   -ok   Report successful build on this system to perl porters
         (use alone or with -v). Only use -ok if *everything* was ok:
         if there were *any* problems at all, use -nok.
@@ -892,12 +913,8 @@ EOF
 }
 
 sub filename {
-    my $dir = $Is_VMS ? 'sys$scratch:'
-	: ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
-        : $Is_MacOS ? $ENV{'TMPDIR'}
-	: '/tmp';
+    my $dir = File::Spec->tmpdir();
     $filename = "bugrep0$$";
-#    $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
     $filename++ while -e File::Spec->catfile($dir, $filename);
     $filename = File::Spec->catfile($dir, $filename);
 }
@@ -929,10 +946,10 @@ B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
 S<[ B<-r> I<returnaddress> ]>
 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
-S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-h> ]>
+S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]>
 
 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
-S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
+ S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
 
 =head1 DESCRIPTION
 
@@ -950,7 +967,7 @@ will be needed.  Simply run it, and follow the prompts.
 
 If you are unable to run B<perlbug> (most likely because you don't have
 a working setup to send mail that perlbug recognizes), you may have to
-compose your own report, and email it to B<perlbug@perl.com>.  You might
+compose your own report, and email it to B<perlbug@perl.org>.  You might
 find the B<-d> option useful to get summary information in that case.
 
 In any case, when reporting a bug, please make sure you have run through
@@ -1028,7 +1045,7 @@ definitely be fixed.  Use the C<diff> program to generate your patches
 (C<diff> is being maintained by the GNU folks as part of the B<diffutils>
 package, so you should be able to get it from any of the GNU software
 repositories).  If you do submit a patch, the cool-dude counter at
-perlbug@perl.com will register you as a savior of the world.  Your
+perlbug@perl.org will register you as a savior of the world.  Your
 patch may be returned with requests for changes, or requests for more
 detailed explanations about your fix.
 
@@ -1048,7 +1065,7 @@ B<perlbug> will, amongst other things, ensure your report includes
 crucial information about your version of perl.  If C<perlbug> is unable
 to mail your report after you have typed it in, you may have to compose
 the message yourself, add the output produced by C<perlbug -d> and email
-it to B<perlbug@perl.com>.  If, for some reason, you cannot run
+it to B<perlbug@perl.org>.  If, for some reason, you cannot run
 C<perlbug> at all on your system, be sure to include the entire output
 produced by running C<perl -V> (note the uppercase V).
 
@@ -1075,7 +1092,14 @@ version of perl comes out and your bug is still present.
 
 =item B<-a>
 
-Address to send the report to.  Defaults to `perlbug@perl.com'.
+Address to send the report to.  Defaults to `perlbug@perl.org'.
+
+=item B<-A>
+
+Don't send a bug received acknowledgement to the reply address.
+Generally it is only a sensible to use this option if you are a
+perl maintainer actively watching perl porters for your message to
+arrive.
 
 =item B<-b>
 
diff --git a/contrib/perl5/utils/perlcc.PL b/contrib/perl5/utils/perlcc.PL
index f0636f6..6304555 100644
--- a/contrib/perl5/utils/perlcc.PL
+++ b/contrib/perl5/utils/perlcc.PL
@@ -31,1084 +31,632 @@ print OUT <<"!GROK!THIS!";
 $Config{startperl}
     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
     if \$running_under_some_shell;
+--\$running_under_some_shell;
 !GROK!THIS!
  
 # In the following, perl variables are not expanded during extraction.
  
 print OUT <<'!NO!SUBS!';
 
-use Config;
+# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000 
+# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
+# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
+# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
+
 use strict;
+use warnings;
+use v5.6.0;
+
 use FileHandle;
-use File::Basename qw(&basename &dirname);
+use Config;
+use Fcntl qw(:DEFAULT :flock);
+use File::Temp qw(tempfile);
 use Cwd;
+our $VERSION = 2.03;
+$| = 1;
 
-use Getopt::Long;
+$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
 
-$Getopt::Long::bundling_override = 1;
-$Getopt::Long::passthrough = 0;
-$Getopt::Long::ignore_case = 0;
+use subs qw{
+    cc_harness check_read check_write checkopts_byte choose_backend
+    compile_byte compile_cstyle compile_module generate_code
+    grab_stash parse_argv sanity_check vprint yclept spawnit
+};
+sub opt(*); # imal quoting
 
-my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD
-                                                            # BE IN Config.pm
+our ($Options, $BinPerl, $Backend);
+our ($Input => $Output);
+our ($logfh);
+our ($cfile);
 
-my $options = {};
-my $_fh;
-unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
+# eval { main(); 1 } or die;
 
 main();
 
-sub main
-{
-
-    GetOptions
-            (
-            $options,   "L:s",
-                        "I:s",
-                        "C:s",
-                        "o:s",
-                        "e:s",
-                        "regex:s",
-                        "verbose:s",
-                        "log:s",
-                        "argv:s",
-                        "b",
-                        "opt",
-                        "gen",
-                        "sav",
-                        "run",
-                        "prog",
-                        "mod"
-            );
-
-
-    my $key;
-
-    local($") = "|";
-
-    _usage() if (!_checkopts());
-    push(@ARGV, _maketempfile()) if ($options->{'e'});
-
-    _usage() if (!@ARGV);
-                
-    my $file;
-    foreach $file (@ARGV)
-    {
-        _print("
---------------------------------------------------------------------------------
-Compiling $file:
---------------------------------------------------------------------------------
-", 36 );
-        _doit($file);
-    }
+sub main {
+    parse_argv();
+    check_write($Output);
+    choose_backend();
+    generate_code();
+    run_code();
+    _die("XXX: Not reached?");
 }
-        
-sub _doit
-{
-    my ($file) = @_;
-
-    my ($program_ext, $module_ext) = _getRegexps();
-    my ($obj, $objfile, $so, $type, $backend, $gentype);
-
-    $backend = $options->{'b'} ? 'Bytecode' : $options->{'opt'} ? 'CC' : 'C';
-
-    $gentype = $options->{'b'} ? 'Bytecode' : 'C';
-
-    if  (
-            (($file =~ m"@$program_ext") && ($file !~ m"@$module_ext"))
-            || (defined($options->{'prog'}) || defined($options->{'run'}))
-        )
-    {
-        $type = 'program';
-
-        if ($options->{'b'})
-        {
-            $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c";
-        }
-        else
-        {
-            $objfile = $options->{'C'} ? $options->{'C'} : "$file.c";
-            $obj = $options->{'o'} ? $options->{'o'}
-                                   : _getExecutable( $file,$program_ext);
-        }
 
-        return() if (!$obj);
+#######################################################################
 
+sub choose_backend {
+    # Choose the backend.
+    $Backend = 'C';
+    if (opt(B)) {
+        checkopts_byte();
+        $Backend = 'Bytecode';
     }
-    elsif (($file =~ m"@$module_ext") || ($options->{'mod'}))
-    {
-        $type = 'module';
-
-        if ($options->{'b'})
-        {
-            $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c";
-        }
-        else
-        {
-            die "Shared objects are not supported on Win32 yet!!!!\n"
-                                          if ($Config{'osname'} eq 'MSWin32');
-
-            $objfile = $options->{'C'} ? $options->{'C'} : "$file.c";
-            $obj = $options->{'o'} ? $options->{'o'}
-                                   : _getExecutable($file, $module_ext);
-            $so = "$obj.$Config{so}";
-        }
-
-        return() if (!$obj);
-    }
-    else
-    {
-        _error("noextension", $file, $program_ext, $module_ext);
-        return();
+    if (opt(S) && opt(c)) {
+        # die "$0: Do you want me to compile this or not?\n";
+        delete $Options->{S};
     }
+    $Backend = 'CC' if opt(O);
+}
 
-    if ($type eq 'program')
-    {
-        _print("Making $gentype($objfile) for $file!\n", 36 );
-
-        my $errcode = _createCode($backend, $objfile, $file);
-        (_print( "ERROR: In generating code for $file!\n", -1), return()) 
-                                                                if ($errcode);
-
-        _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'} &&
-                                                          !$options->{'b'});
-        $errcode = _compileCode($file, $objfile, $obj) 
-                                            if (!$options->{'gen'} &&
-                                                !$options->{'b'});
-
-        if ($errcode)
-		{
-			_print( "ERROR: In compiling code for $objfile !\n", -1);
-			my $ofile = File::Basename::basename($objfile);
-			$ofile =~ s"\.c$"\.o"s;
-			
-			_removeCode("$ofile"); 
-			return()
-		}
-    
-        _runCode($objfile) if ($options->{'run'} && $options->{'b'});
-        _runCode($obj) if ($options->{'run'} && !$options->{'b'});
-
-        _removeCode($objfile) if (($options->{'b'} &&
-                                   ($options->{'e'} && !$options->{'o'})) ||
-                                  (!$options->{'b'} &&
-                                   (!$options->{'sav'} || 
-                                    ($options->{'e'} && !$options->{'C'}))));
 
-        _removeCode($file) if ($options->{'e'}); 
+sub generate_code { 
 
-        _removeCode($obj) if (!$options->{'b'} &&
-                              (($options->{'e'} &&
-			        !$options->{'sav'} && !$options->{'o'}) ||
-			       ($options->{'run'} && !$options->{'sav'})));
-    }
-    else
-    {
-        _print( "Making $gentype($objfile) for $file!\n", 36 );
-        my $errcode = _createCode($backend, $objfile, $file, $obj);
-        (_print( "ERROR: In generating code for $file!\n", -1), return()) 
-                                                                if ($errcode);
-    
-        _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'} &&
-                                                          !$options->{'b'});
+    vprint 0, "Compiling $Input";
 
-        $errcode = 
-            _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'} &&
-                                                          !$options->{'b'});
+    $BinPerl  = yclept();  # Calling convention for perl.
 
-        (_print( "ERROR: In compiling code for $objfile!\n", -1), return()) 
-                                                                if ($errcode);
+    if (opt(shared)) {
+        compile_module();
+    } else {
+        if ($Backend eq 'Bytecode') {
+            compile_byte();
+        } else {
+            compile_cstyle();
+        }
     }
+    exit(0) if (!opt('r'));
 }
 
-sub _getExecutable
-{
-    my ($sourceprog, $ext) = @_;
-    my ($obj);
-
-    if (defined($options->{'regex'}))
-    {
-        eval("(\$obj = \$sourceprog) =~ $options->{'regex'}");
-        return(0) if (_error('badeval', $@));
-        return(0) if (_error('equal', $obj, $sourceprog));
-    }
-    elsif (defined ($options->{'ext'}))
-    {
-        ($obj = $sourceprog) =~ s"@$ext"$options->{ext}"g;        
-        return(0) if (_error('equal', $obj, $sourceprog));
-    }
-    elsif (defined ($options->{'run'}))
-    {
-	    $obj = "perlc$$";
-    }
-    else
-    {
-        ($obj = $sourceprog) =~ s"@$ext""g;
-        return(0) if (_error('equal', $obj, $sourceprog));
-    }
-    return($obj);
+sub run_code {
+    vprint 0, "Running code";
+    run("$Output @ARGV");
+    exit(0);
 }
 
-sub _createCode
-{
-    my ( $backend, $generated_file, $file, $final_output ) = @_;
-    my $return;
-    my $output_switch = "o";
-    my $max_line_len = '';
-
-    local($") = " -I";
-
-    if ($^O eq 'MSWin32' && $backend =~ /^CC?$/ && $Config{cc} =~ /^cl/i) {
-	$max_line_len = '-l2000,';
-    }
-
-    if ($backend eq "Bytecode")
-    {
-        require ByteLoader;
-
-	open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!";
-	binmode GENFILE;
-        print GENFILE "#!$^X\n" if @_ == 3;
-        print GENFILE "use ByteLoader $ByteLoader::VERSION;\n";
-	close(GENFILE);
-
-	$output_switch ="a";
-    }
-
-    if (@_ == 3)                                   # compiling a program   
-    {
-        chmod $generated_file, 0777 & ~umask if $backend eq "Bytecode";
-	my $null=File::Spec->devnull;
-        _print( "$^X -I@INC -MB::Stash -c  $file\n", 36);
-        my @stash=`$^X -I@INC -MB::Stash -c  $file 2>$null`;
-	my $stash=$stash[-1];
-        chomp $stash;
-
-        _print( "$^X -I@INC -MO=$backend,$max_line_len$stash $file\n", 36);
-        $return =  _run("$^X -I@INC -MO=$backend,$max_line_len$stash,-$output_switch$generated_file $file", 9);
-        $return;
-    }
-    else                                           # compiling a shared object
-    {            
-        _print( 
-            "$^X -I@INC -MO=$backend,$max_line_len-m$final_output $file\n", 36);
-        $return = 
-        _run("$^X -I@INC -MO=$backend,$max_line_len-m$final_output,-$output_switch$generated_file $file  ", 9);
-        $return;
+# usage: vprint [level] msg args
+sub vprint {
+    my $level;
+    if (@_ == 1) {
+        $level = 1;
+    } elsif ($_[0] =~ /^\d$/) {
+        $level = shift;
+    } else {
+        # well, they forgot to use a number; means >0
+        $level = 0;
+    } 
+    my $msg = "@_";
+    $msg .= "\n" unless substr($msg, -1) eq "\n";
+    if (opt(v) > $level)
+    {
+         print        "$0: $msg" if !opt('log');
+	 print $logfh "$0: $msg" if  opt('log');
     }
 }
 
-sub _compileCode
-{
-    my ($sourceprog, $generated_cfile, $output_executable, $shared_object) = @_;
-    my @return;
-
-    if (@_ == 3)                            # just compiling a program 
-    {
-        $return[0] = 
-        _ccharness('static', $sourceprog, "-o", $output_executable,
-		   $generated_cfile);  
-        $return[0];
-    }
-    else
-    {
-        my $object_file = $generated_cfile;
-        $object_file =~ s"\.c$"$Config{_o}";   
-
-        $return[0] = _ccharness('compile', $sourceprog, "-c", $generated_cfile);
-        $return[1] = _ccharness
-                            (
-                                'dynamic', 
-                                $sourceprog, "-o", 
-                                $shared_object, $object_file 
-                            );
-        return(1) if (grep ($_, @return));
-        return(0);
+sub parse_argv {
+
+    use Getopt::Long; 
+#    Getopt::Long::Configure("bundling"); turned off. this is silly because 
+#                                         it doesn't allow for long switches.
+    Getopt::Long::Configure("no_ignore_case");
+
+    # no difference in exists and defined for %ENV; also, a "0"
+    # argument or a "" would not help cc, so skip
+    unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
+
+    $Options = {};
+    Getopt::Long::GetOptions( $Options,
+        'L:s',          # lib directory
+        'I:s',          # include directories (FOR C, NOT FOR PERL)
+        'o:s',          # Output executable
+        'v:i',           # Verbosity level
+        'e:s',          # One-liner
+	'r',            # run resulting executable
+        'B',            # Byte compiler backend
+        'O',            # Optimised C backend
+        'c',            # Compile only
+        'h',            # Help me
+        'S',            # Dump C files
+	'r',            # run the resulting executable
+        'static',       # Dirty hack to enable -shared/-static
+        'shared',       # Create a shared library (--shared for compat.)
+	'log:s'         # where to log compilation process information
+    );
+        
+    # This is an attempt to make perlcc's arg. handling look like cc.
+    # if ( opt('s') ) {  # must quote: looks like s)foo)bar)!
+    #   if (opt('s') eq 'hared') {
+    #        $Options->{shared}++; 
+    #    } elsif (opt('s') eq 'tatic') {
+    #        $Options->{static}++; 
+    #    } else {
+    #        warn "$0: Unknown option -s", opt('s');
+    #    }
+    # }
+
+    $Options->{v} += 0;
+
+    helpme() if opt(h); # And exit
+
+    $Output = opt(o) || 'a.out';
+    $Output = relativize($Output);
+    $logfh  = new FileHandle(">> " . opt('log')) if (opt('log'));
+
+    if (opt(e)) {
+        warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
+        # We don't use a temporary file here; why bother?
+        # XXX: this is not bullet proof -- spaces or quotes in name!
+        $Input = "-e '".opt(e)."'"; # Quotes eaten by shell
+    } else {
+        $Input = shift @ARGV;  # XXX: more files?
+        _usage_and_die("$0: No input file specified\n") unless $Input;
+        # DWIM modules. This is bad but necessary.
+        $Options->{shared}++ if $Input =~ /\.pm\z/;
+        warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
+        check_read($Input);
+        check_perl($Input);
+        sanity_check();
     }
-}
 
-sub _runCode
-{
-    my ($executable) = @_;
-    _print("$executable $options->{'argv'}\n", 36);
-    _run("$executable $options->{'argv'}", -1 );
 }
 
-sub _removeCode
-{
-    my ($file) = @_;
-    unlink($file) if (-e $file);
-}
-
-sub _ccharness
-{
-    my $type = shift;
-    my (@args) = @_;
-    local($") = " ";
-
-    my $sourceprog = shift(@args);
-    my ($libdir, $incdir);
-
-    my $L = '-L';
-    $L = '-libpath:' if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i;
-
-    if (-d "$Config{installarchlib}/CORE")
-    {
-        $libdir = "$L$Config{installarchlib}/CORE";
-        $incdir = "-I$Config{installarchlib}/CORE";
-    }
-    else
-    {
-        $libdir = "$L.. $L."; 
-        $incdir = "-I.. -I.";
-    }
-
-    $libdir .= " $L$options->{L}" if (defined($options->{L}));
-    $incdir .= " -I$options->{L}" if (defined($options->{L}));
-
-    my $linkargs = '';
-    my $dynaloader = '';
-    my $optimize = '';
-    my $flags = '';
+sub opt(*) {
+    my $opt = shift;
+    return exists($Options->{$opt}) && ($Options->{$opt} || 0);
+} 
 
-    if (!grep(/^-[cS]$/, @args))
-    {
-	my $lperl = $^O eq 'os2' ? '-llibperl' 
-	   : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\$Config{libperl}"
-	   : '-lperl';
-       ($lperl = $Config{libperl}) =~ s/lib(.*)\Q$Config{_a}\E/-l$1/
-	    if($^O eq 'cygwin');
-
-	$optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'};
-
-	$flags = $type eq 'dynamic' ? $Config{lddlflags} : $Config{ldflags};
-	$linkargs = "$flags $libdir $lperl @Config{libs}";
-	$linkargs = "/link $linkargs" if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i;
-    }
-
-    my $libs = _getSharedObjects($sourceprog);
-    @$libs = grep { !(/DynaLoader\.a$/ && ($dynaloader = $_)) } @$libs
-	if($^O eq 'cygwin');
-
-    my $args = "@args";
-    if ($^O eq 'MSWin32' && $Config{cc} =~ /^bcc/i) {
-        # BC++ cmd line syntax does not allow space between -[oexz...] and arg
-        $args =~ s/(^|\s+)-([oe])\s+/$1-$2/g;
-    }
-
-    my $ccflags = $Config{ccflags};
-    $ccflags .= ' -DUSEIMPORTLIB' if $^O eq 'cygwin';
-    my $cccmd = "$Config{cc} $ccflags $optimize $incdir "
-		."$args $dynaloader $linkargs @$libs";
-
-    _print ("$cccmd\n", 36);
-    _run("$cccmd", 18 );
+sub compile_module { 
+    die "$0: Compiling to shared libraries is currently disabled\n";
 }
 
-sub _getSharedObjects
-{
-    my ($sourceprog) = @_;
-    my ($tmpfile, $incfile);
-    my (@sharedobjects, @libraries);
-    local($") = " -I";
+sub compile_byte {
+    require ByteLoader;
+    my $stash = grab_stash();
+    my $command = "$BinPerl -MO=Bytecode,$stash $Input";
+    # The -a option means we'd have to close the file and lose the
+    # lock, which would create the tiniest of races. Instead, append
+    # the output ourselves. 
+    vprint 1, "Writing on $Output";
 
-    my ($tmpprog);
-    ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
+    my $openflags = O_WRONLY | O_CREAT;
+    $openflags |= O_BINARY if eval { O_BINARY; 1 };
+    $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 };
 
-    my $tempdir= File::Spec->tmpdir;
+    # these dies are not "$0: .... \n" because they "can't happen"
 
-    $tmpfile = "$tempdir/$tmpprog.tst";
-    $incfile = "$tempdir/$tmpprog.val";
+    sysopen(OUT, $Output, $openflags)
+        or die "can't write to $Output: $!";
 
-    my $fd = new FileHandle("> $tmpfile") || die "Couldn't open $tmpfile!\n";
-    my $fd2 = 
-        new FileHandle("$sourceprog") || die "Couldn't open $sourceprog!\n";
+    # this is blocking; hold on; why are we doing this??
+    # flock OUT, LOCK_EX or die "can't lock $Output: $!"
+    #    unless eval { O_EXLOCK; 1 };
 
-    print $fd <<"EOF";
-        use FileHandle;
-        my \$fh3  = new FileHandle("> $incfile") 
-                                        || die "Couldn't open $incfile\\n";
+    truncate(OUT, 0)
+        or die "couldn't trunc $Output: $!";
 
-        my \$key;
-        foreach \$key (keys(\%INC)) { print \$fh3 "\$key:\$INC{\$key}\\n"; }
-        close(\$fh3);
-        exit();
+    print OUT <<EOF;
+#!$^X
+use ByteLoader $ByteLoader::VERSION;
 EOF
 
-    print $fd (   <$fd2>    );
-    close($fd);
-
-    _print("$^X -I@INC $tmpfile\n", 36);
-    _run("$^X -I@INC $tmpfile", 9 );
+    # Now the compile:
+    vprint 1, "Compiling...";
+    vprint 3, "Calling $command";
 
-    $fd = new FileHandle ("$incfile"); 
-    my @lines = <$fd>;    
+    my ($output_r, $error_r) = spawnit($command);
 
-    unlink($tmpfile);
-    unlink($incfile);
-
-    my $line;
-    my $autolib;
-
-    my @return;
-
-    foreach $line (@lines) 
-    {
-        chomp($line);
-
-        my ($modname, $modpath) = split(':', $line);
-        my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
-
-        if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
+    if (@$error_r && $? != 0) {
+	_die("$0: $Input did not compile, which can't happen:\n@$error_r\n");
+    } else {
+	my @error = grep { !/^$Input syntax OK$/o } @$error_r;
+	warn "$0: Unexpected compiler output:\n@error" if @error;
     }
-    return(\@return);
-}
+	
+    # Write it and leave.
+    print OUT @$output_r               or _die("can't write $Output: $!");
+    close OUT                          or _die("can't close $Output: $!");
 
-sub _maketempfile
-{
-    my $return;
-
-#    if ($Config{'osname'} eq 'MSWin32') 
-#            { $return = "C:\\TEMP\\comp$$.p"; }
-#    else
-#            { $return = "/tmp/comp$$.p"; }
-
-    $return = "comp$$.p"; 
-
-    my $fd = new FileHandle( "> $return") || die "Couldn't open $return!\n";
-    print $fd $options->{'e'};
-    close($fd);
-
-    return($return);
+    # wait, how could it be anything but what you see next?
+    chmod 0777 & ~umask, $Output    or _die("can't chmod $Output: $!");
+    exit 0;
 }
-    
-    
-sub _lookforAuto
-{
-    my ($dir, $file) = @_;    
 
-    my ($relabs, $relshared);
-    my ($prefix);
-    my $return;
-    my $sharedextension = $^O =~ /MSWin32|cygwin|os2/i
-			  ? $Config{_a} : ".$Config{so}";
-    ($prefix = $file) =~ s"(.*)\.pm"$1";
-
-    my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
-
-    $relshared = "$pathsep$prefix$pathsep$modname$sharedextension";
-    $relabs    = "$pathsep$prefix$pathsep$modname$Config{_a}";
-                                               # HACK . WHY DOES _a HAVE A '.'
-                                               # AND so HAVE NONE??
-
-    my @searchpaths =   map("$_${pathsep}auto", @INC);
+sub compile_cstyle {
+    my $stash = grab_stash();
     
-    my $path;
-    foreach $path (@searchpaths)
-    {
-        if (-e ($return = "$path$relshared")) { return($return); } 
-        if (-e ($return = "$path$relabs"))    { return($return); }
+    # What are we going to call our output C file?
+    my $lose = 0;
+    my ($cfh);
+
+    if (opt(S) || opt(c)) {
+        # We need to keep it.
+        if (opt(e)) {
+            $cfile = "a.out.c";
+        } else {
+            $cfile = $Input;
+            # File off extension if present
+            # hold on: plx is executable; also, careful of ordering!
+            $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
+            $cfile .= ".c";
+            $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
+        }
+        check_write($cfile);
+    } else {
+        # Don't need to keep it, be safe with a tempfile.
+        $lose = 1;
+        ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c"); 
+        close $cfh; # See comment just below
     }
-   return(undef);
-}
-
-sub _getRegexps    # make the appropriate regexps for making executables, 
-{                  # shared libs
-
-    my ($program_ext, $module_ext) = ([],[]); 
+    vprint 1, "Writing C on $cfile";
 
+    my $max_line_len = '';
+    if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
+        $max_line_len = '-l2000,';
+    }
 
-    @$program_ext = ($ENV{PERL_SCRIPT_EXT})? split(':', $ENV{PERL_SCRIPT_EXT}) :
-                                            ('.p$', '.pl$', '.bat$');
+    # This has to do the write itself, so we can't keep a lock. Life
+    # sucks.
+    my $command = "$BinPerl -MO=$Backend,$max_line_len$stash,-o$cfile $Input";
+    vprint 1, "Compiling...";
+    vprint 1, "Calling $command";
 
+	my ($output_r, $error_r) = spawnit($command);
+	my @output = @$output_r;
+	my @error = @$error_r;
 
-    @$module_ext  = ($ENV{PERL_MODULE_EXT})? split(':', $ENV{PERL_MODULE_EXT}) :
-                                            ('.pm$');
+    if (@error && $? != 0) {
+        _die("$0: $Input did not compile, which can't happen:\n@error\n");
+    }
 
-    _mungeRegexp( $program_ext );
-    _mungeRegexp( $module_ext  );    
+    cc_harness($cfile,$stash) unless opt(c);
 
-    return($program_ext, $module_ext);
+    if ($lose) {
+        vprint 2, "unlinking $cfile";
+        unlink $cfile or _die("can't unlink $cfile: $!"); 
+    }
 }
 
-sub _mungeRegexp
-{
-    my ($regexp) = @_;
-
-    grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
-    grep(s:(^|[^\x00])\\\.:$1\.:g,  @$regexp);
-    grep(s:\x00::g,                 @$regexp);
+sub cc_harness {
+	my ($cfile,$stash)=@_;
+	use ExtUtils::Embed ();
+	my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
+	$command .= " -I".$_ for split /\s+/, opt(I);
+	$command .= " -L".$_ for split /\s+/, opt(L);
+	my @mods = split /-?u /, $stash;
+	$command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
+	vprint 3, "running $Config{cc} $command";
+	system("$Config{cc} $command");
 }
 
-sub _error
-{
-    my ($type, @args) = @_;
-
-    if ($type eq 'equal')
-    {
-            
-        if ($args[0] eq $args[1])
-        {
-            _print ("ERROR: The object file '$args[0]' does not generate a legitimate executable file! Skipping!\n", -1);
-            return(1);
+# Where Perl is, and which include path to give it.
+sub yclept {
+    my $command = "$^X ";
+
+    # DWIM the -I to be Perl, not C, include directories.
+    if (opt(I) && $Backend eq "Bytecode") {
+        for (split /\s+/, opt(I)) {
+            if (-d $_) {
+                push @INC, $_;
+            } else {
+                warn "$0: Include directory $_ not found, skipping\n";
+            }
         }
     }
-    elsif ($type eq 'badeval')
-    {
-        if ($args[0])
-        {
-            _print ("ERROR: $args[0]\n", -1);
-            return(1);
-        }
-    }
-    elsif ($type eq 'noextension')
-    {
-        my $progext = join(',', @{$args[1]});
-        my $modext  = join(',', @{$args[2]});
+            
+    $command .= "-I$_ " for @INC;
+    return $command;
+}
 
-        $progext =~ s"\\""g;
-        $modext  =~ s"\\""g;
+# Use B::Stash to find additional modules and stuff.
+{
+    my $_stash;
+    sub grab_stash {
 
-        $progext =~ s"\$""g;
-        $modext  =~ s"\$""g;
+        warn "already called get_stash once" if $_stash;
 
-        _print 
-        (
-"
-ERROR: '$args[0]' does not have a proper extension! Proper extensions are:
+        my $command = "$BinPerl -MB::Stash -c $Input";
+        # Filename here is perfectly sanitised.
+        vprint 3, "Calling $command\n";
 
-    PROGRAM:       $progext 
-    SHARED OBJECT: $modext
+		my ($stash_r, $error_r) = spawnit($command);
+		my @stash = @$stash_r;
+		my @error = @$error_r;
 
-Use the '-prog' flag to force your files to be interpreted as programs.
-Use the '-mod' flag to force your files to be interpreted as modules.
-", -1
-        );
-        return(1);
+    	if (@error && $? != 0) {
+            _die("$0: $Input did not compile:\n@error\n");
+        }
+
+        $stash[0] =~ s/,-u\<none\>//;
+        vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
+        chomp $stash[0];
+        return $_stash = $stash[0];
     }
 
-    return(0);
 }
 
-sub _checkopts
-{
-    my @errors;
-    local($") = "\n";
-
-    if ($options->{'log'})
-    {
-        $_fh = new FileHandle(">> $options->{'log'}") || push(@errors, "ERROR: Couldn't open $options->{'log'}\n");
-    }
+# Check the consistency of options if -B is selected.
+# To wit, (-B|-O) ==> no -shared, no -S, no -c
+sub checkopts_byte {
 
-    if ($options->{'b'} && $options->{'c'})
-    {
-        push(@errors,
-"ERROR: The '-b' and '-c' options are incompatible. The '-c' option specifies
-       a name for the intermediate C code but '-b' generates byte code
-       directly.\n");
-    }
-    if ($options->{'b'} && ($options->{'sav'} || $options->{'gen'}))
-    {
-        push(@errors,
-"ERROR: The '-sav' and '-gen' options are incompatible with the '-b' option.
-       They ask for intermediate C code to be saved by '-b' generates byte
-       code directly.\n");
-    }
+    _die("$0: Please choose one of either -B and -O.\n") if opt(O);
 
-    if (($options->{'c'}) && (@ARGV > 1) && ($options->{'sav'} ))
-    {
-        push(@errors, 
-"ERROR: The '-sav' and '-C' options are incompatible when you have more than 
-       one input file! ('-C' explicitly names resulting C code, '-sav' saves it,
-       and hence, with more than one file, the c code will be overwritten for 
-       each file that you compile)\n");
-    }
-    if (($options->{'o'}) && (@ARGV > 1))
-    {
-        push(@errors, 
-"ERROR: The '-o' option is incompatible when you have more than one input 
-       file! (-o explicitly names the resulting file, hence, with more than 
-       one file the names clash)\n");
+    if (opt(shared)) {
+        warn "$0: Will not create a shared library for bytecode\n";
+        delete $Options->{shared};
     }
 
-    if ($options->{'e'} && ($options->{'sav'} || $options->{'gen'}) &&
-                                                            !$options->{'C'})
-    {
-        push(@errors, 
-"ERROR: You need to specify where you are going to save the resulting 
-       C code when using '-sav' and '-e'. Use '-C'.\n");
+    for my $o ( qw[c S] ) { 
+        if (opt($o)) { 
+            warn "$0: Compiling to bytecode is a one-pass process--",
+                  "-$o ignored\n";
+            delete $Options->{$o};
+        }
     }
 
-    if (($options->{'regex'} || $options->{'run'} || $options->{'o'}) 
-                                                    && $options->{'gen'})
-    {
-        push(@errors, 
-"ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'. 
-       '-gen' says to stop at C generation, and the other three modify the 
-       compilation and/or running process!\n");
-    }
+}
 
-    if ($options->{'run'} && $options->{'mod'})
-    {
-        push(@errors, 
-"ERROR: Can't run modules that you are compiling! '-run' and '-mod' are 
-       incompatible!\n"); 
+# Check the input and output files make sense, are read/writeable.
+sub sanity_check {
+    if ($Input eq $Output) {
+        if ($Input eq 'a.out') {
+            _die("$0: Compiling a.out is probably not what you want to do.\n");
+            # You fully deserve what you get now. No you *don't*. typos happen.
+        } else {
+            warn "$0: Will not write output on top of input file, ",
+                "compiling to a.out instead\n";
+            $Output = "a.out";
+        }
     }
+}
 
-    if ($options->{'e'} && @ARGV)
-    {
-        push (@errors, 
-"ERROR: The option '-e' needs to be all by itself without any other 
-       file arguments!\n");
-    }
-    if ($options->{'e'} && !($options->{'o'} || $options->{'run'}))
-    {
-        $options->{'run'} = 1;
+sub check_read { 
+    my $file = shift;
+    unless (-r $file) {
+        _die("$0: Input file $file is a directory, not a file\n") if -d _;
+        unless (-e _) {
+            _die("$0: Input file $file was not found\n");
+        } else {
+            _die("$0: Cannot read input file $file: $!\n");
+        }
     }
+    unless (-f _) {
+        # XXX: die?  don't try this on /dev/tty
+        warn "$0: WARNING: input $file is not a plain file\n";
+    } 
+}
 
-    if (!defined($options->{'verbose'})) 
-    { 
-        $options->{'verbose'} = ($options->{'log'})? 64 : 7; 
+sub check_write {
+    my $file = shift;
+    if (-d $file) {
+        _die("$0: Cannot write on $file, is a directory\n");
     }
-
-    my $verbose_error;
-
-    if ($options->{'verbose'} =~ m"[^tagfcd]" && 
-            !( $options->{'verbose'} eq '0' || 
-                ($options->{'verbose'} < 64 && $options->{'verbose'} > 0)))
-    {
-        $verbose_error = 1;
-        push(@errors, 
-"ERROR: Illegal verbosity level.  Needs to have either the letters 
-       't','a','g','f','c', or 'd' in it or be between 0 and 63, inclusive.\n");
+    if (-e _) {
+        _die("$0: Cannot write on $file: $!\n") unless -w _;
+    } 
+    unless (-w cwd()) { 
+        _die("$0: Cannot write in this directory: $!\n");
     }
+}
 
-    $options->{'verbose'} = ($options->{'verbose'} =~ m"[tagfcd]")? 
-                            ($options->{'verbose'} =~ m"d") * 32 +     
-                            ($options->{'verbose'} =~ m"c") * 16 +     
-                            ($options->{'verbose'} =~ m"f") * 8     +     
-                            ($options->{'verbose'} =~ m"t") * 4     +     
-                            ($options->{'verbose'} =~ m"a") * 2     +     
-                            ($options->{'verbose'} =~ m"g") * 1     
-                                                    : $options->{'verbose'};
-
-    if     (!$verbose_error && (    $options->{'log'} && 
-                                !(
-                                    ($options->{'verbose'} & 8)   || 
-                                    ($options->{'verbose'} & 16)  || 
-                                    ($options->{'verbose'} & 32 ) 
-                                )
-                            )
-        )
-    {
-        push(@errors, 
-"ERROR: The verbosity level '$options->{'verbose'}' does not output anything 
-       to a logfile, and you specified '-log'!\n");
-    } # }
-
-    if     (!$verbose_error && (    !$options->{'log'} && 
-                                (
-                                    ($options->{'verbose'} & 8)   || 
-                                    ($options->{'verbose'} & 16)  || 
-                                    ($options->{'verbose'} & 32)  || 
-                                    ($options->{'verbose'} & 64)
-                                )
-                            )
-        )
-    {
-        push(@errors, 
-"ERROR: The verbosity level '$options->{'verbose'}' requires that you also 
-       specify a logfile via '-log'\n");
-    } # }
-
-
-    (_print( "\n". join("\n", @errors), -1), return(0)) if (@errors);
-    return(1);
+sub check_perl {
+    my $file = shift;
+    unless (-T $file) {
+        warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
+        print "Checking file type... ";
+        system("file", $file);  
+        _die("Please try a perlier file!\n");
+    } 
+
+    open(my $handle, "<", $file)    or _die("XXX: can't open $file: $!");
+    local $_ = <$handle>;
+    if (/^#!/ && !/perl/) {
+        _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
+    } 
+
+} 
+
+# File spawning and error collecting
+sub spawnit {
+	my ($command) = shift;
+	my (@error,@output);
+	my $errname;
+	(undef, $errname) = tempfile("pccXXXXX");
+	{ 
+	open (S_OUT, "$command 2>$errname |")
+		or _die("$0: Couldn't spawn the compiler.\n");
+	@output = <S_OUT>;
+	}
+	open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
+	@error = <S_ERROR>;
+	close S_ERROR;
+	close S_OUT;
+	unlink $errname or _die("$0: Can't unlink error file $errname");
+	return (\@output, \@error);
 }
 
-sub _print
-{
-    my ($text, $flag ) = @_;
-    
-    my $logflag = int($flag/8) * 8;
-    my $regflag = $flag % 8;
+sub helpme {
+       print "perlcc compiler frontend, version $VERSION\n\n";
+       { no warnings;
+       exec "pod2usage $0";
+       exec "perldoc $0";
+       exec "pod2text $0";
+       }
+}
 
-    if ($flag == -1 || ($flag & $options->{'verbose'}))
-    {
-        my $dolog = ((($logflag & $options->{'verbose'}) || $flag == -1) 
-                                                        && $options->{'log'}); 
+sub relativize {
+	my ($args) = @_;
 
-        my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
-        
-        if ($doreg) { print( STDERR $text ); }
-        if ($dolog) { print $_fh $text; }
-    }
+	return() if ($args =~ m"^[/\\]");
+	return("./$args");
 }
 
-sub _run
-{
-    my ($command, $flag) = @_;
+sub _die {
+    $logfh->print(@_) if opt('log');
+    print STDERR @_;
+    exit(); # should die eventually. However, needed so that a 'make compile'
+            # can compile all the way through to the end for standard dist.
+}
 
-    my $logflag = ($flag != -1)? int($flag/8) * 8 : 0;
-    my $regflag = $flag % 8;
+sub _usage_and_die {
+    _die(<<EOU);
+$0: Usage:
+$0 [-o executable] [-r] [-O|-B|-c|-S] [-log log] [source[.pl] | -e oneliner]
+EOU
+}
 
-    if ($flag == -1 || ($flag & $options->{'verbose'}))
-    {
-        my $dolog = ($logflag & $options->{'verbose'} && $options->{'log'});
-        my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
+sub run {
+    my (@commands) = @_;
 
-        if ($doreg && !$dolog) 
-        {
-	    print _interruptrun("$command");
-	}
-        elsif ($doreg && $dolog) 
-        { 
-	    my $text = _interruptrun($command); 
-	    print $_fh $text; 
-	    print STDERR $text;
-	}
-        else 
-        { 
-	    my $text = _interruptrun($command);
-	    print $_fh $text; 
-	}
-    }
-    else 
-    {
-	_interruptrun($command);
-    }
-    return($?);
+    print interruptrun(@commands) if (!opt('log'));
+    $logfh->print(interruptrun(@commands)) if (opt('log'));
 }
 
-sub _interruptrun
+sub interruptrun
 {
-    my ($command) = @_;
-    my $pid = open (FD, "$command  |");
-
-    local($SIG{HUP}) = sub { 
-#	kill 9, $pid + 1;  
-#	HACK... 2>&1 doesn't propogate
-#	kill, comment out for quick and dirty
-#	process killing of child.
+    my (@commands) = @_;
 
-	kill 9, $pid;  
-	exit(); 
-    };
-    local($SIG{INT}) = sub { 
-#	kill 9, $pid + 1;  
-#	HACK... 2>&1 doesn't propogate
-#	kill, comment out for quick and dirty
-#	process killing of child.
-	kill 9, $pid; 
-	exit(); 
-    }; 
+    my $command = join('', @commands);
+    local(*FD);
+    my $pid = open(FD, "$command |");
+    my $text;
+    
+    local($SIG{HUP}) = sub { kill 9, $pid; exit };
+    local($SIG{INT}) = sub { kill 9, $pid; exit };
 
     my $needalarm = 
-            ($ENV{'PERLCC_TIMEOUT'} && 
-                    $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
-    my $text;
+          ($ENV{PERLCC_TIMEOUT} && 
+	  $Config{'osname'} ne 'MSWin32' && 
+	  $command =~ m"(^|\s)perlcc\s");
 
-    eval
+    eval 
     {
-        local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
-        alarm($ENV{'PERLCC_TIMEOUT'}) if ($needalarm);
-        $text = join('', <FD>); 
-        alarm(0) if ($needalarm);
+         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
+         alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
+	 $text = join('', <FD>);
+	 alarm(0) if ($needalarm);
     };
 
-    if ($@) 
-    { 
-        eval { kill 'HUP', $pid; };
-        _print("SYSTEM TIMEOUT (infinite loop?)\n", 36); 
+    if ($@)
+    {
+        eval { kill 'HUP', $pid };
+        vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
     }
-        
+
     close(FD);
     return($text);
 }
 
-sub _usage
-{
-    _print
-    ( 
-    <<"EOF"
-
-Usage: $0 <file_list> 
-
-WARNING: The whole compiler suite ('perlcc' included) is considered VERY
-experimental.  Use for production purposes is strongly discouraged.
-
-    Flags with arguments
-        -L       < extra library dirs for installation (form of 'dir1:dir2') >
-        -I       < extra include dirs for installation (form of 'dir1:dir2') >
-        -C       < explicit name of resulting C code > 
-        -o       < explicit name of resulting executable >
-        -e       < to compile 'one liners'. Need executable name (-o) or '-run'>
-        -regex   < rename regex, -regex 's/\.p/\.exe/' compiles a.p to a.exe >
-        -verbose < verbose level < 1-63, or following letters 'gatfcd' >
-        -argv    < arguments for the executables to be run via '-run' or '-e' > 
-
-    Boolean flags
-        -b       ( to generate byte code )
-        -opt     ( to generated optimised C code. May not work in some cases. )
-        -gen     ( to just generate the C code. Implies '-sav' )
-        -sav     ( to save intermediate C code, (and executables with '-run'))
-        -run     ( to run the compiled program on the fly, as were interpreted.)
-        -prog    ( to indicate that the files on command line are programs )
-        -mod     ( to indicate that the files on command line are modules  )
-
-EOF
-, -1
-
-    );
-    exit(255);
+END {
+    unlink $cfile if ($cfile && !opt(S) && !opt(c));
 }
 
-
 __END__
 
 =head1 NAME
 
-perlcc - frontend for perl compiler
+perlcc - generate executables from Perl programs
 
 =head1 SYNOPSIS
 
-    %prompt  perlcc a.p        # compiles into executable 'a'
-
-    %prompt  perlcc A.pm       # compile into 'A.so'
-
-    %prompt  perlcc a.p -o execute  # compiles 'a.p' into 'execute'.
+    $ perlcc hello              # Compiles into executable 'a.out'
+    $ perlcc -o hello hello.pl  # Compiles into executable 'hello'
 
-    %prompt  perlcc a.p -o execute -run # compiles 'a.p' into execute, runs on
-                                        # the fly
+    $ perlcc -O file            # Compiles using the optimised C backend
+    $ perlcc -B file            # Compiles using the bytecode backend
 
-    %prompt  perlcc a.p -o execute -run -argv 'arg1 arg2 arg3' 
-                                        # compiles into execute, runs with 
-                                        # arg1 arg2 arg3 as @ARGV
+    $ perlcc -c file            # Creates a C file, 'file.c'
+    $ perlcc -S -o hello file   # Creates a C file, 'file.c',
+                                # then compiles it to executable 'hello'
+    $ perlcc -c out.c file      # Creates a C file, 'out.c' from 'file'
 
-    %prompt perlcc a.p b.p c.p -regex 's/\.p/\.exe'
-                                        # compiles into 'a.exe','b.exe','c.exe'.
+    $ perlcc -e 'print q//'     # Compiles a one-liner into 'a.out'
+    $ perlcc -c -e 'print q//'  # Creates a C file 'a.out.c'
 
-    %prompt perlcc a.p -log compilelog  # compiles into 'a', saves compilation
-                                        # info into compilelog, as well
-                                        # as mirroring to screen
+    $ perlcc -r hello           # compiles 'hello' into 'a.out', runs 'a.out'.
 
-    %prompt perlcc a.p -log compilelog -verbose cdf 
-                                        # compiles into 'a', saves compilation
-                                        # info into compilelog, being silent
-                                        # on screen.
+    $ perlcc -r hello a b c     # compiles 'hello' into 'a.out', runs 'a.out'.
+                                # with arguments 'a b c' 
 
-    %prompt perlcc a.p -C a.c -gen      # generates C code (into a.c) and 
-                                        # stops without compile.
-
-    %prompt perlcc a.p -L ../lib a.c 
-                                        # Compiles with the perl libraries 
-                                        # inside ../lib included.
+    $ perlcc hello -log c       # compiles 'hello' into 'a.out' logs compile
+                                # log into 'c'. 
 
 =head1 DESCRIPTION
 
-'perlcc' is the frontend into the perl compiler. Typing 'perlcc a.p'
-compiles the code inside a.p into a standalone executable, and 
-perlcc A.pm will compile into a shared object, A.so, suitable for inclusion 
-into a perl program via "use A".
+F<perlcc> creates standalone executables from Perl programs, using the
+code generators provided by the L<B> module. At present, you may
+either create executable Perl bytecode, using the C<-B> option, or 
+generate and compile C files using the standard and 'optimised' C
+backends.
 
-There are quite a few flags to perlcc which help with such issues as compiling 
-programs in bulk, testing compiled programs for compatibility with the 
-interpreter, and controlling.
+The code generated in this way is not guaranteed to work. The whole
+codegen suite (C<perlcc> included) should be considered B<very>
+experimental. Use for production purposes is strongly discouraged.
 
-=head1 OPTIONS 
+=head1 OPTIONS
 
 =over 4
 
-=item -L < library_directories >
-
-Adds directories in B<library_directories> to the compilation command.
-
-=item -I  < include_directories > 
-
-Adds directories inside B<include_directories> to the compilation command.
-
-=item -C   < c_code_name > 
-
-Explicitly gives the name B<c_code_name> to the generated file containing
-the C code which is to be compiled. Can only be used if compiling one file
-on the command line.
-
-=item -o   < executable_name >
-
-Explicitly gives the name B<executable_name> to the executable which is to be
-compiled. Can only be used if compiling one file on the command line.
-
-=item -e   < perl_line_to_execute>
-
-Compiles 'one liners', in the same way that B<perl -e> runs text strings at 
-the command line. Default is to have the 'one liner' be compiled, and run all
-in one go (see B<-run>); giving the B<-o> flag saves the resultant executable, 
-rather than throwing it away. Use '-argv' to pass arguments to the executable
-created.
-
-=item -b
+=item -LI<library directories>
 
-Generates bytecode instead of C code.
+Adds the given directories to the library search path when C code is
+passed to your C compiler.
 
-=item -opt
+=item -II<include directories>
 
-Uses the optimized C backend (C<B::CC>)rather than the simple C backend
-(C<B::C>).  Beware that the optimized C backend creates very large
-switch structures and structure initializations.  Many C compilers
-find it a challenge to compile the resulting output in finite amounts
-of time.  Many Perl features such as C<goto LABEL> are also not
-supported by the optimized C backend.  The simple C backend should
-work in more instances, but can only offer modest speed increases.
+Adds the given directories to the include file search path when C code is
+passed to your C compiler; when using the Perl bytecode option, adds the
+given directories to Perl's include path.
 
-=item -regex   <rename_regex>
+=item -o I<output file name>
 
-Gives a rule B<rename_regex> - which is a legal perl regular expression - to 
-create executable file names.
+Specifies the file name for the final compiled executable.
 
-=item -verbose <verbose_level>
+=item -c I<C file name>
 
-Show exactly what steps perlcc is taking to compile your code. You can
-change the verbosity level B<verbose_level> much in the same way that
-the C<-D> switch changes perl's debugging level, by giving either a
-number which is the sum of bits you want or a list of letters
-representing what you wish to see. Here are the verbosity levels so
-far :
+Create C code only; do not compile to a standalone binary.
 
-    Bit 1(g):      Code Generation Errors to STDERR
-    Bit 2(a):      Compilation Errors to STDERR
-    Bit 4(t):      Descriptive text to STDERR 
-    Bit 8(f):      Code Generation Errors to file (B<-log> flag needed)
-    Bit 16(c):     Compilation Errors to file (B<-log> flag needed)
-    Bit 32(d):     Descriptive text to file (B<-log> flag needed) 
+=item -e I<perl code>
 
-If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring 
-all of perlcc's output to both the screen and to a log file). If no B<-log>
-tag is given, then the default verbose level is 7 (ie: outputting all of 
-perlcc's output to STDERR).
+Compile a one-liner, much the same as C<perl -e '...'>
 
-NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
-both a file, and to the screen! Suggestions are welcome on how to overcome this
-difficulty, but for now it simply does not work properly, and hence will only go
-to the screen.
+=item -S
 
-=item -log <logname>
+Do not delete generated C code after compilation.
 
-Opens, for append, a logfile to save some or all of the text for a given 
-compile command. No rewrite version is available, so this needs to be done 
-manually.
+=item -B
 
-=item -argv <arguments>
+Use the Perl bytecode code generator.
 
-In combination with C<-run> or C<-e>, tells perlcc to run the resulting 
-executable with the string B<arguments> as @ARGV.
+=item -O
 
-=item -sav
+Use the 'optimised' C code generator. This is more experimental than
+everything else put together, and the code created is not guaranteed to
+compile in finite time and memory, or indeed, at all.
 
-Tells perl to save the intermediate C code. Usually, this C code is the name
-of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
-for example. If used with the C<-e> operator, you need to tell perlcc where to 
-save resulting executables.
+=item -v
 
-=item -gen
+Increase verbosity of output; can be repeated for more verbose output.
 
-Tells perlcc to only create the intermediate C code, and not compile the 
-results. Does an implicit B<-sav>, saving the C code rather than deleting it.
+=item -r 
 
-=item -run
+Run the resulting compiled script after compiling it.
 
-Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE 
-B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS 
-ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
+=item -log
 
-=item -prog
-
-Indicate that the programs at the command line are programs, and should be
-compiled as such. B<perlcc> will automatically determine files to be 
-programs if they have B<.p>, B<.pl>, B<.bat> extensions.
-
-=item -mod
-
-Indicate that the programs at the command line are modules, and should be
-compiled as such. B<perlcc> will automatically determine files to be 
-modules if they have the extension B<.pm>.
+Log the output of compiling to a file rather than to stdout.
 
 =back
 
-=head1 ENVIRONMENT
-
-Most of the work of B<perlcc> is done at the command line. However, you can 
-change the heuristic which determines what is a module and what is a program.
-As indicated above, B<perlcc> assumes that the extensions:
-
-.p$, .pl$, and .bat$
-
-indicate a perl program, and:
-
-.pm$
-
-indicate a library, for the purposes of creating executables. And furthermore,
-by default, these extensions will be replaced (and dropped) in the process of 
-creating an executable. 
-
-To change the extensions which are programs, and which are modules, set the
-environmental variables:
-
-PERL_SCRIPT_EXT
-PERL_MODULE_EXT
-
-These two environmental variables take colon-separated, legal perl regular 
-expressions, and are used by perlcc to decide which objects are which. 
-For example:
-
-setenv PERL_SCRIPT_EXT  '.prl$:.perl$'
-prompt%   perlcc sample.perl
-
-will compile the script 'sample.perl' into the executable 'sample', and
-
-setenv PERL_MODULE_EXT  '.perlmod$:.perlmodule$'
-
-prompt%   perlcc sample.perlmod
-
-will  compile the module 'sample.perlmod' into the shared object 
-'sample.so'
-
-NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
-is a literal '.', and not a wild-card. To get a true wild-card, you need to 
-backslash the '.'; as in:
-
-setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
-
-which would have the effect of compiling ANYTHING (except what is in 
-PERL_MODULE_EXT) into an executable with 5 less characters in its name.
-
-The PERLCC_OPTS environment variable can be set to the default flags
-that must be used by the compiler.
-
-The PERLCC_TIMEOUT environment variable can be set to the number of
-seconds to wait for the backends before giving up.  This is sometimes
-necessary to avoid some compilers taking forever to compile the
-generated output.  May not work on Windows and similar platforms.
-
-=head1 FILES
-
-'perlcc' uses a temporary file when you use the B<-e> option to evaluate 
-text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
-perlc$$.p.c, and the temporary executable is perlc$$.
-
-When you use '-run' and don't save your executable, the temporary executable is
-perlc$$
-
-=head1 BUGS
-
-The whole compiler suite (C<perlcc> included) should be considered very
-experimental.  Use for production purposes is strongly discouraged.
-
-perlcc currently cannot compile shared objects on Win32. This should be fixed
-in future.
-
-Bugs in the various compiler backends still exist, and are perhaps too
-numerous to list here.
-
 =cut
 
 !NO!SUBS!
diff --git a/contrib/perl5/utils/perldoc.PL b/contrib/perl5/utils/perldoc.PL
index 32421d7..cfb773e 100644
--- a/contrib/perl5/utils/perldoc.PL
+++ b/contrib/perl5/utils/perldoc.PL
@@ -36,8 +36,15 @@ use strict;
 # make sure creat()s are neither too much nor too little
 INIT { eval { umask(0077) } }   # doubtless someone has no mask
 
+(my \$pager = <<'/../') =~ s/\\s*\\z//;
+$Config{pager}
+/../
 my \@pagers = ();
-push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
+push \@pagers, \$pager if -x \$pager;
+
+(my \$bindir = <<'/../') =~ s/\\s*\\z//;
+$Config{scriptdir}
+/../
 
 !GROK!THIS!
 
@@ -48,6 +55,7 @@ print OUT <<'!NO!SUBS!';
 use Fcntl;    # for sysopen
 use Getopt::Std;
 use Config '%Config';
+use File::Spec::Functions qw(catfile splitdir);
 
 #
 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
@@ -79,6 +87,7 @@ my $global_target = "";
 my $Is_VMS = $^O eq 'VMS';
 my $Is_MSWin32 = $^O eq 'MSWin32';
 my $Is_Dos = $^O eq 'dos';
+my $Is_OS2 = $^O eq 'os2';
 
 sub usage{
     warn "@_\n" if @_;
@@ -147,7 +156,7 @@ usage if $opt_h;
 
 # refuse to run if we should be tainting and aren't
 # (but regular users deserve protection too, though!)
-if (!($Is_VMS || $Is_MSWin32 || $Is_Dos) && ($> == 0 || $< == 0)
+if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0)
      && !am_taint_checking()) 
 {{
     if ($opt_U) {
@@ -201,8 +210,9 @@ if (-f "Makefile.PL") {
     eval q{ use lib qw(. lib); 1; } or die;
 
     # don't add if superuser
-    if ($< && $>) {   # don't be looking too hard now!
-	eval q{ use blib; 1 } or die;
+    if ($< && $> && -f "blib") {   # don't be looking too hard now!
+	eval q{ use blib; 1 };
+	warn $@ if $@ && $opt_v;
     }
 }
 
@@ -223,7 +233,7 @@ sub containspod {
 
 sub minus_f_nocase {
      my($dir,$file) = @_;
-     my $path = join('/',$dir,$file);	# XXX: dirseps
+     my $path = catfile($dir,$file);
      return $path if -f $path and -r _;
      if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
         # on a case-forgiving file system or if case is important
@@ -237,13 +247,13 @@ sub minus_f_nocase {
      local($")="/";
      my @p = ($dir);
      my($p,$cip);
-     foreach $p (split(m!/!, $file)){	# XXX: dirseps
-	my $try = "@p/$p";
+     foreach $p (splitdir $file){
+	my $try = catfile @p, $p;
 	stat $try;
  	if (-d _) {
  	    push @p, $p;
 	    if ( $p eq $global_target) {
-		my $tmp_path = join ('/', @p);  # XXX: dirseps
+		my $tmp_path = catfile @p;
 		my $path_f = 0;
 		for (@global_found) {
 		    $path_f = 1 if $_ eq $tmp_path;
@@ -302,7 +312,7 @@ sub searchfor {
     my $ret;
     my $i;
     my $dir;
-    $global_target = (split(m!/!, $s))[-1];   # XXX: dirseps
+    $global_target = (splitdir $s)[-1];   # XXX: why not use File::Basename?
     for ($i=0; $i<@dirs; $i++) {
 	$dir = $dirs[$i];
 	($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
@@ -325,10 +335,10 @@ sub searchfor {
 
 	if ($recurse) {
 	    opendir(D,$dir)	or die "Can't opendir $dir: $!";
-	    my @newdirs = map "$dir/$_", grep {  # XXX: dirseps
+	    my @newdirs = map catfile($dir, $_), grep {
 		not /^\.\.?\z/s and
 		not /^auto\z/s  and   # save time! don't search auto dirs
-		-d  "$dir/$_"  # XXX: dirseps
+		-d  catfile($dir, $_)
 	    } readdir D;
 	    closedir(D)		or die "Can't closedir $dir: $!";
 	    next unless @newdirs;
@@ -362,7 +372,7 @@ sub printout {
 	close OUT   or die "can't close $tmp: $!";
     }
     elsif (not $opt_u) {
-	my $cmd = "pod2man --lax $file | $opt_n -man";
+	my $cmd = catfile($bindir, 'pod2man') . " --lax $file | $opt_n -man";
 	$cmd .= " | col -x" if $^O =~ /hpux/;
 	my $rslt = `$cmd`;
 	$rslt = filter_nroff($rslt) if $filter;
@@ -406,7 +416,11 @@ sub page {
     }
     else {
 	foreach my $pager (@pagers) {
-	    last if system("$pager $tmp") == 0;
+          if ($Is_VMS) {
+           last if system("$pager $tmp") == 0; # quoting prevents logical expansion
+          } else {
+	    last if system("$pager \"$tmp\"") == 0;
+          }
 	}
     }
 }
@@ -425,8 +439,7 @@ sub cleanup {
 my @found;
 foreach (@pages) {
     if ($podidx && open(PODIDX, $podidx)) {
-	my $searchfor = $_;
-	$searchfor =~ s,::,/,g;	    # XXX: dirseps
+	my $searchfor = catfile split '::';
 	print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
 	local $_;
 	while (<PODIDX>) {
@@ -437,9 +450,9 @@ foreach (@pages) {
 	next;
     }
     print STDERR "Searching for $_\n" if $opt_v;
-    # We must look both in @INC for library modules and in PATH
+    # We must look both in @INC for library modules and in $bindir
     # for executables, like h2xs or perldoc itself.
-    my @searchdirs = @INC;
+    my @searchdirs = ($bindir, @INC);
     if ($opt_F) {
 	next unless -r;
 	push @found, $_ if $opt_m or containspod($_);
@@ -553,7 +566,10 @@ eval q{
     sub END { cleanup($tmp, $buffer) } 
     1;
 } || die;
-eval q{ use sigtrap qw(die INT TERM HUP QUIT) };
+
+# exit/die in a windows sighandler is dangerous, so let it do the
+# default thing, which is to exit
+eval q{ use sigtrap qw(die INT TERM HUP QUIT) } unless $^O eq 'MSWin32';
 
 if ($opt_m) {
     foreach my $pager (@pagers) {
@@ -790,7 +806,7 @@ One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
 
 =head1 VERSION
 
-This is perldoc v2.01.
+This is perldoc v2.03.
 
 =head1 AUTHOR
 
@@ -802,6 +818,9 @@ and others.
 =cut
 
 #
+# Version 2.03: Sun Apr 23 16:56:34 BST 2000
+#	Hugo van der Sanden <hv@crypt0.demon.co.uk>
+#	don't die when 'use blib' fails
 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
 #       Tom Christiansen <tchrist@perl.com>
 #	Added -U insecurity option