Resolve conflicts for perl 5.8.2, remove old files, and add OpenBSD-specific scaffolding

85 files changed, 15550 insertions, 9466 deletions

diff --git a/gnu/usr.bin/perl/lib/AutoLoader.pm b/gnu/usr.bin/perl/lib/AutoLoader.pm
index b42d5ff4b68..4352d8b1fbe 100644
--- a/gnu/usr.bin/perl/lib/AutoLoader.pm
+++ b/gnu/usr.bin/perl/lib/AutoLoader.pm
@@ -1,7 +1,9 @@
 package AutoLoader;
 
+use strict;
 use 5.006_001;
-our(@EXPORT, @EXPORT_OK, $VERSION);
+
+our($VERSION, $AUTOLOAD);
 
 my $is_dosish;
 my $is_epoc;
@@ -9,14 +11,11 @@ my $is_vms;
 my $is_macos;
 
 BEGIN {
-    require Exporter;
-    @EXPORT = @EXPORT = ();
-    @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD);
     $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
     $is_epoc = $^O eq 'epoc';
     $is_vms = $^O eq 'VMS';
     $is_macos = $^O eq 'MacOS';
-    $VERSION = '5.59';
+    $VERSION = '5.60';
 }
 
 AUTOLOAD {
@@ -93,22 +92,24 @@ AUTOLOAD {
     eval { local $SIG{__DIE__}; require $filename };
     if ($@) {
 	if (substr($sub,-9) eq '::DESTROY') {
+	    no strict 'refs';
 	    *$sub = sub {};
-	} else {
+	    $@ = undef;
+	} elsif ($@ =~ /^Can't locate/) {
 	    # The load might just have failed because the filename was too
 	    # long for some old SVR3 systems which treat long names as errors.
-	    # If we can succesfully truncate a long name then it's worth a go.
+	    # If we can successfully truncate a long name then it's worth a go.
 	    # There is a slight risk that we could pick up the wrong file here
 	    # but autosplit should have warned about that when splitting.
 	    if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
 		eval { local $SIG{__DIE__}; require $filename };
 	    }
-	    if ($@){
-		$@ =~ s/ at .*\n//;
-		my $error = $@;
-		require Carp;
-		Carp::croak($error);
-	    }
+	}
+	if ($@){
+	    $@ =~ s/ at .*\n//;
+	    my $error = $@;
+	    require Carp;
+	    Carp::croak($error);
 	}
     }
     $@ = $save;
@@ -124,8 +125,9 @@ sub import {
     #
 
     if ($pkg eq 'AutoLoader') {
-      local $Exporter::ExportLevel = 1;
-      Exporter::import $pkg, @_;
+	no strict 'refs';
+	*{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD
+	    if @_ and $_[0] =~ /^&?AUTOLOAD$/;
     }
 
     #
@@ -166,8 +168,12 @@ sub import {
 }
 
 sub unimport {
-  my $callpkg = caller;
-  eval "package $callpkg; sub AUTOLOAD;";
+    my $callpkg = caller;
+
+    no strict 'refs';
+    my $symname = $callpkg . '::AUTOLOAD';
+    undef *{ $symname } if \&{ $symname } == \&AUTOLOAD;
+    *{ $symname } = \&{ $symname };
 }
 
 1;
diff --git a/gnu/usr.bin/perl/lib/AutoSplit.pm b/gnu/usr.bin/perl/lib/AutoSplit.pm
index 3c45d921132..e021e0fffdd 100644
--- a/gnu/usr.bin/perl/lib/AutoSplit.pm
+++ b/gnu/usr.bin/perl/lib/AutoSplit.pm
@@ -11,7 +11,7 @@ use strict;
 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen,
     $CheckForAutoloader, $CheckModTime);
 
-$VERSION = "1.0307";
+$VERSION = "1.04";
 @ISA = qw(Exporter);
 @EXPORT = qw(&autosplit &autosplit_lib_modules);
 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
@@ -148,10 +148,12 @@ if (defined (&Dos::UseLFN)) {
 my $Is_VMS = ($^O eq 'VMS');
 
 # allow checking for valid ': attrlist' attachments
-my $nested;
+# (we use 'our' rather than 'my' here, due to the rather complex and buggy
+# behaviour of lexicals with qr// and (??{$lex}) )
+our $nested;
 $nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
-my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
-my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+our $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
 
 
 
@@ -227,12 +229,12 @@ sub autosplit_file {
     # allow just a package name to be used
     $filename .= ".pm" unless ($filename =~ m/\.pm\z/);
 
-    open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
+    open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
     my($pm_mod_time) = (stat($filename))[9];
     my($autoloader_seen) = 0;
     my($in_pod) = 0;
     my($def_package,$last_package,$this_package,$fnr);
-    while (<IN>) {
+    while (<$in>) {
 	# Skip pod text.
 	$fnr++;
 	$in_pod = 1 if /^=\w/;
@@ -297,7 +299,8 @@ sub autosplit_file {
     my @cache = ();
     my $caching = 1;
     $last_package = '';
-    while (<IN>) {
+    my $out;
+    while (<$in>) {
 	$fnr++;
 	$in_pod = 1 if /^=\w/;
 	$in_pod = 0 if /^=cut/;
@@ -308,8 +311,9 @@ sub autosplit_file {
 	if (/^package\s+([\w:]+)\s*;/) {
 	    $this_package = $def_package = $1;
 	}
+
 	if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) {
-	    print OUT "# end of $last_package\::$subname\n1;\n"
+	    print $out "# end of $last_package\::$subname\n1;\n"
 		if $last_package;
 	    $subname = $1;
 	    my $proto = $2 || '';
@@ -329,18 +333,19 @@ sub autosplit_file {
 	    my($lpath) = catfile($modnamedir, "$lname.al");
 	    my($spath) = catfile($modnamedir, "$sname.al");
 	    my $path;
-	    if (!$Is83 and open(OUT, ">$lpath")){
+
+	    if (!$Is83 and open($out, ">$lpath")){
 	        $path=$lpath;
 		print "  writing $lpath\n" if ($Verbose>=2);
 	    } else {
-		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+		open($out, ">$spath") or die "Can't create $spath: $!\n";
 		$path=$spath;
 		print "  writing $spath (with truncated name)\n"
 			if ($Verbose>=1);
 	    }
 	    push(@outfiles, $path);
 	    my $lineno = $fnr - @cache;
-	    print OUT <<EOT;
+	    print $out <<EOT;
 # NOTE: Derived from $filename.
 # Changes made here will be lost when autosplit is run again.
 # See AutoSplit.pm.
@@ -348,30 +353,30 @@ package $this_package;
 
 #line $lineno "$filename (autosplit into $path)"
 EOT
-	    print OUT @cache;
+	    print $out @cache;
 	    @cache = ();
 	    $caching = 0;
 	}
 	if($caching) {
 	    push(@cache, $_) if @cache || /\S/;
 	} else {
-	    print OUT $_;
+	    print $out $_;
 	}
 	if(/^\}/) {
 	    if($caching) {
-		print OUT @cache;
+		print $out @cache;
 		@cache = ();
 	    }
-	    print OUT "\n";
+	    print $out "\n";
 	    $caching = 1;
 	}
 	$last_package = $this_package if defined $this_package;
     }
     if ($subname) {
-	print OUT @cache,"1;\n# end of $last_package\::$subname\n";
-	close(OUT);
+	print $out @cache,"1;\n# end of $last_package\::$subname\n";
+	close($out);
     }
-    close(IN);
+    close($in);
     
     if (!$keep){  # don't keep any obsolete *.al files in the directory
 	my(%outfiles);
@@ -391,8 +396,8 @@ EOT
 	    $outdirs{File::Basename::dirname($_)}||=1;
 	}
 	for my $dir (keys %outdirs) {
-	    opendir(OUTDIR,$dir);
-	    foreach (sort readdir(OUTDIR)){
+	    opendir(my $outdir,$dir);
+	    foreach (sort readdir($outdir)){
 		next unless /\.al\z/;
 		my($file) = catfile($dir, $_);
 		$file = lc $file if $Is83 or $Is_VMS;
@@ -402,25 +407,25 @@ EOT
 		do { $deleted += ($thistime = unlink $file) } while ($thistime);
 		carp "Unable to delete $file: $!" unless $deleted;
 	    }
-	    closedir(OUTDIR);
+	    closedir($outdir);
 	}
     }
 
-    open(TS,">$al_idx_file") or
+    open(my $ts,">$al_idx_file") or
 	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
-    print TS "# Index created by AutoSplit for $filename\n";
-    print TS "#    (file acts as timestamp)\n";
+    print $ts "# Index created by AutoSplit for $filename\n";
+    print $ts "#    (file acts as timestamp)\n";
     $last_package = '';
     for my $fqs (@subnames) {
 	my($subname) = $fqs;
 	$subname =~ s/.*:://;
-	print TS "package $package{$fqs};\n"
+	print $ts "package $package{$fqs};\n"
 	    unless $last_package eq $package{$fqs};
-	print TS "sub $subname $proto{$fqs};\n";
+	print $ts "sub $subname $proto{$fqs};\n";
 	$last_package = $package{$fqs};
     }
-    print TS "1;\n";
-    close(TS);
+    print $ts "1;\n";
+    close($ts);
 
     _check_unique($filename, $Maxlen, 1, @outfiles);
 
diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm
index cda764f6ca3..c472d58ffd6 100644
--- a/gnu/usr.bin/perl/lib/Benchmark.pm
+++ b/gnu/usr.bin/perl/lib/Benchmark.pm
@@ -1,5 +1,8 @@
 package Benchmark;
 
+use strict;
+
+
 =head1 NAME
 
 Benchmark - benchmark running times of Perl code
@@ -50,6 +53,9 @@ Benchmark - benchmark running times of Perl code
     $count = $t->iters ;
     print "$count loops of other code took:",timestr($t),"\n";
 
+    # enable hires wallclock timing if possible
+    use Benchmark ':hireswallclock';
+
 =head1 DESCRIPTION
 
 The Benchmark module encapsulates a number of routines to help you
@@ -196,7 +202,7 @@ Clear the cached time for COUNT rounds of the null loop.
 
 Clear all cached times.
 
-=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
+=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
 
 =item cmpthese ( RESULTSHASHREF, [ STYLE ] )
 
@@ -273,6 +279,15 @@ for passing to timestr().
 
 =back
 
+=head2 :hireswallclock
+
+If the Time::HiRes module has been installed, you can specify the
+special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not
+available, the tag will be silently ignored).  This tag will cause the
+wallclock time to be measured in microseconds, instead of integer
+seconds.  Note though that the speed computations are still conducted
+in CPU time, not wallclock time.
+
 =head1 NOTES
 
 The data is stored as a list of values from the time and times
@@ -395,10 +410,12 @@ style in. (so that 'none' will suppress output). Make sub new dump its
 debugging output to STDERR, to be consistent with everything else.
 All bugs found while writing a regression test.
 
+September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
+
 =cut
 
 # evaluate something in a clean lexical environment
-sub _doeval { eval shift }
+sub _doeval { no strict;  eval shift }
 
 #
 # put any lexicals at file scope AFTER here
@@ -406,42 +423,109 @@ sub _doeval { eval shift }
 
 use Carp;
 use Exporter;
-@ISA=(Exporter);
+
+our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
+
+@ISA=qw(Exporter);
 @EXPORT=qw(timeit timethis timethese timediff timestr);
 @EXPORT_OK=qw(timesum cmpthese countit
 	      clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 
-$VERSION = 1.04;
+$VERSION = 1.051;
+
+# --- ':hireswallclock' special handling
+
+my $hirestime;
+
+sub mytime () { time }
+
+init();
+
+sub BEGIN {
+    if (eval 'require Time::HiRes') {
+	import Time::HiRes qw(time);
+	$hirestime = \&Time::HiRes::time;
+    }
+}
+
+sub import {
+    my $class = shift;
+    if (grep { $_ eq ":hireswallclock" } @_) {
+	@_ = grep { $_ ne ":hireswallclock" } @_;
+	*mytime = $hirestime if defined $hirestime;
+    }
+    Benchmark->export_to_level(1, $class, @_);
+}
 
-&init;
+our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style,
+    %_Usage, %Cache, $Do_Cache);
 
 sub init {
-    $debug = 0;
-    $min_count = 4;
-    $min_cpu   = 0.4;
-    $defaultfmt = '5.2f';
-    $defaultstyle = 'auto';
+    $Debug = 0;
+    $Min_Count = 4;
+    $Min_CPU   = 0.4;
+    $Default_Format = '5.2f';
+    $Default_Style = 'auto';
     # The cache can cause a slight loss of sys time accuracy. If a
     # user does many tests (>10) with *very* large counts (>10000)
     # or works on a very slow machine the cache may be useful.
-    &disablecache;
-    &clearallcache;
+    disablecache();
+    clearallcache();
 }
 
-sub debug { $debug = ($_[1] != 0); }
+sub debug { $Debug = ($_[1] != 0); }
+
+sub usage { 
+    my $calling_sub = (caller(1))[3];
+    $calling_sub =~ s/^Benchmark:://;
+    return $_Usage{$calling_sub} || '';
+}
 
 # The cache needs two branches: 's' for strings and 'c' for code.  The
-# emtpy loop is different in these two cases.
-sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
-sub clearallcache { %cache = (); }
-sub enablecache   { $cache = 1; }
-sub disablecache  { $cache = 0; }
+# empty loop is different in these two cases.
+
+$_Usage{clearcache} = <<'USAGE';
+usage: clearcache($count);
+USAGE
+
+sub clearcache    { 
+    die usage unless @_ == 1;
+    delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"}; 
+}
+
+$_Usage{clearallcache} = <<'USAGE';
+usage: clearallcache();
+USAGE
+
+sub clearallcache { 
+    die usage if @_;
+    %Cache = (); 
+}
+
+$_Usage{enablecache} = <<'USAGE';
+usage: enablecache();
+USAGE
+
+sub enablecache   {
+    die usage if @_;
+    $Do_Cache = 1; 
+}
+
+$_Usage{disablecache} = <<'USAGE';
+usage: disablecache();
+USAGE
+
+sub disablecache  {
+    die usage if @_;
+    $Do_Cache = 0; 
+}
+
 
 # --- Functions to process the 'time' data type
 
-sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
-	  print STDERR "new=@t\n" if $debug;
+sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0);
+	  print STDERR "new=@t\n" if $Debug;
 	  bless \@t; }
 
 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
@@ -450,8 +534,16 @@ sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 sub iters { $_[0]->[5] ; }
 
+
+$_Usage{timediff} = <<'USAGE';
+usage: $result_diff = timediff($result1, $result2);
+USAGE
+
 sub timediff {
     my($a, $b) = @_;
+
+    die usage unless ref $a and ref $b;
+
     my @r;
     for (my $i=0; $i < @$a; ++$i) {
 	push(@r, $a->[$i] - $b->[$i]);
@@ -459,32 +551,48 @@ sub timediff {
     bless \@r;
 }
 
+$_Usage{timesum} = <<'USAGE';
+usage: $sum = timesum($result1, $result2);
+USAGE
+
 sub timesum {
-     my($a, $b) = @_;
-     my @r;
-     for (my $i=0; $i < @$a; ++$i) {
+    my($a, $b) = @_;
+
+    die usage unless ref $a and ref $b;
+
+    my @r;
+    for (my $i=0; $i < @$a; ++$i) {
  	push(@r, $a->[$i] + $b->[$i]);
-     }
-     bless \@r;
+    }
+    bless \@r;
 }
 
+
+$_Usage{timestr} = <<'USAGE';
+usage: $formatted_result = timestr($result1);
+USAGE
+
 sub timestr {
     my($tr, $style, $f) = @_;
+
+    die usage unless ref $tr;
+
     my @t = @$tr;
     warn "bad time value (@t)" unless @t==6;
     my($r, $pu, $ps, $cu, $cs, $n) = @t;
     my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
-    $f = $defaultfmt unless defined $f;
+    $f = $Default_Format unless defined $f;
     # format a time in the required style, other formats may be added here
-    $style ||= $defaultstyle;
+    $style ||= $Default_Style;
     return '' if $style eq 'none';
     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
     my $s = "@t $style"; # default for unknown style
-    $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
+    my $w = $hirestime ? "%2g" : "%2d";
+    $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
 			    $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
-    $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
+    $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
 			    $r,$pu,$ps,$pt) if $style eq 'noc';
-    $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
+    $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
 			    $r,$cu,$cs,$ct) if $style eq 'nop';
     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
     $s;
@@ -492,17 +600,21 @@ sub timestr {
 
 sub timedebug {
     my($msg, $t) = @_;
-    print STDERR "$msg",timestr($t),"\n" if $debug;
+    print STDERR "$msg",timestr($t),"\n" if $Debug;
 }
 
 # --- Functions implementing low-level support for timing loops
 
+$_Usage{runloop} = <<'USAGE';
+usage: runloop($number, [$string | $coderef])
+USAGE
+
 sub runloop {
     my($n, $c) = @_;
 
     $n+=0; # force numeric now, so garbage won't creep into the eval
     croak "negative loopcount $n" if $n<0;
-    confess "Usage: runloop(number, [string | coderef])" unless defined $c;
+    confess usage unless defined $c;
     my($t0, $t1, $td); # before, after, difference
 
     # find package of caller so we can execute code there
@@ -522,7 +634,7 @@ sub runloop {
         $subref  = _doeval($subcode);
     }
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
-    print STDERR "runloop $n '$subcode'\n" if $debug;
+    print STDERR "runloop $n '$subcode'\n" if $Debug;
 
     # Wait for the user timer to tick.  This makes the error range more like 
     # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This
@@ -539,21 +651,28 @@ sub runloop {
     $td;
 }
 
+$_Usage{timeit} = <<'USAGE';
+usage: $result = timeit($count, 'code' );        or
+       $result = timeit($count, sub { code } );
+USAGE
 
 sub timeit {
     my($n, $code) = @_;
     my($wn, $wc, $wd);
 
-    printf STDERR "timeit $n $code\n" if $debug;
+    die usage unless defined $code and
+                     (!ref $code or ref $code eq 'CODE');
+
+    printf STDERR "timeit $n $code\n" if $Debug;
     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
-    if ($cache && exists $cache{$cache_key} ) {
-	$wn = $cache{$cache_key};
+    if ($Do_Cache && exists $Cache{$cache_key} ) {
+	$wn = $Cache{$cache_key};
     } else {
 	$wn = &runloop($n, ref( $code ) ? sub { } : '' );
 	# Can't let our baseline have any iterations, or they get subtracted
 	# out of the result.
 	$wn->[5] = 0;
-	$cache{$cache_key} = $wn;
+	$Cache{$cache_key} = $wn;
     }
 
     $wc = &runloop($n, $code);
@@ -571,9 +690,16 @@ my $default_for = 3;
 my $min_for     = 0.1;
 
 
+$_Usage{countit} = <<'USAGE';
+usage: $result = countit($time, 'code' );        or
+       $result = countit($time, sub { code } );
+USAGE
+
 sub countit {
     my ( $tmax, $code ) = @_;
 
+    die usage unless @_;
+
     if ( not defined $tmax or $tmax == 0 ) {
 	$tmax = $default_for;
     } elsif ( $tmax < 0 ) {
@@ -650,16 +776,24 @@ sub n_to_for {
     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 }
 
+$_Usage{timethis} = <<'USAGE';
+usage: $result = timethis($time, 'code' );        or
+       $result = timethis($time, sub { code } );
+USAGE
+
 sub timethis{
     my($n, $code, $title, $style) = @_;
-    my($t, $for, $forn);
+    my($t, $forn);
+
+    die usage unless defined $code and
+                     (!ref $code or ref $code eq 'CODE');
 
     if ( $n > 0 ) {
 	croak "non-integer loopcount $n, stopped" if int($n)<$n;
 	$t = timeit($n, $code);
 	$title = "timethis $n" unless defined $title;
     } else {
-	$fort  = n_to_for( $n );
+	my $fort  = n_to_for( $n );
 	$t     = countit( $fort, $code );
 	$title = "timethis for $fort" unless defined $title;
 	$forn  = $t->[-1];
@@ -667,7 +801,7 @@ sub timethis{
     local $| = 1;
     $style = "" unless defined $style;
     printf("%10s: ", $title) unless $style eq 'none';
-    print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
+    print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none';
 
     $n = $forn if defined $forn;
 
@@ -675,16 +809,22 @@ sub timethis{
     # Don't assume that your benchmark is ok simply because
     # you don't get this warning!
     print "            (warning: too few iterations for a reliable count)\n"
-	if     $n < $min_count
+	if     $n < $Min_Count
 	    || ($t->real < 1 && $n < 1000)
-	    || $t->cpu_a < $min_cpu;
+	    || $t->cpu_a < $Min_CPU;
     $t;
 }
 
+
+$_Usage{timethese} = <<'USAGE';
+usage: timethese($count, { Name1 => 'code1', ... });        or
+       timethese($count, { Name1 => sub { code1 }, ... });
+USAGE
+
 sub timethese{
     my($n, $alt, $style) = @_;
-    die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
-		unless ref $alt eq HASH;
+    die usage unless ref $alt eq 'HASH';
+
     my @names = sort keys %$alt;
     $style = "" unless defined $style;
     print "Benchmark: " unless $style eq 'none';
@@ -712,8 +852,27 @@ sub timethese{
     return \%results;
 }
 
+
+$_Usage{cmpthese} = <<'USAGE';
+usage: cmpthese($count, { Name1 => 'code1', ... });        or
+       cmpthese($count, { Name1 => sub { code1 }, ... });  or
+       cmpthese($result, $style);
+USAGE
+
 sub cmpthese{
-    my ($results, $style) = ref $_[0] ? @_ : ( timethese( @_[0,1,2] ), $_[2] ) ;
+    my ($results, $style);
+
+    if( ref $_[0] ) {
+        ($results, $style) = @_;
+    }
+    else {
+        my($count, $code) = @_[0,1];
+        $style = $_[2] if defined $_[2];
+
+        die usage unless ref $code eq 'HASH';
+
+        $results = timethese($count, $code, ($style || "none"));
+    }
 
     $style = "" unless defined $style;
 
@@ -761,28 +920,28 @@ sub cmpthese{
 	my $row_rate = $row_val->[7];
 
 	# We assume that we'll never get a 0 rate.
-	my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
+	my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;
 
 	# Only give a few decimal places before switching to sci. notation,
 	# since the results aren't usually that accurate anyway.
 	my $format = 
-	   $a >= 100 ? 
+	   $rate >= 100 ? 
 	       "%0.0f" : 
-	   $a >= 10 ?
+	   $rate >= 10 ?
 	       "%0.1f" :
-	   $a >= 1 ?
+	   $rate >= 1 ?
 	       "%0.2f" :
-	   $a >= 0.1 ?
+	   $rate >= 0.1 ?
 	       "%0.3f" :
 	       "%0.2e";
 
 	$format .= "/s"
 	    if $display_as_rate;
-	# Using $b here due to optimizing bug in _58 through _61
-	my $b = sprintf( $format, $a );
-	push @row, $b;
-	$col_widths[1] = length( $b )
-	    if length( $b ) > $col_widths[1];
+
+	my $formatted_rate = sprintf( $format, $rate );
+	push @row, $formatted_rate;
+	$col_widths[1] = length( $formatted_rate )
+	    if length( $formatted_rate ) > $col_widths[1];
 
         # Columns 2..N = performance ratios
 	my $skip_rest = 0;
diff --git a/gnu/usr.bin/perl/lib/CGI.pm b/gnu/usr.bin/perl/lib/CGI.pm
index 88d8445e6a5..96bba36edf5 100644
--- a/gnu/usr.bin/perl/lib/CGI.pm
+++ b/gnu/usr.bin/perl/lib/CGI.pm
@@ -18,8 +18,8 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.6 2003/07/23 01:42:49 millert Exp $';
-$CGI::VERSION='2.98';
+$CGI::revision = '$Id: CGI.pm,v 1.7 2003/12/03 03:02:35 millert Exp $ + patches by merlyn';
+$CGI::VERSION='3.00';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1639,12 +1639,11 @@ sub startform {
     $method = lc($method) || 'post';
     $enctype = $enctype || &URL_ENCODED;
     unless (defined $action) {
-       $action = $self->url(-absolute=>1,-path=>1);
+       $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1));
        if (length($ENV{QUERY_STRING})>0) {
-           $action .= "?$ENV{QUERY_STRING}";
+           $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1);
        }
     }
-    $action =~ s/\"/%22/g;  # fix cross-site scripting bug reported by obscure
     $action = qq(action="$action");
     my($other) = @other ? " @other" : '';
     $self->{'.parametersToAdd'}={};
@@ -3584,10 +3583,12 @@ END_OF_AUTOLOAD
 ####################################################################################
 package CGITempFile;
 
-$SL = $CGI::SL;
-$MAC = $CGI::OS eq 'MACINTOSH';
-my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
-unless ($TMPDIRECTORY) {
+sub find_tempdir {
+  undef $TMPDIRECTORY;
+  $SL = $CGI::SL;
+  $MAC = $CGI::OS eq 'MACINTOSH';
+  my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
+  unless ($TMPDIRECTORY) {
     @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
 	   "C:${SL}temp","${SL}tmp","${SL}temp",
 	   "${vol}${SL}Temporary Items",
@@ -3605,11 +3606,14 @@ unless ($TMPDIRECTORY) {
     # unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
 
     foreach (@TEMP) {
-	do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
+      do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
     }
+  }
+  $TMPDIRECTORY  = $MAC ? "" : "." unless $TMPDIRECTORY;
 }
 
-$TMPDIRECTORY  = $MAC ? "" : "." unless $TMPDIRECTORY;
+find_tempdir();
+
 $MAXTRIES = 5000;
 
 # cute feature, but overload implementation broke it
@@ -3634,6 +3638,7 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
 sub new {
     my($package,$sequence) = @_;
     my $filename;
+    find_tempdir() unless -w $TMPDIRECTORY;
     for (my $i = 0; $i < $MAXTRIES; $i++) {
 	last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
     }
@@ -4941,7 +4946,7 @@ Generate just the protocol and net location, as in http://www.foo.com:8000
 
 =head2 MIXING POST AND URL PARAMETERS
 
-   $color = $query-&gt;url_param('color');
+   $color = $query->url_param('color');
 
 It is possible for a script to receive CGI parameters in the URL as
 well as in the fill-out form by creating a form that POSTs to a URL
@@ -5696,6 +5701,8 @@ a pointer to an associative array relating menu values to another
 associative array with the attribute's name as the key and the
 attribute's value as the value.
 
+=back
+
 =head2 CREATING A SCROLLING LIST
 
    print $query->scrolling_list('list_name',
diff --git a/gnu/usr.bin/perl/lib/CGI/Carp.pm b/gnu/usr.bin/perl/lib/CGI/Carp.pm
index 8420eb2d67a..b99004189d3 100644
--- a/gnu/usr.bin/perl/lib/CGI/Carp.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Carp.pm
@@ -440,13 +440,13 @@ and the time and date of the error.
 END
   ;
   my $mod_perl = exists $ENV{MOD_PERL};
-  print STDOUT "Content-type: text/html\n\n" 
-    unless $mod_perl;
 
   warningsToBrowser(1);    # emit warnings before dying
 
   if ($CUSTOM_MSG) {
     if (ref($CUSTOM_MSG) eq 'CODE') {
+      print STDOUT "Content-type: text/html\n\n" 
+        unless $mod_perl;
       &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
       return;
     } else {
@@ -490,7 +490,13 @@ END
       $r->custom_response(500,$mess);
     }
   } else {
-    print STDOUT $mess;
+    if (eval{tell STDOUT}) {
+        print STDOUT $mess;
+    }
+    else {
+        print STDOUT "Content-type: text/html\n\n";
+        print STDOUT $mess;
+    }
   }
 }
 
diff --git a/gnu/usr.bin/perl/lib/CGI/Fast.pm b/gnu/usr.bin/perl/lib/CGI/Fast.pm
index 669b38e0100..5f744e3584c 100644
--- a/gnu/usr.bin/perl/lib/CGI/Fast.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Fast.pm
@@ -16,7 +16,7 @@ package CGI::Fast;
 # The most recent version and complete docs are available at:
 #   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
 #   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.04';
+$CGI::Fast::VERSION='1.041';
 
 use CGI;
 use FCGI;
@@ -187,7 +187,7 @@ documentation for C<FCGI::OpenSocket> for more information.)
 =item FCGI_SOCKET_PATH
 
 The address (TCP/IP) or path (UNIX Domain) of the socket the external FastCGI
-script to which bind an listen for incoming connections from the web server.
+script to which bind can listen for incoming connections from the web server.
 
 =item FCGI_LISTEN_QUEUE
 
diff --git a/gnu/usr.bin/perl/lib/CGI/Util.pm b/gnu/usr.bin/perl/lib/CGI/Util.pm
index 60eeb186fe1..e0e7a842283 100644
--- a/gnu/usr.bin/perl/lib/CGI/Util.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Util.pm
@@ -6,7 +6,7 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
 
-$VERSION = '1.3';
+$VERSION = '1.31';
 
 $EBCDIC = "\t" ne "\011";
 if ($EBCDIC) {
@@ -167,7 +167,7 @@ sub utf8_chr ($) {
 
         } elsif ($c < 0x80000000) {
                 return sprintf("%c%c%c%c%c%c",
-                                           0xfe |  ($c >> 30),
+                                           0xfc |  ($c >> 30),
                                            0x80 | (($c >> 24) & 0x3f),
                                            0x80 | (($c >> 18) & 0x3f),
                                            0x80 | (($c >> 12) & 0x3f),
diff --git a/gnu/usr.bin/perl/lib/CPAN.pm b/gnu/usr.bin/perl/lib/CPAN.pm
index dc296606a47..c2360c81f65 100644
--- a/gnu/usr.bin/perl/lib/CPAN.pm
+++ b/gnu/usr.bin/perl/lib/CPAN.pm
@@ -1,11 +1,12 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.61';
-# $Id: CPAN.pm,v 1.5 2002/10/27 22:25:25 millert Exp $
+$VERSION = '1.76_01';
+$VERSION = eval $VERSION;
+# $Id: CPAN.pm,v 1.6 2003/12/03 03:02:35 millert Exp $
 
 # only used during development:
 $Revision = "";
-# $Revision = "[".substr(q$Revision: 1.5 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.6 $, 10)."]";
 
 use Carp ();
 use Config ();
@@ -112,6 +113,20 @@ sub shell {
 	    $readline::rl_completion_function =
 		$readline::rl_completion_function = 'CPAN::Complete::cpl';
 	}
+        if (my $histfile = $CPAN::Config->{'histfile'}) {{
+            unless ($term->can("AddHistory")) {
+                $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
+                last;
+            }
+            my($fh) = FileHandle->new;
+            open $fh, "<$histfile" or last;
+            local $/ = "\n";
+            while (<$fh>) {
+                chomp;
+                $term->AddHistory($_);
+            }
+            close $fh;
+        }}
 	# $term->OUT is autoflushed anyway
 	my $odef = select STDERR;
 	$| = 1;
@@ -267,6 +282,28 @@ package CPAN::Bundle;
 package CPAN::Module;
 @CPAN::Module::ISA = qw(CPAN::InfoObj);
 
+package CPAN::Exception::RecursiveDependency;
+use overload '""' => "as_string";
+
+sub new {
+    my($class) = shift;
+    my($deps) = shift;
+    my @deps;
+    my %seen;
+    for my $dep (@$deps) {
+        push @deps, $dep;
+        last if $seen{$dep}++;
+    }
+    bless { deps => \@deps }, $class;
+}
+
+sub as_string {
+    my($self) = shift;
+    "\nRecursive dependency detected:\n    " .
+        join("\n => ", @{$self->{deps}}) .
+            ".\nCannot continue.\n";
+}
+
 package CPAN::Shell;
 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
 @CPAN::Shell::ISA = qw(CPAN::Debug);
@@ -765,27 +802,47 @@ sub cleanup {
   my($message) = @_;
   my $i = 0;
   my $ineval = 0;
-  if (
-      0 &&           # disabled, try reload cpan with it
-      $] > 5.004_60  # thereabouts
-     ) {
-    $ineval = $^S;
-  } else {
-    my($subroutine);
-    while ((undef,undef,undef,$subroutine) = caller(++$i)) {
+  my($subroutine);
+  while ((undef,undef,undef,$subroutine) = caller(++$i)) {
       $ineval = 1, last if
 	  $subroutine eq '(eval)';
-    }
   }
   return if $ineval && !$End;
-  return unless defined $META->{LOCK}; # unsafe meta access, ok
-  return unless -f $META->{LOCK}; # unsafe meta access, ok
-  unlink $META->{LOCK}; # unsafe meta access, ok
+  return unless defined $META->{LOCK};
+  return unless -f $META->{LOCK};
+  $META->savehist;
+  unlink $META->{LOCK};
   # require Carp;
   # Carp::cluck("DEBUGGING");
   $CPAN::Frontend->mywarn("Lockfile removed.\n");
 }
 
+#-> sub CPAN::savehist
+sub savehist {
+    my($self) = @_;
+    my($histfile,$histsize);
+    unless ($histfile = $CPAN::Config->{'histfile'}){
+        $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
+        return;
+    }
+    $histsize = $CPAN::Config->{'histsize'} || 100;
+    if ($CPAN::term){
+        unless ($CPAN::term->can("GetHistory")) {
+            $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
+            return;
+        }
+    } else {
+        return;
+    }
+    my @h = $CPAN::term->GetHistory;
+    splice @h, 0, @h-$histsize if @h>$histsize;
+    my($fh) = FileHandle->new;
+    open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
+    local $\ = local $, = "\n";
+    print $fh @h;
+    close $fh;
+}
+
 sub is_tested {
     my($self,$what) = @_;
     $self->{is_tested}{$what} = 1;
@@ -1340,7 +1397,7 @@ sub ls      {
     my @accept;
     for (@arg) {
         unless (/^[A-Z\-]+$/i) {
-            $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author");
+            $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
             next;
         }
         push @accept, uc $_;
@@ -1389,7 +1446,8 @@ sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
 
 #-> sub CPAN::Shell::m ;
 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
-    $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+    my $self = shift;
+    $CPAN::Frontend->myprint($self->format_result('Module',@_));
 }
 
 #-> sub CPAN::Shell::i ;
@@ -1510,7 +1568,7 @@ Known options:
 sub paintdots_onreload {
     my($ref) = shift;
     sub {
-	if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) {
+	if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
 	    my($subr) = $1;
 	    ++$$ref;
 	    local($|) = 1;
@@ -1528,14 +1586,17 @@ sub reload {
     $command ||= "";
     $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
     if ($command =~ /cpan/i) {
-	CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
-	my $fh = FileHandle->new($INC{'CPAN.pm'});
-	local($/);
-	my $redef = 0;
-	local($SIG{__WARN__}) = paintdots_onreload(\$redef);
-	eval <$fh>;
-	warn $@ if $@;
-	$CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+        for my $f (qw(CPAN.pm CPAN/FirstTime.pm)) {
+            next unless $INC{$f};
+            CPAN->debug("reloading the whole $f") if $CPAN::DEBUG;
+            my $fh = FileHandle->new($INC{$f});
+            local($/);
+            my $redef = 0;
+            local($SIG{__WARN__}) = paintdots_onreload(\$redef);
+            eval <$fh>;
+            warn $@ if $@;
+            $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+        }
     } elsif ($command =~ /index/) {
       CPAN::Index->force_reload;
     } else {
@@ -1929,6 +1990,8 @@ sub print_ornamented {
 	    print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
 	}
     } else {
+        # chomp $what;
+        # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
 	print $what;
     }
 }
@@ -2020,8 +2083,8 @@ sub rematein {
             push @qcopy, $obj;
 	} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
 	    $obj = $CPAN::META->instance('CPAN::Author',$s);
-            if ($meth eq "dump") {
-                $obj->dump;
+            if ($meth =~ /^(dump|ls)$/) {
+                $obj->$meth();
             } else {
                 $CPAN::Frontend->myprint(
                                          join "",
@@ -2125,7 +2188,7 @@ sub get_basic_credentials {
     return unless $proxy;
     if ($USER && $PASSWD) {
     } elsif (defined $CPAN::Config->{proxy_user} &&
-        defined $CPAN::Config->{proxy_pass}) {
+             defined $CPAN::Config->{proxy_pass}) {
         $USER = $CPAN::Config->{proxy_user};
         $PASSWD = $CPAN::Config->{proxy_pass};
     } else {
@@ -2150,6 +2213,21 @@ sub get_basic_credentials {
     return($USER,$PASSWD);
 }
 
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
 sub mirror {
     my($self,$url,$aslocal) = @_;
     my $result = $self->SUPER::mirror($url,$aslocal);
@@ -2273,7 +2351,7 @@ sub localize {
             CPAN::LWP::UserAgent->config;
 	    eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
             if ($@) {
-                $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@")
+                $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
                     if $CPAN::DEBUG;
             } else {
                 my($var);
@@ -2300,10 +2378,9 @@ sub localize {
             }
 	}
     }
-    $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
-    $ENV{http_proxy} = $CPAN::Config->{http_proxy}
-        if $CPAN::Config->{http_proxy};
-    $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy};
+    for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
+        $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
+    }
 
     # Try the list of urls for each single object. We keep a record
     # where we did get a file from
@@ -2424,7 +2501,7 @@ sub hosteasy {
               CPAN::LWP::UserAgent->config;
               eval { $Ua = CPAN::LWP::UserAgent->new; };
               if ($@) {
-                  $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@");
+                  $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
               }
 	  }
 	  my $res = $Ua->mirror($url, $aslocal);
@@ -2629,8 +2706,9 @@ sub hosthardest {
     my($i);
     my($aslocal_dir) = File::Basename::dirname($aslocal);
     File::Path::mkpath($aslocal_dir);
+    my $ftpbin = $CPAN::Config->{ftp};
   HOSTHARDEST: for $i (@$host_seq) {
-	unless (length $CPAN::Config->{'ftp'}) {
+	unless (length $ftpbin && MM->maybe_command($ftpbin)) {
 	    $CPAN::Frontend->myprint("No external ftp command available\n\n");
 	    last HOSTHARDEST;
 	}
@@ -2655,7 +2733,7 @@ sub hosthardest {
 	     @dialog,
 	     "lcd $aslocal_dir",
 	     "cd /",
-	     map("cd $_", split "/", $dir), # RFC 1738
+	     map("cd $_", split /\//, $dir), # RFC 1738
 	     "bin",
 	     "get $getfile $targetfile",
 	     "quit"
@@ -2675,7 +2753,7 @@ sub hosthardest {
 
 }
 		     );
-		$self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
+		$self->talk_ftp("$ftpbin$verbose $host",
 				@dialog);
 		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 		 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
@@ -2700,13 +2778,13 @@ sub hosthardest {
 	# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
 	# then and login manually to host, using e-mail as
 	# password.
-	$CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
+	$CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
 	unshift(
 		@dialog,
 		"open $host",
 		"user anonymous $Config::Config{'cf_email'}"
 	       );
-	$self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
+	$self->talk_ftp("$ftpbin$verbose -n", @dialog);
 	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 	 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
 	$mtime ||= 0;
@@ -3251,7 +3329,7 @@ happen.\a
 	if ($id->cpan_file ne $dist){ # update only if file is
                                       # different. CPAN prohibits same
                                       # name with different version
-	    $userid = $self->userid($dist);
+	    $userid = $id->userid || $self->userid($dist);
 	    $id->set(
 		     'CPAN_USERID' => $userid,
 		     'CPAN_VERSION' => $version,
@@ -3351,7 +3429,7 @@ sub write_metadata_cache {
     $cache->{PROTOCOL} = PROTOCOL;
     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
     eval { Storable::nstore($cache, $metadata_file) };
-    $CPAN::Frontend->mywarn($@) if $@;
+    $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 }
 
 #-> sub CPAN::Index::read_metadata_cache ;
@@ -3364,7 +3442,7 @@ sub read_metadata_cache {
     $CPAN::Frontend->myprint("Going to read $metadata_file\n");
     my $cache;
     eval { $cache = Storable::retrieve($metadata_file) };
-    $CPAN::Frontend->mywarn($@) if $@;
+    $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
     if (!$cache || ref $cache ne 'HASH'){
         $LAST_TIME = 0;
         return;
@@ -3372,7 +3450,7 @@ sub read_metadata_cache {
     if (exists $cache->{PROTOCOL}) {
         if (PROTOCOL > $cache->{PROTOCOL}) {
             $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
-                                            "with protocol v%s, requiring v%s",
+                                            "with protocol v%s, requiring v%s\n",
                                             $cache->{PROTOCOL},
                                             PROTOCOL)
                                    );
@@ -3380,7 +3458,7 @@ sub read_metadata_cache {
         }
     } else {
         $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
-                                "with protocol v1.0");
+                                "with protocol v1.0\n");
         return;
     }
     my $clcnt = 0;
@@ -3417,7 +3495,11 @@ sub read_metadata_cache {
 package CPAN::InfoObj;
 
 # Accessors
-sub cpan_userid { shift->{RO}{CPAN_USERID} }
+sub cpan_userid {
+    my $self = shift;
+    $self->{RO}{CPAN_USERID}
+}
+
 sub id { shift->{ID}; }
 
 #-> sub CPAN::InfoObj::new ;
@@ -3676,7 +3758,7 @@ sub normalize {
        ) {
         return $s if $s =~ m:^N/A|^Contact Author: ;
         $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
-            $CPAN::Frontend->mywarn("Strange distribution name [$s]");
+            $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
         CPAN->debug("s[$s]") if $CPAN::DEBUG;
     }
     $s;
@@ -3687,22 +3769,20 @@ sub color_cmd_tmps {
     my($self) = shift;
     my($depth) = shift || 0;
     my($color) = shift || 0;
+    my($ancestors) = shift || [];
     # a distribution needs to recurse into its prereq_pms
 
     return if exists $self->{incommandcolor}
         && $self->{incommandcolor}==$color;
-    $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
-                                   "color_cmd_tmps depth[%s] self[%s] id[%s]",
-                                   $depth,
-                                   $self,
-                                   $self->id
-                                  )) if $depth>=100;
-    ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+    if ($depth>=100){
+        $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+    }
+    # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
     my $prereq_pm = $self->prereq_pm;
     if (defined $prereq_pm) {
         for my $pre (keys %$prereq_pm) {
             my $premo = CPAN::Shell->expand("Module",$pre);
-            $premo->color_cmd_tmps($depth+1,$color);
+            $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
         }
     }
     if ($color==0) {
@@ -3789,7 +3869,7 @@ sub get {
 			    $CPAN::Config->{keep_source_where},
 			    "authors",
 			    "id",
-			    split("/",$self->id)
+			    split(/\//,$self->id)
 			   );
 
     $self->debug("Doing localize") if $CPAN::DEBUG;
@@ -3897,7 +3977,7 @@ sub get {
     }
 
     $self->{'build_dir'} = $packagedir;
-    $self->safe_chdir(File::Spec->updir);
+    $self->safe_chdir($builddir);
     File::Path::rmtree("tmp");
 
     my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
@@ -4042,8 +4122,10 @@ Could not determine which directory to use for looking at $dist.
     my $pwd  = CPAN::anycwd();
     $self->safe_chdir($dir);
     $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
-    system($CPAN::Config->{'shell'}) == 0
-	or $CPAN::Frontend->mydie("Subprocess shell error");
+    unless (system($CPAN::Config->{'shell'}) == 0) {
+        my $code = $? >> 8;
+        $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
+    }
     $self->safe_chdir($pwd);
 }
 
@@ -4059,7 +4141,7 @@ sub cvs_import {
 
     my $userid = $self->cpan_userid;
 
-    my $cvs_dir = (split '/', $dir)[-1];
+    my $cvs_dir = (split /\//, $dir)[-1];
     $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
     my $cvs_root = 
       $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
@@ -4096,7 +4178,7 @@ sub readme {
 			     $CPAN::Config->{keep_source_where},
 			     "authors",
 			     "id",
-			     split("/","$sans.readme"),
+			     split(/\//,"$sans.readme"),
 			    );
     $self->debug("Doing localize") if $CPAN::DEBUG;
     $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
@@ -4134,7 +4216,7 @@ sub verifyMD5 {
 	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     my($lc_want,$lc_file,@local,$basename);
-    @local = split("/",$self->id);
+    @local = split(/\//,$self->id);
     pop @local;
     push @local, "CHECKSUMS";
     $lc_want =
@@ -4518,6 +4600,7 @@ of modules we are processing right now?", "yes");
     if ($follow) {
         # color them as dirty
         for my $p (@prereq) {
+            # warn "calling color_cmd_tmps(0,1)";
             CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
         }
         CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
@@ -4799,10 +4882,7 @@ package CPAN::Bundle;
 
 sub look {
     my $self = shift;
-    $CPAN::Frontend->myprint(
-                             qq{ look() commmand on bundles not}.
-                             qq{ implemented (What should it do?)}
-                            );
+    $CPAN::Frontend->myprint($self->as_string);
 }
 
 sub undelay {
@@ -4819,23 +4899,21 @@ sub color_cmd_tmps {
     my($self) = shift;
     my($depth) = shift || 0;
     my($color) = shift || 0;
+    my($ancestors) = shift || [];
     # a module needs to recurse to its cpan_file, a distribution needs
     # to recurse into its prereq_pms, a bundle needs to recurse into its modules
 
     return if exists $self->{incommandcolor}
         && $self->{incommandcolor}==$color;
-    $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
-                                   "color_cmd_tmps depth[%s] self[%s] id[%s]",
-                                   $depth,
-                                   $self,
-                                   $self->id
-                                  )) if $depth>=100;
-    ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+    if ($depth>=100){
+        $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+    }
+    # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
 
     for my $c ( $self->contains ) {
         my $obj = CPAN::Shell->expandany($c) or next;
         CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
-        $obj->color_cmd_tmps($depth+1,$color);
+        $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
     }
     if ($color==0) {
         delete $self->{badtestcnt};
@@ -5125,12 +5203,13 @@ No File found for bundle } . $self->id . qq{\n}), return;
 package CPAN::Module;
 
 # Accessors
-# sub cpan_userid { shift->{RO}{CPAN_USERID} }
+# sub CPAN::Module::userid
 sub userid {
     my $self = shift;
     return unless exists $self->{RO}; # should never happen
-    return $self->{RO}{CPAN_USERID} || $self->{RO}{userid};
+    return $self->{RO}{userid} || $self->{RO}{CPAN_USERID};
 }
+# sub CPAN::Module::description
 sub description { shift->{RO}{description} }
 
 sub undelay {
@@ -5146,20 +5225,18 @@ sub color_cmd_tmps {
     my($self) = shift;
     my($depth) = shift || 0;
     my($color) = shift || 0;
+    my($ancestors) = shift || [];
     # a module needs to recurse to its cpan_file
 
     return if exists $self->{incommandcolor}
         && $self->{incommandcolor}==$color;
-    $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
-                                   "color_cmd_tmps depth[%s] self[%s] id[%s]",
-                                   $depth,
-                                   $self,
-                                   $self->id
-                                  )) if $depth>=100;
-    ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+    if ($depth>=100){
+        $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+    }
+    # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
 
     if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
-        $dist->color_cmd_tmps($depth+1,$color);
+        $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
     }
     if ($color==0) {
         delete $self->{badtestcnt};
@@ -5198,7 +5275,7 @@ sub as_glimpse {
 sub as_string {
     my($self) = @_;
     my(@m);
-    CPAN->debug($self) if $CPAN::DEBUG;
+    CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
     my $class = ref($self);
     $class =~ s/^CPAN:://;
     local($^W) = 0;
@@ -5208,7 +5285,8 @@ sub as_string {
 	if $self->description;
     my $sprintf2 = "    %-12s %s (%s)\n";
     my($userid);
-    if ($userid = $self->cpan_userid || $self->userid){
+    $userid = $self->userid;
+    if ( $userid ){
 	my $author;
 	if ($author = CPAN::Shell->expand('Author',$userid)) {
 	  my $email = "";
@@ -5232,8 +5310,8 @@ sub as_string {
     my(%statd,%stats,%statl,%stati);
     @statd{qw,? i c a b R M S,} = qw,unknown idea
 	pre-alpha alpha beta released mature standard,;
-    @stats{qw,? m d u n,}       = qw,unknown mailing-list
-	developer comp.lang.perl.* none,;
+    @stats{qw,? m d u n a,}       = qw,unknown mailing-list
+	developer comp.lang.perl.* none abandoned,;
     @statl{qw,? p c + o h,}       = qw,unknown perl C C++ other hybrid,;
     @stati{qw,? f r O h,}         = qw,unknown functions
 	references+ties object-oriented hybrid,;
@@ -5365,7 +5443,7 @@ sub cpan_file {
                 }
                 return "Contact Author $fullname <$email>";
             } else {
-                return "UserID $userid";
+                return "Contact Author $userid (Email address not available)";
             }
         } else {
             return "N/A";
@@ -5472,6 +5550,13 @@ sub install {
     } else {
 	$doit = 1;
     }
+    if ($self->{RO}{stats} && $self->{RO}{stats} eq "a") {
+        $CPAN::Frontend->mywarn(qq{
+\n\n\n     ***WARNING***
+     The module $self->{ID} has no active maintainer.\n\n\n
+});
+        sleep 5;
+    }
     $self->rematein('install') if $doit;
 }
 #-> sub CPAN::Module::clean ;
@@ -5894,7 +5979,7 @@ sub readable {
 
     # And if they say v1.2, then the old perl takes it as "v12"
 
-    $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
+    $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
     return $n;
   }
   my $better = sprintf "v%vd", $n;
@@ -5924,10 +6009,20 @@ Batch mode:
 
   autobundle, clean, install, make, recompile, test
 
+=head1 STATUS
+
+This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
+of a modern rewrite from ground up with greater extensibility and more
+features but no full compatibility. If you're new to CPAN.pm, you
+probably should investigate if CPANPLUS is the better choice for you.
+If you're already used to CPAN.pm you're welcome to continue using it,
+if you accept that its development is mostly (though not completely)
+stalled.
+
 =head1 DESCRIPTION
 
 The CPAN module is designed to automate the make and install of perl
-modules and extensions. It includes some searching capabilities and
+modules and extensions. It includes some primitive searching capabilities and
 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
 to fetch the raw data from the net.
 
@@ -6648,12 +6743,19 @@ with this floppy. See also below the paragraph about CD-ROM support.
 
 =head1 CONFIGURATION
 
-When the CPAN module is installed, a site wide configuration file is
-created as CPAN/Config.pm. The default values defined there can be
-overridden in another configuration file: CPAN/MyConfig.pm. You can
-store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
-$HOME/.cpan is added to the search path of the CPAN module before the
-use() or require() statements.
+When the CPAN module is used for the first time, a configuration
+dialog tries to determine a couple of site specific options. The
+result of the dialog is stored in a hash reference C< $CPAN::Config >
+in a file CPAN/Config.pm.
+
+The default values defined in the CPAN/Config.pm file can be
+overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
+best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
+added to the search path of the CPAN module before the use() or
+require() statements.
+
+The configuration dialog can be started any time later again by
+issueing the command C< o conf init > in the CPAN shell.
 
 Currently the following keys in the hash reference $CPAN::Config are
 defined:
@@ -6666,6 +6768,8 @@ defined:
   dontload_hash      anonymous hash: modules in the keys will not be
                      loaded by the CPAN::has_inst() routine
   gzip		     location of external program gzip
+  histfile           file to maintain history between sessions
+  histsize           maximum number of lines to keep in histfile
   inactivity_timeout breaks interactive Makefile.PLs after this
                      many seconds inactivity. Set to 0 to never break.
   inhibit_startup_message
@@ -6858,6 +6962,16 @@ This is the firewall implemented in the Linux kernel, it allows you to
 hide a complete network behind one IP address. With this firewall no
 special compiling is needed as you can access hosts directly.
 
+For accessing ftp servers behind such firewalls you may need to set
+the environment variable C<FTP_PASSIVE> to a true value, e.g.
+
+    env FTP_PASSIVE=1 perl -MCPAN -eshell
+
+or
+
+    perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
+
+
 =back
 
 =back
diff --git a/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm b/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
index bb4958383e2..fcf63c32383 100644
--- a/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
+++ b/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
@@ -18,7 +18,7 @@ use File::Basename ();
 use File::Path ();
 use File::Spec;
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.5 $, 10;
+$VERSION = substr q$Revision: 1.6 $, 10;
 
 =head1 NAME
 
@@ -48,7 +48,7 @@ sub init {
     local($\) = "";
     local($|) = 1;
 
-    my($ans,$default,$local,$cont,$url,$expected_size);
+    my($ans,$default);
 
     #
     # Files, directories
@@ -117,6 +117,14 @@ First of all, I\'d like to create this directory. Where?
 
     $default = $cpan_home;
     while ($ans = prompt("CPAN build and cache directory?",$default)) {
+      unless (File::Spec->file_name_is_absolute($ans)) {
+        require Cwd;
+        my $cwd = Cwd::cwd();
+        my $absans = File::Spec->catdir($cwd,$ans);
+        warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
+        $default = $absans;
+        next;
+      }
       eval { File::Path::mkpath($ans); }; # dies if it can't
       if ($@) {
 	warn "Couldn't create directory $ans.
@@ -218,6 +226,32 @@ will be output in UTF-8.
     $CPAN::Config->{term_is_latin} = ($ans =~ /^\s*y/i ? 1 : 0);
 
     #
+    # save history in file histfile
+    #
+    print qq{
+
+If you have one of the readline packages (Term::ReadLine::Perl,
+Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
+shell will have history support. The next two questions deal with the
+filename of the history file and with its size. If you do not want to
+set this variable, please hit SPACE RETURN to the following question.
+
+};
+
+    defined($default = $CPAN::Config->{histfile}) or
+        $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
+    $ans = prompt("File to save your history?", $default);
+    $ans =~ s/^\s+//;
+    $ans =~ s/\s+\z//;
+    $CPAN::Config->{histfile} = $ans;
+
+    if ($CPAN::Config->{histfile}) {
+      defined($default = $CPAN::Config->{histsize}) or $default = 100;
+      $ans = prompt("Number of lines to save?", $default);
+      $CPAN::Config->{histsize} = $ans;
+    }
+
+    #
     # prerequisites_policy
     # Do we follow PREREQ_PM?
     #
@@ -258,7 +292,7 @@ by ENTER.
     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
     local $^W = $old_warn;
     my $progname;
-    for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp/){
+    for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp gpg/){
       if ($^O eq 'MacOS') {
           $CPAN::Config->{$progname} = 'not_here';
           next;
@@ -329,8 +363,7 @@ If you don\'t understand this question, just press ENTER.
 	prompt("Parameters for the 'perl Makefile.PL' command?
 Typical frequently used settings:
 
-    POLLUTE=1        increasing backwards compatibility
-    LIB=~/perl       non-root users (please see manual for more hints)
+    PREFIX=~/perl       non-root users (please see manual for more hints)
 
 Your choice: ",$default);
     $default = $CPAN::Config->{make_arg} || "";
@@ -429,19 +462,6 @@ be echoed to the terminal!
 
     conf_sites() unless $fastread;
 
-    unless (@{$CPAN::Config->{'wait_list'}||[]}) {
-	print qq{
-
-WAIT support is available as a Plugin. You need the CPAN::WAIT module
-to actually use it.  But we need to know your favorite WAIT server. If
-you don\'t know a WAIT server near you, just press ENTER.
-
-};
-	$default = "wait://ls6-www.informatik.uni-dortmund.de:1404";
-	$ans = prompt("Your favorite WAIT server?\n  ",$default);
-	push @{$CPAN::Config->{'wait_list'}}, $ans;
-    }
-
     # We don't ask that now, it will be noticed in time, won't it?
     $CPAN::Config->{'inhibit_startup_message'} = 0;
     $CPAN::Config->{'getcwd'} = 'cwd';
@@ -519,33 +539,33 @@ sub picklist {
     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
     $default ||= '';
 
-	my $pos = 0;
+    my $pos = 0;
 
     my @nums;
     while (1) {
 
-		# display, at most, 15 items at a time
-		my $limit = $#{ $items } - $pos;
-		$limit = 15 if $limit > 15;
-
-		# show the next $limit items, get the new position
-		$pos = display_some($items, $limit, $pos);
-		$pos = 0 if $pos >= @$items;
-
-		my $num = prompt($prompt,$default);
-		
-		@nums = split (' ', $num);
-		my $i = scalar @$items;
-		(warn "invalid items entered, try again\n"), next
-		    if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
-		if ($require_nonempty) {
-		    (warn "$empty_warning\n");
-		}
-    	print "\n";
-
-		# a blank line continues...
-		next unless @nums;
-		last;
+        # display, at most, 15 items at a time
+        my $limit = $#{ $items } - $pos;
+        $limit = 15 if $limit > 15;
+
+        # show the next $limit items, get the new position
+        $pos = display_some($items, $limit, $pos);
+        $pos = 0 if $pos >= @$items;
+
+        my $num = prompt($prompt,$default);
+
+        @nums = split (' ', $num);
+        my $i = scalar @$items;
+        (warn "invalid items entered, try again\n"), next
+            if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
+        if ($require_nonempty) {
+            (warn "$empty_warning\n");
+        }
+        print "\n";
+
+        # a blank line continues...
+        next unless @nums;
+        last;
     }
     for (@nums) { $_-- }
     @{$items}[@nums];
@@ -559,7 +579,10 @@ sub display_some {
     for my $item (@displayable) {
 		printf "(%d) %s\n", ++$pos, $item;
     }
-	printf "%d more items, hit ENTER\n", (@$items - $pos) if $pos < @$items;
+	printf("%d more items, hit SPACE RETURN to show them\n",
+               (@$items - $pos)
+              )
+            if $pos < @$items;
 	return $pos;
 }
 
@@ -643,8 +666,8 @@ http: -- that host a CPAN mirror.
         }
     }
     push (@urls, map ("$_ (previous pick)", @previous_urls));
-    my $prompt = "Select as many URLs as you like,
-put them on one line, separated by blanks";
+    my $prompt = "Select as many URLs as you like (by number),
+put them on one line, separated by blanks, e.g. '1 4 5'";
     if (@previous_urls) {
        $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
                              (scalar @urls));
@@ -669,6 +692,8 @@ Please enter your CPAN site:};
         $ans = prompt ($prompt, "");
 
         if ($ans) {
+            $ans =~ s/^\s+//;  # no leading spaces
+            $ans =~ s/\s+\z//; # no trailing spaces
             $ans =~ s|/?\z|/|; # has to end with one slash
             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
             if ($ans =~ /^\w+:\/./) {
diff --git a/gnu/usr.bin/perl/lib/CPAN/Nox.pm b/gnu/usr.bin/perl/lib/CPAN/Nox.pm
index 5c142910360..062e5ffa7e7 100644
--- a/gnu/usr.bin/perl/lib/CPAN/Nox.pm
+++ b/gnu/usr.bin/perl/lib/CPAN/Nox.pm
@@ -9,7 +9,7 @@ BEGIN{
 use base 'Exporter';
 use CPAN;
 
-$VERSION = "1.02";
+$VERSION = "1.03";
 $CPAN::META->has_inst('Digest::MD5','no');
 $CPAN::META->has_inst('LWP','no');
 $CPAN::META->has_inst('Compress::Zlib','no');
@@ -17,6 +17,8 @@ $CPAN::META->has_inst('Compress::Zlib','no');
 
 *AUTOLOAD = \&CPAN::AUTOLOAD;
 
+1;
+
 __END__
 
 =head1 NAME
diff --git a/gnu/usr.bin/perl/lib/CPAN/bin/cpan b/gnu/usr.bin/perl/lib/CPAN/bin/cpan
index dfb16d6dd72..4c28a7100aa 100644
--- a/gnu/usr.bin/perl/lib/CPAN/bin/cpan
+++ b/gnu/usr.bin/perl/lib/CPAN/bin/cpan
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: cpan,v 1.1 2003/12/03 02:44:01 millert Exp $
+# $Id: cpan,v 1.2 2003/12/03 03:02:37 millert Exp $
 use strict;
 
 =head1 NAME
@@ -117,7 +117,7 @@ use CPAN ();
 use Getopt::Std;
 
 my $VERSION = 
-	sprintf "%d.%02d", q$Revision: 1.1 $ =~ m/ (\d+) \. (\d+) /xg;
+	sprintf "%d.%02d", q$Revision: 1.2 $ =~ m/ (\d+) \. (\d+) /xg;
 
 my $Default = 'default';
 
diff --git a/gnu/usr.bin/perl/lib/Class/Struct.pm b/gnu/usr.bin/perl/lib/Class/Struct.pm
index bad4f78165f..7a9af54faf8 100644
--- a/gnu/usr.bin/perl/lib/Class/Struct.pm
+++ b/gnu/usr.bin/perl/lib/Class/Struct.pm
@@ -14,7 +14,7 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(struct);
 
-$VERSION = '0.61';
+$VERSION = '0.63';
 
 ## Tested on 5.002 and 5.003 without class membership tests:
 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
@@ -61,7 +61,7 @@ sub import {
 	# do we ever export anything else than 'struct'...?
       $self->export_to_level( 1, $self, @_ );
     } else {
-      &struct;
+      goto &struct;
     }
 }
 
@@ -266,6 +266,10 @@ Class::Struct - declare struct-like datatypes as Perl classes
     use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
     use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
 
+    # declare struct at compile time, based on array, implicit class name:
+    package CLASS_NAME;
+    use Class::Struct ELEMENT_NAME => ELEMENT_TYPE, ... ;
+
     package Myobj;
     use Class::Struct;
             # declare struct with four types of elements:
@@ -456,26 +460,26 @@ See Example 3 below for an example of initialization.
 =item Example 1
 
 Giving a struct element a class type that is also a struct is how
-structs are nested.  Here, C<timeval> represents a time (seconds and
-microseconds), and C<rusage> has two elements, each of which is of
-type C<timeval>.
+structs are nested.  Here, C<Timeval> represents a time (seconds and
+microseconds), and C<Rusage> has two elements, each of which is of
+type C<Timeval>.
 
     use Class::Struct;
 
-    struct( rusage => {
-        ru_utime => timeval,  # seconds
-        ru_stime => timeval,  # microseconds
+    struct( Rusage => {
+        ru_utime => 'Timeval',  # user time used
+        ru_stime => 'Timeval',  # system time used
     });
 
-    struct( timeval => [
-        tv_secs  => '$',
-        tv_usecs => '$',
+    struct( Timeval => [
+        tv_secs  => '$',        # seconds
+        tv_usecs => '$',        # microseconds
     ]);
 
         # create an object:
-    my $t = new rusage;
+    my $t = Rusage->new(ru_utime=>Timeval->new(), ru_stime=>Timeval->new());
 
-        # $t->ru_utime and $t->ru_stime are objects of type timeval.
+        # $t->ru_utime and $t->ru_stime are objects of type Timeval.
         # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
     $t->ru_utime->tv_secs(100);
     $t->ru_utime->tv_usecs(0);
@@ -500,10 +504,10 @@ accessor accordingly.
         my $self = shift;
         if ( @_ ) {
             die 'count must be nonnegative' if $_[0] < 0;
-            $self->{'count'} = shift;
+            $self->{'MyObj::count'} = shift;
             warn "Too many args to count" if @_;
         }
-        return $self->{'count'};
+        return $self->{'MyObj::count'};
     }
 
     package main;
diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm
index 8b00543e1e9..984375fb0f6 100644
--- a/gnu/usr.bin/perl/lib/Cwd.pm
+++ b/gnu/usr.bin/perl/lib/Cwd.pm
@@ -38,8 +38,6 @@ Returns the current working directory.
 
 Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
 
-Taint-safe.
-
 =item cwd
 
     my $cwd = cwd();
@@ -48,8 +46,6 @@ The cwd() is the most natural form for the current architecture. For
 most systems it is identical to `pwd` (but without the trailing line
 terminator).
 
-Taint-safe.
-
 =item fastcwd
 
     my $cwd = fastcwd();
@@ -77,7 +73,8 @@ The fastgetcwd() function is provided as a synonym for cwd().
 =head2 abs_path and friends
 
 These functions are exported only on request.  They each take a single
-argument and return the absolute pathname for it.
+argument and return the absolute pathname for it.  If no argument is
+given they'll use the current working directory.
 
 =over 4
 
@@ -89,25 +86,18 @@ Uses the same algorithm as getcwd().  Symbolic links and relative-path
 components ("." and "..") are resolved to return the canonical
 pathname, just like realpath(3).
 
-Taint-safe.
-
 =item realpath
 
   my $abs_path = realpath($file);
 
 A synonym for abs_path().
 
-Taint-safe.
-
 =item fast_abs_path
 
   my $abs_path = fast_abs_path($file);
 
 A more dangerous, but potentially faster version of abs_path.
 
-This function is B<Not> taint-safe : you can't use it in programs
-that work under taint mode.
-
 =back
 
 =head2 $ENV{PWD}
@@ -148,9 +138,7 @@ L<File::chdir>
 
 use strict;
 
-use Carp;
-
-our $VERSION = '2.06';
+our $VERSION = '2.08';
 
 use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -177,7 +165,7 @@ if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
 
 eval {
     require XSLoader;
-    undef *Cwd::fastcwd; # avoid redefinition warning
+    local $^W = 0;
     XSLoader::load('Cwd');
 };
 
@@ -192,7 +180,16 @@ foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
         last;
     }
 }
-$pwd_cmd ||= 'pwd';
+unless ($pwd_cmd) {
+    if (-x '/QOpenSys/bin/pwd') { # OS/400 PASE.
+        $pwd_cmd = '/QOpenSys/bin/pwd' ;
+    } else {
+        # Isn't this wrong?  _backtick_pwd() will fail if somenone has
+        # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
+        # See [perl #16774]. --jhi
+        $pwd_cmd = 'pwd';
+    }
+}
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
@@ -361,7 +358,8 @@ sub _perl_abs_path
 
     unless (@cst = stat( $start ))
     {
-	carp "stat($start): $!";
+	require Carp;
+	Carp::carp ("stat($start): $!");
 	return '';
     }
     $cwd = '';
@@ -370,14 +368,17 @@ sub _perl_abs_path
     {
 	$dotdots .= '/..';
 	@pst = @cst;
+	local *PARENT;
 	unless (opendir(PARENT, $dotdots))
 	{
-	    carp "opendir($dotdots): $!";
+	    require Carp;
+	    Carp::carp ("opendir($dotdots): $!");
 	    return '';
 	}
 	unless (@cst = stat($dotdots))
 	{
-	    carp "stat($dotdots): $!";
+	    require Carp;
+	    Carp::carp ("stat($dotdots): $!");
 	    closedir(PARENT);
 	    return '';
 	}
@@ -391,7 +392,8 @@ sub _perl_abs_path
 	    {
 		unless (defined ($dir = readdir(PARENT)))
 	        {
-		    carp "readdir($dotdots): $!";
+		    require Carp;
+		    Carp::carp ("readdir($dotdots): $!");
 		    closedir(PARENT);
 		    return '';
 		}
@@ -412,14 +414,26 @@ sub _perl_abs_path
 # used to the libc function.  --tchrist 27-Jan-00
 *realpath = \&abs_path;
 
+my $Curdir;
 sub fast_abs_path {
     my $cwd = getcwd();
     require File::Spec;
-    my $path = @_ ? shift : File::Spec->curdir;
-    CORE::chdir($path) || croak "Cannot chdir to $path: $!";
+    my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
+
+    # Detaint else we'll explode in taint mode.  This is safe because
+    # we're not doing anything dangerous with it.
+    ($path) = $path =~ /(.*)/;
+    ($cwd)  = $cwd  =~ /(.*)/;
+
+    if (!CORE::chdir($path)) {
+ 	require Carp;
+ 	Carp::croak ("Cannot chdir to $path: $!");
+    }
     my $realpath = getcwd();
-    -d $cwd && CORE::chdir($cwd) ||
-	croak "Cannot chdir back to $cwd: $!";
+    if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
+ 	require Carp;
+ 	Carp::croak ("Cannot chdir back to $cwd: $!");
+    }
     $realpath;
 }
 
@@ -445,13 +459,17 @@ sub _vms_cwd {
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
     my $path = VMS::Filespec::pathify($_[0]);
-    croak("Invalid path name $_[0]") unless defined $path;
+    if (! defined $path)
+	{
+	require Carp;
+	Carp::croak("Invalid path name $_[0]")
+	}
     return VMS::Filespec::rmsexpand($path);
 }
 
 sub _os2_cwd {
     $ENV{'PWD'} = `cmd /c cd`;
-    chop $ENV{'PWD'};
+    chomp $ENV{'PWD'};
     $ENV{'PWD'} =~ s:\\:/:g ;
     return $ENV{'PWD'};
 }
@@ -470,7 +488,7 @@ sub _win32_cwd {
 sub _dos_cwd {
     if (!defined &Dos::GetCwd) {
         $ENV{'PWD'} = `command /c cd`;
-        chop $ENV{'PWD'};
+        chomp $ENV{'PWD'};
         $ENV{'PWD'} =~ s:\\:/:g ;
     } else {
         $ENV{'PWD'} = Dos::GetCwd();
@@ -483,7 +501,7 @@ sub _qnx_cwd {
 	local $ENV{CDPATH} = '';
 	local $ENV{ENV} = '';
     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
-    chop $ENV{'PWD'};
+    chomp $ENV{'PWD'};
     return $ENV{'PWD'};
 }
 
@@ -492,8 +510,13 @@ sub _qnx_abs_path {
 	local $ENV{CDPATH} = '';
 	local $ENV{ENV} = '';
     my $path = @_ ? shift : '.';
-    my $realpath=`/usr/bin/fullpath -t $path`;
-    chop $realpath;
+    local *REALPATH;
+
+    open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or
+      die "Can't open /usr/bin/fullpath: $!";
+    my $realpath = <REALPATH>;
+    close REALPATH;
+    chomp $realpath;
     return $realpath;
 }
 
diff --git a/gnu/usr.bin/perl/lib/English.pm b/gnu/usr.bin/perl/lib/English.pm
index 05dd05c4f99..6516eb80400 100644
--- a/gnu/usr.bin/perl/lib/English.pm
+++ b/gnu/usr.bin/perl/lib/English.pm
@@ -1,6 +1,6 @@
 package English;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 require Exporter;
 @ISA = (Exporter);
@@ -57,9 +57,9 @@ sub import {
         *EXPORT = \@COMPLETE_EXPORT ;
         $globbed_match ||= (
 	    eval q{
-		*MATCH				= \$&	;
-		*PREMATCH				= \$`	;
-		*POSTMATCH				= \$'	;
+		*MATCH				= *&	;
+		*PREMATCH			= *`	;
+		*POSTMATCH			= *'	;
 		1 ;
 	       }
 	    || do {
@@ -144,87 +144,87 @@ sub import {
 
 # Matching.
 
-	*LAST_PAREN_MATCH			= \$+	;
-	*LAST_SUBMATCH_RESULT			= \$^N ;
-	*LAST_MATCH_START			= \@- ;
-	*LAST_MATCH_END				= \@+ ;
+	*LAST_PAREN_MATCH			= *+	;
+	*LAST_SUBMATCH_RESULT			= *^N ;
+	*LAST_MATCH_START			= *-{ARRAY} ;
+	*LAST_MATCH_END				= *+{ARRAY} ;
 
 # Input.
 
-	*INPUT_LINE_NUMBER			= \$.	;
-	    *NR					= \$.	;
-	*INPUT_RECORD_SEPARATOR			= \$/	;
-	    *RS					= \$/	;
+	*INPUT_LINE_NUMBER			= *.	;
+	    *NR					= *.	;
+	*INPUT_RECORD_SEPARATOR			= */	;
+	    *RS					= */	;
 
 # Output.
 
-	*OUTPUT_AUTOFLUSH			= \$|	;
-	*OUTPUT_FIELD_SEPARATOR			= \$,	;
-	    *OFS				= \$,	;
-	*OUTPUT_RECORD_SEPARATOR		= \$\	;
-	    *ORS				= \$\	;
+	*OUTPUT_AUTOFLUSH			= *|	;
+	*OUTPUT_FIELD_SEPARATOR			= *,	;
+	    *OFS				= *,	;
+	*OUTPUT_RECORD_SEPARATOR		= *\	;
+	    *ORS				= *\	;
 
 # Interpolation "constants".
 
-	*LIST_SEPARATOR				= \$"	;
-	*SUBSCRIPT_SEPARATOR			= \$;	;
-	    *SUBSEP				= \$;	;
+	*LIST_SEPARATOR				= *"	;
+	*SUBSCRIPT_SEPARATOR			= *;	;
+	    *SUBSEP				= *;	;
 
 # Formats
 
-	*FORMAT_PAGE_NUMBER			= \$%	;
-	*FORMAT_LINES_PER_PAGE			= \$=	;
-	*FORMAT_LINES_LEFT			= \$-	;
-	*FORMAT_NAME				= \$~	;
-	*FORMAT_TOP_NAME			= \$^	;
-	*FORMAT_LINE_BREAK_CHARACTERS		= \$:	;
-	*FORMAT_FORMFEED			= \$^L	;
+	*FORMAT_PAGE_NUMBER			= *%	;
+	*FORMAT_LINES_PER_PAGE			= *=	;
+	*FORMAT_LINES_LEFT			= *-	;
+	*FORMAT_NAME				= *~	;
+	*FORMAT_TOP_NAME			= *^	;
+	*FORMAT_LINE_BREAK_CHARACTERS		= *:	;
+	*FORMAT_FORMFEED			= *^L	;
 
 # Error status.
 
-	*CHILD_ERROR				= \$?	;
-	*OS_ERROR				= \$!	;
-	    *ERRNO				= \$!	;
-	*OS_ERROR				= \%!	;
-	    *ERRNO				= \%!	;
-	*EXTENDED_OS_ERROR			= \$^E	;
-	*EVAL_ERROR				= \$@	;
+	*CHILD_ERROR				= *?	;
+	*OS_ERROR				= *!	;
+	    *ERRNO				= *!	;
+	*OS_ERROR				= *!	;
+	    *ERRNO				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
+	*EVAL_ERROR				= *@	;
 
 # Process info.
 
-	*PROCESS_ID				= \$$	;
-	    *PID				= \$$	;
-	*REAL_USER_ID				= \$<	;
-	    *UID				= \$<	;
-	*EFFECTIVE_USER_ID			= \$>	;
-	    *EUID				= \$>	;
-	*REAL_GROUP_ID				= \$(	;
-	    *GID				= \$(	;
-	*EFFECTIVE_GROUP_ID			= \$)	;
-	    *EGID				= \$)	;
-	*PROGRAM_NAME				= \$0	;
+	*PROCESS_ID				= *$	;
+	    *PID				= *$	;
+	*REAL_USER_ID				= *<	;
+	    *UID				= *<	;
+	*EFFECTIVE_USER_ID			= *>	;
+	    *EUID				= *>	;
+	*REAL_GROUP_ID				= *(	;
+	    *GID				= *(	;
+	*EFFECTIVE_GROUP_ID			= *)	;
+	    *EGID				= *)	;
+	*PROGRAM_NAME				= *0	;
 
 # Internals.
 
-	*PERL_VERSION				= \$^V	;
-	*ACCUMULATOR				= \$^A	;
-	*COMPILING				= \$^C	;
-	*DEBUGGING				= \$^D	;
-	*SYSTEM_FD_MAX				= \$^F	;
-	*INPLACE_EDIT				= \$^I	;
-	*PERLDB					= \$^P	;
-	*LAST_REGEXP_CODE_RESULT		= \$^R	;
-	*EXCEPTIONS_BEING_CAUGHT		= \$^S	;
-	*BASETIME				= \$^T	;
-	*WARNING				= \$^W	;
-	*EXECUTABLE_NAME			= \$^X	;
-	*OSNAME					= \$^O	;
+	*PERL_VERSION				= *^V	;
+	*ACCUMULATOR				= *^A	;
+	*COMPILING				= *^C	;
+	*DEBUGGING				= *^D	;
+	*SYSTEM_FD_MAX				= *^F	;
+	*INPLACE_EDIT				= *^I	;
+	*PERLDB					= *^P	;
+	*LAST_REGEXP_CODE_RESULT		= *^R	;
+	*EXCEPTIONS_BEING_CAUGHT		= *^S	;
+	*BASETIME				= *^T	;
+	*WARNING				= *^W	;
+	*EXECUTABLE_NAME			= *^X	;
+	*OSNAME					= *^O	;
 
 # Deprecated.
 
-#	*ARRAY_BASE				= \$[	;
-#	*OFMT					= \$#	;
-#	*MULTILINE_MATCHING			= \$*	;
-#	*OLD_PERL_VERSION			= \$]	;
+#	*ARRAY_BASE				= *[	;
+#	*OFMT					= *#	;
+#	*MULTILINE_MATCHING			= **	;
+#	*OLD_PERL_VERSION			= *]	;
 
 1;
diff --git a/gnu/usr.bin/perl/lib/Exporter.pm b/gnu/usr.bin/perl/lib/Exporter.pm
index 8b8d4c49392..753ea6aab27 100644
--- a/gnu/usr.bin/perl/lib/Exporter.pm
+++ b/gnu/usr.bin/perl/lib/Exporter.pm
@@ -9,7 +9,8 @@ require 5.006;
 our $Debug = 0;
 our $ExportLevel = 0;
 our $Verbose ||= 0;
-our $VERSION = '5.566';
+our $VERSION = '5.567';
+our (%Cache);
 $Carp::Internal{Exporter} = 1;
 
 sub as_heavy {
@@ -30,10 +31,10 @@ sub import {
   my $callpkg = caller($ExportLevel);
 
   # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
-  my($exports, $export_cache, $fail)
-    = (\@{"$pkg\::EXPORT"}, \%{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"});
+  my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"});
   return export $pkg, $callpkg, @_
     if $Verbose or $Debug or @$fail > 1;
+  my $export_cache = ($Cache{$pkg} ||= {});
   my $args = @_ or @_ = @$exports;
 
   local $_;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
index 6593ab3a350..12e2b99ea5a 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
@@ -11,7 +11,7 @@ require Exporter;
 use vars qw(@ISA @EXPORT $VERSION);
 @ISA     = qw(Exporter);
 @EXPORT  = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f);
-$VERSION = '1.04';
+$VERSION = '1.05';
 
 my $Is_VMS = $^O eq 'VMS';
 
@@ -21,16 +21,16 @@ ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
 
 =head1 SYNOPSIS
 
-  perl -MExtUtils::Command -e cat files... > destination
-  perl -MExtUtils::Command -e mv source... destination
-  perl -MExtUtils::Command -e cp source... destination
-  perl -MExtUtils::Command -e touch files...
-  perl -MExtUtils::Command -e rm_f file...
-  perl -MExtUtils::Command -e rm_rf directories...
-  perl -MExtUtils::Command -e mkpath directories...
-  perl -MExtUtils::Command -e eqtime source destination
-  perl -MExtUtils::Command -e chmod mode files...
-  perl -MExtUtils::Command -e test_f file
+  perl -MExtUtils::Command       -e cat files... > destination
+  perl -MExtUtils::Command       -e mv source... destination
+  perl -MExtUtils::Command       -e cp source... destination
+  perl -MExtUtils::Command       -e touch files...
+  perl -MExtUtils::Command       -e rm_f files...
+  perl -MExtUtils::Command       -e rm_rf directories...
+  perl -MExtUtils::Command       -e mkpath directories...
+  perl -MExtUtils::Command       -e eqtime source destination
+  perl -MExtUtils::Command       -e test_f file
+  perl -MExtUtils::Command=chmod -e chmod mode files...
 
 =head1 DESCRIPTION
 
@@ -57,6 +57,7 @@ sub expand_wildcards
  @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
 }
 
+
 =item cat 
 
 Concatenates all files mentioned on command line to STDOUT.
@@ -78,8 +79,7 @@ Sets modified time of dst to that of src
 sub eqtime
 {
  my ($src,$dst) = @ARGV;
- open(F,">$dst");
- close(F);
+ local @ARGV = ($dst);  touch();  # in case $dst doesn't exist
  utime((stat($src))[8,9],$dst);
 }
 
@@ -120,17 +120,14 @@ Makes files exist, with current timestamp
 
 =cut 
 
-sub touch
-{
- my $t    = time;
- expand_wildcards();
- while (@ARGV)
-  {
-   my $file = shift(@ARGV);
-   open(FILE,">>$file") || die "Cannot write $file:$!";
-   close(FILE);
-   utime($t,$t,$file);
-  }
+sub touch {
+    my $t    = time;
+    expand_wildcards();
+    foreach my $file (@ARGV) {
+        open(FILE,">>$file") || die "Cannot write $file:$!";
+        close(FILE);
+        utime($t,$t,$file);
+    }
 }
 
 =item mv source... destination
@@ -140,16 +137,13 @@ Multiple sources are allowed if destination is an existing directory.
 
 =cut 
 
-sub mv
-{
- my $dst = pop(@ARGV);
- expand_wildcards();
- croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
- while (@ARGV)
-  {
-   my $src = shift(@ARGV);
-   move($src,$dst);
-  }
+sub mv {
+    my $dst = pop(@ARGV);
+    expand_wildcards();
+    croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+    foreach my $src (@ARGV) {
+        move($src,$dst);
+    }
 }
 
 =item cp source... destination
@@ -159,29 +153,25 @@ Multiple sources are allowed if destination is an existing directory.
 
 =cut
 
-sub cp
-{
- my $dst = pop(@ARGV);
- expand_wildcards();
- croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
- while (@ARGV)
-  {
-   my $src = shift(@ARGV);
-   copy($src,$dst);
-  }
+sub cp {
+    my $dst = pop(@ARGV);
+    expand_wildcards();
+    croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+    foreach my $src (@ARGV) {
+        copy($src,$dst);
+    }
 }
 
 =item chmod mode files...
 
-Sets UNIX like permissions 'mode' on all the files.
+Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
 
 =cut 
 
-sub chmod
-{
- my $mode = shift(@ARGV);
- expand_wildcards();
- chmod($mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
+sub chmod {
+    my $mode = shift(@ARGV);
+    expand_wildcards();
+    chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
 }
 
 =item mkpath directory...
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
index b8fb4e37258..18510ade4b7 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
@@ -2,17 +2,16 @@ package ExtUtils::Install;
 
 use 5.00503;
 use vars qw(@ISA @EXPORT $VERSION);
-$VERSION = 1.29;
+$VERSION = 1.32;
 
 use Exporter;
 use Carp ();
 use Config qw(%Config);
 @ISA = ('Exporter');
 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
-$Is_VMS = $^O eq 'VMS';
+$Is_VMS     = $^O eq 'VMS';
+$Is_MacPerl = $^O eq 'MacOS';
 
-my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
-my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
 my $Inc_uninstall_warn_handler;
 
 # install relative to here
@@ -20,33 +19,67 @@ my $Inc_uninstall_warn_handler;
 my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
 
 use File::Spec;
+my $Curdir = File::Spec->curdir;
+my $Updir  = File::Spec->updir;
 
-sub install_rooted_file {
-    if (defined $INSTALL_ROOT) {
-	File::Spec->catfile($INSTALL_ROOT, $_[0]);
-    } else {
-	$_[0];
-    }
-}
 
-sub install_rooted_dir {
-    if (defined $INSTALL_ROOT) {
-	File::Spec->catdir($INSTALL_ROOT, $_[0]);
-    } else {
-	$_[0];
-    }
-}
+=head1 NAME
 
-#our(@EXPORT, @ISA, $Is_VMS);
-#use strict;
+ExtUtils::Install - install files from here to there
 
-sub forceunlink {
-    chmod 0666, $_[0];
-    unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
-}
+=head1 SYNOPSIS
+
+  use ExtUtils::Install;
+
+  install({ 'blib/lib' => 'some/install/dir' } );
+
+  uninstall($packlist);
+
+  pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
+
+
+=head1 DESCRIPTION
+
+Handles the installing and uninstalling of perl modules, scripts, man
+pages, etc...
+
+Both install() and uninstall() are specific to the way
+ExtUtils::MakeMaker handles the installation and deinstallation of
+perl modules. They are not designed as general purpose tools.
+
+=head2 Functions
+
+=over 4
+
+=item B<install>
+
+    install(\%from_to);
+    install(\%from_to, $verbose, $dont_execute, $uninstall_shadows);
+
+Copies each directory tree of %from_to to its corresponding value
+preserving timestamps and permissions.
+
+There are two keys with a special meaning in the hash: "read" and
+"write".  These contain packlist files.  After the copying is done,
+install() will write the list of target files to $from_to{write}. If
+$from_to{read} is given the contents of this file will be merged into
+the written file. The read and the written file may be identical, but
+on AFS it is quite likely that people are installing to a different
+directory than the one where the files later appear.
+
+If $verbose is true, will print out each file removed.  Default is
+false.  This is "make install VERBINST=1"
+
+If $dont_execute is true it will only print what it was going to do
+without actually doing it.  Default is false.
+
+If $uninstall_shadows is true any differing versions throughout @INC
+will be uninstalled.  This is "make install UNINST=1"
+
+=cut
 
 sub install {
-    my($hash,$verbose,$nonono,$inc_uninstall) = @_;
+    my($from_to,$verbose,$nonono,$inc_uninstall) = @_;
     $verbose ||= 0;
     $nonono  ||= 0;
 
@@ -57,32 +90,29 @@ sub install {
     use File::Find qw(find);
     use File::Path qw(mkpath);
     use File::Compare qw(compare);
-    use File::Spec;
 
-    my(%hash) = %$hash;
+    my(%from_to) = %$from_to;
     my(%pack, $dir, $warn_permissions);
     my($packlist) = ExtUtils::Packlist->new();
     # -w doesn't work reliably on FAT dirs
     $warn_permissions++ if $^O eq 'MSWin32';
     local(*DIR);
     for (qw/read write/) {
-	$pack{$_}=$hash{$_};
-	delete $hash{$_};
+	$pack{$_}=$from_to{$_};
+	delete $from_to{$_};
     }
     my($source_dir_or_file);
-    foreach $source_dir_or_file (sort keys %hash) {
+    foreach $source_dir_or_file (sort keys %from_to) {
 	#Check if there are files, and if yes, look if the corresponding
 	#target directory is writable for us
 	opendir DIR, $source_dir_or_file or next;
 	for (readdir DIR) {
-	    next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
-		my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
-	    if (-w $targetdir ||
-		mkpath($targetdir)) {
-		last;
-	    } else {
+	    next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists";
+            my $targetdir = install_rooted_dir($from_to{$source_dir_or_file});
+            mkpath($targetdir) unless $nonono;
+	    if (!$nonono && !-w $targetdir) {
 		warn "Warning: You do not have permissions to " .
-		    "install into $hash{$source_dir_or_file}"
+		    "install into $from_to{$source_dir_or_file}"
 		    unless $warn_permissions++;
 	    }
 	}
@@ -92,8 +122,7 @@ sub install {
     $packlist->read($tmpfile) if (-f $tmpfile);
     my $cwd = cwd();
 
-    my($source);
-    MOD_INSTALL: foreach $source (sort keys %hash) {
+    MOD_INSTALL: foreach my $source (sort keys %from_to) {
 	#copy the tree to the target directory without altering
 	#timestamp and permission and remember for the .packlist
 	#file. The packlist file contains the absolute paths of the
@@ -104,29 +133,39 @@ sub install {
 	#there are any files in arch. So we depend on having ./blib/arch
 	#hardcoded here.
 
-	my $targetroot = install_rooted_dir($hash{$source});
+	my $targetroot = install_rooted_dir($from_to{$source});
 
-	if ($source eq "blib/lib" and
-	    exists $hash{"blib/arch"} and
-	    directory_not_empty("blib/arch")) {
-	    $targetroot = install_rooted_dir($hash{"blib/arch"});
-            print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
+        my $blib_lib  = File::Spec->catdir('blib', 'lib');
+        my $blib_arch = File::Spec->catdir('blib', 'arch');
+	if ($source eq $blib_lib and
+	    exists $from_to{$blib_arch} and
+	    directory_not_empty($blib_arch)) {
+	    $targetroot = install_rooted_dir($from_to{$blib_arch});
+            print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
 	}
-	chdir($source) or next;
+
+        chdir $source or next;
 	find(sub {
-	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-                         $atime,$mtime,$ctime,$blksize,$blocks) = stat;
+	    my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
 	    return unless -f _;
-	    return if $_ eq ".exists";
+
+            my $origfile = $_;
+	    return if $origfile eq ".exists";
 	    my $targetdir  = File::Spec->catdir($targetroot, $File::Find::dir);
-	    my $targetfile = File::Spec->catfile($targetdir, $_);
+	    my $targetfile = File::Spec->catfile($targetdir, $origfile);
+            my $sourcedir  = File::Spec->catdir($source, $File::Find::dir);
+            my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
+
+            my $save_cwd = cwd;
+            chdir $cwd;  # in case the target is relative
+                         # 5.5.3's File::Find missing no_chdir option.
 
 	    my $diff = 0;
 	    if ( -f $targetfile && -s _ == $size) {
 		# We have a good chance, we can skip this one
-		$diff = compare($_,$targetfile);
+		$diff = compare($sourcefile, $targetfile);
 	    } else {
-		print "$_ differs\n" if $verbose>1;
+		print "$sourcefile differs\n" if $verbose>1;
 		$diff++;
 	    }
 
@@ -137,7 +176,7 @@ sub install {
 		    mkpath($targetdir,0,0755) unless $nonono;
 		    print "mkpath($targetdir,0,0755)\n" if $verbose>1;
 		}
-		copy($_,$targetfile) unless $nonono;
+		copy($sourcefile, $targetfile) unless $nonono;
 		print "Installing $targetfile\n";
 		utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
 		print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
@@ -147,27 +186,54 @@ sub install {
 	    } else {
 		print "Skipping $targetfile (unchanged)\n" if $verbose;
 	    }
-	    
-	    if (! defined $inc_uninstall) { # it's called 
-	    } elsif ($inc_uninstall == 0){
-		inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
-	    } else {
-		inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
+
+	    if (defined $inc_uninstall) {
+		inc_uninstall($sourcefile,$File::Find::dir,$verbose, 
+                              $inc_uninstall ? 0 : 1);
 	    }
+
 	    # Record the full pathname.
 	    $packlist->{$targetfile}++;
 
-	}, ".");
+            # File::Find can get confused if you chdir in here.
+            chdir $save_cwd;
+
+        # File::Find seems to always be Unixy except on MacPerl :(
+	}, $Is_MacPerl ? $Curdir : '.' );
 	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
     }
     if ($pack{'write'}) {
 	$dir = install_rooted_dir(dirname($pack{'write'}));
-	mkpath($dir,0,0755);
+	mkpath($dir,0,0755) unless $nonono;
 	print "Writing $pack{'write'}\n";
-	$packlist->write(install_rooted_file($pack{'write'}));
+	$packlist->write(install_rooted_file($pack{'write'})) unless $nonono;
     }
 }
 
+sub install_rooted_file {
+    if (defined $INSTALL_ROOT) {
+	File::Spec->catfile($INSTALL_ROOT, $_[0]);
+    } else {
+	$_[0];
+    }
+}
+
+
+sub install_rooted_dir {
+    if (defined $INSTALL_ROOT) {
+	File::Spec->catdir($INSTALL_ROOT, $_[0]);
+    } else {
+	$_[0];
+    }
+}
+
+
+sub forceunlink {
+    chmod 0666, $_[0];
+    unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
+}
+
+
 sub directory_not_empty ($) {
   my($dir) = @_;
   my $files = 0;
@@ -181,6 +247,28 @@ sub directory_not_empty ($) {
   return $files;
 }
 
+
+=item B<install_default> I<DISCOURAGED>
+
+    install_default();
+    install_default($fullext);
+
+Calls install() with arguments to copy a module from blib/ to the
+default site installation location.
+
+$fullext is the name of the module converted to a directory
+(ie. Foo::Bar would be Foo/Bar).  If $fullext is not specified, it
+will attempt to read it from @ARGV.
+
+This is primarily useful for install scripts.
+
+B<NOTE> This function is not really useful because of the hard-coded
+install location with no way to control site vs core vs vendor
+directories and the strange way in which the module name is given.
+Consider its use discouraged.
+
+=cut
+
 sub install_default {
   @_ < 2 or die "install_default should be called with 0 or 1 argument";
   my $FULLEXT = @_ ? shift : $ARGV[0];
@@ -205,9 +293,28 @@ sub install_default {
 	  },1,0,0);
 }
 
+
+=item B<uninstall>
+
+    uninstall($packlist_file);
+    uninstall($packlist_file, $verbose, $dont_execute);
+
+Removes the files listed in a $packlist_file.
+
+If $verbose is true, will print out each file removed.  Default is
+false.
+
+If $dont_execute is true it will only print what it was going to do
+without actually doing it.  Default is false.
+
+=cut
+
 sub uninstall {
     use ExtUtils::Packlist;
     my($fil,$verbose,$nonono) = @_;
+    $verbose ||= 0;
+    $nonono  ||= 0;
+
     die "no packlist file found: $fil" unless -f $fil;
     # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
     # require $my_req; # Hairy, but for the first
@@ -222,14 +329,19 @@ sub uninstall {
 }
 
 sub inc_uninstall {
-    my($file,$libdir,$verbose,$nonono) = @_;
+    my($filepath,$libdir,$verbose,$nonono) = @_;
     my($dir);
+    my $file = (File::Spec->splitpath($filepath))[2];
     my %seen_dir = ();
+
+    my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'} 
+      ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
+
     foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
 						  privlibexp
 						  sitearchexp
 						  sitelibexp)}) {
-	next if $dir eq ".";
+	next if $dir eq $Curdir;
 	next if $seen_dir{$dir}++;
 	my($targetfile) = File::Spec->catfile($dir,$libdir,$file);
 	next unless -f $targetfile;
@@ -238,9 +350,9 @@ sub inc_uninstall {
 	# know, which is the file we just installed (AFS). So we leave
 	# an identical file in place
 	my $diff = 0;
-	if ( -f $targetfile && -s _ == -s $file) {
+	if ( -f $targetfile && -s _ == -s $filepath) {
 	    # We have a good chance, we can skip this one
-	    $diff = compare($file,$targetfile);
+	    $diff = compare($filepath,$targetfile);
 	} else {
 	    print "#$file and $targetfile differ\n" if $verbose>1;
 	    $diff++;
@@ -251,7 +363,10 @@ sub inc_uninstall {
 	    if ($verbose) {
 		$Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
 		$libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
-		$Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
+		$Inc_uninstall_warn_handler->add(
+                                     File::Spec->catfile($libdir, $file),
+                                     $targetfile
+                                    );
 	    }
 	    # if not verbose, we just say nothing
 	} else {
@@ -263,6 +378,7 @@ sub inc_uninstall {
 
 sub run_filter {
     my ($cmd, $src, $dest) = @_;
+    local(*CMD, *SRC);
     open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
     open(SRC, $src)           || die "Cannot open $src: $!";
     my $buf;
@@ -274,6 +390,24 @@ sub run_filter {
     close CMD or die "Filter command '$cmd' failed for $src";
 }
 
+
+=item B<pm_to_blib>
+
+    pm_to_blib(\%from_to, $autosplit_dir);
+    pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
+
+Copies each key of %from_to to its corresponding value efficiently.
+Filenames with the extension .pm are autosplit into the $autosplit_dir.
+
+$filter_cmd is an optional shell command to run each .pm file through
+prior to splitting and copying.  Input is the contents of the module,
+output the new module contents.
+
+You can have an environment variable PERL_INSTALL_ROOT set which will
+be prepended as a directory to each installed file (and directory).
+
+=cut
+
 sub pm_to_blib {
     my($fromto,$autodir,$pm_filter) = @_;
 
@@ -297,41 +431,65 @@ sub pm_to_blib {
      }
 
     mkpath($autodir,0,0755);
-    foreach (keys %$fromto) {
-	my $dest = $fromto->{$_};
-	next if -f $dest && -M $dest < -M $_;
+    while(my($from, $to) = each %$fromto) {
+	if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
+            print "Skip $to (unchanged)\n";
+            next;
+        }
 
 	# When a pm_filter is defined, we need to pre-process the source first
 	# to determine whether it has changed or not.  Therefore, only perform
 	# the comparison check when there's no filter to be ran.
 	#    -- RAM, 03/01/2001
 
-	my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/;
+	my $need_filtering = defined $pm_filter && length $pm_filter && 
+                             $from =~ /\.pm$/;
 
-	if (!$need_filtering && 0 == compare($_,$dest)) {
-	    print "Skip $dest (unchanged)\n";
+	if (!$need_filtering && 0 == compare($from,$to)) {
+	    print "Skip $to (unchanged)\n";
 	    next;
 	}
-	if (-f $dest){
-	    forceunlink($dest);
+	if (-f $to){
+	    forceunlink($to);
 	} else {
-	    mkpath(dirname($dest),0,0755);
+	    mkpath(dirname($to),0,0755);
 	}
 	if ($need_filtering) {
-	    run_filter($pm_filter, $_, $dest);
-	    print "$pm_filter <$_ >$dest\n";
+	    run_filter($pm_filter, $from, $to);
+	    print "$pm_filter <$from >$to\n";
 	} else {
-	    copy($_,$dest);
-	    print "cp $_ $dest\n";
+	    copy($from,$to);
+	    print "cp $from $to\n";
 	}
-	my($mode,$atime,$mtime) = (stat)[2,8,9];
-	utime($atime,$mtime+$Is_VMS,$dest);
-	chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest);
-	next unless /\.pm$/;
-	autosplit($dest,$autodir);
+	my($mode,$atime,$mtime) = (stat $from)[2,8,9];
+	utime($atime,$mtime+$Is_VMS,$to);
+	chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
+	next unless $from =~ /\.pm$/;
+	_autosplit($to,$autodir);
     }
 }
 
+
+=begin _private
+
+=item _autosplit
+
+From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
+the file being split.  This causes problems on systems with mandatory
+locking (ie. Windows).  So we wrap it and close the filehandle.
+
+=end _private
+
+=cut
+
+sub _autosplit {
+    my $retval = autosplit(@_);
+    close *AutoSplit::IN if defined *AutoSplit::IN{IO};
+
+    return $retval;
+}
+
+
 package ExtUtils::Install::Warn;
 
 sub new { bless {}, shift }
@@ -342,87 +500,57 @@ sub add {
 }
 
 sub DESTROY {
-	unless(defined $INSTALL_ROOT) {
-		my $self = shift;
-		my($file,$i,$plural);
-		foreach $file (sort keys %$self) {
-		$plural = @{$self->{$file}} > 1 ? "s" : "";
-		print "## Differing version$plural of $file found. You might like to\n";
-		for (0..$#{$self->{$file}}) {
-			print "rm ", $self->{$file}[$_], "\n";
-			$i++;
-		}
-		}
-		$plural = $i>1 ? "all those files" : "this file";
-		print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
-	}
+    unless(defined $INSTALL_ROOT) {
+        my $self = shift;
+        my($file,$i,$plural);
+        foreach $file (sort keys %$self) {
+            $plural = @{$self->{$file}} > 1 ? "s" : "";
+            print "## Differing version$plural of $file found. You might like to\n";
+            for (0..$#{$self->{$file}}) {
+                print "rm ", $self->{$file}[$_], "\n";
+                $i++;
+            }
+        }
+        $plural = $i>1 ? "all those files" : "this file";
+        print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
+    }
 }
 
-1;
+=back
 
-__END__
 
-=head1 NAME
+=head1 ENVIRONMENT
 
-ExtUtils::Install - install files from here to there
+=over 4
 
-=head1 SYNOPSIS
+=item B<PERL_INSTALL_ROOT>
 
-B<use ExtUtils::Install;>
+Will be prepended to each install path.
 
-B<install($hashref,$verbose,$nonono);>
+=back
 
-B<uninstall($packlistfile,$verbose,$nonono);>
+=head1 AUTHOR
 
-B<pm_to_blib($hashref);>
+Original author lost in the mists of time.  Probably the same as Makemaker.
 
-=head1 DESCRIPTION
+Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
 
-Both install() and uninstall() are specific to the way
-ExtUtils::MakeMaker handles the installation and deinstallation of
-perl modules. They are not designed as general purpose tools.
+Send patches and ideas to <F<makemaker@perl.org>>.
 
-install() takes three arguments. A reference to a hash, a verbose
-switch and a don't-really-do-it switch. The hash ref contains a
-mapping of directories: each key/value pair is a combination of
-directories to be copied. Key is a directory to copy from, value is a
-directory to copy to. The whole tree below the "from" directory will
-be copied preserving timestamps and permissions.
+Send bug reports via http://rt.cpan.org/.  Please send your
+generated Makefile along with your report.
 
-There are two keys with a special meaning in the hash: "read" and
-"write". After the copying is done, install will write the list of
-target files to the file named by C<$hashref-E<gt>{write}>. If there is
-another file named by C<$hashref-E<gt>{read}>, the contents of this file will
-be merged into the written file. The read and the written file may be
-identical, but on AFS it is quite likely that people are installing to a
-different directory than the one where the files later appear.
-
-install_default() takes one or less arguments.  If no arguments are 
-specified, it takes $ARGV[0] as if it was specified as an argument.  
-The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.  
-This function calls install() with the same arguments as the defaults 
-the MakeMaker would use.
-
-The argument-less form is convenient for install scripts like
-
-  perl -MExtUtils::Install -e install_default Tk/Canvas
-
-Assuming this command is executed in a directory with a populated F<blib> 
-directory, it will proceed as if the F<blib> was build by MakeMaker on 
-this machine.  This is useful for binary distributions.
-
-uninstall() takes as first argument a file containing filenames to be
-unlinked. The second argument is a verbose switch, the third is a
-no-don't-really-do-it-now switch.
-
-pm_to_blib() takes a hashref as the first argument and copies all keys
-of the hash to the corresponding values efficiently. Filenames with
-the extension pm are autosplit. Second argument is the autosplit
-directory.  If third argument is not empty, it is taken as a filter command
-to be ran on each .pm file, the output of the command being what is finally
-copied, and the source for auto-splitting.
+For more up-to-date information, see http://www.makemaker.org.
+
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
 
-You can have an environment variable PERL_INSTALL_ROOT set which will
-be prepended as a directory to each installed file (and directory).
 
 =cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
index de79088abbf..4b098083d98 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
@@ -1,18 +1,24 @@
 package ExtUtils::Liblist;
 
 use vars qw($VERSION);
-$VERSION = '1.00';
+$VERSION = '1.01';
 
 use File::Spec;
 require ExtUtils::Liblist::Kid;
 @ISA = qw(ExtUtils::Liblist::Kid File::Spec);
 
+# Backwards compatibility with old interface.
+sub ext {
+    goto &ExtUtils::Liblist::Kid::ext;
+}
+
 sub lsdir {
   shift;
   my $rex = qr/$_[1]/;
   opendir DIR, $_[0];
-  grep /$rex/, readdir DIR;
+  my @out = grep /$rex/, readdir DIR;
   closedir DIR;
+  return @out;
 }
 
 __END__
@@ -23,9 +29,12 @@ ExtUtils::Liblist - determine libraries to use and how to use them
 
 =head1 SYNOPSIS
 
-C<require ExtUtils::Liblist;>
+  require ExtUtils::Liblist;
+
+  $MM->ext($potential_libs, $verbose, $need_names);
 
-C<ExtUtils::Liblist::ext($self, $potential_libs, $verbose, $need_names);>
+  # Usually you can get away with:
+  ExtUtils::Liblist->ext($potential_libs, $verbose, $need_names)
 
 =head1 DESCRIPTION
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
index fb72f5fbe03..b85a0075990 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA);
 use ExtUtils::MakeMaker qw(neatvalue);
 use File::Spec;
 
-$VERSION = '1.03';
+$VERSION = '1.04';
 
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
@@ -32,16 +32,20 @@ the semantics.
 
 =over 4
 
+=item init_dist (o)
+
+Define TO_UNIX to convert OS2 linefeeds to Unix style.
+
 =cut
 
-sub dist {
-    my($self, %attribs) = @_;
+sub init_dist {
+    my($self) = @_;
 
-    $attribs{TO_UNIX} ||= sprintf <<'MAKE_TEXT', $self->{NOECHO};
-%s$(TEST_F) tmp.zip && $(RM) tmp.zip; $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip
+    $self->{TO_UNIX} ||= <<'MAKE_TEXT';
+$(NOECHO) $(TEST_F) tmp.zip && $(RM_F) tmp.zip; $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM_F) tmp.zip
 MAKE_TEXT
 
-    return $self->SUPER::dist(%attribs);
+    $self->SUPER::init_dist;
 }
 
 sub dlsyms {
@@ -117,38 +121,33 @@ sub maybe_command {
     return;
 }
 
-sub perl_archive {
-    return "\$(PERL_INC)/libperl\$(LIB_EXT)";
-}
+=item init_linker
 
-=item perl_archive_after
+=cut
 
-This is an internal method that returns path to a library which
-should be put on the linker command line I<after> the external libraries
-to be linked to dynamic extensions.  This may be needed if the linker
-is one-pass, and Perl includes some overrides for C RTL functions,
-such as malloc().
+sub init_linker {
+    my $self = shift;
 
-=cut 
+    $self->{PERL_ARCHIVE} = "\$(PERL_INC)/libperl\$(LIB_EXT)";
 
-sub perl_archive_after
-{
- return "\$(PERL_INC)/libperl_override\$(LIB_EXT)" unless $OS2::is_aout;
- return "";
+    $self->{PERL_ARCHIVE_AFTER} = $OS2::is_aout
+      ? ''
+      : '$(PERL_INC)/libperl_override$(LIB_EXT)';
+    $self->{EXPORT_LIST} = '$(BASEEXT).def';
 }
 
-sub export_list
-{
- my ($self) = @_;
- return "$self->{BASEEXT}.def";
-}
+=item os_flavor
 
-1;
+OS/2 is OS/2
 
-__END__
+=cut
 
-=pod
+sub os_flavor {
+    return('OS/2');
+}
 
 =back
 
 =cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
index ff813bc0ef0..97987332547 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
@@ -6,30 +6,42 @@ use strict;
 
 use Exporter ();
 use Carp;
-use Config;
+use Config         qw(%Config);
 use File::Basename qw(basename dirname fileparse);
-use File::Spec;
 use DirHandle;
-use strict;
+
 use vars qw($VERSION @ISA
-            $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_VOS
-            $Verbose %pm %static $Xsubpp_Version
+            $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Win95  $Is_Dos $Is_VOS
+            $Is_QNX $Is_AIX $Is_OSF $Is_IRIX  $Is_NetBSD $Is_BSD
+            $Is_SunOS4 $Is_Solaris $Is_SunOS
+            $Verbose %pm %static
             %Config_Override
            );
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue);
 
-$VERSION = '1.33';
+$VERSION = '1.42';
 
 require ExtUtils::MM_Any;
 @ISA = qw(ExtUtils::MM_Any);
 
-$Is_OS2   = $^O eq 'os2';
-$Is_Mac   = $^O eq 'MacOS';
-$Is_Win32 = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare';
-$Is_Dos   = $^O eq 'dos';
-$Is_VOS   = $^O eq 'vos';
-$Is_VMS   = $^O eq 'VMS';
+$Is_OS2     = $^O eq 'os2';
+$Is_Mac     = $^O eq 'MacOS';
+$Is_Win32   = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare';
+$Is_Win95   = $Is_Win32 && Win32::IsWin95();
+$Is_Dos     = $^O eq 'dos';
+$Is_VOS     = $^O eq 'vos';
+$Is_VMS     = $^O eq 'VMS';
+$Is_QNX     = $^O eq 'qnx';
+$Is_AIX     = $^O eq 'aix';
+$Is_OSF     = $^O eq 'dec_osf';
+$Is_IRIX    = $^O eq 'irix';
+$Is_NetBSD  = $^O eq 'netbsd';
+$Is_SunOS4  = $^O eq 'sunos';
+$Is_Solaris = $^O eq 'solaris';
+$Is_SunOS   = $Is_SunOS4 || $Is_Solaris;
+$Is_BSD     = $^O =~ /^(?:free|net|open)bsd|bsdos$/;
+
 
 =head1 NAME
 
@@ -65,7 +77,8 @@ will be overridable via the MY class.
 
 The following description of methods is still under
 development. Please refer to the code for not suitably documented
-sections and complain loudly to the makemaker mailing list.
+sections and complain loudly to the makemaker@perl.org mailing list.
+Better yet, provide a patch.
 
 Not all of the methods below are overridable in a
 Makefile.PL. Overridable methods are marked as (o). All methods are
@@ -75,102 +88,26 @@ L<ExtUtils::MM_VMS>) and L<ExtUtils::MM_OS2>).
 =cut
 
 # So we don't have to keep calling the methods over and over again,
-# we have these globals to cache the values.  They have to be global
-# else the SelfLoaded methods can't see them.
-use vars qw($Curdir $Rootdir $Updir);
-$Curdir  = File::Spec->curdir;
-$Rootdir = File::Spec->rootdir;
-$Updir   = File::Spec->updir;
-
-sub c_o;
-sub clean;
-sub const_cccmd;
-sub const_config;
-sub const_loadlibs;
-sub constants;
-sub depend;
-sub dir_target;
-sub dist;
-sub dist_basics;
-sub dist_ci;
-sub dist_core;
-sub dist_dir;
-sub dist_test;
-sub dlsyms;
-sub dynamic;
-sub dynamic_bs;
-sub dynamic_lib;
-sub exescan;
-sub export_list;
-sub extliblist;
-sub find_perl;
-sub fixin;
-sub force;
-sub guess_name;
-sub has_link_code;
-sub init_dirscan;
-sub init_main;
-sub init_others;
-sub install;
-sub installbin;
-sub libscan;
-sub linkext;
-sub lsdir;
-sub macro;
-sub makeaperl;
-sub makefile;
-sub manifypods;
-sub maybe_command;
-sub maybe_command_in_dirs;
-sub needs_linking;
-sub nicetext;
-sub parse_abstract;
-sub parse_version;
-sub pasthru;
-sub perl_archive;
-sub perl_archive_after;
-sub perl_script;
-sub perldepend;
-sub pm_to_blib;
-sub ppd;
-sub post_constants;
-sub post_initialize;
-sub postamble;
-sub prefixify;
-sub processPL;
-sub quote_paren;
-sub realclean;
-sub replace_manpage_separator;
-sub static;
-sub static_lib;
-sub staticmake;
-sub subdir_x;
-sub subdirs;
-sub test;
-sub test_via_harness;
-sub test_via_script;
-sub tool_autosplit;
-sub tool_xsubpp;
-sub tools_other;
-sub top_targets;
-sub writedoc;
-sub xs_c;
-sub xs_cpp;
-sub xs_o;
-sub xsubpp_version;
-
-#use SelfLoader;
-
-# SelfLoader not smart enough to avoid autoloading DESTROY
-sub DESTROY { }
-
-#1;
-
-#__DATA__
-
-=head2 SelfLoaded methods
+# we have these globals to cache the values.  Faster and shrtr.
+my $Curdir  = __PACKAGE__->curdir;
+my $Rootdir = __PACKAGE__->rootdir;
+my $Updir   = __PACKAGE__->updir;
+
+
+=head2 Methods
+
+=over 4
+
+=item os_flavor (o)
+
+Simply says that we're Unix.
+
+=cut
+
+sub os_flavor {
+    return('Unix');
+}
 
-=over 2
 
 =item c_o (o)
 
@@ -343,27 +280,11 @@ sub clean {
 # Delete temporary files but do not touch installed files. We don\'t delete
 # the Makefile here so a later make realclean still has a makefile to use.
 
-clean ::
+clean :: clean_subdirs
 ');
-    # clean subdirectories first
-    for $dir (@{$self->{DIR}}) {
-	if ($Is_Win32  &&  Win32::IsWin95()) {
-	    push @m, <<EOT;
-	cd $dir
-	\$(TEST_F) $self->{MAKEFILE}
-	\$(MAKE) clean
-	cd ..
-EOT
-	}
-	else {
-	    push @m, <<EOT;
-	-cd $dir && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) clean
-EOT
-	}
-    }
 
     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
-    if ( $^O eq 'qnx' ) {
+    if ( $Is_QNX ) {
       my @errfiles = @{$self->{C}};
       for ( @errfiles ) {
 	s/.c$/.err/;
@@ -373,6 +294,7 @@ EOT
     push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
     push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) 
                          $(INST_ARCHAUTODIR)/extralibs.all
+                         $(INST_ARCHAUTODIR)/extralibs.ld
 			 perlmain.c tmon.out mon.out so_locations pm_to_blib
 			 *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT)
 			 $(BOOTSTRAP) $(BASEEXT).bso
@@ -384,17 +306,52 @@ EOT
     }
     else {
         push(@otherfiles, qw[core core.*perl.*.? *perl.core]);
+
+        # core.\d+
+        push(@otherfiles, map { "core." . "[0-9]"x$_ } (1..5));
     }
 
-    push @m, "\t-$self->{RM_RF} @otherfiles\n";
+    push @m, "\t-\$(RM_RF) @otherfiles\n";
     # See realclean and ext/utils/make_ext for usage of Makefile.old
     push(@m,
-	 "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old \$(DEV_NULL)\n");
+	 "\t-\$(MV) \$(FIRST_MAKEFILE) \$(MAKEFILE_OLD) \$(DEV_NULL)\n");
     push(@m,
 	 "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
     join("", @m);
 }
 
+
+=item clean_subdirs_target
+
+  my $make_frag = $MM->clean_subdirs_target;
+
+Returns the clean_subdirs target.  This is used by the clean target to
+call clean on any subdirectories which contain Makefiles.
+
+=cut
+
+sub clean_subdirs_target {
+    my($self) = shift;
+
+    # No subdirectories, no cleaning.
+    return <<'NOOP_FRAG' unless @{$self->{DIR}};
+clean_subdirs :
+	$(NOECHO) $(NOOP)
+NOOP_FRAG
+
+
+    my $clean = "clean_subdirs :\n";
+
+    for my $dir (@{$self->{DIR}}) {
+        $clean .= sprintf <<'MAKE_FRAG', $dir;
+	-cd %s && $(TEST_F) $(FIRST_MAKEFILE) && $(MAKE) clean
+MAKE_FRAG
+    }
+
+    return $clean;
+}
+
+
 =item const_cccmd (o)
 
 Returns the full compiler call for C programs and stores the
@@ -430,7 +387,7 @@ sub const_config {
     my(%once_only);
     foreach $m (@{$self->{CONFIG}}){
 	# SITE*EXP macros are defined in &constants; avoid duplicates here
-	next if $once_only{$m} or $m eq 'sitelibexp' or $m eq 'sitearchexp';
+	next if $once_only{$m};
 	$self->{uc $m} = quote_paren($self->{uc $m});
 	push @m, uc($m) , ' = ' , $self->{uc $m}, "\n";
 	$once_only{$m} = 1;
@@ -466,53 +423,58 @@ sub const_loadlibs {
 
 =item constants (o)
 
-Initializes lots of constants and .SUFFIXES and .PHONY
+  my $make_frag = $mm->constants;
+
+Prints out macros for lots of constants.
 
 =cut
 
 sub constants {
     my($self) = @_;
-    my(@m,$tmp);
+    my @m = ();
 
-    for $tmp (qw/
+    for my $macro (qw(
 
-	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
-	      VERSION_SYM XS_VERSION 
-	      INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB
+              AR_STATIC_ARGS DIRFILESEP
+              NAME NAME_SYM 
+              VERSION    VERSION_MACRO    VERSION_SYM DEFINE_VERSION
+              XS_VERSION XS_VERSION_MACRO             XS_DEFINE_VERSION
+              INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB
+              INST_MAN1DIR INST_MAN3DIR
+              MAN1EXT      MAN3EXT
               INSTALLDIRS
-              PREFIX          SITEPREFIX      VENDORPREFIX
-	      INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
-	      INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
-              INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN  INSTALLSCRIPT 
-              PERL_LIB        PERL_ARCHLIB 
-              SITELIBEXP      SITEARCHEXP 
+              DESTDIR PREFIX
+              PERLPREFIX      SITEPREFIX      VENDORPREFIX
+                   ),
+                   (map { ("INSTALL".$_,
+                          "DESTINSTALL".$_)
+                        } $self->installvars),
+                   qw(
+              PERL_LIB    
+              PERL_ARCHLIB
               LIBPERL_A MYEXTLIB
-	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC
-	      PERL_INC PERL FULLPERL PERLRUN FULLPERLRUN PERLRUNINST 
-              FULLPERLRUNINST ABSPERL ABSPERLRUN ABSPERLRUNINST
-              FULL_AR PERL_CORE NOOP NOECHO
-
-	      / ) 
+              FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE 
+              PERLMAINCC PERL_SRC PERL_INC 
+              PERL            FULLPERL          ABSPERL
+              PERLRUN         FULLPERLRUN       ABSPERLRUN
+              PERLRUNINST     FULLPERLRUNINST   ABSPERLRUNINST
+              PERL_CORE
+              PERM_RW PERM_RWX
+
+	      ) ) 
     {
-	next unless defined $self->{$tmp};
+	next unless defined $self->{$macro};
 
         # pathnames can have sharp signs in them; escape them so
         # make doesn't think it is a comment-start character.
-        $self->{$tmp} =~ s/#/\\#/g;
-	push @m, "$tmp = $self->{$tmp}\n";
+        $self->{$macro} =~ s/#/\\#/g;
+	push @m, "$macro = $self->{$macro}\n";
     }
 
     push @m, qq{
-VERSION_MACRO = VERSION
-DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
-XS_VERSION_MACRO = XS_VERSION
-XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
-PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
-};
-
-    push @m, qq{
-MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'}
-MM_VERSION = $ExtUtils::MakeMaker::VERSION
+MAKEMAKER   = $self->{MAKEMAKER}
+MM_VERSION  = $self->{MM_VERSION}
+MM_REVISION = $self->{MM_REVISION}
 };
 
     push @m, q{
@@ -522,115 +484,64 @@ MM_VERSION = $ExtUtils::MakeMaker::VERSION
 # DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
 };
 
-    for $tmp (qw/
+    for my $macro (qw/
 	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
 	      LDFROM LINKTYPE PM_FILTER
 	      /	) 
     {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
+	next unless defined $self->{$macro};
+	push @m, "$macro = $self->{$macro}\n";
     }
 
     push @m, "
 # Handy lists of source code files:
-XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})."
-C_FILES = ".join(" \\\n\t", @{$self->{C}})."
-O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})."
-H_FILES = ".join(" \\\n\t", @{$self->{H}})."
-MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})."
-MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
+XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})."
+C_FILES  = ".$self->wraplist(@{$self->{C}})."
+O_FILES  = ".$self->wraplist(@{$self->{O_FILES}})."
+H_FILES  = ".$self->wraplist(@{$self->{H}})."
+MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})."
+MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})."
 ";
 
-    for $tmp (qw/
-	      INST_MAN1DIR  MAN1EXT 
-              INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
-	      INST_MAN3DIR  MAN3EXT
-              INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
-	      /) 
-    {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
-    }
-
-    for $tmp (qw(
-		PERM_RW PERM_RWX
-		)
-	     ) 
-    {
-        my $method = lc($tmp);
-	# warn "self[$self] method[$method]";
-        push @m, "$tmp = ", $self->$method(), "\n";
-    }
 
     push @m, q{
-.NO_CONFIG_REC: Makefile
-} if $ENV{CLEARCASE_ROOT};
-
-    # why not q{} ? -- emacs
-    push @m, qq{
-# work around a famous dec-osf make(1) feature(?):
-makemakerdflt: all
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DIRFILESEP)Config.pm $(PERL_INC)$(DIRFILESEP)config.h
+};
 
-.SUFFIXES: .xs .c .C .cpp .i .s .cxx .cc \$(OBJ_EXT)
 
-# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
-# some make implementations will delete the Makefile when we rebuild it. Because
-# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
-# does so. Our milage may vary.
-# .PRECIOUS: Makefile    # seems to be not necessary anymore
+    push @m, qq{
+# Where to build things
+INST_LIBDIR      = $self->{INST_LIBDIR}
+INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
 
-.PHONY: all config static dynamic test linkext manifest
+INST_AUTODIR     = $self->{INST_AUTODIR}
+INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
 
-# Where is the Config information that we are using/depend on
-CONFIGDEP = \$(PERL_ARCHLIB)/Config.pm \$(PERL_INC)/config.h
+INST_STATIC      = $self->{INST_STATIC}
+INST_DYNAMIC     = $self->{INST_DYNAMIC}
+INST_BOOT        = $self->{INST_BOOT}
 };
 
-    my @parentdir = split(/::/, $self->{PARENT_NAME});
-    push @m, q{
-# Where to put things:
-INST_LIBDIR      = }. File::Spec->catdir('$(INST_LIB)',@parentdir)        .q{
-INST_ARCHLIBDIR  = }. File::Spec->catdir('$(INST_ARCHLIB)',@parentdir)    .q{
 
-INST_AUTODIR     = }. File::Spec->catdir('$(INST_LIB)','auto','$(FULLEXT)')       .q{
-INST_ARCHAUTODIR = }. File::Spec->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)')   .q{
+    push @m, qq{
+# Extra linker info
+EXPORT_LIST        = $self->{EXPORT_LIST}
+PERL_ARCHIVE       = $self->{PERL_ARCHIVE}
+PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER}
 };
 
-    if ($self->has_link_code()) {
-	push @m, '
-INST_STATIC  = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
-INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
-INST_BOOT    = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
-';
-    } else {
-	push @m, '
-INST_STATIC  =
-INST_DYNAMIC =
-INST_BOOT    =
-';
-    }
-
-    $tmp = $self->export_list;
-    push @m, "
-EXPORT_LIST = $tmp
-";
-    $tmp = $self->perl_archive;
-    push @m, "
-PERL_ARCHIVE = $tmp
-";
-    $tmp = $self->perl_archive_after;
     push @m, "
-PERL_ARCHIVE_AFTER = $tmp
-";
 
-    push @m, q{
-TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{
+TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})."
 
-PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
-};
+PM_TO_BLIB = ".$self->wraplist(%{$self->{PM}})."
+";
 
     join('',@m);
 }
 
+
 =item depend (o)
 
 Same as macro for the depend attribute.
@@ -669,8 +580,8 @@ sub dir_target {
     my($self,@dirs) = @_;
     my(@m,$dir,$targdir);
     foreach $dir (@dirs) {
-	my($src) = File::Spec->catfile($self->{PERL_INC},'perl.h');
-	my($targ) = File::Spec->catfile($dir,'.exists');
+	my($src) = $self->catfile($self->{PERL_INC},'perl.h');
+	my($targ) = $self->catfile($dir,'.exists');
 	# catfile may have adapted syntax of $dir to target OS, so...
 	if ($Is_VMS) { # Just remove file name; dirspec is often in macro
 	    ($targdir = $targ) =~ s:/?\.exists\z::;
@@ -681,53 +592,131 @@ sub dir_target {
 	next if $self->{DIR_TARGET}{$self}{$targdir}++;
 	push @m, qq{
 $targ :: $src
-	$self->{NOECHO}\$(MKPATH) $targdir
-	$self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ
+	\$(NOECHO) \$(MKPATH) $targdir
+	\$(NOECHO) \$(EQUALIZE_TIMESTAMP) $src $targ
 };
 	push(@m, qq{
-	-$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $targdir
+	-\$(NOECHO) \$(CHMOD) \$(PERM_RWX) $targdir
 }) unless $Is_VMS;
     }
     join "", @m;
 }
 
-=item dist (o)
+=item init_DEST
+
+  $mm->init_DEST
+
+Defines the DESTDIR and DEST* variables paralleling the INSTALL*.
+
+=cut
+
+sub init_DEST {
+    my $self = shift;
+
+    # Initialize DESTDIR
+    $self->{DESTDIR} ||= '';
+
+    # Make DEST variables.
+    foreach my $var ($self->installvars) {
+        my $destvar = 'DESTINSTALL'.$var;
+        $self->{$destvar} ||= '$(DESTDIR)$(INSTALL'.$var.')';
+    }
+}
+
+
+=item init_dist
+
+  $mm->init_dist;
 
 Defines a lot of macros for distribution support.
 
+  macro         description                     default
+
+  TAR           tar command to use              tar
+  TARFLAGS      flags to pass to TAR            cvf
+
+  ZIP           zip command to use              zip
+  ZIPFLAGS      flags to pass to ZIP            -r
+
+  COMPRESS      compression command to          gzip --best
+                use for tarfiles
+  SUFFIX        suffix to put on                .gz 
+                compressed files
+
+  SHAR          shar command to use             shar
+
+  PREOP         extra commands to run before
+                making the archive 
+  POSTOP        extra commands to run after
+                making the archive
+
+  TO_UNIX       a command to convert linefeeds
+                to Unix style in your archive 
+
+  CI            command to checkin your         ci -u
+                sources to version control
+  RCS_LABEL     command to label your sources   rcs -Nv$(VERSION_SYM): -q
+                just after CI is run
+
+  DIST_CP       $how argument to manicopy()     best
+                when the distdir is created
+
+  DIST_DEFAULT  default target to use to        tardist
+                create a distribution
+
+  DISTVNAME     name of the resulting archive   $(DISTNAME)-$(VERSION)
+                (minus suffixes)
+
+=cut
+
+sub init_dist {
+    my $self = shift;
+
+    $self->{TAR}      ||= 'tar';
+    $self->{TARFLAGS} ||= 'cvf';
+    $self->{ZIP}      ||= 'zip';
+    $self->{ZIPFLAGS} ||= '-r';
+    $self->{COMPRESS} ||= 'gzip --best';
+    $self->{SUFFIX}   ||= '.gz';
+    $self->{SHAR}     ||= 'shar';
+    $self->{PREOP}    ||= '$(NOECHO) $(NOOP)'; # eg update MANIFEST
+    $self->{POSTOP}   ||= '$(NOECHO) $(NOOP)'; # eg remove the distdir
+    $self->{TO_UNIX}  ||= '$(NOECHO) $(NOOP)';
+
+    $self->{CI}       ||= 'ci -u';
+    $self->{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q';
+    $self->{DIST_CP}  ||= 'best';
+    $self->{DIST_DEFAULT} ||= 'tardist';
+
+    ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME};
+    $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION};
+
+}
+
+=item dist (o)
+
+  my $dist_macros = $mm->dist(%overrides);
+
+Generates a make fragment defining all the macros initialized in
+init_dist.
+
+%overrides can be used to override any of the above.
+
 =cut
 
 sub dist {
     my($self, %attribs) = @_;
 
-    # VERSION should be sanitised before use as a file name
-    $attribs{VERSION}  ||= '$(VERSION)';
-    $attribs{NAME}     ||= '$(DISTNAME)';
-    $attribs{TAR}      ||= 'tar';
-    $attribs{TARFLAGS} ||= 'cvf';
-    $attribs{ZIP}      ||= 'zip';
-    $attribs{ZIPFLAGS} ||= '-r';
-    $attribs{COMPRESS} ||= 'gzip --best';
-    $attribs{SUFFIX}   ||= '.gz';
-    $attribs{SHAR}     ||= 'shar';
-    $attribs{PREOP}    ||= "$self->{NOECHO}\$(NOOP)"; # eg update MANIFEST
-    $attribs{POSTOP}   ||= "$self->{NOECHO}\$(NOOP)"; # eg remove the distdir
-    $attribs{TO_UNIX}  ||= "$self->{NOECHO}\$(NOOP)";
-
-    $attribs{CI}       ||= 'ci -u';
-    $attribs{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q';
-    $attribs{DIST_CP}  ||= 'best';
-    $attribs{DIST_DEFAULT} ||= 'tardist';
-
-    $attribs{DISTVNAME} ||= "$attribs{NAME}-$attribs{VERSION}";
-
-    # We've already printed out VERSION and NAME variables.
-    delete $attribs{VERSION};
-    delete $attribs{NAME};
-
     my $make = '';
-    while(my($var, $value) = each %attribs) {
-        $make .= "$var = $value\n";
+    foreach my $key (qw( 
+            TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR
+            PREOP POSTOP TO_UNIX
+            CI RCS_LABEL DIST_CP DIST_DEFAULT
+            DISTNAME DISTVNAME
+           ))
+    {
+        my $value = $attribs{$key} || $self->{$key};
+        $make .= "$key = $value\n";
     }
 
     return $make;
@@ -770,35 +759,116 @@ Defines a check in target for RCS.
 
 sub dist_ci {
     my($self) = shift;
-    my @m;
-    push @m, q{
+    return q{
 ci :
 	$(PERLRUN) "-MExtUtils::Manifest=maniread" \\
-		-e "@all = keys %{ maniread() };" \\
-		-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\
-		-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+	  -e "@all = keys %{ maniread() };" \\
+	  -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \\
+	  -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
 };
-    join "", @m;
 }
 
 =item dist_core (o)
 
-Defines the targets dist, tardist, zipdist, uutardist, shdist
+  my $dist_make_fragment = $MM->dist_core;
+
+Puts the targets necessary for 'make dist' together into one make
+fragment.
 
 =cut
 
 sub dist_core {
     my($self) = shift;
-    my @m;
-    push @m, q{
-dist : $(DIST_DEFAULT)
-	}.$self->{NOECHO}.q{$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
-	    -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "}.$self->{MAKEFILE}.q{";'
 
+    my $make_frag = '';
+    foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile 
+                           shdist))
+    {
+        my $method = $target.'_target';
+        $make_frag .= "\n";
+        $make_frag .= $self->$method();
+    }
+
+    return $make_frag;
+}
+
+
+=item B<dist_target>
+
+  my $make_frag = $MM->dist_target;
+
+Returns the 'dist' target to make an archive for distribution.  This
+target simply checks to make sure the Makefile is up-to-date and
+depends on $(DIST_DEFAULT).
+
+=cut
+
+sub dist_target {
+    my($self) = shift;
+
+    my $date_check = $self->oneliner(<<'CODE', ['-l']);
+print 'Warning: Makefile possibly out of date with $(VERSION_FROM)'
+    if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)';
+CODE
+
+    return sprintf <<'MAKE_FRAG', $date_check;
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+	$(NOECHO) %s
+MAKE_FRAG
+}
+
+=item B<tardist_target>
+
+  my $make_frag = $MM->tardist_target;
+
+Returns the 'tardist' target which is simply so 'make tardist' works.
+The real work is done by the dynamically named tardistfile_target()
+method, tardist should have that as a dependency.
+
+=cut
+
+sub tardist_target {
+    my($self) = shift;
+
+    return <<'MAKE_FRAG';
 tardist : $(DISTVNAME).tar$(SUFFIX)
+	$(NOECHO) $(NOOP)
+MAKE_FRAG
+}
+
+=item B<zipdist_target>
+
+  my $make_frag = $MM->zipdist_target;
+
+Returns the 'zipdist' target which is simply so 'make zipdist' works.
+The real work is done by the dynamically named zipdistfile_target()
+method, zipdist should have that as a dependency.
+
+=cut
+
+sub zipdist_target {
+    my($self) = shift;
 
+    return <<'MAKE_FRAG';
 zipdist : $(DISTVNAME).zip
+	$(NOECHO) $(NOOP)
+MAKE_FRAG
+}
+
+=item B<tarfile_target>
+
+  my $make_frag = $MM->tarfile_target;
+
+The name of this target is the name of the tarball generated by
+tardist.  This target does the actual work of turning the distdir into
+a tarball.
+
+=cut
+
+sub tarfile_target {
+    my($self) = shift;
 
+    return <<'MAKE_FRAG';
 $(DISTVNAME).tar$(SUFFIX) : distdir
 	$(PREOP)
 	$(TO_UNIX)
@@ -806,39 +876,84 @@ $(DISTVNAME).tar$(SUFFIX) : distdir
 	$(RM_RF) $(DISTVNAME)
 	$(COMPRESS) $(DISTVNAME).tar
 	$(POSTOP)
+MAKE_FRAG
+}
+
+=item zipfile_target
+
+  my $make_frag = $MM->zipfile_target;
+
+The name of this target is the name of the zip file generated by
+zipdist.  This target does the actual work of turning the distdir into
+a zip file.
 
+=cut
+
+sub zipfile_target {
+    my($self) = shift;
+
+    return <<'MAKE_FRAG';
 $(DISTVNAME).zip : distdir
 	$(PREOP)
 	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
+MAKE_FRAG
+}
+
+=item uutardist_target
+
+  my $make_frag = $MM->uutardist_target;
 
+Converts the tarfile into a uuencoded file
+
+=cut
+
+sub uutardist_target {
+    my($self) = shift;
+
+    return <<'MAKE_FRAG';
 uutardist : $(DISTVNAME).tar$(SUFFIX)
-	uuencode $(DISTVNAME).tar$(SUFFIX) \\
-		$(DISTVNAME).tar$(SUFFIX) > \\
-		$(DISTVNAME).tar$(SUFFIX)_uu
+	uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
+MAKE_FRAG
+}
+
 
+=item shdist_target
+
+  my $make_frag = $MM->shdist_target;
+
+Converts the distdir into a shell archive.
+
+=cut
+
+sub shdist_target {
+    my($self) = shift;
+
+    return <<'MAKE_FRAG';
 shdist : distdir
 	$(PREOP)
 	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
-};
-    join "", @m;
+MAKE_FRAG
 }
 
-=item dist_dir
+=item distdir
 
 Defines the scratch directory target that will hold the distribution
 before tar-ing (or shar-ing).
 
 =cut
 
-sub dist_dir {
+# For backwards compatibility.
+*dist_dir = *distdir;
+
+sub distdir {
     my($self) = shift;
 
     return <<'MAKE_FRAG';
-distdir :
+distdir : metafile metafile_addtomanifest
 	$(RM_RF) $(DISTVNAME)
 	$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
 		-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
@@ -877,7 +992,7 @@ files.
 sub dlsyms {
     my($self,%attribs) = @_;
 
-    return '' unless ($^O eq 'aix' && $self->needs_linking() );
+    return '' unless ($Is_AIX && $self->needs_linking() );
 
     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
@@ -916,11 +1031,8 @@ sub dynamic {
 
     my($self) = shift;
     '
-## $(INST_PM) has been moved to the all: target.
-## It remains here for awhile to allow for old usage: "make dynamic"
-#dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
-dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT)
-	'.$self->{NOECHO}.'$(NOOP)
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+	$(NOECHO) $(NOOP)
 ';
 }
 
@@ -936,25 +1048,25 @@ sub dynamic_bs {
 BOOTSTRAP =
 ' unless $self->has_link_code();
 
-    return '
-BOOTSTRAP = '."$self->{BASEEXT}.bs".'
+    return <<'MAKE_FRAG';
+BOOTSTRAP = $(BASEEXT).bs
 
 # As Mkbootstrap might not write a file (if none is required)
 # we use touch to prevent make continually trying to remake it.
 # The DynaLoader only reads a non-empty file.
-$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists
-	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
-	'.$self->{NOECHO}.'$(PERLRUN) \
+$(BOOTSTRAP): $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+	$(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	$(NOECHO) $(PERLRUN) \
 		"-MExtUtils::Mkbootstrap" \
-		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
-	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
+		-e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
+	$(NOECHO) $(TOUCH) $(BOOTSTRAP)
 	$(CHMOD) $(PERM_RW) $@
 
-$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
-	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
-	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+	$(NOECHO) $(RM_RF) $(INST_BOOT)
+	-$(CP) $(BOOTSTRAP) $(INST_BOOT)
 	$(CHMOD) $(PERM_RW) $@
-';
+MAKE_FRAG
 }
 
 =item dynamic_lib (o)
@@ -973,27 +1085,29 @@ sub dynamic_lib {
     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
     my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":";
     my($ldfrom) = '$(LDFROM)';
-    $armaybe = 'ar' if ($^O eq 'dec_osf' and $armaybe eq ':');
+    $armaybe = 'ar' if ($Is_OSF and $armaybe eq ':');
     my(@m);
     my $ld_opt = $Is_OS2 ? '$(OPTIMIZE) ' : '';	# Useful on other systems too?
+    my $ld_fix = $Is_OS2 ? '|| ( $(RM_F) $@ && sh -c false )' : '';
     push(@m,'
 # This section creates the dynamically loadable $(INST_DYNAMIC)
 # from $(OBJECT) and possibly $(MYEXTLIB).
 ARMAYBE = '.$armaybe.'
 OTHERLDFLAGS = '.$ld_opt.$otherldflags.'
 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
+INST_DYNAMIC_FIX = '.$ld_fix.'
 
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
 ');
     if ($armaybe ne ':'){
 	$ldfrom = 'tmp$(LIB_EXT)';
 	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
 	push(@m,'	$(RANLIB) '."$ldfrom\n");
     }
-    $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
+    $ldfrom = "-all $ldfrom -none" if $Is_OSF;
 
     # The IRIX linker doesn't use LD_RUN_PATH
-    my $ldrun = $^O eq 'irix' && $self->{LD_RUN_PATH} ?         
+    my $ldrun = $Is_IRIX && $self->{LD_RUN_PATH} ?         
                        qq{-rpath "$self->{LD_RUN_PATH}"} : '';
 
     # For example in AIX the shared objects/libraries from previous builds
@@ -1006,7 +1120,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
 
     my $libs = '$(LDLOADLIBS)';
 
-    if ($^O eq 'netbsd') {
+    if ($Is_NetBSD) {
 	# Use nothing on static perl platforms, and to the flags needed
 	# to link against the shared libperl library on shared perl
 	# platforms.  We peek at lddlflags to see if we need -Wl,-R
@@ -1022,7 +1136,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
 
     push(@m,
 '	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
-' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)');
+' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
     push @m, '
 	$(CHMOD) $(PERM_RWX) $@
 ';
@@ -1065,34 +1179,65 @@ sub find_perl {
     my($self, $ver, $names, $dirs, $trace) = @_;
     my($name, $dir);
     if ($trace >= 2){
-	print "Looking for perl $ver by these names:
+        print "Looking for perl $ver by these names:
 @$names
 in these dirs:
 @$dirs
 ";
     }
+
+    my $stderr_duped = 0;
+    local *STDERR_COPY;
+    unless ($Is_BSD) {
+        if( open(STDERR_COPY, '>&STDERR') ) {
+            $stderr_duped = 1;
+        }
+        else {
+            warn <<WARNING;
+find_perl() can't dup STDERR: $!
+You might see some garbage while we search for Perl
+WARNING
+        }
+    }
+
     foreach $name (@$names){
-	foreach $dir (@$dirs){
-	    next unless defined $dir; # $self->{PERL_SRC} may be undefined
-	    my ($abs, $val);
-	    if (File::Spec->file_name_is_absolute($name)) { # /foo/bar
-		$abs = $name;
-	    } elsif (File::Spec->canonpath($name) eq File::Spec->canonpath(basename($name))) { # foo
-		$abs = File::Spec->catfile($dir, $name);
-	    } else { # foo/bar
-		$abs = File::Spec->canonpath(File::Spec->catfile($Curdir, $name));
-	    }
-	    print "Checking $abs\n" if ($trace >= 2);
-	    next unless $self->maybe_command($abs);
-	    print "Executing $abs\n" if ($trace >= 2);
-	    $val = `$abs -e 'require $ver; print "VER_OK\n" ' 2>&1`;
-	    if ($val =~ /VER_OK/) {
-	        print "Using PERL=$abs\n" if $trace;
-	        return $abs;
-	    } elsif ($trace >= 2) {
-		print "Result: `$val'\n";
-	    }
-	}
+        foreach $dir (@$dirs){
+            next unless defined $dir; # $self->{PERL_SRC} may be undefined
+            my ($abs, $val);
+            if ($self->file_name_is_absolute($name)) {     # /foo/bar
+                $abs = $name;
+            } elsif ($self->canonpath($name) eq 
+                     $self->canonpath(basename($name))) {  # foo
+                $abs = $self->catfile($dir, $name);
+            } else {                                            # foo/bar
+                $abs = $self->catfile($Curdir, $name);
+            }
+            print "Checking $abs\n" if ($trace >= 2);
+            next unless $self->maybe_command($abs);
+            print "Executing $abs\n" if ($trace >= 2);
+
+            my $version_check = qq{$abs -e "require $ver; print qq{VER_OK\n}"};
+            # To avoid using the unportable 2>&1 to supress STDERR,
+            # we close it before running the command.
+            # However, thanks to a thread library bug in many BSDs
+            # ( http://www.freebsd.org/cgi/query-pr.cgi?pr=51535 )
+            # we cannot use the fancier more portable way in here
+            # but instead need to use the traditional 2>&1 construct.
+            if ($Is_BSD) {
+                $val = `$version_check 2>&1`;
+            } else {
+                close STDERR if $stderr_duped;
+                $val = `$version_check`;
+                open STDERR, '>&STDERR_COPY' if $stderr_duped;
+            }
+
+            if ($val =~ /^VER_OK/) {
+                print "Using PERL=$abs\n" if $trace;
+                return $abs;
+            } elsif ($trace >= 2) {
+                print "Result: '$val'\n";
+            }
+        }
     }
     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
     0; # false and not empty
@@ -1134,6 +1279,9 @@ sub fixin { # stolen from the pink Camel book, more or less
 
     my($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/;
     for my $file (@files) {
+        my $file_new = "$file.new";
+        my $file_bak = "$file.bak";
+
 	local(*FIXIN);
 	local(*FIXOUT);
 	open(FIXIN, $file) or croak "Can't process '$file': $!";
@@ -1154,13 +1302,13 @@ sub fixin { # stolen from the pink Camel book, more or less
                 $interpreter = $Config{perlpath};
             }
 	} else {
-	    my(@absdirs) = reverse grep {File::Spec->file_name_is_absolute} File::Spec->path;
+	    my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path;
 	    $interpreter = '';
 	    my($dir);
 	    foreach $dir (@absdirs) {
 		if ($self->maybe_command($cmd)) {
 		    warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter;
-		    $interpreter = File::Spec->catfile($dir,$cmd);
+		    $interpreter = $self->catfile($dir,$cmd);
 		}
 	    }
 	}
@@ -1185,11 +1333,10 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
 	    next;
 	}
 
-	unless ( open(FIXOUT,">$file.new") ) {
+	unless ( open(FIXOUT,">$file_new") ) {
 	    warn "Can't create new $file: $!\n";
 	    next;
 	}
-	my($dev,$ino,$mode) = stat FIXIN;
 	
 	# Print out the new #! line (or equivalent).
 	local $\;
@@ -1198,19 +1345,21 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
 	close FIXIN;
 	close FIXOUT;
 
-	unless ( rename($file, "$file.bak") ) {	
-	    warn "Can't rename $file to $file.bak: $!";
+        chmod 0666, $file_bak;
+        unlink $file_bak;
+	unless ( rename($file, $file_bak) ) {	
+	    warn "Can't rename $file to $file_bak: $!";
 	    next;
 	}
-	unless ( rename("$file.new", $file) ) {	
-	    warn "Can't rename $file.new to $file: $!";
-	    unless ( rename("$file.bak", $file) ) {
-	        warn "Can't rename $file.bak back to $file either: $!";
-		warn "Leaving $file renamed as $file.bak\n";
+	unless ( rename($file_new, $file) ) {	
+	    warn "Can't rename $file_new to $file: $!";
+	    unless ( rename($file_bak, $file) ) {
+	        warn "Can't rename $file_bak back to $file either: $!";
+		warn "Leaving $file renamed as $file_bak\n";
 	    }
 	    next;
 	}
-	unlink "$file.bak";
+	unlink $file_bak;
     } continue {
 	close(FIXIN) if fileno(FIXIN);
 	system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';;
@@ -1227,7 +1376,7 @@ sub force {
     my($self) = shift;
     '# Phony target to force checking subdirectories.
 FORCE:
-	'.$self->{NOECHO}.'$(NOOP)
+	$(NOECHO) $(NOOP)
 ';
 }
 
@@ -1273,14 +1422,17 @@ sub has_link_code {
 
 =item init_dirscan
 
-Initializes DIR, XS, PM, C, O_FILES, H, PL_FILES, MAN*PODS, EXE_FILES.
+Scans the directory structure and initializes DIR, XS, XS_FILES, PM,
+C, C_FILES, O_FILES, H, H_FILES, PL_FILES, MAN*PODS, EXE_FILES.
+
+Called by init_main.
 
 =cut
 
 sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     my($self) = @_;
     my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
-    local(%pm); #the sub in find() has to see this hash
+    my %pm;
 
     @ignore{qw(Makefile.PL test.pl t)} = (1,1,1);
 
@@ -1296,7 +1448,8 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	next unless $self->libscan($name);
 	if (-d $name){
 	    next if -l $name; # We do not support symlinks at all
-	    $dir{$name} = $name if (-f File::Spec->catfile($name,"Makefile.PL"));
+            next if $self->{NORECURS};
+	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
 	} elsif ($name =~ /\.xs\z/){
 	    my($c); ($c = $name) =~ s/\.xs\z/.c/;
 	    $xs{$name} = $c;
@@ -1316,10 +1469,10 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 		($pl_files{$name} = $name) =~ s/[._]pl\z//i ;
 	    }
 	    else { 
-                $pm{$name} = File::Spec->catfile($self->{INST_LIBDIR},$name); 
+                $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name); 
             }
 	} elsif ($name =~ /\.(p[ml]|pod)\z/){
-	    $pm{$name} = File::Spec->catfile($self->{INST_LIBDIR},$name);
+	    $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name);
 	}
     }
 
@@ -1349,14 +1502,14 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     # (which includes PARENT_NAME). This is a subtle distinction but one
     # that's important for nested modules.
 
-    if ($Is_VMS) {
-      # avoid logical name collisions by adding directory syntax
-      $self->{PMLIBDIRS} = ['./lib', './' . $self->{BASEEXT}]
-	unless $self->{PMLIBDIRS};
-    }
-    else {
-      $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}]
-       unless $self->{PMLIBDIRS};
+    unless( $self->{PMLIBDIRS} ) {
+        if( $Is_VMS ) {
+            # Avoid logical name vs directory collisions
+            $self->{PMLIBDIRS} = ['./lib', "./$self->{BASEEXT}"];
+        }
+        else {
+            $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}];
+        }
     }
 
     #only existing directories that aren't in $dir are allowed
@@ -1376,13 +1529,14 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	require File::Find;
         File::Find::find(sub {
             if (-d $_){
-                if ($_ eq "CVS" || $_ eq "RCS"){
+                unless ($self->libscan($_)){
                     $File::Find::prune = 1;
                 }
                 return;
             }
             return if /\#/;
             return if /~$/;    # emacs temp files
+            return if /,v$/;   # RCS files
 
 	    my $path   = $File::Find::name;
             my $prefix = $self->{INST_LIBDIR};
@@ -1391,7 +1545,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	    $prefix =  $self->{INST_LIB} 
                 if ($striplibpath = $path) =~ s:^(\W*)lib\W:$1:i;
 
-	    my($inst) = File::Spec->catfile($prefix,$striplibpath);
+	    my($inst) = $self->catfile($prefix,$striplibpath);
 	    local($_) = $inst; # for backwards compatibility
 	    $inst = $self->libscan($inst);
 	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
@@ -1400,21 +1554,25 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	}, @{$self->{PMLIBDIRS}});
     }
 
-    $self->{DIR} = [sort keys %dir] unless $self->{DIR};
-    $self->{XS}  = \%xs             unless $self->{XS};
-    $self->{PM}  = \%pm             unless $self->{PM};
-    $self->{C}   = [sort keys %c]   unless $self->{C};
-    my(@o_files) = @{$self->{C}};
-    $self->{O_FILES} = [grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files] ;
-    $self->{H}   = [sort keys %h]   unless $self->{H};
-    $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES};
+    $self->{PM}  ||= \%pm;
+    $self->{PL_FILES} ||= \%pl_files;
+
+    $self->{DIR} ||= [sort keys %dir];
+
+    $self->{XS}  ||= \%xs;
+    $self->{C}   ||= [sort keys %c];
+    my @o_files = @{$self->{C}};
+    $self->{O_FILES} = [grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files];
+                            
+    $self->{H}   ||= [sort keys %h];
 
     # Set up names of manual pages to generate from pods
     my %pods;
     foreach my $man (qw(MAN1 MAN3)) {
 	unless ($self->{"${man}PODS"}) {
 	    $self->{"${man}PODS"} = {};
-	    $pods{$man} = 1 unless $self->{"INST_${man}DIR"} =~ /^(none|\s*)$/;
+	    $pods{$man} = 1 unless 
+              $self->{"INST_${man}DIR"} =~ /^(none|\s*)$/;
 	}
     }
 
@@ -1425,7 +1583,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 		my($ispod)=0;
 		if (open(FH,"<$name")) {
 		    while (<FH>) {
-			if (/^=(head[1-4]|item|pod)\b/) {
+			if (/^=(?:head\d+|item|pod)\b/) {
 			    $ispod=1;
 			    last;
 			}
@@ -1438,7 +1596,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 		next unless $ispod;
 		if ($pods{MAN1}) {
 		    $self->{MAN1PODS}->{$name} =
-		      File::Spec->catfile("\$(INST_MAN1DIR)", basename($name).".\$(MAN1EXT)");
+		      $self->catfile("\$(INST_MAN1DIR)", basename($name).".\$(MAN1EXT)");
 		}
 	    }
 	}
@@ -1454,7 +1612,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 		my($ispod)=0;
 		if (open(FH,"<$name")) {
 		    while (<FH>) {
-			if (/^=(head[1-4]|item|pod)\b/) {
+			if (/^=head1\s+\w+/) {
 			    $ispod=1;
 			    last;
 			}
@@ -1479,26 +1637,42 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	    }
 	    my($manpagename) = $name;
 	    $manpagename =~ s/\.p(od|m|l)\z//;
-	    unless ($manpagename =~ s!^\W*lib\W+!!s) { # everything below lib is ok
-		$manpagename = File::Spec->catfile(split(/::/,$self->{PARENT_NAME}),$manpagename);
+           # everything below lib is ok
+	    unless($manpagename =~ s!^\W*lib\W+!!s) {
+		$manpagename = $self->catfile(
+                                split(/::/,$self->{PARENT_NAME}),$manpagename
+                               );
 	    }
 	    if ($pods{MAN3}) {
 		$manpagename = $self->replace_manpage_separator($manpagename);
 		$self->{MAN3PODS}->{$name} =
-		  File::Spec->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)");
+		  $self->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)");
 	    }
 	}
     }
 }
 
+=item init_DIRFILESEP
+
+Using / for Unix.  Called by init_main.
+
+=cut
+
+sub init_DIRFILESEP {
+    my($self) = shift;
+
+    $self->{DIRFILESEP} = '/';
+}
+    
+
 =item init_main
 
 Initializes AR, AR_STATIC_ARGS, BASEEXT, CONFIG, DISTNAME, DLBASE,
 EXE_EXT, FULLEXT, FULLPERL, FULLPERLRUN, FULLPERLRUNINST, INST_*,
-INSTALL*, INSTALLDIRS, LD, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME,
+INSTALL*, INSTALLDIRS, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME,
 OBJ_EXT, PARENT_NAME, PERL, PERL_ARCHLIB, PERL_INC, PERL_LIB,
 PERL_SRC, PERLRUN, PERLRUNINST, PREFIX, VERSION,
-VERSION_FROM, VERSION_SYM, XS_VERSION.
+VERSION_SYM, XS_VERSION.
 
 =cut
 
@@ -1514,7 +1688,7 @@ sub init_main {
 ### Only UNIX:
 ###    ($self->{FULLEXT} =
 ###     $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket
-    $self->{FULLEXT} = File::Spec->catdir(split /::/, $self->{NAME});
+    $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME});
 
 
     # Copied from DynaLoader:
@@ -1549,17 +1723,17 @@ sub init_main {
     unless ($self->{PERL_SRC}){
 	my($dir);
 	foreach $dir ($Updir,
-                      File::Spec->catdir($Updir,$Updir),
-                      File::Spec->catdir($Updir,$Updir,$Updir),
-                      File::Spec->catdir($Updir,$Updir,$Updir,$Updir),
-                      File::Spec->catdir($Updir,$Updir,$Updir,$Updir,$Updir))
+                  $self->catdir($Updir,$Updir),
+                  $self->catdir($Updir,$Updir,$Updir),
+                  $self->catdir($Updir,$Updir,$Updir,$Updir),
+                  $self->catdir($Updir,$Updir,$Updir,$Updir,$Updir))
         {
 	    if (
-		-f File::Spec->catfile($dir,"config_h.SH")
+		-f $self->catfile($dir,"config_h.SH")
 		&&
-		-f File::Spec->catfile($dir,"perl.h")
+		-f $self->catfile($dir,"perl.h")
 		&&
-		-f File::Spec->catfile($dir,"lib","Exporter.pm")
+		-f $self->catfile($dir,"lib","Exporter.pm")
 	       ) {
 		$self->{PERL_SRC}=$dir ;
 		last;
@@ -1571,28 +1745,28 @@ sub init_main {
       $self->{PERL_CORE} and !$self->{PERL_SRC};
 
     if ($self->{PERL_SRC}){
-	$self->{PERL_LIB}     ||= File::Spec->catdir("$self->{PERL_SRC}","lib");
+	$self->{PERL_LIB}     ||= $self->catdir("$self->{PERL_SRC}","lib");
 
         if (defined $Cross::platform) {
             $self->{PERL_ARCHLIB} = 
-              File::Spec->catdir("$self->{PERL_SRC}","xlib",$Cross::platform);
+              $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform);
             $self->{PERL_INC}     = 
-              File::Spec->catdir("$self->{PERL_SRC}","xlib",$Cross::platform, 
+              $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform, 
                                  $Is_Win32?("CORE"):());
         }
         else {
             $self->{PERL_ARCHLIB} = $self->{PERL_LIB};
             $self->{PERL_INC}     = ($Is_Win32) ? 
-              File::Spec->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC};
+              $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC};
         }
 
 	# catch a situation that has occurred a few times in the past:
 	unless (
-		-s File::Spec->catfile($self->{PERL_SRC},'cflags')
+		-s $self->catfile($self->{PERL_SRC},'cflags')
 		or
 		$Is_VMS
 		&&
-		-s File::Spec->catfile($self->{PERL_SRC},'perlshr_attr.opt')
+		-s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt')
 		or
 		$Is_Mac
 		or
@@ -1617,20 +1791,20 @@ from the perl source tree.
         my $old = $self->{PERL_LIB} || $self->{PERL_ARCHLIB} || $self->{PERL_INC};
 	$self->{PERL_LIB}     ||= $Config{privlibexp};
 	$self->{PERL_ARCHLIB} ||= $Config{archlibexp};
-	$self->{PERL_INC}     = File::Spec->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
+	$self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
 	my $perl_h;
 
-	if (not -f ($perl_h = File::Spec->catfile($self->{PERL_INC},"perl.h"))
+	if (not -f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))
 	    and not $old){
 	    # Maybe somebody tries to build an extension with an
 	    # uninstalled Perl outside of Perl build tree
 	    my $found;
 	    for my $dir (@INC) {
-	      $found = $dir, last if -e File::Spec->catdir($dir, "Config.pm");
+	      $found = $dir, last if -e $self->catdir($dir, "Config.pm");
 	    }
 	    if ($found) {
 	      my $inc = dirname $found;
-	      if (-e File::Spec->catdir($inc, "perl.h")) {
+	      if (-e $self->catdir($inc, "perl.h")) {
 		$self->{PERL_LIB}	   = $found;
 		$self->{PERL_ARCHLIB}	   = $found;
 		$self->{PERL_INC}	   = $inc;
@@ -1642,7 +1816,7 @@ EOP
 	    }
 	}
 	
-	unless(-f ($perl_h = File::Spec->catfile($self->{PERL_INC},"perl.h")))
+	unless(-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")))
         {
 	    die qq{
 Error: Unable to locate installed Perl libraries or Perl source code.
@@ -1668,10 +1842,6 @@ usually solves this kind of problem.
     # MakeMaker.
     $self->{INSTALLDIRS} ||= "site";
 
-
-    $self->init_INST;
-    $self->init_INSTALL;
-
     $self->{MAN1EXT} ||= $Config{man1ext};
     $self->{MAN3EXT} ||= $Config{man3ext};
 
@@ -1681,8 +1851,8 @@ usually solves this kind of problem.
     $self->{CONFIG} = [] unless (ref $self->{CONFIG});
     push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config);
     push(@{$self->{CONFIG}}, 'shellflags') if $Config{shellflags};
-    my(%once_only,$m);
-    foreach $m (@{$self->{CONFIG}}){
+    my(%once_only);
+    foreach my $m (@{$self->{CONFIG}}){
 	next if $once_only{$m};
 	print STDOUT "CONFIG key '$m' does not exist in Config.pm\n"
 		unless exists $Config{$m};
@@ -1700,7 +1870,6 @@ usually solves this kind of problem.
     $self->{AR_STATIC_ARGS} ||= "cr";
 
     # These should never be needed
-    $self->{LD} ||= 'ld';
     $self->{OBJ_EXT} ||= '.o';
     $self->{LIB_EXT} ||= '.a';
 
@@ -1711,61 +1880,32 @@ usually solves this kind of problem.
     # make a simple check if we find Exporter
     warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory
         (Exporter.pm not found)"
-	unless -f File::Spec->catfile("$self->{PERL_LIB}","Exporter.pm") ||
+	unless -f $self->catfile("$self->{PERL_LIB}","Exporter.pm") ||
         $self->{NAME} eq "ExtUtils::MakeMaker";
-
-    # Determine VERSION and VERSION_FROM
-    ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME};
-    if ($self->{VERSION_FROM}){
-	$self->{VERSION} = $self->parse_version($self->{VERSION_FROM});
-        if( $self->{VERSION} eq 'undef' ) {
-	    carp "WARNING: Setting VERSION via file ".
-                 "'$self->{VERSION_FROM}' failed\n";
-        }
-    }
-
-    # strip blanks
-    if (defined $self->{VERSION}) {
-	$self->{VERSION} =~ s/^\s+//;
-	$self->{VERSION} =~ s/\s+$//;
-    }
-    else {
-        $self->{VERSION} = '';
-    }
-    ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
-
-    $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION}";
-
-    # Graham Barr and Paul Marquess had some ideas how to ensure
-    # version compatibility between the *.pm file and the
-    # corresponding *.xs file. The bottomline was, that we need an
-    # XS_VERSION macro that defaults to VERSION:
-    $self->{XS_VERSION} ||= $self->{VERSION};
-
-
-    # --- Initialize Perl Binary Locations
-    $self->init_PERL;
 }
 
 =item init_others
 
-Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH,
-OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE,
-MAKEFILE, NOECHO, RM_F, RM_RF, TEST_F, TOUCH, CP, MV, CHMOD, UMASK_NULL
+Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH, LD,
+OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, SHELL, NOOP,
+FIRST_MAKEFILE, MAKEFILE_OLD, NOECHO, RM_F, RM_RF, TEST_F,
+TOUCH, CP, MV, CHMOD, UMASK_NULL, ECHO, ECHO_N
 
 =cut
 
 sub init_others {	# --- Initialize Other Attributes
     my($self) = shift;
 
+    $self->{LD} ||= 'ld';
+
     # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS}
     # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or
     # undefined. In any case we turn it into an anon array:
 
     # May check $Config{libs} too, thus not empty.
-    $self->{LIBS}=[''] unless $self->{LIBS};
+    $self->{LIBS} = [$self->{LIBS}] unless ref $self->{LIBS};
 
-    $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq 'SCALAR';
+    $self->{LIBS} = [''] unless @{$self->{LIBS}} && defined $self->{LIBS}[0];
     $self->{LD_RUN_PATH} = "";
     my($libs);
     foreach $libs ( @{$self->{LIBS}} ){
@@ -1801,36 +1941,62 @@ sub init_others {	# --- Initialize Other Attributes
                         : ($Config{usedl} ? 'dynamic' : 'static');
     };
 
-    # These get overridden for VMS and maybe some other systems
-    $self->{NOOP}  ||= '$(SHELL) -c true';
-    $self->{FIRST_MAKEFILE} ||= "Makefile";
-    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
-    $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
-    $self->{NOECHO} = '@' unless defined $self->{NOECHO};
-    $self->{RM_F}  ||= "rm -f";
-    $self->{RM_RF} ||= "rm -rf";
-    $self->{TOUCH} ||= "touch";
-    $self->{TEST_F} ||= "test -f";
-    $self->{CP} ||= "cp";
-    $self->{MV} ||= "mv";
-    $self->{CHMOD} ||= "chmod";
-    $self->{UMASK_NULL} ||= "umask 0";
-    $self->{DEV_NULL} ||= "> /dev/null 2>&1";
+    $self->{NOOP}               ||= '$(SHELL) -c true';
+    $self->{NOECHO}             = '@' unless defined $self->{NOECHO};
+
+    $self->{MAKEFILE}           ||= 'Makefile';
+    $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
+    $self->{MAKEFILE_OLD}       ||= '$(FIRST_MAKEFILE).old';
+    $self->{MAKE_APERL_FILE}    ||= '$(FIRST_MAKEFILE).aperl';
+
+    $self->{SHELL}              ||= $Config{sh} || '/bin/sh';
+
+    $self->{ECHO}       ||= 'echo';
+    $self->{ECHO_N}     ||= 'echo -n';
+    $self->{RM_F}       ||= "rm -f";
+    $self->{RM_RF}      ||= "rm -rf";
+    $self->{TOUCH}      ||= "touch";
+    $self->{TEST_F}     ||= "test -f";
+    $self->{CP}         ||= "cp";
+    $self->{MV}         ||= "mv";
+    $self->{CHMOD}      ||= "chmod";
+    $self->{MKPATH}     ||= '$(PERLRUN) "-MExtUtils::Command" -e mkpath';
+    $self->{EQUALIZE_TIMESTAMP} ||= 
+      '$(PERLRUN) "-MExtUtils::Command" -e eqtime';
+
+    $self->{UNINST}     ||= 0;
+    $self->{VERBINST}   ||= 0;
+    $self->{MOD_INSTALL} ||= 
+      $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
+install({@ARGV}, '$(VERBINST)', 0, '$(UNINST)');
+CODE
+    $self->{DOC_INSTALL} ||= 
+      '$(PERLRUN) "-MExtUtils::Command::MM" -e perllocal_install';
+    $self->{UNINSTALL}   ||= 
+      '$(PERLRUN) "-MExtUtils::Command::MM" -e uninstall';
+    $self->{WARN_IF_OLD_PACKLIST} ||= 
+      '$(PERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist';
+
+    $self->{UMASK_NULL}         ||= "umask 0";
+    $self->{DEV_NULL}           ||= "> /dev/null 2>&1";
+
+    return 1;
 }
 
 =item init_INST
 
     $mm->init_INST;
 
-Called by init_main.  Sets up all INST_* variables.
+Called by init_main.  Sets up all INST_* variables except those related
+to XS code.  Those are handled in init_xs.
 
 =cut
 
 sub init_INST {
     my($self) = shift;
 
-    $self->{INST_ARCHLIB} ||= File::Spec->catdir($Curdir,"blib","arch");
-    $self->{INST_BIN}     ||= File::Spec->catdir($Curdir,'blib','bin');
+    $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch");
+    $self->{INST_BIN}     ||= $self->catdir($Curdir,'blib','bin');
 
     # INST_LIB typically pre-set if building an extension after
     # perl has been built and installed. Setting INST_LIB allows
@@ -1839,30 +2005,29 @@ sub init_INST {
 	if ($self->{PERL_CORE}) {
             if (defined $Cross::platform) {
                 $self->{INST_LIB} = $self->{INST_ARCHLIB} = 
-                  File::Spec->catdir($self->{PERL_LIB},"..","xlib",
+                  $self->catdir($self->{PERL_LIB},"..","xlib",
                                      $Cross::platform);
             }
             else {
                 $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
             }
 	} else {
-	    $self->{INST_LIB} = File::Spec->catdir($Curdir,"blib","lib");
+	    $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
 	}
     }
 
     my @parentdir = split(/::/, $self->{PARENT_NAME});
-    $self->{INST_LIBDIR} = File::Spec->catdir($self->{INST_LIB},@parentdir);
-    $self->{INST_ARCHLIBDIR} = File::Spec->catdir($self->{INST_ARCHLIB},
-                                                  @parentdir);
-    $self->{INST_AUTODIR} = File::Spec->catdir($self->{INST_LIB},'auto',
-                                               $self->{FULLEXT});
-    $self->{INST_ARCHAUTODIR} = File::Spec->catdir($self->{INST_ARCHLIB},
-                                                   'auto',$self->{FULLEXT});
+    $self->{INST_LIBDIR}      = $self->catdir('$(INST_LIB)',     @parentdir);
+    $self->{INST_ARCHLIBDIR}  = $self->catdir('$(INST_ARCHLIB)', @parentdir);
+    $self->{INST_AUTODIR}     = $self->catdir('$(INST_LIB)', 'auto', 
+                                              '$(FULLEXT)');
+    $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto',
+                                              '$(FULLEXT)');
 
-    $self->{INST_SCRIPT} ||= File::Spec->catdir($Curdir,'blib','script');
+    $self->{INST_SCRIPT}  ||= $self->catdir($Curdir,'blib','script');
 
-    $self->{INST_MAN1DIR} ||= File::Spec->catdir($Curdir,'blib','man1');
-    $self->{INST_MAN3DIR} ||= File::Spec->catdir($Curdir,'blib','man3');
+    $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
+    $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
 
     return 1;
 }
@@ -1872,7 +2037,7 @@ sub init_INST {
     $mm->init_INSTALL;
 
 Called by init_main.  Sets up all INSTALL_* variables (except
-INSTALLDIRS) and PREFIX.
+INSTALLDIRS) and *PREFIX.
 
 =cut
 
@@ -1881,15 +2046,15 @@ sub init_INSTALL {
 
     $self->init_lib2arch;
 
-    if( $Config{usevendorprefix} ) {
-        $Config_Override{installvendorman1dir} =
-          File::Spec->catdir($Config{vendorprefixexp}, 'man', 'man$(MAN1EXT)');
-        $Config_Override{installvendorman3dir} =
-          File::Spec->catdir($Config{vendorprefixexp}, 'man', 'man$(MAN3EXT)');
-    }
-    else {
-        $Config_Override{installvendorman1dir} = '';
-        $Config_Override{installvendorman3dir} = '';
+    # Initialize installvendorman*dir if necessary
+    foreach my $num (1, 3) {
+        my $k = 'installvendorman'.$num.'dir';
+
+        unless ($Config{$k}) {
+            $Config_Override{$k} = $Config{usevendorprefix} ?
+                  $self->catdir($Config{vendorprefixexp}, 'man', "man$num") :
+                  '';
+        }
     }
 
     my $iprefix = $Config{installprefixexp} || $Config{installprefix} || 
@@ -1904,32 +2069,36 @@ sub init_INSTALL {
     # it up.
     unless( $Config{installsiteman1dir} ) {
         $Config_Override{installsiteman1dir} = 
-          File::Spec->catdir($sprefix, 'man', 'man$(MAN1EXT)');
+          $self->catdir($sprefix, 'man', 'man1');
     }
 
     unless( $Config{installsiteman3dir} ) {
         $Config_Override{installsiteman3dir} = 
-          File::Spec->catdir($sprefix, 'man', 'man$(MAN3EXT)');
+          $self->catdir($sprefix, 'man', 'man3');
     }
 
     unless( $Config{installsitebin} ) {
         $Config_Override{installsitebin} =
-          File::Spec->catdir($sprefix, 'bin');
+          $self->catdir($sprefix, 'bin');
     }
 
-    my $u_prefix  = $self->{PREFIX}       || '';
-    my $u_sprefix = $self->{SITEPREFIX}   || $u_prefix;
-    my $u_vprefix = $self->{VENDORPREFIX} || $u_prefix;
+    $self->{PREFIX}       ||= '';
 
-    $self->{PREFIX}       ||= $u_prefix  || $iprefix;
-    $self->{SITEPREFIX}   ||= $u_sprefix || $sprefix;
-    $self->{VENDORPREFIX} ||= $u_vprefix || $vprefix;
+    if( $self->{PREFIX} ) {
+        @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} =
+          ('$(PREFIX)') x 3;
+    }
+    else {
+        $self->{PERLPREFIX}   ||= $iprefix;
+        $self->{SITEPREFIX}   ||= $sprefix;
+        $self->{VENDORPREFIX} ||= $vprefix;
+    }
 
     my $arch    = $Config{archname};
     my $version = $Config{version};
 
     # default style
-    my $libstyle = 'lib/perl5';
+    my $libstyle = $Config{installstyle} || 'lib/perl5';
     my $manstyle = '';
 
     if( $self->{LIBSTYLE} ) {
@@ -1947,73 +2116,73 @@ sub init_INSTALL {
     my %bin_layouts = 
     (
         bin         => { s => $iprefix,
-                         r => $u_prefix,
+                         t => 'perl',
                          d => 'bin' },
         vendorbin   => { s => $vprefix,
-                         r => $u_vprefix,
+                         t => 'vendor',
                          d => 'bin' },
         sitebin     => { s => $sprefix,
-                         r => $u_sprefix,
+                         t => 'site',
                          d => 'bin' },
         script      => { s => $iprefix,
-                         r => $u_prefix,
+                         t => 'perl',
                          d => 'bin' },
     );
     
     my %man_layouts =
     (
         man1dir         => { s => $iprefix,
-                             r => $u_prefix,
-                             d => 'man/man$(MAN1EXT)',
+                             t => 'perl',
+                             d => 'man/man1',
                              style => $manstyle, },
         siteman1dir     => { s => $sprefix,
-                             r => $u_sprefix,
-                             d => 'man/man$(MAN1EXT)',
+                             t => 'site',
+                             d => 'man/man1',
                              style => $manstyle, },
         vendorman1dir   => { s => $vprefix,
-                             r => $u_vprefix,
-                             d => 'man/man$(MAN1EXT)',
+                             t => 'vendor',
+                             d => 'man/man1',
                              style => $manstyle, },
 
         man3dir         => { s => $iprefix,
-                             r => $u_prefix,
-                             d => 'man/man$(MAN3EXT)',
+                             t => 'perl',
+                             d => 'man/man3',
                              style => $manstyle, },
         siteman3dir     => { s => $sprefix,
-                             r => $u_sprefix,
-                             d => 'man/man$(MAN3EXT)',
+                             t => 'site',
+                             d => 'man/man3',
                              style => $manstyle, },
         vendorman3dir   => { s => $vprefix,
-                             r => $u_vprefix,
-                             d => 'man/man$(MAN3EXT)',
+                             t => 'vendor',
+                             d => 'man/man3',
                              style => $manstyle, },
     );
 
     my %lib_layouts =
     (
         privlib     => { s => $iprefix,
-                         r => $u_prefix,
+                         t => 'perl',
                          d => '',
                          style => $libstyle, },
         vendorlib   => { s => $vprefix,
-                         r => $u_vprefix,
+                         t => 'vendor',
                          d => '',
                          style => $libstyle, },
         sitelib     => { s => $sprefix,
-                         r => $u_sprefix,
+                         t => 'site',
                          d => 'site_perl',
                          style => $libstyle, },
         
         archlib     => { s => $iprefix,
-                         r => $u_prefix,
+                         t => 'perl',
                          d => "$version/$arch",
                          style => $libstyle },
         vendorarch  => { s => $vprefix,
-                         r => $u_vprefix,
+                         t => 'vendor',
                          d => "$version/$arch",
                          style => $libstyle },
         sitearch    => { s => $sprefix,
-                         r => $u_sprefix,
+                         t => 'site',
                          d => "site_perl/$version/$arch",
                          style => $libstyle },
     );
@@ -2026,7 +2195,7 @@ sub init_INSTALL {
 
             if( $var =~ /arch/ ) {
                 $self->{$Installvar} ||= 
-                  File::Spec->catdir($self->{LIB}, $Config{archname});
+                  $self->catdir($self->{LIB}, $Config{archname});
             }
             else {
                 $self->{$Installvar} ||= $self->{LIB};
@@ -2034,10 +2203,15 @@ sub init_INSTALL {
         }
     }
 
+    my %type2prefix = ( perl    => 'PERLPREFIX',
+                        site    => 'SITEPREFIX',
+                        vendor  => 'VENDORPREFIX'
+                      );
 
     my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
     while( my($var, $layout) = each(%layouts) ) {
-        my($s, $r, $d, $style) = @{$layout}{qw(s r d style)};
+        my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
+        my $r = '$('.$type2prefix{$t}.')';
 
         print STDERR "Prefixing $var\n" if $Verbose >= 2;
 
@@ -2045,22 +2219,34 @@ sub init_INSTALL {
         my $Installvar = uc $installvar;
         next if $self->{$Installvar};
 
-        if( $r ) {
-            $d = "$style/$d" if $style;
-            $self->prefixify($installvar, $s, $r, $d);
-        }
-        else {
-            $self->{$Installvar} = $Config_Override{$installvar} || 
-                                   $Config{$installvar};
-        }
+        $d = "$style/$d" if $style;
+        $self->prefixify($installvar, $s, $r, $d);
 
         print STDERR "  $Installvar == $self->{$Installvar}\n" 
           if $Verbose >= 2;
     }
 
+    # Generate these if they weren't figured out.
+    $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH};
+    $self->{VENDORLIBEXP}  ||= $self->{INSTALLVENDORLIB};
+
     return 1;
 }
 
+=item init_linker
+
+Unix has no need of special linker flags.
+
+=cut
+
+sub init_linker {
+    my($self) = shift;
+    $self->{PERL_ARCHIVE} ||= '';
+    $self->{PERL_ARCHIVE_AFTER} ||= '';
+    $self->{EXPORT_LIST}  ||= '';
+}
+
+
 =begin _protected
 
 =item init_lib2arch
@@ -2113,6 +2299,7 @@ Called by init_main.  Sets up ABSPERL, PERL, FULLPERL and all the
 
     PERL is allowed to be miniperl
     FULLPERL must be a complete perl
+
     ABSPERL is PERL converted to an absolute path
 
     *PERLRUN contains everything necessary to run perl, find it's
@@ -2134,8 +2321,15 @@ sub init_PERL {
     }
 
     # Build up a set of file names (not command names).
-    my $thisperl = File::Spec->canonpath($^X);
-    $thisperl .= $Config{exe_ext} unless $thisperl =~ m/$Config{exe_ext}$/i;
+    my $thisperl = $self->canonpath($^X);
+    $thisperl .= $Config{exe_ext} unless 
+                # VMS might have a file version # at the end
+      $Is_VMS ? $thisperl =~ m/$Config{exe_ext}(;\d+)?$/i
+              : $thisperl =~ m/$Config{exe_ext}$/i;
+
+    # We need a relative path to perl when in the core.
+    $thisperl = $self->abs2rel($thisperl) if $self->{PERL_CORE};
+
     my @perls = ($thisperl);
     push @perls, map { "$_$Config{exe_ext}" }
                      ('perl', 'perl5', "perl$Config{version}");
@@ -2155,19 +2349,26 @@ sub init_PERL {
     # don't check if perl is executable, maybe they have decided to
     # supply switches with perl
 
+    # When built for debugging, VMS doesn't create perl.exe but ndbgperl.exe.
+    my $perl_name = 'perl';
+    $perl_name = 'ndbgperl' if $Is_VMS && 
+      defined $Config{usevmsdebug} && $Config{usevmsdebug} eq 'define';
+
+    # XXX This logic is flawed.  If "miniperl" is anywhere in the path
+    # it will get confused.  It should be fixed to work only on the filename.
     # Define 'FULLPERL' to be a non-miniperl (used in test: target)
-    ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i
+    ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/$perl_name/i
 	unless $self->{FULLPERL};
 
     # Little hack to get around VMS's find_perl putting "MCR" in front
     # sometimes.
     $self->{ABSPERL} = $self->{PERL};
     my $has_mcr = $self->{ABSPERL} =~ s/^MCR\s*//;
-    if( File::Spec->file_name_is_absolute($self->{ABSPERL}) ) {
+    if( $self->file_name_is_absolute($self->{ABSPERL}) ) {
         $self->{ABSPERL} = '$(PERL)';
     }
     else {
-        $self->{ABSPERL} = File::Spec->rel2abs($self->{ABSPERL});
+        $self->{ABSPERL} = $self->rel2abs($self->{ABSPERL});
         $self->{ABSPERL} = 'MCR '.$self->{ABSPERL} if $has_mcr;
     }
 
@@ -2176,10 +2377,12 @@ sub init_PERL {
 
     # How do we run perl?
     foreach my $perl (qw(PERL FULLPERL ABSPERL)) {
-        $self->{$perl.'RUN'}  = "\$($perl)";
+        my $run  = $perl.'RUN';
+
+        $self->{$run}  = "\$($perl)";
 
         # Make sure perl can find itself before it's installed.
-        $self->{$perl.'RUN'} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} 
+        $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} 
           if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE};
 
         $self->{$perl.'RUNINST'} = 
@@ -2189,6 +2392,39 @@ sub init_PERL {
     return 1;
 }
 
+
+=item init_platform (o)
+
+Add MM_Unix_VERSION.
+
+=item platform_constants (o)
+
+=cut
+
+sub init_platform {
+    my($self) = shift;
+
+    $self->{MM_Unix_VERSION} = $VERSION;
+    $self->{PERL_MALLOC_DEF} = '-DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc '.
+                               '-Dfree=Perl_mfree -Drealloc=Perl_realloc '.
+                               '-Dcalloc=Perl_calloc';
+
+}
+
+sub platform_constants {
+    my($self) = shift;
+    my $make_frag = '';
+
+    foreach my $macro (qw(MM_Unix_VERSION PERL_MALLOC_DEF))
+    {
+        next unless defined $self->{$macro};
+        $make_frag .= "$macro = $self->{$macro}\n";
+    }
+
+    return $make_frag;
+}
+
+
 =item init_PERM
 
   $mm->init_PERM
@@ -2200,12 +2436,38 @@ Called by init_main.  Initializes PERL_*
 sub init_PERM {
     my($self) = shift;
 
-    $self->{PERM_RW}  = 644;
-    $self->{PERM_RWX} = 755;
+    $self->{PERM_RW}  = 644  unless defined $self->{PERM_RW};
+    $self->{PERM_RWX} = 755  unless defined $self->{PERM_RWX};
 
     return 1;
 }
-    
+
+
+=item init_xs
+
+    $mm->init_xs
+
+Sets up macros having to do with XS code.  Currently just INST_STATIC,
+INST_DYNAMIC and INST_BOOT.
+
+=cut
+
+sub init_xs {
+    my $self = shift;
+
+    if ($self->has_link_code()) {
+        $self->{INST_STATIC}  = 
+          $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)');
+        $self->{INST_DYNAMIC} = 
+          $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)');
+        $self->{INST_BOOT}    = 
+          $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs');
+    } else {
+        $self->{INST_STATIC}  = '';
+        $self->{INST_DYNAMIC} = '';
+        $self->{INST_BOOT}    = '';
+    }
+}    
 
 =item install (o)
 
@@ -2229,71 +2491,83 @@ install_vendor :: all pure_vendor_install doc_vendor_install
 pure_install :: pure_$(INSTALLDIRS)_install
 
 doc_install :: doc_$(INSTALLDIRS)_install
-	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
 
 pure__install : pure_site_install
-	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
 
 doc__install : doc_site_install
-	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
 
 pure_perl_install ::
-	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
-		read }.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
-		write }.File::Spec->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
-		$(INST_LIB) $(INSTALLPRIVLIB) \
-		$(INST_ARCHLIB) $(INSTALLARCHLIB) \
-		$(INST_BIN) $(INSTALLBIN) \
-		$(INST_SCRIPT) $(INSTALLSCRIPT) \
-		$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
-		$(INST_MAN3DIR) $(INSTALLMAN3DIR)
-	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
-		}.File::Spec->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{
+	$(NOECHO) $(MOD_INSTALL) \
+		read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(DESTINSTALLPRIVLIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+		$(INST_BIN) $(DESTINSTALLBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{
 
 
 pure_site_install ::
-	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
-		read }.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
-		write }.File::Spec->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \
-		$(INST_LIB) $(INSTALLSITELIB) \
-		$(INST_ARCHLIB) $(INSTALLSITEARCH) \
-		$(INST_BIN) $(INSTALLSITEBIN) \
-		$(INST_SCRIPT) $(INSTALLSCRIPT) \
-		$(INST_MAN1DIR) $(INSTALLSITEMAN1DIR) \
-		$(INST_MAN3DIR) $(INSTALLSITEMAN3DIR)
-	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
-		}.File::Spec->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{
+	$(NOECHO) $(MOD_INSTALL) \
+		read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(DESTINSTALLSITELIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+		$(INST_BIN) $(DESTINSTALLSITEBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{
 
 pure_vendor_install ::
-	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
-		$(INST_LIB) $(INSTALLVENDORLIB) \
-		$(INST_ARCHLIB) $(INSTALLVENDORARCH) \
-		$(INST_BIN) $(INSTALLVENDORBIN) \
-		$(INST_SCRIPT) $(INSTALLSCRIPT) \
-		$(INST_MAN1DIR) $(INSTALLVENDORMAN1DIR) \
-		$(INST_MAN3DIR) $(INSTALLVENDORMAN3DIR)
+	$(NOECHO) $(MOD_INSTALL) \
+		read }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(DESTINSTALLVENDORLIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+		$(INST_BIN) $(DESTINSTALLVENDORBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
 
 doc_perl_install ::
-	-}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB)
-	-}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+	-$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	-$(NOECHO) $(DOC_INSTALL) \
 		"Module" "$(NAME)" \
 		"installed into" "$(INSTALLPRIVLIB)" \
 		LINKTYPE "$(LINKTYPE)" \
 		VERSION "$(VERSION)" \
 		EXE_FILES "$(EXE_FILES)" \
-		>> }.File::Spec->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
 
 doc_site_install ::
-	-}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB)
-	-}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+	-$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	-$(NOECHO) $(DOC_INSTALL) \
 		"Module" "$(NAME)" \
 		"installed into" "$(INSTALLSITELIB)" \
 		LINKTYPE "$(LINKTYPE)" \
 		VERSION "$(VERSION)" \
 		EXE_FILES "$(EXE_FILES)" \
-		>> }.File::Spec->catfile('$(INSTALLSITEARCH)','perllocal.pod').q{
+		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
 
 doc_vendor_install ::
+	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+	-$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	-$(NOECHO) $(DOC_INSTALL) \
+		"Module" "$(NAME)" \
+		"installed into" "$(INSTALLVENDORLIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
 
 };
 
@@ -2301,12 +2575,13 @@ doc_vendor_install ::
 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
 
 uninstall_from_perldirs ::
-	}.$self->{NOECHO}.
-	q{$(UNINSTALL) }.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
+	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
 
 uninstall_from_sitedirs ::
-	}.$self->{NOECHO}.
-	q{$(UNINSTALL) }.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{
+	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{
+
+uninstall_from_vendordirs ::
+	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{
 };
 
     join("",@m);
@@ -2325,57 +2600,49 @@ sub installbin {
     my(@m, $from, $to, %fromto, @to);
     push @m, $self->dir_target(qw[$(INST_SCRIPT)]);
     for $from (@{$self->{EXE_FILES}}) {
-	my($path)= File::Spec->catfile('$(INST_SCRIPT)', basename($from));
+	my($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
 	local($_) = $path; # for backwards compatibility
 	$to = $self->libscan($path);
 	print "libscan($from) => '$to'\n" if ($Verbose >=2);
 	$fromto{$from}=$to;
     }
     @to   = values %fromto;
+
+    my $fixin;
+    if( $Is_Win32 ) {
+        $fixin = $self->{PERL_CORE} ? '$(PERLRUN) ../../win32/bin/pl2bat.pl'
+                                    : 'pl2bat.bat';
+    }
+    else {
+        $fixin = q{$(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"};
+    }
+
     push(@m, qq{
 EXE_FILES = @{$self->{EXE_FILES}}
 
-} . ($Is_Win32
-  ? q{FIXIN = pl2bat.bat
-} : q{FIXIN = $(PERLRUN) "-MExtUtils::MY" \
-    -e "MY->fixin(shift)"
-}).qq{
+FIXIN = $fixin
+
 pure_all :: @to
-	$self->{NOECHO}\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 realclean ::
-	$self->{RM_F} @to
+	\$(RM_F) @to
 });
 
     while (($from,$to) = each %fromto) {
 	last unless defined $from;
 	my $todir = dirname($to);
 	push @m, "
-$to: $from $self->{MAKEFILE} " . File::Spec->catdir($todir,'.exists') . "
-	$self->{NOECHO}$self->{RM_F} $to
-	$self->{CP} $from $to
+$to: $from \$(FIRST_MAKEFILE) " . $self->catdir($todir,'.exists') . "
+	\$(NOECHO) \$(RM_F) $to
+	\$(CP) $from $to
 	\$(FIXIN) $to
-	-$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $to
+	-\$(NOECHO) \$(CHMOD) \$(PERM_RWX) $to
 ";
     }
     join "", @m;
 }
 
-=item libscan (o)
-
-Takes a path to a file that is found by init_dirscan and returns false
-if we don't want to include this file in the library. Mainly used to
-exclude RCS, CVS, and SCCS directories from installation.
-
-=cut
-
-# ';
-
-sub libscan {
-    my($self,$path) = @_;
-    return '' if $path =~ m:\b(RCS|CVS|SCCS)\b: ;
-    $path;
-}
 
 =item linkext (o)
 
@@ -2390,7 +2657,7 @@ sub linkext {
       $attribs{LINKTYPE} : '$(LINKTYPE)';
     "
 linkext :: $linktype
-	$self->{NOECHO}\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 ";
 }
 
@@ -2461,8 +2728,8 @@ $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
 	$(MAKE) -f $(MAKE_APERL_FILE) $@
 
 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
-	}.$self->{NOECHO}.q{echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
-	}.$self->{NOECHO}.q{$(PERLRUNINST) \
+	$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+	$(NOECHO) $(PERLRUNINST) \
 		Makefile.PL DIR=}, $dir, q{ \
 		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
 		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=};
@@ -2592,10 +2859,10 @@ MAP_PRELIBS   = $Config{perllibs} $Config{cryptlib}
 
         if (! -f $libperl and ! -f $lperl) {
           # We did not find a static libperl. Maybe there is a shared one?
-          if ($^O eq 'solaris' or $^O eq 'sunos') {
+          if ($Is_SunOS) {
             $lperl  = $libperl = "$dir/$Config{libperl}";
             # SUNOS ld does not take the full path to a shared library
-            $libperl = '' if $^O eq 'sunos';
+            $libperl = '' if $Is_SunOS4;
           }
         }
 
@@ -2614,10 +2881,10 @@ LLIBPERL    = $llibperl
 ";
 
     push @m, "
-\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)/.exists ".join(" \\\n\t", @$extra)."
-	$self->{NOECHO}$self->{RM_F} \$\@
-	$self->{NOECHO}\$(TOUCH) \$\@
-";
+\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)\$(DIRFILESEP).exists ".join(" \\\n\t", @$extra).'
+	$(NOECHO) $(RM_F)  $@
+	$(NOECHO) $(TOUCH) $@
+';
 
     my $catfile;
     foreach $catfile (@$extra){
@@ -2627,10 +2894,10 @@ LLIBPERL    = $llibperl
 push @m, "
 \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
 	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) \$(LLIBPERL) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
-	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
-	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
-	$self->{NOECHO}echo 'To remove the intermediate files say'
-	$self->{NOECHO}echo '    make -f $makefilename map_clean'
+	\$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call'
+	\$(NOECHO) \$(ECHO) '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
+	\$(NOECHO) \$(ECHO) 'To remove the intermediate files say'
+	\$(NOECHO) \$(ECHO) '    make -f $makefilename map_clean'
 
 $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
 ";
@@ -2638,25 +2905,25 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
 
     push @m, qq{
 $tmp/perlmain.c: $makefilename}, q{
-	}.$self->{NOECHO}.q{echo Writing $@
-	}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\
+	$(NOECHO) $(ECHO) Writing $@
+	$(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\
 		-e "writemain(grep s#.*/auto/##s, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
 
 };
-    push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
+    push @m, "\t", q{$(NOECHO) $(PERL) $(INSTALLSCRIPT)/fixpmain
 } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
 
 
     push @m, q{
 doc_inst_perl:
-	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
-	-}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB)
-	-}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+	-$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	-$(NOECHO) $(DOC_INSTALL) \
 		"Perl binary" "$(MAP_TARGET)" \
 		MAP_STATIC "$(MAP_STATIC)" \
 		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
 		MAP_LIBPERL "$(MAP_LIBPERL)" \
-		>> }.File::Spec->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
 
 };
 
@@ -2664,7 +2931,7 @@ doc_inst_perl:
 inst_perl: pure_inst_perl doc_inst_perl
 
 pure_inst_perl: $(MAP_TARGET)
-	}.$self->{CP}.q{ $(MAP_TARGET) }.File::Spec->catfile('$(INSTALLBIN)','$(MAP_TARGET)').q{
+	}.$self->{CP}.q{ $(MAP_TARGET) }.$self->catfile('$(DESTINSTALLBIN)','$(MAP_TARGET)').q{
 
 clean :: map_clean
 
@@ -2692,17 +2959,17 @@ $(OBJECT) : $(FIRST_MAKEFILE)
 ' if $self->{OBJECT};
 
     push @m, q{
-# We take a very conservative approach here, but it\'s worth it.
+# We take a very conservative approach here, but it's worth it.
 # We move Makefile to Makefile.old here to avoid gnu make looping.
-}.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP)
-	}.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?"
-	}.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..."
-	-}.$self->{NOECHO}.q{$(RM_F) }."$self->{MAKEFILE}.old".q{
-	-}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
-	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP)
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+	$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+	$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+	$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+	$(NOECHO) $(MV)   $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+	-$(MAKE) -f $(MAKEFILE_OLD) clean $(DEV_NULL) || $(NOOP)
 	$(PERLRUN) Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{
-	}.$self->{NOECHO}.q{echo "==> Your Makefile has been rebuilt. <=="
-	}.$self->{NOECHO}.q{echo "==> Please rerun the make command.  <=="
+	$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+	$(NOECHO) $(ECHO) "==> Please rerun the make command.  <=="
 	false
 
 };
@@ -2710,58 +2977,6 @@ $(OBJECT) : $(FIRST_MAKEFILE)
     join "", @m;
 }
 
-=item manifypods (o)
-
-Defines targets and routines to translate the pods into manpages and
-put them into the INST_* directories.
-
-=cut
-
-sub manifypods {
-    my($self, %attribs) = @_;
-    return "\nmanifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless
-	%{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
-    my($dist);
-    my($pod2man_exe);
-    if (defined $self->{PERL_SRC}) {
-	$pod2man_exe = File::Spec->catfile($self->{PERL_SRC},'pod','pod2man');
-    } else {
-	$pod2man_exe = File::Spec->catfile($Config{scriptdirexp},'pod2man');
-    }
-    unless ($pod2man_exe = $self->perl_script($pod2man_exe)) {
-      # Maybe a build by uninstalled Perl?
-      $pod2man_exe = File::Spec->catfile($self->{PERL_INC}, "pod", "pod2man");
-    }
-    unless ($pod2man_exe = $self->perl_script($pod2man_exe)) {
-	# No pod2man but some MAN3PODS to be installed
-	print <<END;
-
-Warning: I could not locate your pod2man program. Please make sure,
-         your pod2man program is in your PATH before you execute 'make'
-
-END
-        $pod2man_exe = "-S pod2man";
-    }
-    my(@m);
-    push @m,
-qq[POD2MAN_EXE = $pod2man_exe\n],
-qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n],
-q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "],
- $self->{MAKEFILE}, q[";' \\
--e 'print "Manifying $$m{$$_}\n";' \\
--e 'system(q[$(PERLRUN) $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
--e 'chmod(oct($(PERM_RW)), $$m{$$_}) or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
-];
-    push @m, "\nmanifypods : pure_all ";
-    push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
-
-    push(@m,"\n");
-    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
-	push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t";
-	push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}};
-    }
-    join('', @m);
-}
 
 =item maybe_command
 
@@ -2775,44 +2990,6 @@ sub maybe_command {
     return;
 }
 
-=item maybe_command_in_dirs
-
-method under development. Not yet used. Ask Ilya :-)
-
-=cut
-
-sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
-# Ilya's suggestion. Not yet used, want to understand it first, but at least the code is here
-    my($self, $names, $dirs, $trace, $ver) = @_;
-    my($name, $dir);
-    foreach $dir (@$dirs){
-	next unless defined $dir; # $self->{PERL_SRC} may be undefined
-	foreach $name (@$names){
-	    my($abs,$tryabs);
-	    if (File::Spec->file_name_is_absolute($name)) { # /foo/bar
-		$abs = $name;
-	    } elsif (File::Spec->canonpath($name) eq File::Spec->canonpath(basename($name))) { # bar
-		$abs = File::Spec->catfile($dir, $name);
-	    } else { # foo/bar
-		$abs = File::Spec->catfile($Curdir, $name);
-	    }
-	    print "Checking $abs for $name\n" if ($trace >= 2);
-	    next unless $tryabs = $self->maybe_command($abs);
-	    print "Substituting $tryabs instead of $abs\n"
-		if ($trace >= 2 and $tryabs ne $abs);
-	    $abs = $tryabs;
-	    if (defined $ver) {
-		print "Executing $abs\n" if ($trace >= 2);
-		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
-		    print "Using PERL=$abs\n" if $trace;
-		    return $abs;
-		}
-	    } else { # Do not look for perl
-		return $abs;
-	    }
-	}
-    }
-}
 
 =item needs_linking (o)
 
@@ -2825,7 +3002,7 @@ sub needs_linking {
     my($self) = shift;
     my($child,$caller);
     $caller = (caller(0))[3];
-    confess("Needs_linking called too early") if 
+    confess("needs_linking called too early") if 
       $caller =~ /^ExtUtils::MakeMaker::/;
     return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING};
     if ($self->has_link_code or $self->{MAKEAPERL}){
@@ -2905,8 +3082,7 @@ sub parse_version {
 	$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
 	next if $inpod || /^\s*#/;
 	chop;
-	# next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
-	next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
+	next unless /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
 	my $eval = qq{
 	    package ExtUtils::MakeMaker::_version;
 	    no strict;
@@ -2984,10 +3160,10 @@ sub perldepend {
 # We do NOT just update config.h because that is not sufficient.
 # An out of date config.h is not fatal but complains loudly!
 $(PERL_INC)/config.h: $(PERL_SRC)/config.sh
-	-}.$self->{NOECHO}.q{echo "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; false
+	-$(NOECHO) $(ECHO) "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; false
 
 $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh
-	}.$self->{NOECHO}.q{echo "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh"
+	$(NOECHO) $(ECHO) "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh"
 	cd $(PERL_SRC) && $(MAKE) lib/Config.pm
 } if $self->{PERL_SRC};
 
@@ -3018,10 +3194,8 @@ PERL_HDRS = \
 	$(PERL_INC)/nostdio.h		\
 	$(PERL_INC)/op.h		\
 	$(PERL_INC)/opcode.h		\
-	$(PERL_INC)/opnames.h		\
 	$(PERL_INC)/patchlevel.h	\
 	$(PERL_INC)/perl.h		\
-	$(PERL_INC)/perlapi.h		\
 	$(PERL_INC)/perlio.h		\
 	$(PERL_INC)/perlsdio.h		\
 	$(PERL_INC)/perlsfio.h		\
@@ -3038,9 +3212,7 @@ PERL_HDRS = \
 	$(PERL_INC)/thrdvar.h		\
 	$(PERL_INC)/thread.h		\
 	$(PERL_INC)/unixish.h		\
-	$(PERL_INC)/utf8.h		\
-	$(PERL_INC)/util.h		\
-	$(PERL_INC)/warnings.h
+	$(PERL_INC)/util.h
 
 $(OBJECT) : $(PERL_HDRS)
 } if $self->{OBJECT};
@@ -3064,7 +3236,7 @@ interpreted as an octal value.
 =cut
 
 sub perm_rw {
-    shift->{PERM_RW} || "644";
+    return shift->{PERM_RW};
 }
 
 =item perm_rwx (o)
@@ -3077,7 +3249,7 @@ See also perl_rw.
 =cut
 
 sub perm_rwx {
-    shift->{PERM_RWX} || "755";
+    return shift->{PERM_RWX};
 }
 
 =item pm_to_blib
@@ -3087,36 +3259,23 @@ destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
 
 =cut
 
-sub _pm_to_blib_flush {
-    my ($self, $autodir, $rr, $ra, $rl) = @_;
-    $$rr .= 
-q{	}.$self->{NOECHO}.q[$(PERLRUNINST) "-MExtUtils::Install" \
-	-e "pm_to_blib({qw{].qq[@$ra].q[}},'].$autodir.q{','$(PM_FILTER)')"
-};
-    @$ra = ();
-    $$rl = 0;
-}
-
 sub pm_to_blib {
     my $self = shift;
-    my($autodir) = File::Spec->catdir('$(INST_LIB)','auto');
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
     my $r = q{
 pm_to_blib: $(TO_INST_PM)
 };
-    my %pm_to_blib = %{$self->{PM}};
-    my @a;
-    my $l = 0;
-    while (my ($pm, $blib) = each %pm_to_blib) {
-	my $la = length $pm;
-	my $lb = length $blib;
-	if ($l + $la + $lb + @a / 2 > 200) { # limit line length
-	    _pm_to_blib_flush($self, $autodir, \$r, \@a, \$l);
-        }
-        push @a, $pm, $blib;
-	$l += $la + $lb;
-    }
-    _pm_to_blib_flush($self, $autodir, \$r, \@a, \$l);
-    return $r.q{	}.$self->{NOECHO}.q{$(TOUCH) $@};
+
+    my $pm_to_blib = $self->oneliner(<<CODE, ['-MExtUtils::Install']);
+pm_to_blib({\@ARGV}, '$autodir', '\$(PM_FILTER)')
+CODE
+
+    my @cmds = $self->split_command($pm_to_blib, %{$self->{PM}});
+
+    $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds;
+    $r .= q{	$(NOECHO) $(TOUCH) $@};
+
+    return $r;
 }
 
 =item post_constants (o)
@@ -3127,7 +3286,6 @@ within Makefile.PL after all constants have been defined.
 =cut
 
 sub post_constants{
-    my($self) = shift;
     "";
 }
 
@@ -3139,7 +3297,6 @@ chunk of text to the Makefile after the object is initialized.
 =cut
 
 sub post_initialize {
-    my($self) = shift;
     "";
 }
 
@@ -3151,7 +3308,6 @@ text to the Makefile at the end.
 =cut
 
 sub postamble {
-    my($self) = shift;
     "";
 }
 
@@ -3181,40 +3337,38 @@ sub ppd {
     my $author = $self->{AUTHOR} || '';
     $author =~ s/</&lt;/g;
     $author =~ s/>/&gt;/g;
-    $author =~ s/@/\\@/g;
-
-    my $make_ppd = sprintf <<'PPD_OUT', $pack_ver, $abstract, $author;
-# Creates a PPD (Perl Package Description) for a binary distribution.
-ppd:
-	@$(PERL) -e "print qq{<SOFTPKG NAME=\"$(DISTNAME)\" VERSION=\"%s\">\n\t<TITLE>$(DISTNAME)</TITLE>\n\t<ABSTRACT>%s</ABSTRACT>\n\t<AUTHOR>%s</AUTHOR>\n}" > $(DISTNAME).ppd
-PPD_OUT
 
+    my $ppd_xml = sprintf <<'PPD_HTML', $pack_ver, $abstract, $author;
+<SOFTPKG NAME="$(DISTNAME)" VERSION="%s">
+    <TITLE>$(DISTNAME)</TITLE>
+    <ABSTRACT>%s</ABSTRACT>
+    <AUTHOR>%s</AUTHOR>
+PPD_HTML
 
-    $make_ppd .= '	@$(PERL) -e "print qq{\t<IMPLEMENTATION>\n';
+    $ppd_xml .= "    <IMPLEMENTATION>\n";
     foreach my $prereq (sort keys %{$self->{PREREQ_PM}}) {
         my $pre_req = $prereq;
         $pre_req =~ s/::/-/g;
         my ($dep_ver) = join ",", (split (/\./, $self->{PREREQ_PM}{$prereq}), 
                                   (0) x 4) [0 .. 3];
-        $make_ppd .= sprintf q{\t\t<DEPENDENCY NAME=\"%s\" VERSION=\"%s\" />\n}, $pre_req, $dep_ver;
-    }
-    $make_ppd .= qq[}" >> \$(DISTNAME).ppd\n];
-
-
-    $make_ppd .= sprintf <<'PPD_OUT', $Config{archname};
-	@$(PERL) -e "print qq{\t\t<OS NAME=\"$(OSNAME)\" />\n\t\t<ARCHITECTURE NAME=\"%s\" />\n
+        $ppd_xml .= sprintf <<'PPD_OUT', $pre_req, $dep_ver;
+        <DEPENDENCY NAME="%s" VERSION="%s" />
 PPD_OUT
 
-    chomp $make_ppd;
+    }
 
+    $ppd_xml .= sprintf <<'PPD_OUT', $Config{archname};
+        <OS NAME="$(OSNAME)" />
+        <ARCHITECTURE NAME="%s" />
+PPD_OUT
 
     if ($self->{PPM_INSTALL_SCRIPT}) {
         if ($self->{PPM_INSTALL_EXEC}) {
-            $make_ppd .= sprintf q{\t\t<INSTALL EXEC=\"%s\">%s</INSTALL>\n},
+            $ppd_xml .= sprintf qq{        <INSTALL EXEC="%s">%s</INSTALL>\n},
                   $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT};
         }
         else {
-            $make_ppd .= sprintf q{\t\t<INSTALL>%s</INSTALL>\n}, 
+            $ppd_xml .= sprintf qq{        <INSTALL>%s</INSTALL>\n}, 
                   $self->{PPM_INSTALL_SCRIPT};
         }
     }
@@ -3222,13 +3376,20 @@ PPD_OUT
     my ($bin_location) = $self->{BINARY_LOCATION} || '';
     $bin_location =~ s/\\/\\\\/g;
 
-    $make_ppd .= sprintf q{\t\t<CODEBASE HREF=\"%s\" />\n}, $bin_location;
-    $make_ppd .= q{\t</IMPLEMENTATION>\n};
-    $make_ppd .= q{</SOFTPKG>\n};
+    $ppd_xml .= sprintf <<'PPD_XML', $bin_location;
+        <CODEBASE HREF="%s" />
+    </IMPLEMENTATION>
+</SOFTPKG>
+PPD_XML
 
-    $make_ppd .= '}" >> $(DISTNAME).ppd';
+    my @ppd_cmds = $self->echo($ppd_xml, '$(DISTNAME).ppd');
+
+    return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds;
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd:
+	%s
+PPD_OUT
 
-    return $make_ppd;
 }
 
 =item prefixify
@@ -3236,8 +3397,12 @@ PPD_OUT
   $MM->prefixify($var, $prefix, $new_prefix, $default);
 
 Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to
-replace it's $prefix with a $new_prefix.  Should the $prefix fail to
-match it sill simply set it to the $new_prefix + $default.
+replace it's $prefix with a $new_prefix.  
+
+Should the $prefix fail to match I<AND> a PREFIX was given as an
+argument to WriteMakefile() it will set it to the $new_prefix +
+$default.  This is for systems whose file layouts don't neatly fit into
+our ideas of prefixes.
 
 This is for heuristics which attempt to create directory structures
 that mirror those of the installed perl.
@@ -3259,15 +3424,17 @@ sub prefixify {
     my $path = $self->{uc $var} || 
                $Config_Override{lc $var} || $Config{lc $var} || '';
 
+    $rprefix .= '/' if $sprefix =~ m|/$|;
+
     print STDERR "  prefixify $var => $path\n" if $Verbose >= 2;
     print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
 
-    unless( $path =~ s{^\Q$sprefix\E\b}{$rprefix}s ) {
+    if( $path !~ s{^\Q$sprefix\E\b}{$rprefix}s && $self->{ARGS}{PREFIX} ) {
 
         print STDERR "    cannot prefix, using default.\n" if $Verbose >= 2;
         print STDERR "    no default!\n" if !$default && $Verbose >= 2;
 
-        $path = File::Spec->catdir($rprefix, $default) if $default;
+        $path = $self->catdir($rprefix, $default) if $default;
     }
 
     print "    now $path\n" if $Verbose >= 2;
@@ -3293,7 +3460,7 @@ sub processPL {
 	foreach $target (@$list) {
 	push @m, "
 all :: $target
-	$self->{NOECHO}\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 $target :: $plfile
 	\$(PERLRUNINST) $plfile $target
@@ -3312,11 +3479,11 @@ but handles simple ones.
 =cut
 
 sub quote_paren {
-    local $_ = shift;
-    s/\$\((.+?)\)/\$\\\\($1\\\\)/g;	# protect $(...)
-    s/(?<!\\)([()])/\\$1/g;		# quote unprotected
-    s/\$\\\\\((.+?)\\\\\)/\$($1)/g;	# unprotect $(...)
-    return $_;
+    my $arg = shift;
+    $arg =~ s/\$\((.+?)\)/\$\\\\($1\\\\)/g;	# protect $(...)
+    $arg =~ s/(?<!\\)([()])/\\$1/g;		# quote unprotected
+    $arg =~ s/\$\\\\\((.+?)\\\\\)/\$($1)/g;	# unprotect $(...)
+    return $arg;
 }
 
 =item realclean (o)
@@ -3331,57 +3498,74 @@ sub realclean {
 
     push(@m,'
 # Delete temporary files (via clean) and also delete installed files
-realclean purge ::  clean
+realclean purge ::  clean realclean_subdirs
+	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
+	$(RM_RF) $(DISTVNAME)
 ');
-    # realclean subdirectories first (already cleaned)
-    my $sub;
-    if( $Is_Win32  &&  Win32::IsWin95() ) {
-        $sub = <<'REALCLEAN';
-	-cd %s
-	-$(PERLRUN) -e "exit unless -f shift; system q{$(MAKE) realclean}" %s
-	-cd ..
-REALCLEAN
-    }
-    else {
-        $sub = <<'REALCLEAN';
-	-cd %s && $(TEST_F) %s && $(MAKE) %s realclean
-REALCLEAN
-    }
 
-    foreach(@{$self->{DIR}}){
-	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old"));
-	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",''));
-    }
-    push(@m, "	$self->{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n");
-    push(@m, "	$self->{RM_RF} \$(DISTVNAME)\n");
     if( $self->has_link_code ){
-        push(@m, "	$self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n");
-        push(@m, "	$self->{RM_F} \$(INST_STATIC)\n");
+        push(@m, "	\$(RM_F) \$(INST_DYNAMIC) \$(INST_BOOT)\n");
+        push(@m, "	\$(RM_F) \$(INST_STATIC)\n");
     }
+
+    my @files = values %{$self->{PM}};
+    push @files, $attribs{FILES} if $attribs{FILES};
+    push @files, '$(FIRST_MAKEFILE)', '$(MAKEFILE_OLD)';
+
+    # Occasionally files are repeated several times from different sources
+    { my(%f) = map { ($_,1) } @files; @files = keys %f; }
+
     # Issue a several little RM_F commands rather than risk creating a
     # very long command line (useful for extensions such as Encode
     # that have many files).
-    if (keys %{$self->{PM}}) {
-	my $line = "";
-	foreach (values %{$self->{PM}}) {
-	    if (length($line) + length($_) > 80) {
-		push @m, "\t$self->{RM_F} $line\n";
-		$line = $_;
-	    }
-	    else {
-		$line .= " $_"; 
-	    }
-	}
-    push @m, "\t$self->{RM_F} $line\n" if $line;
+    my $line = "";
+    foreach my $file (@files) {
+        if (length($line) + length($file) > 200) {
+            push @m, "\t\$(RM_F) $line\n";
+            $line = $file;
+        }
+        else {
+            $line .= " $file"; 
+        }
     }
-    my(@otherfiles) = ($self->{MAKEFILE},
-		       "$self->{MAKEFILE}.old"); # Makefiles last
-    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
-    push(@m, "	$self->{RM_RF} @otherfiles\n") if @otherfiles;
-    push(@m, "	$attribs{POSTOP}\n")       if $attribs{POSTOP};
+    push @m, "\t\$(RM_F) $line\n" if $line;
+    push(@m, "\t$attribs{POSTOP}\n")      if $attribs{POSTOP};
+
     join("", @m);
 }
 
+
+=item realclean_subdirs_target
+
+  my $make_frag = $MM->realclean_subdirs_target;
+
+Returns the realclean_subdirs target.  This is used by the realclean
+target to call realclean on any subdirectories which contain Makefiles.
+
+=cut
+
+sub realclean_subdirs_target {
+    my $self = shift;
+
+    return <<'NOOP_FRAG' unless @{$self->{DIR}};
+realclean_subdirs :
+	$(NOECHO) $(NOOP)
+NOOP_FRAG
+
+    my $rclean = "realclean_subdirs :\n";
+
+    foreach my $dir (@{$self->{DIR}}){
+        $rclean .= sprintf <<'RCLEAN', $dir, $dir;
+	-cd %s && $(TEST_F) $(MAKEFILE_OLD) && $(MAKE) -f $(MAKEFILE_OLD) realclean
+	-cd %s && $(TEST_F) $(FIRST_MAKEFILE) && $(MAKE) realclean
+RCLEAN
+
+    }
+
+    return $rclean;
+}
+
+
 =item replace_manpage_separator
 
   my $man_name = $MM->replace_manpage_separator($file_path);
@@ -3399,6 +3583,79 @@ sub replace_manpage_separator {
     return $man;
 }
 
+
+=item oneliner (o)
+
+=cut
+
+sub oneliner {
+    my($self, $cmd, $switches) = @_;
+    $switches = [] unless defined $switches;
+
+    # Strip leading and trailing newlines
+    $cmd =~ s{^\n+}{};
+    $cmd =~ s{\n+$}{};
+
+    my @cmds = split /\n/, $cmd;
+    $cmd = join " \n\t-e ", map $self->quote_literal($_), @cmds;
+    $cmd = $self->escape_newlines($cmd);
+
+    $switches = join ' ', @$switches;
+
+    return qq{\$(PERLRUN) $switches -e $cmd};   
+}
+
+
+=item quote_literal
+
+=cut
+
+sub quote_literal {
+    my($self, $text) = @_;
+
+    # I think all we have to quote is single quotes and I think
+    # this is a safe way to do it.
+    $text =~ s{'}{'\\''}g;
+
+    return "'$text'";
+}
+
+
+=item escape_newlines
+
+=cut
+
+sub escape_newlines {
+    my($self, $text) = @_;
+
+    $text =~ s{\n}{\\\n}g;
+
+    return $text;
+}
+
+
+=item max_exec_len
+
+Using POSIX::ARG_MAX.  Otherwise falling back to 4096.
+
+=cut
+
+sub max_exec_len {
+    my $self = shift;
+
+    if (!defined $self->{_MAX_EXEC_LEN}) {
+        if (my $arg_max = eval { require POSIX;  &POSIX::ARG_MAX }) {
+            $self->{_MAX_EXEC_LEN} = $arg_max;
+        }
+        else {      # POSIX minimum exec size
+            $self->{_MAX_EXEC_LEN} = 4096;
+        }
+    }
+
+    return $self->{_MAX_EXEC_LEN};
+}
+
+
 =item static (o)
 
 Defines the static target.
@@ -3412,9 +3669,8 @@ sub static {
     '
 ## $(INST_PM) has been moved to the all: target.
 ## It remains here for awhile to allow for old usage: "make static"
-#static :: '.$self->{MAKEFILE}.' $(INST_STATIC) $(INST_PM)
-static :: '.$self->{MAKEFILE}.' $(INST_STATIC)
-	'.$self->{NOECHO}.'$(NOOP)
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+	$(NOECHO) $(NOOP)
 ';
 }
 
@@ -3426,19 +3682,20 @@ Defines how to produce the *.a (or equivalent) files.
 
 sub static_lib {
     my($self) = @_;
-# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
-#    return '' unless $self->needs_linking(); #might be because of a subdir
-
     return '' unless $self->has_link_code;
 
     my(@m);
     push(@m, <<'END');
-$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
 	$(RM_RF) $@
 END
+
     # If this extension has its own library (eg SDBM_File)
     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
-    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
+    push(@m, <<'MAKE_FRAG') if $self->{MYEXTLIB};
+	$(CP) $(MYEXTLIB) $@
+MAKE_FRAG
 
     my $ar; 
     if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) {
@@ -3448,20 +3705,19 @@ END
     } else {
         $ar = 'AR';
     }
-    push @m,
-        "\t\$($ar) ".'$(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@'."\n";
-    push @m,
-q{	$(CHMOD) $(PERM_RWX) $@
-	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
-};
+    push @m, sprintf <<'MAKE_FRAG', $ar;
+	$(%s) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+	$(CHMOD) $(PERM_RWX) $@
+	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+MAKE_FRAG
+
     # Old mechanism - still available:
-    push @m,
-"\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
-}	if $self->{PERL_SRC} && $self->{EXTRALIBS};
-    push @m, "\n";
+    push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
+	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
+MAKE_FRAG
 
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
-    join('', "\n",@m);
+    push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('', @m);
 }
 
 =item staticmake (o)
@@ -3479,7 +3735,7 @@ sub staticmake {
     # And as it's not yet built, we add the current extension
     # but only if it has some C code (or XS code, which implies C code)
     if (@{$self->{C}}) {
-	@static = File::Spec->catfile($self->{INST_ARCHLIB},
+	@static = $self->catfile($self->{INST_ARCHLIB},
 				 "auto",
 				 $self->{FULLEXT},
 				 "$self->{BASEEXT}$self->{LIB_EXT}"
@@ -3514,34 +3770,11 @@ Helper subroutine for subdirs
 
 sub subdir_x {
     my($self, $subdir) = @_;
-    my(@m);
-    if ($Is_Win32 && Win32::IsWin95()) {
-	if ($Config{'make'} =~ /dmake/i) {
-	    # dmake-specific
-	    return <<EOT;
-subdirs ::
-@[
-	cd $subdir
-	\$(MAKE) -f \$(FIRST_MAKEFILE) all \$(PASTHRU)
-	cd ..
-]
-EOT
-        } elsif ($Config{'make'} =~ /nmake/i) {
-	    # nmake-specific
-	    return <<EOT;
-subdirs ::
-	cd $subdir
-	\$(MAKE) -f \$(FIRST_MAKEFILE) all \$(PASTHRU)
-	cd ..
-EOT
-	}
-    } else {
-	return <<EOT;
+    return sprintf <<'EOT', $subdir;
 
 subdirs ::
-	$self->{NOECHO}cd $subdir && \$(MAKE) -f \$(FIRST_MAKEFILE) all \$(PASTHRU)
+	$(NOECHO)cd %s && $(MAKE) -f $(FIRST_MAKEFILE) all $(PASTHRU)
 EOT
-    }
 }
 
 =item subdirs (o)
@@ -3601,14 +3834,14 @@ testdb :: testdb_\$(LINKTYPE)
 test :: \$(TEST_TYPE)
 ");
 
-    if ($Is_Win32 && Win32::IsWin95()) {
-        push(@m, map(qq{\t$self->{NOECHO}\$(PERLRUN) -e "exit unless -f shift; chdir '$_'; system q{\$(MAKE) test \$(PASTHRU)}" $self->{MAKEFILE}\n}, @{$self->{DIR}}));
+    if ($Is_Win95) {
+        push(@m, map(qq{\t\$(NOECHO) \$(PERLRUN) -e "exit unless -f shift; chdir '$_'; system q{\$(MAKE) test \$(PASTHRU)}" \$(FIRST_MAKEFILE)\n}, @{$self->{DIR}}));
     }
     else {
-        push(@m, map("\t$self->{NOECHO}cd $_ && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n", @{$self->{DIR}}));
+        push(@m, map("\t\$(NOECHO) cd $_ && \$(TEST_F) \$(FIRST_MAKEFILE) && \$(MAKE) test \$(PASTHRU)\n", @{$self->{DIR}}));
     }
 
-    push(@m, "\t$self->{NOECHO}echo 'No tests defined for \$(NAME) extension.'\n")
+    push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n")
 	unless $tests or -f "test.pl" or @{$self->{DIR}};
     push(@m, "\n");
 
@@ -3665,87 +3898,38 @@ sub test_via_script {
     return $self->SUPER::test_via_script("PERL_DL_NONLAZY=1 $perl", $script);
 }
 
-=item tool_autosplit (o)
 
-Defines a simple perl call that runs autosplit. May be deprecated by
-pm_to_blib soon.
-
-=cut
-
-sub tool_autosplit {
-    my($self, %attribs) = @_;
-    my($asl) = "";
-    $asl = "\$\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
-
-    return sprintf <<'MAKE_FRAG', $asl;
-# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
-AUTOSPLITFILE = $(PERLRUN) -e 'use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
+=item tools_other (o)
 
-MAKE_FRAG
+    my $make_frag = $MM->tools_other;
 
-}
+Returns a make fragment containing definitions for:
 
-=item tools_other (o)
+SHELL, CHMOD, CP, MV, NOOP, NOECHO, RM_F, RM_RF, TEST_F, TOUCH,
+DEV_NULL, UMASK_NULL, MKPATH, EQUALIZE_TIMESTAMP,
+WARN_IF_OLD_PACKLIST, UNINST, VERBINST, MOD_INSTALL, DOC_INSTALL and
+UNINSTALL
 
-Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
-the Makefile. Also defines the perl programs MKPATH,
-WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
+init_others() initializes all these values.
 
 =cut
 
 sub tools_other {
     my($self) = shift;
     my @m;
-    my $bin_sh = $Config{sh} || '/bin/sh';
-    push @m, qq{
-SHELL = $bin_sh
-};
 
-    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
-	push @m, "$_ = $self->{$_}\n";
+    for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH 
+                      UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP 
+                      ECHO ECHO_N
+                      UNINST VERBINST
+                      MOD_INSTALL DOC_INSTALL UNINSTALL
+                      WARN_IF_OLD_PACKLIST
+                    } ) 
+    {
+        next unless defined $self->{$tool};
+        push @m, "$tool = $self->{$tool}\n";
     }
 
-    push @m, q{
-# The following is a portable way to say mkdir -p
-# To see which directories are created, change the if 0 to if 1
-MKPATH = $(PERLRUN) "-MExtUtils::Command" -e mkpath
-
-# This helps us to minimize the effect of the .exists files A yet
-# better solution would be to have a stable file in the perl
-# distribution with a timestamp of zero. But this solution doesn't
-# need any changes to the core distribution and works with older perls
-EQUALIZE_TIMESTAMP = $(PERLRUN) "-MExtUtils::Command" -e eqtime
-};
-
-
-    return join "", @m if $self->{PARENT};
-
-    push @m, q{
-# Here we warn users that an old packlist file was found somewhere,
-# and that they should call some uninstall routine
-WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\
--e 'print "WARNING: I have found an old package in\n";' \\
--e 'print "\t$$ARGV[0].\n";' \\
--e 'print "Please make sure the two installations are not conflicting\n";'
-
-UNINST=0
-VERBINST=0
-
-MOD_INSTALL = $(PERL) "-I$(INST_LIB)" "-I$(PERL_LIB)" "-MExtUtils::Install" \
--e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
-
-DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
--e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", $$arg=shift, "|", $$arg, ">";' \
--e 'print "=over 4";' \
--e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
--e 'print "=back";'
-
-UNINSTALL =   $(PERLRUN) "-MExtUtils::Install" \
--e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \
--e 'print " packlist above carefully.\n  There may be errors. Remove the";' \
--e 'print " appropriate files manually.\n  Sorry for the inconveniences.\n"'
-};
-
     return join "", @m;
 }
 
@@ -3758,8 +3942,17 @@ Determines typemaps, xsubpp version, prototype behaviour.
 sub tool_xsubpp {
     my($self) = shift;
     return "" unless $self->needs_linking;
-    my($xsdir)  = File::Spec->catdir($self->{PERL_LIB},"ExtUtils");
-    my(@tmdeps) = File::Spec->catdir('$(XSUBPPDIR)','typemap');
+
+    my $xsdir;
+    foreach my $dir (@INC) {
+        $xsdir = $self->catdir($dir, 'ExtUtils');
+        if( -r $self->catfile($xsdir, "xsubpp") ) {
+            last;
+        }
+    }
+
+    my $tmdir   = File::Spec->catdir($self->{PERL_LIB},"ExtUtils");
+    my(@tmdeps) = $self->catfile($tmdir,'typemap');
     if( $self->{TYPEMAPS} ){
 	my $typemap;
 	foreach $typemap (@{$self->{TYPEMAPS}}){
@@ -3778,27 +3971,11 @@ sub tool_xsubpp {
     }
 
 
-    my $xsubpp_version = $self->xsubpp_version(File::Spec->catfile($xsdir,"xsubpp"));
-
-    # What are the correct thresholds for version 1 && 2 Paul?
-    if ( $xsubpp_version > 1.923 ){
-	$self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
-    } else {
-	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
-	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
-	Your version of xsubpp is $xsubpp_version and cannot handle this.
-	Please upgrade to a more recent version of xsubpp.
-};
-	} else {
-	    $self->{XSPROTOARG} = "";
-	}
-    }
-
-    my $xsubpp = "xsubpp";
+    $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
 
     return qq{
 XSUBPPDIR = $xsdir
-XSUBPP = \$(XSUBPPDIR)/$xsubpp
+XSUBPP = \$(XSUBPPDIR)/xsubpp
 XSPROTOARG = $self->{XSPROTOARG}
 XSUBPPDEPS = @tmdeps \$(XSUBPP)
 XSUBPPARGS = @tmargs
@@ -3806,59 +3983,20 @@ XSUBPP_EXTRA_ARGS =
 };
 };
 
-sub xsubpp_version
-{
-    my($self,$xsubpp) = @_;
-    return $Xsubpp_Version if defined $Xsubpp_Version; # global variable
-
-    my ($version) ;
-
-    # try to figure out the version number of the xsubpp on the system
-
-    # first try the -v flag, introduced in 1.921 & 2.000a2
-
-    return "" unless $self->needs_linking;
-
-    my $command = qq{$self->{PERL} "-I$self->{PERL_LIB}" $xsubpp -v 2>&1};
-    print "Running $command\n" if $Verbose >= 2;
-    $version = `$command` ;
-    warn "Running '$command' exits with status " . ($?>>8) if $?;
-    chop $version ;
-
-    return $Xsubpp_Version = $1 if $version =~ /^xsubpp version (.*)/ ;
-
-    # nope, then try something else
-
-    my $counter = '000';
-    my ($file) = 'temp' ;
-    $counter++ while -e "$file$counter"; # don't overwrite anything
-    $file .= $counter;
 
-    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
-    print F <<EOM ;
-MODULE = fred PACKAGE = fred
+=item all_target
 
-int
-fred(a)
-        int     a;
-EOM
+Build man pages, too
 
-    close F ;
-
-    $command = "$self->{PERL} $xsubpp $file 2>&1";
-    print "Running $command\n" if $Verbose >= 2;
-    my $text = `$command` ;
-    warn "Running '$command' exits with status " . ($?>>8) if $?;
-    unlink $file ;
-
-    # gets 1.2 -> 1.92 and 2.000a1
-    return $Xsubpp_Version = $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+=cut
 
-    # it is either 1.0 or 1.1
-    return $Xsubpp_Version = 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+sub all_target {
+    my $self = shift;
 
-    # none of the above, so 1.0
-    return $Xsubpp_Version = "1.0" ;
+    return <<'MAKE_EXT';
+all :: pure_all manifypods
+	$(NOECHO) $(NOOP)
+MAKE_EXT
 }
 
 =item top_targets (o)
@@ -3873,43 +4011,39 @@ sub top_targets {
     my($self) = shift;
     my(@m);
 
-    push @m, '
-all :: pure_all manifypods
-	'.$self->{NOECHO}.'$(NOOP)
-' 
-	  unless $self->{SKIPHASH}{'all'};
+    push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'};
     
     push @m, '
 pure_all :: config pm_to_blib subdirs linkext
-	'.$self->{NOECHO}.'$(NOOP)
+	$(NOECHO) $(NOOP)
 
 subdirs :: $(MYEXTLIB)
-	'.$self->{NOECHO}.'$(NOOP)
+	$(NOECHO) $(NOOP)
 
-config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)/.exists
-	'.$self->{NOECHO}.'$(NOOP)
+config :: $(FIRST_MAKEFILE) $(INST_LIBDIR)$(DIRFILESEP).exists
+	$(NOECHO) $(NOOP)
 
-config :: $(INST_ARCHAUTODIR)/.exists
-	'.$self->{NOECHO}.'$(NOOP)
+config :: $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+	$(NOECHO) $(NOOP)
 
-config :: $(INST_AUTODIR)/.exists
-	'.$self->{NOECHO}.'$(NOOP)
+config :: $(INST_AUTODIR)$(DIRFILESEP).exists
+	$(NOECHO) $(NOOP)
 ';
 
     push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
 
     if (%{$self->{MAN1PODS}}) {
-	push @m, qq[
-config :: \$(INST_MAN1DIR)/.exists
-	$self->{NOECHO}\$(NOOP)
+	push @m, q[
+config :: $(INST_MAN1DIR)$(DIRFILESEP).exists
+	$(NOECHO) $(NOOP)
 
 ];
 	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
     }
     if (%{$self->{MAN3PODS}}) {
-	push @m, qq[
-config :: \$(INST_MAN3DIR)/.exists
-	$self->{NOECHO}\$(NOOP)
+	push @m, q[
+config :: $(INST_MAN3DIR)$(DIRFILESEP).exists
+	$(NOECHO) $(NOOP)
 
 ];
 	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
@@ -3989,47 +4123,6 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
 ';
 }
 
-=item perl_archive
-
-This is internal method that returns path to libperl.a equivalent
-to be linked to dynamic extensions. UNIX does not have one but other
-OSs might have one.
-
-=cut 
-
-sub perl_archive
-{
- return "";
-}
-
-=item perl_archive_after
-
-This is an internal method that returns path to a library which
-should be put on the linker command line I<after> the external libraries
-to be linked to dynamic extensions.  This may be needed if the linker
-is one-pass, and Perl includes some overrides for C RTL functions,
-such as malloc().
-
-=cut 
-
-sub perl_archive_after
-{
- return "";
-}
-
-=item export_list
-
-This is internal method that returns name of a file that is
-passed to linker to define symbols to be exported.
-UNIX does not have one but OS2 and Win32 do.
-
-=cut 
-
-sub export_list
-{
- return "";
-}
-
 
 1;
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
index 3fedae852f5..f9a50831e14 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
@@ -7,18 +7,25 @@ package ExtUtils::MM_VMS;
 
 use strict;
 
-use Carp qw( &carp );
 use Config;
 require Exporter;
-use VMS::Filespec;
+
+BEGIN {
+    # so we can compile the thing on non-VMS platforms.
+    if( $^O eq 'VMS' ) {
+        require VMS::Filespec;
+        VMS::Filespec->import;
+    }
+}
+
 use File::Basename;
-use File::Spec;
 use vars qw($Revision @ISA $VERSION);
-($VERSION) = $Revision = '5.65';
+($VERSION) = '5.70';
+($Revision) = q$Revision: 1.7 $ =~ /Revision:\s+(\S+)/;
 
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
-@ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix File::Spec );
+@ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue);
 
@@ -52,9 +59,8 @@ Converts a list into a string wrapped at approximately 80 columns.
 sub wraplist {
     my($self) = shift;
     my($line,$hlen) = ('',0);
-    my($word);
 
-    foreach $word (@_) {
+    foreach my $word (@_) {
       # Perl bug -- seems to occasionally insert extra elements when
       # traversing array (scalar(@array) doesn't show them, but
       # foreach(@array) does) (5.00307)
@@ -158,25 +164,33 @@ sub find_perl {
     my($rslt);
     my($inabs) = 0;
     local *TCF;
-    # Check in relative directories first, so we pick up the current
-    # version of Perl if we're running MakeMaker as part of the main build.
-    @sdirs = sort { my($absa) = File::Spec->file_name_is_absolute($a);
-                    my($absb) = File::Spec->file_name_is_absolute($b);
-                    if ($absa && $absb) { return $a cmp $b }
-                    else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
-                  } @$dirs;
-    # Check miniperl before perl, and check names likely to contain
-    # version numbers before "generic" names, so we pick up an
-    # executable that's less likely to be from an old installation.
-    @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
-                     my($bb) = $b =~ m!([^:>\]/]+)$!;
-                     my($ahasdir) = (length($a) - length($ba) > 0);
-                     my($bhasdir) = (length($b) - length($bb) > 0);
-                     if    ($ahasdir and not $bhasdir) { return 1; }
-                     elsif ($bhasdir and not $ahasdir) { return -1; }
-                     else { $bb =~ /\d/ <=> $ba =~ /\d/
-                            or substr($ba,0,1) cmp substr($bb,0,1)
-                            or length($bb) <=> length($ba) } } @$names;
+
+    if( $self->{PERL_CORE} ) {
+        # Check in relative directories first, so we pick up the current
+        # version of Perl if we're running MakeMaker as part of the main build.
+        @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
+                        my($absb) = $self->file_name_is_absolute($b);
+                        if ($absa && $absb) { return $a cmp $b }
+                        else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
+                      } @$dirs;
+        # Check miniperl before perl, and check names likely to contain
+        # version numbers before "generic" names, so we pick up an
+        # executable that's less likely to be from an old installation.
+        @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
+                         my($bb) = $b =~ m!([^:>\]/]+)$!;
+                         my($ahasdir) = (length($a) - length($ba) > 0);
+                         my($bhasdir) = (length($b) - length($bb) > 0);
+                         if    ($ahasdir and not $bhasdir) { return 1; }
+                         elsif ($bhasdir and not $ahasdir) { return -1; }
+                         else { $bb =~ /\d/ <=> $ba =~ /\d/
+                                  or substr($ba,0,1) cmp substr($bb,0,1)
+                                  or length($bb) <=> length($ba) } } @$names;
+    }
+    else {
+        @sdirs  = @$dirs;
+        @snames = @$names;
+    }
+
     # Image names containing Perl version use '_' instead of '.' under VMS
     foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
     if ($trace >= 2){
@@ -187,7 +201,7 @@ sub find_perl {
     }
     foreach $dir (@sdirs){
 	next unless defined $dir; # $self->{PERL_SRC} may be undefined
-	$inabs++ if File::Spec->file_name_is_absolute($dir);
+	$inabs++ if $self->file_name_is_absolute($dir);
 	if ($inabs == 1) {
 	    # We've covered relative dirs; everything else is an absolute
 	    # dir (probably an installed location).  First, we'll try potential
@@ -196,7 +210,7 @@ sub find_perl {
 	    $inabs++; # Should happen above in next $dir, but just in case . . .
 	}
 	foreach $name (@snames){
-	    if ($name !~ m![/:>\]]!) { push(@cand,File::Spec->catfile($dir,$name)); }
+	    if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
 	    else                     { push(@cand,$self->fixpath($name,0));    }
 	}
     }
@@ -211,9 +225,9 @@ sub find_perl {
             $rslt = `\@temp_mmvms.com` ;
             unlink('temp_mmvms.com');
             if ($rslt =~ /VER_OK/) {
-	    print "Using PERL=$name\n" if $trace;
-	    return $name;
-	}
+                print "Using PERL=$name\n" if $trace;
+                return $name;
+            }
         }
 	next unless $vmsfile = $self->maybe_command($name);
 	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
@@ -267,42 +281,6 @@ sub maybe_command {
     return 0;
 }
 
-=item maybe_command_in_dirs (override)
-
-Uses DCL argument quoting on test command line.
-
-=cut
-
-sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
-    my($self, $names, $dirs, $trace, $ver) = @_;
-    my($name, $dir);
-    foreach $dir (@$dirs){
-	next unless defined $dir; # $self->{PERL_SRC} may be undefined
-	foreach $name (@$names){
-	    my($abs,$tryabs);
-	    if (File::Spec->file_name_is_absolute($name)) {
-		$abs = $name;
-	    } else {
-		$abs = File::Spec->catfile($dir, $name);
-	    }
-	    print "Checking $abs for $name\n" if ($trace >= 2);
-	    next unless $tryabs = $self->maybe_command($abs);
-	    print "Substituting $tryabs instead of $abs\n" 
-		if ($trace >= 2 and $tryabs ne $abs);
-	    $abs = $tryabs;
-	    if (defined $ver) {
-		print "Executing $abs\n" if ($trace >= 2);
-		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
-		    print "Using $abs\n" if $trace;
-		    return $abs;
-		}
-	    } else { # Do not look for perl
-		return $abs;
-	    }
-	}
-    }
-}
-
 =item perl_script (override)
 
 If name passed in doesn't specify a readable file, appends F<.com> or
@@ -332,10 +310,42 @@ sub replace_manpage_separator {
     $man;
 }
 
+=item init_DEST
+
+(override) Because of the difficulty concatenating VMS filepaths we
+must pre-expand the DEST* variables.
+
+=cut
+
+sub init_DEST {
+    my $self = shift;
+
+    $self->SUPER::init_DEST;
+
+    # Expand DEST variables.
+    foreach my $var ($self->installvars) {
+        my $destvar = 'DESTINSTALL'.$var;
+        $self->{$destvar} = File::Spec->eliminate_macros($self->{$destvar});
+    }
+}
+
+
+=item init_DIRFILESEP
+
+No seperator between a directory path and a filename on VMS.
+
+=cut
+
+sub init_DIRFILESEP {
+    my($self) = shift;
+
+    $self->{DIRFILESEP} = '';
+    return 1;
+}
+
+
 =item init_main (override)
 
-Override DISTVNAME so it uses VERSION_SYM to avoid getting too many
-dots in the name.
 
 =cut
 
@@ -343,7 +353,34 @@ sub init_main {
     my($self) = shift;
 
     $self->SUPER::init_main;
-    $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}";
+
+    $self->{DEFINE} ||= '';
+    if ($self->{DEFINE} ne '') {
+        my(@terms) = split(/\s+/,$self->{DEFINE});
+        my(@defs,@udefs);
+        foreach my $def (@terms) {
+            next unless $def;
+            my $targ = \@defs;
+            if ($def =~ s/^-([DU])//) {    # If it was a Unix-style definition
+                $targ = \@udefs if $1 eq 'U';
+                $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
+                $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
+            }
+            if ($def =~ /=/) {
+                $def =~ s/"/""/g;  # Protect existing " from DCL
+                $def = qq["$def"]; # and quote to prevent parsing of =
+            }
+            push @$targ, $def;
+        }
+
+        $self->{DEFINE} = '';
+        if (@defs)  { 
+            $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')'; 
+        }
+        if (@udefs) { 
+            $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')'; 
+        }
+    }
 }
 
 =item init_others (override)
@@ -351,238 +388,201 @@ sub init_main {
 Provide VMS-specific forms of various utility commands, then hand
 off to the default MM_Unix method.
 
+DEV_NULL should probably be overriden with something.
+
+Also changes EQUALIZE_TIMESTAMP to set revision date of target file to
+one second later than source file, since MMK interprets precisely
+equal revision dates for a source and target file as a sign that the
+target needs to be updated.
+
 =cut
 
 sub init_others {
     my($self) = @_;
 
-    $self->{NOOP} = 'Continue';
-    $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS';
-    $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
-    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
-    $self->{NOECHO} ||= '@ ';
-    $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"';
-    $self->{RM_RF} = '$(PERLRUN) -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
-    $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"';
-    $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
+    $self->{NOOP}               = 'Continue';
+    $self->{NOECHO}             ||= '@ ';
+
+    $self->{MAKEFILE}           ||= 'Descrip.MMS';
+    $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
+    $self->{MAKE_APERL_FILE}    ||= 'Makeaperl.MMS';
+    $self->{MAKEFILE_OLD}       ||= '$(FIRST_MAKEFILE)_old';
+
+    $self->{ECHO}     ||= '$(PERLRUN) -le "print qq{@ARGV}"';
+    $self->{ECHO_N}   ||= '$(PERLRUN) -e  "print qq{@ARGV}"';
+    $self->{TOUCH}    ||= '$(PERLRUN) "-MExtUtils::Command" -e touch';
+    $self->{CHMOD}    ||= '$(PERLRUN) "-MExtUtils::Command" -e chmod'; 
+    $self->{RM_F}     ||= '$(PERLRUN) "-MExtUtils::Command" -e rm_f';
+    $self->{RM_RF}    ||= '$(PERLRUN) "-MExtUtils::Command" -e rm_rf';
+    $self->{TEST_F}   ||= '$(PERLRUN) "-MExtUtils::Command" -e test_f';
+    $self->{EQUALIZE_TIMESTAMP} ||= '$(PERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
+
+    $self->{MOD_INSTALL} ||= 
+      $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
+install({split(' ',<STDIN>)}, '$(VERBINST)', 0, '$(UNINST)');
+CODE
+
+    $self->{SHELL}    ||= 'Posix';
+
     $self->{CP} = 'Copy/NoConfirm';
     $self->{MV} = 'Rename/NoConfirm';
     $self->{UMASK_NULL} = '! ';  
-    
+
     $self->SUPER::init_others;
+
+    if ($self->{OBJECT} =~ /\s/) {
+        $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
+        $self->{OBJECT} = $self->wraplist(
+            map $self->fixpath($_,0), split /,?\s+/, $self->{OBJECT}
+        );
+    }
+
+    $self->{LDFROM} = $self->wraplist(
+        map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM}
+    );
 }
 
-=item constants (override)
 
-Fixes up numerous file and directory macros to insure VMS syntax
-regardless of input syntax.  Also adds a few VMS-specific macros
-and makes lists of files comma-separated.
+=item init_platform (override)
+
+Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
+
+MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
+$VERSION.
 
 =cut
 
-sub constants {
-    my($self) = @_;
-    my(@m,$def,$macro);
+sub init_platform {
+    my($self) = shift;
 
-    # Be kind about case for pollution
-    for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
+    $self->{MM_VMS_REVISION} = $Revision;
+    $self->{MM_VMS_VERSION}  = $VERSION;
+    $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
+      if $self->{PERL_SRC};
+}
 
-    $self->{DEFINE} ||= '';
-    if ($self->{DEFINE} ne '') {
-	my(@terms) = split(/\s+/,$self->{DEFINE});
-	my(@defs,@udefs);
-	foreach $def (@terms) {
-	    next unless $def;
-	    my $targ = \@defs;
-	    if ($def =~ s/^-([DU])//) {       # If it was a Unix-style definition
-		if ($1 eq 'U') { $targ = \@udefs; }
-		$def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
-		$def =~ s/^'(.*)'$/$1/;   # from entire term or argument
-	    }
-	    if ($def =~ /=/) {
-		$def =~ s/"/""/g;  # Protect existing " from DCL
-		$def = qq["$def"]; # and quote to prevent parsing of =
-	    }
-	    push @$targ, $def;
-	}
-	$self->{DEFINE} = '';
-	if (@defs)  { 
-            $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')'; 
-        }
-	if (@udefs) { 
-            $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')'; 
-        }
-    }
 
-    if ($self->{OBJECT} =~ /\s/) {
-	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
-	$self->{OBJECT} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{OBJECT})));
-    }
-    $self->{LDFROM} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{LDFROM})));
+=item platform_constants
 
+=cut
 
-    foreach $macro ( qw [
-            INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB 
-            INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
-	    INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
-            INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN  INSTALLSCRIPT 
-            INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
-            INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
-            PERL_LIB PERL_ARCHLIB
-            PERL_INC PERL_SRC FULLEXT ] ) {
-	next unless defined $self->{$macro};
-        next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
-	$self->{$macro} = $self->fixpath($self->{$macro},1);
+sub platform_constants {
+    my($self) = shift;
+    my $make_frag = '';
+
+    foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
+    {
+        next unless defined $self->{$macro};
+        $make_frag .= "$macro = $self->{$macro}\n";
     }
-    $self->{PERL_VMS} = File::Spec->catdir($self->{PERL_SRC},q(VMS))
-	if ($self->{PERL_SRC});
-                        
 
+    return $make_frag;
+}
 
-    # Fix up file specs
-    foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
-	next unless defined $self->{$macro};
-	$self->{$macro} = $self->fixpath($self->{$macro},0);
-    }
 
-    foreach $macro (qw/
-	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM 
-              XS_VERSION
-	      INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT 
-              INSTALLDIRS
-              PREFIX          SITEPREFIX      VENDORPREFIX
-	      INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
-	      INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
-              INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN  INSTALLSCRIPT 
-	      PERL_LIB PERL_ARCHLIB 
-              SITELIBEXP SITEARCHEXP 
-              LIBPERL_A MYEXTLIB
-	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS
-	      PERL_INC PERL FULLPERL PERLRUN FULLPERLRUN PERLRUNINST
-              FULLPERLRUNINST ABSPERL ABSPERLRUN ABSPERLRUNINST
-              PERL_CORE NOECHO NOOP
-	      / ) {
-	next unless defined $self->{$macro};
-	push @m, "$macro = $self->{$macro}\n";
-    }
+=item init_VERSION (override)
 
+Override the *DEFINE_VERSION macros with VMS semantics.  Translate the
+MAKEMAKER filepath to VMS style.
 
-    push @m, q[
-VERSION_MACRO = VERSION
-DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)"""
-XS_VERSION_MACRO = XS_VERSION
-XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)"""
-
-MAKEMAKER = ],File::Spec->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[
-MM_VERSION = $ExtUtils::MakeMaker::VERSION
-MM_REVISION = $ExtUtils::MakeMaker::Revision
-MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
-
-# FULLEXT = Pathname for extension directory (eg DBD/Oracle).
-# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT.
-# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
-# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
-];
+=cut
 
-    for my $tmp (qw/
-	      FULLEXT VERSION_FROM OBJECT LDFROM
-	      /	) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n";
-    }
+sub init_VERSION {
+    my $self = shift;
 
-    for my $tmp (qw/
-	      BASEEXT PARENT_NAME DLBASE INC DEFINE LINKTYPE
-	      /	) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
-    }
+    $self->SUPER::init_VERSION;
 
-    for my $tmp (qw/ XS MAN1PODS MAN3PODS PM /) {
-	# Where is the space coming from? --jhi
-	next unless $self ne " " && defined $self->{$tmp};
-	my(%tmp,$key);
-	for $key (keys %{$self->{$tmp}}) {
-	    $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$tmp}{$key},0);
-	}
-	$self->{$tmp} = \%tmp;
+    $self->{DEFINE_VERSION}    = '"$(VERSION_MACRO)=""$(VERSION)"""';
+    $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
+    $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
+}
+
+
+=item constants (override)
+
+Fixes up numerous file and directory macros to insure VMS syntax
+regardless of input syntax.  Also makes lists of files
+comma-separated.
+
+=cut
+
+sub constants {
+    my($self) = @_;
+
+    # Be kind about case for pollution
+    for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
+
+    # Cleanup paths for directories in MMS macros.
+    foreach my $macro ( qw [
+            INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB 
+            PERL_LIB PERL_ARCHLIB
+            PERL_INC PERL_SRC ],
+                        (map { 'INSTALL'.$_ } $self->installvars)
+                      ) 
+    {
+        next unless defined $self->{$macro};
+        next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
+        $self->{$macro} = $self->fixpath($self->{$macro},1);
     }
 
-    for my $tmp (qw/ C O_FILES H /) {
-	next unless defined $self->{$tmp};
-	my(@tmp,$val);
-	for $val (@{$self->{$tmp}}) {
-	    push(@tmp,$self->fixpath($val,0));
-	}
-	$self->{$tmp} = \@tmp;
+    # Cleanup paths for files in MMS macros.
+    foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD 
+                           MAKE_APERL_FILE MYEXTLIB] ) 
+    {
+        next unless defined $self->{$macro};
+        $self->{$macro} = $self->fixpath($self->{$macro},0);
     }
 
-    push @m,'
+    # Fixup files for MMS macros
+    # XXX is this list complete?
+    for my $macro (qw/
+                   FULLEXT VERSION_FROM OBJECT LDFROM
+	      /	) {
+        next unless defined $self->{$macro};
+        $self->{$macro} = $self->fixpath($self->{$macro},0);
+    }
 
-# Handy lists of source code files:
-XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),'
-C_FILES  = ',$self->wraplist(@{$self->{C}}),'
-O_FILES  = ',$self->wraplist(@{$self->{O_FILES}} ),'
-H_FILES  = ',$self->wraplist(@{$self->{H}}),'
-MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),'
-MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),'
 
-';
+    for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
+        # Where is the space coming from? --jhi
+        next unless $self ne " " && defined $self->{$macro};
+        my %tmp = ();
+        for my $key (keys %{$self->{$macro}}) {
+            $tmp{$self->fixpath($key,0)} = 
+                                     $self->fixpath($self->{$macro}{$key},0);
+        }
+        $self->{$macro} = \%tmp;
+    }
 
-    for my $tmp (qw/
-	      INST_MAN1DIR  MAN1EXT 
-              INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
-	      INST_MAN3DIR  MAN3EXT
-              INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
-	      /) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
+    for my $macro (qw/ C O_FILES H /) {
+        next unless defined $self->{$macro};
+        my @tmp = ();
+        for my $val (@{$self->{$macro}}) {
+            push(@tmp,$self->fixpath($val,0));
+        }
+        $self->{$macro} = \@tmp;
     }
 
-push @m,"
-makemakerdflt : all
-	\$(NOECHO) \$(NOOP)
+    return $self->SUPER::constants;
+}
 
-.SUFFIXES :
-.SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
 
-# Here is the Config.pm that we are using/depend on
-CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
+=item special_targets
 
-# Where to put things:
-INST_LIBDIR      = $self->{INST_LIBDIR}
-INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
+Clear the default .SUFFIXES and put in our own list.
 
-INST_AUTODIR     = $self->{INST_AUTODIR}
-INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
-";
+=cut
 
-    if ($self->has_link_code()) {
-	push @m,'
-INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT)
-INST_DYNAMIC = $(INST_ARCHAUTODIR)$(DLBASE).$(DLEXT)
-INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
-';
-    } else {
-	my $shr = $Config{'dbgprefix'} . 'PERLSHR';
-	push @m,'
-INST_STATIC =
-INST_DYNAMIC =
-INST_BOOT =
-EXPORT_LIST = $(BASEEXT).opt
-PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),'
-';
-    }
+sub special_targets {
+    my $self = shift;
 
-    $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
-    $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
-    push @m,'
-TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),'
+    my $make_frag .= <<'MAKE_FRAG';
+.SUFFIXES :
+.SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
 
-PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),'
-';
+MAKE_FRAG
 
-    join('',@m);
+    return $make_frag;
 }
 
 =item cflags (override)
@@ -723,78 +723,6 @@ sub const_cccmd {
     $self->{CONST_CCCMD} = join('',@m);
 }
 
-=item pm_to_blib (override)
-
-DCL I<still> accepts a maximum of 255 characters on a command
-line, so we write the (potentially) long list of file names
-to a temp file, then persuade Perl to read it instead of the
-command line to find args.
-
-=cut
-
-sub pm_to_blib {
-    my($self) = @_;
-    my($autodir) = File::Spec->catdir($self->{INST_LIB},'auto');
-    my(%files) = @{$self->{PM_TO_BLIB}};
-
-    my $m = <<'MAKE_FRAG';
-
-# Dummy target to match Unix target name; we use pm_to_blib.ts as
-# timestamp file to avoid repeated invocations under VMS
-pm_to_blib : pm_to_blib.ts
-	$(NOECHO) $(NOOP)
-
-# As always, keep under DCL's 255-char limit
-pm_to_blib.ts : $(TO_INST_PM)
-MAKE_FRAG
-
-    if( keys %files ) {
-        $m .= <<'MAKE_FRAG';
-	$(NOECHO) $(RM_F) .MM_tmp
-MAKE_FRAG
-
-        my $line = '';
-        while (my($from, $to) = each %files) {
-            $line .= " $from $to";
-            if (length($line) > 128) {
-                $m .= sprintf <<'MAKE_FRAG', $line;
-	$(NOECHO) $(PERL) -e "print '%s'" >>.MM_tmp
-MAKE_FRAG
-                $line = '';
-            }
-        }
-        $m .= sprintf <<'MAKE_FRAG', $line if $line;
-	$(NOECHO) $(PERL) -e "print '%s'" >>.MM_tmp
-MAKE_FRAG
-
-        $m .= sprintf <<'MAKE_FRAG', $autodir;
-	$(PERLRUN) "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'%s','$(PM_FILTER)')" <.MM_tmp
-	$(NOECHO) $(RM_F) .MM_tmp
-MAKE_FRAG
-
-    }
-    $m .= <<'MAKE_FRAG';
-	$(NOECHO) $(TOUCH) pm_to_blib.ts
-MAKE_FRAG
-
-    return $m;
-}
-
-=item tool_autosplit (override)
-
-Use VMS-style quoting on command line.
-
-=cut
-
-sub tool_autosplit {
-    my($self, %attribs) = @_;
-    my($asl) = "";
-    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
-    q{
-# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
-AUTOSPLITFILE = $(PERLRUN) -e "use AutoSplit;}.$asl.q{autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
-};
-}
 
 =item tool_sxubpp (override)
 
@@ -805,10 +733,17 @@ Use VMS-style quoting on xsubpp command line.
 sub tool_xsubpp {
     my($self) = @_;
     return '' unless $self->needs_linking;
-    my($xsdir) = File::Spec->catdir($self->{PERL_LIB},'ExtUtils');
-    # drop back to old location if xsubpp is not in new location yet
-    $xsdir = File::Spec->catdir($self->{PERL_SRC},'ext') unless (-f File::Spec->catfile($xsdir,'xsubpp'));
-    my(@tmdeps) = '$(XSUBPPDIR)typemap';
+
+    my $xsdir;
+    foreach my $dir (@INC) {
+        $xsdir = $self->catdir($dir, 'ExtUtils');
+        if( -r $self->catfile($xsdir, "xsubpp") ) {
+            last;
+        }
+    }
+
+    my $tmdir   = File::Spec->catdir($self->{PERL_LIB},"ExtUtils");
+    my(@tmdeps) = $self->catfile($tmdir,'typemap');
     if( $self->{TYPEMAPS} ){
 	my $typemap;
 	foreach $typemap (@{$self->{TYPEMAPS}}){
@@ -831,23 +766,11 @@ sub tool_xsubpp {
         (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)) {
         unshift(@tmargs,'-nolinenumbers');
     }
-    my $xsubpp_version = $self->xsubpp_version(File::Spec->catfile($xsdir,'xsubpp'));
 
-    # What are the correct thresholds for version 1 && 2 Paul?
-    if ( $xsubpp_version > 1.923 ){
-	$self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
-    } else {
-	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
-	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
-	Your version of xsubpp is $xsubpp_version and cannot handle this.
-	Please upgrade to a more recent version of xsubpp.
-};
-	} else {
-	    $self->{XSPROTOARG} = "";
-	}
-    }
 
-    "
+    $self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
+
+    return "
 XSUBPPDIR = $xsdir
 XSUBPP = \$(PERLRUN) \$(XSUBPPDIR)xsubpp
 XSPROTOARG = $self->{XSPROTOARG}
@@ -856,136 +779,71 @@ XSUBPPARGS = @tmargs
 ";
 }
 
-=item xsubpp_version (override)
 
-Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good)
-rather than Unix rules ($sts == 0 ==E<gt> good).
+=item tools_other (override)
 
-=cut
+Throw in some dubious extra macros for Makefile args.
 
-sub xsubpp_version
-{
-    my($self,$xsubpp) = @_;
-    my ($version) ;
-    return '' unless $self->needs_linking;
+Also keep around the old $(SAY) macro in case somebody's using it.
 
-    # try to figure out the version number of the xsubpp on the system
+=cut
 
-    # first try the -v flag, introduced in 1.921 & 2.000a2
+sub tools_other {
+    my($self) = @_;
 
-    my $command = qq{$self->{PERL} "-I$self->{PERL_LIB}" $xsubpp -v};
-    print "Running: $command\n" if $Verbose;
-    $version = `$command` ;
-    if ($?) {
-	use vmsish 'status';
-	warn "Running '$command' exits with status $?";
-    }
-    chop $version ;
+    # XXX Are these necessary?  Does anyone override them?  They're longer
+    # than just typing the literal string.
+    my $extra_tools = <<'EXTRA_TOOLS';
 
-    return $1 if $version =~ /^xsubpp version (.*)/ ;
+# Assumes $(MMS) invokes MMS or MMK
+# (It is assumed in some cases later that the default makefile name
+# (Descrip.MMS for MM[SK]) is used.)
+USEMAKEFILE = /Descrip=
+USEMACROS = /Macro=(
+MACROEND = )
 
-    # nope, then try something else
+# Just in case anyone is using the old macro.
+SAY = $(ECHO)
 
-    my $counter = '000';
-    my ($file) = 'temp' ;
-    $counter++ while -e "$file$counter"; # don't overwrite anything
-    $file .= $counter;
+EXTRA_TOOLS
 
-    local(*F);
-    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
-    print F <<EOM ;
-MODULE = fred PACKAGE = fred
+    return $self->SUPER::tools_other . $extra_tools;
+}
 
-int
-fred(a)
-	int	a;
-EOM
+=item init_dist (override)
 
-    close F ;
+VMSish defaults for some values.
 
-    $command = "$self->{PERLRUN} $xsubpp $file";
-    print "Running: $command\n" if $Verbose;
-    my $text = `$command` ;
-    if ($?) {
-	use vmsish 'status';
-	warn "Running '$command' exits with status $?";
-    }
-    unlink $file ;
+  macro         description                     default
 
-    # gets 1.2 -> 1.92 and 2.000a1
-    return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+  ZIPFLAGS      flags to pass to ZIP            -Vu
 
-    # it is either 1.0 or 1.1
-    return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+  COMPRESS      compression command to          gzip
+                use for tarfiles
+  SUFFIX        suffix to put on                -gz 
+                compressed files
 
-    # none of the above, so 1.0
-    return "1.0" ;
-}
+  SHAR          shar command to use             vms_share
 
-=item tools_other (override)
+  DIST_DEFAULT  default target to use to        tardist
+                create a distribution
 
-Adds a few MM[SK] macros, and shortens some the installatin commands,
-in order to stay under DCL's 255-character limit.  Also changes
-EQUALIZE_TIMESTAMP to set revision date of target file to one second
-later than source file, since MMK interprets precisely equal revision
-dates for a source and target file as a sign that the target needs
-to be updated.
+  DISTVNAME     Use VERSION_SYM instead of      $(DISTNAME)-$(VERSION_SYM)
+                VERSION for the name
 
 =cut
 
-sub tools_other {
+sub init_dist {
     my($self) = @_;
-    qq!
-# Assumes \$(MMS) invokes MMS or MMK
-# (It is assumed in some cases later that the default makefile name
-# (Descrip.MMS for MM[SK]) is used.)
-USEMAKEFILE = /Descrip=
-USEMACROS = /Macro=(
-MACROEND = )
-MAKEFILE = Descrip.MMS
-SHELL = Posix
-TOUCH = $self->{TOUCH}
-CHMOD = $self->{CHMOD}
-CP = $self->{CP}
-MV = $self->{MV}
-RM_F  = $self->{RM_F}
-RM_RF = $self->{RM_RF}
-SAY = Write Sys\$Output
-UMASK_NULL = $self->{UMASK_NULL}
-MKPATH = Create/Directory
-EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
-!. ($self->{PARENT} ? '' : 
-qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
-MOD_INSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
-DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,<STDIN>);print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
-UNINSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
-!);
-}
-
-=item dist (override)
-
-Provide VMSish defaults for some values, then hand off to
-default MM_Unix method.
-
-=cut
-
-sub dist {
-    my($self, %attribs) = @_;
-    $attribs{VERSION}      ||= $self->{VERSION_SYM};
-    $attribs{NAME}         ||= $self->{DISTNAME};
-    $attribs{ZIPFLAGS}     ||= '-Vu';
-    $attribs{COMPRESS}     ||= 'gzip';
-    $attribs{SUFFIX}       ||= '-gz';
-    $attribs{SHAR}         ||= 'vms_share';
-    $attribs{DIST_DEFAULT} ||= 'zipdist';
-
-    # Sanitize these for use in $(DISTVNAME) filespec
-    $attribs{VERSION} =~ s/[^\w\$]/_/g;
-    $attribs{NAME} =~ s/[^\w\$]/-/g;
+    $self->{ZIPFLAGS}     ||= '-Vu';
+    $self->{COMPRESS}     ||= 'gzip';
+    $self->{SUFFIX}       ||= '-gz';
+    $self->{SHAR}         ||= 'vms_share';
+    $self->{DIST_DEFAULT} ||= 'zipdist';
 
-    $attribs{DISTVNAME} ||= '$(DISTNAME)-$(VERSION_SYM)';
+    $self->SUPER::init_dist;
 
-    return $self->SUPER::dist(%attribs);
+    $self->{DISTVNAME}    = "$self->{DISTNAME}-$self->{VERSION_SYM}";
 }
 
 =item c_o (override)
@@ -1042,62 +900,6 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
 ';
 }
 
-=item top_targets (override)
-
-Path seperator differences.
-
-=cut
-
-sub top_targets {
-    my($self) = shift;
-    my(@m);
-    push @m, '
-all :: pure_all manifypods
-	$(NOECHO) $(NOOP)
-
-pure_all :: config pm_to_blib subdirs linkext
-	$(NOECHO) $(NOOP)
-
-subdirs :: $(MYEXTLIB)
-	$(NOECHO) $(NOOP)
-
-config :: $(MAKEFILE) $(INST_LIBDIR).exists
-	$(NOECHO) $(NOOP)
-
-config :: $(INST_ARCHAUTODIR).exists
-	$(NOECHO) $(NOOP)
-
-config :: $(INST_AUTODIR).exists
-	$(NOECHO) $(NOOP)
-';
-
-    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
-    if (%{$self->{MAN1PODS}}) {
-	push @m, q[
-config :: $(INST_MAN1DIR).exists
-	$(NOECHO) $(NOOP)
-];
-	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
-    }
-    if (%{$self->{MAN3PODS}}) {
-	push @m, q[
-config :: $(INST_MAN3DIR).exists
-	$(NOECHO) $(NOOP)
-];
-	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
-    }
-
-    push @m, '
-$(O_FILES) : $(H_FILES)
-' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
-
-    push @m, q{
-help :
-	perldoc ExtUtils::MakeMaker
-};
-
-    join('',@m);
-}
 
 =item dlsyms (override)
 
@@ -1204,7 +1006,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
 
 ";
     push @m, '
-$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
 	If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
 	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
@@ -1231,13 +1033,13 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".'
 # As MakeMaker mkbootstrap might not write a file (if none is required)
 # we use touch to prevent make continually trying to remake it.
 # The DynaLoader only reads a non-empty file.
-$(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
-	$(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+$(BOOTSTRAP) : $(FIRST_MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+	$(NOECHO) $(ECHO) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
 	$(NOECHO) $(PERLRUN) -
 	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
 	$(NOECHO) $(TOUCH) $(MMS$TARGET)
 
-$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
 	$(NOECHO) $(RM_RF) $(INST_BOOT)
 	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
 ';
@@ -1261,7 +1063,7 @@ $(INST_STATIC) :
     my(@m,$lib);
     push @m,'
 # Rely on suffix rule for update action
-$(OBJECT) : $(INST_ARCHAUTODIR).exists
+$(OBJECT) : $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
 
 $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 ';
@@ -1289,56 +1091,6 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 }
 
 
-=item manifypods (override)
-
-Use VMS-style quoting on command line, and VMS logical name
-to specify fallback location at build time if we can't find pod2man.
-
-=cut
-
-
-sub manifypods {
-    my($self, %attribs) = @_;
-    return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
-    my($dist);
-    my($pod2man_exe);
-    if (defined $self->{PERL_SRC}) {
-	$pod2man_exe = File::Spec->catfile($self->{PERL_SRC},'pod','pod2man');
-    } else {
-	$pod2man_exe = File::Spec->catfile($Config{scriptdirexp},'pod2man');
-    }
-    if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
-	# No pod2man but some MAN3PODS to be installed
-	print <<END;
-
-Warning: I could not locate your pod2man program.  As a last choice,
-         I will look for the file to which the logical name POD2MAN
-         points when MMK is invoked.
-
-END
-        $pod2man_exe = "pod2man";
-    }
-    my(@m);
-    push @m,
-qq[POD2MAN_EXE = $pod2man_exe\n],
-q[POD2MAN = $(PERLRUN) "-MPod::Man" -we "%m=@ARGV;for(keys %m){" -
--e "Pod::Man->new->parse_from_file($_,$m{$_}) }"
-];
-    push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
-    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
-	my($pod);
-	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
-	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
-	    push @m, "$pod $self->{MAN1PODS}{$pod}\n";
-	}
-	foreach $pod (sort keys %{$self->{MAN3PODS}}) {
-	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
-	    push @m, "$pod $self->{MAN3PODS}{$pod}\n";
-	}
-    }
-    join('', @m);
-}
-
 =item processPL (override)
 
 Use VMS-style quoting on command line.
@@ -1380,7 +1132,7 @@ sub installbin {
     my($self) = @_;
     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
     return '' unless @{$self->{EXE_FILES}};
-    my(@m, $from, $to, %fromto, @to, $line);
+    my(@m, $from, $to, %fromto, @to);
     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
     for $from (@exefiles) {
 	my($path) = '$(INST_SCRIPT)' . basename($from);
@@ -1393,9 +1145,13 @@ sub installbin {
     push @m, "
 EXE_FILES = @exefiles
 
+pure_all :: @to
+	\$(NOECHO) \$(NOOP)
+
 realclean ::
 ";
-    $line = '';  #avoid unitialized var warning
+
+    my $line = '';
     foreach $to (@to) {
 	if (length($line) + length($to) > 80) {
 	    push @m, "\t\$(RM_F) $line\n";
@@ -1408,11 +1164,15 @@ realclean ::
     while (($from,$to) = each %fromto) {
 	last unless defined $from;
 	my $todir;
-	if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
-	else                   { ($todir = $to) =~ s/[^\)]+$//; }
+	if ($to =~ m#[/>:\]]#) {
+            $todir = dirname($to); 
+        }
+	else { 
+            ($todir = $to) =~ s/[^\)]+$//; 
+        }
 	$todir = $self->fixpath($todir,1);
 	push @m, "
-$to : $from \$(MAKEFILE) ${todir}.exists
+$to : $from \$(FIRST_MAKEFILE) ${todir}\$(DIRFILESEP).exists
 	\$(CP) $from $to
 
 ", $self->dir_target($todir);
@@ -1455,13 +1215,8 @@ sub clean {
     push @m, '
 # Delete temporary files but do not touch installed files. We don\'t delete
 # the Descrip.MMS here so that a later make realclean still has it to use.
-clean ::
+clean :: clean_subdirs
 ';
-    foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
-	my($vmsdir) = $self->fixpath($dir,1);
-	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
-	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
-    }
     push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
 ';
 
@@ -1469,24 +1224,29 @@ clean ::
     # Unlink realclean, $attribs{FILES} is a string here; it may contain
     # a list or a macro that expands to a list.
     if ($attribs{FILES}) {
-	my($word,$key,@filist);
-	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
-	else { @filist = split /\s+/, $attribs{FILES}; }
-	foreach $word (@filist) {
-	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
-		push(@otherfiles, @{$self->{$key}});
+        my @filelist = ref $attribs{FILES} eq 'ARRAY'
+            ? @{$attribs{FILES}}
+            : split /\s+/, $attribs{FILES};
+
+	foreach my $word (@filelist) {
+	    if ($word =~ m#^\$\((.*)\)$# and 
+                ref $self->{$1} eq 'ARRAY') 
+            {
+		push(@otherfiles, @{$self->{$1}});
 	    }
 	    else { push(@otherfiles, $word); }
 	}
     }
-    push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
-    push(@otherfiles,File::Spec->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
-    my($file,$line);
-    $line = '';  #avoid unitialized var warning
+    push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) 
+                          perlmain.c pm_to_blib pm_to_blib.ts ]);
+    push(@otherfiles, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
+    push(@otherfiles, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld'));
+
     # Occasionally files are repeated several times from different sources
-    { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
+    { my(%of) = map { ($_ => 1) } @otherfiles; @otherfiles = keys %of; }
     
-    foreach $file (@otherfiles) {
+    my $line = '';
+    foreach my $file (@otherfiles) {
 	$file = $self->fixpath($file);
 	if (length($line) + length($file) > 80) {
 	    push @m, "\t\$(RM_RF) $line\n";
@@ -1499,6 +1259,39 @@ clean ::
     join('', @m);
 }
 
+
+=item clean_subdirs_target
+
+  my $make_frag = $MM->clean_subdirs_target;
+
+VMS semantics for changing directories and rerunning make very different.
+
+=cut
+
+sub clean_subdirs_target {
+    my($self) = shift;
+
+    # No subdirectories, no cleaning.
+    return <<'NOOP_FRAG' unless @{$self->{DIR}};
+clean_subdirs :
+	$(NOECHO) $(NOOP)
+NOOP_FRAG
+
+
+    my $clean = "clean_subdirs :\n";
+
+    foreach my $dir (@{$self->{DIR}}) { # clean subdirectories first
+	$dir = $self->fixpath($dir,1);
+
+        $clean .= sprintf <<'MAKE_FRAG', $dir, $dir;
+	If F$Search("%s$(FIRST_MAKEFILE)").nes."" Then $(PERLRUN) -e "chdir '%s'; print `$(MMS)$(MMSQUALIFIERS) clean`;"
+MAKE_FRAG
+    }
+
+    return $clean;
+}
+
+
 =item realclean (override)
 
 Guess what we're working around?  Also, use MM[SK] for subdirectories.
@@ -1514,7 +1307,7 @@ realclean :: clean
 ');
     foreach(@{$self->{DIR}}){
 	my($vmsdir) = $self->fixpath($_,1);
-	push(@m, '	If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
+	push(@m, '	If F$Search("'."$vmsdir".'$(FIRST_MAKEFILE)").nes."" Then \\',"\n\t",
 	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
     }
     push @m, "	\$(RM_RF) \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n";
@@ -1523,17 +1316,18 @@ realclean :: clean
     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
     # combination of macros).  In order to stay below DCL's 255 char limit,
     # we put only 2 on a line.
-    my($file,$line,$fcnt);
-    my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
+    my($file,$fcnt);
+    my(@files) = values %{$self->{PM}};
+    push @files, qw{ $(FIRST_MAKEFILE) $(MAKEFILE_OLD) };
     if ($self->has_link_code) {
 	push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
     }
-    push(@files, values %{$self->{PM}});
-    $line = '';  #avoid unitialized var warning
+
     # Occasionally files are repeated several times from different sources
     { my(%f) = map { ($_,1) } @files; @files = keys %f; }
+
+    my $line = '';
     foreach $file (@files) {
-	$file = $self->fixpath($file);
 	if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
 	    push @m, "\t\$(RM_F) $line\n";
 	    $line = "$file";
@@ -1569,32 +1363,32 @@ realclean :: clean
     join('', @m);
 }
 
+=item zipfile_target (o)
 
-=item dist_core (override)
+=item tarfile_target (o)
 
-Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
-so C<shdist> target actions are VMS-specific.
+=item shdist_target (o)
 
-=cut
-
-sub dist_core {
-    my($self) = @_;
-q[
-dist : $(DIST_DEFAULT)
-	$(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
+Syntax for invoking shar, tar and zip differs from that for Unix.
 
-zipdist : $(DISTVNAME).zip
-	$(NOECHO) $(NOOP)
+=cut
 
-tardist : $(DISTVNAME).tar$(SUFFIX)
-	$(NOECHO) $(NOOP)
+sub zipfile_target {
+    my($self) = shift;
 
+    return <<'MAKE_FRAG';
 $(DISTVNAME).zip : distdir
 	$(PREOP)
 	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
+MAKE_FRAG
+}
+
+sub tarfile_target {
+    my($self) = shift;
 
+    return <<'MAKE_FRAG';
 $(DISTVNAME).tar$(SUFFIX) : distdir
 	$(PREOP)
 	$(TO_UNIX)
@@ -1602,13 +1396,19 @@ $(DISTVNAME).tar$(SUFFIX) : distdir
 	$(RM_RF) $(DISTVNAME)
 	$(COMPRESS) $(DISTVNAME).tar
 	$(POSTOP)
+MAKE_FRAG
+}
 
+sub shdist_target {
+    my($self) = shift;
+
+    return <<'MAKE_FRAG';
 shdist : distdir
 	$(PREOP)
-	$(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
+	$(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
-];
+MAKE_FRAG
 }
 
 =item dist_test (override)
@@ -1642,18 +1442,18 @@ VMS-style command line quoting in a few cases.
 
 sub install {
     my($self, %attribs) = @_;
-    my(@m,@docfiles);
+    my(@m,@exe_files);
 
     if ($self->{EXE_FILES}) {
 	my($line,$file) = ('','');
 	foreach $file (@{$self->{EXE_FILES}}) {
 	    $line .= "$file ";
 	    if (length($line) > 128) {
-		push(@docfiles,qq[\t\$(NOECHO) \$(PERL) -e "print '$line'" >>.MM_tmp\n]);
+		push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]);
 		$line = '';
 	    }
 	}
-	push(@docfiles,qq[\t\$(NOECHO) \$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
+	push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]) if $line;
     }
 
     push @m, q[
@@ -1670,77 +1470,82 @@ pure_install :: pure_$(INSTALLDIRS)_install
 	$(NOECHO) $(NOOP)
 
 doc_install :: doc_$(INSTALLDIRS)_install
-	$(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
+        $(NOECHO) $(NOOP)
 
 pure__install : pure_site_install
-	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+	$(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 doc__install : doc_site_install
-	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+	$(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 # This hack brought to you by DCL's 255-character command line limit
 pure_perl_install ::
 	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
-	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
-	$(MOD_INSTALL) <.MM_tmp
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
-	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].File::Spec->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
+	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp
+	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
+	$(NOECHO) $(RM_F) .MM_tmp
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
 
 # Likewise
 pure_site_install ::
 	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
-	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLSITEBIN) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLSITEMAN1DIR) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLSITEMAN3DIR) '" >>.MM_tmp
-	$(MOD_INSTALL) <.MM_tmp
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
-	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].File::Spec->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
+	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp
+	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
+	$(NOECHO) $(RM_F) .MM_tmp
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
 
 pure_vendor_install ::
-	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLVENDORLIB) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLVENDORARCH) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLVENDORBIN) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLVENDORMAN1DIR) '" >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLVENDORMAN3DIR) '" >>.MM_tmp
-	$(MOD_INSTALL) <.MM_tmp
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
+	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp
+	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp
+	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
+	$(NOECHO) $(RM_F) .MM_tmp
 
 # Ditto
 doc_perl_install ::
-	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
-	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
-],@docfiles,
-q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
-	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.File::Spec->catfile($self->{INSTALLARCHLIB},'perllocal.pod').q[
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
+	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
+	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
+	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
+],@exe_files,
+q[	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
+	$(NOECHO) $(RM_F) .MM_tmp
 
 # And again
 doc_site_install ::
-	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
-	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
-],@docfiles,
-q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
-	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
-	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.File::Spec->catfile($self->{INSTALLARCHLIB},'perllocal.pod').q[
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
+	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
+	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
+	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
+],@exe_files,
+q[	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
+	$(NOECHO) $(RM_F) .MM_tmp
 
 doc_vendor_install ::
+	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
+	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
+	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
+],@exe_files,
+q[	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
+	$(NOECHO) $(RM_F) .MM_tmp
 
 ];
 
@@ -1749,16 +1554,16 @@ uninstall :: uninstall_from_$(INSTALLDIRS)dirs
 	$(NOECHO) $(NOOP)
 
 uninstall_from_perldirs ::
-	$(NOECHO) $(UNINSTALL) ].File::Spec->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
-	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
-	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
-	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
+	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
+	$(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
 
 uninstall_from_sitedirs ::
-	$(NOECHO) $(UNINSTALL) ],File::Spec->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist'),"\n",q[
-	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
-	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
-	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
+	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
+	$(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
 ];
 
     join('',@m);
@@ -1780,24 +1585,24 @@ sub perldepend {
 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
 $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
-$(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)fakethr.h, $(PERL_INC)form.h
+$(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
 $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
-$(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)opnames.h, $(PERL_INC)patchlevel.h
-$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlapi.h, $(PERL_INC)perlio.h
-$(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlsfio.h, $(PERL_INC)perlvars.h
+$(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
+$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
+$(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
 $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
 $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
 $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
-$(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h, $(PERL_INC)utf8.h
-$(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h, $(PERL_INC)warnings.h
+$(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h
+$(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h
 
 ' if $self->{OBJECT}; 
 
     if ($self->{PERL_SRC}) {
 	my(@macros);
-	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
+	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
 	push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
 	push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
 	push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
@@ -1850,16 +1655,16 @@ $(OBJECT) : $(FIRST_MAKEFILE)
 ] if $self->{OBJECT};
 
     push @m,q[
-# We take a very conservative approach here, but it\'s worth it.
-# We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
-$(MAKEFILE) : Makefile.PL $(CONFIGDEP)
-	$(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
-	$(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
-	- $(MV) $(MAKEFILE) $(MAKEFILE)_old
-	- $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+# We take a very conservative approach here, but it's worth it.
+# We move $(FIRST_MAKEFILE) to $(MAKEFILE_OLD) here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+	$(NOECHO) $(ECHO) "$(FIRST_MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
+	$(NOECHO) $(ECHO) "Cleaning current config before rebuilding $(FIRST_MAKEFILE) ..."
+	- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+	- $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE_OLD) clean
 	$(PERLRUN) Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
-	$(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
-	$(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
+	$(NOECHO) $(ECHO) "$(FIRST_MAKEFILE) has been rebuilt."
+	$(NOECHO) $(ECHO) "Please run $(MMS) to build the extension."
 ];
 
     join('',@m);
@@ -1899,10 +1704,10 @@ testdb :: testdb_\$(LINKTYPE)
 ";
     foreach(@{$self->{DIR}}){
       my($vmsdir) = $self->fixpath($_,1);
-      push(@m, '	If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
+      push(@m, '	If F$Search("',$vmsdir,'$(FIRST_MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
     }
-    push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
+    push(@m, "\t\$(NOECHO) \$(ECHO) \"No tests defined for \$(NAME) extension.\"\n")
         unless $tests or -f "test.pl" or @{$self->{DIR}};
     push(@m, "\n");
 
@@ -1949,7 +1754,7 @@ use vars qw(%olbs);
 
 sub makeaperl {
     my($self, %attribs) = @_;
-    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = 
+    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = 
       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
     my(@m);
     push @m, "
@@ -1963,10 +1768,10 @@ MAP_TARGET    = $target
     unless ($self->{MAKEAPERL}) {
 	push @m, q{
 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
-	$(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
+	$(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
 	$(NOECHO) $(PERLRUNINST) \
 		Makefile.PL DIR=}, $dir, q{ \
-		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
 		MAKEAPERL=1 NORECURS=1 };
 
 	push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
@@ -2091,23 +1896,23 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
     $shrtarget =~ s/^([^.]*)/$1Shr/;
     $shrtarget = $targdir . $shrtarget;
     $target = "Perlshr.$Config{'dlext'}" unless $target;
-    $tmp = "[]" unless $tmp;
-    $tmp = $self->fixpath($tmp,1);
+    $tmpdir = "[]" unless $tmpdir;
+    $tmpdir = $self->fixpath($tmpdir,1);
     if (@optlibs) { $extralist = join(' ',@optlibs); }
     else          { $extralist = ''; }
     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
     # that's what we're building here).
     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
     if ($libperl) {
-	unless (-f $libperl || -f ($libperl = File::Spec->catfile($Config{'installarchlib'},'CORE',$libperl))) {
+	unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
 	    print STDOUT "Warning: $libperl not found\n";
 	    undef $libperl;
 	}
     }
     unless ($libperl) {
 	if (defined $self->{PERL_SRC}) {
-	    $libperl = File::Spec->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
-	} elsif (-f ($libperl = File::Spec->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
+	    $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
+	} elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
 	} else {
 	    print STDOUT "Warning: $libperl not found
     If you're going to build a static perl binary, make sure perl is installed
@@ -2127,41 +1932,44 @@ MAP_LIBPERL = ",$self->fixpath($libperl,0),'
 ';
 
 
-    push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
+    push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
     foreach (@optlibs) {
 	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
     }
-    push @m,"\n${tmp}PerlShr.Opt :\n\t";
+    push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
 
-push @m,'
+    push @m,'
 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
 	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
-$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
-	$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
-	$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
-	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
-	$(NOECHO) $(SAY) "To remove the intermediate files, say
-	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
+	$(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
+	$(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
+	$(NOECHO) $(ECHO) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+	$(NOECHO) $(ECHO) "To remove the intermediate files, say
+	$(NOECHO) $(ECHO) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
 ';
-    push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
+    push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
     push @m, "# More from the 255-char line length limit\n";
     foreach (@staticpkgs) {
-	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
+	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
     }
-	push @m,'
-	$(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
-	$(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
+
+    push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
+	$(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
+	$(NOECHO) $(RM_F) %sWritemain.tmp
+MAKE_FRAG
 
     push @m, q[
 # Still more from the 255-char line length limit
 doc_inst_perl :
-	$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
-	$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
-	$(NOECHO) $(PERL) -pl040 -e " " ].File::Spec->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
-	$(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
-	$(DOC_INSTALL) <.MM_tmp >>].File::Spec->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
-	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+	$(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
+	$(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
+	$(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+	$(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
+	$(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) $(RM_F) .MM_tmp
 ];
 
     push @m, "
@@ -2176,8 +1984,8 @@ clean :: map_clean
 	\$(NOECHO) \$(NOOP)
 
 map_clean :
-	\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
-	\$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
+	\$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
+	\$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
 ";
 
     join '', @m;
@@ -2219,12 +2027,19 @@ used instead.
 
 sub prefixify {
     my($self, $var, $sprefix, $rprefix, $default) = @_;
+
+    # Translate $(PERLPREFIX) to a real path.
+    $rprefix = $self->eliminate_macros($rprefix);
+    $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
+    $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
+
     $default = VMS::Filespec::vmsify($default) 
       unless $default =~ /\[.*\]/;
 
     (my $var_no_install = $var) =~ s/^install//;
-    my $path = $self->{uc $var} || $Config{lc $var} || 
-               $Config{lc $var_no_install};
+    my $path = $self->{uc $var} || 
+               $ExtUtils::MM_Unix::Config_Override{lc $var} || 
+               $Config{lc $var} || $Config{lc $var_no_install};
 
     if( !$path ) {
         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
@@ -2238,7 +2053,7 @@ sub prefixify {
         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
 
-        my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
+        my($path_vol, $path_dirs) = $self->splitpath( $path );
         if( $path_vol eq $Config{vms_prefix}.':' ) {
             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
 
@@ -2275,19 +2090,247 @@ sub _prefixify_default {
 sub _catprefix {
     my($self, $rprefix, $default) = @_;
 
-    my($rvol, $rdirs) = File::Spec->splitpath($rprefix);
+    my($rvol, $rdirs) = $self->splitpath($rprefix);
     if( $rvol ) {
-        return File::Spec->catpath($rvol,
-                                   File::Spec->catdir($rdirs, $default),
+        return $self->catpath($rvol,
+                                   $self->catdir($rdirs, $default),
                                    ''
                                   )
     }
     else {
-        return File::Spec->catdir($rdirs, $default);
+        return $self->catdir($rdirs, $default);
     }
 }
 
 
+=item oneliner (o)
+
+=cut
+
+sub oneliner {
+    my($self, $cmd, $switches) = @_;
+    $switches = [] unless defined $switches;
+
+    # Strip leading and trailing newlines
+    $cmd =~ s{^\n+}{};
+    $cmd =~ s{\n+$}{};
+
+    $cmd = $self->quote_literal($cmd);
+    $cmd = $self->escape_newlines($cmd);
+
+    # Switches must be quoted else they will be lowercased.
+    $switches = join ' ', map { qq{"$_"} } @$switches;
+
+    return qq{\$(PERLRUN) $switches -e $cmd};
+}
+
+
+=item B<echo> (o)
+
+perl trips up on "<foo>" thinking it's an input redirect.  So we use the
+native Write command instead.  Besides, its faster.
+
+=cut
+
+sub echo {
+    my($self, $text, $file, $appending) = @_;
+    $appending ||= 0;
+
+    my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
+
+    my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
+    push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) } 
+                split /\n/, $text;
+    push @cmds, '$(NOECHO) Close MMECHOFILE';
+    return @cmds;
+}
+
+
+=item quote_literal
+
+=cut
+
+sub quote_literal {
+    my($self, $text) = @_;
+
+    # I believe this is all we should need.
+    $text =~ s{"}{""}g;
+
+    return qq{"$text"};
+}
+
+=item escape_newlines
+
+=cut
+
+sub escape_newlines {
+    my($self, $text) = @_;
+
+    $text =~ s{\n}{-\n}g;
+
+    return $text;
+}
+
+=item max_exec_len
+
+256 characters.
+
+=cut
+
+sub max_exec_len {
+    my $self = shift;
+
+    return $self->{_MAX_EXEC_LEN} ||= 256;
+}
+
+=item init_linker (o)
+
+=cut
+
+sub init_linker {
+    my $self = shift;
+    $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
+
+    my $shr = $Config{dbgprefix} . 'PERLSHR';
+    if ($self->{PERL_SRC}) {
+        $self->{PERL_ARCHIVE} ||=
+          $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
+    }
+    else {
+        $self->{PERL_ARCHIVE} ||=
+          $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
+    }
+
+    $self->{PERL_ARCHIVE_AFTER} ||= '';
+}
+
+=item eliminate_macros
+
+Expands MM[KS]/Make macros in a text string, using the contents of
+identically named elements of C<%$self>, and returns the result
+as a file specification in Unix syntax.
+
+NOTE:  This is the canonical version of the method.  The version in
+File::Spec::VMS is deprecated.
+
+=cut
+
+sub eliminate_macros {
+    my($self,$path) = @_;
+    return '' unless $path;
+    $self = {} unless ref $self;
+
+    if ($path =~ /\s/) {
+      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+    }
+
+    my($npath) = unixify($path);
+    # sometimes unixify will return a string with an off-by-one trailing null
+    $npath =~ s{\0$}{};
+
+    my($complex) = 0;
+    my($head,$macro,$tail);
+
+    # perform m##g in scalar context so it acts as an iterator
+    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
+        if (defined $self->{$2}) {
+            ($head,$macro,$tail) = ($1,$2,$3);
+            if (ref $self->{$macro}) {
+                if (ref $self->{$macro} eq 'ARRAY') {
+                    $macro = join ' ', @{$self->{$macro}};
+                }
+                else {
+                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                    $macro = "\cB$macro\cB";
+                    $complex = 1;
+                }
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
+            $npath = "$head$macro$tail";
+        }
+    }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
+    $npath;
+}
+
+=item fixpath
+
+Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
+in any directory specification, in order to avoid juxtaposing two
+VMS-syntax directories when MM[SK] is run.  Also expands expressions which
+are all macro, so that we can tell how long the expansion is, and avoid
+overrunning DCL's command buffer when MM[KS] is running.
+
+If optional second argument has a TRUE value, then the return string is
+a VMS-syntax directory specification, if it is FALSE, the return string
+is a VMS-syntax file specification, and if it is not specified, fixpath()
+checks to see whether it matches the name of a directory in the current
+default directory, and returns a directory or file specification accordingly.
+
+NOTE:  This is the canonical version of the method.  The version in
+File::Spec::VMS is deprecated.
+
+=cut
+
+sub fixpath {
+    my($self,$path,$force_path) = @_;
+    return '' unless $path;
+    $self = bless {} unless ref $self;
+    my($fixedpath,$prefix,$name);
+
+    if ($path =~ /\s/) {
+      return join ' ',
+             map { $self->fixpath($_,$force_path) }
+	     split /\s+/, $path;
+    }
+
+    if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
+            $fixedpath = vmspath($self->eliminate_macros($path));
+        }
+        else {
+            $fixedpath = vmsify($self->eliminate_macros($path));
+        }
+    }
+    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
+        my($vmspre) = $self->eliminate_macros("\$($prefix)");
+        # is it a dir or just a name?
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # No hints, so we try to guess
+    if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+        $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+    }
+
+    # Trim off root dirname if it's had other dirs inserted in front of it.
+    $fixedpath =~ s/\.000000([\]>])/$1/;
+    # Special case for VMS absolute directory specs: these will have had device
+    # prepended during trip through Unix syntax in eliminate_macros(), since
+    # Unix syntax has no way to express "absolute from the top of this device's
+    # directory tree".
+    if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
+
+    return $fixedpath;
+}
+
+
+=item os_flavor
+
+VMS is VMS.
+
+=cut
+
+sub os_flavor {
+    return('VMS');
+}
+
 =back
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
index 03af82e839f..8fe0b96d955 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
@@ -1,5 +1,7 @@
 package ExtUtils::MM_Win32;
 
+use strict;
+
 
 =head1 NAME
 
@@ -15,8 +17,6 @@ See ExtUtils::MM_Unix for a documentation of the methods provided
 there. This package overrides the implementation of these methods, not
 the semantics.
 
-=over 4
-
 =cut 
 
 use Config;
@@ -24,12 +24,12 @@ use File::Basename;
 use File::Spec;
 use ExtUtils::MakeMaker qw( neatvalue );
 
-use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE $PERLMAKE);
+use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE);
 
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
 @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
-$VERSION = '1.05';
+$VERSION = '1.09';
 
 $ENV{EMXSHELL} = 'sh'; # to run `commands`
 
@@ -37,7 +37,15 @@ $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
 $GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
 $DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
 $NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
-$PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i;
+
+
+=head2 Overridden methods
+
+=over 4
+
+=item B<dlsyms>
+
+=cut
 
 sub dlsyms {
     my($self,%attribs) = @_;
@@ -47,7 +55,6 @@ sub dlsyms {
     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
     my(@m);
-    (my $boot = $self->{NAME}) =~ s/:/_/g;
 
     if (not $self->{SKIPHASH}{'dynamic'}) {
 	push(@m,"
@@ -69,12 +76,30 @@ $self->{BASEEXT}.def: Makefile.PL
     join('',@m);
 }
 
+=item replace_manpage_separator
+
+Changes the path separator with .
+
+=cut
+
 sub replace_manpage_separator {
     my($self,$man) = @_;
     $man =~ s,/+,.,g;
     $man;
 }
 
+
+=item B<maybe_command>
+
+Since Windows has nothing as simple as an executable bit, we check the
+file extension.
+
+The PATHEXT env variable will be used to get a list of extensions that
+might indicate a command, otherwise .com, .exe, .bat and .cmd will be
+used by default.
+
+=cut
+
 sub maybe_command {
     my($self,$file) = @_;
     my @e = exists($ENV{'PATHEXT'})
@@ -96,313 +121,185 @@ sub maybe_command {
 }
 
 
-sub find_perl {
-    my($self, $ver, $names, $dirs, $trace) = @_;
-    $trace ||= 0;
+=item B<find_tests>
 
-    my($name, $dir);
-    if ($trace >= 2){
-	print "Looking for perl $ver by these names:
-@$names
-in these dirs:
-@$dirs
-";
-    }
-    foreach $dir (@$dirs){
-	next unless defined $dir; # $self->{PERL_SRC} may be undefined
-	foreach $name (@$names){
-	    my ($abs, $val);
-	    if (File::Spec->file_name_is_absolute($name)) {  # /foo/bar
-		$abs = $name;
-	    } elsif (File::Spec->canonpath($name) eq 
-                     File::Spec->canonpath(basename($name))) # foo
-            {
-		$abs = File::Spec->catfile($dir, $name);
-	    } else {                                         # foo/bar
-		$abs = File::Spec->canonpath(
-                           File::Spec->catfile(File::Spec->curdir, $name)
-                       );
-	    }
-	    print "Checking $abs\n" if ($trace >= 2);
-	    next unless $self->maybe_command($abs);
-	    print "Executing $abs\n" if ($trace >= 2);
-            (my($safe_abs) = $abs) =~ s{(\s)}{\\$1}g;
-	    $val = `$safe_abs -e "require $ver;" 2>&1`;
-	    if ($? == 0) {
-	        print "Using PERL=$abs\n" if $trace;
-	        return $abs;
-	    } elsif ($trace >= 2) {
-		print "Result: `$val'\n";
-	    }
-	}
-    }
-    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
-    0; # false and not empty
-}
+The Win9x shell does not expand globs and I'll play it safe and assume
+other Windows variants don't either.
 
+So we do it for them.
+
+=cut
 
-# This code was taken out of MM_Unix to avoid loading File::Glob
-# unless necessary.
 sub find_tests {
     return join(' ', <t\\*.t>);
 }
 
 
-sub init_others
-{
- my ($self) = @_;
- $self->SUPER::init_others;
- $self->{'TOUCH'}  = '$(PERLRUN) -MExtUtils::Command -e touch';
- $self->{'CHMOD'}  = '$(PERLRUN) -MExtUtils::Command -e chmod'; 
- $self->{'CP'}     = '$(PERLRUN) -MExtUtils::Command -e cp';
- $self->{'RM_F'}   = '$(PERLRUN) -MExtUtils::Command -e rm_f';
- $self->{'RM_RF'}  = '$(PERLRUN) -MExtUtils::Command -e rm_rf';
- $self->{'MV'}     = '$(PERLRUN) -MExtUtils::Command -e mv';
- $self->{'NOOP'}   = 'rem';
- $self->{'TEST_F'} = '$(PERLRUN) -MExtUtils::Command -e test_f';
- $self->{'LD'}     = $Config{'ld'} || 'link';
- $self->{'AR'}     = $Config{'ar'} || 'lib';
- $self->{'LDLOADLIBS'} ||= $Config{'libs'};
- # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
- if ($BORLAND) {
-     my $libs = $self->{'LDLOADLIBS'};
-     my $libpath = '';
-     while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
-         $libpath .= ' ' if length $libpath;
-         $libpath .= $1;
-     }
-     $self->{'LDLOADLIBS'} = $libs;
-     $self->{'LDDLFLAGS'} ||= $Config{'lddlflags'};
-     $self->{'LDDLFLAGS'} .= " $libpath";
- }
- $self->{'DEV_NULL'} = '> NUL';
+=item B<init_DIRFILESEP>
+
+Using \ for Windows.
+
+=cut
+
+sub init_DIRFILESEP {
+    my($self) = shift;
+
+    # The ^ makes sure its not interpreted as an escape in nmake
+    $self->{DIRFILESEP} = $NMAKE ? '^\\' :
+                          $DMAKE ? '\\\\'
+                                 : '\\';
 }
 
+=item B<init_others>
+
+Override some of the Unix specific commands with portable
+ExtUtils::Command ones.
 
-=item constants (o)
+Also provide defaults for LD and AR in case the %Config values aren't
+set.
 
-Initializes lots of constants and .SUFFIXES and .PHONY
+LDLOADLIBS's default is changed to $Config{libs}.
+
+Adjustments are made for Borland's quirks needing -L to come first.
 
 =cut
 
-sub constants {
-    my($self) = @_;
-    my(@m,$tmp);
-
-    for $tmp (qw/
-	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
-	      VERSION_SYM XS_VERSION 
-          INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT 
-          INSTALLDIRS
-          PREFIX          SITEPREFIX      VENDORPREFIX
-	      INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
-	      INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
-          INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN  INSTALLSCRIPT 
-          PERL_LIB        PERL_ARCHLIB 
-          SITELIBEXP      SITEARCHEXP 
-          LIBPERL_A MYEXTLIB
-	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC
-	      PERL_INC PERL FULLPERL PERLRUN FULLPERLRUN PERLRUNINST 
-          FULLPERLRUNINST ABSPERL ABSPERLRUN ABSPERLRUNINST
-          FULL_AR PERL_CORE
-
-	      / ) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
+sub init_others {
+    my ($self) = @_;
+
+    # Used in favor of echo because echo won't strip quotes. :(
+    $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
+    $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
+
+    $self->{TOUCH}    ||= '$(PERLRUN) -MExtUtils::Command -e touch';
+    $self->{CHMOD}    ||= '$(PERLRUN) -MExtUtils::Command -e chmod'; 
+    $self->{CP}       ||= '$(PERLRUN) -MExtUtils::Command -e cp';
+    $self->{RM_F}     ||= '$(PERLRUN) -MExtUtils::Command -e rm_f';
+    $self->{RM_RF}    ||= '$(PERLRUN) -MExtUtils::Command -e rm_rf';
+    $self->{MV}       ||= '$(PERLRUN) -MExtUtils::Command -e mv';
+    $self->{NOOP}     ||= 'rem';
+    $self->{TEST_F}   ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
+    $self->{DEV_NULL} ||= '> NUL';
+
+    $self->{LD}     ||= $Config{ld} || 'link';
+    $self->{AR}     ||= $Config{ar} || 'lib';
+
+    $self->SUPER::init_others;
+
+    # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
+    delete $self->{SHELL};
+
+    $self->{LDLOADLIBS} ||= $Config{libs};
+    # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
+    if ($BORLAND) {
+        my $libs = $self->{LDLOADLIBS};
+        my $libpath = '';
+        while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
+            $libpath .= ' ' if length $libpath;
+            $libpath .= $1;
+        }
+        $self->{LDLOADLIBS} = $libs;
+        $self->{LDDLFLAGS} ||= $Config{lddlflags};
+        $self->{LDDLFLAGS} .= " $libpath";
     }
 
-    push @m, qq{
-VERSION_MACRO = VERSION
-DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
-XS_VERSION_MACRO = XS_VERSION
-XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
-};
+    return 1;
+}
 
-    push @m, qq{
-MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'}
-MM_VERSION = $ExtUtils::MakeMaker::VERSION
-};
 
-    push @m, q{
-# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
-# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
-# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
-# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
-};
+=item init_platform (o)
 
-    for $tmp (qw/
-	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
-	      LDFROM LINKTYPE
-	      /	) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
-    }
+Add MM_Win32_VERSION.
 
-    push @m, "
-# Handy lists of source code files:
-XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})."
-C_FILES = ".join(" \\\n\t", @{$self->{C}})."
-O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})."
-H_FILES = ".join(" \\\n\t", @{$self->{H}})."
-MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})."
-MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
-";
-
-    for $tmp (qw/
-	      INST_MAN1DIR  MAN1EXT 
-          INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
-	      INST_MAN3DIR  MAN3EXT
-          INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
-	      /) {
-	next unless defined $self->{$tmp};
-	push @m, "$tmp = $self->{$tmp}\n";
-    }
+=item platform_constants (o)
 
-    push @m, qq{
-.USESHELL :
-} if $DMAKE;
+=cut
 
-    push @m, q{
-.NO_CONFIG_REC: Makefile
-} if $ENV{CLEARCASE_ROOT};
+sub init_platform {
+    my($self) = shift;
 
-    # why not q{} ? -- emacs
-    push @m, qq{
-# work around a famous dec-osf make(1) feature(?):
-makemakerdflt: all
+    $self->{MM_Win32_VERSION} = $VERSION;
+}
 
-.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT)
+sub platform_constants {
+    my($self) = shift;
+    my $make_frag = '';
 
-# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to 
-# recall, that some make implementations will delete the Makefile when we 
-# rebuild it. Because we call false(1) when we rebuild it. So make(1) is 
-# not completely wrong when it does so. Our milage may vary.
-# .PRECIOUS: Makefile    # seems to be not necessary anymore
+    foreach my $macro (qw(MM_Win32_VERSION))
+    {
+        next unless defined $self->{$macro};
+        $make_frag .= "$macro = $self->{$macro}\n";
+    }
 
-.PHONY: all config static dynamic test linkext manifest
+    return $make_frag;
+}
 
-# Where is the Config information that we are using/depend on
-CONFIGDEP = \$(PERL_ARCHLIB)\\Config.pm \$(PERL_INC)\\config.h
-};
 
-    my @parentdir = split(/::/, $self->{PARENT_NAME});
-    push @m, q{
-# Where to put things:
-INST_LIBDIR      = }. File::Spec->catdir('$(INST_LIB)',@parentdir)        .q{
-INST_ARCHLIBDIR  = }. File::Spec->catdir('$(INST_ARCHLIB)',@parentdir)    .q{
+=item special_targets (o)
 
-INST_AUTODIR     = }. File::Spec->catdir('$(INST_LIB)','auto','$(FULLEXT)')       .q{
-INST_ARCHAUTODIR = }. File::Spec->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)')   .q{
-};
+Add .USESHELL target for dmake.
 
-    if ($self->has_link_code()) {
-	push @m, '
-INST_STATIC  = $(INST_ARCHAUTODIR)\$(BASEEXT)$(LIB_EXT)
-INST_DYNAMIC = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT)
-INST_BOOT    = $(INST_ARCHAUTODIR)\$(BASEEXT).bs
-';
-    } else {
-	push @m, '
-INST_STATIC  =
-INST_DYNAMIC =
-INST_BOOT    =
-';
-    }
+=cut
 
-    $tmp = $self->export_list;
-    push @m, "
-EXPORT_LIST = $tmp
-";
-    $tmp = $self->perl_archive;
-    push @m, "
-PERL_ARCHIVE = $tmp
-";
+sub special_targets {
+    my($self) = @_;
 
-    push @m, q{
-TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{
+    my $make_frag = $self->SUPER::special_targets;
 
-PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
-};
+    $make_frag .= <<'MAKE_FRAG' if $DMAKE;
+.USESHELL :
+MAKE_FRAG
 
-    join('',@m);
+    return $make_frag;
 }
 
 
 =item static_lib (o)
 
-Defines how to produce the *.a (or equivalent) files.
+Changes how to run the linker.
+
+The rest is duplicate code from MM_Unix.  Should move the linker code
+to its own method.
 
 =cut
 
 sub static_lib {
     my($self) = @_;
-# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
-#    return '' unless $self->needs_linking(); #might be because of a subdir
-
     return '' unless $self->has_link_code;
 
     my(@m);
     push(@m, <<'END');
-$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)\.exists
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
 	$(RM_RF) $@
 END
+
     # If this extension has its own library (eg SDBM_File)
     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
-    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
+    push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
+	$(CP) $(MYEXTLIB) $@
+MAKE_FRAG
 
     push @m,
 q{	$(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 			  : ($GCC ? '-ru $@ $(OBJECT)'
 			          : '-out:$@ $(OBJECT)')).q{
-	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
-	$(CHMOD) 755 $@
+	$(CHMOD) $(PERM_RWX) $@
+	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
 };
 
-# Old mechanism - still available:
-
-    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs}."\n\n"
-	if $self->{PERL_SRC};
+    # Old mechanism - still available:
+    push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
+	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
+MAKE_FRAG
 
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
-    join('', "\n",@m);
+    push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('', @m);
 }
 
-=item dynamic_bs (o)
-
-Defines targets for bootstrap files.
-
-=cut
-
-sub dynamic_bs {
-    my($self, %attribs) = @_;
-    return '
-BOOTSTRAP =
-' unless $self->has_link_code();
-
-    return '
-BOOTSTRAP = '."$self->{BASEEXT}.bs".'
-
-# As Mkbootstrap might not write a file (if none is required)
-# we use touch to prevent make continually trying to remake it.
-# The DynaLoader only reads a non-empty file.
-$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)\.exists
-	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
-	'.$self->{NOECHO}.'$(PERLRUN) \
-		-MExtUtils::Mkbootstrap \
-		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
-	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
-	$(CHMOD) 644 $@
-
-$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists
-	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
-	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
-	$(CHMOD) 644 $@
-';
-}
 
 =item dynamic_lib (o)
 
-Defines how to produce the *.so (or equivalent) files.
+Complicated stuff for Win32 that I don't understand. :(
 
 =cut
 
@@ -434,7 +331,7 @@ sub dynamic_lib {
 OTHERLDFLAGS = '.$otherldflags.'
 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 ');
     if ($GCC) {
       push(@m,  
@@ -456,13 +353,20 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists
       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
     }
     push @m, '
-	$(CHMOD) 755 $@
+	$(CHMOD) $(PERM_RWX) $@
 ';
 
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
 
+=item clean
+
+Clean out some extra dll.{base,exp} files which might be generated by
+gcc.  Otherwise, take out all *.pdb files.
+
+=cut
+
 sub clean
 {
     my ($self) = shift;
@@ -476,309 +380,134 @@ END
     return $s;
 }
 
+=item init_linker
 
+=cut
 
-sub perl_archive
-{
-    my ($self) = @_;
-    return '$(PERL_INC)\\'.$Config{'libperl'};
-}
+sub init_linker {
+    my $self = shift;
 
-sub export_list
-{
- my ($self) = @_;
- return "$self->{BASEEXT}.def";
+    $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
+    $self->{PERL_ARCHIVE_AFTER} = '';
+    $self->{EXPORT_LIST}        = '$(BASEEXT).def';
 }
 
 
 =item perl_script
 
-Takes one argument, a file name, and returns the file name, if the
-argument is likely to be a perl script. On MM_Unix this is true for
-any ordinary, readable file.
+Checks for the perl program under several common perl extensions.
 
 =cut
 
 sub perl_script {
     my($self,$file) = @_;
     return $file if -r $file && -f _;
-    return "$file.pl" if -r "$file.pl" && -f _;
+    return "$file.pl"  if -r "$file.pl" && -f _;
+    return "$file.plx" if -r "$file.plx" && -f _;
     return "$file.bat" if -r "$file.bat" && -f _;
     return;
 }
 
-=item pm_to_blib
-
-Defines target that copies all files in the hash PM to their
-destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
-
-=cut
 
-sub pm_to_blib {
-    my $self = shift;
-    my($autodir) = File::Spec->catdir('$(INST_LIB)','auto');
-    return q{
-pm_to_blib: $(TO_INST_PM)
-	}.$self->{NOECHO}.q{$(PERLRUNINST) -MExtUtils::Install \
-        -e "pm_to_blib(}.
-	($NMAKE ? 'qw[ <<pmfiles.dat ],'
-	        : $DMAKE ? 'qw[ $(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n) ],'
-			 : '{ qw[$(PM_TO_BLIB)] },'
-	 ).q{'}.$autodir.q{','$(PM_FILTER)')"
-}. ($NMAKE ? q{
-$(PM_TO_BLIB)
-<<
-	} : '') . "\t".$self->{NOECHO}.q{$(TOUCH) $@
-};
-}
-
-
-=item tool_autosplit (override)
+=item xs_o (o)
 
-Use Win32 quoting on command line.
+This target is stubbed out.  Not sure why.
 
 =cut
 
-sub tool_autosplit{
-    my($self, %attribs) = @_;
-    my($asl) = "";
-    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
-    q{
-# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
-AUTOSPLITFILE = $(PERLRUN) -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);"
-};
+sub xs_o {
+    return ''
 }
 
-=item tools_other (o)
 
-Win32 overrides.
+=item pasthru (o)
 
-Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
-the Makefile. Also defines the perl programs MKPATH,
-WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
+All we send is -nologo to nmake to prevent it from printing its damned
+banner.
 
 =cut
 
-sub tools_other {
+sub pasthru {
     my($self) = shift;
-    my @m;
-    my $bin_sh = $Config{sh} || 'cmd /c';
-    push @m, qq{
-SHELL = $bin_sh
-} unless $DMAKE;  # dmake determines its own shell 
-
-    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
-	push @m, "$_ = $self->{$_}\n";
-    }
-
-    push @m, q{
-# The following is a portable way to say mkdir -p
-# To see which directories are created, change the if 0 to if 1
-MKPATH = $(PERLRUN) -MExtUtils::Command -e mkpath
-
-# This helps us to minimize the effect of the .exists files A yet
-# better solution would be to have a stable file in the perl
-# distribution with a timestamp of zero. But this solution doesn't
-# need any changes to the core distribution and works with older perls
-EQUALIZE_TIMESTAMP = $(PERLRUN) -MExtUtils::Command -e eqtime
-};
-
-
-    return join "", @m if $self->{PARENT};
-
-    push @m, q{
-# Here we warn users that an old packlist file was found somewhere,
-# and that they should call some uninstall routine
-WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\
--e "print 'WARNING: I have found an old package in';" \\
--e "print '	', $$ARGV[0], '.';" \\
--e "print 'Please make sure the two installations are not conflicting';"
-
-UNINST=0
-VERBINST=1
-
-MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
--e "install({ @ARGV },'$(VERBINST)',0,'$(UNINST)');"
-
-DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \
--e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', $$arg=shift, '|', $$arg, '>';" \
--e "print '=over 4';" \
--e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \
--e "print '=back';"
-
-UNINSTALL =   $(PERL) -MExtUtils::Install \
--e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \
--e "print \" packlist above carefully.\n  There may be errors. Remove the\";" \
--e "print \" appropriate files manually.\n  Sorry for the inconveniences.\n\""
-};
-
-    return join "", @m;
+    return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
 }
 
-=item xs_o (o)
 
-Defines suffix rules to go from XS to object files directly. This is
-only intended for broken make implementations.
+=item oneliner (o)
 
-=cut
-
-sub xs_o {	# many makes are too dumb to use xs_c then c_o
-    my($self) = shift;
-    return ''
-}
-
-=item top_targets (o)
-
-Defines the targets all, subdirs, config, and O_FILES
+These are based on what command.com does on Win98.  They may be wrong
+for other Windows shells, I don't know.
 
 =cut
 
-sub top_targets {
-# --- Target Sections ---
+sub oneliner {
+    my($self, $cmd, $switches) = @_;
+    $switches = [] unless defined $switches;
 
-    my($self) = shift;
-    my(@m);
-
-    push @m, '
-all :: pure_all manifypods
-	'.$self->{NOECHO}.'$(NOOP)
-' 
-	  unless $self->{SKIPHASH}{'all'};
-    
-    push @m, '
-pure_all :: config pm_to_blib subdirs linkext
-	'.$self->{NOECHO}.'$(NOOP)
+    # Strip leading and trailing newlines
+    $cmd =~ s{^\n+}{};
+    $cmd =~ s{\n+$}{};
 
-subdirs :: $(MYEXTLIB)
-	'.$self->{NOECHO}.'$(NOOP)
+    $cmd = $self->quote_literal($cmd);
+    $cmd = $self->escape_newlines($cmd);
 
-config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)\.exists
-	'.$self->{NOECHO}.'$(NOOP)
+    $switches = join ' ', @$switches;
 
-config :: $(INST_ARCHAUTODIR)\.exists
-	'.$self->{NOECHO}.'$(NOOP)
+    return qq{\$(PERLRUN) $switches -e $cmd};
+}
 
-config :: $(INST_AUTODIR)\.exists
-	'.$self->{NOECHO}.'$(NOOP)
-';
 
-    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
+sub quote_literal {
+    my($self, $text) = @_;
 
-    if (%{$self->{MAN1PODS}}) {
-	push @m, qq[
-config :: \$(INST_MAN1DIR)\\.exists
-	$self->{NOECHO}\$(NOOP)
+    # I don't know if this is correct, but it seems to work on
+    # Win98's command.com
+    $text =~ s{"}{\\"}g;
 
-];
-	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    # dmake eats '{' inside double quotes and leaves alone { outside double
+    # quotes; however it transforms {{ into { either inside and outside double
+    # quotes.  It also translates }} into }.  The escaping below is not
+    # 100% correct.
+    if( $DMAKE ) {
+        $text =~ s/{/{{/g;
+        $text =~ s/}}/}}}/g;
     }
-    if (%{$self->{MAN3PODS}}) {
-	push @m, qq[
-config :: \$(INST_MAN3DIR)\\.exists
-	$self->{NOECHO}\$(NOOP)
 
-];
-	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
-    }
-
-    push @m, '
-$(O_FILES): $(H_FILES)
-' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
-
-    push @m, q{
-help:
-	perldoc ExtUtils::MakeMaker
-};
-
-    join('',@m);
+    return qq{"$text"};
 }
 
-=item manifypods (o)
 
-We don't want manpage process.
+sub escape_newlines {
+    my($self, $text) = @_;
 
-=cut
+    # Escape newlines
+    $text =~ s{\n}{\\\n}g;
 
-sub manifypods {
-    my($self) = shift;
-    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
+    return $text;
 }
 
-=item dist_ci (o)
-
-Same as MM_Unix version (changes command-line quoting).
-
-=cut
-
-sub dist_ci {
-    my($self) = shift;
-    my @m;
-    push @m, q{
-ci :
-	$(PERLRUN) -MExtUtils::Manifest=maniread \\
-		-e "@all = keys %{ maniread() };" \\
-		-e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\
-		-e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");"
-};
-    join "", @m;
-}
 
-=item dist_core (o)
+=item max_exec_len
 
-Same as MM_Unix version (changes command-line quoting).
+nmake 1.50 limits command length to 2048 characters.
 
 =cut
 
-sub dist_core {
-    my($self) = shift;
-    my @m;
-    push @m, q{
-dist : $(DIST_DEFAULT)
-	}.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \
-	    -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";"
-
-tardist : $(DISTVNAME).tar$(SUFFIX)
-
-zipdist : $(DISTVNAME).zip
-
-$(DISTVNAME).tar$(SUFFIX) : distdir
-	$(PREOP)
-	$(TO_UNIX)
-	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
-	$(RM_RF) $(DISTVNAME)
-	$(COMPRESS) $(DISTVNAME).tar
-	$(POSTOP)
-
-$(DISTVNAME).zip : distdir
-	$(PREOP)
-	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
-	$(RM_RF) $(DISTVNAME)
-	$(POSTOP)
-
-uutardist : $(DISTVNAME).tar$(SUFFIX)
-	uuencode $(DISTVNAME).tar$(SUFFIX) \\
-		$(DISTVNAME).tar$(SUFFIX) > \\
-		$(DISTVNAME).tar$(SUFFIX)_uu
-
-shdist : distdir
-	$(PREOP)
-	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
-	$(RM_RF) $(DISTVNAME)
-	$(POSTOP)
-};
-    join "", @m;
+sub max_exec_len {
+    my $self = shift;
+
+    return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
 }
 
-=item pasthru (o)
 
-Defines the string that is passed to recursive make calls in
-subdirectories.
+=item os_flavor
+
+Windows is Win32.
 
 =cut
 
-sub pasthru {
-    my($self) = shift;
-    return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
+sub os_flavor {
+    return('Win32');
 }
 
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
index 94267570b74..ad850de27eb 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
@@ -2,21 +2,20 @@ package ExtUtils::MakeMaker;
 
 BEGIN {require 5.005_03;}
 
-$VERSION = "6.03";
-$Version_OK = "5.49";   # Makefiles older than $Version_OK will die
-                        # (Will be checked from MakeMaker version 4.13 onwards)
-($Revision = substr(q$Revision: 1.6 $, 10)) =~ s/\s+$//;
+$VERSION = '6.17';
+($Revision) = q$Revision: 1.7 $ =~ /Revision:\s+(\S+)/;
 
 require Exporter;
 use Config;
 use Carp ();
+use File::Path;
 
 use vars qw(
             @ISA @EXPORT @EXPORT_OK
-            $ISA_TTY $Revision $VERSION $Verbose $Version_OK %Config 
-            %Keep_after_flush %MM_Sections @Prepend_parent
+            $Revision $VERSION $Verbose %Config 
+            @Prepend_parent @Parent
             %Recognized_Att_Keys @Get_from_Config @MM_Sections @Overridable 
-            @Parent $PACKNAME
+            $Filename
            );
 use strict;
 
@@ -29,6 +28,10 @@ use strict;
 my $Is_VMS     = $^O eq 'VMS';
 my $Is_Win32   = $^O eq 'MSWin32';
 
+# Our filename for diagnostic and debugging purposes.  More reliable
+# than %INC (think caseless filesystems)
+$Filename = __FILE__;
+
 full_setup();
 
 require ExtUtils::MM;  # Things like CPAN assume loading ExtUtils::MakeMaker
@@ -57,109 +60,31 @@ sub WriteMakefile {
 # Basic signatures of the attributes WriteMakefile takes.  Each is the
 # reference type.  Empty value indicate it takes a non-reference
 # scalar.
-my %Att_Sigs =
-(
- ABSTRACT           => '',
- ABSTRACT_FROM      => '',
- AUTHOR             => '',
- BINARY_LOCATION    => '',
+my %Att_Sigs;
+my %Special_Sigs = (
  C                  => 'array',
- CCFLAGS            => '',
  CONFIG             => 'array',
  CONFIGURE          => 'code',
- DEFINE             => '',
  DIR                => 'array',
- DISTNAME           => '',
  DL_FUNCS           => 'hash',
  DL_VARS            => 'array',
  EXCLUDE_EXT        => 'array',
  EXE_FILES          => 'array',
- FIRST_MAKEFILE     => '',
- FULLPERL           => '',
- FULLPERLRUN        => '',
- FULLPERLRUNINST    => '',
  FUNCLIST           => 'array',
  H                  => 'array',
  IMPORTS            => 'hash',
- INC                => '',
  INCLUDE_EXT        => 'array',
- INSTALLARCHLIB     => '',
- INSTALLBIN         => '',
- INSTALLDIRS        => '',
- INSTALLMAN1DIR     => '',
- INSTALLMAN3DIR     => '',
- INSTALLPRIVLIB     => '',
- INSTALLSCRIPT      => '',
- INSTALLSITEARCH    => '',
- INSTALLSITEBIN     => '',
- INSTALLSITELIB     => '',
- INSTALLSITEMAN1DIR => '',
- INSTALLSITEMAN3DIR => '',
- INSTALLVENDORARCH  => '',
- INSTALLVENDORBIN   => '',
- INSTALLVENDORLIB   => '',
- INSTALLVENDORMAN1DIR   => '',
- INSTALLVENDORMAN3DIR   => '',
- INST_ARCHLIB       => '',
- INST_BIN           => '',
- INST_LIB           => '',
- INST_MAN1DIR       => '',
- INST_MAN3DIR       => '',
- INST_SCRIPT        => '',
- _KEEP_AFTER_FLUSH  => '',
- LDDLFLAGS          => '',
- LDFROM             => '',
- LIB                => '',
- LIBPERL_A          => '',
  LIBS               => ['array',''],
- LINKTYPE           => '',
- MAKEAPERL          => '',
- MAKEFILE           => '',
  MAN1PODS           => 'hash',
  MAN3PODS           => 'hash',
- MAP_TARGET         => '',
- MYEXTLIB           => '',
- NAME               => '',
- NEEDS_LINKING      => '',
- NOECHO             => '',
- NORECURS           => '',
- NO_VC              => '',
- OBJECT             => '',
- OPTIMIZE           => '',
- PERL               => '',
- PERL_CORE          => '',
- PERLMAINCC         => '',
- PERL_ARCHLIB       => '',
- PERL_LIB           => '',
- PERL_MALLOC_OK     => '',
- PERLRUN            => '',
- PERLRUNINST        => '',
- PERL_SRC           => '',
- PERM_RW            => '',
- PERM_RWX           => '',
  PL_FILES           => 'hash',
  PM                 => 'hash',
  PMLIBDIRS          => 'array',
- PM_FILTER          => '',
- POLLUTE            => '',
- PPM_INSTALL_EXEC   => '',
- PPM_INSTALL_SCRIPT => '',
- PREFIX             => '',
- PREREQ_FATAL       => '',
  PREREQ_PM          => 'hash',
- PREREQ_PRINT       => '',
- PRINT_PREREQ       => '',
- SITEPREFIX         => '',
  SKIP               => 'array',
  TYPEMAPS           => 'array',
- VENDORPREFIX       => '',
- VERBINST           => '',
- VERSION            => '',
- VERSION_FROM       => '',
  XS                 => 'hash',
- XSOPT              => '',
- XSPROTOARG         => '',
- XS_VERSION         => '',
+ _KEEP_AFTER_FLUSH  => '',
 
  clean      => 'hash',
  depend     => 'hash',
@@ -167,11 +92,15 @@ my %Att_Sigs =
  dynamic_lib=> 'hash',
  linkext    => 'hash',
  macro      => 'hash',
+ postamble  => 'hash',
  realclean  => 'hash',
  test       => 'hash',
  tool_autosplit => 'hash',
 );
 
+@Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys;
+@Att_Sigs{keys %Special_Sigs} = values %Special_Sigs;
+
 
 sub _verify_att {
     my($att) = @_;
@@ -198,17 +127,24 @@ sub _verify_att {
 }
 
 sub prompt ($;$) {
-    my($mess,$def)=@_;
-    $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;   # Pipe?
+    my($mess, $def) = @_;
     Carp::confess("prompt function called without an argument") 
         unless defined $mess;
+
+    my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
+
     my $dispdef = defined $def ? "[$def] " : " ";
     $def = defined $def ? $def : "";
-    my $ans;
+
     local $|=1;
     local $\;
     print "$mess $dispdef";
-    if ($ISA_TTY && !$ENV{PERL_MM_USE_DEFAULT}) {
+
+    my $ans;
+    if ($ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
+        print "$def\n";
+    }
+    else {
         $ans = <STDIN>;
         if( defined $ans ) {
             chomp $ans;
@@ -217,9 +153,7 @@ sub prompt ($;$) {
             print "\n";
         }
     }
-    else {
-        print "$def\n";
-    }
+
     return (!defined $ans || $ans eq '') ? $def : $ans;
 }
 
@@ -256,22 +190,25 @@ sub eval_in_x {
     }
 }
 
+
+# package name for the classes into which the first object will be blessed
+my $PACKNAME = 'PACK000';
+
 sub full_setup {
     $Verbose ||= 0;
 
-    # package name for the classes into which the first object will be blessed
-    $PACKNAME = "PACK000";
-
     my @attrib_help = qw/
 
     AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION
     C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
-    EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE 
+    EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE
     FULLPERL FULLPERLRUN FULLPERLRUNINST
     FUNCLIST H IMPORTS
+
     INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR
     INSTALLDIRS
-    PREFIX          SITEPREFIX      VENDORPREFIX
+    DESTDIR PREFIX
+    PERLPREFIX      SITEPREFIX      VENDORPREFIX
     INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
     INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
     INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN
@@ -281,17 +218,18 @@ sub full_setup {
     INSTALLSCRIPT 
     PERL_LIB        PERL_ARCHLIB 
     SITELIBEXP      SITEARCHEXP 
+
     INC INCLUDE_EXT LDFROM LIB LIBPERL_A LIBS
-    LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
-    PERL_MALLOC_OK
-    NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC
-    PERLRUN PERLRUNINST PERL_CORE
+    LINKTYPE MAKEAPERL MAKEFILE MAKEFILE_OLD MAN1PODS MAN3PODS MAP_TARGET 
+    MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NORECURS NO_VC OBJECT OPTIMIZE 
+    PERL_MALLOC_OK PERL PERLMAINCC PERLRUN PERLRUNINST PERL_CORE
     PERL_SRC PERM_RW PERM_RWX
     PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
     PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
     SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
     XS_VERSION clean depend dist dynamic_lib linkext macro realclean
     tool_autosplit
+
     MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC
     MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED
         /;
@@ -310,16 +248,24 @@ sub full_setup {
     @MM_Sections = 
         qw(
 
- post_initialize const_config constants tool_autosplit tool_xsubpp
- tools_other dist macro depend cflags const_loadlibs const_cccmd
+ post_initialize const_config constants platform_constants 
+ tool_autosplit tool_xsubpp tools_other 
+
+ makemakerdflt
+
+ dist macro depend cflags const_loadlibs const_cccmd
  post_constants
 
  pasthru
 
- c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs
+ special_targets
+ c_o xs_c xs_o
+ top_targets linkext dlsyms dynamic dynamic_bs
  dynamic_lib static static_lib manifypods processPL
  installbin subdirs
- clean realclean dist_basics dist_core dist_dir dist_test dist_ci
+ clean_subdirs clean realclean_subdirs realclean 
+ metafile metafile_addtomanifest
+ dist_basics dist_core distdir dist_test dist_ci
  install force perldepend makefile staticmake test ppd
 
           ); # loses section ordering
@@ -352,6 +298,9 @@ sub full_setup {
            exe_ext full_ar
           );
 
+    # 5.5.3 doesn't have any concept of vendor libs
+    push @Get_from_Config, qw( vendorarchexp vendorlibexp ) if $] >= 5.006;
+
     foreach my $item (@attrib_help){
         $Recognized_Att_Keys{$item} = 1;
     }
@@ -371,11 +320,6 @@ sub full_setup {
            MAP_TARGET INST_MAN1DIR INST_MAN3DIR PERL_SRC
            PERL FULLPERL
     );
-
-    my @keep = qw/
-        NEEDS_LINKING HAS_LINK_CODE
-        /;
-    @Keep_after_flush{@keep} = (1) x @keep;
 }
 
 sub writeMakefile {
@@ -402,14 +346,21 @@ sub new {
     my($class,$self) = @_;
     my($key);
 
+    # Store the original args passed to WriteMakefile()
+    foreach my $k (keys %$self) {
+        $self->{ARGS}{$k} = $self->{$k};
+    }
+
     if ("@ARGV" =~ /\bPREREQ_PRINT\b/) {
         require Data::Dumper;
         print Data::Dumper->Dump([$self->{PREREQ_PM}], [qw(PREREQ_PM)]);
+        exit 0;
     }
 
     # PRINT_PREREQ is RedHatism.
     if ("@ARGV" =~ /\bPRINT_PREREQ\b/) {
-        print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " } sort keys %{$self->{PREREQ_PM}}), "\n";
+        print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " } 
+                        sort keys %{$self->{PREREQ_PM}}), "\n";
         exit 0;
    }
 
@@ -427,10 +378,15 @@ sub new {
 
     my(%unsatisfied) = ();
     foreach my $prereq (sort keys %{$self->{PREREQ_PM}}) {
-        eval "require $prereq";
+        # 5.8.0 has a bug with require Foo::Bar alone in an eval, so an
+        # extra statement is a workaround.
+        eval "require $prereq; 0";
 
         my $pr_version = $prereq->VERSION || 0;
 
+        # convert X.Y_Z alpha version #s to X.YZ for easier comparisons
+        $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/;
+
         if ($@) {
             warn sprintf "Warning: prerequisite %s %s not found.\n", 
               $prereq, $self->{PREREQ_PM}{$prereq} 
@@ -483,8 +439,14 @@ sub new {
         my $key;
         for $key (@Prepend_parent) {
             next unless defined $self->{PARENT}{$key};
+
+            # Don't stomp on WriteMakefile() args.
+            next if defined $self->{ARGS}{$key} and
+                    $self->{ARGS}{$key} eq $self->{$key};
+
             $self->{$key} = $self->{PARENT}{$key};
-            unless ($^O eq 'VMS' && $key =~ /PERL$/) {
+
+            unless ($Is_VMS && $key =~ /PERL$/) {
                 $self->{$key} = $self->catdir("..",$self->{$key})
                   unless $self->file_name_is_absolute($self->{$key});
             } else {
@@ -520,7 +482,17 @@ sub new {
 
     ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
 
-    $self->init_main();
+    $self->init_main;
+    $self->init_VERSION;
+    $self->init_dist;
+    $self->init_INST;
+    $self->init_INSTALL;
+    $self->init_DEST;
+    $self->init_dirscan;
+    $self->init_xs;
+    $self->init_PERL;
+    $self->init_DIRFILESEP;
+    $self->init_linker;
 
     if (! $self->{PERL_SRC} ) {
         require VMS::Filespec if $Is_VMS;
@@ -547,8 +519,8 @@ END
         }
     }
 
-    $self->init_dirscan();
     $self->init_others();
+    $self->init_platform();
     $self->init_PERM();
     my($argv) = neatvalue(\@ARGV);
     $argv =~ s/^\[/(/;
@@ -569,6 +541,8 @@ END
 END
 
     foreach my $key (sort keys %initial_att){
+        next if $key eq 'ARGS';
+
         my($v) = neatvalue($initial_att{$key});
         $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
         $v =~ tr/\n/ /s;
@@ -583,6 +557,7 @@ END
 END
         if (scalar(keys %configure_att) > 0) {
             foreach my $key (sort keys %configure_att){
+               next if $key eq 'ARGS';
                my($v) = neatvalue($configure_att{$key});
                $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
                $v =~ tr/\n/ /s;
@@ -604,7 +579,7 @@ END
     delete $self->{SKIP}; # free memory
 
     if ($self->{PARENT}) {
-        for (qw/install dist dist_basics dist_core dist_dir dist_test dist_ci/) {
+        for (qw/install dist dist_basics dist_core distdir dist_test dist_ci/) {
             $self->{SKIPHASH}{$_} = 1;
         }
     }
@@ -616,6 +591,10 @@ END
     }
 
     foreach my $section ( @MM_Sections ){
+        # Support for new foo_target() methods.
+        my $method = $section;
+        $method .= '_target' unless $self->can($method);
+
         print "Processing Makefile '$section' section\n" if ($Verbose >= 2);
         my($skipit) = $self->skipcheck($section);
         if ($skipit){
@@ -624,7 +603,7 @@ END
             my(%a) = %{$self->{$section} || {}};
             push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:";
             push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a;
-            push @{$self->{RESULT}}, $self->nicetext($self->$section( %a ));
+            push @{$self->{RESULT}}, $self->nicetext($self->$method( %a ));
         }
     }
 
@@ -638,13 +617,14 @@ sub WriteEmptyMakefile {
 
     my %att = @_;
     my $self = MM->new(\%att);
-    if (-f "$self->{MAKEFILE}.old") {
-      chmod 0666, "$self->{MAKEFILE}.old";
-      unlink "$self->{MAKEFILE}.old" or warn "unlink $self->{MAKEFILE}.old: $!";
+    if (-f $self->{MAKEFILE_OLD}) {
+      _unlink($self->{MAKEFILE_OLD}) or 
+        warn "unlink $self->{MAKEFILE_OLD}: $!";
+    }
+    if ( -f $self->{MAKEFILE} ) {
+        _rename($self->{MAKEFILE}, $self->{MAKEFILE_OLD}) or
+          warn "rename $self->{MAKEFILE} => $self->{MAKEFILE_OLD}: $!"
     }
-    rename $self->{MAKEFILE}, "$self->{MAKEFILE}.old"
-      or warn "rename $self->{MAKEFILE} $self->{MAKEFILE}.old: $!"
-        if -f $self->{MAKEFILE};
     open MF, '>'.$self->{MAKEFILE} or die "open $self->{MAKEFILE} for write: $!";
     print MF <<'EOP';
 all:
@@ -681,7 +661,6 @@ sub parse_args{
     my($self, @args) = @_;
     foreach (@args) {
         unless (m/(.*?)=(.*)/) {
-            help(),exit 1 if m/^help$/;
             ++$Verbose if m/^verb/;
             next;
         }
@@ -693,7 +672,9 @@ sub parse_args{
                  (getpwuid($>))[7]
                  ]ex;
         }
-        $self->{uc($name)} = $value;
+
+        # Remember the original args passed it.  It will be useful later.
+        $self->{ARGS}{uc $name} = $self->{uc $name} = $value;
     }
 
     # catch old-style 'potential_libs' and inform user how to 'upgrade'
@@ -738,6 +719,7 @@ sub parse_args{
     }
 
     foreach my $mmkey (sort keys %$self){
+        next if $mmkey eq 'ARGS';
         print STDOUT "  $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose;
         print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n"
             unless exists $Recognized_Att_Keys{$mmkey};
@@ -749,7 +731,11 @@ sub check_hints {
     my($self) = @_;
     # We allow extension-specific hints files.
 
-    return unless -d "hints";
+    require File::Spec;
+    my $curdir = File::Spec->curdir;
+
+    my $hint_dir = File::Spec->catdir($curdir, "hints");
+    return unless -d $hint_dir;
 
     # First we look for the best hintsfile we have
     my($hint)="${^O}_$Config{osvers}";
@@ -759,11 +745,11 @@ sub check_hints {
 
     # Also try without trailing minor version numbers.
     while (1) {
-        last if -f "hints/$hint.pl";      # found
+        last if -f File::Spec->catfile($hint_dir, "$hint.pl");  # found
     } continue {
         last unless $hint =~ s/_[^_]*$//; # nothing to cut off
     }
-    my $hint_file = "hints/$hint.pl";
+    my $hint_file = File::Spec->catfile($hint_dir, "$hint.pl");
 
     return unless -f $hint_file;    # really there
 
@@ -775,11 +761,16 @@ sub _run_hintfile {
     local($self) = shift;       # make $self available to the hint file.
     my($hint_file) = shift;
 
-    local $@;
+    local($@, $!);
     print STDERR "Processing hints file $hint_file\n";
-    my $ret = do "./$hint_file";
-    unless( defined $ret ) {
-        print STDERR $@ if $@;
+
+    # Just in case the ./ isn't on the hint file, which File::Spec can
+    # often strip off, we bung the curdir into @INC
+    local @INC = (File::Spec->curdir, @INC);
+    my $ret = do $hint_file;
+    if( !defined $ret ) {
+        my $error = $@ || $!;
+        print STDERR $error;
     }
 }
 
@@ -883,18 +874,38 @@ sub flush {
 
     close FH;
     my($finalname) = $self->{MAKEFILE};
-    rename("MakeMaker.tmp", $finalname);
+    _rename("MakeMaker.tmp", $finalname) or
+      warn "rename MakeMaker.tmp => $finalname: $!";
     chmod 0644, $finalname unless $Is_VMS;
 
+    my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE);
+
     if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) {
         foreach (keys %$self) { # safe memory
-            delete $self->{$_} unless $Keep_after_flush{$_};
+            delete $self->{$_} unless $keep{$_};
         }
     }
 
     system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":";
 }
 
+
+# This is a rename for OS's where the target must be unlinked first.
+sub _rename {
+    my($src, $dest) = @_;
+    chmod 0666, $dest;
+    unlink $dest;
+    return rename $src, $dest;
+}
+
+# This is an unlink for OS's where the target must be writable first.
+sub _unlink {
+    my @files = @_;
+    chmod 0666, @files;
+    return unlink @files;
+}
+
+
 # The following mkbootstrap() is only for installations that are calling
 # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker
 # writes Makefiles, that use ExtUtils::Mkbootstrap directly.
@@ -961,7 +972,7 @@ __END__
 
 =head1 NAME
 
-ExtUtils::MakeMaker - create an extension Makefile
+ExtUtils::MakeMaker - Create a module Makefile
 
 =head1 SYNOPSIS
 
@@ -986,24 +997,7 @@ Makefiles with a single invocation of WriteMakefile().
 
 =head2 How To Write A Makefile.PL
 
-The short answer is: Don't.
-
-        Always begin with h2xs.
-        Always begin with h2xs!
-        ALWAYS BEGIN WITH H2XS!
-
-even if you're not building around a header file, and even if you
-don't have an XS component.
-
-Run h2xs(1) before you start thinking about writing a module. For so
-called pm-only modules that consist of C<*.pm> files only, h2xs has
-the C<-X> switch. This will generate dummy files of all kinds that are
-useful for the module developer.
-
-The medium answer is:
-
-    use ExtUtils::MakeMaker;
-    WriteMakefile( NAME => "Foo::Bar" );
+See ExtUtils::MakeMaker::Tutorial.
 
 The long answer is the rest of the manpage :-)
 
@@ -1077,7 +1071,7 @@ INSTALLDIRS according to the following table:
                                  INSTALLDIRS set to
                            perl        site          vendor
 
-                 PREFIX          SITEPREFIX          VENDORPREFIX
+                 PERLPREFIX      SITEPREFIX          VENDORPREFIX
   INST_ARCHLIB   INSTALLARCHLIB  INSTALLSITEARCH     INSTALLVENDORARCH
   INST_LIB       INSTALLPRIVLIB  INSTALLSITELIB      INSTALLVENDORLIB
   INST_BIN       INSTALLBIN      INSTALLSITEBIN      INSTALLVENDORBIN
@@ -1357,6 +1351,18 @@ be determined by some evaluation method.
 
 Something like C<"-DHAVE_UNISTD_H">
 
+=item DESTDIR
+
+This is the root directory into which the code will be installed.  It
+I<prepends itself to the normal prefix>.  For example, if your code
+would normally go into /usr/local/lib/perl you could set DESTDIR=/tmp/
+and installation would go into /tmp/usr/local/lib/perl.
+
+This is primarily of use for people who repackage Perl modules.
+
+NOTE: Due to the nature of make, it is important that you put the trailing
+slash on your DESTDIR.  "/tmp/" not "/tmp".
+
 =item DIR
 
 Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm'
@@ -1364,8 +1370,24 @@ Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm'
 
 =item DISTNAME
 
-Your name for distributing the package (by tar file). This defaults to
-NAME above.
+A safe filename for the package. 
+
+Defaults to NAME above but with :: replaced with -.
+
+For example, Foo::Bar becomes Foo-Bar.
+
+=item DISTVNAME
+
+Your name for distributing the package with the version number
+included.  This is used by 'make dist' to name the resulting archive
+file.
+
+Defaults to DISTNAME-VERSION.
+
+For example, version 1.04 of Foo::Bar becomes Foo-Bar-1.04.
+
+On some OS's where . has special meaning VERSION_SYM may be used in
+place of VERSION.
 
 =item DL_FUNCS
 
@@ -1407,11 +1429,20 @@ Ref to array of executable files. The files will be copied to the
 INST_SCRIPT directory. Make realclean will delete them from there
 again.
 
+If your executables start with something like #!perl or
+#!/usr/bin/perl MakeMaker will change this to the path of the perl
+'Makefile.PL' was invoked with so the programs will be sure to run
+properly even if perl is not in /usr/bin/perl.
+
 =item FIRST_MAKEFILE
 
-The name of the Makefile to be produced. Defaults to the contents of
-MAKEFILE, but can be overridden. This is used for the second Makefile
-that will be produced for the MAP_TARGET.
+The name of the Makefile to be produced.  This is used for the second
+Makefile that will be produced for the MAP_TARGET.
+
+Defaults to 'Makefile' or 'Descrip.MMS' on VMS.
+
+(Note: we couldn't use MAKEFILE because dmake uses this for something
+else).
 
 =item FULLPERL
 
@@ -1576,6 +1607,12 @@ Directory, where executable files should be installed during
 testing. make install will copy the files in INST_SCRIPT to
 INSTALLSCRIPT.
 
+=item LD
+
+Program to be used to link libraries for dynamic loading.
+
+Defaults to $Config{ld}.
+
 =item LDDLFLAGS
 
 Any special flags that might need to be passed to ld to create a
@@ -1636,9 +1673,12 @@ Boolean which tells MakeMaker, that it should include the rules to
 make a perl. This is handled automatically as a switch by
 MakeMaker. The user normally does not need it.
 
-=item MAKEFILE
+=item MAKEFILE_OLD
+
+When 'make clean' or similar is run, the $(FIRST_MAKEFILE) will be
+backed up at this location.
 
-The name of the Makefile to be produced.
+Defaults to $(FIRST_MAKEFILE).old or $(FIRST_MAKEFILE)_old on VMS.
 
 =item MAN1PODS
 
@@ -1680,14 +1720,24 @@ this boolean variable yourself.
 
 =item NOECHO
 
-Defaults to C<@>. By setting it to an empty string you can generate a
-Makefile that echos all commands. Mainly used in debugging MakeMaker
-itself.
+Command so make does not print the literal commands its running.
+
+By setting it to an empty string you can generate a Makefile that
+prints all commands. Mainly used in debugging MakeMaker itself.
+
+Defaults to C<@>.
 
 =item NORECURS
 
 Boolean.  Attribute to inhibit descending into subdirectories.
 
+=item NO_META
+
+When true, suppresses the generation and addition to the MANIFEST of
+the META.yml module meta-data file during 'make distdir'.
+
+Defaults to false.
+
 =item NO_VC
 
 In general, any generated Makefile checks for the current version of
@@ -1766,6 +1816,16 @@ nullifies many advantages of Perl's malloc(), such as better usage of
 system resources, error detection, memory usage reporting, catchable failure
 of memory allocations, etc.
 
+=item PERLPREFIX
+
+Directory under which core modules are to be installed.
+
+Defaults to $Config{installprefixexp} falling back to
+$Config{installprefix}, $Config{prefixexp} or $Config{prefix} should
+$Config{installprefixexp} not exist.
+
+Overridden by PREFIX.
+
 =item PERLRUN
 
 Use this instead of $(PERL) when you wish to run perl.  It will set up
@@ -1882,8 +1942,6 @@ which should be sensible for your platform.
 If you specify LIB or any INSTALL* variables they will not be effected
 by the PREFIX.
 
-Defaults to $Config{installprefixexp}.
-
 =item PREREQ_FATAL
 
 Bool. If this parameter is true, failing to have the required modules
@@ -1908,7 +1966,8 @@ only check if any version is installed already.
 =item PREREQ_PRINT
 
 Bool.  If this parameter is true, the prerequisites will be printed to
-stdout and MakeMaker will exit.  The output format is
+stdout and MakeMaker will exit.  The output format is an evalable hash
+ref.
 
 $PREREQ_PM = {
                'A::B' => Vers1,
@@ -1924,11 +1983,13 @@ RedHatism for C<PREREQ_PRINT>.  The output format is different, though:
 
 =item SITEPREFIX
 
-Like PREFIX, but only for the site install locations.
+Like PERLPREFIX, but only for the site install locations.
+
+Defaults to $Config{siteprefixexp}.  Perls prior to 5.6.0 didn't have
+an explicit siteprefix in the Config.  In those cases
+$Config{installprefix} will be used.
 
-Defaults to PREFIX (if set) or $Config{siteprefixexp}.  Perls prior to
-5.6.0 didn't have an explicit siteprefix in the Config.  In those
-cases $Config{installprefix} will be used.
+Overridable by PREFIX
 
 =item SKIP
 
@@ -1948,9 +2009,11 @@ typemap has lowest precedence.
 
 =item VENDORPREFIX
 
-Like PREFIX, but only for the vendor install locations.
+Like PERLPREFIX, but only for the vendor install locations.
+
+Defaults to $Config{vendorprefixexp}.
 
-Defaults to PREFIX (if set) or $Config{vendorprefixexp}
+Overridable by PREFIX
 
 =item VERBINST
 
@@ -1977,7 +2040,7 @@ MakeMaker object. The following lines will be parsed o.k.:
 
     $VERSION = '1.00';
     *VERSION = \'1.01';
-    ( $VERSION ) = '$Revision: 1.6 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    $VERSION = sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)/g;
     $FOO::VERSION = '1.10';
     *FOO::VERSION = \'1.11';
     our $VERSION = 1.2.3;       # new for perl5.6.0 
@@ -2001,6 +2064,11 @@ would have to do something like
 
 See attribute C<depend> below.
 
+=item VERSION_SYM
+
+A sanitized VERSION with . replaced by _.  For places where . has
+special meaning (some filesystems, RCS labels, etc...)
+
 =item XS
 
 Hashref of .xs files. MakeMaker will default this.  e.g.
@@ -2032,7 +2100,8 @@ to the value of the VERSION attribute.
 =head2 Additional lowercase attributes
 
 can be used to pass parameters to the methods which implement that
-part of the Makefile.
+part of the Makefile.  Parameters are specified as a hash ref but are
+passed to the method as a hash.
 
 =over 2
 
@@ -2079,6 +2148,10 @@ be linked.
 
   {ANY_MACRO => ANY_VALUE, ...}
 
+=item postamble
+
+Anything put here will be passed to MY::postamble() if you have one.
+
 =item realclean
 
   {FILES => '$(INST_ARCHAUTODIR)/*.xyz'}
@@ -2212,6 +2285,10 @@ Copies all the files that are in the MANIFEST file to a newly created
 directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory
 exists, it will be removed first.
 
+Additionally, it will create a META.yml module meta-data file and add
+this to your MANFIEST.  You can shut this behavior off with the NO_META
+flag.
+
 =item   make disttest
 
 Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
@@ -2276,6 +2353,28 @@ An example:
 
     WriteMakefile( 'dist' => { COMPRESS=>"bzip2", SUFFIX=>".bz2" })
 
+
+=head2 Module Meta-Data
+
+Long plaguing users of MakeMaker based modules has been the problem of
+getting basic information about the module out of the sources
+I<without> running the F<Makefile.PL> and doing a bunch of messy
+heuristics on the resulting F<Makefile>.  To this end a simple module
+meta-data file has been introduced, F<META.yml>.
+
+F<META.yml> is a YAML document (see http://www.yaml.org) containing
+basic information about the module (name, version, prerequisites...)
+in an easy to read format.  The format is developed and defined by the
+Module::Build developers (see 
+http://module-build.sourceforge.net/META-spec.html)
+
+MakeMaker will automatically generate a F<META.yml> file for you and
+add it to your F<MANIFEST> as part of the 'distdir' target (and thus
+the 'dist' target).  This is intended to seamlessly and rapidly
+populate CPAN with module meta-data.  If you wish to shut this feature
+off, set the C<NO_META> C<WriteMakefile()> flag to true.
+
+
 =head2 Disabling an extension
 
 If some events detected in F<Makefile.PL> imply that there is no way
@@ -2293,9 +2392,33 @@ in a subdirectory of some other distribution, or is listed as a
 dependency in a CPAN::Bundle, but the functionality is supported by
 different means on the current architecture).
 
+=head2 Other Handy Functions
+
+=over 4
+
+=item prompt
+
+    my $value = prompt($message);
+    my $value = prompt($message, $default);
+
+The C<prompt()> function provides an easy way to request user input
+used to write a makefile.  It displays the $message as a prompt for
+input.  If a $default is provided it will be used as a default.  The
+function returns the $value selected by the user.
+
+If C<prompt()> detects that it is not running interactively and there
+is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
+is set to true, the $default will be used without prompting.  This
+prevents automated processes from blocking on user input. 
+
+If no $default is provided an empty string will be used instead.
+
+=back
+
+
 =head1 ENVIRONMENT
 
-=over 8
+=over 4
 
 =item PERL_MM_OPT
 
@@ -2331,4 +2454,12 @@ generated Makefile along with your report.
 
 For more up-to-date information, see http://www.makemaker.org.
 
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+
 =cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod
index df4313dfce5..df109192a1f 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod
@@ -1,6 +1,6 @@
 package ExtUtils::MakeMaker::FAQ;
 
-(our $VERSION) = sprintf "%03d", q$Revision: 1.1 $ =~ /Revision:\s+(\S+)/;
+(our $VERSION) = sprintf "%03d", q$Revision: 1.2 $ =~ /Revision:\s+(\S+)/;
 
 1;
 __END__
@@ -75,7 +75,7 @@ system's revision number (you are using version control, right?).
 
 In CVS and RCS you use $Z<>Revision$ writing it like so:
 
-    $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g;
+    $VERSION = sprintf "%d.%03d", q$Revision: 1.2 $ =~ /(\d+)/g;
 
 Every time the file is checked in the $Z<>Revision$ will be updated,
 updating your $VERSION.
@@ -88,7 +88,7 @@ If branches are involved (ie. $Z<>Revision: 1.5.3.4) its a little more
 complicated.
 
     # must be all on one line or MakeMaker will get confused.
-    $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
+    $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
 
 =item What's this F<META.yml> thing and how did it get in my F<MANIFEST>?!
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
index 7ca5bdd3726..f6dea291d91 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
@@ -12,23 +12,83 @@ use vars qw($VERSION @ISA @EXPORT_OK
           $Is_MacOS $Is_VMS 
           $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
 
-$VERSION = 1.38;
+$VERSION = 1.42;
 @ISA=('Exporter');
-@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
-	      'skipcheck', 'maniread', 'manicopy');
+@EXPORT_OK = qw(mkmanifest
+                manicheck  filecheck  fullcheck  skipcheck
+                manifind   maniread   manicopy   maniadd
+               );
 
 $Is_MacOS = $^O eq 'MacOS';
-$Is_VMS = $^O eq 'VMS';
+$Is_VMS   = $^O eq 'VMS';
 require VMS::Filespec if $Is_VMS;
 
-$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
+$Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
 $Quiet = 0;
 $MANIFEST = 'MANIFEST';
-$DEFAULT_MSKIP = (File::Spec->splitpath($INC{"ExtUtils/Manifest.pm"}))[1].
+
+my $Filename = __FILE__;
+$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
                  "$MANIFEST.SKIP";
 
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+    use ExtUtils::Manifest qw(...funcs to import...);
+
+    mkmanifest();
+
+    my @missing_files    = manicheck;
+    my @skipped          = skipcheck;
+    my @extra_files      = filecheck;
+    my($missing, $extra) = fullcheck;
+
+    my $found    = manifind();
+
+    my $manifest = maniread();
+
+    manicopy($read,$target);
+
+    maniadd({$file => $comment, ...});
+
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+ExtUtils::Manifest exports no functions by default.  The following are
+exported on request
+
+=over 4
+
+=item mkmanifest
+
+    mkmanifest();
+
+Writes all files in and below the current directory to your F<MANIFEST>.
+It works similar to
+
+    find . > MANIFEST
+
+All files that match any regular expression in a file F<MANIFEST.SKIP>
+(if it exists) are ignored.
+
+Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.  Lines
+from the old F<MANIFEST> file is preserved, including any comments
+that are found in the existing F<MANIFEST> file in the new one.
+
+=cut
+
+sub _sort {
+    return sort { lc $a cmp lc $b } @_;
+}
+
 sub mkmanifest {
     my $manimiss = 0;
     my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
@@ -42,7 +102,7 @@ sub mkmanifest {
     %all = (%$found, %$read);
     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
         if $manimiss; # add new MANIFEST to known file list
-    foreach $file (sort keys %all) {
+    foreach $file (_sort keys %all) {
 	if ($skip->($file)) {
 	    # Policy: only remove files if they're listed in MANIFEST.SKIP.
 	    # Don't remove files just because they don't exist.
@@ -72,6 +132,16 @@ sub clean_up_filename {
   return $filename;
 }
 
+
+=item manifind
+
+    my $found = manifind();
+
+returns a hash reference. The keys of the hash are the files found
+below the current directory.
+
+=cut
+
 sub manifind {
     my $p = shift || {};
     my $found = {};
@@ -98,25 +168,73 @@ sub manifind {
     return $found;
 }
 
-sub fullcheck {
-    return [_check_files()], [_check_manifest()];
-}
+
+=item manicheck
+
+    my @missing_files = manicheck();
+
+checks if all the files within a C<MANIFEST> in the current directory
+really do exist. If C<MANIFEST> and the tree below the current
+directory are in sync it silently returns an empty list.
+Otherwise it returns a list of files which are listed in the
+C<MANIFEST> but missing from the directory, and by default also
+outputs these names to STDERR.
+
+=cut
 
 sub manicheck {
     return _check_files();
 }
 
+
+=item filecheck
+
+    my @extra_files = filecheck();
+
+finds files below the current directory that are not mentioned in the
+C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
+consulted. Any file matching a regular expression in such a file will
+not be reported as missing in the C<MANIFEST> file. The list of any
+extraneous files found is returned, and by default also reported to
+STDERR.
+
+=cut
+
 sub filecheck {
     return _check_manifest();
 }
 
+
+=item fullcheck
+
+    my($missing, $extra) = fullcheck();
+
+does both a manicheck() and a filecheck(), returning then as two array
+refs.
+
+=cut
+
+sub fullcheck {
+    return [_check_files()], [_check_manifest()];
+}
+
+
+=item skipcheck
+
+    my @skipped = skipcheck();
+
+lists all the files that are skipped due to your C<MANIFEST.SKIP>
+file.
+
+=cut
+
 sub skipcheck {
     my($p) = @_;
     my $found = manifind();
     my $matches = _maniskip();
 
     my @skipped = ();
-    foreach my $file (sort keys %$found){
+    foreach my $file (_sort keys %$found){
         if (&$matches($file)){
             warn "Skipping $file\n";
             push @skipped, $file;
@@ -135,7 +253,7 @@ sub _check_files {
     my $found = manifind($p);
 
     my(@missfile) = ();
-    foreach my $file (sort keys %$read){
+    foreach my $file (_sort keys %$read){
         warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
         if ($dosnames){
             $file = lc $file;
@@ -159,7 +277,7 @@ sub _check_manifest {
     my $skip  = _maniskip();
 
     my @missentry = ();
-    foreach my $file (sort keys %$found){
+    foreach my $file (_sort keys %$found){
         next if $skip->($file);
         warn "Debug: manicheck checking from disk $file\n" if $Debug;
         unless ( exists $read->{$file} ) {
@@ -173,38 +291,51 @@ sub _check_manifest {
 }
 
 
+=item maniread
+
+    my $manifest = maniread();
+    my $manifest = maniread($manifest_file);
+
+reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
+directory) and returns a HASH reference with files being the keys and
+comments being the values of the HASH.  Blank lines and lines which
+start with C<#> in the C<MANIFEST> file are discarded.
+
+=cut
+
 sub maniread {
     my ($mfile) = @_;
     $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
-	warn "$mfile: $!";
-	return $read;
+        warn "$mfile: $!";
+        return $read;
     }
+    local $_;
     while (<M>){
-	chomp;
-	next if /^#/;
+        chomp;
+        next if /^\s*#/;
 
         my($file, $comment) = /^(\S+)\s*(.*)/;
         next unless $file;
 
-	if ($Is_MacOS) {
-	    $file = _macify($file);
-	    $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
-	}
-	elsif ($Is_VMS) {
-        require File::Basename;
-	    my($base,$dir) = File::Basename::fileparse($file);
-	    # Resolve illegal file specifications in the same way as tar
-	    $dir =~ tr/./_/;
-	    my(@pieces) = split(/\./,$base);
-	    if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
-	    my $okfile = "$dir$base";
-	    warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+        if ($Is_MacOS) {
+            $file = _macify($file);
+            $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
+        }
+        elsif ($Is_VMS) {
+            require File::Basename;
+            my($base,$dir) = File::Basename::fileparse($file);
+            # Resolve illegal file specifications in the same way as tar
+            $dir =~ tr/./_/;
+            my(@pieces) = split(/\./,$base);
+            if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
+            my $okfile = "$dir$base";
+            warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
             $file = $okfile;
             $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
-	}
+        }
 
         $read->{$file} = $comment;
     }
@@ -216,7 +347,7 @@ sub maniread {
 sub _maniskip {
     my @skip ;
     my $mfile = "$MANIFEST.SKIP";
-    local *M;
+    local(*M,$_);
     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
     while (<M>){
 	chomp;
@@ -234,6 +365,23 @@ sub _maniskip {
     return sub { $_[0] =~ qr{$opts$regex} };
 }
 
+=item manicopy
+
+    manicopy($src, $dest_dir);
+    manicopy($src, $dest_dir, $how);
+
+copies the files that are the keys in the HASH I<%$src> to the
+$dest_dir. The HASH reference $read is typically returned by the
+maniread() function. This function is useful for producing a directory
+tree identical to the intended distribution tree. The third parameter
+$how can be used to specify a different methods of "copying". Valid
+values are C<cp>, which actually copies the files, C<ln> which creates
+hard links, and C<best> which mostly links the files but copies any
+symbolic link to make a tree without any symbolic link. Best is the
+default.
+
+=cut
+
 sub manicopy {
     my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
@@ -270,6 +418,7 @@ sub cp_if_diff {
     local(*F,*T);
     open(F,"< $from\0") or die "Can't read $from: $!\n";
     if (open(T,"< $to\0")) {
+        local $_;
 	while (<F>) { $diff++,last if $_ ne <T>; }
 	$diff++ unless eof(T);
 	close T;
@@ -372,90 +521,75 @@ sub _unmacify {
     $file;
 }
 
-1;
 
-__END__
+=item maniadd
 
-=head1 NAME
+  maniadd({ $file => $comment, ...});
 
-ExtUtils::Manifest - utilities to write and check a MANIFEST file
+Adds an entry to an existing F<MANIFEST> unless its already there.
 
-=head1 SYNOPSIS
+$file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
 
-    require ExtUtils::Manifest;
+=cut
 
-    ExtUtils::Manifest::mkmanifest;
+sub maniadd {
+    my($additions) = shift;
 
-    ExtUtils::Manifest::manicheck;
+    _normalize($additions);
+    _fix_manifest($MANIFEST);
 
-    ExtUtils::Manifest::filecheck;
+    my $manifest = maniread();
+    my @needed = grep { !exists $manifest->{$_} } keys %$additions;
+    return 1 unless @needed;
 
-    ExtUtils::Manifest::fullcheck;
+    open(MANIFEST, ">>$MANIFEST") or 
+      die "maniadd() could not open $MANIFEST: $!";
 
-    ExtUtils::Manifest::skipcheck;
+    foreach my $file (_sort @needed) {
+        my $comment = $additions->{$file} || '';
+        printf MANIFEST "%-40s %s\n", $file, $comment;
+    }
+    close MANIFEST or die "Error closing $MANIFEST: $!";
 
-    ExtUtils::Manifest::manifind();
+    return 1;
+}
 
-    ExtUtils::Manifest::maniread($file);
 
-    ExtUtils::Manifest::manicopy($read,$target,$how);
+# Sometimes MANIFESTs are missing a trailing newline.  Fix this.
+sub _fix_manifest {
+    my $manifest_file = shift;
 
-=head1 DESCRIPTION
+    open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
 
-mkmanifest() writes all files in and below the current directory to a
-file named in the global variable $ExtUtils::Manifest::MANIFEST (which
-defaults to C<MANIFEST>) in the current directory. It works similar to
-
-    find . -print
-
-but in doing so checks each line in an existing C<MANIFEST> file and
-includes any comments that are found in the existing C<MANIFEST> file
-in the new one. Anything between white space and an end of line within
-a C<MANIFEST> file is considered to be a comment. Filenames and
-comments are separated by one or more TAB characters in the
-output. All files that match any regular expression in a file
-C<MANIFEST.SKIP> (if such a file exists) are ignored.
-
-manicheck() checks if all the files within a C<MANIFEST> in the current
-directory really do exist. If C<MANIFEST> and the tree below the current
-directory are in sync it exits silently, returning an empty list.  Otherwise
-it returns a list of files which are listed in the C<MANIFEST> but missing
-from the directory, and by default also outputs these names to STDERR.
-
-filecheck() finds files below the current directory that are not
-mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
-will be consulted. Any file matching a regular expression in such a
-file will not be reported as missing in the C<MANIFEST> file. The list of
-any extraneous files found is returned, and by default also reported to
-STDERR.
+    # Yes, we should be using seek(), but I'd like to avoid loading POSIX
+    # to get SEEK_*
+    my @manifest = <MANIFEST>;
+    close MANIFEST;
 
-fullcheck() does both a manicheck() and a filecheck(), returning references
-to two arrays, the first for files manicheck() found to be missing, the
-seond for unexpeced files found by filecheck().
+    unless( $manifest[-1] =~ /\n\z/ ) {
+        open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
+        print MANIFEST "\n";
+        close MANIFEST;
+    }
+}
+        
 
-skipcheck() lists all the files that are skipped due to your
-C<MANIFEST.SKIP> file.
+# UNIMPLEMENTED
+sub _normalize {
+    return;
+}
+
+
+=back
 
-manifind() returns a hash reference. The keys of the hash are the
-files found below the current directory.
+=head2 MANIFEST
 
-maniread($file) reads a named C<MANIFEST> file (defaults to
-C<MANIFEST> in the current directory) and returns a HASH reference
-with files being the keys and comments being the values of the HASH.
-Blank lines and lines which start with C<#> in the C<MANIFEST> file
-are discarded.
+Anything between white space and an end of line within a C<MANIFEST>
+file is considered to be a comment.  Filenames and comments are
+separated by one or more TAB characters in the output. 
 
-C<manicopy($read,$target,$how)> copies the files that are the keys in
-the HASH I<%$read> to the named target directory. The HASH reference
-$read is typically returned by the maniread() function. This
-function is useful for producing a directory tree identical to the
-intended distribution tree. The third parameter $how can be used to
-specify a different methods of "copying". Valid values are C<cp>,
-which actually copies the files, C<ln> which creates hard links, and
-C<best> which mostly links the files but copies any symbolic link to
-make a tree without any symbolic link. Best is the default.
 
-=head1 MANIFEST.SKIP
+=head2 MANIFEST.SKIP
 
 The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
@@ -467,6 +601,7 @@ expression to start with a sharp character. A typical example:
     \bRCS\b
     \bCVS\b
     ,v$
+    \B\.svn\b
 
     # Makemaker generated files and dirs.
     ^MANIFEST\.
@@ -485,12 +620,12 @@ used, similar to the example above.  If you want nothing skipped,
 simply make an empty MANIFEST.SKIP file.
 
 
-=head1 EXPORT_OK
+=head2 EXPORT_OK
 
 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 C<&maniread>, and C<&manicopy> are exportable.
 
-=head1 GLOBAL VARIABLES
+=head2 GLOBAL VARIABLES
 
 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 results in both a different C<MANIFEST> and a different
@@ -554,3 +689,5 @@ L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 Andreas Koenig <F<andreas.koenig@anima.de>>
 
 =cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/typemap b/gnu/usr.bin/perl/lib/ExtUtils/typemap
index 1124eb64838..2a53b62abf8 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/typemap
+++ b/gnu/usr.bin/perl/lib/ExtUtils/typemap
@@ -14,6 +14,7 @@ const char *		T_PV
 caddr_t			T_PV
 wchar_t *		T_PV
 wchar_t			T_IV
+# bool_t is defined in <rpc/rpc.h>
 bool_t			T_IV
 size_t			T_UV
 ssize_t			T_IV
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
index b5dfa610c02..7ae8020e25b 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
+++ b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
@@ -137,6 +137,7 @@ $ProtoUsed = 0 ;
 $WantLineNumbers = 1 ;
 $WantOptimize = 1 ;
 $Overload = 0;
+$Fallback = 'PL_sv_undef';
 
 my $process_inout = 1;
 my $process_argtypes = 1;
@@ -293,7 +294,7 @@ $END = "!End!\n\n";		# "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
 	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
 	CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD
+	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
 	)) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -617,6 +618,24 @@ sub OVERLOAD_handler()
 
 }
 
+sub FALLBACK_handler()
+{
+    # the rest of the current line should contain either TRUE, 
+    # FALSE or UNDEF
+
+    TrimWhitespace($_) ;
+    my %map = (
+	TRUE => "PL_sv_yes", 1 => "PL_sv_yes",
+	FALSE => "PL_sv_no", 0 => "PL_sv_no",
+	UNDEF => "PL_sv_undef",
+    ) ;
+
+    # check for valid FALLBACK value
+    death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_} ;
+
+    $Fallback = $map{uc $_} ;
+}
+
 sub REQUIRE_handler ()
 {
     # the rest of the current line should contain a version number
@@ -888,7 +907,19 @@ while (<$FH>) {
         my $podstartline = $.;
     	do {
 	    if (/^=cut\s*$/) {
-		print("/* Skipped embedded POD. */\n");
+		# We can't just write out a /* */ comment, as our embedded
+		# POD might itself be in a comment. We can't put a /**/
+		# comment inside #if 0, as the C standard says that the source
+		# file is decomposed into preprocessing characters in the stage
+		# before preprocessing commands are executed.
+		# I don't want to leave the text as barewords, because the spec
+		# isn't clear whether macros are expanded before or after
+		# preprocessing commands are executed, and someone pathological
+		# may just have defined one of the 3 words as a macro that does
+		# something strange. Multiline strings are illegal in C, so
+		# the "" we write must be a string literal. And they aren't
+		# concatenated until 2 steps later, so we are safe.
+		print("#if 0\n  \"Skipped embedded POD.\"\n#endif\n");
 		printf("#line %d \"$filename\"\n", $. + 1)
 		  if $WantLineNumbers;
 		next firstmodule
@@ -1053,7 +1084,7 @@ while (fetch_para()) {
     $xsreturn = 0;
 
     $_ = shift(@line);
-    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
+    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE")) {
         &{"${kwd}_handler"}() ;
         next PARAGRAPH unless @line ;
         $_ = shift(@line);
@@ -1422,7 +1453,11 @@ EOF
 	$xsreturn = 1 if $ret_type ne "void";
 	my $num = $xsreturn;
 	my $c = @outlist;
-	print "\tXSprePUSH;" if $c and not $prepush_done;
+	# (PP)CODE set different values of SP; reset to PPCODE's with 0 output
+	print "\tXSprePUSH;"    if $c and not $prepush_done;
+	# Take into account stuff already put on stack
+	print "\t++SP;"         if $c and not $prepush_done and $xsreturn;
+	# Now SP corresponds to ST($xsreturn), so one can combine PUSH and ST()
 	print "\tEXTEND(SP,$c);\n" if $c;
 	$xsreturn += $c;
 	generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
@@ -1542,6 +1577,25 @@ EOF
     }
 }
 
+if ($Overload) # make it findable with fetchmethod
+{
+    
+    print Q<<"EOF"; 
+#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Packid}_nil)
+#{
+#   XSRETURN_EMPTY;
+#}
+#
+EOF
+    unshift(@InitFileCode, <<"MAKE_FETCHMETHOD_WORK");
+    /* Making a sub named "${Package}::()" allows the package */
+    /* to be findable via fetchmethod(), and causes */
+    /* overload::Overloaded("${Package}") to return true. */
+    newXS("${Package}::()", XS_${Packid}_nil, file$proto);
+MAKE_FETCHMETHOD_WORK
+}
+
 # print initialization routine
 
 print Q<<"EOF";
@@ -1580,15 +1634,15 @@ print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
 EOF
 
 print Q<<"EOF" if ($Overload);
-#    {
-#        /* create the package stash */
-#        HV *hv = get_hv(\"$Package\::OVERLOAD\",TRUE);
-#        SV *sv = *hv_fetch(hv,"register",8,1);
-#        sv_inc(sv);
-#        SvSETMAGIC(sv);
-#        /* Make it findable via fetchmethod */
-#        newXS(\"$Package\::()\", NULL, file);
-#    }
+#    /* register the overloading (type 'A') magic */
+#    PL_amagic_generation++;
+#    /* The magic for overload gets a GV* via gv_fetchmeth as */
+#    /* mentioned above, and looks in the SV* slot of it for */
+#    /* the "fallback" status. */
+#    sv_setsv(
+#        get_sv( "${Package}::()", TRUE ),
+#        $Fallback
+#    );
 EOF
 
 print @InitFileCode;
diff --git a/gnu/usr.bin/perl/lib/File/Basename.pm b/gnu/usr.bin/perl/lib/File/Basename.pm
index f2ef495cddf..58a740e56a1 100644
--- a/gnu/usr.bin/perl/lib/File/Basename.pm
+++ b/gnu/usr.bin/perl/lib/File/Basename.pm
@@ -19,7 +19,7 @@ dirname - extract just the directory from a path
 
     ($name,$path,$suffix) = fileparse("lib/File/Basename.pm",qr{\.pm});
     fileparse_set_fstype("VMS");
-    $basename = basename("lib/File/Basename.pm",qr{\.pm});
+    $basename = basename("lib/File/Basename.pm",".pm");
     $dirname = dirname("lib/File/Basename.pm");
 
 =head1 DESCRIPTION
@@ -130,7 +130,7 @@ directory name to be F<.>).
 # not be available.
 BEGIN {
   unless (eval { require re; })
-    { eval ' sub re::import { $^H |= 0x00100000; } ' }
+    { eval ' sub re::import { $^H |= 0x00100000; } ' } # HINT_RE_TAINT
   import re 'taint';
 }
 
@@ -142,7 +142,7 @@ our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.71";
+$VERSION = "2.72";
 
 
 #   fileparse_set_fstype() - specify OS-based rules used in future
@@ -169,7 +169,7 @@ sub fileparse {
   my($fullname,@suffices) = @_;
   unless (defined $fullname) {
       require Carp;
-      Carp::croak "fileparse(): need a valid pathname";
+      Carp::croak("fileparse(): need a valid pathname");
   }
   my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
   my($dirpath,$tail,$suffix,$basename);
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm
index 08da5e5d31e..0e87e988d52 100644
--- a/gnu/usr.bin/perl/lib/File/Copy.pm
+++ b/gnu/usr.bin/perl/lib/File/Copy.pm
@@ -24,7 +24,7 @@ sub mv;
 # package has not yet been updated to work with Perl 5.004, and so it
 # would be a Bad Thing for the CPAN module to grab it and replace this
 # module.  Therefore, we set this module's version higher than 2.0.
-$VERSION = '2.05';
+$VERSION = '2.06';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -37,7 +37,7 @@ my $macfiles;
 if ($^O eq 'MacOS') {
 	$macfiles = eval { require Mac::MoreFiles };
 	warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
-		if $^W;
+		if $@ && $^W;
 }
 
 sub _catname {
@@ -180,7 +180,7 @@ sub copy {
 
 sub move {
     my($from,$to) = @_;
-    my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
+    my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
 
     if (-d $to && ! -d $from) {
 	$to = _catname($from, $to);
@@ -194,7 +194,6 @@ sub move {
     }
     return 1 if rename $from, $to;
 
-    ($sts,$ossts) = ($! + 0, $^E + 0);
     # Did rename return an error even though it succeeded, because $to
     # is on a remote NFS file system, and NFS lost the server's ack?
     return 1 if defined($fromsz) && !-e $from &&           # $from disappeared
@@ -203,7 +202,8 @@ sub move {
                 $tosz2 == $fromsz;                         # it's all there
 
     ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
-    return 1 if ($copied = copy($from,$to)) && unlink($from);
+    return 1 if copy($from,$to) && unlink($from);
+    ($sts,$ossts) = ($! + 0, $^E + 0);
 
     ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
     unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
@@ -269,13 +269,13 @@ File::Copy - Copy files or filehandles
 
 =head1 SYNOPSIS
 
-  	use File::Copy;
+	use File::Copy;
 
-	copy("file1","file2");
-  	copy("Copy.pm",\*STDOUT);'
+	copy("file1","file2") or die "Copy failed: $!";
+	copy("Copy.pm",\*STDOUT);
 	move("/dev1/fileA","/dev2/fileB");
 
-  	use POSIX;
+	use POSIX;
 	use File::Copy cp;
 
 	$n = FileHandle->new("/a/file","r");
diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm
index 72fd195c9b0..4c15d384d75 100644
--- a/gnu/usr.bin/perl/lib/File/Find.pm
+++ b/gnu/usr.bin/perl/lib/File/Find.pm
@@ -3,10 +3,16 @@ use 5.006;
 use strict;
 use warnings;
 use warnings::register;
-our $VERSION = '1.04';
+our $VERSION = '1.05';
 require Exporter;
 require Cwd;
 
+#
+# Modified to ensure sub-directory traversal order is not inverded by stack
+# push and pops.  That is remains in the same order as in the directory file,
+# or user pre-processing (EG:sorted).
+#
+
 =head1 NAME
 
 File::Find - Traverse a directory tree.
@@ -14,7 +20,7 @@ File::Find - Traverse a directory tree.
 =head1 SYNOPSIS
 
     use File::Find;
-    find(\&wanted, @directories_to_seach);
+    find(\&wanted, @directories_to_search);
     sub wanted { ... }
 
     use File::Find;
@@ -39,7 +45,7 @@ but have subtle differences.
   find(\%options, @directories);
 
 find() does a breadth-first search over the given @directories in the
-order they are given.  In essense, it works from the top down.
+order they are given.  In essence, it works from the top down.
 
 For each file or directory found the &wanted subroutine is called (see
 below for details).  Additionally, for each directory found it will go
@@ -568,7 +574,7 @@ sub _find_opt {
     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 	$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 	$pre_process, $post_process, $dangling_symlinks);
-    local($dir, $name, $fullname, $prune);
+    local($dir, $name, $fullname, $prune, $_);
 
     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
     my $cwd_untainted  = $cwd;
@@ -662,7 +668,7 @@ sub _find_opt {
 		next Proc_Top_Item;
 	    }
 	    if (-d _) {
-		$top_item =~ s/\.dir\z// if $Is_VMS;
+		$top_item =~ s/\.dir\z//i if $Is_VMS;
 		_find_dir($wanted, $top_item, $topnlink);
 		$Is_Dir= 1;
 	    }
@@ -700,6 +706,7 @@ sub _find_opt {
 	    }
 
 	    $name = $abs_dir . $_; # $File::Find::name
+	    $_ = $name if $no_chdir;
 
 	    { $wanted_callback->() }; # protect against wild "next"
 
@@ -762,7 +769,7 @@ sub _find_dir($$$) {
 		}
 	    }
 	}
-	unless (chdir $udir) {
+	unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 	    warnings::warnif "Can't cd to $udir: $!\n";
 	    return;
 	}
@@ -804,7 +811,7 @@ sub _find_dir($$$) {
 		    }
 		}
 	    }
-	    unless (chdir $udir) {
+	    unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 		if ($Is_MacOS) {
 		    warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
 		}
@@ -854,6 +861,11 @@ sub _find_dir($$$) {
 	    # This dir has subdirectories.
 	    $subcount = $nlink - 2;
 
+	    # HACK: insert directories at this position. so as to preserve
+	    # the user pre-processed ordering of files.
+	    # EG: directory traversal is in user sorted order, not at random.
+            my $stack_top = @Stack;
+
 	    for my $FN (@filenames) {
 		next if $FN =~ $File::Find::skip_pattern;
 		if ($subcount > 0 || $no_nlink) {
@@ -864,8 +876,11 @@ sub _find_dir($$$) {
 
 		    if (-d _) {
 			--$subcount;
-			$FN =~ s/\.dir\z// if $Is_VMS;
-			push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
+			$FN =~ s/\.dir\z//i if $Is_VMS;
+			# HACK: replace push to preserve dir traversal order
+			#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
+			splice @Stack, $stack_top, 0,
+			         [$CdLvl,$dir_name,$FN,$sub_nlink];
 		    }
 		    else {
 			$name = $dir_pref . $FN; # $File::Find::name
diff --git a/gnu/usr.bin/perl/lib/File/Path.pm b/gnu/usr.bin/perl/lib/File/Path.pm
index 46af24fdb20..7881b6b35af 100644
--- a/gnu/usr.bin/perl/lib/File/Path.pm
+++ b/gnu/usr.bin/perl/lib/File/Path.pm
@@ -90,9 +90,21 @@ were not deleted may be left with permissions reset to allow world
 read and write access.  Note also that the occurrence of errors in
 rmtree can be determined I<only> by trapping diagnostic messages
 using C<$SIG{__WARN__}>; it is not apparent from the return value.
-Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
 in situations where security is an issue.
 
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item *
+
+On Windows, if C<mkpath> gives you the warning: B<No such file or
+directory>, this may mean that you've exceeded your filesystem's
+maximum path length.
+
+=back
+
 =head1 AUTHORS
 
 Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
@@ -107,7 +119,7 @@ use Exporter ();
 use strict;
 use warnings;
 
-our $VERSION = "1.05";
+our $VERSION = "1.06";
 our @ISA = qw( Exporter );
 our @EXPORT = qw( mkpath rmtree );
 
diff --git a/gnu/usr.bin/perl/lib/File/Temp.pm b/gnu/usr.bin/perl/lib/File/Temp.pm
index 6f351dfa6ce..4b9203310a1 100644
--- a/gnu/usr.bin/perl/lib/File/Temp.pm
+++ b/gnu/usr.bin/perl/lib/File/Temp.pm
@@ -51,6 +51,19 @@ The C<_can_do_level> method should be modified accordingly.
 
   $fh = tempfile();
 
+Object interface:
+
+  require File::Temp;
+  use File::Temp ();
+
+  $fh = new File::Temp($template);
+  $fname = $fh->filename;
+
+  $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
+  print $tmp "Some data\n";
+  print "Filename is $tmp\n";
+
+
 MkTemp family:
 
   use File::Temp qw/ :mktemp  /;
@@ -70,30 +83,21 @@ POSIX functions:
   $fh = tmpfile();
 
   ($fh, $file) = tmpnam();
-  ($fh, $file) = tmpfile();
+  $fh = tmpfile();
 
 
 Compatibility functions:
 
   $unopened_file = File::Temp::tempnam( $dir, $pfx );
 
-=begin later
-
-Objects (NOT YET IMPLEMENTED):
-
-  require File::Temp;
-
-  $fh = new File::Temp($template);
-  $fname = $fh->filename;
-
-=end later
-
 =head1 DESCRIPTION
 
-C<File::Temp> can be used to create and open temporary files in a safe way.
-The tempfile() function can be used to return the name and the open
-filehandle of a temporary file.  The tempdir() function can
-be used to create a temporary directory.
+C<File::Temp> can be used to create and open temporary files in a safe
+way.  There is both a function interface and an object-oriented
+interface.  The File::Temp constructor or the tempfile() function can
+be used to return the name and the open filehandle of a temporary
+file.  The tempdir() function can be used to create a temporary
+directory.
 
 The security aspect of temporary file creation is emphasized such that
 a filehandle and filename are returned together.  This helps guarantee
@@ -131,6 +135,10 @@ require VMS::Stdio if $^O eq 'VMS';
 # Need the Symbol package if we are running older perl
 require Symbol if $] < 5.006;
 
+### For the OO interface
+use base qw/ IO::Handle /;
+use overload '""' => "STRINGIFY";
+
 
 # use 'our' on v5.6.0
 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
@@ -167,7 +175,7 @@ Exporter::export_tags('POSIX','mktemp');
 
 # Version number
 
-$VERSION = '0.13';
+$VERSION = '0.14';
 
 # This is a list of characters that can be used in random filenames
 
@@ -798,7 +806,7 @@ sub _can_do_level {
   return 1 if $level == STANDARD;
 
   # Currently, the systems that can do HIGH or MEDIUM are identical
-  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS') {
+  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
     return 0;
   } else {
     return 1;
@@ -847,7 +855,7 @@ sub _can_do_level {
     # Dirs
     foreach my $dir (@dirs_to_unlink) {
       if (-d $dir) {
-	rmtree($dir, $DEBUG, 1);
+	rmtree($dir, $DEBUG, 0);
       }
     }
 
@@ -900,6 +908,131 @@ sub _can_do_level {
 
 }
 
+=head1 OO INTERFACE
+
+This is the primary interface for interacting with
+C<File::Temp>. Using the OO interface a temporary file can be created
+when the object is constructed and the file can be removed when the
+object is no longer required.
+
+Note that there is no method to obtain the filehandle from the
+C<File::Temp> object. The object itself acts as a filehandle. Also,
+the object is configured such that it stringifies to the name of the
+temporary file.
+
+=over 4
+
+=item B<new>
+
+Create a temporary file object.
+
+  my $tmp = new File::Temp();
+
+by default the object is constructed as if C<tempfile>
+was called without options, but with the additional behaviour
+that the temporary file is removed by the object destructor
+if UNLINK is set to true (the default).
+
+Supported arguments are the same as for C<tempfile>: UNLINK
+(defaulting to true), DIR and SUFFIX. Additionally, the filename
+template is specified using the TEMPLATE option. The OPEN option
+is not supported (the file is always opened).
+
+ $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
+                        DIR => 'mydir',
+                        SUFFIX => '.dat');
+
+Arguments are case insensitive.
+
+=cut
+
+sub new {
+  my $proto = shift;
+  my $class = ref($proto) || $proto;
+
+  # read arguments and convert keys to upper case
+  my %args = @_;
+  %args = map { uc($_), $args{$_} } keys %args;
+
+  # see if they are unlinking (defaulting to yes)
+  my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
+  delete $args{UNLINK};
+
+  # template (store it in an error so that it will
+  # disappear from the arg list of tempfile
+  my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
+  delete $args{TEMPLATE};
+
+  # Protect OPEN
+  delete $args{OPEN};
+
+  # Open the file and retain file handle and file name
+  my ($fh, $path) = tempfile( @template, %args );
+
+  print "Tmp: $fh - $path\n" if $DEBUG;
+
+  # Store the filename in the scalar slot
+  ${*$fh} = $path;
+
+  # Store unlink information in hash slot (plus other constructor info)
+  %{*$fh} = %args;
+  ${*$fh}{UNLINK} = $unlink;
+
+  bless $fh, $class;
+
+  return $fh;
+}
+
+=item B<filename>
+
+Return the name of the temporary file associated with this object.
+
+  $filename = $tmp->filename;
+
+This method is called automatically when the object is used as
+a string.
+
+=cut
+
+sub filename {
+  my $self = shift;
+  return ${*$self};
+}
+
+sub STRINGIFY {
+  my $self = shift;
+  return $self->filename;
+}
+
+=item B<DESTROY>
+
+When the object goes out of scope, the destructor is called. This
+destructor will attempt to unlink the file (using C<unlink1>)
+if the constructor was called with UNLINK set to 1 (the default state
+if UNLINK is not specified).
+
+No error is given if the unlink fails.
+
+=cut
+
+sub DESTROY {
+  my $self = shift;
+  if (${*$self}{UNLINK}) {
+    print "# --------->   Unlinking $self\n" if $DEBUG;
+
+    # The unlink1 may fail if the file has been closed
+    # by the caller. This leaves us with the decision
+    # of whether to refuse to remove the file or simply
+    # do an unlink without test. Seems to be silly
+    # to do this when we are trying to be careful
+    # about security
+    unlink1( $self, $self->filename )
+      or unlink($self->filename);
+  }
+}
+
+=back
+
 =head1 FUNCTIONS
 
 This section describes the recommended interface for generating
@@ -922,7 +1055,7 @@ files, as specified by the tmpdir() function in L<File::Spec>.
 Create a temporary file in the current directory using the supplied
 template.  Trailing `X' characters are replaced with random letters to
 generate the filename.  At least four `X' characters must be present
-in the template.
+at the end of the template.
 
   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
 
@@ -958,7 +1091,7 @@ This is the preferred mode of operation, as if you only
 have a filehandle, you can never create a race condition
 by fumbling with the filename. On systems that can not unlink
 an open file or can not mark a file as temporary when it is opened
-(for example, Windows NT uses the C<O_TEMPORARY> flag))
+(for example, Windows NT uses the C<O_TEMPORARY> flag)
 the file is marked for deletion when the program ends (equivalent
 to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
 
@@ -1471,7 +1604,7 @@ sub tmpnam {
 
 =item B<tmpfile>
 
-In scalar context, returns the filehandle of a temporary file.
+Returns the filehandle of a temporary file.
 
   $fh = tmpfile();
 
@@ -1597,11 +1730,78 @@ sub unlink0 {
   # Read args
   my ($fh, $path) = @_;
 
-  warn "Unlinking $path using unlink0\n"
+  cmpstat($fh, $path) or return 0;
+
+  # attempt remove the file (does not work on some platforms)
+  if (_can_unlink_opened_file()) {
+    # XXX: do *not* call this on a directory; possible race
+    #      resulting in recursive removal
+    croak "unlink0: $path has become a directory!" if -d $path;
+    unlink($path) or return 0;
+
+    # Stat the filehandle
+    my @fh = stat $fh;
+
+    print "Link count = $fh[3] \n" if $DEBUG;
+
+    # Make sure that the link count is zero
+    # - Cygwin provides deferred unlinking, however,
+    #   on Win9x the link count remains 1
+    # On NFS the link count may still be 1 but we cant know that
+    # we are on NFS
+    return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
+
+  } else {
+    _deferred_unlink($fh, $path, 0);
+    return 1;
+  }
+
+}
+
+=item B<cmpstat>
+
+Compare C<stat> of filehandle with C<stat> of provided filename.  This
+can be used to check that the filename and filehandle initially point
+to the same file and that the number of links to the file is 1 (all
+fields returned by stat() are compared).
+
+  cmpstat($fh, $path) or die "Error comparing handle with file";
+
+Returns false if the stat information differs or if the link count is
+greater than 1.
+
+On certain platofms, eg Windows, not all the fields returned by stat()
+can be compared. For example, the C<dev> and C<rdev> fields seem to be
+different in Windows.  Also, it seems that the size of the file
+returned by stat() does not always agree, with C<stat(FH)> being more
+accurate than C<stat(filename)>, presumably because of caching issues
+even when using autoflush (this is usually overcome by waiting a while
+after writing to the tempfile before attempting to C<unlink0> it).
+
+Not exported by default.
+
+=cut
+
+sub cmpstat {
+
+  croak 'Usage: cmpstat(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  warn "Comparing stat\n"
     if $DEBUG;
 
-  # Stat the filehandle
-  my @fh = stat $fh;
+  # Stat the filehandle - which may be closed if someone has manually
+  # closed the file. Can not turn off warnings without using $^W
+  # unless we upgrade to 5.006 minimum requirement
+  my @fh;
+  {
+    local ($^W) = 0;
+    @fh = stat $fh;
+  }
+  return unless @fh;
 
   if ($fh[3] > 1 && $^W) {
     carp "unlink0: fstat found too many links; SB=@fh" if $^W;
@@ -1633,7 +1833,9 @@ sub unlink0 {
   } elsif ($^O eq 'VMS') { # device and file ID are sufficient
     @okstat = (0, 1);
   } elsif ($^O eq 'dos') {
-     @okstat = (0,2..7,11..$#fh);
+    @okstat = (0,2..7,11..$#fh);
+  } elsif ($^O eq 'mpeix') {
+    @okstat = (0..4,8..10);
   }
 
   # Now compare each entry explicitly by number
@@ -1648,30 +1850,39 @@ sub unlink0 {
     }
   }
 
-  # attempt remove the file (does not work on some platforms)
-  if (_can_unlink_opened_file()) {
-    # XXX: do *not* call this on a directory; possible race
-    #      resulting in recursive removal
-    croak "unlink0: $path has become a directory!" if -d $path;
-    unlink($path) or return 0;
+  return 1;
+}
 
-    # Stat the filehandle
-    @fh = stat $fh;
+=item B<unlink1>
 
-    print "Link count = $fh[3] \n" if $DEBUG;
+Similar to C<unlink0> except after file comparison using cmpstat, the
+filehandle is closed prior to attempting to unlink the file. This
+allows the file to be removed without using an END block, but does
+mean that the post-unlink comparison of the filehandle state provided
+by C<unlink0> is not available.
 
-    # Make sure that the link count is zero
-    # - Cygwin provides deferred unlinking, however,
-    #   on Win9x the link count remains 1
-    # On NFS the link count may still be 1 but we cant know that
-    # we are on NFS
-    return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
+  unlink1($fh, $path) or die "Error closing and unlinking file";
 
-  } else {
-    _deferred_unlink($fh, $path, 0);
-    return 1;
-  }
+Usually called from the object destructor when using the OO interface.
+
+Not exported by default.
+
+=cut
 
+sub unlink1 {
+  croak 'Usage: unlink1(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  cmpstat($fh, $path) or return 0;
+
+  # Close the file
+  close( $fh ) or return 0;
+
+  # remove the file
+  return unlink($path);
 }
 
 =back
@@ -1858,9 +2069,9 @@ temporary file handling.
 
 =head1 AUTHOR
 
-Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
+Tim Jenness E<lt>tjenness@cpan.orgE<gt>
 
-Copyright (C) 1999-2001 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2003 Tim Jenness and the UK Particle Physics and
 Astronomy Research Council. All Rights Reserved.  This program is free
 software; you can redistribute it and/or modify it under the same
 terms as Perl itself.
@@ -1872,5 +2083,4 @@ security enhancements.
 
 =cut
 
-
 1;
diff --git a/gnu/usr.bin/perl/lib/FileCache.pm b/gnu/usr.bin/perl/lib/FileCache.pm
index ee14d92d072..8e1fe446a52 100644
--- a/gnu/usr.bin/perl/lib/FileCache.pm
+++ b/gnu/usr.bin/perl/lib/FileCache.pm
@@ -1,6 +1,6 @@
 package FileCache;
 
-our $VERSION = '1.021';
+our $VERSION = 1.03;
 
 =head1 NAME
 
@@ -12,18 +12,22 @@ FileCache - keep more files open than the system permits
     # or
     use FileCache maxopen => 16;
 
+    cacheout $mode, $path;
+    # or
     cacheout $path;
     print $path @data;
 
-    cacheout $mode, $path;
-    print $path @data;
+    $fh = cacheout $mode, $path;
+    # or
+    $fh = cacheout $path;
+    print $fh @data;
 
 =head1 DESCRIPTION
 
 The C<cacheout> function will make sure that there's a filehandle open
 for reading or writing available as the pathname you give it. It
-automatically closes and re-opens files if you exceed  your system's
-maximum number of file descriptors, or the suggested maximum.
+automatically closes and re-opens files if you exceed your system's
+maximum number of file descriptors, or the suggested maximum I<maxopen>.
 
 =over
 
@@ -32,6 +36,9 @@ maximum number of file descriptors, or the suggested maximum.
 The 1-argument form of cacheout will open a file for writing (C<< '>' >>)
 on it's first use, and appending (C<<< '>>' >>>) thereafter.
 
+Returns EXPR on success for convenience. You may neglect the
+return value and manipulate EXPR as the filehandle directly if you prefer.
+
 =item cacheout MODE, EXPR
 
 The 2-argument form of cacheout will use the supplied mode for the initial
@@ -39,11 +46,10 @@ and subsequent openings. Most valid modes for 3-argument C<open> are supported
 namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
 C< '|-' > and C< '-|' >
 
-=head1 CAVEATS
+Returns EXPR on success for convenience. You may neglect the
+return value and manipulate EXPR as the filehandle directly if you prefer.
 
-If you use cacheout with C<'|-'> or C<'-|'> you should catch SIGPIPE
-and explicitly close the filehandle., when it is closed from the
-other end some cleanup needs to be done.
+=head1 CAVEATS
 
 While it is permissible to C<close> a FileCache managed file,
 do not do so if you are calling C<FileCache::cacheout> from a package other
@@ -53,74 +59,109 @@ If you must, use C<FileCache::cacheout_close>.
 =head1 BUGS
 
 F<sys/param.h> lies with its C<NOFILE> define on some systems,
-so you may have to set maxopen (I<$FileCache::cacheout_maxopen>) yourself.
+so you may have to set I<maxopen> yourself.
+
+=head1 NOTES
+
+FileCache installs signal handlers for CHLD (a.k.a. CLD) and PIPE in the
+calling package to handle deceased children from 2-arg C<cacheout> with C<'|-'>
+or C<'-|'> I<expediently>. The children would otherwise be reaped eventually,
+unless you terminated before repeatedly calling cacheout.
 
 =cut
 
 require 5.006;
 use Carp;
+use Config;
 use strict;
 no strict 'refs';
-use vars qw(%saw $cacheout_maxopen);
 # These are not C<my> for legacy reasons.
 # Previous versions requested the user set $cacheout_maxopen by hand.
 # Some authors fiddled with %saw to overcome the clobber on initial open.
+use vars qw(%saw $cacheout_maxopen);
 my %isopen;
 my $cacheout_seq = 0;
 
 sub import {
     my ($pkg,%args) = @_;
-    *{caller(1).'::cacheout'} = \&cacheout;
-    *{caller(1).'::close'}    = \&cacheout_close;
+    $pkg = caller(1);
+    *{$pkg.'::cacheout'} = \&cacheout;
+    *{$pkg.'::close'}    = \&cacheout_close;
+
+    # Reap our children
+    ${"$pkg\::SIG"}{'CLD'}  = 'IGNORE' if $Config{sig_name} =~ /\bCLD\b/;
+    ${"$pkg\::SIG"}{'CHLD'} = 'IGNORE' if $Config{sig_name} =~ /\bCHLD\b/;
+    ${"$pkg\::SIG"}{'PIPE'} = 'IGNORE' if $Config{sig_name} =~ /\bPIPE\b/;
 
     # Truth is okay here because setting maxopen to 0 would be bad
-    return $cacheout_maxopen = $args{maxopen} if $args{maxopen} ;
-    if (open(PARAM,'/usr/include/sys/param.h')) {
-      local ($_, $.);
-      while (<PARAM>) {
-	$cacheout_maxopen = $1 - 4
-	  if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+    return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
+    foreach my $param ( '/usr/include/sys/param.h' ){
+      if (open($param, '<', $param)) {
+	local ($_, $.);
+	while (<$param>) {
+	  if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
+	    $cacheout_maxopen = $1 - 4;
+	    close($param);
+	    last;
+	  }
+	}
+	close $param;
       }
-      close PARAM;
     }
     $cacheout_maxopen ||= 16;
 }
 
 # Open in their package.
-
 sub cacheout_open {
-    open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]);
+  return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
 }
 
 # Close in their package.
-
 sub cacheout_close {
-    fileno(*{caller(1) . '::' . $_[0]}) &&
-      CORE::close(*{caller(1) . '::' . $_[0]});
-    delete $isopen{$_[0]};
+  # Short-circuit in case the filehandle disappeared
+  my $pkg = caller($_[1]||0);
+  fileno(*{$pkg . '::' . $_[0]}) &&
+    CORE::close(*{$pkg . '::' . $_[0]});
+  delete $isopen{$_[0]};
 }
 
 # But only this sub name is visible to them.
- 
 sub cacheout {
-    croak "Not enough arguments for cacheout"  unless @_;
-    croak "Too many arguments for cacheout" if scalar @_ > 2;
-    my($mode, $file)=@_;
-    ($file, $mode) = ($mode, $file) if scalar @_ == 1;
-    # We don't want children
-    croak "Invalid file for cacheout" if $file =~ /^\s*(?:\|\-)|(?:\-\|)\s*$/;
-    croak "Invalid mode for cacheout" if $mode &&
-      ( $mode !~ /^\s*(?:>>)|(?:\+?>)|(?:\+?<)|(?:\|\-)|(?:\-\|)\s*$/ );
+    my($mode, $file, $class, $ret, $ref, $narg);
+    croak "Not enough arguments for cacheout"  unless $narg = scalar @_;
+    croak "Too many arguments for cacheout"    if $narg > 2;
 
-    unless( $isopen{$file}) {
+    ($mode, $file) = @_;
+    ($file, $mode) = ($mode, $file) if $narg == 1;
+    croak "Invalid mode for cacheout" if $mode &&
+      ( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
+    
+    # Mode changed?
+    if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[2] ){
+      &cacheout_close($file, 1);
+    }
+    
+    if( $isopen{$file}) {
+      $ret = $file;
+      $isopen{$file}->[0]++;
+    }
+    else{
       if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
-	my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
-	&cacheout_close($_) for splice(@lru, $cacheout_maxopen / 3);
+	my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
+	$cacheout_seq = 0;
+	$isopen{$_}->[0] = $cacheout_seq++ for
+	  splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
+	&cacheout_close($_, 1) for @lru;
       }
-      $mode ||=  ( $saw{$file} = ! $saw{$file} ) ? '>': '>>';
-      cacheout_open($mode, $file) or croak("Can't create $file: $!");
+
+      unless( $ref ){
+	$mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
+      }
+      #XXX should we just return the value from cacheout_open, no croak?
+      $ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
+      
+      $isopen{$file} = [++$cacheout_seq, $mode];
     }
-    $isopen{$file} = ++$cacheout_seq;
+    return $ret;
 }
-
 1;
diff --git a/gnu/usr.bin/perl/lib/FileCache.t b/gnu/usr.bin/perl/lib/FileCache.t
deleted file mode 100644
index 1d91d210ab8..00000000000
--- a/gnu/usr.bin/perl/lib/FileCache.t
+++ /dev/null
@@ -1,91 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..5\n";
-
-use FileCache maxopen=>2;
-my @files = qw(foo bar baz quux);
-
-{# Test 1: that we can open files
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 1\n";
-     }
-     print "not " unless scalar map({ -f } @files) == 4;
-     print "ok 1\n";
-}
-
-
-{# Test 2: that we actually adhere to maxopen
-    my @cat;
-    for my $path ( @files ){
-	print $path "$path 2\n";
-        close($path);
-	open($path, $path);
-	<$path>;
-	push @cat, <$path>;
-        close($path);
-    }
-    print "not " if (grep {/foo|bar/} @cat) && ! (grep {/baz|quux/} @cat);
-    print "ok 2\n" ;
-}
-
-{# Test 3: that we open for append on second viewing
-     my @cat;
-     for my $path ( @files ){
-	 cacheout $path;
-	 print $path "$path 3\n";
-     }
-     for my $path ( @files ){
-	 open($path, $path);
-	 push @cat, do{ local $/; <$path>};
-         close($path);
-     }
-     print "not " unless scalar map({ /3$/ } @cat) == 4;
-     print "ok 3\n";
-}
-
-
-{# Test 4: that 2 arg format works
-     cacheout '+<', "foo";
-     print foo "foo 2\n";
-     close foo;
-     cacheout '<', "foo";
-     print "not " unless <foo> eq "foo 2\n";
-     print "ok 4\n";
-     close(foo);
-}
-
-{# Test 5: that close is overridden properly
-     cacheout local $_ = "Foo_Bar";
-     print $_ "Hello World\n";
-     close($_);
-     open($_, "+>$_");
-     print $_ "$_\n";
-     seek($_, 0, 0);
-     print "not " unless <$_> eq "$_\n";
-     print "ok 5\n";
-     close($_);
-}
-
-q(
-{# Test close override
-     package Bob;
-     use FileCache;
-     cacheout local $_ = "Foo_Bar";
-     print $_ "Hello World\n";
-     close($_);
-     open($_, "+>$_");
-     print $_ "$_\n";
-     seek($_, 0, 0);
-     print "not " unless <$_> eq "$_\n";
-     print "ok 5\n";
-     close($_);
-}
-);
-
-1 while unlink @files, "Foo_Bar";
diff --git a/gnu/usr.bin/perl/lib/Getopt/Long.pm b/gnu/usr.bin/perl/lib/Getopt/Long.pm
index 0f49e40ee37..8c1c40ae8dd 100644
--- a/gnu/usr.bin/perl/lib/Getopt/Long.pm
+++ b/gnu/usr.bin/perl/lib/Getopt/Long.pm
@@ -1,13 +1,13 @@
-# GetOpt::Long.pm -- Universal options parsing
+# Getopt::Long.pm -- Universal options parsing
 
 package Getopt::Long;
 
-# RCS Status      : $Id: Long.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
+# RCS Status      : $Id: Long.pm,v 1.7 2003/12/03 03:02:38 millert Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Thu Jun 20 07:48:05 2002
-# Update Count    : 1083
+# Last Modified On: Tue Sep 23 15:21:23 2003
+# Update Count    : 1364
 # Status          : Released
 
 ################ Copyright ################
@@ -35,20 +35,25 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.32;
+$VERSION        =  2.34;
 # For testing versions only.
-use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.32";
+#use vars qw($VERSION_STRING);
+#$VERSION_STRING = "2.33_03";
 
 use Exporter;
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw(@ISA @EXPORT @EXPORT_OK);
 @ISA = qw(Exporter);
-%EXPORT_TAGS = qw();
+
+# Exported subroutines.
+sub GetOptions(@);		# always
+sub Configure(@);		# on demand
+sub HelpMessage(@);		# on demand
+sub VersionMessage(@);		# in demand
+
 BEGIN {
     # Init immediately so their contents can be used in the 'use vars' below.
-    @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
-    @EXPORT_OK   = qw();
+    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure);
 }
 
 # User visible variables.
@@ -58,24 +63,27 @@ use vars qw($error $debug $major_version $minor_version);
 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
 	    $passthrough);
 # Official invisible variables.
-use vars qw($genprefix $caller $gnu_compat);
+use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version);
 
 # Public subroutines.
-sub Configure (@);
-sub config (@);			# deprecated name
-sub GetOptions;
+sub config(@);			# deprecated name
 
 # Private subroutines.
-sub ConfigDefaults ();
-sub ParseOptionSpec ($$);
-sub OptCtl ($);
-sub FindOption ($$$$);
+sub ConfigDefaults();
+sub ParseOptionSpec($$);
+sub OptCtl($);
+sub FindOption($$$$);
 
 ################ Local Variables ################
 
+# $requested_version holds the version that was mentioned in the 'use'
+# or 'require', if any. It can be used to enable or disable specific
+# features.
+my $requested_version = 0;
+
 ################ Resident subroutines ################
 
-sub ConfigDefaults () {
+sub ConfigDefaults() {
     # Handle POSIX compliancy.
     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
 	$genprefix = "(--|-)";
@@ -110,13 +118,14 @@ sub import {
 	    $dest = \@config;	# config next
 	    next;
 	}
-	push (@$dest, $_);	# push
+	push(@$dest, $_);	# push
     }
     # Hide one level and call super.
     local $Exporter::ExportLevel = 1;
+    push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
     $pkg->SUPER::import(@syms);
     # And configure.
-    Configure (@config) if @config;
+    Configure(@config) if @config;
 }
 
 ################ Initialization ################
@@ -205,6 +214,8 @@ sub getoptions {
 
 package Getopt::Long;
 
+################ Back to Normal ################
+
 # Indices in option control info.
 # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
 use constant CTL_TYPE    => 0;
@@ -233,7 +244,7 @@ use constant CTL_DEFAULT => 4;
 #use constant CTL_RANGE   => ;
 #use constant CTL_REPEAT  => ;
 
-sub GetOptions {
+sub GetOptions(@) {
 
     my @optionlist = @_;	# local copy of the option descriptions
     my $argend = '--';		# option list terminator
@@ -248,23 +259,28 @@ sub GetOptions {
 
     $error = '';
 
-    print STDERR ("GetOpt::Long $Getopt::Long::VERSION (",
-		  '$Revision: 1.6 $', ") ",
-		  "called from package \"$pkg\".",
-		  "\n  ",
-		  "ARGV: (@ARGV)",
-		  "\n  ",
-		  "autoabbrev=$autoabbrev,".
-		  "bundling=$bundling,",
-		  "getopt_compat=$getopt_compat,",
-		  "gnu_compat=$gnu_compat,",
-		  "order=$order,",
-		  "\n  ",
-		  "ignorecase=$ignorecase,",
-		  "passthrough=$passthrough,",
-		  "genprefix=\"$genprefix\".",
-		  "\n")
-	if $debug;
+    if ( $debug ) {
+	# Avoid some warnings if debugging.
+	local ($^W) = 0;
+	print STDERR
+	  ("Getopt::Long $Getopt::Long::VERSION (",
+	   '$Revision: 1.7 $', ") ",
+	   "called from package \"$pkg\".",
+	   "\n  ",
+	   "ARGV: (@ARGV)",
+	   "\n  ",
+	   "autoabbrev=$autoabbrev,".
+	   "bundling=$bundling,",
+	   "getopt_compat=$getopt_compat,",
+	   "gnu_compat=$gnu_compat,",
+	   "order=$order,",
+	   "\n  ",
+	   "ignorecase=$ignorecase,",
+	   "requested_version=$requested_version,",
+	   "passthrough=$passthrough,",
+	   "genprefix=\"$genprefix\".",
+	   "\n");
+    }
 
     # Check for ref HASH as first argument.
     # First argument may be an object. It's OK to use this as long
@@ -358,7 +374,18 @@ sub GetOptions {
 	    elsif ( $rl eq "HASH" ) {
 		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
 	    }
-	    elsif ( $rl eq "SCALAR" || $rl eq "CODE" ) {
+	    elsif ( $rl eq "SCALAR" ) {
+#		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
+#		    my $t = $linkage{$orig};
+#		    $$t = $linkage{$orig} = [];
+#		}
+#		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
+#		}
+#		else {
+		    # Ok.
+#		}
+	    }
+	    elsif ( $rl eq "CODE" ) {
 		# Ok.
 	    }
 	    else {
@@ -392,6 +419,22 @@ sub GetOptions {
     die ($error) if $error;
     $error = 0;
 
+    # Supply --version and --help support, if needed and allowed.
+    if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
+	if ( !defined($opctl{version}) ) {
+	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
+	    $linkage{version} = \&VersionMessage;
+	}
+	$auto_version = 1;
+    }
+    if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
+	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
+	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
+	    $linkage{help} = \&HelpMessage;
+	}
+	$auto_help = 1;
+    }
+
     # Show the options tables if debugging.
     if ( $debug ) {
 	my ($arrow, $k, $v);
@@ -411,7 +454,10 @@ sub GetOptions {
 	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
 
 	# Double dash is option list terminator.
-	last if $opt eq $argend;
+	if ( $opt eq $argend ) {
+	  push (@ret, $argend) if $passthrough;
+	  last;
+	}
 
 	# Look it up.
 	my $tryopt = $opt;
@@ -450,6 +496,26 @@ sub GetOptions {
 			        ${$linkage{$opt}} = $arg;
 			    }
 			}
+			elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
+			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+					  " to ARRAY\n")
+			      if $debug;
+			    my $t = $linkage{$opt};
+			    $$t = $linkage{$opt} = [];
+			    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+			      if $debug;
+			    push (@{$linkage{$opt}}, $arg);
+			}
+			elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+					  " to HASH\n")
+			      if $debug;
+			    my $t = $linkage{$opt};
+			    $$t = $linkage{$opt} = {};
+			    print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+			      if $debug;
+			    $linkage{$opt}->{$key} = $arg;
+			}
 			else {
 			    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
 			      if $debug;
@@ -698,6 +764,7 @@ sub ParseOptionSpec ($$) {
 
 	if ( $spec eq '!' ) {
 	    $opctl->{"no$_"} = $entry;
+	    $opctl->{"no-$_"} = $entry;
 	    $opctl->{$_} = [@$entry];
 	    $opctl->{$_}->[CTL_TYPE] = '';
 	}
@@ -797,6 +864,15 @@ sub FindOption ($$$$) {
 		  if defined $opctl->{$_}->[CTL_CNAME];
 		$hit{$_} = 1;
 	    }
+	    # Remove auto-supplied options (version, help).
+	    if ( keys(%hit) == 2 ) {
+		if ( $auto_version && exists($hit{version}) ) {
+		    delete $hit{version};
+		}
+		elsif ( $auto_help && exists($hit{help}) ) {
+		    delete $hit{help};
+		}
+	    }
 	    # Now see if it really is ambiguous.
 	    unless ( keys(%hit) == 1 ) {
 		return (0) if $passthrough;
@@ -826,6 +902,11 @@ sub FindOption ($$$$) {
     my $ctl = $opctl->{$tryopt};
     unless  ( defined $ctl ) {
 	return (0) if $passthrough;
+	# Pretend one char when bundling.
+	if ( $bundling == 1) {
+	    $opt = substr($opt,0,1);
+            unshift (@ARGV, $starter.$rest) if defined $rest;
+	}
 	warn ("Unknown option: ", $opt, "\n");
 	$error++;
 	return (1, undef);
@@ -853,7 +934,7 @@ sub FindOption ($$$$) {
 	    $arg = 1;
 	}
 	else {
-	    $opt =~ s/^no//i;	# strip NO prefix
+	    $opt =~ s/^no-?//i;	# strip NO prefix
 	    $arg = 0;		# supply explicit value
 	}
 	unshift (@ARGV, $starter.$rest) if defined $rest;
@@ -899,11 +980,21 @@ sub FindOption ($$$$) {
     my $key;
     if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
 	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
-	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 1);
+	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
+	     ($mand ? undef : ($type eq 's' ? "" : 1)));
+	if (! defined $arg) {
+	    warn ("Option $opt, key \"$key\", requires a value\n");
+	    $error++;
+	    # Push back.
+	    unshift (@ARGV, $starter.$rest) if defined $rest;
+	    return (1, undef);
+	}
     }
 
     #### Check if the argument is valid for this option ####
 
+    my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
+
     if ( $type eq 's' ) {	# string
 	# A mandatory string takes anything.
 	return (1, $opt, $ctl, $arg, $key) if $mand;
@@ -931,9 +1022,10 @@ sub FindOption ($$$$) {
 	  $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
 	    : "[-+]?[0-9]+";
 
-	if ( $bundling && defined $rest && $rest =~ /^($o_valid)(.*)$/si ) {
-	    $arg = $1;
-	    $rest = $2;
+	if ( $bundling && defined $rest
+	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
+	    ($key, $arg, $rest) = ($1, $2, $+);
+	    chop($key) if $key;
 	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
 	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 	}
@@ -976,9 +1068,9 @@ sub FindOption ($$$$) {
 	# and at least one digit following the point and 'e'.
 	# [-]NN[.NN][eNN]
 	if ( $bundling && defined $rest &&
-	     $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
-	    $arg = $1;
-	    $rest = $+;
+	     $rest =~ /^($key_valid)([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
+	    ($key, $arg, $rest) = ($1, $2, $+);
+	    chop($key) if $key;
 	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 	}
 	elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
@@ -1004,7 +1096,7 @@ sub FindOption ($$$$) {
 	}
     }
     else {
-	die("GetOpt::Long internal error (Can't happen)\n");
+	die("Getopt::Long internal error (Can't happen)\n");
     }
     return (1, $opt, $ctl, $arg, $key);
 }
@@ -1016,12 +1108,13 @@ sub Configure (@) {
     my $prevconfig =
       [ $error, $debug, $major_version, $minor_version,
 	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
-	$gnu_compat, $passthrough, $genprefix ];
+	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ];
 
     if ( ref($options[0]) eq 'ARRAY' ) {
 	( $error, $debug, $major_version, $minor_version,
 	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
-	  $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)};
+	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ) =
+	    @{shift(@options)};
     }
 
     my $opt;
@@ -1057,6 +1150,12 @@ sub Configure (@) {
 	elsif ( $try eq 'gnu_compat' ) {
 	    $gnu_compat = $action;
 	}
+	elsif ( $try =~ /^(auto_?)?version$/ ) {
+	    $auto_version = $action;
+	}
+	elsif ( $try =~ /^(auto_?)?help$/ ) {
+	    $auto_help = $action;
+	}
 	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
 	    $ignorecase = $action;
 	}
@@ -1108,6 +1207,101 @@ sub config (@) {
     Configure (@_);
 }
 
+# Issue a standard message for --version.
+#
+# The arguments are mostly the same as for Pod::Usage::pod2usage:
+#
+#  - a number (exit value)
+#  - a string (lead in message)
+#  - a hash with options. See Pod::Usage for details.
+#
+sub VersionMessage(@) {
+    # Massage args.
+    my $pa = setup_pa_args("version", @_);
+
+    my $v = $main::VERSION;
+    my $fh = $pa->{-output} ||
+      ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
+
+    print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
+	       $0, defined $v ? " version $v" : (),
+	       "\n",
+	       "(", __PACKAGE__, "::", "GetOptions",
+	       " version ",
+	       defined($Getopt::Long::VERSION_STRING)
+	         ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
+	       " Perl version ",
+	       $] >= 5.006 ? sprintf("%vd", $^V) : $],
+	       ")\n");
+    exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
+}
+
+# Issue a standard message for --help.
+#
+# The arguments are the same as for Pod::Usage::pod2usage:
+#
+#  - a number (exit value)
+#  - a string (lead in message)
+#  - a hash with options. See Pod::Usage for details.
+#
+sub HelpMessage(@) {
+    eval {
+	require Pod::Usage;
+	import Pod::Usage;
+	1;
+    } || die("Cannot provide help: cannot load Pod::Usage\n");
+
+    # Note that pod2usage will issue a warning if -exitval => NOEXIT.
+    pod2usage(setup_pa_args("help", @_));
+
+}
+
+# Helper routine to set up a normalized hash ref to be used as
+# argument to pod2usage.
+sub setup_pa_args($@) {
+    my $tag = shift;		# who's calling
+
+    # If called by direct binding to an option, it will get the option
+    # name and value as arguments. Remove these, if so.
+    @_ = () if @_ == 2 && $_[0] eq $tag;
+
+    my $pa;
+    if ( @_ > 1 ) {
+	$pa = { @_ };
+    }
+    else {
+	$pa = shift || {};
+    }
+
+    # At this point, $pa can be a number (exit value), string
+    # (message) or hash with options.
+
+    if ( UNIVERSAL::isa($pa, 'HASH') ) {
+	# Get rid of -msg vs. -message ambiguity.
+	$pa->{-message} = $pa->{-msg};
+	delete($pa->{-msg});
+    }
+    elsif ( $pa =~ /^-?\d+$/ ) {
+	$pa = { -exitval => $pa };
+    }
+    else {
+	$pa = { -message => $pa };
+    }
+
+    # These are _our_ defaults.
+    $pa->{-verbose} = 0 unless exists($pa->{-verbose});
+    $pa->{-exitval} = 0 unless exists($pa->{-exitval});
+    $pa;
+}
+
+# Sneak way to know what version the user requested.
+sub VERSION {
+    $requested_version = $_[1];
+    shift->SUPER::VERSION(@_);
+}
+
+1;
+
 ################ Documentation ################
 
 =head1 NAME
@@ -1306,19 +1500,23 @@ use multiple directories to search for library files:
 To accomplish this behaviour, simply specify an array reference as the
 destination for the option:
 
-    my @libfiles = ();
     GetOptions ("library=s" => \@libfiles);
 
-Used with the example above, C<@libfiles> would contain two strings
-upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
-It is also possible to specify that only integer or floating point
-numbers are acceptible values.
+Alternatively, you can specify that the option can have multiple
+values by adding a "@", and pass a scalar reference as the
+destination:
+
+    GetOptions ("library=s@" => \$libfiles);
+
+Used with the example above, C<@libfiles> (or C<@$libfiles>) would
+contain two strings upon completion: C<"lib/srdlib"> and
+C<"lib/extlib">, in that order. It is also possible to specify that
+only integer or floating point numbers are acceptible values.
 
 Often it is useful to allow comma-separated lists of values as well as
 multiple occurrences of the options. This is easy using Perl's split()
 and join() operators:
 
-    my @libfiles = ();
     GetOptions ("library=s" => \@libfiles);
     @libfiles = split(/,/,join(',',@libfiles));
 
@@ -1331,17 +1529,20 @@ If the option destination is a reference to a hash, the option will
 take, as value, strings of the form I<key>C<=>I<value>. The value will
 be stored with the specified key in the hash.
 
-    my %defines = ();
     GetOptions ("define=s" => \%defines);
 
+Alternatively you can use:
+
+    GetOptions ("define=s%" => \$defines);
+
 When used with command line options:
 
     --define os=linux --define vendor=redhat
 
-the hash C<%defines> will contain two keys, C<"os"> with value
-C<"linux> and C<"vendor"> with value C<"redhat">.
-It is also possible to specify that only integer or floating point
-numbers are acceptible values. The keys are always taken to be strings.
+the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
+with value C<"linux> and C<"vendor"> with value C<"redhat">. It is
+also possible to specify that only integer or floating point numbers
+are acceptible values. The keys are always taken to be strings.
 
 =head2 User-defined subroutines to handle options
 
@@ -1425,7 +1626,7 @@ The argument specification can be
 
 The option does not take an argument and may be negated, i.e. prefixed
 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
-assigned) and C<--nofoo> (a value of 0 will be assigned). If the
+assigned) and C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the
 option has aliases, this applies to the aliases as well.
 
 Using negation on a single letter option when bundling is in effect is
@@ -1538,7 +1739,7 @@ messages. For example:
 
     =head1 NAME
 
-    sample - Using GetOpt::Long and Pod::Usage
+    sample - Using Getopt::Long and Pod::Usage
 
     =head1 SYNOPSIS
 
@@ -1689,7 +1890,7 @@ it will set variable C<$stdio>.
 
 =head2 Argument callback
 
-A special option 'name' C<<>> can be used to designate a subroutine
+A special option 'name' C<< <> >> can be used to designate a subroutine
 to handle non-option arguments. When GetOptions() encounters an
 argument that does not look like an option, it will immediately call this
 subroutine and passes it one parameter: the argument name.
@@ -1712,7 +1913,6 @@ C<process("arg3")> while C<$width> is C<60>.
 This feature requires configuration option B<permute>, see section
 L<Configuring Getopt::Long>.
 
-
 =head1 Configuring Getopt::Long
 
 Getopt::Long can be configured by calling subroutine
@@ -1861,6 +2061,33 @@ options also.
 
 Note: disabling C<ignore_case_always> also disables C<ignore_case>.
 
+=item auto_version (default:disabled)
+
+Automatically provide support for the B<--version> option if
+the application did not specify a handler for this option itself.
+
+Getopt::Long will provide a standard version message that includes the
+program name, its version (if $main::VERSION is defined), and the
+versions of Getopt::Long and Perl. The message will be written to
+standard output and processing will terminate.
+
+C<auto_version> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+C<require> statement.
+
+=item auto_help (default:disabled)
+
+Automatically provide support for the B<--help> and B<-?> options if
+the application did not specify a handler for this option itself.
+
+Getopt::Long will provide a help message using module L<Pod::Usage>. The
+message, derived from the SYNOPSIS POD section, will be written to
+standard output and processing will terminate.
+
+C<auto_help> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+C<require> statement.
+
 =item pass_through (default: disabled)
 
 Options that are unknown, ambiguous or supplied with an invalid option
@@ -1873,6 +2100,9 @@ If C<require_order> is enabled, options processing will terminate at
 the first unrecognized option, or non-option, whichever comes first.
 However, if C<permute> is enabled instead, results can become confusing.
 
+Note that the options terminator (default C<-->), if present, will
+also be passed through in C<@ARGV>.
+
 =item prefix
 
 The string that starts options. If a constant string is not
@@ -1890,6 +2120,83 @@ Enable debugging output.
 
 =back
 
+=head1 Exportable Methods
+
+=over
+
+=item VersionMessage
+
+This subroutine provides a standard version message. Its argument can be:
+
+=over 4
+
+=item *
+
+A string containing the text of a message to print I<before> printing
+the standard message.
+
+=item *
+
+A numeric value corresponding to the desired exit status.
+
+=item *
+
+A reference to a hash.
+
+=back
+
+If more than one argument is given then the entire argument list is
+assumed to be a hash.  If a hash is supplied (either as a reference or
+as a list) it should contain one or more elements with the following
+keys:
+
+=over 4
+
+=item C<-message>
+
+=item C<-msg>
+
+The text of a message to print immediately prior to printing the
+program's usage message.
+
+=item C<-exitval>
+
+The desired exit status to pass to the B<exit()> function.
+This should be an integer, or else the string "NOEXIT" to
+indicate that control should simply be returned without
+terminating the invoking process.
+
+=item C<-output>
+
+A reference to a filehandle, or the pathname of a file to which the
+usage message should be written. The default is C<\*STDERR> unless the
+exit value is less than 2 (in which case the default is C<\*STDOUT>).
+
+=back
+
+You cannot tie this routine directly to an option, e.g.:
+
+    GetOptions("version" => \&VersionMessage);
+
+Use this instead:
+
+    GetOptions("version" => sub { VersionMessage() });
+
+=item HelpMessage
+
+This subroutine produces a standard help message, derived from the
+program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
+arguments as VersionMessage(). In particular, you cannot tie it
+directly to an option, e.g.:
+
+    GetOptions("help" => \&HelpMessage);
+
+Use this instead:
+
+    GetOptions("help" => sub { HelpMessage() });
+
+=back
+
 =head1 Return values and Errors
 
 Configuration errors and errors in the option definitions are
@@ -1902,8 +2209,6 @@ It returns false when the function detected one or more errors during
 option parsing. These errors are signalled using warn() and can be
 trapped with C<$SIG{__WARN__}>.
 
-Errors that can't happen are signalled using Carp::croak().
-
 =head1 Legacy
 
 The earliest development of C<newgetopt.pl> started in 1990, with Perl
@@ -1970,23 +2275,6 @@ in version 2.17. Besides, it is much easier.
 
 =head1 Trouble Shooting
 
-=head2 Warning: Ignoring '!' modifier for short option
-
-This warning is issued when the '!' modifier is applied to a short
-(one-character) option and bundling is in effect. E.g.,
-
-    Getopt::Long::Configure("bundling");
-    GetOptions("foo|f!" => \$foo);
-
-Note that older Getopt::Long versions did not issue a warning, because
-the '!' modifier was applied to the first name only. This bug was
-fixed in 2.22.
-
-Solution: separate the long and short names and apply the '!' to the
-long names only, e.g.,
-
-    GetOptions("foo!" => \$foo, "f" => \$foo);
-
 =head2 GetOptions does not return a false result when an option is not supplied
 
 That's why they're called 'options'.
@@ -1995,7 +2283,7 @@ That's why they're called 'options'.
 
 The command line is not split by GetOptions, but by the command line
 interpreter (CLI). On Unix, this is the shell. On Windows, it is
-COMMAND.COM or CMD.EXE. Other operating systems have other CLIs. 
+COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
 
 It is important to know that these CLIs may behave different when the
 command line contains special characters, in particular quotes or
@@ -2014,6 +2302,14 @@ program:
 
 to verify how your CLI passes the arguments to the program.
 
+=head2 Undefined subroutine &main::GetOptions called
+
+Are you running Windows, and did you write
+
+    use GetOpt::Long;
+
+(note the capital 'O')?
+
 =head2 How do I put a "-?" option into a Getopt::Long?
 
 You can only obtain this using an alias, and Getopt::Long of at least
@@ -2028,7 +2324,7 @@ Johan Vromans <jvromans@squirrel.nl>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 2002,1990 by Johan Vromans.
+This program is Copyright 2003,1990 by Johan Vromans.
 This program is free software; you can redistribute it and/or
 modify it under the terms of the Perl Artistic License or the
 GNU General Public License as published by the Free Software
diff --git a/gnu/usr.bin/perl/lib/Getopt/Std.pm b/gnu/usr.bin/perl/lib/Getopt/Std.pm
index fab0035aebb..6c420937636 100644
--- a/gnu/usr.bin/perl/lib/Getopt/Std.pm
+++ b/gnu/usr.bin/perl/lib/Getopt/Std.pm
@@ -44,11 +44,36 @@ To allow programs to process arguments that look like switches, but aren't,
 both functions will stop processing switches when they see the argument
 C<-->.  The C<--> will be removed from @ARGV.
 
+=head1 C<--help> and C<--version>
+
+If C<-> is not a recognized switch letter, getopts() supports arguments
+C<--help> and C<--version>.  If C<main::HELP_MESSAGE()> and/or
+C<main::VERSION_MESSAGE()> are defined, they are called; the arguments are
+the output file handle, the name of option-processing package, its version,
+and the switches string.  If the subroutines are not defined, an attempt is
+made to generate intelligent messages; for best results, define $main::VERSION.
+
+If embedded documentation (in pod format, see L<perlpod>) is detected
+in the script, C<--help> will also show how to access the documentation.
+
+Note that due to excessive paranoia, if $Getopt::Std::STANDARD_HELP_VERSION
+isn't true (the default is false), then the messages are printed on STDERR,
+and the processing continues after the messages are printed.  This being
+the opposite of the standard-conforming behaviour, it is strongly recommended
+to set $Getopt::Std::STANDARD_HELP_VERSION to true.
+
+One can change the output file handle of the messages by setting
+$Getopt::Std::OUTPUT_HELP_VERSION.  One can print the messages of C<--help>
+(without the C<Usage:> line) and C<--version> by calling functions help_mess()
+and version_mess() with the switches string as an argument.
+
 =cut
 
 @ISA = qw(Exporter);
 @EXPORT = qw(getopt getopts);
-$VERSION = '1.03';
+$VERSION = '1.04';
+# uncomment the next line to disable 1.03-backward compatibility paranoia
+# $STANDARD_HELP_VERSION = 1;
 
 # Process single-character switches with switch clustering.  Pass one argument
 # which is a string containing all switches that take an argument.  For each
@@ -110,25 +135,101 @@ sub getopt (;$$) {
     }
 }
 
+sub output_h () {
+  return $OUTPUT_HELP_VERSION if defined $OUTPUT_HELP_VERSION;
+  return \*STDOUT if $STANDARD_HELP_VERSION;
+  return \*STDERR;
+}
+
+sub try_exit () {
+    exit 0 if $STANDARD_HELP_VERSION;
+    my $p = __PACKAGE__;
+    print {output_h()} <<EOM;
+  [Now continuing due to backward compatibility and excessive paranoia.
+   See ``perldoc $p'' about \$$p\::STANDARD_HELP_VERSION.]
+EOM
+}
+
+sub version_mess ($;$) {
+    my $args = shift;
+    my $h = output_h;
+    if (@_ and defined &main::VERSION_MESSAGE) {
+	main::VERSION_MESSAGE($h, __PACKAGE__, $VERSION, $args);
+    } else {
+	my $v = $main::VERSION;
+	$v = '[unknown]' unless defined $v;
+	my $myv = $VERSION;
+	$myv .= ' [paranoid]' unless $STANDARD_HELP_VERSION;
+	my $perlv = $];
+	$perlv = sprintf "%vd", $^V if $] >= 5.006;
+	print $h <<EOH;
+$0 version $v calling Getopt::Std::getopts (version $myv),
+running under Perl version $perlv.
+EOH
+    }
+}
+
+sub help_mess ($;$) {
+    my $args = shift;
+    my $h = output_h;
+    if (@_ and defined &main::HELP_MESSAGE) {
+	main::HELP_MESSAGE($h, __PACKAGE__, $VERSION, $args);
+    } else {
+	my (@witharg) = ($args =~ /(\S)\s*:/g);
+	my (@rest) = ($args =~ /([^\s:])(?!\s*:)/g);
+	my ($help, $arg) = ('', '');
+	if (@witharg) {
+	    $help .= "\n\tWith arguments: -" . join " -", @witharg;
+	    $arg = "\nSpace is not required between options and their arguments.";
+	}
+	if (@rest) {
+	    $help .= "\n\tBoolean (without arguments): -" . join " -", @rest;
+	}
+	my ($scr) = ($0 =~ m,([^/\\]+)$,);
+	print $h <<EOH if @_;			# Let the script override this
+
+Usage: $scr [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
+EOH
+	print $h <<EOH;
+
+The following single-character options are accepted:$help
+
+Options may be merged together.  -- stops processing of options.$arg
+EOH
+	my $has_pod;
+	if ( defined $0 and $0 ne '-e' and -f $0 and -r $0
+	     and open my $script, '<', $0 ) {
+	    while (<$script>) {
+		$has_pod = 1, last if /^=(pod|head1)/;
+	    }
+	}
+	print $h <<EOH if $has_pod;
+
+For more details run
+	perldoc -F $0
+EOH
+    }
+}
+
 # Usage:
 #   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
 #			#  side effect.
 
 sub getopts ($;$) {
     my ($argumentative, $hash) = @_;
-    my (@args,$first,$rest);
+    my (@args,$first,$rest,$exit);
     my $errs = 0;
     local $_;
     local @EXPORT;
 
     @args = split( / */, $argumentative );
-    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/s) {
 	($first,$rest) = ($1,$2);
 	if (/^--$/) {	# early exit if --
 	    shift @ARGV;
 	    last;
 	}
-	$pos = index($argumentative,$first);
+	my $pos = index($argumentative,$first);
 	if ($pos >= 0) {
 	    if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
 		shift(@ARGV);
@@ -161,6 +262,18 @@ sub getopts ($;$) {
 	    }
 	}
 	else {
+	    if ($first eq '-' and $rest eq 'help') {
+		version_mess($argumentative, 'main');
+		help_mess($argumentative, 'main');
+		try_exit();
+		shift(@ARGV);
+		next;
+	    } elsif ($first eq '-' and $rest eq 'version') {
+		version_mess($argumentative, 'main');
+		try_exit();
+		shift(@ARGV);
+		next;
+	    }
 	    warn "Unknown option: $first\n";
 	    ++$errs;
 	    if ($rest ne '') {
diff --git a/gnu/usr.bin/perl/lib/I18N/LangTags/test.pl b/gnu/usr.bin/perl/lib/I18N/LangTags/test.pl
deleted file mode 100644
index 88a7bf66ae8..00000000000
--- a/gnu/usr.bin/perl/lib/I18N/LangTags/test.pl
+++ /dev/null
@@ -1,79 +0,0 @@
-# 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.
-require 5;
- # Time-stamp: "2001-06-21 22:59:38 MDT"
-use strict;
-use Test;
-BEGIN { plan tests => 46 };
-BEGIN { ok 1 }
-use I18N::LangTags (':ALL');
-
-print "# Perl v$], I18N::LangTags v$I18N::LangTags::VERSION\n";
-
-ok !is_language_tag('');
-ok  is_language_tag('fr');
-ok  is_language_tag('fr-ca');
-ok  is_language_tag('fr-CA');
-ok !is_language_tag('fr-CA-');
-ok !is_language_tag('fr_CA');
-ok  is_language_tag('fr-ca-joual');
-ok !is_language_tag('frca');
-ok  is_language_tag('nav');
-ok  is_language_tag('nav-shiprock');
-ok !is_language_tag('nav-ceremonial'); # subtag too long
-ok !is_language_tag('x');
-ok !is_language_tag('i');
-ok  is_language_tag('i-borg'); # NB: fictitious tag
-ok  is_language_tag('x-borg');
-ok  is_language_tag('x-borg-prot5123');
-ok  same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123' );
-ok !same_language_tag('en', 'en-us' );
-
-ok 0 == similarity_language_tag('en-ca', 'fr-ca');
-ok 1 == similarity_language_tag('en-ca', 'en-us');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us-western');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us');
-
-ok grep $_ eq 'hi', panic_languages('kok');
-ok grep $_ eq 'en', panic_languages('x-woozle-wuzzle');
-ok ! grep $_ eq 'mr', panic_languages('it');
-ok grep $_ eq 'es', panic_languages('it');
-ok grep $_ eq 'it', panic_languages('es');
-
-
-print "# Now the ::List tests...\n";
-use I18N::LangTags::List;
-foreach my $lt (qw(
- en
- en-us
- en-kr
- el
- elx
- i-mingo
- i-mingo-tom
- x-mingo-tom
- it
- it-it
- it-IT
- it-FR
- yi
- ji
- cre-syllabic
- cre-syllabic-western
- cre-western
- cre-latin
-)) {
-  my $name = I18N::LangTags::List::name($lt);
-  if($name) {
-    ok(1);
-    print "#        $lt -> $name\n";
-  } else {
-    ok(0);
-    print "#        Failed lookup on $lt\n";
-  }
-}
-
-print "# So there!\n";
-
diff --git a/gnu/usr.bin/perl/lib/IPC/Open3.pm b/gnu/usr.bin/perl/lib/IPC/Open3.pm
index eefbd76ff06..d92894b28a9 100644
--- a/gnu/usr.bin/perl/lib/IPC/Open3.pm
+++ b/gnu/usr.bin/perl/lib/IPC/Open3.pm
@@ -9,7 +9,7 @@ require Exporter;
 use Carp;
 use Symbol qw(gensym qualify);
 
-$VERSION	= 1.0104;
+$VERSION	= 1.0105;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open3);
 
@@ -52,6 +52,11 @@ failure: it just raises an exception matching C</^open3:/>.  However,
 C<exec> failures in the child are not detected.  You'll have to 
 trap SIGPIPE yourself.
 
+Note if you specify C<-> as the command, in an analogous fashion to
+C<open(FOO, "-|")> the child process will just be the forked Perl
+process rather than an external command.  This feature isn't yet
+supported on Win32 platforms.
+
 open3() does not wait for and reap the child process after it exits.  
 Except for short programs where it's acceptable to let the operating system
 take care of this, you need to do this yourself.  This is normally as 
@@ -88,8 +93,9 @@ The order of arguments differs from that of open2().
 # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
 # fixed for autovivving FHs, tchrist again
 # allow fd numbers to be used, by Frank Tobin
+# allow '-' as command (c.f. open "-|"), by Adam Spiers <perl@adamspiers.org>
 #
-# $Id: Open3.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
+# $Id: Open3.pm,v 1.7 2003/12/03 03:02:38 millert Exp $
 #
 # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
 #
@@ -226,6 +232,11 @@ sub _open3 {
 	} else {
 	    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
 	}
+	if ($cmd[0] eq '-') {
+	    croak "Arguments don't make sense when the command is '-'"
+	      if @cmd > 1;
+	    return 0;
+	}
 	local($")=(" ");
 	exec @cmd # XXX: wrong process to croak from
 	    or croak "$Me: exec of @cmd failed";
diff --git a/gnu/usr.bin/perl/lib/Locale/Maketext/test.pl b/gnu/usr.bin/perl/lib/Locale/Maketext/test.pl
deleted file mode 100644
index 1a29da359be..00000000000
--- a/gnu/usr.bin/perl/lib/Locale/Maketext/test.pl
+++ /dev/null
@@ -1,61 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-# Time-stamp: "2001-06-20 02:12:53 MDT"
-######################### We start with some black magic to print on failure.
-
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..5\n"; }
-END {print "fail 1\n" unless $loaded;}
-use Locale::Maketext 1.01;
-print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
-$loaded = 1;
-print "ok 1\n";
-{
-  package Woozle;
-  @ISA = ('Locale::Maketext');
-  sub dubbil   { return $_[1] * 2 }
-  sub numerate { return $_[2] . 'en' }
-}
-{
-  package Woozle::elx;
-  @ISA = ('Woozle');
-  %Lexicon = (
-   'd2' => 'hum [dubbil,_1]',
-   'd3' => 'hoo [quant,_1,zaz]',
-   'd4' => 'hoo [*,_1,zaz]',
-  );
-}
-
-$lh = Woozle->get_handle('elx');
-if($lh) {
-  print "ok 2\n";
-
-  my $x;
-
-  $x = $lh->maketext('d2', 7);
-  if($x eq "hum 14") {
-    print "ok 3\n";
-  } else {
-    print "fail 3 #  (got \"$x\")\n";
-  }
-
-  $x = $lh->maketext('d3', 7);
-  if($x eq "hoo 7 zazen") {
-    print "ok 4\n";
-  } else {
-    print "fail 4 #  (got \"$x\")\n";
-  }
-
-  $x = $lh->maketext('d4', 7);
-  if($x eq "hoo 7 zazen") {
-    print "ok 5\n";
-  } else {
-    print "fail 5 #  (got \"$x\")\n";
-  }
-
-  
-} else {
-  print "fail 2\n";
-}
-#Shazam!
diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm
index 5a1385d5193..c193b8b4671 100644
--- a/gnu/usr.bin/perl/lib/Math/BigInt.pm
+++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm
@@ -18,13 +18,14 @@ package Math::BigInt;
 my $class = "Math::BigInt";
 require 5.005;
 
-# This is a patched v1.60, containing a fix for the "1234567890\n" bug
-$VERSION = '1.60';
+$VERSION = '1.66';
 use Exporter;
 @ISA =       qw( Exporter );
 @EXPORT_OK = qw( objectify _swap bgcd blcm); 
 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
 use vars qw/$upgrade $downgrade/;
+# the following are internal and should never be accessed from the outside
+use vars qw/$_trap_nan $_trap_inf/;
 use strict;
 
 # Inside overload, the first arg is always an object. If the original code had
@@ -115,13 +116,8 @@ use overload
 ##############################################################################
 # global constants, flags and accessory
 
-use constant MB_NEVER_ROUND => 0x0001;
-
-my $NaNOK=1; 				# are NaNs ok?
-my $nan = 'NaN'; 			# constants for easier life
-
-my $CALC = 'Math::BigInt::Calc';	# module to do low level math
-my $IMPORT = 0;				# did import() yet?
+# these are public, but their usage is not recommended, use the accessor
+# methods instead
 
 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
 $accuracy   = undef;
@@ -131,6 +127,18 @@ $div_scale  = 40;
 $upgrade = undef;			# default is no upgrade
 $downgrade = undef;			# default is no downgrade
 
+# these are internally, and not to be used from the outside
+
+use constant MB_NEVER_ROUND => 0x0001;
+
+$_trap_nan = 0;				# are NaNs ok? set w/ config()
+$_trap_inf = 0;				# are infs ok? set w/ config()
+my $nan = 'NaN'; 			# constants for easier life
+
+my $CALC = 'Math::BigInt::Calc';	# module to do the low level math
+my $IMPORT = 0;				# was import() called yet?
+					# used to make require work
+
 ##############################################################################
 # the old code had $rnd_mode, so we need to support it, too
 
@@ -152,11 +160,13 @@ sub round_mode
   if (defined $_[0])
     {
     my $m = shift;
-    die "Unknown round mode $m"
-     if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+    if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+      {
+      require Carp; Carp::croak ("Unknown round mode '$m'");
+      }
     return ${"${class}::round_mode"} = $m;
     }
-  return ${"${class}::round_mode"};
+  ${"${class}::round_mode"};
   }
 
 sub upgrade
@@ -171,7 +181,7 @@ sub upgrade
     my $u = shift;
     return ${"${class}::upgrade"} = $u;
     }
-  return ${"${class}::upgrade"};
+  ${"${class}::upgrade"};
   }
 
 sub downgrade
@@ -186,21 +196,24 @@ sub downgrade
     my $u = shift;
     return ${"${class}::downgrade"} = $u;
     }
-  return ${"${class}::downgrade"};
+  ${"${class}::downgrade"};
   }
 
 sub div_scale
   {
   no strict 'refs';
-  # make Class->round_mode() work
+  # make Class->div_scale() work
   my $self = shift;
   my $class = ref($self) || $self || __PACKAGE__;
   if (defined $_[0])
     {
-    die ('div_scale must be greater than zero') if $_[0] < 0;
+    if ($_[0] < 0)
+      {
+      require Carp; Carp::croak ('div_scale must be greater than zero');
+      }
     ${"${class}::div_scale"} = shift;
     }
-  return ${"${class}::div_scale"};
+  ${"${class}::div_scale"};
   }
 
 sub accuracy
@@ -218,21 +231,39 @@ sub accuracy
   if (@_ > 0)
     {
     my $a = shift;
-    die ('accuracy must not be zero') if defined $a && $a == 0;
+    # convert objects to scalars to avoid deep recursion. If object doesn't
+    # have numify(), then hopefully it will have overloading for int() and
+    # boolean test without wandering into a deep recursion path...
+    $a = $a->numify() if ref($a) && $a->can('numify');
+
+    if (defined $a)
+      {
+      # also croak on non-numerical
+      if (!$a || $a <= 0)
+        {
+        require Carp;
+        Carp::croak ('Argument to accuracy must be greater than zero');
+        }
+      if (int($a) != $a)
+        {
+        require Carp; Carp::croak ('Argument to accuracy must be an integer');
+        }
+      }
     if (ref($x))
       {
       # $object->accuracy() or fallback to global
-      $x->bround($a) if defined $a;
-      $x->{_a} = $a;			# set/overwrite, even if not rounded
-      $x->{_p} = undef;			# clear P
+      $x->bround($a) if $a;             # not for undef, 0
+      $x->{_a} = $a;                    # set/overwrite, even if not rounded
+      $x->{_p} = undef;                 # clear P
+      $a = ${"${class}::accuracy"} unless defined $a;   # proper return value
       }
     else
       {
       # set global
       ${"${class}::accuracy"} = $a;
-      ${"${class}::precision"} = undef;	# clear P
+      ${"${class}::precision"} = undef; # clear P
       }
-    return $a;				# shortcut
+    return $a;                          # shortcut
     }
 
   my $r;
@@ -241,7 +272,7 @@ sub accuracy
   # but don't return global undef, when $x's accuracy is 0!
   $r = ${"${class}::accuracy"} if !defined $r;
   $r;
-  } 
+  }
 
 sub precision
   {
@@ -254,24 +285,32 @@ sub precision
   my $class = ref($x) || $x || __PACKAGE__;
 
   no strict 'refs';
-  # need to set new value?
   if (@_ > 0)
     {
     my $p = shift;
+    # convert objects to scalars to avoid deep recursion. If object doesn't
+    # have numify(), then hopefully it will have overloading for int() and
+    # boolean test without wandering into a deep recursion path...
+    $p = $p->numify() if ref($p) && $p->can('numify');
+    if ((defined $p) && (int($p) != $p))
+      {
+      require Carp; Carp::croak ('Argument to precision must be an integer');
+      }
     if (ref($x))
       {
       # $object->precision() or fallback to global
-      $x->bfround($p) if defined $p;
-      $x->{_p} = $p;			# set/overwrite, even if not rounded
-      $x->{_a} = undef;			# clear A
+      $x->bfround($p) if $p;            # not for undef, 0
+      $x->{_p} = $p;                    # set/overwrite, even if not rounded
+      $x->{_a} = undef;                 # clear A
+      $p = ${"${class}::precision"} unless defined $p;  # proper return value
       }
     else
       {
       # set global
       ${"${class}::precision"} = $p;
-      ${"${class}::accuracy"} = undef;	# clear A
+      ${"${class}::accuracy"} = undef;  # clear A
       }
-    return $p;				# shortcut
+    return $p;                          # shortcut
     }
 
   my $r;
@@ -280,24 +319,66 @@ sub precision
   # but don't return global undef, when $x's precision is 0!
   $r = ${"${class}::precision"} if !defined $r;
   $r;
-  } 
+  }
 
 sub config
   {
-  # return (later set?) configuration data as hash ref
+  # return (or set) configuration data as hash ref
   my $class = shift || 'Math::BigInt';
 
   no strict 'refs';
-  my $lib = $CALC;
+  if (@_ > 0)
+    {
+    # try to set given options as arguments from hash
+
+    my $args = $_[0];
+    if (ref($args) ne 'HASH')
+      {
+      $args = { @_ };
+      }
+    # these values can be "set"
+    my $set_args = {};
+    foreach my $key (
+     qw/trap_inf trap_nan
+        upgrade downgrade precision accuracy round_mode div_scale/
+     )
+      {
+      $set_args->{$key} = $args->{$key} if exists $args->{$key};
+      delete $args->{$key};
+      }
+    if (keys %$args > 0)
+      {
+      require Carp;
+      Carp::croak ("Illegal key(s) '",
+       join("','",keys %$args),"' passed to $class\->config()");
+      }
+    foreach my $key (keys %$set_args)
+      {
+      if ($key =~ /^trap_(inf|nan)\z/)
+        {
+        ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
+        next;
+        }
+      # use a call instead of just setting the $variable to check argument
+      $class->$key($set_args->{$key});
+      }
+    }
+
+  # now return actual configuration
+
   my $cfg = {
-    lib => $lib,
-    lib_version => ${"${lib}::VERSION"},
+    lib => $CALC,
+    lib_version => ${"${CALC}::VERSION"},
     class => $class,
+    trap_nan => ${"${class}::_trap_nan"},
+    trap_inf => ${"${class}::_trap_inf"},
+    version => ${"${class}::VERSION"},
     };
-  foreach (
-   qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
+  foreach my $key (qw/
+     upgrade downgrade precision accuracy round_mode div_scale
+     /)
     {
-    $cfg->{lc($_)} = ${"${class}::$_"};
+    $cfg->{$key} = ${"${class}::$key"};
     };
   $cfg;
   }
@@ -413,9 +494,13 @@ sub new
     my $ref = \$wanted;
     if ($wanted =~ /^[+-]/)
      {
-      # remove sign without touching wanted
+      # remove sign without touching wanted to make it work with constants
       my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
       }
+    # force to string version (otherwise Pari is unhappy about overflowed
+    # constants, for instance)
+    # not good, BigInt shouldn't need to know about alternative libs:
+    # $ref = \"$$ref" if $CALC eq 'Math::BigInt::Pari';
     $self->{value} = $CALC->_new($ref);
     no strict 'refs';
     if ( (defined $a) || (defined $p) 
@@ -439,8 +524,10 @@ sub new
   my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
   if (!ref $mis)
     {
-    die "$wanted is not a number initialized to $class" if !$NaNOK;
-    #print "NaN 1\n";
+    if ($_trap_nan)
+      {
+      require Carp; Carp::croak("$wanted is not a number in $class");
+      }
     $self->{value} = $CALC->_zero();
     $self->{sign} = $nan;
     return $self;
@@ -461,6 +548,10 @@ sub new
     my $diff = $e - CORE::length($$mfv);
     if ($diff < 0)				# Not integer
       {
+      if ($_trap_nan)
+        {
+        require Carp; Carp::croak("$wanted not an integer in $class");
+        }
       #print "NOI 1\n";
       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
       $self->{sign} = $nan;
@@ -468,7 +559,7 @@ sub new
     else					# diff >= 0
       {
       # adjust fraction and add it to value
-      # print "diff > 0 $$miv\n";
+      #print "diff > 0 $$miv\n";
       $$miv = $$miv . ($$mfv . '0' x $diff);
       }
     }
@@ -477,6 +568,10 @@ sub new
     if ($$mfv ne '')				# e <= 0
       {
       # fraction and negative/zero E => NOI
+      if ($_trap_nan)
+        {
+        require Carp; Carp::croak("$wanted not an integer in $class");
+        }
       #print "NOI 2 \$\$mfv '$$mfv'\n";
       return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
       $self->{sign} = $nan;
@@ -488,6 +583,10 @@ sub new
       $e = abs($e);
       if ($$miv !~ s/0{$e}$//)		# can strip so many zero's?
         {
+        if ($_trap_nan)
+          {
+          require Carp; Carp::croak("$wanted not an integer in $class");
+          }
         #print "NOI 3\n";
         return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
         $self->{sign} = $nan;
@@ -512,9 +611,14 @@ sub bnan
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  no strict 'refs';
+  if (${"${class}::_trap_nan"})
+    {
+    require Carp;
+    Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
+    }
   $self->import() if $IMPORT == 0;		# make require work
   return if $self->modify('bnan');
-  my $c = ref($self);
   if ($self->can('_bnan'))
     {
     # use subclass to initialize
@@ -541,9 +645,14 @@ sub binf
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  no strict 'refs';
+  if (${"${class}::_trap_inf"})
+    {
+    require Carp;
+    Carp::croak ("Tried to set $self to +-inf in $class\::binfn()");
+    }
   $self->import() if $IMPORT == 0;		# make require work
   return if $self->modify('binf');
-  my $c = ref($self);
   if ($self->can('_binf'))
     {
     # use subclass to initialize
@@ -572,7 +681,7 @@ sub bzero
     }
   $self->import() if $IMPORT == 0;		# make require work
   return if $self->modify('bzero');
-
+  
   if ($self->can('_bzero'))
     {
     # use subclass to initialize
@@ -609,7 +718,7 @@ sub bone
   my $self = shift;
   my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
   $self = $class if !defined $self;
- 
+
   if (!ref($self))
     {
     my $c = $self; $self = {}; bless $self, $c;
@@ -663,9 +772,7 @@ sub bsstr
     return 'inf';					# +inf
     }
   my ($m,$e) = $x->parts();
-  # e can only be positive
-  my $sign = 'e+';	
-  # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
+  my $sign = 'e+'; # e can only be positive
   return $m->bstr().$sign.$e->bstr();
   }
 
@@ -688,7 +795,8 @@ sub numify
   {
   # Make a "normal" scalar from a BigInt object
   my $x = shift; $x = $class->new($x) unless ref $x;
-  return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+
+  return $x->bstr() if $x->{sign} !~ /^[+-]$/;
   my $num = $CALC->_num($x->{value});
   return -$num if $x->{sign} eq '-';
   $num;
@@ -710,9 +818,14 @@ sub _find_round_parameters
   # After any operation or when calling round(), the result is rounded by
   # regarding the A & P from arguments, local parameters, or globals.
 
+  # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
+
   # This procedure finds the round parameters, but it is for speed reasons
   # duplicated in round. Otherwise, it is tested by the testsuite and used
   # by fdiv().
+ 
+  # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
+  # were requested/defined (locally or globally or both)
   
   my ($self,$a,$p,$r,@args) = @_;
   # $a accuracy, if given by caller
@@ -721,7 +834,7 @@ sub _find_round_parameters
   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 
   # leave bigfloat parts alone
-  return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+  return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
 
   my $c = ref($self);				# find out class of argument(s)
   no strict 'refs';
@@ -748,17 +861,23 @@ sub _find_round_parameters
   # if still none defined, use globals (#2)
   $a = ${"$c\::accuracy"} unless defined $a;
   $p = ${"$c\::precision"} unless defined $p;
+
+  # A == 0 is useless, so undef it to signal no rounding
+  $a = undef if defined $a && $a == 0;
  
   # no rounding today? 
   return ($self) unless defined $a || defined $p;		# early out
 
   # set A and set P is an fatal error
-  return ($self->bnan()) if defined $a && defined $p;
+  return ($self->bnan()) if defined $a && defined $p;		# error
 
   $r = ${"$c\::round_mode"} unless defined $r;
-  die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
- 
-  return ($self,$a,$p,$r);
+  if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+    {
+    require Carp; Carp::croak ("Unknown round mode '$r'");
+    }
+
+  ($self,$a,$p,$r);
   }
 
 sub round
@@ -775,7 +894,7 @@ sub round
   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 
   # leave bigfloat parts alone
-  return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+  return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
 
   my $c = ref($self);				# find out class of argument(s)
   no strict 'refs';
@@ -803,6 +922,9 @@ sub round
   $a = ${"$c\::accuracy"} unless defined $a;
   $p = ${"$c\::precision"} unless defined $p;
  
+  # A == 0 is useless, so undef it to signal no rounding
+  $a = undef if defined $a && $a == 0;
+  
   # no rounding today? 
   return $self unless defined $a || defined $p;		# early out
 
@@ -810,7 +932,10 @@ sub round
   return $self->bnan() if defined $a && defined $p;
 
   $r = ${"$c\::round_mode"} unless defined $r;
-  die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+  if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+    {
+   
+    }
 
   # now round, by calling either fround or ffround:
   if (defined $a)
@@ -871,6 +996,9 @@ sub bcmp
     ($self,$x,$y) = objectify(2,@_);
     }
 
+  return $upgrade->bcmp($x,$y) if defined $upgrade &&
+    ((!$x->isa($self)) || (!$y->isa($self)));
+
   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
     {
     # handle +-inf and NaN
@@ -913,6 +1041,9 @@ sub bacmp
     ($self,$x,$y) = objectify(2,@_);
     }
 
+  return $upgrade->bacmp($x,$y) if defined $upgrade &&
+    ((!$x->isa($self)) || (!$y->isa($self)));
+
   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
     {
     # handle +-inf and NaN
@@ -1079,7 +1210,7 @@ sub blog
   # not implemented yet
   my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  
-  return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
+  return $upgrade->blog($upgrade->new($x),$base,$a,$p,$r) if defined $upgrade;
 
   return $x->bnan();
   }
@@ -1192,7 +1323,7 @@ sub is_one
   # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
   my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
     
-  $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
+  $sign = '+' if !defined $sign || $sign ne '-';
  
   return 0 if $x->{sign} ne $sign; 	# -1 != +1, NaN, +-inf aren't either
   $CALC->_is_one($x->{value});
@@ -1356,44 +1487,14 @@ sub bdiv
   return $self->_div_inf($x,$y)
    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
 
-  return $upgrade->bdiv($upgrade->new($x),$y,@r)
-   if defined $upgrade && !$y->isa($self);
-
-  $r[3] = $y;					# no push!
-
-  # 0 / something
-  return
-   wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
- 
-  # Is $x in the interval [0, $y) (aka $x <= $y) ?
-  my $cmp = $CALC->_acmp($x->{value},$y->{value});
-  if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
-    {
-    return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
-     if defined $upgrade;
-
-    return $x->bzero()->round(@r) unless wantarray;
-    my $t = $x->copy();      # make copy first, because $x->bzero() clobbers $x
-    return ($x->bzero()->round(@r),$t);
-    }
-  elsif ($cmp == 0)
-    {
-    # shortcut, both are the same, so set to +/- 1
-    $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') ); 
-    return $x unless wantarray;
-    return ($x->round(@r),$self->bzero(@r));
-    }
   return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
    if defined $upgrade;
    
+  $r[3] = $y;					# no push!
+
   # calc new sign and in case $y == +/- 1, return $x
   my $xsign = $x->{sign};				# keep
   $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+'); 
-  # check for / +-1 (cant use $y->is_one due to '-'
-  if ($CALC->_is_one($y->{value}))
-    {
-    return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r); 
-    }
 
   if (wantarray)
     {
@@ -1402,23 +1503,24 @@ sub bdiv
     $x->{sign} = '+' if $CALC->_is_zero($x->{value});
     $rem->{_a} = $x->{_a};
     $rem->{_p} = $x->{_p};
-    $x->round(@r); 
+    $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
     if (! $CALC->_is_zero($rem->{value}))
       {
       $rem->{sign} = $y->{sign};
-      $rem = $y-$rem if $xsign ne $y->{sign};	# one of them '-'
+      $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
       }
     else
       {
       $rem->{sign} = '+';			# dont leave -0
       }
-    return ($x,$rem->round(@r));
+    $rem->round(@r) if !exists $rem->{_f} || ($rem->{_f} & MB_NEVER_ROUND) == 0;
+    return ($x,$rem);
     }
 
   $x->{value} = $CALC->_div($x->{value},$y->{value});
   $x->{sign} = '+' if $CALC->_is_zero($x->{value});
 
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+  $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
   $x;
   }
 
@@ -1481,25 +1583,25 @@ sub bmod
 
 sub bmodinv
   {
-  # modular inverse.  given a number which is (hopefully) relatively
+  # Modular inverse.  given a number which is (hopefully) relatively
   # prime to the modulus, calculate its inverse using Euclid's
-  # alogrithm.  if the number is not relatively prime to the modulus
+  # alogrithm.  If the number is not relatively prime to the modulus
   # (i.e. their gcd is not one) then NaN is returned.
 
   # set up parameters
   my ($self,$x,$y,@r) = (ref($_[0]),@_);
-  # objectify is costly, so avoid it 
+  # objectify is costly, so avoid it
   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
     {
     ($self,$x,$y,@r) = objectify(2,@_);
-    } 
+    }
 
   return $x if $x->modify('bmodinv');
 
   return $x->bnan()
-	if ($y->{sign} ne '+'				# -, NaN, +inf, -inf
-         || $x->is_zero()				# or num == 0
-	 || $x->{sign} !~ /^[+-]$/			# or num NaN, inf, -inf
+        if ($y->{sign} ne '+'                           # -, NaN, +inf, -inf
+         || $x->is_zero()                               # or num == 0
+         || $x->{sign} !~ /^[+-]$/                      # or num NaN, inf, -inf
         );
 
   # put least residue into $x if $x was negative, and thus make it positive
@@ -1507,11 +1609,14 @@ sub bmodinv
 
   if ($CALC->can('_modinv'))
     {
-    $x->{value} = $CALC->_modinv($x->{value},$y->{value});
-    $x->bnan() if !defined $x->{value} ;            # in case there was none
+    my $sign;
+    ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
+    $x->bnan() if !defined $x->{value};                 # in case no GCD found
+    return $x if !defined $sign;                        # already real result
+    $x->{sign} = $sign;                                 # flip/flop see below
+    $x->bmod($y);                                       # calc real result
     return $x;
     }
-
   my ($u, $u1) = ($self->bzero(), $self->bone());
   my ($a, $b) = ($y->copy(), $x->copy());
 
@@ -1521,21 +1626,37 @@ sub bmodinv
   # a case with 28 loops still gains about 3% with this layout.
   my $q;
   ($a, $q, $b) = ($b, $a->bdiv($b));                    # step #1
-  # Euclid's Algorithm
-  while (!$b->is_zero())
+  # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
+  # two values in $u and $u1, we use only $u1 afterwards)
+  my $sign = 1;                                         # flip-flop
+  while (!$b->is_zero())                                # found GCD if $b == 0
     {
-    ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
+    # the original algorithm had:
+    # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
+    # The following creates exact the same sequence of numbers in $u1,
+    # except for the sign ($u1 is now always positive). Since formerly
+    # the sign of $u1 was alternating between '-' and '+', the $sign
+    # flip-flop will take care of that, so that at the end of the loop
+    # we have the real sign of $u1. Keeping numbers positive gains us
+    # speed since badd() is faster than bsub() and makes it possible
+    # to have the algorithmn in Calc for even more speed.
+
+    ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
+    $sign = - $sign;                                    # flip sign
+
     ($a, $q, $b) = ($b, $a->bdiv($b));                  # step #1 again
     }
 
-  # if the gcd is not 1, then return NaN!  It would be pointless to
-  # have called bgcd to check this first, because we would then be performing
-  # the same Euclidean Algorithm *twice*
+  # If the gcd is not 1, then return NaN! It would be pointless to
+  # have called bgcd to check this first, because we would then be
+  # performing the same Euclidean Algorithm *twice*.
   return $x->bnan() unless $a->is_one();
 
-  $u1->bmod($y);
-  $x->{value} = $u1->{value};
-  $x->{sign} = $u1->{sign};
+  $u1->bneg() if $sign != 1;                            # need to flip?
+
+  $u1->bmod($y);                                        # calc result
+  $x->{value} = $u1->{value};                           # and copy over to $x
+  $x->{sign} = $u1->{sign};                             # to modify in place
   $x;
   }
 
@@ -1581,7 +1702,7 @@ sub bmodpow
   $num->bone(); # keep ref to $num
 
   my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
-  my $len = length($expbin);
+  my $len = CORE::length($expbin);
   while (--$len >= 0)
     {
     if( substr($expbin,$len,1) eq '1')
@@ -1630,7 +1751,7 @@ sub bpow
   # (BINT or num_str, BINT or num_str) return BINT
   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
   # modifies first argument
-  
+
   # set up parameters
   my ($self,$x,$y,@r) = (ref($_[0]),@_);
   # objectify is costly, so avoid it
@@ -1686,7 +1807,7 @@ sub bpow
 
   my $pow2 = $self->__one();
   my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
-  my $len = length($y_bin);
+  my $len = CORE::length($y_bin);
   while (--$len > 0)
     {
     $pow2->bmul($x) if substr($y_bin,$len,1) eq '1';	# is odd?
@@ -1984,13 +2105,14 @@ sub _trailing_zeros
 
 sub bsqrt
   {
+  # calculate square root of $x
   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   return $x if $x->modify('bsqrt');
 
-  return $x->bnan() if $x->{sign} ne '+';	# -x or inf or NaN => NaN
-  return $x->bzero(@r) if $x->is_zero();			# 0 => 0
-  return $x->round(@r) if $x->is_one();			# 1 => 1
+  return $x->bnan() if $x->{sign} !~ /^\+/;	# -x or -inf or NaN => NaN
+  return $x if $x->{sign} eq '+inf';		# sqrt(+inf) == inf
+  return $x->round(@r) if $x->is_zero() || $x->is_one();	# 0,1 => 0,1
 
   return $upgrade->bsqrt($x,@r) if defined $upgrade;
 
@@ -2005,21 +2127,98 @@ sub bsqrt
   my $l = int($x->length()/2);
   
   $x->bone();					# keep ref($x), but modify it
-  $x->blsft($l,10);
+  $x->blsft($l,10) if $l != 0;			# first guess: 1.('0' x (l/2))
 
   my $last = $self->bzero();
   my $two = $self->new(2);
-  my $lastlast = $x+$two;
+  my $lastlast = $self->bzero();
+  #my $lastlast = $x+$two;
   while ($last != $x && $lastlast != $x)
     {
-    $lastlast = $last; $last = $x; 
-    $x += $y / $x; 
-    $x /= $two;
+    $lastlast = $last; $last = $x->copy(); 
+    $x->badd($y / $x); 
+    $x->bdiv($two);
     }
-  $x-- if $x * $x > $y;				# overshot?
+  $x->bdec() if $x * $x > $y;				# overshot?
   $x->round(@r);
   }
 
+sub broot
+  {
+  # calculate $y'th root of $x
+ 
+  # set up parameters
+  my ($self,$x,$y,@r) = (ref($_[0]),@_);
+
+  $y = $self->new(2) unless defined $y;
+
+  # objectify is costly, so avoid it
+  if ((!ref($x)) || (ref($x) ne ref($y)))
+    {
+    ($self,$x,$y,@r) = $self->objectify(2,@_);
+    }
+
+  return $x if $x->modify('broot');
+
+  # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
+  return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
+         $y->{sign} !~ /^\+$/;
+
+  return $x->round(@r)
+    if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
+
+  return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
+
+  if ($CALC->can('_root'))
+    {
+    $x->{value} = $CALC->_root($x->{value},$y->{value});
+    return $x->round(@r);
+    }
+
+  return $x->bsqrt() if $y->bacmp(2) == 0;	# 2 => square root
+
+  # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
+  return $x->bone('+',@r) if $x < 8;		# $x=2..7 => 1
+
+  my $num = $x->numify();
+
+  if ($num <= 1000000)
+    {
+    $x = $self->new( int($num ** (1 / $y->numify()) ));
+    return $x->round(@r);
+    }
+
+  # if $n is a power of two, we can repeatedly take sqrt($X) and find the
+  # proper result, because sqrt(sqrt($x)) == root($x,4)
+  # See Calc.pm for more details
+  my $b = $y->as_bin();
+  if ($b =~ /0b1(0+)/)
+    {
+    my $count = CORE::length($1);	# 0b100 => len('00') => 2
+    my $cnt = $count;			# counter for loop
+    my $shift = $self->new(6);
+    $x->blsft($shift);			# add some zeros (even amount)
+    while ($cnt-- > 0)
+      {
+      # 'inflate' $X by adding more zeros
+      $x->blsft($shift);
+      # calculate sqrt($x), $x is now a bit too big, again. In the next
+      # round we make even bigger, again.
+      $x->bsqrt($x);
+      }
+    # $x is still to big, so truncate result
+    $x->brsft($shift);
+    }
+  else
+    {
+    # Should compute a guess of the result (by rule of thumb), then improve it
+    # via Newton's method or something similiar.
+    # XXX TODO
+    warn ('broot() not fully implemented in BigInt.');
+    }
+  return $x->round(@r);
+  }
+
 sub exponent
   {
   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
@@ -2133,6 +2332,11 @@ sub bround
 
   # we have fewer digits than we want to scale to
   my $len = $x->length();
+  # convert $scale to a scalar in case it is an object (put's a limit on the
+  # number length, but this would already limited by memory constraints), makes
+  # it faster
+  $scale = $scale->numify() if ref ($scale);
+
   # scale < 0, but > -len (not >=!)
   if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
     {
@@ -2149,7 +2353,7 @@ sub bround
 
   my $xs = $CALC->_str($x->{value});
   my $pl = -$pad-1;
- 
+
   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
   $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
@@ -2187,7 +2391,7 @@ sub bround
   if ($round_up)					# what gave test above?
     {
     $put_back = 1;
-    $pad = $len, $$xs = '0'x$pad if $scale < 0;		# tlr: whack 0.51=>1.0	
+    $pad = $len, $$xs = '0' x $pad if $scale < 0;	# tlr: whack 0.51=>1.0	
 
     # we modify directly the string variant instead of creating a number and
     # adding it, since that is faster (we already have the string)
@@ -2321,7 +2525,7 @@ sub objectify
     }
 
   my $up = ${"$a[0]::upgrade"};
-  # print "Now in objectify, my class is today $a[0]\n";
+  #print "Now in objectify, my class is today $a[0], count = $count\n";
   if ($count == 0)
     {
     while (@_)
@@ -2358,7 +2562,10 @@ sub objectify
       }
     push @a,@_;		# return other params, too
     }
-  die "$class objectify needs list context" unless wantarray;
+  if (! wantarray)
+    {
+    require Carp; Carp::croak ("$class objectify needs list context");
+    }
   ${"$a[0]::downgrade"} = $d;
   @a;
   }
@@ -2424,7 +2631,11 @@ sub import
       }
     $CALC = $lib, last if $@ eq '';	# no error in loading lib?
     }
-  die "Couldn't load any math lib, not even the default" if $CALC eq '';
+  if ($CALC eq '')
+    {
+    require Carp;
+    Carp::croak ("Couldn't load any math lib, not even the default");
+    }
   }
 
 sub __from_hex
@@ -2542,12 +2753,14 @@ sub _split
 
   # some possible inputs: 
   # 2.1234 # 0.12        # 1 	      # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2 
-  # .2 	   # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2
+  # .2 	   # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2     # 0e999	
 
-  return if $$x =~ /[Ee].*[Ee]/;	# more than one E => error
+  #return if $$x =~ /[Ee].*[Ee]/;	# more than one E => error
 
-  my ($m,$e) = split /[Ee]/,$$x;
+  my ($m,$e,$last) = split /[Ee]/,$$x;
+  return if defined $last;		# last defined => 1e2E3 or others
   $e = '0' if !defined $e || $e eq "";
+
   # sign,value for exponent,mantint,mantfrac
   my ($es,$ev,$mis,$miv,$mfv);
   # valid exponent?
@@ -2556,8 +2769,8 @@ sub _split
     $es = $1; $ev = $2;
     # valid mantissa?
     return if $m eq '.' || $m eq '';
-    my ($mi,$mf,$last) = split /\./,$m;
-    return if defined $last;		# last defined => 1.2.3 or others
+    my ($mi,$mf,$lastf) = split /\./,$m;
+    return if defined $lastf;		# last defined => 1.2.3 or others
     $mi = '0' if !defined $mi;
     $mi .= '0' if $mi =~ /^[\-\+]?$/;
     $mf = '0' if !defined $mf || $mf eq '';
@@ -2566,6 +2779,8 @@ sub _split
       $mis = $1||'+'; $miv = $2;
       return unless ($mf =~ /^(\d*?)0*$/);	# strip trailing zeros
       $mfv = $1;
+      # handle the 0e999 case here
+      $ev = 0 if $miv eq '0' && $mfv eq '';
       return (\$mis,\$miv,\$mfv,\$es,\$ev);
       }
     }
@@ -2588,7 +2803,6 @@ sub as_hex
   my $x = shift; $x = $class->new($x) if !ref($x);
 
   return $x->bstr() if $x->{sign} !~ /^[+-]$/;	# inf, nan etc
-  return '0x0' if $x->is_zero();
 
   my $es = ''; my $s = '';
   $s = $x->{sign} if $x->{sign} eq '-';
@@ -2598,6 +2812,8 @@ sub as_hex
     }
   else
     {
+    return '0x0' if $x->is_zero();
+
     my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
     if ($] >= 5.006)
       {
@@ -2625,7 +2841,6 @@ sub as_bin
   my $x = shift; $x = $class->new($x) if !ref($x);
 
   return $x->bstr() if $x->{sign} !~ /^[+-]$/;	# inf, nan etc
-  return '0b0' if $x->is_zero();
 
   my $es = ''; my $s = '';
   $s = $x->{sign} if $x->{sign} eq '-';
@@ -2635,6 +2850,7 @@ sub as_bin
     }
   else
     {
+    return '0b0' if $x->is_zero();
     my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
     if ($] >= 5.006)
       {
@@ -2704,6 +2920,12 @@ Math::BigInt - Arbitrary size integer math package
 
   use Math::BigInt;
 
+  # or make it faster: install (optional) Math::BigInt::GMP
+  # and always use (it will fall back to pure Perl if the
+  # GMP library is not installed):
+
+  use Math::BigInt lib => 'GMP';
+
   # Number creation	
   $x = Math::BigInt->new($str);		# defaults to 0
   $nan  = Math::BigInt->bnan(); 	# create a NotANumber
@@ -2713,104 +2935,112 @@ Math::BigInt - Arbitrary size integer math package
   $one = Math::BigInt->bone();		# create a +1
   $one = Math::BigInt->bone('-');	# create a -1
 
-  # Testing
-  $x->is_zero();		# true if arg is +0
-  $x->is_nan();			# true if arg is NaN
-  $x->is_one();			# true if arg is +1
-  $x->is_one('-');		# true if arg is -1
-  $x->is_odd();			# true if odd, false for even
-  $x->is_even();		# true if even, false for odd
-  $x->is_positive();		# true if >= 0
-  $x->is_negative();		# true if <  0
-  $x->is_inf(sign);		# true if +inf, or -inf (sign is default '+')
-  $x->is_int();			# true if $x is an integer (not a float)
-
-  $x->bcmp($y);			# compare numbers (undef,<0,=0,>0)
-  $x->bacmp($y);		# compare absolutely (undef,<0,=0,>0)
-  $x->sign();			# return the sign, either +,- or NaN
-  $x->digit($n);		# return the nth digit, counting from right
-  $x->digit(-$n);		# return the nth digit, counting from left
-
-  # The following all modify their first argument:
-
-  # set 
-  $x->bzero();			# set $x to 0
-  $x->bnan();			# set $x to NaN
-  $x->bone();			# set $x to +1
-  $x->bone('-');		# set $x to -1
-  $x->binf();			# set $x to inf
-  $x->binf('-');		# set $x to -inf
-
-  $x->bneg();			# negation
-  $x->babs();			# absolute value
-  $x->bnorm();			# normalize (no-op)
-  $x->bnot();			# two's complement (bit wise not)
-  $x->binc();			# increment x by 1
-  $x->bdec();			# decrement x by 1
+  # Testing (don't modify their arguments)
+  # (return true if the condition is met, otherwise false)
+
+  $x->is_zero();	# if $x is +0
+  $x->is_nan();		# if $x is NaN
+  $x->is_one();		# if $x is +1
+  $x->is_one('-');	# if $x is -1
+  $x->is_odd();		# if $x is odd
+  $x->is_even();	# if $x is even
+  $x->is_positive();	# if $x >= 0
+  $x->is_negative();	# if $x <  0
+  $x->is_inf(sign);	# if $x is +inf, or -inf (sign is default '+')
+  $x->is_int();		# if $x is an integer (not a float)
+
+  # comparing and digit/sign extration
+  $x->bcmp($y);		# compare numbers (undef,<0,=0,>0)
+  $x->bacmp($y);	# compare absolutely (undef,<0,=0,>0)
+  $x->sign();		# return the sign, either +,- or NaN
+  $x->digit($n);	# return the nth digit, counting from right
+  $x->digit(-$n);	# return the nth digit, counting from left
+
+  # The following all modify their first argument. If you want to preserve
+  # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
+  # neccessary when mixing $a = $b assigments with non-overloaded math.
+
+  $x->bzero();		# set $x to 0
+  $x->bnan();		# set $x to NaN
+  $x->bone();		# set $x to +1
+  $x->bone('-');	# set $x to -1
+  $x->binf();		# set $x to inf
+  $x->binf('-');	# set $x to -inf
+
+  $x->bneg();		# negation
+  $x->babs();		# absolute value
+  $x->bnorm();		# normalize (no-op in BigInt)
+  $x->bnot();		# two's complement (bit wise not)
+  $x->binc();		# increment $x by 1
+  $x->bdec();		# decrement $x by 1
   
-  $x->badd($y);			# addition (add $y to $x)
-  $x->bsub($y);			# subtraction (subtract $y from $x)
-  $x->bmul($y);			# multiplication (multiply $x by $y)
-  $x->bdiv($y);			# divide, set $x to quotient
-				# return (quo,rem) or quo if scalar
-
-  $x->bmod($y);			# modulus (x % y)
-  $x->bmodpow($exp,$mod);	# modular exponentation (($num**$exp) % $mod))
-  $x->bmodinv($mod);		# the inverse of $x in the given modulus $mod
-
-  $x->bpow($y);			# power of arguments (x ** y)
-  $x->blsft($y);		# left shift
-  $x->brsft($y);		# right shift 
-  $x->blsft($y,$n);		# left shift, by base $n (like 10)
-  $x->brsft($y,$n);		# right shift, by base $n (like 10)
+  $x->badd($y);		# addition (add $y to $x)
+  $x->bsub($y);		# subtraction (subtract $y from $x)
+  $x->bmul($y);		# multiplication (multiply $x by $y)
+  $x->bdiv($y);		# divide, set $x to quotient
+			# return (quo,rem) or quo if scalar
+
+  $x->bmod($y);		   # modulus (x % y)
+  $x->bmodpow($exp,$mod);  # modular exponentation (($num**$exp) % $mod))
+  $x->bmodinv($mod);	   # the inverse of $x in the given modulus $mod
+
+  $x->bpow($y);		   # power of arguments (x ** y)
+  $x->blsft($y);	   # left shift
+  $x->brsft($y);	   # right shift 
+  $x->blsft($y,$n);	   # left shift, by base $n (like 10)
+  $x->brsft($y,$n);	   # right shift, by base $n (like 10)
   
-  $x->band($y);			# bitwise and
-  $x->bior($y);			# bitwise inclusive or
-  $x->bxor($y);			# bitwise exclusive or
-  $x->bnot();			# bitwise not (two's complement)
+  $x->band($y);		   # bitwise and
+  $x->bior($y);		   # bitwise inclusive or
+  $x->bxor($y);		   # bitwise exclusive or
+  $x->bnot();		   # bitwise not (two's complement)
+
+  $x->bsqrt();		   # calculate square-root
+  $x->broot($y);	   # $y'th root of $x (e.g. $y == 3 => cubic root)
+  $x->bfac();		   # factorial of $x (1*2*3*4*..$x)
 
-  $x->bsqrt();			# calculate square-root
-  $x->bfac();			# factorial of $x (1*2*3*4*..$x)
+  $x->round($A,$P,$mode);  # round to accuracy or precision using mode $mode
+  $x->bround($N);          # accuracy: preserve $N digits
+  $x->bfround($N);         # round to $Nth digit, no-op for BigInts
 
-  $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
-  $x->bround($N);               # accuracy: preserve $N digits
-  $x->bfround($N);              # round to $Nth digit, no-op for BigInts
+  # The following do not modify their arguments in BigInt (are no-ops),
+  # but do so in BigFloat:
 
-  # The following do not modify their arguments in BigInt, but do in BigFloat:
-  $x->bfloor();			# return integer less or equal than $x
-  $x->bceil();			# return integer greater or equal than $x
+  $x->bfloor();		   # return integer less or equal than $x
+  $x->bceil();		   # return integer greater or equal than $x
   
   # The following do not modify their arguments:
 
-  bgcd(@values);		# greatest common divisor (no OO style)
-  blcm(@values);		# lowest common multiplicator (no OO style)
+  bgcd(@values);	   # greatest common divisor (no OO style)
+  blcm(@values);	   # lowest common multiplicator (no OO style)
  
-  $x->length();			# return number of digits in number
-  ($x,$f) = $x->length();	# length of number and length of fraction part,
-				# latter is always 0 digits long for BigInt's
-
-  $x->exponent();		# return exponent as BigInt
-  $x->mantissa();		# return (signed) mantissa as BigInt
-  $x->parts();			# return (mantissa,exponent) as BigInt
-  $x->copy();			# make a true copy of $x (unlike $y = $x;)
-  $x->as_number();		# return as BigInt (in BigInt: same as copy())
+  $x->length();		   # return number of digits in number
+  ($x,$f) = $x->length();  # length of number and length of fraction part,
+			   # latter is always 0 digits long for BigInt's
+
+  $x->exponent();	   # return exponent as BigInt
+  $x->mantissa();	   # return (signed) mantissa as BigInt
+  $x->parts();		   # return (mantissa,exponent) as BigInt
+  $x->copy();		   # make a true copy of $x (unlike $y = $x;)
+  $x->as_number();	   # return as BigInt (in BigInt: same as copy())
   
-  # conversation to string 
-  $x->bstr();			# normalized string
-  $x->bsstr();			# normalized string in scientific notation
-  $x->as_hex();			# as signed hexadecimal string with prefixed 0x
-  $x->as_bin();			# as signed binary string with prefixed 0b
+  # conversation to string (do not modify their argument)
+  $x->bstr();		   # normalized string
+  $x->bsstr();		   # normalized string in scientific notation
+  $x->as_hex();		   # as signed hexadecimal string with prefixed 0x
+  $x->as_bin();		   # as signed binary string with prefixed 0b
   
-  Math::BigInt->config();	# return hash containing configuration/version
 
   # precision and accuracy (see section about rounding for more)
-  $x->precision();              # return P of $x (or global, if P of $x undef)
-  $x->precision($n);            # set P of $x to $n
-  $x->accuracy();               # return A of $x (or global, if A of $x undef)
-  $x->accuracy($n);             # set A $x to $n
+  $x->precision();	   # return P of $x (or global, if P of $x undef)
+  $x->precision($n);	   # set P of $x to $n
+  $x->accuracy();	   # return A of $x (or global, if A of $x undef)
+  $x->accuracy($n);	   # set A $x to $n
 
-  Math::BigInt->precision();	# get/set global P for all BigInt objects
-  Math::BigInt->accuracy();	# get/set global A for all BigInt objects
+  # Global methods
+  Math::BigInt->precision(); # get/set global P for all BigInt objects
+  Math::BigInt->accuracy();  # get/set global A for all BigInt objects
+  Math::BigInt->config();    # return hash containing configuration
 
 =head1 DESCRIPTION
 
@@ -2824,34 +3054,29 @@ exactly what you expect.
 
 =over 2
 
-=item Canonical notation
-
-Big integer values are strings of the form C</^[+-]\d+$/> with leading
-zeros suppressed.
+=item Input
 
-   '-0'                            canonical value '-0', normalized '0'
-   '   -123_123_123'               canonical value '-123123123'
-   '1_23_456_7890'                 canonical value '1234567890'
+Input values to these routines may be any string, that looks like a number
+and results in an integer, including hexadecimal and binary numbers.
 
-=item Input
+Scalars holding numbers may also be passed, but note that non-integer numbers
+may already have lost precision due to the conversation to float. Quote
+your input if you want BigInt to see all the digits.
 
-Input values to these routines may be either Math::BigInt objects or
-strings of the form C</^[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
+	$x = Math::BigInt->new(12345678890123456789);	# bad
+	$x = Math::BigInt->new('12345678901234567890');	# good
 
-You can include one underscore between any two digits. The input string may
-have leading and trailing whitespace, which will be ignored. In later
-versions, a more strict (no whitespace at all) or more lax (whitespace
-allowed everywhere) input checking will also be possible.
+You can include one underscore between any two digits.
 
 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
-Non integer values result in NaN.
+Non-integer values result in NaN.
 
-Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
-in 'NaN'.
+Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
+results in 'NaN'.
 
-bnorm() on a BigInt object is now effectively a no-op, since the numbers 
+C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers 
 are always stored in normalized form. On a string, it creates a BigInt 
-object.
+object from the input.
 
 =item Output
 
@@ -2865,27 +3090,66 @@ return either undef, <0, 0 or >0 and are suited for sort.
 
 =head1 METHODS
 
-Each of the methods below accepts three additional parameters. These arguments
-$A, $P and $R are accuracy, precision and round_mode. Please see more in the
-section about ACCURACY and ROUNDIND.
+Each of the methods below (except config(), accuracy() and precision())
+accepts three additional parameters. These arguments $A, $P and $R are
+accuracy, precision and round_mode. Please see the section about
+L<ACCURACY and PRECISION> for more information.
 
 =head2 config
 
 	use Data::Dumper;
 
 	print Dumper ( Math::BigInt->config() );
+	print Math::BigInt->config()->{lib},"\n";
 
 Returns a hash containing the configuration, e.g. the version number, lib
-loaded etc.
+loaded etc. The following hash keys are currently filled in with the
+appropriate information.
+
+	key		Description
+			Example
+	============================================================
+	lib		Name of the Math library
+			Math::BigInt::Calc
+	lib_version 	Version of 'lib'
+			0.30
+	class		The class of config you just called
+			Math::BigInt
+	upgrade		To which class numbers are upgraded
+			Math::BigFloat
+	downgrade	To which class numbers are downgraded
+			undef
+	precision	Global precision
+			undef
+	accuracy	Global accuracy
+			undef
+	round_mode	Global round mode
+			even
+	version		version number of the class you used
+			1.61
+	div_scale	Fallback acccuracy for div
+			40
+
+The following values can be set by passing C<config()> a reference to a hash:
+
+	trap_inf trap_nan
+        upgrade downgrade precision accuracy round_mode div_scale
+
+Example:
+	
+	$new_cfg = Math::BigInt->config( { trap_inf => 1, precision => 5 } );
 
 =head2 accuracy
 
 	$x->accuracy(5);		# local for $x
-	$class->accuracy(5);		# global for all members of $class
+	CLASS->accuracy(5);		# global for all members of CLASS
+	$A = $x->accuracy();		# read out
+	$A = CLASS->accuracy();		# read out
 
 Set or get the global or local accuracy, aka how many significant digits the
-results have. Please see the section about L<ACCURACY AND PRECISION> for
-further details.
+results have. 
+
+Please see the section about L<ACCURACY AND PRECISION> for further details.
 
 Value must be greater than zero. Pass an undef value to disable it:
 
@@ -2906,6 +3170,45 @@ represents the accuracy that will be in effect for $x:
 	print $x->accuracy(),"\n";		# still 4
 	print $y->accuracy(),"\n";		# 5, since global is 5
 
+Note: Works also for subclasses like Math::BigFloat. Each class has it's own
+globals separated from Math::BigInt, but it is possible to subclass
+Math::BigInt and make the globals of the subclass aliases to the ones from
+Math::BigInt.
+
+=head2 precision
+
+	$x->precision(-2);		# local for $x, round right of the dot
+	$x->precision(2);		# ditto, but round left of the dot
+	CLASS->accuracy(5);		# global for all members of CLASS
+	CLASS->precision(-5);		# ditto
+	$P = CLASS->precision();	# read out
+	$P = $x->precision();		# read out
+
+Set or get the global or local precision, aka how many digits the result has
+after the dot (or where to round it when passing a positive number). In
+Math::BigInt, passing a negative number precision has no effect since no
+numbers have digits after the dot.
+
+Please see the section about L<ACCURACY AND PRECISION> for further details.
+
+Value must be greater than zero. Pass an undef value to disable it:
+
+	$x->precision(undef);
+	Math::BigInt->precision(undef);
+
+Returns the current precision. For C<$x->precision()> it will return either the
+local precision of $x, or if not defined, the global. This means the return
+value represents the accuracy that will be in effect for $x:
+
+	$y = Math::BigInt->new(1234567);	# unrounded
+	print Math::BigInt->precision(4),"\n";	# set 4, print 4
+	$x = Math::BigInt->new(123456);		# will be automatically rounded
+
+Note: Works also for subclasses like Math::BigFloat. Each class has it's own
+globals separated from Math::BigInt, but it is possible to subclass
+Math::BigInt and make the globals of the subclass aliases to the ones from
+Math::BigInt.
+
 =head2 brsft
 
 	$x->brsft($y,$n);		
@@ -2935,10 +3238,12 @@ result).
 
   	$x = Math::BigInt->new($str,$A,$P,$R);
 
-Creates a new BigInt object from a string or another BigInt object. The
+Creates a new BigInt object from a scalar or another BigInt object. The
 input is accepted as decimal, hex (with leading '0x') or binary (with leading
 '0b').
 
+See L<Input> for more info on accepted input formats.
+
 =head2 bnan
 
   	$x = Math::BigInt->bnan();
@@ -3015,6 +3320,8 @@ These methods are only testing the sign, and not the value.
 The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
 C<-inf> are not integers and are neither odd nor even.
 
+In BigInt, all numbers except C<NaN>, C<+inf> and C<-inf> are integers.
+
 =head2 bcmp
 
 	$x->bcmp($y);
@@ -3055,44 +3362,44 @@ numbers.
 
 =head2 bnorm
 
-  $x->bnorm();			# normalize (no-op)
+	$x->bnorm();			# normalize (no-op)
 
 =head2 bnot
 
-  $x->bnot();			# two's complement (bit wise not)
+	$x->bnot();			# two's complement (bit wise not)
 
 =head2 binc
 
-  $x->binc();			# increment x by 1
+	$x->binc();			# increment x by 1
 
 =head2 bdec
 
-  $x->bdec();			# decrement x by 1
+	$x->bdec();			# decrement x by 1
 
 =head2 badd
 
-  $x->badd($y);			# addition (add $y to $x)
+	$x->badd($y);			# addition (add $y to $x)
 
 =head2 bsub
 
-  $x->bsub($y);			# subtraction (subtract $y from $x)
+	$x->bsub($y);			# subtraction (subtract $y from $x)
 
 =head2 bmul
 
-  $x->bmul($y);			# multiplication (multiply $x by $y)
+	$x->bmul($y);			# multiplication (multiply $x by $y)
 
 =head2 bdiv
 
-  $x->bdiv($y);			# divide, set $x to quotient
-				# return (quo,rem) or quo if scalar
+	$x->bdiv($y);			# divide, set $x to quotient
+					# return (quo,rem) or quo if scalar
 
 =head2 bmod
 
-  $x->bmod($y);			# modulus (x % y)
+	$x->bmod($y);			# modulus (x % y)
 
 =head2 bmodinv
 
-  $num->bmodinv($mod);		# modular inverse
+	num->bmodinv($mod);		# modular inverse
 
 Returns the inverse of C<$num> in the given modulus C<$mod>.  'C<NaN>' is
 returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
@@ -3100,74 +3407,78 @@ C<bgcd($num, $mod)==1>.
 
 =head2 bmodpow
 
-  $num->bmodpow($exp,$mod);	# modular exponentation ($num**$exp % $mod)
+	$num->bmodpow($exp,$mod);	# modular exponentation
+					# ($num**$exp % $mod)
 
 Returns the value of C<$num> taken to the power C<$exp> in the modulus
 C<$mod> using binary exponentation.  C<bmodpow> is far superior to
 writing
 
-  $num ** $exp % $mod
+	$num ** $exp % $mod
 
 because C<bmodpow> is much faster--it reduces internal variables into
 the modulus whenever possible, so it operates on smaller numbers.
 
 C<bmodpow> also supports negative exponents.
 
-  bmodpow($num, -1, $mod)
+	bmodpow($num, -1, $mod)
 
 is exactly equivalent to
 
-  bmodinv($num, $mod)
+	bmodinv($num, $mod)
 
 =head2 bpow
 
-  $x->bpow($y);			# power of arguments (x ** y)
+	$x->bpow($y);			# power of arguments (x ** y)
 
 =head2 blsft
 
-  $x->blsft($y);		# left shift
-  $x->blsft($y,$n);		# left shift, by base $n (like 10)
+	$x->blsft($y);		# left shift
+	$x->blsft($y,$n);	# left shift, in base $n (like 10)
 
 =head2 brsft
 
-  $x->brsft($y);		# right shift 
-  $x->brsft($y,$n);		# right shift, by base $n (like 10)
+	$x->brsft($y);		# right shift 
+	$x->brsft($y,$n);	# right shift, in base $n (like 10)
 
 =head2 band
 
-  $x->band($y);			# bitwise and
+	$x->band($y);			# bitwise and
 
 =head2 bior
 
-  $x->bior($y);			# bitwise inclusive or
+	$x->bior($y);			# bitwise inclusive or
 
 =head2 bxor
 
-  $x->bxor($y);			# bitwise exclusive or
+	$x->bxor($y);			# bitwise exclusive or
 
 =head2 bnot
 
-  $x->bnot();			# bitwise not (two's complement)
+	$x->bnot();			# bitwise not (two's complement)
 
 =head2 bsqrt
 
-  $x->bsqrt();			# calculate square-root
+	$x->bsqrt();			# calculate square-root
 
 =head2 bfac
 
-  $x->bfac();			# factorial of $x (1*2*3*4*..$x)
+	$x->bfac();			# factorial of $x (1*2*3*4*..$x)
 
 =head2 round
 
-  $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
+	$x->round($A,$P,$round_mode);
+	
+Round $x to accuracy C<$A> or precision C<$P> using the round mode
+C<$round_mode>.
 
 =head2 bround
 
-  $x->bround($N);               # accuracy: preserve $N digits
+	$x->bround($N);               # accuracy: preserve $N digits
 
 =head2 bfround
 
-  $x->bfround($N);              # round to $Nth digit, no-op for BigInts
+	$x->bfround($N);              # round to $Nth digit, no-op for BigInts
 
 =head2 bfloor
 
@@ -3185,11 +3496,11 @@ does change $x in BigFloat.
 
 =head2 bgcd
 
-  bgcd(@values);		# greatest common divisor (no OO style)
+	bgcd(@values);		# greatest common divisor (no OO style)
 
 =head2 blcm
 
-  blcm(@values);		# lowest common multiplicator (no OO style)
+	blcm(@values);		# lowest common multiplicator (no OO style)
  
 head2 length
 
@@ -3214,31 +3525,31 @@ Return the signed mantissa of $x as BigInt.
 
 =head2 parts
 
-  $x->parts();			# return (mantissa,exponent) as BigInt
+	$x->parts();		# return (mantissa,exponent) as BigInt
 
 =head2 copy
 
-  $x->copy();			# make a true copy of $x (unlike $y = $x;)
+	$x->copy();		# make a true copy of $x (unlike $y = $x;)
 
 =head2 as_number
 
-  $x->as_number();		# return as BigInt (in BigInt: same as copy())
+	$x->as_number();	# return as BigInt (in BigInt: same as copy())
   
 =head2 bsrt
 
-  $x->bstr();			# normalized string
+	$x->bstr();		# return normalized string
 
 =head2 bsstr
 
-  $x->bsstr();			# normalized string in scientific notation
+	$x->bsstr();		# normalized string in scientific notation
 
 =head2 as_hex
 
-  $x->as_hex();			# as signed hexadecimal string with prefixed 0x
+	$x->as_hex();		# as signed hexadecimal string with prefixed 0x
 
 =head2 as_bin
 
-  $x->as_bin();			# as signed binary string with prefixed 0b
+	$x->as_bin();		# as signed binary string with prefixed 0b
 
 =head1 ACCURACY and PRECISION
 
@@ -3452,7 +3763,7 @@ This is how it works now:
     globals enforced upon creation of a number by using
     $x = Math::BigInt->new($number,undef,undef):
 
-	use Math::Bigint::SomeSubclass;
+	use Math::BigInt::SomeSubclass;
 	use Math::BigInt;
 
 	Math::BigInt->accuracy(2);
@@ -3658,8 +3969,8 @@ numerical sense, e.g. $m might get minimized.
 
   $x = Math::BigInt->bstr("1234")      	# string "1234"
   $x = "$x";                         	# same as bstr()
-  $x = Math::BigInt->bneg("1234");   	# Bigint "-1234"
-  $x = Math::BigInt->babs("-12345"); 	# Bigint "12345"
+  $x = Math::BigInt->bneg("1234");   	# BigInt "-1234"
+  $x = Math::BigInt->babs("-12345"); 	# BigInt "12345"
   $x = Math::BigInt->bnorm("-0 00"); 	# BigInt "0"
   $x = bint(1) + bint(2);            	# BigInt "3"
   $x = bint(1) + "2";                	# ditto (auto-BigIntify of "2")
@@ -3727,7 +4038,7 @@ so that
 do not work. You need an explicit Math::BigInt->new() around one of the
 operands. You should also quote large constants to protect loss of precision:
 
-	use Math::Bigint;
+	use Math::BigInt;
 
 	$x = Math::BigInt->new('1234567889123456789123456789123456789');
 
@@ -3897,6 +4208,11 @@ versions to a more sophisticated scheme):
 
 =over 2
 
+=item broot() does not work
+
+The broot() function in BigInt may only work for small values. This will be
+fixed in a later version.
+
 =item Out of Memory!
 
 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and 
@@ -4204,13 +4520,14 @@ will both result in the proper type due to the way the overloaded math works.
 
 This section also applies to other overloaded math packages, like Math::String.
 
-One solution to you problem might be L<autoupgrading|upgrading>.
+One solution to you problem might be autoupgrading|upgrading. See the
+pragmas L<bignum>, L<bigint> and L<bigrat> for an easy way to do this.
 
 =item bsqrt()
 
 C<bsqrt()> works only good if the result is a big integer, e.g. the square
 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
-mode.
+mode. The reason is that the result is always truncated to an integer.
 
 If you want a better approximation of the square root, then use:
 
@@ -4236,8 +4553,11 @@ the same terms as Perl itself.
 
 =head1 SEE ALSO
 
-L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
-L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
+L<Math::BigFloat>, L<Math::BigRat> and L<Math::Big> as well as
+L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
+
+The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest
+because they solve the autoupgrading/downgrading issue, at least partly.
 
 The package at
 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
@@ -4247,6 +4567,11 @@ subclass files and benchmarks.
 =head1 AUTHORS
 
 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
+Completely rewritten by Tels http://bloodgate.com in late 2000, 2001, 2002
+and still at it in 2003.
+
+Many people contributed in one or more ways to the final beast, see the file
+CREDITS for an (uncomplete) list. If you miss your name, please drop me a
+mail. Thank you!
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/Math/Trig.pm b/gnu/usr.bin/perl/lib/Math/Trig.pm
index d1ac4f5500d..7560df54156 100644
--- a/gnu/usr.bin/perl/lib/Math/Trig.pm
+++ b/gnu/usr.bin/perl/lib/Math/Trig.pm
@@ -16,11 +16,11 @@ our($VERSION, $PACKAGE, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
 @ISA = qw(Exporter);
 
-$VERSION = 1.01;
+$VERSION = 1.02;
 
 my @angcnv = qw(rad2deg rad2grad
-	     deg2rad deg2grad
-	     grad2rad grad2deg);
+		deg2rad deg2grad
+		grad2rad grad2deg);
 
 @EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}},
 	   @angcnv);
@@ -133,17 +133,24 @@ sub great_circle_distance {
 sub great_circle_direction {
     my ( $theta0, $phi0, $theta1, $phi1 ) = @_;
 
+    my $distance = &great_circle_distance;
+
     my $lat0 = pip2 - $phi0;
     my $lat1 = pip2 - $phi1;
 
     my $direction =
-	atan2(sin($theta0 - $theta1) * cos($lat1),
-	      cos($lat0) * sin($lat1) -
-	      sin($lat0) * cos($lat1) * cos($theta0 - $theta1));
+	acos((sin($lat1) - sin($lat0) * cos($distance)) /
+	     (cos($lat0) * sin($distance)));
+
+    $direction = pi2 - $direction
+	if sin($theta1 - $theta0) < 0;
 
     return rad2rad($direction);
 }
 
+1;
+
+__END__
 =pod
 
 =head1 NAME
diff --git a/gnu/usr.bin/perl/lib/Net/FTP.pm b/gnu/usr.bin/perl/lib/Net/FTP.pm
index af27dc52b7d..beda69571e6 100644
--- a/gnu/usr.bin/perl/lib/Net/FTP.pm
+++ b/gnu/usr.bin/perl/lib/Net/FTP.pm
@@ -22,7 +22,7 @@ use Net::Config;
 use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
 # use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.65"; # $Id: //depot/libnet/Net/FTP.pm#68 $
+$VERSION = "2.72"; # $Id: //depot/libnet/Net/FTP.pm#80 $
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 # Someday I will "use constant", when I am not bothered to much about
@@ -70,12 +70,14 @@ sub new
      delete $arg{Port};
 	 $fire_type = $arg{FirewallType}
 	 || $ENV{FTP_FIREWALL_TYPE}
+	 || $NetConfig{firewall_type}
 	 || undef;
     }
   }
 
  my $ftp = $pkg->SUPER::new(PeerAddr => $peer, 
 			    PeerPort => $arg{Port} || 'ftp(21)',
+			    LocalAddr => $arg{'LocalAddr'},
 			    Proto    => 'tcp',
 			    Timeout  => defined $arg{Timeout}
 						? $arg{Timeout}
@@ -86,6 +88,8 @@ sub new
  ${*$ftp}{'net_ftp_type'}     = 'A';		# ASCII/binary/etc mode
  ${*$ftp}{'net_ftp_blksize'}  = abs($arg{'BlockSize'} || 10240);
 
+ ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
+
  ${*$ftp}{'net_ftp_firewall'} = $fire
 	if(defined $fire);
  ${*$ftp}{'net_ftp_firewall_type'} = $fire_type
@@ -202,7 +206,7 @@ sub size {
   my $io;
   if($ftp->supported("SIZE")) {
     return $ftp->_SIZE($file)
-	? ($ftp->message =~ /(\d+)$/)[0]
+	? ($ftp->message =~ /(\d+)\s*$/)[0]
 	: undef;
  }
  elsif($ftp->supported("STAT")) {
@@ -212,14 +216,14 @@ sub size {
    my $line;
    foreach $line (@msg) {
      return (split(/\s+/,$line))[4]
-	 if $line =~ /^[-rwx]{10}/
+	 if $line =~ /^[-rwxSsTt]{10}/
    }
  }
  else {
    my @files = $ftp->dir($file);
    if(@files) {
      return (split(/\s+/,$1))[4]
-	 if $files[0] =~ /^([-rwx]{10}.*)$/;
+	 if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
    }
  }
  undef;
@@ -391,6 +395,23 @@ sub type
  $oldval;
 }
 
+sub alloc
+{
+ my $ftp = shift;
+ my $size = shift;
+ my $oldval = ${*$ftp}{'net_ftp_allo'};
+
+ return $oldval
+	unless (defined $size);
+
+ return undef
+	unless ($ftp->_ALLO($size,@_));
+
+ ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_);
+
+ $oldval;
+}
+
 sub abort
 {
  my $ftp = shift;
@@ -462,6 +483,7 @@ sub get
    if($ref = ${*$ftp}{'net_ftp_hash'});
 
  my $blksize = ${*$ftp}{'net_ftp_blksize'};
+ local $\; # Just in case
 
  while(1)
   {
@@ -478,8 +500,7 @@ sub get
     print $hashh "#" x (int($count / $hashb));
     $count %= $hashb;
    }
-   my $written = syswrite($loc,$buf,$len);
-   unless(defined($written) && $written == $len)
+   unless(print $loc $buf)
     {
      carp "Cannot write to Local file $local: $!\n";
      $data->abort;
@@ -683,7 +704,18 @@ sub _store_cmd
    require File::Basename;
    $remote = File::Basename::basename($local);
   }
-
+ if( defined ${*$ftp}{'net_ftp_allo'} ) 
+  {
+   delete ${*$ftp}{'net_ftp_allo'};
+  } else 
+  {
+   # if the user hasn't already invoked the alloc method since the last 
+   # _store_cmd call, figure out if the local file is a regular file(not
+   # a pipe, or device) and if so get the file size from stat, and send
+   # an ALLO command before sending the STOR, STOU, or APPE command.
+   my $size = -f $local && -s _; # no ALLO if sending data from a pipe
+   $ftp->_ALLO($size) if $size;
+  }
  croak("Bad remote filename '$remote'\n")
 	if $remote =~ /[\r\n]/s;
 
@@ -714,6 +746,9 @@ sub _store_cmd
  $sock = $ftp->_data_cmd($cmd, $remote) or 
 	return undef;
 
+ $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
+   if 'STOU' eq uc $cmd;
+
  my $blksize = ${*$ftp}{'net_ftp_blksize'};
 
  my($count,$hashh,$hashb,$ref) = (0);
@@ -723,7 +758,7 @@ sub _store_cmd
 
  while(1)
   {
-   last unless $len = sysread($loc,$buf="",$blksize);
+   last unless $len = read($loc,$buf="",$blksize);
 
    if (trEBCDIC && $ftp->type ne 'I')
     {
@@ -908,6 +943,7 @@ sub _dataconn
 
    $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
     	    	     PeerPort => $port[4] * 256 + $port[5],
+		     LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
     	    	     Proto    => 'tcp'
     	    	    );
   }
@@ -1142,6 +1178,7 @@ sub cmd { shift->command(@_)->response() }
 #
 
 sub _ABOR { shift->command("ABOR")->response()	 == CMD_OK }
+sub _ALLO { shift->command("ALLO",@_)->response() == CMD_OK}
 sub _CDUP { shift->command("CDUP")->response()	 == CMD_OK }
 sub _NOOP { shift->command("NOOP")->response()	 == CMD_OK }
 sub _PASV { shift->command("PASV")->response()	 == CMD_OK }
@@ -1172,7 +1209,6 @@ sub _PASS { shift->command("PASS",@_)->response() }
 sub _ACCT { shift->command("ACCT",@_)->response() }
 sub _AUTH { shift->command("AUTH",@_)->response() }
 
-sub _ALLO { shift->unsupported(@_) }
 sub _SMNT { shift->unsupported(@_) }
 sub _MODE { shift->unsupported(@_) }
 sub _SYST { shift->unsupported(@_) }
@@ -1191,10 +1227,18 @@ Net::FTP - FTP Client class
 
     use Net::FTP;
 
-    $ftp = Net::FTP->new("some.host.name", Debug => 0);
-    $ftp->login("anonymous",'-anonymous@');
-    $ftp->cwd("/pub");
-    $ftp->get("that.file");
+    $ftp = Net::FTP->new("some.host.name", Debug => 0)
+      or die "Cannot connect to some.host.name: $@";
+
+    $ftp->login("anonymous",'-anonymous@')
+      or die "Cannot login ", $ftp->message;
+
+    $ftp->cwd("/pub")
+      or die "Cannot change working directory ", $ftp->message;
+
+    $ftp->get("that.file")
+      or die "get failed ", $ftp->message;
+
     $ftp->quit;
 
 =head1 DESCRIPTION
@@ -1277,6 +1321,9 @@ simply invokes the C<hash()> method for you, so that hash marks
 are displayed for all transfers.  You can, of course, call C<hash()>
 explicitly whenever you'd like.
 
+B<LocalAddr> - Local address to use for all socket connections, this
+argument will be passed to L<IO::Socket::INET>
+
 If the constructor fails undef will be returned and an error message will
 be in $@
 
@@ -1315,17 +1362,16 @@ Send a SITE command to the remote server and wait for a response.
 
 Returns most significant digit of the response code.
 
-=item type (TYPE [, ARGS])
+=item ascii
 
-This method will send the TYPE command to the remote FTP server
-to change the type of data transfer. The return value is the previous
-value.
+Transfer file in ASCII. CRLF translation will be done if required
 
-=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
+=item binary
 
-Synonyms for C<type> with the first arguments set correctly
+Transfer file in binary mode. No transformation will be done.
 
-B<NOTE> ebcdic and byte are not fully supported.
+B<Hint>: If both server and client machines use the same line ending for
+text files, then it will be faster to transfer all files in binary mode.
 
 =item rename ( OLDNAME, NEWNAME )
 
@@ -1358,9 +1404,10 @@ records this value and uses it when during the next data transfer. For this
 reason this method will not return an error, but setting it may cause
 a subsequent data transfer to fail.
 
-=item rmdir ( DIR )
+=item rmdir ( DIR [, RECURSE ])
 
-Remove the directory with the name C<DIR>.
+Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
+C<rmdir> will attempt to delete everything inside the directory.
 
 =item mkdir ( DIR [, RECURSE ])
 
@@ -1371,6 +1418,20 @@ Returns the full pathname to the new directory.
 
 =item ls ( [ DIR ] )
 
+=item alloc ( SIZE [, RECORD_SIZE] )
+
+The alloc command allows you to give the ftp server a hint about the size
+of the file about to be transfered using the ALLO ftp command. Some storage
+systems use this to make intelligent decisions about how to store the file.
+The C<SIZE> argument represents the size of the file in bytes. The
+C<RECORD_SIZE> argument indicates a mazimum record or page size for files
+sent with a record or page structure.
+
+The size of the file will be determined, and sent to the server
+automatically for normal files so that this method need only be called if
+you are transfering data from a socket, named pipe, or other stream not
+associated with a normal file.
+
 Get a directory listing of C<DIR>, or the current directory.
 
 In an array context, returns a list of lines returned from the server. In
@@ -1619,10 +1680,6 @@ The following RFC959 commands have not been implemented:
 
 =over 4
 
-=item B<ALLO>
-
-Allocates storage for the file to be transferred.
-
 =item B<SMNT>
 
 Mount a different file system structure without changing login or
@@ -1686,7 +1743,7 @@ For an example of the use of Net::FTP see
 
 =over 4
 
-=item http://www.csh.rit.edu/~adam/Progs/autoftp-2.0.tar.gz
+=item http://www.csh.rit.edu/~adam/Progs/
 
 C<autoftp> is a program that can retrieve, send, or list files via
 the FTP protocol in a non-interactive manner.
@@ -1710,6 +1767,6 @@ under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/FTP.pm#68 $>
+I<$Id: //depot/libnet/Net/FTP.pm#80 $>
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/Net/NNTP.pm b/gnu/usr.bin/perl/lib/Net/NNTP.pm
index 0076405c269..79261f889d5 100644
--- a/gnu/usr.bin/perl/lib/Net/NNTP.pm
+++ b/gnu/usr.bin/perl/lib/Net/NNTP.pm
@@ -14,7 +14,7 @@ use Carp;
 use Time::Local;
 use Net::Config;
 
-$VERSION = "2.21"; # $Id: //depot/libnet/Net/NNTP.pm#15 $
+$VERSION = "2.22"; # $Id: //depot/libnet/Net/NNTP.pm#18 $
 @ISA     = qw(Net::Cmd IO::Socket::INET);
 
 sub new
@@ -87,7 +87,7 @@ sub debug_text
  my $inout = shift;
  my $text = shift;
 
- if(($nntp->code == 350 && $text =~ /^(\S+)/)
+ if((ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/)
     || ($text =~ /^(authinfo\s+pass)/io)) 
   {
    $text = "$1 ....\n"
@@ -882,6 +882,10 @@ C<datasend> and C<dataend> methods from L<Net::Cmd>
 
 C<MESSAGE> can be either an array of lines or a reference to an array.
 
+The message, either sent via C<datasend> or as the C<MESSAGE>
+parameter, must be in the format as described by RFC822 and must
+contain From:, Newsgroups: and Subject: headers.
+
 =item postfh ()
 
 Post a new article to the news server using a tied filehandle.  If
@@ -1113,6 +1117,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/NNTP.pm#15 $>
+I<$Id: //depot/libnet/Net/NNTP.pm#18 $>
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/Net/Ping.pm b/gnu/usr.bin/perl/lib/Net/Ping.pm
index 93a186dfee5..f247d237334 100644
--- a/gnu/usr.bin/perl/lib/Net/Ping.pm
+++ b/gnu/usr.bin/perl/lib/Net/Ping.pm
@@ -1,38 +1,52 @@
 package Net::Ping;
 
-# $Id: Ping.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
-
 require 5.002;
 require Exporter;
 
 use strict;
 use vars qw(@ISA @EXPORT $VERSION
-            $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify);
-use FileHandle;
-use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
+            $def_timeout $def_proto $def_factor
+            $max_datasize $pingstring $hires $source_verify $syn_forking);
+use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
+use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR
                inet_aton inet_ntoa sockaddr_in );
+use POSIX qw( ENOTCONN ECONNREFUSED ECONNRESET EINPROGRESS EWOULDBLOCK EAGAIN WNOHANG );
+use FileHandle;
 use Carp;
-use POSIX qw(ECONNREFUSED);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.20";
+$VERSION = "2.31";
+
+sub SOL_IP { 0; };
+sub IP_TOS { 1; };
 
 # Constants
 
 $def_timeout = 5;           # Default timeout to wait for a reply
 $def_proto = "tcp";         # Default protocol to use for pinging
+$def_factor = 1.2;          # Default exponential backoff rate.
 $max_datasize = 1024;       # Maximum data bytes in a packet
 # The data we exchange with the server for the stream protocol
 $pingstring = "pingschwingping!\n";
 $source_verify = 1;         # Default is to verify source endpoint
+$syn_forking = 0;
 
 if ($^O =~ /Win32/i) {
   # Hack to avoid this Win32 spewage:
   # Your vendor has not defined POSIX macro ECONNREFUSED
   *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
+  *ENOTCONN     = sub {10057;};
+  *ECONNRESET   = sub {10054;};
+  *EINPROGRESS  = sub {10036;};
+  *EWOULDBLOCK  = sub {10035;};
+#  $syn_forking = 1;    # XXX possibly useful in < Win2K ?
 };
 
+# h2ph "asm/socket.h"
+# require "asm/socket.ph";
+sub SO_BINDTODEVICE {25;}
+
 # Description:  The pingecho() subroutine is provided for backward
 # compatibility with the original Net::Ping.  It accepts a host
 # name/IP and an optional timeout in seconds.  Create a tcp ping
@@ -61,7 +75,9 @@ sub new
   my ($this,
       $proto,             # Optional protocol to use for pinging
       $timeout,           # Optional timeout in seconds
-      $data_size          # Optional additional bytes of data
+      $data_size,         # Optional additional bytes of data
+      $device,            # Optional device to use
+      $tos,               # Optional ToS to set
       ) = @_;
   my  $class = ref($this) || $this;
   my  $self = {};
@@ -72,8 +88,8 @@ sub new
   bless($self, $class);
 
   $proto = $def_proto unless $proto;          # Determine the protocol
-  croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
-    unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
+  croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
+    unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
   $self->{"proto"} = $proto;
 
   $timeout = $def_timeout unless $timeout;    # Determine the timeout
@@ -81,6 +97,10 @@ sub new
     if $timeout <= 0;
   $self->{"timeout"} = $timeout;
 
+  $self->{"device"} = $device;
+
+  $self->{"tos"} = $tos;
+
   $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
   $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
   croak("Data for ping must be from $min_datasize to $max_datasize bytes")
@@ -95,6 +115,8 @@ sub new
   }
 
   $self->{"local_addr"} = undef;              # Don't bind by default
+  $self->{"retrans"} = $def_factor;           # Default exponential backoff rate
+  $self->{"econnrefused"} = undef;            # Default Connection refused behavior
 
   $self->{"seq"} = 0;                         # For counting packets
   if ($self->{"proto"} eq "udp")              # Open a socket
@@ -107,16 +129,32 @@ sub new
     socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
            $self->{"proto_num"}) ||
              croak("udp socket error - $!");
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak "error binding to device $self->{'device'} $!";
+    }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "icmp")
   {
-    croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
+    croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
     $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
       croak("Can't get icmp protocol by name");
     $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
     $self->{"fh"} = FileHandle->new();
     socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
       croak("icmp socket error - $!");
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak "error binding to device $self->{'device'} $!";
+    }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
   {
@@ -126,6 +164,30 @@ sub new
       croak("Can't get tcp echo port by name");
     $self->{"fh"} = FileHandle->new();
   }
+  elsif ($self->{"proto"} eq "syn")
+  {
+    $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+      croak("Can't get tcp protocol by name");
+    $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
+      croak("Can't get tcp echo port by name");
+    if ($syn_forking) {
+      $self->{"fork_rd"} = FileHandle->new();
+      $self->{"fork_wr"} = FileHandle->new();
+      pipe($self->{"fork_rd"}, $self->{"fork_wr"});
+      $self->{"fh"} = FileHandle->new();
+      $self->{"good"} = {};
+      $self->{"bad"} = {};
+    } else {
+      $self->{"wbits"} = "";
+      $self->{"bad"} = {};
+    }
+    $self->{"syn"} = {};
+    $self->{"stop_time"} = 0;
+  }
+  elsif ($self->{"proto"} eq "external")
+  {
+    # No preliminary work needs to be done.
+  }
 
   return($self);
 }
@@ -155,7 +217,7 @@ sub bind
   CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
     croak("$self->{'proto'} bind error - $!");
   }
-  elsif ($self->{"proto"} ne "tcp")
+  elsif (($self->{"proto"} ne "tcp") && ($self->{"proto"} ne "syn"))
   {
     croak("Unknown protocol \"$self->{proto}\" in bind()");
   }
@@ -163,6 +225,32 @@ sub bind
   return 1;
 }
 
+# Description: A select() wrapper that compensates for platform
+# peculiarities.
+sub mselect
+{
+    if ($_[3] > 0 and $^O eq 'MSWin32') {
+	# On windows, select() doesn't process the message loop,
+	# but sleep() will, allowing alarm() to interrupt the latter.
+	# So we chop up the timeout into smaller pieces and interleave
+	# select() and sleep() calls.
+	my $t = $_[3];
+	my $gran = 0.5;  # polling granularity in seconds
+	my @args = @_;
+	while (1) {
+	    $gran = $t if $gran > $t;
+	    my $nfound = select($_[0], $_[1], $_[2], $gran);
+	    $t -= $gran;
+	    return $nfound if $nfound or !defined($nfound) or $t <= 0;
+
+	    sleep(0);
+	    ($_[0], $_[1], $_[2]) = @args;
+	}
+    }
+    else {
+	return select($_[0], $_[1], $_[2], $_[3]);
+    }
+}
 
 # Description: Allow UDP source endpoint comparision to be
 #              skipped for those remote interfaces that do
@@ -175,6 +263,32 @@ sub source_verify
     ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
 }
 
+# Description: Set whether or not the connect
+# behavior should enforce remote service
+# availability as well as reachability.
+
+sub service_check
+{
+  my $self = shift;
+  $self->{"econnrefused"} = 1 unless defined
+    ($self->{"econnrefused"} = shift());
+}
+
+sub tcp_service_check
+{
+  service_check(@_);
+}
+
+# Description: Set exponential backoff for retransmission.
+# Should be > 1 to retain exponential properties.
+# If set to 0, retransmissions are disabled.
+
+sub retrans
+{
+  my $self = shift;
+  $self->{"retrans"} = shift;
+}
+
 # Description: allows the module to use milliseconds as returned by
 # the Time::HiRes module
 
@@ -192,6 +306,34 @@ sub time
   return $hires ? Time::HiRes::time() : CORE::time();
 }
 
+# Description: Sets or clears the O_NONBLOCK flag on a file handle.
+sub socket_blocking_mode
+{
+  my ($self,
+      $fh,              # the file handle whose flags are to be modified
+      $block) = @_;     # if true then set the blocking
+                        # mode (clear O_NONBLOCK), otherwise
+                        # set the non-blocking mode (set O_NONBLOCK)
+
+  my $flags;
+  if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+      # FIONBIO enables non-blocking sockets on windows and vms.
+      # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per winsock.h, ioctl.h
+      my $f = 0x8004667e;
+      my $v = pack("L", $block ? 0 : 1);
+      ioctl($fh, $f, $v) or croak("ioctl failed: $!");
+      return;
+  }
+  if ($flags = fcntl($fh, F_GETFL, 0)) {
+    $flags = $block ? ($flags & ~O_NONBLOCK) : ($flags | O_NONBLOCK);
+    if (!fcntl($fh, F_SETFL, $flags)) {
+      croak("fcntl F_SETFL: $!");
+    }
+  } else {
+    croak("fcntl F_GETFL: $!");
+  }
+}
+
 # Description: Ping a host name or IP number with an optional timeout.
 # First lookup the host, and return undef if it is not found.  Otherwise
 # perform the specific ping method based on the protocol.  Return the
@@ -213,7 +355,7 @@ sub ping
   croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
 
   $ip = inet_aton($host);
-  return(undef) unless defined($ip);      # Does host exist?
+  return () unless defined($ip);      # Does host exist?
 
   # Dispatch to the appropriate routine.
   $ping_time = &time();
@@ -231,6 +373,9 @@ sub ping
   }
   elsif ($self->{"proto"} eq "stream") {
     $ret = $self->ping_stream($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "syn") {
+    $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
   } else {
     croak("Unknown protocol \"$self->{proto}\" in ping()");
   }
@@ -252,7 +397,7 @@ sub ping_external {
 
 use constant ICMP_ECHOREPLY => 0; # ICMP packet types
 use constant ICMP_ECHO      => 8;
-use constant ICMP_STRUCT    => "C2 S3 A";  # Structure of a minimal ICMP packet
+use constant ICMP_STRUCT    => "C2 n3 A";  # Structure of a minimal ICMP packet
 use constant SUBCODE        => 0; # No ICMP subcode for ECHO and ECHOREPLY
 use constant ICMP_FLAGS     => 0; # No special flags for send or recv
 use constant ICMP_PORT      => 0; # No port with ICMP
@@ -294,6 +439,9 @@ sub ping_icmp
               $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
   $len_msg = length($msg);
   $saddr = sockaddr_in(ICMP_PORT, $ip);
+  $self->{"from_ip"} = undef;
+  $self->{"from_type"} = undef;
+  $self->{"from_subcode"} = undef;
   send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
 
   $rbits = "";
@@ -303,7 +451,7 @@ sub ping_icmp
   $finish_time = &time() + $timeout;      # Must be done by this time
   while (!$done && $timeout > 0)          # Keep trying if we have time
   {
-    $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
+    $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
     $timeout = $finish_time - &time();    # Get remaining time
     if (!defined($nfound))                # Hmm, a strange error
     {
@@ -313,30 +461,42 @@ sub ping_icmp
     elsif ($nfound)                     # Got a packet from somewhere
     {
       $recv_msg = "";
+      $from_pid = -1;
+      $from_seq = -1;
       $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
       ($from_port, $from_ip) = sockaddr_in($from_saddr);
-      ($from_type, $from_subcode, $from_chk,
-       $from_pid, $from_seq, $from_msg) =
-         unpack(ICMP_STRUCT . $self->{"data_size"},
-                substr($recv_msg, length($recv_msg) - $len_msg,
-                       $len_msg));
-      if (($from_type == ICMP_ECHOREPLY) &&
-          (!$source_verify || $from_ip eq $ip) &&
-          ($from_pid == $self->{"pid"}) && # Does the packet check out?
-          ($from_seq == $self->{"seq"}))
-      {
-        $ret = 1;                   # It's a winner
+      ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
+      if ($from_type == ICMP_ECHOREPLY) {
+        ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
+          if length $recv_msg >= 28;
+      } else {
+        ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
+          if length $recv_msg >= 56;
+      }
+      $self->{"from_ip"} = $from_ip;
+      $self->{"from_type"} = $from_type;
+      $self->{"from_subcode"} = $from_subcode;
+      if (($from_pid == $self->{"pid"}) && # Does the packet check out?
+          ($from_seq == $self->{"seq"})) {
+        if ($from_type == ICMP_ECHOREPLY){
+          $ret = 1;
+        }
         $done = 1;
       }
-    }
-    else                                # Oops, timed out
-    {
+    } else {     # Oops, timed out
       $done = 1;
     }
   }
   return $ret;
 }
 
+sub icmp_result {
+  my ($self) = @_;
+  my $ip = $self->{"from_ip"} || "";
+  $ip = "\0\0\0\0" unless 4 == length $ip;
+  return (inet_ntoa($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
+}
+
 # Description:  Do a checksum on the message.  Basically sum all of
 # the short words and fold the high order bits into the low order bits.
 
@@ -354,7 +514,7 @@ sub checksum
   $len_msg = length($msg);
   $num_short = int($len_msg / 2);
   $chk = 0;
-  foreach $short (unpack("S$num_short", $msg))
+  foreach $short (unpack("n$num_short", $msg))
   {
     $chk += $short;
   }                                           # Add the odd byte in
@@ -383,9 +543,12 @@ sub ping_tcp
   my ($ret                # The return value
       );
 
-  $@ = ""; $! = 0;
+  $! = 0;
   $ret = $self -> tcp_connect( $ip, $timeout);
-  $ret = 1 if $! == ECONNREFUSED;  # Connection refused
+  if (!$self->{"econnrefused"} &&
+      $! == ECONNREFUSED) {
+    $ret = 1;  # "Connection refused" means reachable
+  }
   $self->{"fh"}->close();
   return $ret;
 }
@@ -409,41 +572,123 @@ sub tcp_connect
         !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
       croak("tcp bind error - $!");
     }
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak("error binding to device $self->{'device'} $!");
+    }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   };
   my $do_connect = sub {
-    eval {
-      die $! unless connect($self->{"fh"}, $saddr);
-      $self->{"ip"} = $ip;
-      $ret = 1;
-    };
-    $ret;
+    $self->{"ip"} = $ip;
+    # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
+    # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
+    return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
   };
+  my $do_connect_nb = sub {
+    # Set O_NONBLOCK property on filehandle
+    $self->socket_blocking_mode($self->{"fh"}, 0);
+
+    # start the connection attempt
+    if (!connect($self->{"fh"}, $saddr)) {
+      if ($! == ECONNREFUSED) {
+        $ret = 1 unless $self->{"econnrefused"};
+      } elsif ($! != EINPROGRESS && ($^O ne 'MSWin32' || $! != EWOULDBLOCK)) {
+        # EINPROGRESS is the expected error code after a connect()
+        # on a non-blocking socket.  But if the kernel immediately
+        # determined that this connect() will never work,
+        # Simply respond with "unreachable" status.
+        # (This can occur on some platforms with errno
+        # EHOSTUNREACH or ENETUNREACH.)
+        return 0;
+      } else {
+        # Got the expected EINPROGRESS.
+        # Just wait for connection completion...
+        my ($wbits, $wout, $wexc);
+        $wout = $wexc = $wbits = "";
+        vec($wbits, $self->{"fh"}->fileno, 1) = 1;
+
+        my $nfound = mselect(undef,
+			    ($wout = $wbits),
+			    ($^O eq 'MSWin32' ? ($wexc = $wbits) : undef),
+			    $timeout);
+        warn("select: $!") unless defined $nfound;
+
+        if ($nfound && vec($wout, $self->{"fh"}->fileno, 1)) {
+          # the socket is ready for writing so the connection
+          # attempt completed. test whether the connection
+          # attempt was successful or not
+
+          if (getpeername($self->{"fh"})) {
+            # Connection established to remote host
+            $ret = 1;
+          } else {
+            # TCP ACK will never come from this host
+            # because there was an error connecting.
 
-  if ($^O =~ /Win32/i) {
+            # This should set $! to the correct error.
+            my $char;
+            sysread($self->{"fh"},$char,1);
+            $! = ECONNREFUSED if ($! == EAGAIN && $^O =~ /cygwin/i);
 
-    # Buggy Winsock API doesn't allow us to use alarm() calls.
+            $ret = 1 if (!$self->{"econnrefused"}
+                         && $! == ECONNREFUSED);
+          }
+        } else {
+          # the connection attempt timed out (or there were connect
+	  # errors on Windows)
+	  if ($^O =~ 'MSWin32') {
+	      # If the connect will fail on a non-blocking socket,
+	      # winsock reports ECONNREFUSED as an exception, and we
+	      # need to fetch the socket-level error code via getsockopt()
+	      # instead of using the thread-level error code that is in $!.
+	      if ($nfound && vec($wexc, $self->{"fh"}->fileno, 1)) {
+		  $! = unpack("i", getsockopt($self->{"fh"}, SOL_SOCKET,
+			                      SO_ERROR));
+	      }
+	  }
+        }
+      }
+    } else {
+      # Connection established to remote host
+      $ret = 1;
+    }
+
+    # Unset O_NONBLOCK property on filehandle
+    $self->socket_blocking_mode($self->{"fh"}, 1);
+    $self->{"ip"} = $ip;
+    return $ret;
+  };
+
+  if ($syn_forking) {
+    # Buggy Winsock API doesn't allow nonblocking connect.
     # Hence, if our OS is Windows, we need to create a separate
     # process to do the blocking connect attempt.
+    # XXX Above comments are not true at least for Win2K, where
+    # nonblocking connect works.
 
     $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
-    my $pid = fork;
-    if (!$pid) {
-      if (!defined $pid) {
+    $self->{'tcp_chld'} = fork;
+    if (!$self->{'tcp_chld'}) {
+      if (!defined $self->{'tcp_chld'}) {
         # Fork did not work
-        warn "Win32 Fork error: $!";
+        warn "Fork error: $!";
         return 0;
       }
       &{ $do_socket }();
 
       # Try a slow blocking connect() call
-      # and report the status to the pipe.
+      # and report the status to the parent.
       if ( &{ $do_connect }() ) {
         $self->{"fh"}->close();
         # No error
         exit 0;
       } else {
         # Pass the error status to the parent
-        exit $!;
+        # Make sure that $! <= 255
+        exit($! <= 255 ? $! : 255);
       }
     }
 
@@ -451,46 +696,57 @@ sub tcp_connect
 
     my $patience = &time() + $timeout;
 
-    require POSIX;
-    my ($child);
-    $? = 0;
+    my ($child, $child_errno);
+    $? = 0; $child_errno = 0;
     # Wait up to the timeout
     # And clean off the zombie
     do {
-      $child = waitpid($pid, &POSIX::WNOHANG);
-      $! = $? >> 8;
-      $@ = $!;
+      $child = waitpid($self->{'tcp_chld'}, &WNOHANG());
+      $child_errno = $? >> 8;
       select(undef, undef, undef, 0.1);
-    } while &time() < $patience && $child != $pid;
-
-    if ($child == $pid) {
-      # Since she finished within the timeout,
-      # it is probably safe for me to try it too
-      &{ $do_connect }();
+    } while &time() < $patience && $child != $self->{'tcp_chld'};
+
+    if ($child == $self->{'tcp_chld'}) {
+      if ($self->{"proto"} eq "stream") {
+        # We need the socket connected here, in parent
+        # Should be safe to connect because the child finished
+        # within the timeout
+        &{ $do_connect }();
+      }
+      # $ret cannot be set by the child process
+      $ret = !$child_errno;
     } else {
       # Time must have run out.
-      $@ = "Timed out!";
       # Put that choking client out of its misery
-      kill "KILL", $pid;
+      kill "KILL", $self->{'tcp_chld'};
       # Clean off the zombie
-      waitpid($pid, 0);
+      waitpid($self->{'tcp_chld'}, 0);
       $ret = 0;
     }
-  } else { # Win32
+    delete $self->{'tcp_chld'};
+    $! = $child_errno;
+  } else {
     # Otherwise don't waste the resources to fork
 
     &{ $do_socket }();
 
-    $SIG{'ALRM'} = sub { die "Timed out!"; };
-    alarm($timeout);        # Interrupt connect() if we have to
-
-    &{ $do_connect }();
-    alarm(0);
+    &{ $do_connect_nb }();
   }
 
   return $ret;
 }
 
+sub DESTROY {
+  my $self = shift;
+  if ($self->{'proto'} eq 'tcp' &&
+      $self->{'tcp_chld'}) {
+    # Put that choking client out of its misery
+    kill "KILL", $self->{'tcp_chld'};
+    # Clean off the zombie
+    waitpid($self->{'tcp_chld'}, 0);
+  }
+}
+
 # This writes the given string to the socket and then reads it
 # back.  It returns 1 on success, 0 on failure.
 sub tcp_echo
@@ -515,10 +771,10 @@ sub tcp_echo
         vec($rout, $self->{"fh"}->fileno(), 1) = 1;
       }
 
-      if(select($rin, $rout, undef, ($time + $timeout) - &time())) {
+      if(mselect($rin, $rout, undef, ($time + $timeout) - &time())) {
 
         if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
-          my $num = syswrite($self->{"fh"}, $wrstr);
+          my $num = syswrite($self->{"fh"}, $wrstr, length $wrstr);
           if($num) {
             # If it was a partial write, update and try again.
             $wrstr = substr($wrstr,$num);
@@ -603,7 +859,6 @@ sub open
 # of time.  Return the result of our efforts.
 
 use constant UDP_FLAGS => 0; # Nothing special on send or recv
-
 sub ping_udp
 {
   my ($self,
@@ -615,6 +870,8 @@ sub ping_udp
       $ret,               # The return value
       $msg,               # Message to be echoed
       $finish_time,       # Time ping should be finished
+      $flush,             # Whether socket needs to be disconnected
+      $connect,           # Whether socket needs to be connected
       $done,              # Set to 1 when we are done pinging
       $rbits,             # Read bits, filehandles for reading
       $nfound,            # Number of ready filehandles found
@@ -627,16 +884,54 @@ sub ping_udp
   $saddr = sockaddr_in($self->{"port_num"}, $ip);
   $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
   $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
-  send($self->{"fh"}, $msg, UDP_FLAGS, $saddr);   # Send it
+
+  if ($self->{"connected"}) {
+    if ($self->{"connected"} ne $saddr) {
+      # Still connected to wrong destination.
+      # Need to flush out the old one.
+      $flush = 1;
+    }
+  } else {
+    # Not connected yet.
+    # Need to connect() before send()
+    $connect = 1;
+  }
+
+  # Have to connect() and send() instead of sendto()
+  # in order to pick up on the ECONNREFUSED setting
+  # from recv() or double send() errno as utilized in
+  # the concept by rdw @ perlmonks.  See:
+  # http://perlmonks.thepen.com/42898.html
+  if ($flush) {
+    # Need to socket() again to flush the descriptor
+    # This will disconnect from the old saddr.
+    socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
+           $self->{"proto_num"});
+  }
+  # Connect the socket if it isn't already connected
+  # to the right destination.
+  if ($flush || $connect) {
+    connect($self->{"fh"}, $saddr);               # Tie destination to socket
+    $self->{"connected"} = $saddr;
+  }
+  send($self->{"fh"}, $msg, UDP_FLAGS);           # Send it
 
   $rbits = "";
   vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
   $ret = 0;                   # Default to unreachable
   $done = 0;
+  my $retrans = 0.01;
+  my $factor = $self->{"retrans"};
   $finish_time = &time() + $timeout;       # Ping needs to be done by then
   while (!$done && $timeout > 0)
   {
-    $nfound = select($rbits, undef, undef, $timeout); # Wait for response
+    if ($factor > 1)
+    {
+      $timeout = $retrans if $timeout > $retrans;
+      $retrans*= $factor; # Exponential backoff
+    }
+    $nfound  = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
+    my $why = $!;
     $timeout = $finish_time - &time();   # Get remaining time
 
     if (!defined($nfound))  # Hmm, a strange error
@@ -647,34 +942,425 @@ sub ping_udp
     elsif ($nfound)         # A packet is waiting
     {
       $from_msg = "";
-      $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
-        or last; # For example an unreachable host will make recv() fail.
-      ($from_port, $from_ip) = sockaddr_in($from_saddr);
-      if (!$source_verify ||
-          (($from_ip eq $ip) &&        # Does the packet check out?
-           ($from_port == $self->{"port_num"}) &&
-           ($from_msg eq $msg)))
-      {
-        $ret = 1;       # It's a winner
+      $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
+      if (!$from_saddr) {
+        # For example an unreachable host will make recv() fail.
+        if (!$self->{"econnrefused"} &&
+            ($! == ECONNREFUSED ||
+             $! == ECONNRESET)) {
+          # "Connection refused" means reachable
+          # Good, continue
+          $ret = 1;
+        }
         $done = 1;
+      } else {
+        ($from_port, $from_ip) = sockaddr_in($from_saddr);
+        if (!$source_verify ||
+            (($from_ip eq $ip) &&        # Does the packet check out?
+             ($from_port == $self->{"port_num"}) &&
+             ($from_msg eq $msg)))
+        {
+          $ret = 1;       # It's a winner
+          $done = 1;
+        }
       }
     }
-    else                    # Oops, timed out
+    elsif ($timeout <= 0)              # Oops, timed out
     {
       $done = 1;
     }
+    else
+    {
+      # Send another in case the last one dropped
+      if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
+        # Another send worked?  The previous udp packet
+        # must have gotten lost or is still in transit.
+        # Hopefully this new packet will arrive safely.
+      } else {
+        if (!$self->{"econnrefused"} &&
+            $! == ECONNREFUSED) {
+          # "Connection refused" means reachable
+          # Good, continue
+          $ret = 1;
+        }
+        $done = 1;
+      }
+    }
   }
   return $ret;
 }
 
-# Description:  Close the connection unless we are using the tcp
-# protocol, since it will already be closed.
+# Description: Send a TCP SYN packet to host specified.
+sub ping_syn
+{
+  my $self = shift;
+  my $host = shift;
+  my $ip = shift;
+  my $start_time = shift;
+  my $stop_time = shift;
+
+  if ($syn_forking) {
+    return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
+  }
+
+  my $fh = FileHandle->new();
+  my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+  # Create TCP socket
+  if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
+    croak("tcp socket error - $!");
+  }
+
+  if (defined $self->{"local_addr"} &&
+      !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
+    croak("tcp bind error - $!");
+  }
+
+  if ($self->{'device'}) {
+    setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+      or croak("error binding to device $self->{'device'} $!");
+  }
+  if ($self->{'tos'}) {
+    setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+      or croak "error configuring tos to $self->{'tos'} $!";
+  }
+  # Set O_NONBLOCK property on filehandle
+  $self->socket_blocking_mode($fh, 0);
+
+  # Attempt the non-blocking connect
+  # by just sending the TCP SYN packet
+  if (connect($fh, $saddr)) {
+    # Non-blocking, yet still connected?
+    # Must have connected very quickly,
+    # or else it wasn't very non-blocking.
+    #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
+  } else {
+    # Error occurred connecting.
+    if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
+      # The connection is just still in progress.
+      # This is the expected condition.
+    } else {
+      # Just save the error and continue on.
+      # The ack() can check the status later.
+      $self->{"bad"}->{$host} = $!;
+    }
+  }
+
+  my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
+  $self->{"syn"}->{$fh->fileno} = $entry;
+  if ($self->{"stop_time"} < $stop_time) {
+    $self->{"stop_time"} = $stop_time;
+  }
+  vec($self->{"wbits"}, $fh->fileno, 1) = 1;
+
+  return 1;
+}
+
+sub ping_syn_fork {
+  my ($self, $host, $ip, $start_time, $stop_time) = @_;
+
+  # Buggy Winsock API doesn't allow nonblocking connect.
+  # Hence, if our OS is Windows, we need to create a separate
+  # process to do the blocking connect attempt.
+  my $pid = fork();
+  if (defined $pid) {
+    if ($pid) {
+      # Parent process
+      my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
+      $self->{"syn"}->{$pid} = $entry;
+      if ($self->{"stop_time"} < $stop_time) {
+        $self->{"stop_time"} = $stop_time;
+      }
+    } else {
+      # Child process
+      my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+      # Create TCP socket
+      if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
+        croak("tcp socket error - $!");
+      }
+
+      if (defined $self->{"local_addr"} &&
+          !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
+        croak("tcp bind error - $!");
+      }
+
+      if ($self->{'device'}) {
+        setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+          or croak("error binding to device $self->{'device'} $!");
+      }
+      if ($self->{'tos'}) {
+        setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+          or croak "error configuring tos to $self->{'tos'} $!";
+      }
+
+      $!=0;
+      # Try to connect (could take a long time)
+      connect($self->{"fh"}, $saddr);
+      # Notify parent of connect error status
+      my $err = $!+0;
+      my $wrstr = "$$ $err";
+      # Force to 16 chars including \n
+      $wrstr .= " "x(15 - length $wrstr). "\n";
+      syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
+      exit;
+    }
+  } else {
+    # fork() failed?
+    die "fork: $!";
+  }
+  return 1;
+}
+
+# Description: Wait for TCP ACK from host specified
+# from ping_syn above.  If no host is specified, wait
+# for TCP ACK from any of the hosts in the SYN queue.
+sub ack
+{
+  my $self = shift;
+
+  if ($self->{"proto"} eq "syn") {
+    if ($syn_forking) {
+      my @answer = $self->ack_unfork(shift);
+      return wantarray ? @answer : $answer[0];
+    }
+    my $wbits = "";
+    my $stop_time = 0;
+    if (my $host = shift) {
+      # Host passed as arg
+      if (exists $self->{"bad"}->{$host}) {
+        if (!$self->{"econnrefused"} &&
+            $self->{"bad"}->{ $host } &&
+            (($! = ECONNREFUSED)>0) &&
+            $self->{"bad"}->{ $host } eq "$!") {
+          # "Connection refused" means reachable
+          # Good, continue
+        } else {
+          # ECONNREFUSED means no good
+          return ();
+        }
+      }
+      my $host_fd = undef;
+      foreach my $fd (keys %{ $self->{"syn"} }) {
+        my $entry = $self->{"syn"}->{$fd};
+        if ($entry->[0] eq $host) {
+          $host_fd = $fd;
+          $stop_time = $entry->[4]
+            || croak("Corrupted SYN entry for [$host]");
+          last;
+        }
+      }
+      croak("ack called on [$host] without calling ping first!")
+        unless defined $host_fd;
+      vec($wbits, $host_fd, 1) = 1;
+    } else {
+      # No $host passed so scan all hosts
+      # Use the latest stop_time
+      $stop_time = $self->{"stop_time"};
+      # Use all the bits
+      $wbits = $self->{"wbits"};
+    }
+
+    while ($wbits !~ /^\0*\z/) {
+      my $timeout = $stop_time - &time();
+      # Force a minimum of 10 ms timeout.
+      $timeout = 0.01 if $timeout <= 0.01;
+
+      my $winner_fd = undef;
+      my $wout = $wbits;
+      my $fd = 0;
+      # Do "bad" fds from $wbits first
+      while ($wout !~ /^\0*\z/) {
+        if (vec($wout, $fd, 1)) {
+          # Wipe it from future scanning.
+          vec($wout, $fd, 1) = 0;
+          if (my $entry = $self->{"syn"}->{$fd}) {
+            if ($self->{"bad"}->{ $entry->[0] }) {
+              $winner_fd = $fd;
+              last;
+            }
+          }
+        }
+        $fd++;
+      }
+
+      if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
+        if (defined $winner_fd) {
+          $fd = $winner_fd;
+        } else {
+          # Done waiting for one of the ACKs
+          $fd = 0;
+          # Determine which one
+          while ($wout !~ /^\0*\z/ &&
+                 !vec($wout, $fd, 1)) {
+            $fd++;
+          }
+        }
+        if (my $entry = $self->{"syn"}->{$fd}) {
+          # Wipe it from future scanning.
+          delete $self->{"syn"}->{$fd};
+          vec($self->{"wbits"}, $fd, 1) = 0;
+          vec($wbits, $fd, 1) = 0;
+          if (!$self->{"econnrefused"} &&
+              $self->{"bad"}->{ $entry->[0] } &&
+              (($! = ECONNREFUSED)>0) &&
+              $self->{"bad"}->{ $entry->[0] } eq "$!") {
+            # "Connection refused" means reachable
+            # Good, continue
+          } elsif (getpeername($entry->[2])) {
+            # Connection established to remote host
+            # Good, continue
+          } else {
+            # TCP ACK will never come from this host
+            # because there was an error connecting.
+
+            # This should set $! to the correct error.
+            my $char;
+            sysread($entry->[2],$char,1);
+            # Store the excuse why the connection failed.
+            $self->{"bad"}->{$entry->[0]} = $!;
+            if (!$self->{"econnrefused"} &&
+                (($! == ECONNREFUSED) ||
+                 ($! == EAGAIN && $^O =~ /cygwin/i))) {
+              # "Connection refused" means reachable
+              # Good, continue
+            } else {
+              # No good, try the next socket...
+              next;
+            }
+          }
+          # Everything passed okay, return the answer
+          return wantarray ?
+            ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
+            : $entry->[0];
+        } else {
+          warn "Corrupted SYN entry: unknown fd [$fd] ready!";
+          vec($wbits, $fd, 1) = 0;
+          vec($self->{"wbits"}, $fd, 1) = 0;
+        }
+      } elsif (defined $nfound) {
+        # Timed out waiting for ACK
+        foreach my $fd (keys %{ $self->{"syn"} }) {
+          if (vec($wbits, $fd, 1)) {
+            my $entry = $self->{"syn"}->{$fd};
+            $self->{"bad"}->{$entry->[0]} = "Timed out";
+            vec($wbits, $fd, 1) = 0;
+            vec($self->{"wbits"}, $fd, 1) = 0;
+            delete $self->{"syn"}->{$fd};
+          }
+        }
+      } else {
+        # Weird error occurred with select()
+        warn("select: $!");
+        $self->{"syn"} = {};
+        $wbits = "";
+      }
+    }
+  }
+  return ();
+}
+
+sub ack_unfork {
+  my ($self,$host) = @_;
+  my $stop_time = $self->{"stop_time"};
+  if ($host) {
+    # Host passed as arg
+    if (my $entry = $self->{"good"}->{$host}) {
+      delete $self->{"good"}->{$host};
+      return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
+    }
+  }
+
+  my $rbits = "";
+  my $timeout;
+
+  if (keys %{ $self->{"syn"} }) {
+    # Scan all hosts that are left
+    vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
+    $timeout = $stop_time - &time();
+    # Force a minimum of 10 ms timeout.
+    $timeout = 0.01 if $timeout < 0.01;
+  } else {
+    # No hosts left to wait for
+    $timeout = 0;
+  }
+
+  if ($timeout > 0) {
+    my $nfound;
+    while ( keys %{ $self->{"syn"} } and
+           $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
+      # Done waiting for one of the ACKs
+      if (!sysread($self->{"fork_rd"}, $_, 16)) {
+        # Socket closed, which means all children are done.
+        return ();
+      }
+      my ($pid, $how) = split;
+      if ($pid) {
+        # Flush the zombie
+        waitpid($pid, 0);
+        if (my $entry = $self->{"syn"}->{$pid}) {
+          # Connection attempt to remote host is done
+          delete $self->{"syn"}->{$pid};
+          if (!$how || # If there was no error connecting
+              (!$self->{"econnrefused"} &&
+               $how == ECONNREFUSED)) {  # "Connection refused" means reachable
+            if ($host && $entry->[0] ne $host) {
+              # A good connection, but not the host we need.
+              # Move it from the "syn" hash to the "good" hash.
+              $self->{"good"}->{$entry->[0]} = $entry;
+              # And wait for the next winner
+              next;
+            }
+            return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
+          }
+        } else {
+          # Should never happen
+          die "Unknown ping from pid [$pid]";
+        }
+      } else {
+        die "Empty response from status socket?";
+      }
+    }
+    if (defined $nfound) {
+      # Timed out waiting for ACK status
+    } else {
+      # Weird error occurred with select()
+      warn("select: $!");
+    }
+  }
+  if (my @synners = keys %{ $self->{"syn"} }) {
+    # Kill all the synners
+    kill 9, @synners;
+    foreach my $pid (@synners) {
+      # Wait for the deaths to finish
+      # Then flush off the zombie
+      waitpid($pid, 0);
+    }
+  }
+  $self->{"syn"} = {};
+  return ();
+}
+
+# Description:  Tell why the ack() failed
+sub nack {
+  my $self = shift;
+  my $host = shift || croak('Usage> nack($failed_ack_host)');
+  return $self->{"bad"}->{$host} || undef;
+}
+
+# Description:  Close the connection.
 
 sub close
 {
   my ($self) = @_;
 
-  $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
+  if ($self->{"proto"} eq "syn") {
+    delete $self->{"syn"};
+  } elsif ($self->{"proto"} eq "tcp") {
+    # The connection will already be closed
+  } else {
+    $self->{"fh"}->close();
+  }
 }
 
 
@@ -715,6 +1401,16 @@ Net::Ping - check a remote host for reachability
     }
     undef($p);
 
+    # Like tcp protocol, but with many hosts
+    $p = Net::Ping->new("syn");
+    $p->{port_num} = getservbyname("http", "tcp");
+    foreach $host (@host_array) {
+      $p->ping($host);
+    }
+    while (($host,$rtt,$ip) = $p->ack) {
+      print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
+    }
+
     # High precision syntax (requires Time::HiRes)
     $p = Net::Ping->new();
     $p->hires();
@@ -733,16 +1429,16 @@ hosts on a network.  A ping object is first created with optional
 parameters, a variable number of hosts may be pinged multiple
 times and then the connection is closed.
 
-You may choose one of four different protocols to use for the
-ping. The "udp" protocol is the default. Note that a live remote host
+You may choose one of six different protocols to use for the
+ping. The "tcp" protocol is the default. Note that a live remote host
 may still fail to be pingable by one or more of these protocols. For
-example, www.microsoft.com is generally alive but not pingable.
+example, www.microsoft.com is generally alive but not "icmp" pingable.
 
 With the "tcp" protocol the ping() method attempts to establish a
 connection to the remote host's echo port.  If the connection is
 successfully established, the remote host is considered reachable.  No
 data is actually echoed.  This protocol does not require any special
-privileges but has higher overhead than the other two protocols.
+privileges but has higher overhead than the "udp" and "icmp" protocols.
 
 Specifying the "udp" protocol causes the ping() method to send a udp
 packet to the remote host's echo port.  If the echoed packet is
@@ -768,15 +1464,32 @@ utility to perform the ping, and generally produces relatively
 accurate results. If C<Net::Ping::External> if not installed on your
 system, specifying the "external" protocol will result in an error.
 
+If the "syn" protocol is specified, the ping() method will only
+send a TCP SYN packet to the remote host then immediately return.
+If the syn packet was sent successfully, it will return a true value,
+otherwise it will return false.  NOTE: Unlike the other protocols,
+the return value does NOT determine if the remote host is alive or
+not since the full TCP three-way handshake may not have completed
+yet.  The remote host is only considered reachable if it receives
+a TCP ACK within the timeout specifed.  To begin waiting for the
+ACK packets, use the ack() method as explained below.  Use the
+"syn" protocol instead the "tcp" protocol to determine reachability
+of multiple destinations simultaneously by sending parallel TCP
+SYN packets.  It will not block while testing each remote host.
+demo/fping is provided in this distribution to demonstrate the
+"syn" protocol as an example.
+This protocol does not require any special privileges.
+
 =head2 Functions
 
 =over 4
 
-=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [, $tos ]]]]]);
 
 Create a new ping object.  All of the parameters are optional.  $proto
 specifies the protocol to use when doing a ping.  The current choices
-are "tcp", "udp" or "icmp".  The default is "udp".
+are "tcp", "udp", "icmp", "stream", "syn", or "external".
+The default is "tcp".
 
 If a default timeout ($def_timeout) in seconds is provided, it is used
 when a timeout is not given to the ping() method (below).  The timeout
@@ -789,6 +1502,12 @@ default) number of data bytes is 1 if the protocol is "udp" and 0
 otherwise.  The maximum number of data bytes that can be specified is
 1024.
 
+If $device is given, this device is used to bind the source endpoint
+before sending the ping packet.  I beleive this only works with
+superuser privileges and with udp and icmp protocols at this time.
+
+If $tos is given, this ToS is configured into the soscket.
+
 =item $p->ping($host [, $timeout]);
 
 Ping the remote host and wait for a response.  $host can be either the
@@ -799,7 +1518,8 @@ hostname cannot be found or there is a problem with the IP number, the
 success flag returned will be undef.  Otherwise, the success flag will
 be 1 if the host is reachable and 0 if it is not.  For most practical
 purposes, undef and 0 and can be treated as the same case.  In array
-context, the elapsed time is also returned.  The elapsed time value will
+context, the elapsed time as well as the string form of the ip the
+host resolved to are also returned.  The elapsed time value will
 be a float, as retuned by the Time::HiRes::time() function, if hires()
 has been previously called, otherwise it is returned as an integer.
 
@@ -813,6 +1533,34 @@ This only affects udp and icmp protocol pings.
 
 This is enabled by default.
 
+=item $p->service_check( { 0 | 1 } );
+
+Set whether or not the connect behavior should enforce
+remote service availability as well as reachability.  Normally,
+if the remote server reported ECONNREFUSED, it must have been
+reachable because of the status packet that it reported.
+With this option enabled, the full three-way tcp handshake
+must have been established successfully before it will
+claim it is reachable.  NOTE:  It still does nothing more
+than connect and disconnect.  It does not speak any protocol
+(i.e., HTTP or FTP) to ensure the remote server is sane in
+any way.  The remote server CPU could be grinding to a halt
+and unresponsive to any clients connecting, but if the kernel
+throws the ACK packet, it is considered alive anyway.  To
+really determine if the server is responding well would be
+application specific and is beyond the scope of Net::Ping.
+For udp protocol, enabling this option demands that the
+remote server replies with the same udp data that it was sent
+as defined by the udp echo service.
+
+This affects the "udp", "tcp", and "syn" protocols.
+
+This is disabled by default.
+
+=item $p->tcp_service_check( { 0 | 1 } );
+
+Depricated method, but does the same as service_check() method.
+
 =item $p->hires( { 0 | 1 } );
 
 Causes this module to use Time::HiRes module, allowing milliseconds
@@ -836,7 +1584,7 @@ object.
 
 =item $p->open($host);
 
-When you are using the stream protocol, this call pre-opens the
+When you are using the "stream" protocol, this call pre-opens the
 tcp socket.  It's only necessary to do this if you want to
 provide a different timeout when creating the connection, or
 remove the overhead of establishing the connection from the
@@ -845,6 +1593,31 @@ automatically opened the first time C<ping()> is called.
 This call simply does nothing if you are using any protocol other
 than stream.
 
+=item $p->ack( [ $host ] );
+
+When using the "syn" protocol, use this method to determine
+the reachability of the remote host.  This method is meant
+to be called up to as many times as ping() was called.  Each
+call returns the host (as passed to ping()) that came back
+with the TCP ACK.  The order in which the hosts are returned
+may not necessarily be the same order in which they were
+SYN queued using the ping() method.  If the timeout is
+reached before the TCP ACK is received, or if the remote
+host is not listening on the port attempted, then the TCP
+connection will not be established and ack() will return
+undef.  In list context, the host, the ack time, and the
+dotted ip string will be returned instead of just the host.
+If the optional $host argument is specified, the return
+value will be partaining to that host only.
+This call simply does nothing if you are using any protocol
+other than syn.
+
+=item $p->nack( $failed_ack_host );
+
+The reason that host $failed_ack_host did not receive a
+valid ACK.  Useful to find out why when ack( $fail_ack_host )
+returns a false value.
+
 =item $p->close();
 
 Close the network connection for this ping object.  The network
@@ -863,13 +1636,6 @@ version of Net::Ping.
 
 =back
 
-=head1 WARNING
-
-pingecho() or a ping object with the tcp protocol use alarm() to
-implement the timeout.  So, don't use alarm() in your program while
-you are using pingecho() or a ping object with the tcp protocol.  The
-udp and icmp protocols do not use alarm() to implement the timeout.
-
 =head1 NOTES
 
 There will be less network overhead (and some efficiency in your
@@ -903,7 +1669,7 @@ kinds of ICMP packets.
 
 The latest source tree is available via cvs:
 
-  cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware co Net-Ping
+  cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
   cd Net-Ping
 
 The tarball can be created as follows:
@@ -936,6 +1702,16 @@ Or install it RPM Style:
 
   rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
 
+=head1 BUGS
+
+For a list of known issues, visit:
+
+https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ping
+
+To report a new bug, visit:
+
+https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ping
+
 =head1 AUTHORS
 
   Current maintainer:
@@ -956,11 +1732,13 @@ Or install it RPM Style:
 
 =head1 COPYRIGHT
 
-Copyright (c) 2002, Rob Brown.  All rights reserved.
+Copyright (c) 2002-2003, Rob Brown.  All rights reserved.
 
 Copyright (c) 2001, Colin McMillen.  All rights reserved.
 
 This program is free software; you may redistribute it and/or
 modify it under the same terms as Perl itself.
 
+$Id: Ping.pm,v 1.7 2003/12/03 03:02:39 millert Exp $
+
 =cut
diff --git a/gnu/usr.bin/perl/lib/Net/Ping/README b/gnu/usr.bin/perl/lib/Net/Ping/README
deleted file mode 100644
index 2dc4b952806..00000000000
--- a/gnu/usr.bin/perl/lib/Net/Ping/README
+++ /dev/null
@@ -1,264 +0,0 @@
-NAME
-    Net::Ping - check a remote host for reachability
-
-    $Id: Ping.pm,v 1.6 2002/06/19 15:23:48 rob Exp $
-
-SYNOPSIS
-        use Net::Ping;
-
-        $p = Net::Ping->new();
-        print "$host is alive.\n" if $p->ping($host);
-        $p->close();
-
-        $p = Net::Ping->new("icmp");
-        $p->bind($my_addr); # Specify source interface of pings
-        foreach $host (@host_array)
-        {
-            print "$host is ";
-            print "NOT " unless $p->ping($host, 2);
-            print "reachable.\n";
-            sleep(1);
-        }
-        $p->close();
-
-        $p = Net::Ping->new("tcp", 2);
-        # Try connecting to the www port instead of the echo port
-        $p->{port_num} = getservbyname("http", "tcp");
-        while ($stop_time > time())
-        {
-            print "$host not reachable ", scalar(localtime()), "\n"
-                unless $p->ping($host);
-            sleep(300);
-        }
-        undef($p);
-
-        # High precision syntax (requires Time::HiRes)
-        $p = Net::Ping->new();
-        $p->hires();
-        ($ret, $duration, $ip) = $p->ping($host, 5.5);
-        printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
-          if $ret;
-        $p->close();
-
-        # For backward compatibility
-        print "$host is alive.\n" if pingecho($host);
-
-DESCRIPTION
-    This module contains methods to test the reachability of remote hosts on
-    a network. A ping object is first created with optional parameters, a
-    variable number of hosts may be pinged multiple times and then the
-    connection is closed.
-
-    You may choose one of four different protocols to use for the ping. The
-    "udp" protocol is the default. Note that a live remote host may still
-    fail to be pingable by one or more of these protocols. For example,
-    www.microsoft.com is generally alive but not pingable.
-
-    With the "tcp" protocol the ping() method attempts to establish a
-    connection to the remote host's echo port. If the connection is
-    successfully established, the remote host is considered reachable. No
-    data is actually echoed. This protocol does not require any special
-    privileges but has higher overhead than the other two protocols.
-
-    Specifying the "udp" protocol causes the ping() method to send a udp
-    packet to the remote host's echo port. If the echoed packet is received
-    from the remote host and the received packet contains the same data as
-    the packet that was sent, the remote host is considered reachable. This
-    protocol does not require any special privileges. It should be borne in
-    mind that, for a udp ping, a host will be reported as unreachable if it
-    is not running the appropriate echo service. For Unix-like systems see
-    the inetd(8) manpage for more information.
-
-    If the "icmp" protocol is specified, the ping() method sends an icmp
-    echo message to the remote host, which is what the UNIX ping program
-    does. If the echoed message is received from the remote host and the
-    echoed information is correct, the remote host is considered reachable.
-    Specifying the "icmp" protocol requires that the program be run as root
-    or that the program be setuid to root.
-
-    If the "external" protocol is specified, the ping() method attempts to
-    use the `Net::Ping::External' module to ping the remote host.
-    `Net::Ping::External' interfaces with your system's default `ping'
-    utility to perform the ping, and generally produces relatively accurate
-    results. If `Net::Ping::External' if not installed on your system,
-    specifying the "external" protocol will result in an error.
-
-  Functions
-
-    Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
-        Create a new ping object. All of the parameters are optional. $proto
-        specifies the protocol to use when doing a ping. The current choices
-        are "tcp", "udp" or "icmp". The default is "udp".
-
-        If a default timeout ($def_timeout) in seconds is provided, it is
-        used when a timeout is not given to the ping() method (below). The
-        timeout must be greater than 0 and the default, if not specified, is
-        5 seconds.
-
-        If the number of data bytes ($bytes) is given, that many data bytes
-        are included in the ping packet sent to the remote host. The number
-        of data bytes is ignored if the protocol is "tcp". The minimum (and
-        default) number of data bytes is 1 if the protocol is "udp" and 0
-        otherwise. The maximum number of data bytes that can be specified is
-        1024.
-
-    $p->ping($host [, $timeout]);
-        Ping the remote host and wait for a response. $host can be either
-        the hostname or the IP number of the remote host. The optional
-        timeout must be greater than 0 seconds and defaults to whatever was
-        specified when the ping object was created. Returns a success flag.
-        If the hostname cannot be found or there is a problem with the IP
-        number, the success flag returned will be undef. Otherwise, the
-        success flag will be 1 if the host is reachable and 0 if it is not.
-        For most practical purposes, undef and 0 and can be treated as the
-        same case. In array context, the elapsed time is also returned. The
-        elapsed time value will be a float, as retuned by the
-        Time::HiRes::time() function, if hires() has been previously called,
-        otherwise it is returned as an integer.
-
-    $p->source_verify( { 0 | 1 } );
-        Allows source endpoint verification to be enabled or disabled. This
-        is useful for those remote destinations with multiples interfaces
-        where the response may not originate from the same endpoint that the
-        original destination endpoint was sent to. This only affects udp and
-        icmp protocol pings.
-
-        This is enabled by default.
-
-    $p->hires( { 0 | 1 } );
-        Causes this module to use Time::HiRes module, allowing milliseconds
-        to be returned by subsequent calls to ping().
-
-        This is disabled by default.
-
-    $p->bind($local_addr);
-        Sets the source address from which pings will be sent. This must be
-        the address of one of the interfaces on the local host. $local_addr
-        may be specified as a hostname or as a text IP address such as
-        "192.168.1.1".
-
-        If the protocol is set to "tcp", this method may be called any
-        number of times, and each call to the ping() method (below) will use
-        the most recent $local_addr. If the protocol is "icmp" or "udp",
-        then bind() must be called at most once per object, and (if it is
-        called at all) must be called before the first call to ping() for
-        that object.
-
-    $p->open($host);
-        When you are using the stream protocol, this call pre-opens the tcp
-        socket. It's only necessary to do this if you want to provide a
-        different timeout when creating the connection, or remove the
-        overhead of establishing the connection from the first ping. If you
-        don't call `open()', the connection is automatically opened the
-        first time `ping()' is called. This call simply does nothing if you
-        are using any protocol other than stream.
-
-    $p->close();
-        Close the network connection for this ping object. The network
-        connection is also closed by "undef $p". The network connection is
-        automatically closed if the ping object goes out of scope (e.g. $p
-        is local to a subroutine and you leave the subroutine).
-
-    pingecho($host [, $timeout]);
-        To provide backward compatibility with the previous version of
-        Net::Ping, a pingecho() subroutine is available with the same
-        functionality as before. pingecho() uses the tcp protocol. The
-        return values and parameters are the same as described for the
-        ping() method. This subroutine is obsolete and may be removed in a
-        future version of Net::Ping.
-
-WARNING
-    pingecho() or a ping object with the tcp protocol use alarm() to
-    implement the timeout. So, don't use alarm() in your program while you
-    are using pingecho() or a ping object with the tcp protocol. The udp and
-    icmp protocols do not use alarm() to implement the timeout.
-
-NOTES
-    There will be less network overhead (and some efficiency in your
-    program) if you specify either the udp or the icmp protocol. The tcp
-    protocol will generate 2.5 times or more traffic for each ping than
-    either udp or icmp. If many hosts are pinged frequently, you may wish to
-    implement a small wait (e.g. 25ms or more) between each ping to avoid
-    flooding your network with packets.
-
-    The icmp protocol requires that the program be run as root or that it be
-    setuid to root. The other protocols do not require special privileges,
-    but not all network devices implement tcp or udp echo.
-
-    Local hosts should normally respond to pings within milliseconds.
-    However, on a very congested network it may take up to 3 seconds or
-    longer to receive an echo packet from the remote host. If the timeout is
-    set too low under these conditions, it will appear that the remote host
-    is not reachable (which is almost the truth).
-
-    Reachability doesn't necessarily mean that the remote host is actually
-    functioning beyond its ability to echo packets. tcp is slightly better
-    at indicating the health of a system than icmp because it uses more of
-    the networking stack to respond.
-
-    Because of a lack of anything better, this module uses its own routines
-    to pack and unpack ICMP packets. It would be better for a separate
-    module to be written which understands all of the different kinds of
-    ICMP packets.
-
-INSTALL
-    The latest source tree is available via cvs:
-
-      cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware co Net-Ping
-      cd Net-Ping
-
-    The tarball can be created as follows:
-
-      perl Makefile.PL ; make ; make dist
-
-    The latest Net::Ping release can be found at CPAN:
-
-      $CPAN/modules/by-module/Net/
-
-    1) Extract the tarball
-
-      gtar -zxvf Net-Ping-xxxx.tar.gz
-      cd Net-Ping-xxxx
-
-    2) Build:
-
-      make realclean
-      perl Makefile.PL
-      make
-      make test
-
-    3) Install
-
-      make install
-
-    Or install it RPM Style:
-
-      rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
-
-      rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
-
-AUTHORS
-      Current maintainer:
-        bbb@cpan.org (Rob Brown)
-
-      External protocol:
-        colinm@cpan.org (Colin McMillen)
-
-      Stream protocol:
-        bronson@trestle.com (Scott Bronson)
-
-      Original pingecho():
-        karrer@bernina.ethz.ch (Andreas Karrer)
-        pmarquess@bfsec.bt.co.uk (Paul Marquess)
-
-      Original Net::Ping author:
-        mose@ns.ccsn.edu (Russell Mosemann)
-
-COPYRIGHT
-    Copyright (c) 2002, Rob Brown. All rights reserved.
-
-    Copyright (c) 2001, Colin McMillen. All rights reserved.
-
-    This program is free software; you may redistribute it and/or modify it
-    under the same terms as Perl itself.
-
diff --git a/gnu/usr.bin/perl/lib/Net/hostent.pm b/gnu/usr.bin/perl/lib/Net/hostent.pm
index 04cbee35a7c..3a2fc013877 100644
--- a/gnu/usr.bin/perl/lib/Net/hostent.pm
+++ b/gnu/usr.bin/perl/lib/Net/hostent.pm
@@ -2,7 +2,7 @@ package Net::hostent;
 use strict;
 
 use 5.006_001;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
@@ -70,7 +70,7 @@ Net::hostent - by-name interface to Perl's built-in gethost*() functions
 
 =head1 SYNOPSIS
 
- use Net::hostnet;
+ use Net::hostent;
 
 =head1 DESCRIPTION
 
diff --git a/gnu/usr.bin/perl/lib/Net/servent.pm b/gnu/usr.bin/perl/lib/Net/servent.pm
index 63ae3079fe7..78a16814555 100644
--- a/gnu/usr.bin/perl/lib/Net/servent.pm
+++ b/gnu/usr.bin/perl/lib/Net/servent.pm
@@ -2,7 +2,7 @@ package Net::servent;
 use strict;
 
 use 5.006_001;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN {
     use Exporter   ();
@@ -74,10 +74,10 @@ method returns an array reference, the rest scalars.
 You may also import all the structure fields directly into your namespace
 as regular variables using the :FIELDS import tag.  (Note that this still
 overrides your core functions.)  Access these fields as variables named
-with a preceding C<n_>.  Thus, C<$serv_obj-E<gt>name()> corresponds to
+with a preceding C<s_>.  Thus, C<$serv_obj-E<gt>name()> corresponds to
 $s_name if you import the fields.  Array references are available as
-regular array variables, so for example C<@{ $serv_obj-E<gt>aliases()
-}> would be simply @s_aliases.
+regular array variables, so for example C<@{ $serv_obj-E<gt>aliases()}>
+would be simply @s_aliases.
 
 The getserv() function is a simple front-end that forwards a numeric
 argument to getservbyport(), and the rest to getservbyname().
diff --git a/gnu/usr.bin/perl/lib/Pod/Functions.pm b/gnu/usr.bin/perl/lib/Pod/Functions.pm
index 7f7e15060a2..e185381bc44 100644
--- a/gnu/usr.bin/perl/lib/Pod/Functions.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Functions.pm
@@ -7,7 +7,7 @@ Pod::Functions - Group Perl's functions a la perlfunc.pod
 
 =head1 SYNOPSIS
 
-    use Pod:Functions;
+    use Pod::Functions;
     
     my @misc_ops = @{ $Kinds{ 'Misc' } };
     my $misc_dsc = $Type_Description{ 'Misc' };
@@ -54,6 +54,9 @@ L<perlfunc/"Perl Functions by Category"> section.
 
 =head1 CHANGES
 
+1.02 20020813 <abe@ztreet.demon.nl>
+    de-typo in the SYNOPSIS section (thanks Mike Castle for noticing)
+
 1.01 20011229 <abe@ztreet.demon.nl>
     fixed some bugs that slipped in after 5.6.1
     added the pod
@@ -64,7 +67,7 @@ L<perlfunc/"Perl Functions by Category"> section.
 
 =cut
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 require Exporter;
 
@@ -281,12 +284,13 @@ qq/STRING/	String	doubly quote a string
 quotemeta	Regexp	quote regular expression magic characters
 qw/STRING/	LIST	quote a list of words
 qx/STRING/	Process	backquote quote a string
-qr/PATTERN/	Regexp	Compile pattern 
+qr/STRING/	Regexp	Compile pattern 
 rand	Math	retrieve the next pseudorandom number 
 read	I/O,Binary	fixed-length buffered input from a filehandle
 readdir	I/O	get a directory from a directory handle
 readline	I/O	fetch a record from a file
 readlink	File	determine where a symbolic link is pointing
+readpipe	Process	execute a system command and collect standard output
 recv	Socket	receive a message over a Socket
 redo	Flow	start this loop iteration over again
 ref	Objects	find out the type of thing being referenced
@@ -338,6 +342,7 @@ sub	Flow	declare a subroutine, possibly anonymously
 substr	String	get or alter a portion of a stirng
 symlink	File	create a symbolic link to a file
 syscall	I/O,Binary	execute an arbitrary system call
+sysopen	File	open a file, pipe, or descriptor
 sysread	I/O,Binary	fixed-length unbuffered input from a filehandle
 sysseek	I/O,Binary	position I/O pointer on handle used with sysread and syswrite
 system	Process	run a separate program 
@@ -345,6 +350,7 @@ syswrite	I/O,Binary	fixed-length unbuffered output to a filehandle
 tell	I/O	get current seekpointer on a filehandle
 telldir	I/O	get current seekpointer on a directory handle
 tie	Objects	bind a variable to an object class 
+tied	Objects	get a reference to the object underlying a tied variable
 time	Time	return number of seconds since 1970
 times	Process,Time	return elapsed time for self and child processes
 tr///	String	transliterate a string
diff --git a/gnu/usr.bin/perl/lib/Pod/Html.pm b/gnu/usr.bin/perl/lib/Pod/Html.pm
index eebc4dbf3be..c4af19cb80e 100644
--- a/gnu/usr.bin/perl/lib/Pod/Html.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Html.pm
@@ -2,10 +2,11 @@ package Pod::Html;
 use strict;
 require Exporter;
 
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 1.04;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+$VERSION = 1.0501;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
+@EXPORT_OK = qw(anchorify);
 
 use Carp;
 use Config;
@@ -201,105 +202,97 @@ This program is distributed under the Artistic License.
 
 =cut
 
-my $cachedir = ".";		# The directory to which item and directory
-				# caches will be written.
-my $cache_ext = $^O eq 'VMS' ? ".tmp" : ".x~~";
-my $dircache = "pod2htmd$cache_ext";
-my $itemcache = "pod2htmi$cache_ext";
 
-my @begin_stack = ();		# begin/end stack
+my($Cachedir);
+my($Dircache, $Itemcache);
+my @Begin_Stack;
+my @Libpods;
+my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
+my($Podfile, @Podpath, $Podroot);
+my $Css;
 
-my @libpods = ();	    	# files to search for links from C<> directives
-my $htmlroot = "/";	    	# http-server base directory from which all
-				#   relative paths in $podpath stem.
-my $htmldir = "";		# The directory to which the html pages
-				# will (eventually) be written.
-my $htmlfile = "";		# write to stdout by default
-my $htmlfileurl = "" ;		# The url that other files would use to
-				# refer to this file.  This is only used
-				# to make relative urls that point to
-				# other files.
-my $podfile = "";		# read from stdin by default
-my @podpath = ();		# list of directories containing library pods.
-my $podroot = File::Spec->curdir;		# filesystem base directory from which all
-				#   relative paths in $podpath stem.
-my $css = '';                   # Cascading style sheet
-my $recurse = 1;		# recurse on subdirectories in $podpath.
-my $quiet = 0;			# not quiet by default
-my $verbose = 0;		# not verbose by default
-my $doindex = 1;   	    	# non-zero if we should generate an index
-my $backlink = '';              # text for "back to top" links
-my $listlevel = 0;		# current list depth
-my @listend = ();		# the text to use to end the list.
-my $after_lpar = 0;             # set to true after a par in an =item
-my $ignore = 1;			# whether or not to format text.  we don't
-				#   format text until we hit our first pod
-				#   directive.
+my $Recurse;
+my $Quiet;
+my $Verbose;
+my $Doindex;
 
-my %items_named = ();		# for the multiples of the same item in perlfunc
-my @items_seen = ();
-my $title;			# title to give the pod(s)
-my $header = 0;			# produce block header/footer
-my $top = 1;			# true if we are at the top of the doc.  used
-				#   to prevent the first <hr /> directive.
-my $paragraph;			# which paragraph we're processing (used
-				#   for error messages)
-my $ptQuote = 0;                # status of double-quote conversion
-my %pages = ();			# associative array used to find the location
+my $Backlink;
+my($Listlevel, @Listend);
+my $After_Lpar;
+use vars qw($Ignore);  # need to localize it later.
+
+my(%Items_Named, @Items_Seen);
+my($Title, $Header);
+
+my $Top;
+my $Paragraph;
+
+my %Sections;
+
+# Caches
+my %Pages = ();			# associative array used to find the location
 				#   of pages referenced by L<> links.
-my %sections = ();		# sections within this page
-my %items = ();			# associative array used to find the location
+my %Items = ();			# associative array used to find the location
 				#   of =item directives referenced by C<> links
-my %local_items = ();           # local items - avoid destruction of %items
-my $Is83;                       # is dos with short filenames (8.3)
+
+my %Local_Items;
+my $Is83;
+my $PTQuote;
+
+my $Curdir = File::Spec->curdir;
+
+init_globals();
 
 sub init_globals {
-$dircache = "pod2htmd$cache_ext";
-$itemcache = "pod2htmi$cache_ext";
+    $Cachedir = ".";		# The directory to which item and directory
+				# caches will be written.
+
+    $Dircache = "pod2htmd.tmp";
+    $Itemcache = "pod2htmi.tmp";
 
-@begin_stack = ();		# begin/end stack
+    @Begin_Stack = ();		# begin/end stack
 
-@libpods = ();	    	# files to search for links from C<> directives
-$htmlroot = "/";	    	# http-server base directory from which all
+    @Libpods = ();	    	# files to search for links from C<> directives
+    $Htmlroot = "/";	    	# http-server base directory from which all
 				#   relative paths in $podpath stem.
-$htmldir = "";	    	# The directory to which the html pages
+    $Htmldir = "";	    	# The directory to which the html pages
 				# will (eventually) be written.
-$htmlfile = "";		# write to stdout by default
-$podfile = "";		# read from stdin by default
-@podpath = ();		# list of directories containing library pods.
-$podroot = File::Spec->curdir;		# filesystem base directory from which all
+    $Htmlfile = "";		# write to stdout by default
+    $Htmlfileurl = "" ;		# The url that other files would use to
+				# refer to this file.  This is only used
+				# to make relative urls that point to
+				# other files.
+
+    $Podfile = "";		# read from stdin by default
+    @Podpath = ();		# list of directories containing library pods.
+    $Podroot = $Curdir;	        # filesystem base directory from which all
 				#   relative paths in $podpath stem.
-$css = '';                   # Cascading style sheet
-$recurse = 1;		# recurse on subdirectories in $podpath.
-$quiet = 0;		# not quiet by default
-$verbose = 0;		# not verbose by default
-$doindex = 1;   	    	# non-zero if we should generate an index
-$backlink = '';		# text for "back to top" links
-$listlevel = 0;		# current list depth
-@listend = ();		# the text to use to end the list.
-$after_lpar = 0;        # set to true after a par in an =item
-$ignore = 1;			# whether or not to format text.  we don't
+    $Css = '';                  # Cascading style sheet
+    $Recurse = 1;		# recurse on subdirectories in $podpath.
+    $Quiet = 0;		        # not quiet by default
+    $Verbose = 0;		# not verbose by default
+    $Doindex = 1;   	    	# non-zero if we should generate an index
+    $Backlink = '';		# text for "back to top" links
+    $Listlevel = 0;		# current list depth
+    @Listend = ();		# the text to use to end the list.
+    $After_Lpar = 0;            # set to true after a par in an =item
+    $Ignore = 1;		# whether or not to format text.  we don't
 				#   format text until we hit our first pod
 				#   directive.
 
-@items_seen = ();
-%items_named = ();
-$header = 0;			# produce block header/footer
-$title = '';			# title to give the pod(s)
-$top = 1;			# true if we are at the top of the doc.  used
+    @Items_Seen = ();	        # for multiples of the same item in perlfunc
+    %Items_Named = ();
+    $Header = 0;		# produce block header/footer
+    $Title = '';		# title to give the pod(s)
+    $Top = 1;			# true if we are at the top of the doc.  used
 				#   to prevent the first <hr /> directive.
-$paragraph = '';			# which paragraph we're processing (used
+    $Paragraph = '';		# which paragraph we're processing (used
 				#   for error messages)
-%sections = ();		# sections within this page
+    $PTQuote = 0;               # status of double-quote conversion
+    %Sections = ();		# sections within this page
 
-# These are not reinitialised here but are kept as a cache.
-# See get_cache and related cache management code.
-#%pages = ();			# associative array used to find the location
-				#   of pages referenced by L<> links.
-#%items = ();			# associative array used to find the location
-				#   of =item directives referenced by C<> links
-%local_items = ();
-$Is83=$^O eq 'dos';
+    %Local_Items = ();
+    $Is83 = $^O eq 'dos';       # Is it an 8.3 filesystem?
 }
 
 #
@@ -328,7 +321,7 @@ sub pod2html {
 
     $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
 
-    # cache of %pages and %items from last time we ran pod2html
+    # cache of %Pages and %Items from last time we ran pod2html
 
     #undef $opt_help if defined $opt_help;
 
@@ -336,36 +329,36 @@ sub pod2html {
     parse_command_line();
 
     # escape the backlink argument (same goes for title but is done later...)
-    $backlink = html_escape($backlink) if defined $backlink;
+    $Backlink = html_escape($Backlink) if defined $Backlink;
 
     # set some variables to their default values if necessary
     local *POD;
     unless (@ARGV && $ARGV[0]) {
-	$podfile  = "-" unless $podfile;	# stdin
-	open(POD, "<$podfile")
-		|| die "$0: cannot open $podfile file for input: $!\n";
+	$Podfile  = "-" unless $Podfile;	# stdin
+	open(POD, "<$Podfile")
+		|| die "$0: cannot open $Podfile file for input: $!\n";
     } else {
-	$podfile = $ARGV[0];  # XXX: might be more filenames
+	$Podfile = $ARGV[0];  # XXX: might be more filenames
 	*POD = *ARGV;
     }
-    $htmlfile = "-" unless $htmlfile;	# stdout
-    $htmlroot = "" if $htmlroot eq "/";	# so we don't get a //
-    $htmldir =~ s#/\z## ;               # so we don't get a //
-    if (  $htmlroot eq ''
-       && defined( $htmldir )
-       && $htmldir ne ''
-       && substr( $htmlfile, 0, length( $htmldir ) ) eq $htmldir
+    $Htmlfile = "-" unless $Htmlfile;	# stdout
+    $Htmlroot = "" if $Htmlroot eq "/";	# so we don't get a //
+    $Htmldir =~ s#/\z## ;               # so we don't get a //
+    if (  $Htmlroot eq ''
+       && defined( $Htmldir )
+       && $Htmldir ne ''
+       && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir
        )
     {
 	# Set the 'base' url for this file, so that we can use it
 	# as the location from which to calculate relative links
 	# to other files. If this is '', then absolute links will
 	# be used throughout.
-        $htmlfileurl= "$htmldir/" . substr( $htmlfile, length( $htmldir ) + 1);
+        $Htmlfileurl= "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
     }
 
     # read the pod a paragraph at a time
-    warn "Scanning for sections in input file(s)\n" if $verbose;
+    warn "Scanning for sections in input file(s)\n" if $Verbose;
     $/ = "";
     my @poddata  = <POD>;
     close(POD);
@@ -391,64 +384,64 @@ sub pod2html {
     clean_data( \@poddata );
 
     # scan the pod for =head[1-6] directives and build an index
-    my $index = scan_headings(\%sections, @poddata);
+    my $index = scan_headings(\%Sections, @poddata);
 
     unless($index) {
-	warn "No headings in $podfile\n" if $verbose;
+	warn "No headings in $Podfile\n" if $Verbose;
     }
 
     # open the output file
-    open(HTML, ">$htmlfile")
-	    || die "$0: cannot open $htmlfile file for output: $!\n";
+    open(HTML, ">$Htmlfile")
+	    || die "$0: cannot open $Htmlfile file for output: $!\n";
 
     # put a title in the HTML file if one wasn't specified
-    if ($title eq '') {
+    if ($Title eq '') {
 	TITLE_SEARCH: {
  	    for (my $i = 0; $i < @poddata; $i++) {
 		if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
  		    for my $para ( @poddata[$i, $i+1] ) {
 			last TITLE_SEARCH
-			    if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
+			    if ($Title) = $para =~ /(\S+\s+-+.*\S)/s;
 		    }
 		}
 
 	    }
 	}
     }
-    if (!$title and $podfile =~ /\.pod\z/) {
+    if (!$Title and $Podfile =~ /\.pod\z/) {
 	# probably a split pod so take first =head[12] as title
  	for (my $i = 0; $i < @poddata; $i++) {
-	    last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
+	    last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
 	}
-	warn "adopted '$title' as title for $podfile\n"
-	    if $verbose and $title;
+	warn "adopted '$Title' as title for $Podfile\n"
+	    if $Verbose and $Title;
     }
-    if ($title) {
-	$title =~ s/\s*\(.*\)//;
+    if ($Title) {
+	$Title =~ s/\s*\(.*\)//;
     } else {
-	warn "$0: no title for $podfile.\n" unless $quiet;
-	$podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
-	$title = ($podfile eq "-" ? 'No Title' : $1);
-	warn "using $title" if $verbose;
+	warn "$0: no title for $Podfile.\n" unless $Quiet;
+	$Podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
+	$Title = ($Podfile eq "-" ? 'No Title' : $1);
+	warn "using $Title" if $Verbose;
     }
-    $title = html_escape($title);
+    $Title = html_escape($Title);
 
     my $csslink = '';
     my $bodystyle = ' style="background-color: white"';
     my $tdstyle = ' style="background-color: #cccccc"';
 
-    if ($css) {
-      $csslink = qq(\n<link rel="stylesheet" href="$css" type="text/css" />);
+    if ($Css) {
+      $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
       $csslink =~ s,\\,/,g;
       $csslink =~ s,(/.):,$1|,;
       $bodystyle = '';
       $tdstyle = '';
     }
 
-      my $block = $header ? <<END_OF_BLOCK : '';
+      my $block = $Header ? <<END_OF_BLOCK : '';
 <table border="0" width="100%" cellspacing="0" cellpadding="3">
 <tr><td class="block"$tdstyle valign="middle">
-<big><strong><span class="block">&nbsp;$title</span></strong></big>
+<big><strong><span class="block">&nbsp;$Title</span></strong></big>
 </td></tr>
 </table>
 END_OF_BLOCK
@@ -457,7 +450,7 @@ END_OF_BLOCK
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml">
 <head>
-<title>$title</title>$csslink
+<title>$Title</title>$csslink
 <link rev="made" href="mailto:$Config{perladmin}" />
 </head>
 
@@ -465,35 +458,35 @@ END_OF_BLOCK
 $block
 END_OF_HEAD
 
-    # load/reload/validate/cache %pages and %items
-    get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
+    # load/reload/validate/cache %Pages and %Items
+    get_cache($Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse);
 
     # scan the pod for =item directives
-    scan_items( \%local_items, "", @poddata);
+    scan_items( \%Local_Items, "", @poddata);
 
-    # put an index at the top of the file.  note, if $doindex is 0 we
+    # put an index at the top of the file.  note, if $Doindex is 0 we
     # still generate an index, but surround it with an html comment.
     # that way some other program can extract it if desired.
     $index =~ s/--+/-/g;
     print HTML "<p><a name=\"__index__\"></a></p>\n";
     print HTML "<!-- INDEX BEGIN -->\n";
-    print HTML "<!--\n" unless $doindex;
+    print HTML "<!--\n" unless $Doindex;
     print HTML $index;
-    print HTML "-->\n" unless $doindex;
+    print HTML "-->\n" unless $Doindex;
     print HTML "<!-- INDEX END -->\n\n";
-    print HTML "<hr />\n" if $doindex and $index;
+    print HTML "<hr />\n" if $Doindex and $index;
 
     # now convert this file
     my $after_item;             # set to true after an =item
     my $need_dd = 0;
-    warn "Converting input file $podfile\n" if $verbose;
+    warn "Converting input file $Podfile\n" if $Verbose;
     foreach my $i (0..$#poddata){
-        $ptQuote = 0; # status of quote conversion
+        $PTQuote = 0; # status of quote conversion
 
 	$_ = $poddata[$i];
-	$paragraph = $i+1;
+	$Paragraph = $i+1;
 	if (/^(=.*)/s) {	# is it a pod directive?
-	    $ignore = 0;
+	    $Ignore = 0;
 	    $after_item = 0;
 	    $need_dd = 0;
 	    $_ = $1;
@@ -506,10 +499,10 @@ END_OF_HEAD
 	    } elsif (/^=pod/) {			# =pod
 		process_pod();
 	    } else {
-		next if @begin_stack && $begin_stack[-1] ne 'html';
+		next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
 
 		if (/^=(head[1-6])\s+(.*\S)/s) {	# =head[1-6] heading
-		    process_head( $1, $2, $doindex && $index );
+		    process_head( $1, $2, $Doindex && $index );
 		} elsif (/^=item\s*(.*\S)?/sm) {	# =item text
 		    $need_dd = process_item( $1 );
 		    $after_item = 1;
@@ -521,16 +514,16 @@ END_OF_HEAD
 		    process_for($1,$2);
 		} else {
 		    /^=(\S*)\s*/;
-		    warn "$0: $podfile: unknown pod directive '$1' in "
-		       . "paragraph $paragraph.  ignoring.\n";
+		    warn "$0: $Podfile: unknown pod directive '$1' in "
+		       . "paragraph $Paragraph.  ignoring.\n";
 		}
 	    }
-	    $top = 0;
+	    $Top = 0;
 	}
 	else {
-	    next if $ignore;
-	    next if @begin_stack && $begin_stack[-1] ne 'html';
-	    print HTML and next if @begin_stack && $begin_stack[-1] eq 'html';
+	    next if $Ignore;
+	    next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
+	    print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
 	    print HTML "<dd>\n" if $need_dd;
 	    my $text = $_;
 	    if( $text =~ /\A\s+/ ){
@@ -564,7 +557,7 @@ END_OF_HEAD
 
 		if( $after_item ){
 		    print HTML "$text\n";
-		    $after_lpar = 1;
+		    $After_Lpar = 1;
 		} else {
 		    print HTML "<p>$text</p>\n";
 		}
@@ -578,8 +571,8 @@ END_OF_HEAD
     finish_list();
 
     # link to page index
-    print HTML "<p><a href=\"#__index__\"><small>$backlink</small></a></p>\n"
-	if $doindex and $index and $backlink;
+    print HTML "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n"
+	if $Doindex and $index and $Backlink;
 
     print HTML <<END_OF_TAIL;
 $block
@@ -591,19 +584,15 @@ END_OF_TAIL
     # close the html file
     close(HTML);
 
-    warn "Finished\n" if $verbose;
+    warn "Finished\n" if $Verbose;
 }
 
 ##############################################################################
 
-my $usage;			# see below
 sub usage {
     my $podfile = shift;
     warn "$0: $podfile: @_\n" if @_;
-    die $usage;
-}
-
-$usage =<<END_OF_USAGE;
+    die <<END_OF_USAGE;
 Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
            --podpath=<name>:...:<name> --podroot=<name>
            --libpods=<name>:...:<name> --recurse --verbose --index
@@ -641,6 +630,8 @@ Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
 
 END_OF_USAGE
 
+}
+
 sub parse_command_line {
     my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help,
 	$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,
@@ -674,33 +665,35 @@ sub parse_command_line {
     usage("-") if defined $opt_help;	# see if the user asked for help
     $opt_help = "";			# just to make -w shut-up.
 
-    @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
-    @libpods  = split(":", $opt_libpods) if defined $opt_libpods;
-
-    $backlink = $opt_backlink if defined $opt_backlink;
-    $cachedir = $opt_cachedir if defined $opt_cachedir;
-    $css      = $opt_css      if defined $opt_css;
-    $header   = $opt_header   if defined $opt_header;
-    $htmldir  = $opt_htmldir  if defined $opt_htmldir;
-    $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
-    $doindex  = $opt_index    if defined $opt_index;
-    $podfile  = $opt_infile   if defined $opt_infile;
-    $htmlfile = $opt_outfile  if defined $opt_outfile;
-    $podroot  = $opt_podroot  if defined $opt_podroot;
-    $quiet    = $opt_quiet    if defined $opt_quiet;
-    $recurse  = $opt_recurse  if defined $opt_recurse;
-    $title    = $opt_title    if defined $opt_title;
-    $verbose  = $opt_verbose  if defined $opt_verbose;
+    @Podpath  = split(":", $opt_podpath) if defined $opt_podpath;
+    @Libpods  = split(":", $opt_libpods) if defined $opt_libpods;
+
+    $Backlink = $opt_backlink if defined $opt_backlink;
+    $Cachedir = $opt_cachedir if defined $opt_cachedir;
+    $Css      = $opt_css      if defined $opt_css;
+    $Header   = $opt_header   if defined $opt_header;
+    $Htmldir  = $opt_htmldir  if defined $opt_htmldir;
+    $Htmlroot = $opt_htmlroot if defined $opt_htmlroot;
+    $Doindex  = $opt_index    if defined $opt_index;
+    $Podfile  = $opt_infile   if defined $opt_infile;
+    $Htmlfile = $opt_outfile  if defined $opt_outfile;
+    $Podroot  = $opt_podroot  if defined $opt_podroot;
+    $Quiet    = $opt_quiet    if defined $opt_quiet;
+    $Recurse  = $opt_recurse  if defined $opt_recurse;
+    $Title    = $opt_title    if defined $opt_title;
+    $Verbose  = $opt_verbose  if defined $opt_verbose;
 
     warn "Flushing item and directory caches\n"
 	if $opt_verbose && defined $opt_flush;
-    $dircache = "$cachedir/pod2htmd$cache_ext";
-    $itemcache = "$cachedir/pod2htmi$cache_ext";
-    unlink($dircache, $itemcache) if defined $opt_flush;
+    $Dircache = "$Cachedir/pod2htmd.tmp";
+    $Itemcache = "$Cachedir/pod2htmi.tmp";
+    if (defined $opt_flush) {
+	1 while unlink($Dircache, $Itemcache);
+    }
 }
 
 
-my $saved_cache_key;
+my $Saved_Cache_Key;
 
 sub get_cache {
     my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
@@ -712,23 +705,23 @@ sub get_cache {
 
     my $this_cache_key = cache_key(@cache_key_args);
 
-    return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
+    return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
 
-    # load the cache of %pages and %items if possible.  $tests will be
+    # load the cache of %Pages and %Items if possible.  $tests will be
     # non-zero if successful.
     my $tests = 0;
     if (-f $dircache && -f $itemcache) {
-	warn "scanning for item cache\n" if $verbose;
+	warn "scanning for item cache\n" if $Verbose;
 	$tests = load_cache($dircache, $itemcache, $podpath, $podroot);
     }
 
     # if we didn't succeed in loading the cache then we must (re)build
-    #  %pages and %items.
+    #  %Pages and %Items.
     if (!$tests) {
-	warn "scanning directories in pod-path\n" if $verbose;
+	warn "scanning directories in pod-path\n" if $Verbose;
 	scan_podpath($podroot, $recurse, 0);
     }
-    $saved_cache_key = cache_key(@cache_key_args);
+    $Saved_Cache_Key = cache_key(@cache_key_args);
 }
 
 sub cache_key {
@@ -739,7 +732,7 @@ sub cache_key {
 
 #
 # load_cache - tries to find if the caches stored in $dircache and $itemcache
-#  are valid caches of %pages and %items.  if they are valid then it loads
+#  are valid caches of %Pages and %Items.  if they are valid then it loads
 #  them and returns a non-zero value.
 #
 sub load_cache {
@@ -769,14 +762,14 @@ sub load_cache {
 	return 0;
     }
 
-    warn "loading item cache\n" if $verbose;
+    warn "loading item cache\n" if $Verbose;
     while (<CACHE>) {
 	/(.*?) (.*)$/;
-	$items{$1} = $2;
+	$Items{$1} = $2;
     }
     close(CACHE);
 
-    warn "scanning for directory cache\n" if $verbose;
+    warn "scanning for directory cache\n" if $Verbose;
     open(CACHE, "<$dircache") ||
 	die "$0: error opening $dircache for reading: $!\n";
     $/ = "\n";
@@ -798,10 +791,10 @@ sub load_cache {
 	return 0;
     }
 
-    warn "loading directory cache\n" if $verbose;
+    warn "loading directory cache\n" if $Verbose;
     while (<CACHE>) {
 	/(.*?) (.*)$/;
-	$pages{$1} = $2;
+	$Pages{$1} = $2;
     }
 
     close(CACHE);
@@ -812,7 +805,7 @@ sub load_cache {
 #
 # scan_podpath - scans the directories specified in @podpath for directories,
 #  .pod files, and .pm files.  it also scans the pod files specified in
-#  @libpods for =item directives.
+#  @Libpods for =item directives.
 #
 sub scan_podpath {
     my($podroot, $recurse, $append) = @_;
@@ -820,28 +813,28 @@ sub scan_podpath {
     my($libpod, $dirname, $pod, @files, @poddata);
 
     unless($append) {
-	%items = ();
-	%pages = ();
+	%Items = ();
+	%Pages = ();
     }
 
-    # scan each directory listed in @podpath
+    # scan each directory listed in @Podpath
     $pwd = getcwd();
     chdir($podroot)
 	|| die "$0: error changing to directory $podroot: $!\n";
-    foreach $dir (@podpath) {
+    foreach $dir (@Podpath) {
 	scan_dir($dir, $recurse);
     }
 
-    # scan the pods listed in @libpods for =item directives
-    foreach $libpod (@libpods) {
+    # scan the pods listed in @Libpods for =item directives
+    foreach $libpod (@Libpods) {
 	# if the page isn't defined then we won't know where to find it
 	# on the system.
-	next unless defined $pages{$libpod} && $pages{$libpod};
+	next unless defined $Pages{$libpod} && $Pages{$libpod};
 
 	# if there is a directory then use the .pod and .pm files within it.
 	# NOTE: Only finds the first so-named directory in the tree.
-#	if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
-	if ($pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
+#	if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	if ($Pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
 	    #  find all the .pod and .pm files within the directory
 	    $dirname = $1;
 	    opendir(DIR, $dirname) ||
@@ -857,17 +850,17 @@ sub scan_podpath {
 		close(POD);
 		clean_data( \@poddata );
 
-		scan_items( \%items, "$dirname/$pod", @poddata);
+		scan_items( \%Items, "$dirname/$pod", @poddata);
 	    }
 
 	    # use the names of files as =item directives too.
 ### Don't think this should be done this way - confuses issues.(WL)
 ###	    foreach $pod (@files) {
 ###		$pod =~ /^(.*)(\.pod|\.pm)$/;
-###		$items{$1} = "$dirname/$1.html" if $1;
+###		$Items{$1} = "$dirname/$1.html" if $1;
 ###	    }
-	} elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
-		 $pages{$libpod} =~ /([^:]*\.pm):/) {
+	} elsif ($Pages{$libpod} =~ /([^:]*\.pod):/ ||
+		 $Pages{$libpod} =~ /([^:]*\.pm):/) {
 	    # scan the .pod or .pm file for =item directives
 	    $pod = $1;
 	    open(POD, "<$pod") ||
@@ -876,7 +869,7 @@ sub scan_podpath {
 	    close(POD);
 	    clean_data( \@poddata );
 
-	    scan_items( \%items, "$pod", @poddata);
+	    scan_items( \%Items, "$pod", @poddata);
 	} else {
 	    warn "$0: shouldn't be here (line ".__LINE__."\n";
 	}
@@ -887,25 +880,25 @@ sub scan_podpath {
 	|| die "$0: error changing to directory $pwd: $!\n";
 
     # cache the item list for later use
-    warn "caching items for later use\n" if $verbose;
-    open(CACHE, ">$itemcache") ||
-	die "$0: error open $itemcache for writing: $!\n";
+    warn "caching items for later use\n" if $Verbose;
+    open(CACHE, ">$Itemcache") ||
+	die "$0: error open $Itemcache for writing: $!\n";
 
-    print CACHE join(":", @podpath) . "\n$podroot\n";
-    foreach my $key (keys %items) {
-	print CACHE "$key $items{$key}\n";
+    print CACHE join(":", @Podpath) . "\n$podroot\n";
+    foreach my $key (keys %Items) {
+	print CACHE "$key $Items{$key}\n";
     }
 
     close(CACHE);
 
     # cache the directory list for later use
-    warn "caching directories for later use\n" if $verbose;
-    open(CACHE, ">$dircache") ||
-	die "$0: error open $dircache for writing: $!\n";
+    warn "caching directories for later use\n" if $Verbose;
+    open(CACHE, ">$Dircache") ||
+	die "$0: error open $Dircache for writing: $!\n";
 
-    print CACHE join(":", @podpath) . "\n$podroot\n";
-    foreach my $key (keys %pages) {
-	print CACHE "$key $pages{$key}\n";
+    print CACHE join(":", @Podpath) . "\n$podroot\n";
+    foreach my $key (keys %Pages) {
+	print CACHE "$key $Pages{$key}\n";
     }
 
     close(CACHE);
@@ -929,22 +922,22 @@ sub scan_dir {
 	die "$0: error opening directory $dir: $!\n";
     while (defined($_ = readdir(DIR))) {
 	if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {	    # directory
-	    $pages{$_}  = "" unless defined $pages{$_};
-	    $pages{$_} .= "$dir/$_:";
+	    $Pages{$_}  = "" unless defined $Pages{$_};
+	    $Pages{$_} .= "$dir/$_:";
 	    push(@subdirs, $_);
 	} elsif (/\.pod\z/) {	    	    	    	    # .pod
 	    s/\.pod\z//;
-	    $pages{$_}  = "" unless defined $pages{$_};
-	    $pages{$_} .= "$dir/$_.pod:";
+	    $Pages{$_}  = "" unless defined $Pages{$_};
+	    $Pages{$_} .= "$dir/$_.pod:";
 	    push(@pods, "$dir/$_.pod");
 	} elsif (/\.html\z/) { 	    	    	    	    # .html
 	    s/\.html\z//;
-	    $pages{$_}  = "" unless defined $pages{$_};
-	    $pages{$_} .= "$dir/$_.pod:";
+	    $Pages{$_}  = "" unless defined $Pages{$_};
+	    $Pages{$_} .= "$dir/$_.pod:";
 	} elsif (/\.pm\z/) { 	    	    	    	    # .pm
 	    s/\.pm\z//;
-	    $pages{$_}  = "" unless defined $pages{$_};
-	    $pages{$_} .= "$dir/$_.pm:";
+	    $Pages{$_}  = "" unless defined $Pages{$_};
+	    $Pages{$_} .= "$dir/$_.pm:";
 	    push(@pods, "$dir/$_.pm");
 	}
     }
@@ -966,9 +959,7 @@ sub scan_headings {
     my($sections, @data) = @_;
     my($tag, $which_head, $otitle, $listdepth, $index);
 
-    # here we need	local $ignore = 0;
-    #  unfortunately, we can't have it, because $ignore is lexical
-    $ignore = 0;
+    local $Ignore = 0;
 
     $listdepth = 0;
     $index = "";
@@ -1008,8 +999,6 @@ sub scan_headings {
     # get rid of bogus lists
     $index =~ s,\t*<ul>\s*</ul>\n,,g;
 
-    $ignore = 1;	# restore old value;
-
     return $index;
 }
 
@@ -1055,17 +1044,17 @@ sub process_head {
     $tag =~ /head([1-6])/;
     my $level = $1;
 
-    if( $listlevel ){
-	warn "$0: $podfile: unterminated list at =head in paragraph $paragraph.  ignoring.\n";
-        while( $listlevel ){
+    if( $Listlevel ){
+	warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n";
+        while( $Listlevel ){
             process_back();
         }
     }
 
     print HTML "<p>\n";
-    if( $level == 1 && ! $top ){
-      print HTML "<a href=\"#__index__\"><small>$backlink</small></a>\n"
-        if $hasindex and $backlink;
+    if( $level == 1 && ! $Top ){
+      print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
+        if $hasindex and $Backlink;
       print HTML "</p>\n<hr />\n"
     } else {
       print HTML "</p>\n";
@@ -1091,7 +1080,7 @@ sub emit_item_tag($$$){
     ### print STDERR "emit_item_tag=$item ($text)\n";
 
     print HTML '<strong>';
-    if ($items_named{$item}++) {
+    if ($Items_Named{$item}++) {
 	print HTML process_text( \$otext );
     } else {
         my $name = 'item_' . $item;
@@ -1104,8 +1093,8 @@ sub emit_item_tag($$$){
 
 sub emit_li {
     my( $tag ) = @_;
-    if( $items_seen[$listlevel]++ == 0 ){
-	push( @listend, "</$tag>" );
+    if( $Items_Seen[$Listlevel]++ == 0 ){
+	push( @Listend, "</$tag>" );
 	print HTML "<$tag>\n";
     }
     my $emitted = $tag eq 'dl' ? 'dt' : 'li';
@@ -1123,15 +1112,15 @@ sub process_item {
     # lots of documents start a list without doing an =over.  this is
     # bad!  but, the proper thing to do seems to be to just assume
     # they did do an =over.  so warn them once and then continue.
-    if( $listlevel == 0 ){
-	warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n";
+    if( $Listlevel == 0 ){
+	warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n";
 	process_over();
     }
 
     # formatting: insert a paragraph if preceding item has >1 paragraph
-    if( $after_lpar ){
+    if( $After_Lpar ){
 	print HTML "<p></p>\n";
-	$after_lpar = 0;
+	$After_Lpar = 0;
     }
 
     # remove formatting instructions from the text
@@ -1173,41 +1162,41 @@ sub process_item {
 #
 sub process_over {
     # start a new list
-    $listlevel++;
-    push( @items_seen, 0 );
-    $after_lpar = 0;
+    $Listlevel++;
+    push( @Items_Seen, 0 );
+    $After_Lpar = 0;
 }
 
 #
 # process_back - process a pod back tag and convert it to HTML format.
 #
 sub process_back {
-    if( $listlevel == 0 ){
-	warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignoring.\n";
+    if( $Listlevel == 0 ){
+	warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n";
 	return;
     }
 
-    # close off the list.  note, I check to see if $listend[$listlevel] is
+    # close off the list.  note, I check to see if $Listend[$Listlevel] is
     # defined because an =item directive may have never appeared and thus
-    # $listend[$listlevel] may have never been initialized.
-    $listlevel--;
-    if( defined $listend[$listlevel] ){
-	print HTML '<p></p>' if $after_lpar;
-	print HTML $listend[$listlevel];
+    # $Listend[$Listlevel] may have never been initialized.
+    $Listlevel--;
+    if( defined $Listend[$Listlevel] ){
+	print HTML '<p></p>' if $After_Lpar;
+	print HTML $Listend[$Listlevel];
         print HTML "\n";
-        pop( @listend );
+        pop( @Listend );
     }
-    $after_lpar = 0;
+    $After_Lpar = 0;
 
     # clean up item count
-    pop( @items_seen );
+    pop( @Items_Seen );
 }
 
 #
 # process_cut - process a pod cut tag, thus start ignoring pod directives.
 #
 sub process_cut {
-    $ignore = 1;
+    $Ignore = 1;
 }
 
 #
@@ -1215,7 +1204,7 @@ sub process_cut {
 # until we see a corresponding cut.
 #
 sub process_pod {
-    # no need to set $ignore to 0 cause the main loop did it
+    # no need to set $Ignore to 0 cause the main loop did it
 }
 
 #
@@ -1243,7 +1232,7 @@ sub process_for {
 sub process_begin {
     my($whom, $text) = @_;
     $whom = lc($whom);
-    push (@begin_stack, $whom);
+    push (@Begin_Stack, $whom);
     if ( $whom =~ /^(pod2)?html$/) {
 	print HTML $text if $text;
     }
@@ -1256,10 +1245,10 @@ sub process_begin {
 sub process_end {
     my($whom, $text) = @_;
     $whom = lc($whom);
-    if ($begin_stack[-1] ne $whom ) {
-	die "Unmatched begin/end at chunk $paragraph\n"
+    if ($Begin_Stack[-1] ne $whom ) {
+	die "Unmatched begin/end at chunk $Paragraph\n"
     }
-    pop( @begin_stack );
+    pop( @Begin_Stack );
 }
 
 #
@@ -1268,7 +1257,7 @@ sub process_end {
 sub process_pre {
     my( $text ) = @_;
     my( $rest );
-    return if $ignore;
+    return if $Ignore;
 
     $rest = $$text;
 
@@ -1287,10 +1276,10 @@ sub process_pre {
     $rest =~ s{
 	         (\s*)(perl\w+)
 	      }{
-		 if ( defined $pages{$2} ){	# is a link
-		     qq($1<a href="$htmlroot/$pages{$2}">$2</a>);
-		 } elsif (defined $pages{dosify($2)}) {	# is a link
-		     qq($1<a href="$htmlroot/$pages{dosify($2)}">$2</a>);
+		 if ( defined $Pages{$2} ){	# is a link
+		     qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>);
+		 } elsif (defined $Pages{dosify($2)}) {	# is a link
+		     qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>);
 		 } else {
 		     "$1$2";
 		 }
@@ -1299,16 +1288,16 @@ sub process_pre {
 		 (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
                }{
                   my $url ;
-                  if ( $htmlfileurl ne '' ){
+                  if ( $Htmlfileurl ne '' ){
 		     # Here, we take advantage of the knowledge
-		     # that $htmlfileurl ne '' implies $htmlroot eq ''.
-		     # Since $htmlroot eq '', we need to prepend $htmldir
+		     # that $Htmlfileurl ne '' implies $Htmlroot eq ''.
+		     # Since $Htmlroot eq '', we need to prepend $Htmldir
 		     # on the fron of the link to get the absolute path
 		     # of the link's target. We check for a leading '/'
 		     # to avoid corrupting links that are #, file:, etc.
 		     my $old_url = $3 ;
-		     $old_url = "$htmldir$old_url" if $old_url =~ m{^\/};
- 		     $url = relativize_url( "$old_url.html", $htmlfileurl );
+		     $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/};
+ 		     $url = relativize_url( "$old_url.html", $Htmlfileurl );
 	          } else {
 		     $url = "$3.html" ;
 		  }
@@ -1336,23 +1325,25 @@ sub process_pre {
     my $any  = "${ltrs}${gunk}${punc}";
 
     $rest =~ s{
-        \b                          # start at word boundary
-        (                           # begin $1  {
-          $urls     :               # need resource and a colon
-	  (?!:)                     # Ignore File::, among others.
-          [$any] +?                 # followed by one or more of any valid
-                                    #   character, but be conservative and
-                                    #   take only what you need to....
-        )                           # end   $1  }
-        (?=                         # look-ahead non-consumptive assertion
-                [$punc]*            # either 0 or more punctuation
-                (?:                 #   followed
-                    [^$any]         #   by a non-url char
-                    |               #   or
-                    $               #   end of the string
-                )                   #
-            |                       # or else
-                $                   #   then end of the string
+	\b			# start at word boundary
+	(			# begin $1  {
+	    $urls :		# need resource and a colon
+	    (?!:)		# Ignore File::, among others.
+	    [$any] +?		# followed by one or more of any valid
+				#   character, but be conservative and
+				#   take only what you need to....
+	)			# end   $1  }
+	(?=
+	    &quot; &gt;		# maybe pre-quoted '<a href="...">'
+	|			# or:
+	    [$punc]*		# 0 or more punctuation
+	    (?:			#   followed
+		[^$any]		#   by a non-url char
+	    |			#   or
+		$		#   end of the string
+	    )			#
+	|			# or else
+	    $			#   then end of the string
         )
       }{<a href="$1">$1</a>}igox;
 
@@ -1369,12 +1360,12 @@ sub process_pre {
 #
 sub pure_text($){
     my $text = shift();
-    process_puretext( $text, \$ptQuote, 1 );
+    process_puretext( $text, \$PTQuote, 1 );
 }
 
 sub inIS_text($){
     my $text = shift();
-    process_puretext( $text, \$ptQuote, 0 );
+    process_puretext( $text, \$PTQuote, 0 );
 }
 
 #
@@ -1459,7 +1450,7 @@ sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
 sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
 
 sub process_text {
-    return if $ignore;
+    return if $Ignore;
     my( $tref ) = @_;
     my $res = process_text1( 0, $tref );
     $$tref = $res;
@@ -1610,7 +1601,7 @@ sub process_text1($$;$$){
 
             # warning; show some text.
             $linktext = $opar unless defined $linktext;
-            warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.\n";
+            warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n";
         }
 
         # now we have a URL or just plain code
@@ -1632,7 +1623,7 @@ sub process_text1($$;$$){
 
     } elsif( $func eq 'Z' ){
 	# Z<> - empty
-	warn "$0: $podfile: invalid X<> in paragraph $paragraph.\n"
+	warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
 	    unless $$rstr =~ s/^>//;
 
     } else {
@@ -1651,7 +1642,7 @@ sub process_text1($$;$$){
 	if( $lev == 1 ){
 	    $res .= pure_text( $$rstr );
 	} else {
-	    warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
+	    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n";
 	}
     }
     return $res;
@@ -1675,7 +1666,7 @@ sub go_ahead($$$){
 	}
 	$res .= $2;
     }
-    warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
+    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n";
     return $res;
 }
 
@@ -1740,14 +1731,14 @@ sub page_sect($$) {
     my( $linktext, $page83, $link);	# work strings
 
     # check if we know that this is a section in this page
-    if (!defined $pages{$page} && defined $sections{$page}) {
+    if (!defined $Pages{$page} && defined $Sections{$page}) {
 	$section = $page;
 	$page = "";
         ### print STDERR "reset page='', section=$section\n";
     }
 
     $page83=dosify($page);
-    $page=$page83 if (defined $pages{$page83});
+    $page=$page83 if (defined $Pages{$page83});
     if ($page eq "") {
         $link = "#" . anchorify( $section );
     } elsif ( $page =~ /::/ ) {
@@ -1758,16 +1749,16 @@ sub page_sect($$) {
 	# an intermediate page that is an index to all such pages.
 	my $page_name = $page ;
 	$page_name =~ s,^.*/,,s ;
-	if ( defined( $pages{ $page_name } ) &&
-	     $pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
+	if ( defined( $Pages{ $page_name } ) &&
+	     $Pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
 	   ) {
 	    $page = $1 ;
 	}
 	else {
 	    # NOTE: This branch assumes that all A::B pages are located in
-	    # $htmlroot/A/B.html . This is often incorrect, since they are
-	    # often in $htmlroot/lib/A/B.html or such like. Perhaps we could
-	    # analyze the contents of %pages and figure out where any
+	    # $Htmlroot/A/B.html . This is often incorrect, since they are
+	    # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could
+	    # analyze the contents of %Pages and figure out where any
 	    # cousins of A::B are, then assume that.  So, if A::B isn't found,
 	    # but A::C is found in lib/A/C.pm, then A::B is assumed to be in
 	    # lib/A/B.pm. This is also limited, but it's an improvement.
@@ -1775,9 +1766,9 @@ sub page_sect($$) {
 	    # nonetheless?
 
 	}
-	$link = "$htmlroot/$page.html";
+	$link = "$Htmlroot/$page.html";
 	$link .= "#" . anchorify( $section ) if ($section);
-    } elsif (!defined $pages{$page}) {
+    } elsif (!defined $Pages{$page}) {
 	$link = "";
     } else {
 	$section = anchorify( $section ) if $section ne "";
@@ -1785,9 +1776,9 @@ sub page_sect($$) {
 
 	# if there is a directory by the name of the page, then assume that an
 	# appropriate section will exist in the subdirectory
-#	if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
-	if ($section ne "" && $pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
-	    $link = "$htmlroot/$1/$section.html";
+#	if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	if ($section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
+	    $link = "$Htmlroot/$1/$section.html";
             ### print STDERR "...link=$link\n";
 
 	# since there is no directory by the name of the page, the section will
@@ -1798,10 +1789,10 @@ sub page_sect($$) {
             ### print STDERR "...section=$section\n";
 
 	    # check if there is a .pod with the page name
-	    if ($pages{$page} =~ /([^:]*)\.pod:/) {
-		$link = "$htmlroot/$1.html$section";
-	    } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
-		$link = "$htmlroot/$1.html$section";
+	    if ($Pages{$page} =~ /([^:]*)\.pod:/) {
+		$link = "$Htmlroot/$1.html$section";
+	    } elsif ($Pages{$page} =~ /([^:]*)\.pm:/) {
+		$link = "$Htmlroot/$1.html$section";
 	    } else {
 		$link = "";
 	    }
@@ -1809,16 +1800,16 @@ sub page_sect($$) {
     }
 
     if ($link) {
-	# Here, we take advantage of the knowledge that $htmlfileurl ne ''
-	# implies $htmlroot eq ''. This means that the link in question
-	# needs a prefix of $htmldir if it begins with '/'. The test for
+	# Here, we take advantage of the knowledge that $Htmlfileurl ne ''
+	# implies $Htmlroot eq ''. This means that the link in question
+	# needs a prefix of $Htmldir if it begins with '/'. The test for
 	# the initial '/' is done to avoid '#'-only links, and to allow
 	# for other kinds of links, like file:, ftp:, etc.
         my $url ;
-        if (  $htmlfileurl ne '' ) {
-            $link = "$htmldir$link" if $link =~ m{^/}s;
-            $url = relativize_url( $link, $htmlfileurl );
-# print( "  b: [$link,$htmlfileurl,$url]\n" );
+        if (  $Htmlfileurl ne '' ) {
+            $link = "$Htmldir$link" if $link =~ m{^/}s;
+            $url = relativize_url( $link, $Htmlfileurl );
+# print( "  b: [$link,$Htmlfileurl,$url]\n" );
 	}
 	else {
             $url = $link ;
@@ -1877,20 +1868,20 @@ sub coderef($$){
 	$page =~ s{::}{/}g;
 
 	# Do we take it? Item could be a section!
-	my $base = $items{$fid} || "";
+	my $base = $Items{$fid} || "";
 	$base =~ s{[^/]*/}{};
 	if( $base ne "$page.html" ){
-            ###   print STDERR "coderef( $page, $item ): items{$fid} = $items{$fid} = $base => discard page!\n";
+            ###   print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n";
 	    $page = undef();
 	}
 
     } else {
         # no page - local items precede cached items
 	if( defined( $fid ) ){
-	    if(  exists $local_items{$fid} ){
-		$page = $local_items{$fid};
+	    if(  exists $Local_Items{$fid} ){
+		$page = $Local_Items{$fid};
 	    } else {
-		$page = $items{$fid};
+		$page = $Items{$fid};
 	    }
 	}
     }
@@ -1899,16 +1890,16 @@ sub coderef($$){
     # =item directive, then create a link to that page.
     if( defined $page ){
 	if( $page ){
-            if( exists $pages{$page} and $pages{$page} =~ /([^:.]*)\.[^:]*:/){
+            if( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/){
 		$page = $1 . '.html';
 	    }
-	    my $link = "$htmlroot/$page#item_" . anchorify($fid);
+	    my $link = "$Htmlroot/$page#item_" . anchorify($fid);
 
-	    # Here, we take advantage of the knowledge that $htmlfileurl
-	    # ne '' implies $htmlroot eq ''.
-	    if (  $htmlfileurl ne '' ) {
-		$link = "$htmldir$link" ;
-		$url = relativize_url( $link, $htmlfileurl ) ;
+	    # Here, we take advantage of the knowledge that $Htmlfileurl
+	    # ne '' implies $Htmlroot eq ''.
+	    if (  $Htmlfileurl ne '' ) {
+		$link = "$Htmldir$link" ;
+		$url = relativize_url( $link, $Htmlfileurl ) ;
 	    } else {
 		$url = $link ;
 	    }
@@ -1940,9 +1931,9 @@ sub relative_url {
 # after the entire pod file has been read and converted.
 #
 sub finish_list {
-    while ($listlevel > 0) {
+    while ($Listlevel > 0) {
 	print HTML "</dl>\n";
-	$listlevel--;
+	$Listlevel--;
     }
 }
 
@@ -1963,12 +1954,12 @@ sub htmlify {
 }
 
 #
-# similar to htmlify, but turns spaces into underscores
+# similar to htmlify, but turns non-alphanumerics into underscores
 #
 sub anchorify {
     my ($anchor) = @_;
     $anchor = htmlify($anchor);
-    $anchor =~ s/\s/_/g; # fixup spaces left by htmlify
+    $anchor =~ s/\W/_/g;
     return $anchor;
 }
 
@@ -2038,7 +2029,7 @@ sub depod1($;$$){
 #   a) =item text
 #   b) contents of C<...>
 #
-my @hc;
+my @HC;
 sub fragment_id {
     my $text = shift();
     $text =~ s/\s+\Z//s;
@@ -2064,8 +2055,8 @@ sub fragment_id {
 	# text? normalize!
 	$text =~ s/\s+/_/sg;
 	$text =~ s{(\W)}{
-         defined( $hc[ord($1)] ) ? $hc[ord($1)]
-                 : ( $hc[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
+         defined( $HC[ord($1)] ) ? $HC[ord($1)]
+                 : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
         $text = substr( $text, 0, 50 );
     } else {
 	return undef();
diff --git a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm
index eae8678e463..9cd347b969a 100644
--- a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm
+++ b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm
@@ -11,7 +11,7 @@
 package Pod::InputObjects;
 
 use vars qw($VERSION);
-$VERSION = 1.13;  ## Current version of this package
+$VERSION = 1.14;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -855,9 +855,15 @@ the current one.
 sub append {
    my $self = shift;
    local *ptree = $self;
+   my $can_append = @ptree && !(ref $ptree[-1]);
    for (@_) {
-      next  unless length;
-      if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
+      if (ref) {
+         push @ptree, $_;
+      }
+      elsif(!length) {
+         next;
+      }
+      elsif ($can_append) {
          $ptree[-1] .= $_;
       }
       else {
diff --git a/gnu/usr.bin/perl/lib/Pod/LaTeX.pm b/gnu/usr.bin/perl/lib/Pod/LaTeX.pm
index ca108badb35..4e73ee43dcc 100644
--- a/gnu/usr.bin/perl/lib/Pod/LaTeX.pm
+++ b/gnu/usr.bin/perl/lib/Pod/LaTeX.pm
@@ -33,7 +33,7 @@ use Carp;
 
 use vars qw/ $VERSION %HTML_Escapes @LatexSections /;
 
-$VERSION = '0.54';
+$VERSION = '0.55';
 
 # Definitions of =headN -> latex mapping
 @LatexSections = (qw/
@@ -45,176 +45,316 @@ $VERSION = '0.54';
 		  subparagraph
 		  /);
 
-# Standard escape sequences converted to Latex
-# Up to "yuml" these are taken from the original pod2latex
-# command written by Taro Kawagish (kawagish@imslab.co.jp)
-
+# Standard escape sequences converted to Latex.
+# The Unicode name of each character is given in the comments.
+# Complete LaTeX set added by Peter Acklam.
 
 %HTML_Escapes = (
-    # lt, gt and verbar are inserted without math mode
-    # since the $$ will be added during general correction
-    # for those escape characters
-    'amp'       =>      '\&',      #   ampersand
-    'lt'        =>      '<',    #   ' left chevron, less-than
-    'gt'        =>      '>',    #   ' right chevron, greater-than
-    'quot'      =>      '"',      #   double quote
-    'sol'       =>      '/',
-    'verbar'    =>      '|',
-
-    "Aacute"    =>      "\\'{A}",       #   capital A, acute accent
-    "aacute"    =>      "\\'{a}",       #   small a, acute accent
-    "Acirc"     =>      "\\^{A}",       #   capital A, circumflex accent
-    "acirc"     =>      "\\^{a}",       #   small a, circumflex accent
-    "AElig"     =>      '\\AE',         #   capital AE diphthong (ligature)
-    "aelig"     =>      '\\ae',         #   small ae diphthong (ligature)
-    "Agrave"    =>      "\\`{A}",       #   capital A, grave accent
-    "agrave"    =>      "\\`{a}",       #   small a, grave accent
-    "Aring"     =>      '\\u{A}',       #   capital A, ring
-    "aring"     =>      '\\u{a}',       #   small a, ring
-    "Atilde"    =>      '\\~{A}',       #   capital A, tilde
-    "atilde"    =>      '\\~{a}',       #   small a, tilde
-    "Auml"      =>      '\\"{A}',       #   capital A, dieresis or umlaut mark
-    "auml"      =>      '\\"{a}',       #   small a, dieresis or umlaut mark
-    "Ccedil"    =>      '\\c{C}',       #   capital C, cedilla
-    "ccedil"    =>      '\\c{c}',       #   small c, cedilla
-    "Eacute"    =>      "\\'{E}",       #   capital E, acute accent
-    "eacute"    =>      "\\'{e}",       #   small e, acute accent
-    "Ecirc"     =>      "\\^{E}",       #   capital E, circumflex accent
-    "ecirc"     =>      "\\^{e}",       #   small e, circumflex accent
-    "Egrave"    =>      "\\`{E}",       #   capital E, grave accent
-    "egrave"    =>      "\\`{e}",       #   small e, grave accent
-    "ETH"       =>      '\\OE',         #   capital Eth, Icelandic
-    "eth"       =>      '\\oe',         #   small eth, Icelandic
-    "Euml"      =>      '\\"{E}',       #   capital E, dieresis or umlaut mark
-    "euml"      =>      '\\"{e}',       #   small e, dieresis or umlaut mark
-    "Iacute"    =>      "\\'{I}",       #   capital I, acute accent
-    "iacute"    =>      "\\'{i}",       #   small i, acute accent
-    "Icirc"     =>      "\\^{I}",       #   capital I, circumflex accent
-    "icirc"     =>      "\\^{i}",       #   small i, circumflex accent
-    "Igrave"    =>      "\\`{I}",       #   capital I, grave accent
-    "igrave"    =>      "\\`{i}",       #   small i, grave accent
-    "Iuml"      =>      '\\"{I}',       #   capital I, dieresis or umlaut mark
-    "iuml"      =>      '\\"{i}',       #   small i, dieresis or umlaut mark
-    "Ntilde"    =>      '\\~{N}',       #   capital N, tilde
-    "ntilde"    =>      '\\~{n}',       #   small n, tilde
-    "Oacute"    =>      "\\'{O}",       #   capital O, acute accent
-    "oacute"    =>      "\\'{o}",       #   small o, acute accent
-    "Ocirc"     =>      "\\^{O}",       #   capital O, circumflex accent
-    "ocirc"     =>      "\\^{o}",       #   small o, circumflex accent
-    "Ograve"    =>      "\\`{O}",       #   capital O, grave accent
-    "ograve"    =>      "\\`{o}",       #   small o, grave accent
-    "Oslash"    =>      "\\O",          #   capital O, slash
-    "oslash"    =>      "\\o",          #   small o, slash
-    "Otilde"    =>      "\\~{O}",       #   capital O, tilde
-    "otilde"    =>      "\\~{o}",       #   small o, tilde
-    "Ouml"      =>      '\\"{O}',       #   capital O, dieresis or umlaut mark
-    "ouml"      =>      '\\"{o}',       #   small o, dieresis or umlaut mark
-    "szlig"     =>      '\\ss{}',       #   small sharp s, German (sz ligature)
-    "THORN"     =>      '\\L',          #   capital THORN, Icelandic
-    "thorn"     =>      '\\l',,         #   small thorn, Icelandic
-    "Uacute"    =>      "\\'{U}",       #   capital U, acute accent
-    "uacute"    =>      "\\'{u}",       #   small u, acute accent
-    "Ucirc"     =>      "\\^{U}",       #   capital U, circumflex accent
-    "ucirc"     =>      "\\^{u}",       #   small u, circumflex accent
-    "Ugrave"    =>      "\\`{U}",       #   capital U, grave accent
-    "ugrave"    =>      "\\`{u}",       #   small u, grave accent
-    "Uuml"      =>      '\\"{U}',       #   capital U, dieresis or umlaut mark
-    "uuml"      =>      '\\"{u}',       #   small u, dieresis or umlaut mark
-    "Yacute"    =>      "\\'{Y}",       #   capital Y, acute accent
-    "yacute"    =>      "\\'{y}",       #   small y, acute accent
-    "yuml"      =>      '\\"{y}',       #   small y, dieresis or umlaut mark
-
-    # Added by TimJ
-
-    "iexcl"  =>   '!`',           # inverted exclamation mark
-#    "cent"   =>   ' ',        # cent sign
-    "pound"  =>   '\pounds',      # (UK) pound sign
-#    "curren" =>   ' ',        # currency sign
-#    "yen"    =>   ' ',        # yen sign
-#    "brvbar" =>   ' ',        # broken vertical bar
-    "sect"   =>   '\S',           # section sign
-    "uml"    =>   '\"{}',        # diaresis
-    "copy"   =>   '\copyright',   # Copyright symbol
-#    "ordf"   =>   ' ',        # feminine ordinal indicator
-    "laquo"  =>   '$\ll$',      # ' # left pointing double angle quotation mark
-    "not"    =>   '$\neg$',       # '  # not sign
-    "shy"    =>   '-',            # soft hyphen
-#    "reg"    =>   ' ',        # registered trademark
-    "macr"   =>   '$^-$',         # ' # macron, overline
-    "deg"    =>   '$^\circ$',     # '  # degree sign
-    "plusmn" =>   '$\pm$',        # ' # plus-minus sign
-    "sup2"   =>   '$^2$',         # ' # superscript 2
-    "sup3"   =>   '$^3$',         # ' # superscript 3
-    "acute"  =>   "\\'{}",        # acute accent
-    "micro"  =>   '$\mu$',        # micro sign
-    "para"   =>   '\P',           # pilcrow sign = paragraph sign
-    "middot" =>   '$\cdot$',      # middle dot = Georgian comma
-    "cedil"  =>   '\c{}',        # cedilla
-    "sup1"   =>   '$^1$',         # ' # superscript 1
-#    "ordm"   =>   ' ',        # masculine ordinal indicator
-    "raquo"  =>   '$\gg$',     # ' # right pointing double angle quotation mark
-    "frac14" =>   '$\frac{1}{4}$',   # ' # vulgar fraction one quarter
-    "frac12" =>   '$\frac{1}{2}$',   # ' # vulgar fraction one half
-    "frac34" =>   '$\frac{3}{4}$',   # ' # vulgar fraction three quarters
-    "iquest" =>   "?'",              # inverted question mark
-    "times"  =>   '$\times$',        # ' # multiplication sign
-    "divide" =>   '$\div$',          # division sign
-
-    # Greek letters using HTML codes
-    "alpha"  =>   '$\alpha$',   # '
-    "beta"   =>   '$\beta$',    # '
-    "gamma"  =>   '$\gamma$',   # '
-    "delta"  =>   '$\delta$',   # '
-    "epsilon"=>   '$\epsilon$', # '
-    "zeta"   =>   '$\zeta$',    # '
-    "eta"    =>   '$\eta$',     # '
-    "theta"  =>   '$\theta$',   # '
-    "iota"   =>   '$\iota$',    # '
-    "kappa"  =>   '$\kappa$',   # '
-    "lambda" =>   '$\lambda$',  # '
-    "mu"     =>   '$\mu$',      # '
-    "nu"     =>   '$\nu$',      # '
-    "xi"     =>   '$\xi$',      # '
-    "omicron"=>   '$o$',        # '
-    "pi"     =>   '$\pi$',      # '
-    "rho"    =>   '$\rho$',     # '
-    "sigma"  =>   '$\sigma$',   # '
-    "tau"    =>   '$\tau$',     # '
-    "upsilon"=>   '$\upsilon$', # '
-    "phi"    =>   '$\phi$',     # '
-    "chi"    =>   '$\chi$',     # '
-    "psi"    =>   '$\psi$',     # '
-    "omega"  =>   '$\omega$',   # '
-
-    "Alpha"  =>   '$A$',   # '
-    "Beta"   =>   '$B$',    # '
-    "Gamma"  =>   '$\Gamma$',   # '
-    "Delta"  =>   '$\Delta$',   # '
-    "Epsilon"=>   '$E$', # '
-    "Zeta"   =>   '$Z$',    # '
-    "Eta"    =>   '$H$',     # '
-    "Theta"  =>   '$\Theta$',   # '
-    "Iota"   =>   '$I$',    # '
-    "Kappa"  =>   '$K$',   # '
-    "Lambda" =>   '$\Lambda$',  # '
-    "Mu"     =>   '$M$',      # '
-    "Nu"     =>   '$N$',      # '
-    "Xi"     =>   '$\Xi$',      # '
-    "Omicron"=>   '$O$',        # '
-    "Pi"     =>   '$\Pi$',      # '
-    "Rho"    =>   '$R$',     # '
-    "Sigma"  =>   '$\Sigma$',   # '
-    "Tau"    =>   '$T$',     # '
-    "Upsilon"=>   '$\Upsilon$', # '
-    "Phi"    =>   '$\Phi$',     # '
-    "Chi"    =>   '$X$',     # '
-    "Psi"    =>   '$\Psi$',     # '
-    "Omega"  =>   '$\Omega$',   # '
-
-
+     'sol'    => '\textfractionsolidus{}',  # xxx - or should it be just '/'
+     'verbar' => '|',
+
+     # The stuff below is based on the information available at
+     # http://www.w3.org/TR/html401/sgml/entities.html
+
+     # All characters in the range 0xA0-0xFF of the ISO 8859-1 character set.
+     # Several of these characters require the `textcomp' LaTeX package.
+     'nbsp'   => q|~|,                     # 0xA0 - no-break space = non-breaking space
+     'iexcl'  => q|\textexclamdown{}|,     # 0xA1 - inverted exclamation mark
+     'cent'   => q|\textcent{}|,           # 0xA2 - cent sign
+     'pound'  => q|\textsterling{}|,       # 0xA3 - pound sign
+     'curren' => q|\textcurrency{}|,       # 0xA4 - currency sign
+     'yen'    => q|\textyen{}|,            # 0xA5 - yen sign = yuan sign
+     'brvbar' => q|\textbrokenbar{}|,      # 0xA6 - broken bar = broken vertical bar
+     'sect'   => q|\textsection{}|,        # 0xA7 - section sign
+     'uml'    => q|\textasciidieresis{}|,  # 0xA8 - diaeresis = spacing diaeresis
+     'copy'   => q|\textcopyright{}|,      # 0xA9 - copyright sign
+     'ordf'   => q|\textordfeminine{}|,    # 0xAA - feminine ordinal indicator
+     'laquo'  => q|\guillemotleft{}|,      # 0xAB - left-pointing double angle quotation mark = left pointing guillemet
+     'not'    => q|\textlnot{}|,           # 0xAC - not sign
+     'shy'    => q|\-|,                    # 0xAD - soft hyphen = discretionary hyphen
+     'reg'    => q|\textregistered{}|,     # 0xAE - registered sign = registered trade mark sign
+     'macr'   => q|\textasciimacron{}|,    # 0xAF - macron = spacing macron = overline = APL overbar
+     'deg'    => q|\textdegree{}|,         # 0xB0 - degree sign
+     'plusmn' => q|\textpm{}|,             # 0xB1 - plus-minus sign = plus-or-minus sign
+     'sup2'   => q|\texttwosuperior{}|,    # 0xB2 - superscript two = superscript digit two = squared
+     'sup3'   => q|\textthreesuperior{}|,  # 0xB3 - superscript three = superscript digit three = cubed
+     'acute'  => q|\textasciiacute{}|,     # 0xB4 - acute accent = spacing acute
+     'micro'  => q|\textmu{}|,             # 0xB5 - micro sign
+     'para'   => q|\textparagraph{}|,      # 0xB6 - pilcrow sign = paragraph sign
+     'middot' => q|\textperiodcentered{}|, # 0xB7 - middle dot = Georgian comma = Greek middle dot
+     'cedil'  => q|\c{}|,                  # 0xB8 - cedilla = spacing cedilla
+     'sup1'   => q|\textonesuperior{}|,    # 0xB9 - superscript one = superscript digit one
+     'ordm'   => q|\textordmasculine{}|,   # 0xBA - masculine ordinal indicator
+     'raquo'  => q|\guillemotright{}|,     # 0xBB - right-pointing double angle quotation mark = right pointing guillemet
+     'frac14' => q|\textonequarter{}|,     # 0xBC - vulgar fraction one quarter = fraction one quarter
+     'frac12' => q|\textonehalf{}|,        # 0xBD - vulgar fraction one half = fraction one half
+     'frac34' => q|\textthreequarters{}|,  # 0xBE - vulgar fraction three quarters = fraction three quarters
+     'iquest' => q|\textquestiondown{}|,   # 0xBF - inverted question mark = turned question mark
+     'Agrave' => q|\`A|,                   # 0xC0 - latin capital letter A with grave = latin capital letter A grave
+     'Aacute' => q|\'A|,             # 0xC1 - latin capital letter A with acute
+     'Acirc'  => q|\^A|,             # 0xC2 - latin capital letter A with circumflex
+     'Atilde' => q|\~A|,             # 0xC3 - latin capital letter A with tilde
+     'Auml'   => q|\"A|,             # 0xC4 - latin capital letter A with diaeresis
+     'Aring'  => q|\AA{}|,           # 0xC5 - latin capital letter A with ring above = latin capital letter A ring
+     'AElig'  => q|\AE{}|,           # 0xC6 - latin capital letter AE = latin capital ligature AE
+     'Ccedil' => q|\c{C}|,           # 0xC7 - latin capital letter C with cedilla
+     'Egrave' => q|\`E|,             # 0xC8 - latin capital letter E with grave
+     'Eacute' => q|\'E|,             # 0xC9 - latin capital letter E with acute
+     'Ecirc'  => q|\^E|,             # 0xCA - latin capital letter E with circumflex
+     'Euml'   => q|\"E|,             # 0xCB - latin capital letter E with diaeresis
+     'Igrave' => q|\`I|,             # 0xCC - latin capital letter I with grave
+     'Iacute' => q|\'I|,             # 0xCD - latin capital letter I with acute
+     'Icirc'  => q|\^I|,             # 0xCE - latin capital letter I with circumflex
+     'Iuml'   => q|\"I|,             # 0xCF - latin capital letter I with diaeresis
+     'ETH'    => q|\DH{}|,           # 0xD0 - latin capital letter ETH
+     'Ntilde' => q|\~N|,             # 0xD1 - latin capital letter N with tilde
+     'Ograve' => q|\`O|,             # 0xD2 - latin capital letter O with grave
+     'Oacute' => q|\'O|,             # 0xD3 - latin capital letter O with acute
+     'Ocirc'  => q|\^O|,             # 0xD4 - latin capital letter O with circumflex
+     'Otilde' => q|\~O|,             # 0xD5 - latin capital letter O with tilde
+     'Ouml'   => q|\"O|,             # 0xD6 - latin capital letter O with diaeresis
+     'times'  => q|\texttimes{}|,    # 0xD7 - multiplication sign
+     'Oslash' => q|\O{}|,            # 0xD8 - latin capital letter O with stroke = latin capital letter O slash
+     'Ugrave' => q|\`U|,             # 0xD9 - latin capital letter U with grave
+     'Uacute' => q|\'U|,             # 0xDA - latin capital letter U with acute
+     'Ucirc'  => q|\^U|,             # 0xDB - latin capital letter U with circumflex
+     'Uuml'   => q|\"U|,             # 0xDC - latin capital letter U with diaeresis
+     'Yacute' => q|\'Y|,             # 0xDD - latin capital letter Y with acute
+     'THORN'  => q|\TH{}|,           # 0xDE - latin capital letter THORN
+     'szlig'  => q|\ss{}|,           # 0xDF - latin small letter sharp s = ess-zed
+     'agrave' => q|\`a|,             # 0xE0 - latin small letter a with grave = latin small letter a grave
+     'aacute' => q|\'a|,             # 0xE1 - latin small letter a with acute
+     'acirc'  => q|\^a|,             # 0xE2 - latin small letter a with circumflex
+     'atilde' => q|\~a|,             # 0xE3 - latin small letter a with tilde
+     'auml'   => q|\"a|,             # 0xE4 - latin small letter a with diaeresis
+     'aring'  => q|\aa{}|,           # 0xE5 - latin small letter a with ring above = latin small letter a ring
+     'aelig'  => q|\ae{}|,           # 0xE6 - latin small letter ae = latin small ligature ae
+     'ccedil' => q|\c{c}|,           # 0xE7 - latin small letter c with cedilla
+     'egrave' => q|\`e|,             # 0xE8 - latin small letter e with grave
+     'eacute' => q|\'e|,             # 0xE9 - latin small letter e with acute
+     'ecirc'  => q|\^e|,             # 0xEA - latin small letter e with circumflex
+     'euml'   => q|\"e|,             # 0xEB - latin small letter e with diaeresis
+     'igrave' => q|\`i|,             # 0xEC - latin small letter i with grave
+     'iacute' => q|\'i|,             # 0xED - latin small letter i with acute
+     'icirc'  => q|\^i|,             # 0xEE - latin small letter i with circumflex
+     'iuml'   => q|\"i|,             # 0xEF - latin small letter i with diaeresis
+     'eth'    => q|\dh{}|,           # 0xF0 - latin small letter eth
+     'ntilde' => q|\~n|,             # 0xF1 - latin small letter n with tilde
+     'ograve' => q|\`o|,             # 0xF2 - latin small letter o with grave
+     'oacute' => q|\'o|,             # 0xF3 - latin small letter o with acute
+     'ocirc'  => q|\^o|,             # 0xF4 - latin small letter o with circumflex
+     'otilde' => q|\~o|,             # 0xF5 - latin small letter o with tilde
+     'ouml'   => q|\"o|,             # 0xF6 - latin small letter o with diaeresis
+     'divide' => q|\textdiv{}|,      # 0xF7 - division sign
+     'oslash' => q|\o{}|,            # 0xF8 - latin small letter o with stroke, = latin small letter o slash
+     'ugrave' => q|\`u|,             # 0xF9 - latin small letter u with grave
+     'uacute' => q|\'u|,             # 0xFA - latin small letter u with acute
+     'ucirc'  => q|\^u|,             # 0xFB - latin small letter u with circumflex
+     'uuml'   => q|\"u|,             # 0xFC - latin small letter u with diaeresis
+     'yacute' => q|\'y|,             # 0xFD - latin small letter y with acute
+     'thorn'  => q|\th{}|,           # 0xFE - latin small letter thorn
+     'yuml'   => q|\"y|,             # 0xFF - latin small letter y with diaeresis
+
+     # Latin Extended-B
+     'fnof'   => q|\textflorin{}|,   # latin small f with hook = function = florin
+
+     # Greek
+     'Alpha'    => q|$\mathrm{A}$|,      # greek capital letter alpha
+     'Beta'     => q|$\mathrm{B}$|,      # greek capital letter beta
+     'Gamma'    => q|$\Gamma$|,          # greek capital letter gamma
+     'Delta'    => q|$\Delta$|,          # greek capital letter delta
+     'Epsilon'  => q|$\mathrm{E}$|,      # greek capital letter epsilon
+     'Zeta'     => q|$\mathrm{Z}$|,      # greek capital letter zeta
+     'Eta'      => q|$\mathrm{H}$|,      # greek capital letter eta
+     'Theta'    => q|$\Theta$|,          # greek capital letter theta
+     'Iota'     => q|$\mathrm{I}$|,      # greek capital letter iota
+     'Kappa'    => q|$\mathrm{K}$|,      # greek capital letter kappa
+     'Lambda'   => q|$\Lambda$|,         # greek capital letter lambda
+     'Mu'       => q|$\mathrm{M}$|,      # greek capital letter mu
+     'Nu'       => q|$\mathrm{N}$|,      # greek capital letter nu
+     'Xi'       => q|$\Xi$|,             # greek capital letter xi
+     'Omicron'  => q|$\mathrm{O}$|,      # greek capital letter omicron
+     'Pi'       => q|$\Pi$|,             # greek capital letter pi
+     'Rho'      => q|$\mathrm{R}$|,      # greek capital letter rho
+     'Sigma'    => q|$\Sigma$|,          # greek capital letter sigma
+     'Tau'      => q|$\mathrm{T}$|,      # greek capital letter tau
+     'Upsilon'  => q|$\Upsilon$|,        # greek capital letter upsilon
+     'Phi'      => q|$\Phi$|,            # greek capital letter phi
+     'Chi'      => q|$\mathrm{X}$|,      # greek capital letter chi
+     'Psi'      => q|$\Psi$|,            # greek capital letter psi
+     'Omega'    => q|$\Omega$|,          # greek capital letter omega
+
+     'alpha'    => q|$\alpha$|,          # greek small letter alpha
+     'beta'     => q|$\beta$|,           # greek small letter beta
+     'gamma'    => q|$\gamma$|,          # greek small letter gamma
+     'delta'    => q|$\delta$|,          # greek small letter delta
+     'epsilon'  => q|$\epsilon$|,        # greek small letter epsilon
+     'zeta'     => q|$\zeta$|,           # greek small letter zeta
+     'eta'      => q|$\eta$|,            # greek small letter eta
+     'theta'    => q|$\theta$|,          # greek small letter theta
+     'iota'     => q|$\iota$|,           # greek small letter iota
+     'kappa'    => q|$\kappa$|,          # greek small letter kappa
+     'lambda'   => q|$\lambda$|,         # greek small letter lambda
+     'mu'       => q|$\mu$|,             # greek small letter mu
+     'nu'       => q|$\nu$|,             # greek small letter nu
+     'xi'       => q|$\xi$|,             # greek small letter xi
+     'omicron'  => q|$o$|,               # greek small letter omicron
+     'pi'       => q|$\pi$|,             # greek small letter pi
+     'rho'      => q|$\rho$|,            # greek small letter rho
+#    'sigmaf'   => q||,                  # greek small letter final sigma
+     'sigma'    => q|$\sigma$|,          # greek small letter sigma
+     'tau'      => q|$\tau$|,            # greek small letter tau
+     'upsilon'  => q|$\upsilon$|,        # greek small letter upsilon
+     'phi'      => q|$\phi$|,            # greek small letter phi
+     'chi'      => q|$\chi$|,            # greek small letter chi
+     'psi'      => q|$\psi$|,            # greek small letter psi
+     'omega'    => q|$\omega$|,          # greek small letter omega
+#    'thetasym' => q||,                  # greek small letter theta symbol
+#    'upsih'    => q||,                  # greek upsilon with hook symbol
+#    'piv'      => q||,                  # greek pi symbol
+
+     # General Punctuation
+     'bull'     => q|\textbullet{}|,     # bullet = black small circle
+     # bullet is NOT the same as bullet operator
+     'hellip'   => q|\textellipsis{}|,           # horizontal ellipsis = three dot leader
+     'prime'    => q|\textquotesingle{}|,        # prime = minutes = feet
+     'Prime'    => q|\textquotedbl{}|,           # double prime = seconds = inches
+     'oline'    => q|\textasciimacron{}|,        # overline = spacing overscore
+     'frasl'    => q|\textfractionsolidus{}|,    # fraction slash
+
+     # Letterlike Symbols
+     'weierp'   => q|$\wp$|,                     # script capital P = power set = Weierstrass p
+     'image'    => q|$\Re$|,                     # blackletter capital I = imaginary part
+     'real'     => q|$\Im$|,                     # blackletter capital R = real part symbol
+     'trade'    => q|\texttrademark{}|,          # trade mark sign
+#    'alefsym'  => q||,                          # alef symbol = first transfinite cardinal
+     # alef symbol is NOT the same as hebrew letter alef, although the same
+     # glyph could be used to depict both characters
+
+     # Arrows
+     'larr'     => q|\textleftarrow{}|,          # leftwards arrow
+     'uarr'     => q|\textuparrow{}|,            # upwards arrow
+     'rarr'     => q|\textrightarrow{}|,         # rightwards arrow
+     'darr'     => q|\textdownarrow{}|,          # downwards arrow
+     'harr'     => q|$\leftrightarrow$|,         # left right arrow
+#    'crarr'    => q||,                          # downwards arrow with corner leftwards = carriage return
+     'lArr'     => q|$\Leftarrow$|,              # leftwards double arrow
+     # ISO 10646 does not say that lArr is the same as the 'is implied by'
+     # arrow but also does not have any other character for that function. So
+     # lArr can be used for 'is implied by' as ISOtech suggests
+     'uArr'     => q|$\Uparrow$|,                # upwards double arrow
+     'rArr'     => q|$\Rightarrow$|,             # rightwards double arrow
+     # ISO 10646 does not say this is the 'implies' character but does not
+     # have another character with this function so ? rArr can be used for
+     # 'implies' as ISOtech suggests
+     'dArr'     => q|$\Downarrow$|,              # downwards double arrow
+     'hArr'     => q|$\Leftrightarrow$|,         # left right double arrow
+
+     # Mathematical Operators.
+     # Some of these require the `amssymb' package.
+     'forall'   => q|$\forall$|,                 # for all
+     'part'     => q|$\partial$|,                # partial differential
+     'exist'    => q|$\exists$|,                 # there exists
+     'empty'    => q|$\emptyset$|,               # empty set = null set = diameter
+     'nabla'    => q|$\nabla$|,                  # nabla = backward difference
+     'isin'     => q|$\in$|,                     # element of
+     'notin'    => q|$\notin$|,                  # not an element of
+     'ni'       => q|$\ni$|,                     # contains as member
+     'prod'     => q|$\prod$|,                   # n-ary product = product sign
+     # prod is NOT the same character as 'greek capital letter pi' though the
+     # same glyph might be used for both
+     'sum'      => q|$\sum$|,                    # n-ary sumation
+     # sum is NOT the same character as 'greek capital letter sigma' though
+     # the same glyph might be used for both
+     'minus'    => q|$-$|,                       # minus sign
+     'lowast'   => q|$\ast$|,                    # asterisk operator
+     'radic'    => q|$\surd$|,                   # square root = radical sign
+     'prop'     => q|$\propto$|,                 # proportional to
+     'infin'    => q|$\infty$|,                  # infinity
+     'ang'      => q|$\angle$|,                  # angle
+     'and'      => q|$\wedge$|,                  # logical and = wedge
+     'or'       => q|$\vee$|,                    # logical or = vee
+     'cap'      => q|$\cap$|,                    # intersection = cap
+     'cup'      => q|$\cup$|,                    # union = cup
+     'int'      => q|$\int$|,                    # integral
+     'there4'   => q|$\therefore$|,              # therefore
+     'sim'      => q|$\sim$|,                    # tilde operator = varies with = similar to
+     # tilde operator is NOT the same character as the tilde
+     'cong'     => q|$\cong$|,                   # approximately equal to
+     'asymp'    => q|$\asymp$|,                  # almost equal to = asymptotic to
+     'ne'       => q|$\neq$|,                    # not equal to
+     'equiv'    => q|$\equiv$|,                  # identical to
+     'le'       => q|$\leq$|,                    # less-than or equal to
+     'ge'       => q|$\geq$|,                    # greater-than or equal to
+     'sub'      => q|$\subset$|,                 # subset of
+     'sup'      => q|$\supset$|,                 # superset of
+     # note that nsup, 'not a superset of' is not covered by the Symbol font
+     # encoding and is not included.
+     'nsub'     => q|$\not\subset$|,             # not a subset of
+     'sube'     => q|$\subseteq$|,               # subset of or equal to
+     'supe'     => q|$\supseteq$|,               # superset of or equal to
+     'oplus'    => q|$\oplus$|,                  # circled plus = direct sum
+     'otimes'   => q|$\otimes$|,                 # circled times = vector product
+     'perp'     => q|$\perp$|,                   # up tack = orthogonal to = perpendicular
+     'sdot'     => q|$\cdot$|,                   # dot operator
+     # dot operator is NOT the same character as middle dot
+
+     # Miscellaneous Technical
+     'lceil'    => q|$\lceil$|,                  # left ceiling = apl upstile
+     'rceil'    => q|$\rceil$|,                  # right ceiling
+     'lfloor'   => q|$\lfloor$|,                 # left floor = apl downstile
+     'rfloor'   => q|$\rfloor$|,                 # right floor
+     'lang'     => q|$\langle$|,                 # left-pointing angle bracket = bra
+     # lang is NOT the same character as 'less than' or 'single left-pointing
+     # angle quotation mark'
+     'rang'     => q|$\rangle$|,                 # right-pointing angle bracket = ket
+     # rang is NOT the same character as 'greater than' or 'single
+     # right-pointing angle quotation mark'
+
+     # Geometric Shapes
+     'loz'      => q|$\lozenge$|,                # lozenge
+
+     # Miscellaneous Symbols
+     'spades'   => q|$\spadesuit$|,              # black spade suit
+     'clubs'    => q|$\clubsuit$|,               # black club suit = shamrock
+     'hearts'   => q|$\heartsuit$|,              # black heart suit = valentine
+     'diams'    => q|$\diamondsuit$|,            # black diamond suit
+
+     # C0 Controls and Basic Latin
+     'quot'     => q|"|,                         # quotation mark = APL quote ["]
+     'amp'      => q|\&|,                        # ampersand
+     'lt'       => q|<|,                         # less-than sign
+     'gt'       => q|>|,                         # greater-than sign
+     'OElig'    => q|\OE{}|,                     # latin capital ligature OE
+     'oelig'    => q|\oe{}|,                     # latin small ligature oe
+     'Scaron'   => q|\v{S}|,                     # latin capital letter S with caron
+     'scaron'   => q|\v{s}|,                     # latin small letter s with caron
+     'Yuml'     => q|\"Y|,                       # latin capital letter Y with diaeresis
+     'circ'     => q|\textasciicircum{}|,        # modifier letter circumflex accent
+     'tilde'    => q|\textasciitilde{}|,         # small tilde
+     'ensp'     => q|\phantom{n}|,               # en space
+     'emsp'     => q|\hspace{1em}|,              # em space
+     'thinsp'   => q|\,|,                        # thin space
+     'zwnj'     => q|{}|,                        # zero width non-joiner
+#    'zwj'      => q||,                          # zero width joiner
+#    'lrm'      => q||,                          # left-to-right mark
+#    'rlm'      => q||,                          # right-to-left mark
+     'ndash'    => q|--|,                        # en dash
+     'mdash'    => q|---|,                       # em dash
+     'lsquo'    => q|\textquoteleft{}|,          # left single quotation mark
+     'rsquo'    => q|\textquoteright{}|,         # right single quotation mark
+     'sbquo'    => q|\quotesinglbase{}|,         # single low-9 quotation mark
+     'ldquo'    => q|\textquotedblleft{}|,       # left double quotation mark
+     'rdquo'    => q|\textquotedblright{}|,      # right double quotation mark
+     'bdquo'    => q|\quotedblbase{}|,           # double low-9 quotation mark
+     'dagger'   => q|\textdagger{}|,             # dagger
+     'Dagger'   => q|\textdaggerdbl{}|,          # double dagger
+     'permil'   => q|\textperthousand{}|,        # per mille sign
+     'lsaquo'   => q|\guilsinglleft{}|,          # single left-pointing angle quotation mark
+     'rsaquo'   => q|\guilsinglright{}|,         # single right-pointing angle quotation mark
+     'euro'     => q|\texteuro{}|,               # euro sign
 );
 
-
 =head1 OBJECT METHODS
 
 The following methods are provided in this module. Methods inherited
@@ -336,10 +476,12 @@ of arguments when using the C<new()> constructor.
 =item B<AddPreamble>
 
 Logical to control whether a C<latex> preamble is to be written.
-If true, a valid C<latex> preamble is written before the pod data
-is written.  This is similar to:
+If true, a valid C<latex> preamble is written before the pod data is written.
+This is similar to:
 
   \documentclass{article}
+  \usepackage[T1]{fontenc}
+  \usepackage{textcomp}
   \begin{document}
 
 but will be more complicated if table of contents and indexing are required.
@@ -351,6 +493,9 @@ Can be used to set or retrieve the current value.
 If used in conjunction with C<AddPostamble> a full latex document will
 be written that could be immediately processed by C<latex>.
 
+For some pod escapes it may be necessary to include the amsmath
+package. This is not yet added to the preamble automaatically.
+
 =cut
 
 sub AddPreamble {
@@ -363,13 +508,13 @@ sub AddPreamble {
 
 =item B<AddPostamble>
 
-Logical to control whether a standard C<latex> ending is written to
-the output file after the document has been processed.  In its
-simplest form this is simply:
+Logical to control whether a standard C<latex> ending is written to the output
+file after the document has been processed.
+In its simplest form this is simply:
 
   \end{document}
 
-but can be more complicated if an index is required.
+but can be more complicated if a index is required.
 Can be used to set or retrieve the current value.
 
   $add = $parser->AddPostamble();
@@ -408,10 +553,10 @@ Can be used to set or retrieve the current value:
   $parser->Head1Level(2);
   $sect = $parser->Head1Level;
 
-Setting this number too high can result in sections that may not be
-reproducible in the expected way. For example, setting this to 4 would
-imply that C<=head3> do not have a corresponding C<latex> section
-(C<=head1> would correspond to a C<paragraph>).
+Setting this number too high can result in sections that may not be reproducible
+in the expected way. For example, setting this to 4 would imply that C<=head3>
+do not have a corresponding C<latex> section (C<=head1> would correspond to
+a C<paragraph>).
 
 A check is made to ensure that the supplied value is an integer in the
 range 0 to 5.
@@ -502,8 +647,8 @@ into the preamble and postamble
   $makeindex = $parser->MakeIndex;
   $parser->MakeIndex(0);
 
-Irrelevant if both C<AddPreamble> and C<AddPostamble> are false
-(or equivalently, C<UserPreamble> and C<UserPostamble> are set).
+Irrelevant if both C<AddPreamble> and C<AddPostamble> are false (or equivalently,
+C<UserPreamble> and C<UserPostamble> are set).
 
 Default is for an index to be created.
 
@@ -632,8 +777,8 @@ sub UniqueLabels {
 User supplied C<latex> preamble. Added before the pod translation
 data. 
 
-If set, the contents will be prepended to the output file before
-the translated data regardless of the value of C<AddPreamble>.
+If set, the contents will be prepended to the output file before the translated 
+data regardless of the value of C<AddPreamble>.
 C<MakeIndex> and C<TableOfContents> will also be ignored.
 
 =cut
@@ -651,8 +796,8 @@ sub UserPreamble {
 User supplied C<latex> postamble. Added after the pod translation
 data. 
 
-If set, the contents will be prepended to the output file after
-the translated data regardless of the value of C<AddPostamble>.
+If set, the contents will be prepended to the output file after the translated 
+data regardless of the value of C<AddPostamble>.
 C<MakeIndex> will also be ignored.
 
 =cut
@@ -764,13 +909,15 @@ __TEX_COMMENT__
 
     # Table of contents
     my $tableofcontents = '\tableofcontents';
-    
+
     $tableofcontents = '%% ' . $tableofcontents
       unless $self->TableOfContents;
 
     # Roll our own
     $preamble = << "__TEX_HEADER__";
 \\documentclass{article}
+\\usepackage[T1]{fontenc}
+\\usepackage{textcomp}
 
 $comment
 
@@ -1096,7 +1243,7 @@ sub interior_sequence {
   } elsif ($seq_command eq 'Z') {
 
     # Zero width space
-    return '$\!$'; # '
+    return '{}';
 
   } elsif ($seq_command eq 'C') {
     return "\\texttt{$seq_argument}";
@@ -1106,13 +1253,12 @@ sub interior_sequence {
 
   } elsif ($seq_command eq 'S') {
     # non breakable spaces
-    my $nbsp = '$\:$'; #'
+    my $nbsp = '~';
 
     $seq_argument =~ s/\s/$nbsp/g;
     return $seq_argument;
 
   } elsif ($seq_command eq 'L') {
-
     my $link = new Pod::Hyperlink($seq_argument);
 
     # undef on failure
@@ -1138,7 +1284,6 @@ sub interior_sequence {
       # Use default markup for external references
       # (although Starlink would use \xlabel)
       my $markup = $link->markup;
-
       my ($file, $line) = $pod_seq->file_line();
 
       return $self->interpolate($link->markup, $line);
@@ -1151,7 +1296,7 @@ sub interior_sequence {
     # Replace :: with / - but not sure if I want to do this
     # any more.
     my $link = $seq_argument;
-    $link =~ s/::/\//g;
+    $link =~ s|::|/|g;
 
     my $ref = "\\emph{$seq_argument}";
     return $ref;
@@ -1314,10 +1459,10 @@ sub add_item {
     }
 
   } else {
-    # If the item was '* Something' we still need to write
-    # out the something
+    # If the item was '* Something' or '\d+ something' we still need to write
+    # out the something. Also allow 1) and 1.
     my $extra_info = $paragraph;
-    $extra_info =~ s/^\*\s*//;
+    $extra_info =~ s/^(\*|\d+[\.\)]?)\s*//;
     $self->_output("\n\\item $extra_info");
   }
 
@@ -1444,6 +1589,7 @@ Special characters and the C<latex> equivalents are:
   \     $\backslash$
   ^     \^{}
   ~     \~{}
+  #     \#
 
 =cut
 
@@ -1693,15 +1839,18 @@ L<Pod::Parser>, L<Pod::Select>, L<pod2latex>
 
 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
 
-Bug fixes have been received from: Simon Cozens
+Bug fixes and improvements have been received from: Simon Cozens
 E<lt>simon@cozens.netE<gt>, Mark A. Hershberger
 E<lt>mah@everybody.orgE<gt>, Marcel Grunauer
-E<lt>marcel@codewerk.comE<gt> and Hugh S Myers
-E<lt>hsmyers@sdragons.comE<gt>.
+E<lt>marcel@codewerk.comE<gt>, Hugh S Myers
+E<lt>hsmyers@sdragons.comE<gt>, Peter J Acklam
+E<lt>jacklam@math.uio.noE<gt>, Sudhi Herle E<lt>sudhi@herle.netE<gt>
+and Ariel Scolnicov E<lt>ariels@compugen.co.ilE<gt>.
+
 
 =head1 COPYRIGHT
 
-Copyright (C) 2000-2001 Tim Jenness. All Rights Reserved.
+Copyright (C) 2000-2003 Tim Jenness. All Rights Reserved.
 
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
@@ -1710,8 +1859,10 @@ it under the same terms as Perl itself.
 
 =head1 REVISION
 
-$Id: LaTeX.pm,v 1.3 2002/10/27 22:25:27 millert Exp $
+$Id: LaTeX.pm,v 1.4 2003/12/03 03:02:40 millert Exp $
 
 =end __PRIVATE__
 
 =cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Pod/Man.pm b/gnu/usr.bin/perl/lib/Pod/Man.pm
index dc067686953..a46397faa8b 100644
--- a/gnu/usr.bin/perl/lib/Pod/Man.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Man.pm
@@ -1,7 +1,7 @@
 # Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 1.7 2002/10/27 22:25:27 millert Exp $
+# $Id: Man.pm,v 1.8 2003/12/03 03:02:40 millert Exp $
 #
-# Copyright 1999, 2000, 2001, 2002 by Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2000, 2001, 2002, 2003 by Russ Allbery <rra@stanford.edu>
 #
 # This program is free software; you may redistribute it and/or modify it
 # under the same terms as Perl itself.
@@ -38,7 +38,7 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.  This
 # number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = 1.34;
+$VERSION = 1.37;
 
 
 ##############################################################################
@@ -471,6 +471,7 @@ $_
     $$self{INDEX}     = [];     # Index keys waiting to be printed.
     $$self{IN_NAME}   = 0;      # Whether processing the NAME section.
     $$self{ITEMS}     = 0;      # The number of consecutive =items.
+    $$self{ITEMTYPES} = [];     # Stack of =item types, one per list.
     $$self{SHIFTWAIT} = 0;      # Whether there is a shift waiting.
     $$self{SHIFTS}    = [];     # Stack of .RS shifts.
 }
@@ -537,9 +538,9 @@ sub textblock {
     $text =~ s/\n\s*$/\n/;
 
     # Output the paragraph.  We also have to handle =over without =item.  If
-    # there's an =over without =item, NEWINDENT will be set, and we need to
-    # handle creation of the indent here.  Set WEIRDINDENT so that it will be
-    # cleaned up on =back.
+    # there's an =over without =item, SHIFTWAIT will be set, and we need to
+    # handle creation of the indent here.  Add the shift to SHIFTS so that it
+    # will be cleaned up on =back.
     $self->makespace;
     if ($$self{SHIFTWAIT}) {
         $self->output (".RS $$self{INDENT}\n");
@@ -716,6 +717,7 @@ sub cmd_over {
         push (@{ $$self{SHIFTS} }, $$self{INDENT});
     }
     push (@{ $$self{INDENTS} }, $$self{INDENT});
+    push (@{ $$self{ITEMTYPES} }, 'unknown');
     $$self{INDENT} = ($_ + 0);
     $$self{SHIFTWAIT} = 1;
 }
@@ -726,7 +728,9 @@ sub cmd_over {
 sub cmd_back {
     my $self = shift;
     $$self{INDENT} = pop @{ $$self{INDENTS} };
-    unless (defined $$self{INDENT}) {
+    if (defined $$self{INDENT}) {
+        pop @{ $$self{ITEMTYPES} };
+    } else {
         my ($file, $line, $paragraph) = @_;
         ($file, $line) = $paragraph->file_line;
         warn "$file:$line: Unmatched =back\n";
@@ -759,8 +763,18 @@ sub cmd_item {
         $index = $_;
         $index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//;
     }
-    $_ = '*' unless $_;
-    s/^\*(\s|\Z)/\\\(bu$1/;
+    $_ = '*' unless length ($_) > 0;
+    my $type = $$self{ITEMTYPES}[0];
+    unless (defined $type) {
+        my ($file, $line, $paragraph) = @_;
+        ($file, $line) = $paragraph->file_line;
+        $type = 'unknown';
+    }
+    if ($type eq 'unknown') {
+        $type = /^\*\s*\Z/ ? 'bullet' : 'text';
+        $$self{ITEMTYPES}[0] = $type if $$self{ITEMTYPES}[0];
+    }
+    s/^\*\s*\Z/\\\(bu/ if $type eq 'bullet';
     if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) {
         $self->output (".RE\n");
         pop @{ $$self{SHIFTS} };
@@ -1121,12 +1135,13 @@ sub switchquotes {
     }
 }
 
-__END__
-
 ##############################################################################
-# Documentation
+# Module return value and documentation
 ##############################################################################
 
+1;
+__END__
+
 =head1 NAME
 
 Pod::Man - Convert POD data to formatted *roff input
@@ -1387,7 +1402,7 @@ B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>.
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 1999, 2000, 2001, 2002 by Russ Allbery <rra@stanford.edu>.
+Copyright 1999, 2000, 2001, 2002, 2003 by Russ Allbery <rra@stanford.edu>.
 
 This program is free software; you may redistribute it and/or modify it
 under the same terms as Perl itself.
diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
index 8f1bb0cb559..d00b604483c 100644
--- a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
@@ -487,7 +487,7 @@ sub find_good_formatter_class {
       } else {
         $^W = 0;
         # The average user just has no reason to be seeing
-        #  $^W-suppressable warnings from the the require!
+        #  $^W-suppressable warnings from the require!
       }
 
       eval "require $c";
diff --git a/gnu/usr.bin/perl/lib/Pod/PlainText.pm b/gnu/usr.bin/perl/lib/Pod/PlainText.pm
index ce0688b31cb..02c9205714e 100644
--- a/gnu/usr.bin/perl/lib/Pod/PlainText.pm
+++ b/gnu/usr.bin/perl/lib/Pod/PlainText.pm
@@ -1,5 +1,5 @@
 # Pod::PlainText -- Convert POD data to formatted ASCII text.
-# $Id: PlainText.pm,v 1.1 2003/12/03 02:44:08 millert Exp $
+# $Id: PlainText.pm,v 1.2 2003/12/03 03:02:40 millert Exp $
 #
 # Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
 #
@@ -29,7 +29,7 @@ use vars qw(@ISA %ESCAPES $VERSION);
 # by Pod::Usage.
 @ISA = qw(Pod::Select);
 
-($VERSION = (split (' ', q$Revision: 1.1 $ ))[1]) =~ s/\.(\d)$/.0$1/;
+($VERSION = (split (' ', q$Revision: 1.2 $ ))[1]) =~ s/\.(\d)$/.0$1/;
 
 
 ############################################################################
diff --git a/gnu/usr.bin/perl/lib/Pod/Text.pm b/gnu/usr.bin/perl/lib/Pod/Text.pm
index bf2bf0f813a..2e454524c56 100644
--- a/gnu/usr.bin/perl/lib/Pod/Text.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Text.pm
@@ -1,5 +1,5 @@
 # Pod::Text -- Convert POD data to formatted ASCII text.
-# $Id: Text.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
+# $Id: Text.pm,v 1.7 2003/12/03 03:02:40 millert Exp $
 #
 # Copyright 1999, 2000, 2001, 2002 by Russ Allbery <rra@stanford.edu>
 #
@@ -43,7 +43,7 @@ use vars qw(@ISA @EXPORT %ESCAPES $VERSION);
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.  This
 # number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = 2.20;
+$VERSION = 2.21;
 
 
 ##############################################################################
@@ -177,6 +177,7 @@ sub initialize {
 
     $$self{alt}      = 0  unless defined $$self{alt};
     $$self{indent}   = 4  unless defined $$self{indent};
+    $$self{margin}   = 0  unless defined $$self{margin};
     $$self{loose}    = 0  unless defined $$self{loose};
     $$self{sentence} = 0  unless defined $$self{sentence};
     $$self{width}    = 76 unless defined $$self{width};
@@ -195,8 +196,11 @@ sub initialize {
         croak qq(Invalid quote specification "$$self{quotes}");
     }
 
-    $$self{INDENTS}  = [];              # Stack of indentations.
-    $$self{MARGIN}   = $$self{indent};  # Current left margin in spaces.
+    # Stack of indentations.
+    $$self{INDENTS}  = [];
+
+    # Current left margin.
+    $$self{MARGIN} = $$self{indent} + $$self{margin};
 
     $self->SUPER::initialize;
 
@@ -496,10 +500,12 @@ sub heading {
     $text = $self->interpolate ($text, $line);
     if ($$self{alt}) {
         my $closemark = reverse (split (//, $marker));
-        $self->output ("\n" . "$marker $text $closemark" . "\n\n");
+        my $margin = ' ' x $$self{margin};
+        $self->output ("\n" . "$margin$marker $text $closemark" . "\n\n");
     } else {
         $text .= "\n" if $$self{loose};
-        $self->output (' ' x $indent . $text . "\n");
+        my $margin = ' ' x ($$self{margin} + $indent);
+        $self->output ($margin . $text . "\n");
     }
 }
 
@@ -526,12 +532,12 @@ sub item {
     undef $$self{ITEM};
     my $indent = $$self{INDENTS}[-1];
     unless (defined $indent) { $indent = $$self{indent} }
-    my $space = ' ' x $indent;
-    $space =~ s/^ /:/ if $$self{alt};
+    my $margin = ' ' x $$self{margin};
     if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
-        my $margin = $$self{MARGIN};
+        my $realindent = $$self{MARGIN};
         $$self{MARGIN} = $indent;
         my $output = $self->reformat ($tag);
+        $output =~ s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);
         $output =~ s/\n*$/\n/;
 
         # If the text is just whitespace, we have an empty item paragraph;
@@ -541,11 +547,13 @@ sub item {
         $output .= "\n" if $_ && $_ =~ /^\s*$/;
 
         $self->output ($output);
-        $$self{MARGIN} = $margin;
+        $$self{MARGIN} = $realindent;
         $self->output ($self->reformat ($_)) if $_ && /\S/;
     } else {
+        my $space = ' ' x $indent;
+        $space =~ s/^$margin /$margin:/ if $$self{alt};
         $_ = $self->reformat ($_);
-        s/^ /:/ if ($$self{alt} && $indent > 0);
+        s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);
         my $tagspace = ' ' x length $tag;
         s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
         $self->output ($_);
@@ -716,6 +724,13 @@ it's the expected formatting for manual pages; if you're formatting
 arbitrary text documents, setting this to true may result in more pleasing
 output.
 
+=item margin
+
+The width of the left margin in spaces.  Defaults to 0.  This is the margin
+for all text, including headings, not the amount by which regular text is
+indented; for the latter, see the I<indent> option.  To set the right
+margin, see the I<width> option.
+
 =item quotes
 
 Sets the quote marks used to surround CE<lt>> text.  If the value is a
diff --git a/gnu/usr.bin/perl/lib/Pod/Text/Color.pm b/gnu/usr.bin/perl/lib/Pod/Text/Color.pm
index 21ae2b0c32a..eadffcd1d69 100644
--- a/gnu/usr.bin/perl/lib/Pod/Text/Color.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Text/Color.pm
@@ -1,5 +1,5 @@
 # Pod::Text::Color -- Convert POD data to formatted color ASCII text
-# $Id: Color.pm,v 1.4 2002/10/27 22:25:27 millert Exp $
+# $Id: Color.pm,v 1.5 2003/12/03 03:02:40 millert Exp $
 #
 # Copyright 1999, 2001 by Russ Allbery <rra@stanford.edu>
 #
diff --git a/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm b/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm
index 717ea94743f..b41e6f00208 100644
--- a/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Text/Overstrike.pm
@@ -1,5 +1,5 @@
 # Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
-# $Id: Overstrike.pm,v 1.3 2002/10/27 22:25:27 millert Exp $
+# $Id: Overstrike.pm,v 1.4 2003/12/03 03:02:40 millert Exp $
 #
 # Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
 #   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
@@ -36,7 +36,7 @@ use vars qw(@ISA $VERSION);
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.  This
 # number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = 1.09;
+$VERSION = 1.10;
 
 
 ##############################################################################
@@ -85,7 +85,8 @@ sub heading {
     my ($self, $text, $line, $indent, $marker) = @_;
     $self->item ("\n\n") if defined $$self{ITEM};
     $text .= "\n" if $$self{loose};
-    $self->output (' ' x $indent . $text . "\n");
+    my $margin = ' ' x ($$self{margin} + $indent);
+    $self->output ($margin . $text . "\n");
 }
 
 # Fix the various formatting codes.
diff --git a/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm b/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm
index 6ea95abab84..b90001013e2 100644
--- a/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Text/Termcap.pm
@@ -1,5 +1,5 @@
 # Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes.
-# $Id: Termcap.pm,v 1.4 2002/10/27 22:25:27 millert Exp $
+# $Id: Termcap.pm,v 1.5 2003/12/03 03:02:40 millert Exp $
 #
 # Copyright 1999, 2001, 2002 by Russ Allbery <rra@stanford.edu>
 #
@@ -30,7 +30,7 @@ use vars qw(@ISA $VERSION);
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.  This
 # number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = 1.10;
+$VERSION = 1.11;
 
 
 ##############################################################################
@@ -43,9 +43,11 @@ sub initialize {
     my $self = shift;
     my ($ospeed, $term, $termios);
 
-    # The default Term::Cap path won't work on Solaris.
-    $ENV{TERMPATH} = "$ENV{HOME}/.termcap:/etc/termcap"
-        . ":/usr/share/misc/termcap:/usr/share/lib/termcap";
+    # $ENV{HOME} is usually not set on Windows.  The default Term::Cap path
+    # may not work on Solaris.
+    my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : '';
+    $ENV{TERMPATH} = $home . '/etc/termcap:/usr/share/misc/termcap'
+                           . ':/usr/share/lib/termcap';
 
     # Fall back on a hard-coded terminal speed if POSIX::Termios isn't
     # available (such as on VMS).
diff --git a/gnu/usr.bin/perl/lib/Pod/t/latex.t b/gnu/usr.bin/perl/lib/Pod/t/latex.t
deleted file mode 100644
index dd3323b81dc..00000000000
--- a/gnu/usr.bin/perl/lib/Pod/t/latex.t
+++ /dev/null
@@ -1,349 +0,0 @@
-
-BEGIN {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-        require Test; import Test;
-        plan(tests => 154);
-}
-
-# Test that Pod::LaTeX works
-# This test relies on the DATA filehandle
-# DATA contains the latex that is used for comparison
-# and the pod that was used to generate it. The two
-# are separated by '=pod'
-# Note that if the translator is adjusted the output tex
-# will probably not match what is currently there. You
-# will need to adjust it to match (assuming it is correct).
-
-use strict;
-
-use Pod::LaTeX;
-
-# Set up an END block to remove the test output file
-END { unlink "test.tex" };
-
-ok(1);
-
-# First thing to do is to read the expected output from
-# the DATA filehandle and store it in a scalar.
-# Do this until we read an =pod
-my @reference;
-while (my $line = <DATA>) {
-  last if $line =~ /^=pod/;
-  push(@reference,$line);
-}
-
-# Create a new parser
-my $parser = Pod::LaTeX->new;
-ok($parser);
-$parser->Head1Level(1);
-# Add the preamble but remember not to compare the timestamps
-$parser->AddPreamble(1);
-$parser->AddPostamble(1);
-
-# For a laugh add a table of contents
-$parser->TableOfContents(1);
-
-# Create an output file
-open(OUTFH, "> test.tex" ) or die "Unable to open test tex file: $!\n";
-
-# Read from the DATA filehandle and write to a new output file
-# Really want to write this to a scalar
-$parser->parse_from_filehandle(\*DATA,\*OUTFH);
-
-close(OUTFH) or die "Error closing OUTFH test.tex: $!\n";
-
-# Now read in OUTFH and compare
-open(INFH, "< test.tex") or die "Unable to read test tex file: $!\n";
-my @output = <INFH>;
-
-ok(@output, @reference);
-for my $i (0..$#reference) {
-  next if $reference[$i] =~ /^%%/; # skip timestamp comments
-  ok($output[$i], $reference[$i]);
-}
-
-close(INFH) or die "Error closing INFH test.tex: $!\n";
-
-
-__DATA__
-\documentclass{article}
-
-%%  Latex generated from POD in document ...
-%%  Using the perl module Pod::LaTeX
-%%  Converted on Tue Nov 20 20:43:05 2001
-
-
-\usepackage{makeidx}
-\makeindex
-
-
-\begin{document}
-
-\tableofcontents
-
-\section{Introduction\label{Introduction}\index{Introduction}}
-\begin{itemize}
-
-\item 
-
-Always check the return codes of system calls. Good error messages should
-go to STDERR, include which program caused the problem, what the failed
-system call and arguments were, and (\textbf{very important}) should contain
-the standard system error message for what went wrong. Here's a simple
-but sufficient example:
-
-\begin{verbatim}
-        opendir(D, $dir) or die "can't opendir $dir: $!";
-\end{verbatim}
-
-\item 
-
-Line up your transliterations when it makes sense:
-
-\begin{verbatim}
-        tr [abc]
-           [xyz];
-\end{verbatim}
-
-
-The above should be aligned since it includes an embedded tab.
-
-
-\item 
-
-Think about reusability. Why waste brainpower on a one-shot when you
-might want to do something like it again? Consider generalizing your
-code. Consider writing a module or object class. Consider making your
-code run cleanly with \texttt{use strict} and \texttt{-w} (or \texttt{use warnings} in
-Perl 5.6) in effect. Consider giving away your code. Consider changing
-your whole world view. Consider... oh, never mind.
-
-
-\item 
-
-Be consistent.
-
-
-\item 
-
-Be nice.
-
-\end{itemize}
-\section{Links\label{Links}\index{Links}}
-
-
-This link should just include one word: \textsf{Pod::LaTeX}
-
-
-
-This link should include the text \texttt{test} even though
-it refers to \texttt{Pod::LaTeX}: \textsf{test}.
-
-
-
-Standard link: the \emph{Pod::LaTeX} manpage.
-
-
-
-Now refer to an external section: the section on \textsf{sec} in the \emph{Pod::LaTeX} manpage
-
-\section{Lists\label{Lists}\index{Lists}}
-
-
-Test description list with long lines
-
-\begin{description}
-
-\item[Some short text] \mbox{}
-
-Some additional para.
-
-\begin{itemize}
-
-\item 
-
-Nested itemized list
-
-
-\item 
-
-Second item
-
-\end{itemize}
-
-\item[some longer text than that] \mbox{}
-
-and again.
-
-
-\item[this text is even longer and greater than] \textbf{40 characters}
-
-Some more content for the item.
-
-
-\item[this is some text with \textit{something across}] \textbf{the 40 char boundary}
-
-This is item content.
-
-\end{description}
-\section{Escapes\label{Escapes}\index{Escapes}}
-
-
-Test some normal escapes such as $<$ (lt) and $>$ (gt) and $|$ (verbar) and
-\texttt{\~{}} (tilde) and \& (amp) as well as $<$ (Esc lt) and $|$ (Esc
-verbar) and / (Esc sol) and $>$ (Esc gt) and \& (Esc amp)
-and " (Esc quot) and even $\alpha$ (Esc alpha).
-
-\section{For blocks\label{For_blocks}\index{For blocks}}
-  Some latex code \textbf{here}.
-
-
-
-Some text that should appear.
-
-
-
-Some more text that should appear
-
-Some latex in a \textsf{begin block}
-
-and some more
-
-\begin{equation}
-a = \frac{3}{2}
-\end{equation}
-
-
-
-Back to pod.
-
-\printindex
-
-\end{document}
-=pod
-
-=head1 Introduction
-
-=over 4
-
-=item *
-
-Always check the return codes of system calls. Good error messages should
-go to STDERR, include which program caused the problem, what the failed
-system call and arguments were, and (B<very important>) should contain
-the standard system error message for what went wrong. Here's a simple
-but sufficient example:
-
-        opendir(D, $dir) or die "can't opendir $dir: $!";
-
-=item *
-
-Line up your transliterations when it makes sense:
-
-        tr [abc]
-  	   [xyz];
-
-The above should be aligned since it includes an embedded tab.
-
-=item *
-
-Think about reusability. Why waste brainpower on a one-shot when you
-might want to do something like it again? Consider generalizing your
-code. Consider writing a module or object class. Consider making your
-code run cleanly with C<use strict> and C<-w> (or C<use warnings> in
-Perl 5.6) in effect. Consider giving away your code. Consider changing
-your whole world view. Consider... oh, never mind.
-
-=item *
-
-Be consistent.
-
-=item *
-
-Be nice.
-
-=back
-
-=head1 Links
-
-This link should just include one word: L<Pod::LaTeX|Pod::LaTeX>
-
-This link should include the text C<test> even though
-it refers to C<Pod::LaTeX>: L<test|Pod::LaTeX>.
-
-Standard link: L<Pod::LaTeX>.
-
-Now refer to an external section: L<Pod::LaTeX/"sec">
-
-
-=head1 Lists
-
-Test description list with long lines
-
-=over 4
-
-=item Some short text
-
-Some additional para.
-
-=over 4
-
-=item *
-
-Nested itemized list
-
-=item *
-
-Second item
-
-=back
-
-=item some longer text than that
-
-and again.
-
-=item this text is even longer and greater than 40 characters
-
-Some more content for the item.
-
-=item this is some text with I<something across> the 40 char boundary
-
-This is item content.
-
-=back
-
-=head1 Escapes
-
-Test some normal escapes such as < (lt) and > (gt) and | (verbar) and
-~ (tilde) and & (amp) as well as E<lt> (Esc lt) and E<verbar> (Esc
-verbar) and E<sol> (Esc sol) and E<gt> (Esc gt) and E<amp> (Esc amp)
-and E<quot> (Esc quot) and even E<alpha> (Esc alpha).
-
-=head1 For blocks
-
-=for latex
-  Some latex code \textbf{here}.
-
-Some text that should appear.
-
-=for comment
-  Should not print anything
-
-Some more text that should appear
-
-=begin latex
-
-Some latex in a \textsf{begin block}
-
-and some more
-
-\begin{equation}
-a = \frac{3}{2}
-\end{equation}
-
-=end latex
-
-Back to pod.
-
-=cut
diff --git a/gnu/usr.bin/perl/lib/Pod/t/text-options.t b/gnu/usr.bin/perl/lib/Pod/t/text-options.t
index 5e6598dd7c8..dd204ffcdfd 100644
--- a/gnu/usr.bin/perl/lib/Pod/t/text-options.t
+++ b/gnu/usr.bin/perl/lib/Pod/t/text-options.t
@@ -1,5 +1,5 @@
 #!/usr/bin/perl -w
-# $Id: text-options.t,v 1.1 2003/12/03 02:44:08 millert Exp $
+# $Id: text-options.t,v 1.2 2003/12/03 03:02:41 millert Exp $
 #
 # text-options.t -- Additional tests for Pod::Text options.
 #
diff --git a/gnu/usr.bin/perl/lib/SelfLoader.pm b/gnu/usr.bin/perl/lib/SelfLoader.pm
index 59defe0bb27..40c92db6b7a 100644
--- a/gnu/usr.bin/perl/lib/SelfLoader.pm
+++ b/gnu/usr.bin/perl/lib/SelfLoader.pm
@@ -3,17 +3,19 @@ package SelfLoader;
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(AUTOLOAD);
-$VERSION = "1.0903";
+$VERSION = "1.0904";
 sub Version {$VERSION}
 $DEBUG = 0;
 
 my %Cache;      # private cache for all SelfLoader's client packages
 
 # allow checking for valid ': attrlist' attachments
-my $nested;
+# (we use 'our' rather than 'my' here, due to the rather complex and buggy
+# behaviour of lexicals with qr// and (??{$lex}) )
+our $nested;
 $nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
-my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
-my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+our $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
 
 sub croak { require Carp; goto &Carp::croak }
 
diff --git a/gnu/usr.bin/perl/lib/Shell.pm b/gnu/usr.bin/perl/lib/Shell.pm
index 9762a3aa0bb..e300d792c6c 100644
--- a/gnu/usr.bin/perl/lib/Shell.pm
+++ b/gnu/usr.bin/perl/lib/Shell.pm
@@ -4,9 +4,9 @@ use strict;
 use warnings;
 our($capture_stderr, $VERSION, $AUTOLOAD);
 
-$VERSION = '0.4';
+$VERSION = '0.5';
 
-sub new { bless \$VERSION, shift } # Nothing better to bless
+sub new { bless \my $foo, shift }
 sub DESTROY { }
 
 sub import {
@@ -30,6 +30,7 @@ sub AUTOLOAD {
     $cmd =~ s/^.*:://;
     eval <<"*END*";
 	sub $AUTOLOAD {
+	    shift if ref \$_[0] && \$_[0]->isa( 'Shell' );
 	    if (\@_ < 1) {
 		\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
 	    } elsif ('$^O' eq 'os2') {
diff --git a/gnu/usr.bin/perl/lib/Symbol.pm b/gnu/usr.bin/perl/lib/Symbol.pm
index 98fb6763fe6..5c0843e7d7b 100644
--- a/gnu/usr.bin/perl/lib/Symbol.pm
+++ b/gnu/usr.bin/perl/lib/Symbol.pm
@@ -34,7 +34,6 @@ Symbol - manipulate Perl symbols and their names
     delete_package('Foo::Bar');
     print "deleted\n" unless exists $Foo::{'Bar::'};
 
-
 =head1 DESCRIPTION
 
 C<Symbol::gensym> creates an anonymous glob and returns a reference
@@ -68,6 +67,16 @@ C<Symbol::delete_package> wipes out a whole package namespace.  Note
 this routine is not exported by default--you may want to import it
 explicitly.
 
+=head1 BUGS
+
+C<Symbol::delete_package> is a bit too powerful. It undefines every symbol
+that lives in the specified package and in its sub-packages. Since perl,
+for performance reasons, does not perform a symbol table lookup each time
+a function is called or a global variable is accessed, some code that has
+already been loaded and that makes use of symbols in package C<Foo> may
+stop working after you delete C<Foo>, even if you reload the C<Foo> module
+afterwards.
+
 =cut
 
 BEGIN { require 5.005; }
@@ -77,7 +86,7 @@ require Exporter;
 @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
 @EXPORT_OK = qw(delete_package geniosym);
 
-$VERSION = 1.04;
+$VERSION = '1.05';
 
 my $genpkg = "Symbol::";
 my $genseq = 0;
diff --git a/gnu/usr.bin/perl/lib/Term/ANSIColor.pm b/gnu/usr.bin/perl/lib/Term/ANSIColor.pm
index 81f37d2d46a..af1f9436834 100644
--- a/gnu/usr.bin/perl/lib/Term/ANSIColor.pm
+++ b/gnu/usr.bin/perl/lib/Term/ANSIColor.pm
@@ -1,5 +1,5 @@
 # Term::ANSIColor -- Color screen output using ANSI escape sequences.
-# $Id: ANSIColor.pm,v 1.4 2002/10/27 22:25:27 millert Exp $
+# $Id: ANSIColor.pm,v 1.5 2003/12/03 03:02:41 millert Exp $
 #
 # Copyright 1996, 1997, 1998, 2000, 2001, 2002
 #   by Russ Allbery <rra@stanford.edu> and Zenin <zenin@bawdycaste.com>
@@ -34,7 +34,7 @@ Exporter::export_ok_tags ('constants');
 
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.
-$VERSION = 1.05;
+$VERSION = 1.07;
 
 ##############################################################################
 # Internal data structures
@@ -227,7 +227,7 @@ Term::ANSIColor - Color screen output using ANSI escape sequences
 
 This module has two interfaces, one through color() and colored() and the
 other through constants.  It also offers the utility function uncolor(),
-which has to be explicitly imported to be used (see L<SYNOPSYS>).
+which has to be explicitly imported to be used (see L<SYNOPSIS>).
 
 color() takes any number of strings as arguments and considers them to be
 space-separated lists of attributes.  It then forms and returns the escape
@@ -410,7 +410,8 @@ ignored, or they may display as an ESC character followed by some apparent
 garbage.
 
 Jean Delvare provided the following table of different common terminal
-emulators and their support for the various attributes:
+emulators and their support for the various attributes and others have helped
+me flesh it out:
 
               clear    bold     dark    under    blink   reverse  conceal
  ------------------------------------------------------------------------
@@ -420,11 +421,15 @@ emulators and their support for the various attributes:
  dtterm        yes      yes      yes     yes    reverse    yes      yes
  teraterm      yes    reverse    no      yes    rev/red    yes      no
  aixterm      kinda   normal     no      yes      no       yes      yes
+ PuTTY         yes     color     no      yes      no       yes      no
+ Windows       yes      no       no      no       no       yes      no
+ Cygwin SSH    yes      yes      no     color    color    color     yes
 
-Where the entry is other than yes or no, that emulator interpret the given
-attribute as something else instead.  Note that on an aixterm, clear doesn't
-reset colors; you have to explicitly set the colors back to what you want.
-More entries in this table are welcome.
+Windows is Windows telnet, and Cygwin SSH is the OpenSSH implementation under
+Cygwin on Windows NT.  Where the entry is other than yes or no, that emulator
+displays the given attribute as something else instead.  Note that on an
+aixterm, clear doesn't reset colors; you have to explicitly set the colors
+back to what you want.  More entries in this table are welcome.
 
 Note that codes 3 (italic), 6 (rapid blink), and 9 (strikethrough) are
 specified in ANSI X3.64 and ECMA-048 but are not commonly supported by most
@@ -438,7 +443,7 @@ supported by this module.
 =head1 SEE ALSO
 
 ECMA-048 is available on-line (at least at the time of this writing) at
-L<http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>.
+L<http://www.ecma-international.org/publications/standards/ECMA-048.HTM>.
 
 ISO 6429 is available from ISO for a charge; the author of this module does
 not own a copy of it.  Since the source material for ISO 6429 was ECMA-048
diff --git a/gnu/usr.bin/perl/lib/Term/Cap.pm b/gnu/usr.bin/perl/lib/Term/Cap.pm
index 03d2573d853..1deadc55049 100644
--- a/gnu/usr.bin/perl/lib/Term/Cap.pm
+++ b/gnu/usr.bin/perl/lib/Term/Cap.pm
@@ -6,7 +6,7 @@ use strict;
 use vars qw($VERSION $VMS_TERMCAP);
 use vars qw($termpat $state $first $entry);
 
-$VERSION = '1.07';
+$VERSION = '1.08';
 
 # Version undef: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
 # Version 1.00:  Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com
@@ -29,6 +29,8 @@ $VERSION = '1.07';
 # Version 1.07:  Wed Jan  2 21:35:09 GMT 2002
 #       Sanity check on infocmp output from Norton Allen
 #       Repaired INSTALLDIRS thanks to Michael Schwern
+# Version 1.08: Fri Aug 30 14:15:55 CEST 2002
+#	Cope with comments lines from 'infocmp' from Brendan O'Dea
 
 # TODO:
 # support Berkeley DB termcaps
@@ -217,9 +219,9 @@ sub Tgetent { ## public -- static method
         }
         else {
            if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} ) {
-              eval
-              {
+              eval {
                 my $tmp = `infocmp -C 2>/dev/null`;
+                $tmp =~ s/^#.*\n//gm;	# remove comments
 
                 if (( $tmp !~ m%^/%s ) && ( $tmp =~ /(^|\|)${termpat}[:|]/s)) {
                    $entry = $tmp;
diff --git a/gnu/usr.bin/perl/lib/Term/Complete.pm b/gnu/usr.bin/perl/lib/Term/Complete.pm
index e20b2a66cea..c74907bb597 100644
--- a/gnu/usr.bin/perl/lib/Term/Complete.pm
+++ b/gnu/usr.bin/perl/lib/Term/Complete.pm
@@ -5,7 +5,7 @@ require Exporter;
 use strict;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(Complete);
-our $VERSION = '1.4';
+our $VERSION = '1.401';
 
 #      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91
 
@@ -66,7 +66,7 @@ Wayne Thompson
 
 =cut
 
-our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty);
+our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty, $tty_safe_restore);
 our($tty_saved_state) = '';
 CONFIG: {
     $complete = "\004";
@@ -77,6 +77,7 @@ CONFIG: {
 	if (-x $s) {
 	    $tty_raw_noecho = "$s raw -echo";
 	    $tty_restore    = "$s -raw echo";
+	    $tty_safe_restore = $tty_restore;
 	    $stty = $s;
 	    last;
 	}
@@ -106,7 +107,8 @@ sub Complete {
 	    $tty_saved_state = undef;
 	}
 	else {
-	    $tty_restore = qq($stty "$tty_saved_state");
+	    $tty_saved_state =~ s/\s+$//g;
+	    $tty_restore = qq($stty "$tty_saved_state" 2>/dev/null);
 	}
     }
     system $tty_raw_noecho if defined $tty_raw_noecho;
@@ -168,10 +170,18 @@ sub Complete {
             }
         }
     }
-    system $tty_restore if defined $tty_restore;
+
+    # system $tty_restore if defined $tty_restore;
+    if (defined $tty_saved_state && defined $tty_restore && defined $tty_safe_restore)
+    {
+	system $tty_restore;
+	if ($?) {
+	    # tty_restore caused error
+	    system $tty_safe_restore;
+	}
+    }
     print("\n");
     $return;
 }
 
 1;
-
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
index 8c58694fd8a..8cb6ab3f2bf 100644
--- a/gnu/usr.bin/perl/lib/Term/ReadLine.pm
+++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
@@ -1,7 +1,7 @@
 =head1 NAME
 
-Term::ReadLine - Perl interface to various C<readline> packages. If
-no real package is found, substitutes stubs instead of basic functions.
+Term::ReadLine - Perl interface to various C<readline> packages.
+If no real package is found, substitutes stubs instead of basic functions.
 
 =head1 SYNOPSIS
 
@@ -10,7 +10,7 @@ no real package is found, substitutes stubs instead of basic functions.
   my $prompt = "Enter your arithmetic expression: ";
   my $OUT = $term->OUT || \*STDOUT;
   while ( defined ($_ = $term->readline($prompt)) ) {
-    my $res = eval($_), "\n";
+    my $res = eval($_);
     warn $@ if $@;
     print $OUT $res, "\n" unless $@;
     $term->addhistory($_) if /\S/;
@@ -33,7 +33,7 @@ or as
 
   $term->addhistory('row');
 
-where $term is a return value of Term::ReadLine-E<gt>Init.
+where $term is a return value of Term::ReadLine-E<gt>new().
 
 =over 12
 
@@ -60,7 +60,7 @@ support. Trailing newline is removed. Returns C<undef> on C<EOF>.
 adds the line to the history of input, from where it can be used if
 the actual C<readline> is present.
 
-=item C<IN>, $C<OUT>
+=item C<IN>, C<OUT>
 
 return the filehandles for input and output or C<undef> if C<readline>
 input and output cannot be used for Perl.
@@ -184,6 +184,8 @@ $DB::emacs = $DB::emacs;	# To peacify -w
 our @rl_term_set;
 *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
 
+sub PERL_UNICODE_STDIN () { 0x0001 }
+
 sub ReadLine {'Term::ReadLine::Stub'}
 sub readline {
   my $self = shift;
@@ -196,6 +198,9 @@ sub readline {
   #$str = scalar <$in>;
   $str = $self->get_line;
   $str =~ s/^\s*\Q$prompt\E// if ($^O eq 'MacOS');
+  utf8::upgrade($str)
+      if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
+         utf8::valid($str);
   print $out $rl_term_set[3]; 
   # bug in 5.000: chomping empty string creats length -1:
   chomp $str if defined $str;
@@ -285,7 +290,7 @@ sub Features { \%features }
 
 package Term::ReadLine;		# So late to allow the above code be defined?
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {
diff --git a/gnu/usr.bin/perl/lib/Test/Harness.pm b/gnu/usr.bin/perl/lib/Test/Harness.pm
index 337d055d7dc..bcb72368f6e 100644
--- a/gnu/usr.bin/perl/lib/Test/Harness.pm
+++ b/gnu/usr.bin/perl/lib/Test/Harness.pm
@@ -1,5 +1,5 @@
 # -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
+# $Id: Harness.pm,v 1.7 2003/12/03 03:02:41 millert Exp $
 
 package Test::Harness;
 
@@ -13,16 +13,16 @@ use strict;
 
 use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
             $Columns $verbose $switches $ML $Strap
-            @ISA @EXPORT @EXPORT_OK
+            @ISA @EXPORT @EXPORT_OK $Last_ML_Print
            );
 
 # Backwards compatibility for exportable variable names.
-*verbose  = \$Verbose;
-*switches = \$Switches;
+*verbose  = *Verbose;
+*switches = *Switches;
 
 $Have_Devel_Corestack = 0;
 
-$VERSION = '2.26';
+$VERSION = '2.30';
 
 $ENV{HARNESS_ACTIVE} = 1;
 
@@ -36,6 +36,8 @@ my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
 
 my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
 
+my $Ok_Slow = $ENV{HARNESS_OK_SLOW};
+
 $Strap = Test::Harness::Straps->new;
 
 @ISA = ('Exporter');
@@ -328,6 +330,7 @@ It returns true if everything was ok.  Otherwise it will die() with
 one of the messages in the DIAGNOSTICS section.
 
 =for _private
+
 This is just _run_all_tests() plus _show_results()
 
 =cut
@@ -448,7 +451,7 @@ sub _run_all_tests {
 
     my $width = _leader_width(@tests);
     foreach my $tfile (@tests) {
-
+        $Last_ML_Print = 0;  # so each test prints at least once
         my($leader, $ml) = _mk_leader($tfile, $width);
         local $ML = $ml;
         print $leader;
@@ -469,7 +472,7 @@ sub _run_all_tests {
                     failed      => \@failed,
                     bonus       => $results{bonus},
                     skipped     => $results{skip},
-                    skip_reason => $Strap->{_skip_reason},
+                    skip_reason => $results{skip_reason},
                     skip_all    => $Strap->{skip_all},
                     ml          => $ml,
                    );
@@ -482,12 +485,7 @@ sub _run_all_tests {
 
         my($estatus, $wstatus) = @results{qw(exit wait)};
 
-        if ($wstatus) {
-            $failedtests{$tfile} = _dubious_return(\%test, \%tot, 
-                                                  $estatus, $wstatus);
-            $failedtests{$tfile}{name} = $tfile;
-        }
-        elsif ($results{passing}) {
+        if ($results{passing}) {
             if ($test{max} and $test{skipped} + $test{bonus}) {
                 my @msg;
                 push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
@@ -507,11 +505,27 @@ sub _run_all_tests {
             $tot{good}++;
         }
         else {
-            if ($test{max}) {
-                if ($test{'next'} <= $test{max}) {
-                    push @{$test{failed}}, $test{'next'}..$test{max};
+            # List unrun tests as failures.
+            if ($test{'next'} <= $test{max}) {
+                push @{$test{failed}}, $test{'next'}..$test{max};
+            }
+            # List overruns as failures.
+            else {
+                my $details = $results{details};
+                foreach my $overrun ($test{max}+1..@$details)
+                {
+                    next unless ref $details->[$overrun-1];
+                    push @{$test{failed}}, $overrun
                 }
-                if (@{$test{failed}}) {
+            }
+
+            if ($wstatus) {
+                $failedtests{$tfile} = _dubious_return(\%test, \%tot, 
+                                                       $estatus, $wstatus);
+                $failedtests{$tfile}{name} = $tfile;
+            }
+            elsif($results{seen}) {
+                if (@{$test{failed}} and $test{max}) {
                     my ($txt, $canon) = canonfailed($test{max},$test{skipped},
                                                     @{$test{failed}});
                     print "$test{ml}$txt";
@@ -536,7 +550,7 @@ sub _run_all_tests {
                                            };
                 }
                 $tot{bad}++;
-            } elsif ($test{'next'} == 0) {
+            } else {
                 print "FAILED before any test output arrived\n";
                 $tot{bad}++;
                 $failedtests{$tfile} = { canon       => '??',
@@ -694,13 +708,13 @@ $Handlers{test} = sub {
     my $detail = $totals->{details}[-1];
 
     if( $detail->{ok} ) {
-        _print_ml("ok $curr/$max");
+        _print_ml_less("ok $curr/$max");
 
         if( $detail->{type} eq 'skip' ) {
-            $self->{_skip_reason} = $detail->{reason}
-              unless defined $self->{_skip_reason};
-            $self->{_skip_reason} = 'various reasons'
-              if $self->{_skip_reason} ne $detail->{reason};
+            $totals->{skip_reason} = $detail->{reason}
+              unless defined $totals->{skip_reason};
+            $totals->{skip_reason} = 'various reasons'
+              if $totals->{skip_reason} ne $detail->{reason};
         }
     }
     else {
@@ -730,6 +744,15 @@ sub _print_ml {
 }
 
 
+# For slow connections, we save lots of bandwidth by printing only once
+# per second.
+sub _print_ml_less {
+    if( !$Ok_Slow || $Last_ML_Print != time ) {
+        _print_ml(@_);
+        $Last_ML_Print = time;
+    }
+}
+
 sub _bonusmsg {
     my($tot) = @_;
 
@@ -858,12 +881,15 @@ sub _create_fmts {
     sub corestatus {
         my($st) = @_;
 
-        eval {
+        my $did_core;
+        eval { # we may not have a WCOREDUMP
             local $^W = 0;  # *.ph files are often *very* noisy
-            require 'wait.ph'
+            require 'wait.ph';
+            $did_core = WCOREDUMP($st);
         };
-        return if $@;
-        my $did_core = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
+        if( $@ ) {
+            $did_core = $st & 0200;
+        }
 
         eval { require Devel::CoreStack; $Have_Devel_Corestack++ } 
           unless $tried_devel_corestack++;
@@ -872,7 +898,7 @@ sub _create_fmts {
     }
 }
 
-sub canonfailed ($@) {
+sub canonfailed ($$@) {
     my($max,$skipped,@failed) = @_;
     my %seen;
     @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
@@ -903,13 +929,23 @@ sub canonfailed ($@) {
     }
 
     push @result, "\tFailed $failed/$max tests, ";
-    push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+    if ($max) {
+	push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+    } else {
+	push @result, "?% okay";
+    }
     my $ender = 's' x ($skipped > 1);
     my $good = $max - $failed - $skipped;
-    my $goodper = sprintf("%.2f",100*($good/$max));
-    push @result, " (less $skipped skipped test$ender: $good okay, ".
-                  "$goodper%)"
-         if $skipped;
+    if ($skipped) {
+	my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
+	if ($max) {
+	    my $goodper = sprintf("%.2f",100*($good/$max));
+	    $skipmsg .= "$goodper%)";
+	} else {
+	    $skipmsg .= "?%)";
+	}
+	push @result, $skipmsg;
+    }
     push @result, "\n";
     my $txt = join "", @result;
     ($txt, $canon);
@@ -928,7 +964,7 @@ __END__
 
 =head1 EXPORT
 
-C<&runtests> is exported by Test::Harness per default.
+C<&runtests> is exported by Test::Harness by default.
 
 C<$verbose> and C<$switches> are exported upon request.
 
@@ -1014,6 +1050,12 @@ output more frequent progress messages using carriage returns.  Some
 consoles may not handle carriage returns properly (which results in a
 somewhat messy output).
 
+=item C<HARNESS_OK_SLOW>
+
+If true, the C<ok> messages are printed out only every second.
+This reduces output and therefore may for example help testing
+over slow connections.
+
 =item C<HARNESS_PERL_SWITCHES>
 
 Its value will be prepended to the switches used to invoke perl on
@@ -1054,9 +1096,17 @@ analysis.
 Either Tim Bunce or Andreas Koenig, we don't know. What we know for
 sure is, that it was inspired by Larry Wall's TEST script that came
 with perl distributions for ages. Numerous anonymous contributors
-exist.  Andreas Koenig held the torch for many years.
+exist.  Andreas Koenig held the torch for many years, and then
+Michael G Schwern.
 
-Current maintainer is Michael G Schwern E<lt>schwern@pobox.comE<gt>
+Current maintainer is Andy Lester C<< <andy@petdance.com> >>.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
 
 =head1 TODO
 
@@ -1065,6 +1115,8 @@ validation of tests.  This will probably take the form of a version
 of runtests() which rather than printing its output returns raw data
 on the state of the tests.  (Partially done in Test::Harness::Straps)
 
+Document the format.
+
 Fix HARNESS_COMPILE_TEST without breaking its core usage.
 
 Figure a way to report test names in the failure summary.
@@ -1076,10 +1128,36 @@ Deal with VMS's "not \nok 4\n" mistake.
 
 Add option for coverage analysis.
 
+Trap STDERR.
+
+Implement Straps total_results()
+
+Remember exit code
+
+Completely redo the print summary code.
+
+Implement Straps callbacks.  (experimentally implemented)
+
+Straps->analyze_file() not taint clean, don't know if it can be
+
+Fix that damned VMS nit.
+
+HARNESS_TODOFAIL to display TODO failures
+
+Add a test for verbose.
+
+Change internal list of test results to a hash.
+
+Fix stats display when there's an overrun.
+
+Fix so perls with spaces in the filename work.
+
 =for _private
+
 Keeping whittling away at _run_all_tests()
 
 =for _private
+
 Clean up how the summary is printed.  Get rid of those damned formats.
 
 =head1 BUGS
diff --git a/gnu/usr.bin/perl/lib/Text/Abbrev.pm b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
index 08143fea8fb..c6be63bcc60 100644
--- a/gnu/usr.bin/perl/lib/Text/Abbrev.pm
+++ b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
@@ -2,7 +2,7 @@ package Text::Abbrev;
 require 5.005;		# Probably works on earlier versions too.
 require Exporter;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 =head1 NAME
 
@@ -43,6 +43,7 @@ The values are the original list elements.
 sub abbrev {
     my ($word, $hashref, $glob, %table, $returnvoid);
 
+    @_ or return;   # So we don't autovivify onto @_ and trigger warning
     if (ref($_[0])) {           # hash reference preferably
       $hashref = shift;
       $returnvoid = 1;
diff --git a/gnu/usr.bin/perl/lib/Text/Balanced.pm b/gnu/usr.bin/perl/lib/Text/Balanced.pm
index ee83e545dc8..362dc59b94e 100644
--- a/gnu/usr.bin/perl/lib/Text/Balanced.pm
+++ b/gnu/usr.bin/perl/lib/Text/Balanced.pm
@@ -10,7 +10,7 @@ use Exporter;
 use SelfLoader;
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 
-$VERSION = '1.89';
+$VERSION = '1.95';
 @ISA		= qw ( Exporter );
 		     
 %EXPORT_TAGS	= ( ALL => [ qw(
@@ -30,15 +30,6 @@ $VERSION = '1.89';
 
 Exporter::export_ok_tags('ALL');
 
-##
-## These shenanagins are to avoid using $& in perl5.6+
-##
-my $GetMatchedText = ($] < 5.006) ? eval 'sub { $& } '
-                                  : eval 'sub { 
-                                           substr($_[0], $-[0], $+[0] - $-[0])
-                                          }';
-
-
 # PROTOTYPES
 
 sub _match_bracketed($$$$$$);
@@ -337,8 +328,7 @@ sub _match_tagged	# ($$$$$$$)
 
 	if (!defined $rdel)
 	{
-		$rdelspec = &$GetMatchedText($$textref);
-
+		$rdelspec = $&;
 		unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes)
 		{
 			_failmsg "Unable to construct closing tag to match: $rdel",
@@ -348,7 +338,16 @@ sub _match_tagged	# ($$$$$$$)
 	}
 	else
 	{
-		$rdelspec = eval "qq{$rdel}";
+		$rdelspec = eval "qq{$rdel}" || do {
+			my $del;
+			for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',)
+				{ next if $rdel =~ /\Q$_/; $del = $_; last }
+			unless ($del) {
+				use Carp;
+				croak "Can't interpolate right delimiter $rdel"
+			}
+			eval "qq$del$rdel$del";
+		};
 	}
 
 	while (pos($$textref) < length($$textref))
@@ -450,7 +449,7 @@ sub _match_variable($$)
 		return;
 	}
 	my $varpos = pos($$textref);
-        unless ($$textref =~ m{\G\$\s*(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci)
+        unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci)
 	{
 	    unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc)
 	    {
@@ -472,6 +471,7 @@ sub _match_variable($$)
 
 	while (1)
 	{
+		next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc;
 		next if _match_codeblock($textref,
 					 qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/,
 					 qr/[({[]/, qr/[)}\]]/,
@@ -583,11 +583,13 @@ sub _match_codeblock($$$$$$$)
 
 
 		# NEED TO COVER MANY MORE CASES HERE!!!
-		if ($$textref =~ m#\G\s*( [-+*x/%^&|.]=?
+		if ($$textref =~ m#\G\s*(?!$ldel_inner)
+					( [-+*x/%^&|.]=?
 					| [!=]~
 					| =(?!>)
 					| (\*\*|&&|\|\||<<|>>)=?
 					| split|grep|map|return
+					| [([]
 					)#gcx)
 		{
 			$patvalid = 1;
@@ -717,7 +719,7 @@ sub _match_quotelike($$$$)	# ($textref, $prepat, $allow_raw_match)
 		       );
 	}
 
-	unless ($$textref =~ m{\G((?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
+	unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
 	{
 		_failmsg q{No quotelike operator found after prefix at "} .
 			     substr($$textref, pos($$textref), 20) .
@@ -908,7 +910,7 @@ sub extract_multiple (;$$$$)	# ($text, $functions_ref, $max_fields, $ignoreunkno
 
 		FIELD: while (pos($$textref) < length($$textref))
 		{
-			my $field;
+			my ($field, $rem);
 			my @bits;
 			foreach my $i ( 0..$#func )
 			{
@@ -917,12 +919,13 @@ sub extract_multiple (;$$$$)	# ($text, $functions_ref, $max_fields, $ignoreunkno
 				$class = $class[$i];
 				$lastpos = pos $$textref;
 				if (ref($func) eq 'CODE')
-					{ ($field,undef,$pref) = @bits = $func->($$textref) }
+					{ ($field,$rem,$pref) = @bits = $func->($$textref);
+					# print "[$field|$rem]" if $field;
+					}
 				elsif (ref($func) eq 'Text::Balanced::Extractor')
 					{ @bits = $field = $func->extract($$textref) }
 				elsif( $$textref =~ m/\G$func/gc )
-					{ @bits = $field = defined($1) ? $1 : &$GetMatchedText($$textref) }
-                                       # substr() on previous line is "$&", without the pain
+					{ @bits = $field = defined($1) ? $1 : $& }
 				$pref ||= "";
 				if (defined($field) && length($field))
 				{
@@ -1057,7 +1060,7 @@ Text::Balanced - Extract delimited text sequences from strings.
 
 
  # Extract the initial substring of $text that is bounded by
- # an HTML/XML tag.
+ # an XML tag.
 
 	($extracted, $remainder) = extract_tagged($text);
 
@@ -1113,11 +1116,23 @@ Text::Balanced - Extract delimited text sequences from strings.
 
 =head1 DESCRIPTION
 
-The various C<extract_...> subroutines may be used to extract a 
-delimited string (possibly after skipping a specified prefix string).
-The search for the string always begins at the current C<pos>
-location of the string's variable (or at index zero, if no C<pos>
-position is defined).
+The various C<extract_...> subroutines may be used to
+extract a delimited substring, possibly after skipping a
+specified prefix string. By default, that prefix is
+optional whitespace (C</\s*/>), but you can change it to whatever
+you wish (see below).
+
+The substring to be extracted must appear at the
+current C<pos> location of the string's variable
+(or at index zero, if no C<pos> position is defined).
+In other words, the C<extract_...> subroutines I<don't>
+extract the first occurance of a substring anywhere
+in a string (like an unanchored regex would). Rather,
+they extract an occurance of the substring appearing
+immediately at the current matching position in the
+string (like a C<\G>-anchored regex would).
+
+
 
 =head2 General behaviour in list contexts
 
@@ -1219,7 +1234,7 @@ pattern C<'\s*'> - optional whitespace - is used. If the delimiter set
 is also not specified, the set C</["'`]/> is used. If the text to be processed
 is not specified either, C<$_> is used.
 
-In list context, C<extract_delimited> returns an array of three
+In list context, C<extract_delimited> returns a array of three
 elements, the extracted substring (I<including the surrounding
 delimiters>), the remainder of the text, and the skipped prefix (if
 any). If a suitable delimited substring is not found, the first
@@ -1375,6 +1390,58 @@ would correctly match something like this:
 See also: C<"extract_quotelike"> and C<"extract_codeblock">.
 
 
+=head2 C<extract_variable>
+
+C<extract_variable> extracts any valid Perl variable or
+variable-involved expression, including scalars, arrays, hashes, array
+accesses, hash look-ups, method calls through objects, subroutine calles
+through subroutine references, etc.
+
+The subroutine takes up to two optional arguments:
+
+=over 4
+
+=item 1.
+
+A string to be processed (C<$_> if the string is omitted or C<undef>)
+
+=item 2.
+
+A string specifying a pattern to be matched as a prefix (which is to be
+skipped). If omitted, optional whitespace is skipped.
+
+=back
+
+On success in a list context, an array of 3 elements is returned. The
+elements are:
+
+=over 4
+
+=item [0]
+
+the extracted variable, or variablish expression
+
+=item [1]
+
+the remainder of the input text,
+
+=item [2]
+
+the prefix substring (if any),
+
+=back
+
+On failure, all of these values (except the remaining text) are C<undef>.
+
+In a scalar context, C<extract_variable> returns just the complete
+substring that matched a variablish expression. C<undef> is returned on
+failure. In addition, the original input text has the returned substring
+(and any prefix) removed from it.
+
+In a void context, the input text just has the matched substring (and
+any specified prefix) removed.
+
+
 =head2 C<extract_tagged>
 
 C<extract_tagged> extracts and segments text between (balanced)
@@ -1392,7 +1459,7 @@ A string to be processed (C<$_> if the string is omitted or C<undef>)
 
 A string specifying a pattern to be matched as the opening tag.
 If the pattern string is omitted (or C<undef>) then a pattern
-that matches any standard HTML/XML tag is used.
+that matches any standard XML tag is used.
 
 =item 3.
 
@@ -1427,7 +1494,7 @@ that must I<not> appear within the tagged text.
 For example, to extract
 an HTML link (which should not contain nested links) use:
 
-	extract_tagged($text, '<A>', '</A>', undef, {reject => ['<A>']} );
+        extract_tagged($text, '<A>', '</A>', undef, {reject => ['<A>']} );
 
 =item C<ignore =E<gt> $listref>
 
@@ -1437,7 +1504,7 @@ that are I<not> be be treated as nested tags within the tagged text
 
 For example, to extract an arbitrary XML tag, but ignore "empty" elements:
 
-	extract_tagged($text, undef, undef, undef, {ignore => ['<[^>]*/>']} );
+        extract_tagged($text, undef, undef, undef, {ignore => ['<[^>]*/>']} );
 
 (also see L<"gen_delimited_pat"> below).
 
@@ -1460,22 +1527,22 @@ For example, suppose the start tag "/para" introduces a paragraph, which then
 continues until the next "/endpara" tag or until another "/para" tag is
 encountered:
 
-	$text = "/para line 1\n\nline 3\n/para line 4";
+        $text = "/para line 1\n\nline 3\n/para line 4";
 
-	extract_tagged($text, '/para', '/endpara', undef,
-				{reject => '/para', fail => MAX );
+        extract_tagged($text, '/para', '/endpara', undef,
+                                {reject => '/para', fail => MAX );
 
-	# EXTRACTED: "/para line 1\n\nline 3\n"
+        # EXTRACTED: "/para line 1\n\nline 3\n"
 
 Suppose instead, that if no matching "/endpara" tag is found, the "/para"
 tag refers only to the immediately following paragraph:
 
-	$text = "/para line 1\n\nline 3\n/para line 4";
+        $text = "/para line 1\n\nline 3\n/para line 4";
 
-	extract_tagged($text, '/para', '/endpara', undef,
-			{reject => '/para', fail => MAX );
+        extract_tagged($text, '/para', '/endpara', undef,
+                        {reject => '/para', fail => MAX );
 
-	# EXTRACTED: "/para line 1\n"
+        # EXTRACTED: "/para line 1\n"
 
 Note that the specified C<fail> behaviour applies to nested tags as well.
 
@@ -1558,12 +1625,12 @@ be extracted from).
 In other words, the implementation of C<extract_tagged> is exactly
 equivalent to:
 
-	sub extract_tagged
-	{
-		my $text = shift;
-		$extractor = gen_extract_tagged(@_);
-		return $extractor->($text);
-	}
+        sub extract_tagged
+        {
+                my $text = shift;
+                $extractor = gen_extract_tagged(@_);
+                return $extractor->($text);
+        }
 
 (although C<extract_tagged> is not currently implemented that way, in order
 to preserve pre-5.005 compatibility).
@@ -1582,13 +1649,13 @@ L<perlop(3)>) Nested backslashed delimiters, embedded balanced bracket
 delimiters (for the quotelike operators), and trailing modifiers are
 all caught. For example, in:
 
-	extract_quotelike 'q # an octothorpe: \# (not the end of the q!) #'
-	
-	extract_quotelike '  "You said, \"Use sed\"."  '
+        extract_quotelike 'q # an octothorpe: \# (not the end of the q!) #'
+        
+        extract_quotelike '  "You said, \"Use sed\"."  '
 
-	extract_quotelike ' s{([A-Z]{1,8}\.[A-Z]{3})} /\L$1\E/; '
+        extract_quotelike ' s{([A-Z]{1,8}\.[A-Z]{3})} /\L$1\E/; '
 
-	extract_quotelike ' tr/\\\/\\\\/\\\//ds; '
+        extract_quotelike ' tr/\\\/\\\\/\\\//ds; '
 
 the full Perl quotelike operations are all extracted correctly.
 
@@ -1596,17 +1663,17 @@ Note too that, when using the /x modifier on a regex, any comment
 containing the current pattern delimiter will cause the regex to be
 immediately terminated. In other words:
 
-	'm /
-		(?i)		# CASE INSENSITIVE
-		[a-z_]		# LEADING ALPHABETIC/UNDERSCORE
-		[a-z0-9]*	# FOLLOWED BY ANY NUMBER OF ALPHANUMERICS
-	   /x'
+        'm /
+                (?i)            # CASE INSENSITIVE
+                [a-z_]          # LEADING ALPHABETIC/UNDERSCORE
+                [a-z0-9]*       # FOLLOWED BY ANY NUMBER OF ALPHANUMERICS
+           /x'
 
 will be extracted as if it were:
 
-	'm /
-		(?i)		# CASE INSENSITIVE
-		[a-z_]		# LEADING ALPHABETIC/'
+        'm /
+                (?i)            # CASE INSENSITIVE
+                [a-z_]          # LEADING ALPHABETIC/'
 
 This behaviour is identical to that of the actual compiler.
 
@@ -1653,7 +1720,7 @@ the right delimiter of the first block of the operation,
 =item [7]
 
 the left delimiter of the second block of the operation
-(that is, if it is an C<s>, C<tr>, or C<y>),
+(that is, if it is a C<s>, C<tr>, or C<y>),
 
 =item [8]
 
@@ -1683,27 +1750,27 @@ prefix) removed.
 
 Examples:
 
-	# Remove the first quotelike literal that appears in text
+        # Remove the first quotelike literal that appears in text
 
-		$quotelike = extract_quotelike($text,'.*?');
+                $quotelike = extract_quotelike($text,'.*?');
 
-	# Replace one or more leading whitespace-separated quotelike
-	# literals in $_ with "<QLL>"
+        # Replace one or more leading whitespace-separated quotelike
+        # literals in $_ with "<QLL>"
 
-		do { $_ = join '<QLL>', (extract_quotelike)[2,1] } until $@;
+                do { $_ = join '<QLL>', (extract_quotelike)[2,1] } until $@;
 
 
-	# Isolate the search pattern in a quotelike operation from $text
+        # Isolate the search pattern in a quotelike operation from $text
 
-		($op,$pat) = (extract_quotelike $text)[3,5];
-		if ($op =~ /[ms]/)
-		{
-			print "search pattern: $pat\n";
-		}
-		else
-		{
-			print "$op is not a pattern matching operation\n";
-		}
+                ($op,$pat) = (extract_quotelike $text)[3,5];
+                if ($op =~ /[ms]/)
+                {
+                        print "search pattern: $pat\n";
+                }
+                else
+                {
+                        print "$op is not a pattern matching operation\n";
+                }
 
 
 =head2 C<extract_quotelike> and "here documents"
@@ -1718,7 +1785,7 @@ here document might look like this:
         <<'EOMSG' || die;
         This is the message.
         EOMSG
-	exit;
+        exit;
 
 Given this as an input string in a scalar context, C<extract_quotelike>
 would correctly return the string "<<'EOMSG'\nThis is the message.\nEOMSG",
@@ -1771,7 +1838,7 @@ However, the matching position of the input variable would be set to
 which would cause the earlier " || die;\nexit;" to be skipped in any
 sequence of code fragment extractions.
 
-To avoid this problem, when it encounters a here document while
+To avoid this problem, when it encounters a here document whilst
 extracting from a modifiable string, C<extract_quotelike> silently
 rearranges the string to an equivalent piece of Perl:
 
@@ -1779,7 +1846,7 @@ rearranges the string to an equivalent piece of Perl:
         This is the message.
         EOMSG
         || die;
-	exit;
+        exit;
 
 in which the here document I<is> contiguous. It still leaves the
 matching position after the here document, but now the rest of the line
@@ -1811,7 +1878,7 @@ Omitting the third argument (prefix argument) implies optional whitespace at the
 Omitting the fourth argument (outermost delimiter brackets) indicates that the
 value of the second argument is to be used for the outermost delimiters.
 
-Once the prefix an the outermost opening delimiter bracket have been
+Once the prefix an dthe outermost opening delimiter bracket have been
 recognized, code blocks are extracted by stepping through the input text and
 trying the following alternatives in sequence:
 
@@ -1898,7 +1965,7 @@ extracted substring removed from it. In all contexts
 C<extract_multiple> starts at the current C<pos> of the string, and
 sets that C<pos> appropriately after it matches.
 
-Hence, the aim of a call to C<extract_multiple> in a list context
+Hence, the aim of of a call to C<extract_multiple> in a list context
 is to split the processed string into as many non-overlapping fields as
 possible, by repeatedly applying each of the specified extractors
 to the remainder of the string. Thus C<extract_multiple> is
@@ -1930,7 +1997,7 @@ is used.
 
 =item 3.
 
-A number specifying the maximum number of fields to return. If this
+An number specifying the maximum number of fields to return. If this
 argument is omitted (or C<undef>), split continues as long as possible.
 
 If the third argument is I<N>, then extraction continues until I<N> fields
@@ -1986,7 +2053,7 @@ If none of the extractor subroutines succeeds, then one
 character is extracted from the start of the text and the extraction
 subroutines reapplied. Characters which are thus removed are accumulated and
 eventually become the next field (unless the fourth argument is true, in which
-case they are discarded).
+case they are disgarded).
 
 For example, the following extracts substrings that are valid Perl variables:
 
diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.pm b/gnu/usr.bin/perl/lib/Text/Soundex.pm
index 54571b35bdf..94f80c65865 100644
--- a/gnu/usr.bin/perl/lib/Text/Soundex.pm
+++ b/gnu/usr.bin/perl/lib/Text/Soundex.pm
@@ -7,7 +7,7 @@ require Exporter;
 
 $VERSION = '1.01';
 
-# $Id: Soundex.pm,v 1.6 2002/10/27 22:25:27 millert Exp $
+# $Id: Soundex.pm,v 1.7 2003/12/03 03:02:41 millert Exp $
 #
 # Implementation of soundex algorithm as described by Knuth in volume
 # 3 of The Art of Computer Programming, with ideas stolen from Ian
@@ -25,8 +25,8 @@ $VERSION = '1.01';
 # Lukasiewicz, Lissajous -> L222
 #
 # $Log: Soundex.pm,v $
-# Revision 1.6  2002/10/27 22:25:27  millert
-# Resolve conflicts, remove old files, merge local changes
+# Revision 1.7  2003/12/03 03:02:41  millert
+# Resolve conflicts for perl 5.8.2, remove old files, and add OpenBSD-specific scaffolding
 #
 # Revision 1.2  1994/03/24  00:30:27  mike
 # Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm
index 8dd1f6c2512..c2c32257d6d 100644
--- a/gnu/usr.bin/perl/lib/Text/Wrap.pm
+++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm
@@ -6,7 +6,7 @@ require Exporter;
 @EXPORT = qw(wrap fill);
 @EXPORT_OK = qw($columns $break $huge);
 
-$VERSION = 2001.0929;
+$VERSION = 2001.09291;
 
 use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
 	$separator);
@@ -34,6 +34,7 @@ sub wrap
 	my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
 	my $lead = $ip;
 	my $ll = $columns - length(expand($ip)) - 1;
+	$ll = 0 if $ll < 0;
 	my $nll = $columns - length(expand($xp)) - 1;
 	my $nl = "";
 	my $remainder = "";
@@ -144,7 +145,7 @@ B<Example 3>
 C<Text::Wrap::wrap()> is a very simple paragraph formatter.  It formats a
 single paragraph at a time by breaking lines at word boundries.
 Indentation is controlled for the first line (C<$initial_tab>) and
-all subsquent lines (C<$subsequent_tab>) independently.  Please note: 
+all subsequent lines (C<$subsequent_tab>) independently.  Please note: 
 C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
 be used: it is unlikley you would want to pass in a number.
 
diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm
index 282006984b9..65f9dd0b385 100644
--- a/gnu/usr.bin/perl/lib/Tie/Hash.pm
+++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm
@@ -24,7 +24,7 @@ Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes
 
     # All methods provided by default, define only those needing overrides
     # Accessors access the storage in %{$_[0]};
-    # TIEHANDLE should return a reference to the actual storage
+    # TIEHASH should return a reference to the actual storage
     sub DELETE { ... }
 
     package NewExtraHash;
@@ -34,11 +34,12 @@ Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes
 
     # All methods provided by default, define only those needing overrides
     # Accessors access the storage in %{$_[0][0]};
-    # TIEHANDLE should return an array reference with the first element being
+    # TIEHASH should return an array reference with the first element being
     # the reference to the actual storage 
     sub DELETE { 
       $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer
-      delete $_[0][0]->{$_[1]};		  #  $_[0]->SUPER::DELETE($_[1]) }
+      delete $_[0][0]->{$_[1]};		  #  $_[0]->SUPER::DELETE($_[1])
+    }
 
 
     package main;
@@ -110,7 +111,7 @@ Clear all values from the tied hash I<this>.
 
 The accessor methods assume that the actual storage for the data in the tied
 hash is in the hash referenced by C<tied(%tiedhash)>.  Thus overwritten
-C<TIEHANDLE> method should return a hash reference, and the remaining methods
+C<TIEHASH> method should return a hash reference, and the remaining methods
 should operate on the hash referenced by the first argument:
 
   package ReportHash;
@@ -131,24 +132,25 @@ should operate on the hash referenced by the first argument:
 
 The accessor methods assume that the actual storage for the data in the tied
 hash is in the hash referenced by C<(tied(%tiedhash))[0]>.  Thus overwritten
-C<TIEHANDLE> method should return an array reference with the first
+C<TIEHASH> method should return an array reference with the first
 element being a hash reference, and the remaining methods should operate on the
 hash C<< %{ $_[0]->[0] } >>:
 
   package ReportHash;
-  our @ISA = 'Tie::StdHash';
+  our @ISA = 'Tie::ExtraHash';
 
   sub TIEHASH  {
-    my $storage = bless {}, shift;
+    my $class = shift;
+    my $storage = bless [{}, @_], $class;
     warn "New ReportHash created, stored in $storage.\n";
-    [$storage, @_]
+    $storage;
   }
   sub STORE    {
     warn "Storing data with key $_[1] at $_[0].\n";
     $_[0][0]{$_[1]} = $_[2]
   }
 
-The default C<TIEHANDLE> method stores "extra" arguments to tie() starting
+The default C<TIEHASH> method stores "extra" arguments to tie() starting
 from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the
 same storage algorithm as in TIEHASH subroutine above.  Hence, a typical
 package inheriting from B<Tie::ExtraHash> does not need to overwrite this
diff --git a/gnu/usr.bin/perl/lib/Tie/RefHash.pm b/gnu/usr.bin/perl/lib/Tie/RefHash.pm
index 8ef85ca280b..3f3fc6b2e52 100644
--- a/gnu/usr.bin/perl/lib/Tie/RefHash.pm
+++ b/gnu/usr.bin/perl/lib/Tie/RefHash.pm
@@ -1,6 +1,6 @@
 package Tie::RefHash;
 
-our $VERSION = 1.30;
+our $VERSION = 1.31;
 
 =head1 NAME
 
@@ -57,6 +57,8 @@ store a reference to one of your own hashes in the tied hash.
 
 Gurusamy Sarathy        gsar@activestate.com
 
+'Nestable' by Ed Avis   ed@membled.com
+
 =head1 VERSION
 
 Version 1.30
@@ -72,6 +74,8 @@ use vars '@ISA';
 @ISA = qw(Tie::Hash);
 use strict;
 
+require overload; # to support objects with overloaded ""
+
 sub TIEHASH {
   my $c = shift;
   my $s = [];
@@ -85,8 +89,9 @@ sub TIEHASH {
 sub FETCH {
   my($s, $k) = @_;
   if (ref $k) {
-      if (defined $s->[0]{"$k"}) {
-        $s->[0]{"$k"}[1];
+      my $kstr = overload::StrVal($k);
+      if (defined $s->[0]{$kstr}) {
+        $s->[0]{$kstr}[1];
       }
       else {
         undef;
@@ -100,7 +105,7 @@ sub FETCH {
 sub STORE {
   my($s, $k, $v) = @_;
   if (ref $k) {
-    $s->[0]{"$k"} = [$k, $v];
+    $s->[0]{overload::StrVal($k)} = [$k, $v];
   }
   else {
     $s->[1]{$k} = $v;
@@ -110,19 +115,19 @@ sub STORE {
 
 sub DELETE {
   my($s, $k) = @_;
-  (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
+  (ref $k) ? delete($s->[0]{overload::StrVal($k)}) : delete($s->[1]{$k});
 }
 
 sub EXISTS {
   my($s, $k) = @_;
-  (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
+  (ref $k) ? exists($s->[0]{overload::StrVal($k)}) : exists($s->[1]{$k});
 }
 
 sub FIRSTKEY {
   my $s = shift;
   keys %{$s->[0]};	# reset iterator
   keys %{$s->[1]};	# reset iterator
-  $s->[2] = 0;
+  $s->[2] = 0;      # flag for iteration, see NEXTKEY
   $s->NEXTKEY;
 }
 
@@ -131,7 +136,7 @@ sub NEXTKEY {
   my ($k, $v);
   if (!$s->[2]) {
     if (($k, $v) = each %{$s->[0]}) {
-      return $s->[0]{"$k"}[0];
+      return $v->[0];
     }
     else {
       $s->[2] = 1;
diff --git a/gnu/usr.bin/perl/lib/Time/Local.pm b/gnu/usr.bin/perl/lib/Time/Local.pm
index faef1d78694..c38d07ca60f 100644
--- a/gnu/usr.bin/perl/lib/Time/Local.pm
+++ b/gnu/usr.bin/perl/lib/Time/Local.pm
@@ -1,15 +1,16 @@
 package Time::Local;
-use 5.006;
+
 require Exporter;
 use Carp;
 use Config;
 use strict;
 use integer;
 
-our $VERSION    = '1.04';
-our @ISA	= qw( Exporter );
-our @EXPORT	= qw( timegm timelocal );
-our @EXPORT_OK	= qw( timegm_nocheck timelocal_nocheck );
+use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
+$VERSION    = '1.07';
+@ISA	= qw( Exporter );
+@EXPORT	= qw( timegm timelocal );
+@EXPORT_OK	= qw( timegm_nocheck timelocal_nocheck );
 
 my @MonthDays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
 
@@ -132,7 +133,18 @@ sub timelocal {
 	or return $loc_t;
 
     # Adjust for DST change
-    $loc_t + $dst_off;
+    $loc_t += $dst_off;
+
+    # for a negative offset from GMT, and if the original date
+    # was a non-extent gap in a forward DST jump, we should
+    # now have the wrong answer - undo the DST adjust;
+
+    return $loc_t if $zone_off <= 0;
+
+    my ($s,$m,$h) = localtime($loc_t);
+    $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
+
+    $loc_t;
 }
 
 
@@ -158,8 +170,11 @@ Time::Local - efficiently compute time from local and GMT time
 
 These routines are the inverse of built-in perl functions localtime()
 and gmtime().  They accept a date as a six-element array, and return
-the corresponding time(2) value in seconds since the Epoch (Midnight,
-January 1, 1970).  This value can be positive or negative.
+the corresponding time(2) value in seconds since the system epoch
+(Midnight, January 1, 1970 UTC on Unix, for example).  This value can
+be positive or negative, though POSIX only requires support for
+positive values, so dates before the system's epoch may not work on
+all operating systems.
 
 It is worth drawing particular attention to the expected ranges for
 the values provided.  The value for the day of the month is the actual day
@@ -251,5 +266,24 @@ The whole scheme for interpreting two-digit years can be considered a bug.
 
 The proclivity to croak() is probably a bug.
 
+=head1 SUPPORT
+
+Support for this module is provided via the perl5-porters@perl.org
+email list.  See http://lists.perl.org/ for more details.
+
+Please submit bugs using the RT system at bugs.perl.org, the perlbug
+script, or as a last resort, to the perl5-porters@perl.org list.
+
+=head1 AUTHOR
+
+This module is based on a Perl 4 library, timelocal.pl, that was
+included with Perl 4.036, and was most likely written by Tom
+Christiansen.
+
+The current version was written by Graham Barr.
+
+It is now being maintained separately from the Perl core by Dave
+Rolsky, <autarch@urth.org>.
+
 =cut
 
diff --git a/gnu/usr.bin/perl/lib/UNIVERSAL.pm b/gnu/usr.bin/perl/lib/UNIVERSAL.pm
index 92b4fcd352a..7b7bfc4058a 100644
--- a/gnu/usr.bin/perl/lib/UNIVERSAL.pm
+++ b/gnu/usr.bin/perl/lib/UNIVERSAL.pm
@@ -1,6 +1,6 @@
 package UNIVERSAL;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 # UNIVERSAL should not contain any extra subs/methods beyond those
 # that it exists to define. The use of Exporter below is a historical
@@ -41,20 +41,42 @@ C<UNIVERSAL> provides the following methods and functions:
 
 =over 4
 
-=item $obj->isa( TYPE ), CLASS->isa( TYPE ), isa( VAL, TYPE )
+=item C<< $obj->isa( TYPE ) >>
 
-    C<TYPE> is a package name
-    $obj is a blessed reference or a string containing a package name
-    C<CLASS> is a package name
-    C<VAL> is any of the above or an unblessed reference
+=item C<< CLASS->isa( TYPE ) >> 
 
-When used as an instance or class method (C<$obj->isa( TYPE )>), C<isa>
-returns I<true> if $obj is blessed into package C<TYPE> or inherits from
-package C<TYPE>.
+=item C<isa( VAL, TYPE )>
 
-When used as a class method (C<CLASS->isa( TYPE )>; sometimes referred to as a
-static method), C<isa> returns I<true> if C<CLASS> inherits from (or is itself)
-the name of the package C<TYPE> or inherits from package C<TYPE>.
+Where
+
+=over 4
+
+=item C<TYPE>
+
+is a package name
+
+=item C<$obj>
+
+is a blessed reference or a string containing a package name
+
+=item C<CLASS>
+
+is a package name
+
+=item C<VAL>
+
+is any of the above or an unblessed reference
+
+=back
+
+When used as an instance or class method (C<< $obj->isa( TYPE ) >>),
+C<isa> returns I<true> if $obj is blessed into package C<TYPE> or
+inherits from package C<TYPE>.
+
+When used as a class method (C<< CLASS->isa( TYPE ) >>: sometimes
+referred to as a static method), C<isa> returns I<true> if C<CLASS>
+inherits from (or is itself) the name of the package C<TYPE> or
+inherits from package C<TYPE>.
 
 When used as a function, like
 
@@ -67,11 +89,15 @@ or
    require UNIVERSAL ;
    $yes = UNIVERSAL::isa $a, "ARRAY";
 
-, C<isa> returns I<true> in the same cases as above and also if C<VAL> is an
+C<isa> returns I<true> in the same cases as above and also if C<VAL> is an
 unblessed reference to a perl variable of type C<TYPE>, such as "HASH",
 "ARRAY", or "Regexp".
 
-=item $obj->can( METHOD ), CLASS->can( METHOD ), can( VAL, METHOD )
+=item C<< $obj->can( METHOD ) >>
+
+=item C<< CLASS->can( METHOD ) >>
+
+=item C<can( VAL, METHOD )>
 
 C<can> checks if the object or class has a method called C<METHOD>. If it does
 then a reference to the sub is returned. If it does not then I<undef> is
@@ -95,24 +121,27 @@ has a method called C<METHOD>, C<can> returns a reference to the subroutine.
 If C<VAL> is not a blessed reference, or if it does not have a method
 C<METHOD>, I<undef> is returned.
 
-=item VERSION ( [ REQUIRE ] )
+=item C<VERSION ( [ REQUIRE ] )>
 
 C<VERSION> will return the value of the variable C<$VERSION> in the
 package the object is blessed into. If C<REQUIRE> is given then
 it will do a comparison and die if the package version is not
 greater than or equal to C<REQUIRE>.
 
-C<VERSION> can be called as either a class (static) method, an object method or
-or a function.
+C<VERSION> can be called as either a class (static) method, an object
+method or a function.
 
 
 =back
 
-These subroutines should I<not> be imported via S<C<use UNIVERSAL qw(...)>>.
-If you want simple local access to them you can do
+=head1 EXPORTS
 
-  *isa = \&UNIVERSAL::isa;
+None by default.
 
-to import isa into your package.
+You may request the import of all three functions (C<isa>, C<can>, and
+C<VERSION>), however it isn't usually necessary to do so.  Perl magically
+makes these functions act as methods on all objects.  The one exception is
+C<isa>, which is useful as a function when operating on non-blessed
+references.
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/base.pm b/gnu/usr.bin/perl/lib/base.pm
index 37f220f63a9..3177488eac0 100644
--- a/gnu/usr.bin/perl/lib/base.pm
+++ b/gnu/usr.bin/perl/lib/base.pm
@@ -1,3 +1,154 @@
+package base;
+
+use strict 'vars';
+use vars qw($VERSION);
+$VERSION = '2.03';
+
+# constant.pm is slow
+sub SUCCESS () { 1 }
+
+sub PUBLIC     () { 2**0  }
+sub PRIVATE    () { 2**1  }
+sub INHERITED  () { 2**2  }
+sub PROTECTED  () { 2**3  }
+
+
+my $Fattr = \%fields::attr;
+
+sub has_fields {
+    my($base) = shift;
+    my $fglob = ${"$base\::"}{FIELDS};
+    return( ($fglob && *$fglob{HASH}) ? 1 : 0 );
+}
+
+sub has_version {
+    my($base) = shift;
+    my $vglob = ${$base.'::'}{VERSION};
+    return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
+}
+
+sub has_attr {
+    my($proto) = shift;
+    my($class) = ref $proto || $proto;
+    return exists $Fattr->{$class};
+}
+
+sub get_attr {
+    $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
+    return $Fattr->{$_[0]};
+}
+
+sub get_fields {
+    # Shut up a possible typo warning.
+    () = \%{$_[0].'::FIELDS'};
+
+    return \%{$_[0].'::FIELDS'};
+}
+
+sub import {
+    my $class = shift;
+
+    return SUCCESS unless @_;
+
+    # List of base classes from which we will inherit %FIELDS.
+    my $fields_base;
+
+    my $inheritor = caller(0);
+
+    foreach my $base (@_) {
+        next if $inheritor->isa($base);
+
+        if (has_version($base)) {
+	    ${$base.'::VERSION'} = '-1, set by base.pm' 
+	      unless defined ${$base.'::VERSION'};
+        }
+        else {
+            local $SIG{__DIE__} = 'IGNORE';
+            eval "require $base";
+            # Only ignore "Can't locate" errors from our eval require.
+            # Other fatal errors (syntax etc) must be reported.
+            die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
+            unless (%{"$base\::"}) {
+                require Carp;
+                Carp::croak(<<ERROR);
+Base class package "$base" is empty.
+    (Perhaps you need to 'use' the module which defines that package first.)
+ERROR
+
+            }
+            ${$base.'::VERSION'} = "-1, set by base.pm"
+              unless defined ${$base.'::VERSION'};
+        }
+        push @{"$inheritor\::ISA"}, $base;
+
+        if ( has_fields($base) || has_attr($base) ) {
+	    # No multiple fields inheritence *suck*
+	    if ($fields_base) {
+		require Carp;
+		Carp::croak("Can't multiply inherit %FIELDS");
+	    } else {
+		$fields_base = $base;
+	    }
+        }
+    }
+
+    if( defined $fields_base ) {
+        inherit_fields($inheritor, $fields_base);
+    }
+}
+
+
+sub inherit_fields {
+    my($derived, $base) = @_;
+
+    return SUCCESS unless $base;
+
+    my $battr = get_attr($base);
+    my $dattr = get_attr($derived);
+    my $dfields = get_fields($derived);
+    my $bfields = get_fields($base);
+
+    $dattr->[0] = @$battr;
+
+    if( keys %$dfields ) {
+        warn "$derived is inheriting from $base but already has its own ".
+             "fields!\n".
+             "This will cause problems with pseudo-hashes.\n".
+             "Be sure you use base BEFORE declaring fields\n";
+    }
+
+    # Iterate through the base's fields adding all the non-private
+    # ones to the derived class.  Hang on to the original attribute
+    # (Public, Private, etc...) and add Inherited.
+    # This is all too complicated to do efficiently with add_fields().
+    while (my($k,$v) = each %$bfields) {
+        my $fno;
+	if ($fno = $dfields->{$k} and $fno != $v) {
+	    require Carp;
+	    Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
+	}
+
+        if( $battr->[$v] & PRIVATE ) {
+            $dattr->[$v] = PRIVATE | INHERITED;
+        }
+        else {
+            $dattr->[$v] = INHERITED | $battr->[$v];
+            $dfields->{$k} = $v;
+        }
+    }
+
+    unless( keys %$bfields ) {
+        foreach my $idx (1..$#{$battr}) {
+            $dattr->[$idx] = $battr->[$idx] & INHERITED;
+        }
+    }
+}
+
+
+1;
+
+__END__
+
 =head1 NAME
 
 base - Establish IS-A relationship with base class at compile time
@@ -12,83 +163,41 @@ base - Establish IS-A relationship with base class at compile time
 Roughly similar in effect to
 
     BEGIN {
-	require Foo;
-	require Bar;
-	push @ISA, qw(Foo Bar);
+        require Foo;
+        require Bar;
+        push @ISA, qw(Foo Bar);
     }
 
-Will also initialize the %FIELDS hash if one of the base classes has
-it.  Multiple inheritance of %FIELDS is not supported.  The 'base'
-pragma will croak if multiple base classes have a %FIELDS hash.  See
-L<fields> for a description of this feature.
+Will also initialize the fields if one of the base classes has it.
+Multiple Inheritence of fields is B<NOT> supported, if two or more
+base classes each have inheritable fields the 'base' pragma will
+croak.  See L<fields>, L<public> and L<protected> for a description of
+this feature.
 
-When strict 'vars' is in scope I<base> also let you assign to @ISA
+When strict 'vars' is in scope, I<base> also lets you assign to @ISA
 without having to declare @ISA with the 'vars' pragma first.
 
 If any of the base classes are not loaded yet, I<base> silently
-C<require>s them.  Whether to C<require> a base class package is
-determined by the absence of a global $VERSION in the base package.
-If $VERSION is not detected even after loading it, <base> will
-define $VERSION in the base package, setting it to the string
-C<-1, set by base.pm>.
+C<require>s them (but it won't call the C<import> method).  Whether to
+C<require> a base class package is determined by the absence of a global
+$VERSION in the base package.  If $VERSION is not detected even after
+loading it, I<base> will define $VERSION in the base package, setting it to
+the string C<-1, set by base.pm>.
+
 
 =head1 HISTORY
 
 This module was introduced with Perl 5.004_04.
 
-=head1 SEE ALSO
-
-L<fields>
 
-=cut
+=head1 CAVEATS
 
-package base;
+Due to the limitations of the pseudo-hash implementation, you must use
+base I<before> you declare any of your own fields.
 
-use 5.006_001;
-our $VERSION = "1.03";
 
-sub import {
-    my $class = shift;
-    my $fields_base;
-    my $pkg = caller(0);
-
-    foreach my $base (@_) {
-	next if $pkg->isa($base);
-        my $vglob;
-	if ($vglob = ${"$base\::"}{VERSION} and *$vglob{SCALAR}) {
-          $$vglob = "-1, set by base.pm" unless defined $$vglob;
-        } else {
-	    eval "require $base";
-	    # Only ignore "Can't locate" errors from our eval require.
-	    # Other fatal errors (syntax etc) must be reported.
-	    die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
-	    unless (%{"$base\::"}) {
-		require Carp;
-		Carp::croak("Base class package \"$base\" is empty.\n",
-			    "\t(Perhaps you need to 'use' the module ",
-			    "which defines that package first.)");
-	    }
-	    ${"$base\::VERSION"} = "-1, set by base.pm" unless defined ${"$base\::VERSION"};
-	}
-	push @{"$pkg\::ISA"}, $base;
+=head1 SEE ALSO
 
-	# A simple test like (defined %{"$base\::FIELDS"}) will
-	# sometimes produce typo warnings because it would create
-	# the hash if it was not present before.
-	my $fglob;
-	if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
-	    if ($fields_base) {
-		require Carp;
-		Carp::croak("Can't multiply inherit %FIELDS");
-	    } else {
-		$fields_base = $base;
-	    }
-	}
-    }
-    if ($fields_base) {
-	require fields;
-	fields::inherit($pkg, $fields_base);
-    }
-}
+L<fields>
 
-1;
+=cut
diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm
index c68fa3f79f8..0d1a7e2e6ef 100644
--- a/gnu/usr.bin/perl/lib/diagnostics.pm
+++ b/gnu/usr.bin/perl/lib/diagnostics.pm
@@ -4,7 +4,7 @@ package diagnostics;
 
 diagnostics - Perl compiler pragma to force verbose warning diagnostics
 
-splain - standalone program to do the same thing
+splain - filter to produce verbose descriptions of perl warning diagnostics
 
 =head1 SYNOPSIS
 
@@ -16,7 +16,7 @@ As a pragma:
     enable  diagnostics;
     disable diagnostics;
 
-Aa a program:
+As a program:
 
     perl program 2>diag.out
     splain [-v] [-p] diag.out
@@ -53,7 +53,7 @@ escape sequences for pagers.
 
 Warnings dispatched from perl itself (or more accurately, those that match
 descriptions found in L<perldiag>) are only displayed once (no duplicate
-descriptions).  User code generated warnings ala warn() are unaffected,
+descriptions).  User code generated warnings a la warn() are unaffected,
 allowing duplicate user messages to be displayed.
 
 =head2 The I<splain> Program
@@ -171,7 +171,7 @@ use strict;
 use 5.006;
 use Carp;
 
-our $VERSION = 1.1;
+our $VERSION = 1.11;
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
@@ -296,6 +296,7 @@ our %HTML_Escapes;
 
 *THITHER = $standalone ? *STDOUT : *STDERR;
 
+my %transfmt = (); 
 my $transmo = <<EOFUNC;
 sub transmo {
     #local \$^W = 0;  # recursive warnings we do NOT need!
@@ -330,7 +331,7 @@ my %msg;
 		    ) )
 		{
 		    next;
-		} 
+		}
 		s/^/    /gm;
 		$msg{$header} .= $_;
 	 	undef $for_item;	
@@ -358,25 +359,38 @@ my %msg;
 	    }
 	}
 
-	# strip formatting directives in =item line
+	# strip formatting directives from =item line
 	$header =~ s/[A-Z]<(.*?)>/$1/g;
 
-	if ($header =~ /%[csd]/) {
-	    my $rhs = my $lhs = $header;
-	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E-?\\d+\Q$2\E/g)  {
-		$lhs =~ s/\\%s/.*?/g;
-	    } else {
-		# if i had lookbehind negations,
-		# i wouldn't have to do this \377 noise
-		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
-		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
-		$lhs =~ s/\377//g;
-		$lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
-	    } 
-	    $lhs =~ s/\\%c/./g;
-	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
+        my @toks = split( /(%l?[dx]|%c|%(?:\.\d+)?s)/, $header );
+	if (@toks > 1) {
+            my $conlen = 0;
+            for my $i (0..$#toks){
+                if( $i % 2 ){
+                    if(      $toks[$i] eq '%c' ){
+                        $toks[$i] = '.';
+                    } elsif( $toks[$i] eq '%d' ){
+                        $toks[$i] = '\d+';
+                    } elsif( $toks[$i] eq '%s' ){
+                        $toks[$i] = $i == $#toks ? '.*' : '.*?';
+                    } elsif( $toks[$i] =~ '%.(\d+)s' ){
+                        $toks[$i] = ".{$1}";
+                     } elsif( $toks[$i] =~ '^%l*x$' ){
+                        $toks[$i] = '[\da-f]+';
+                   }
+                } elsif( length( $toks[$i] ) ){
+                    $toks[$i] =~ s/^.*$/\Q$&\E/;
+                    $conlen += length( $toks[$i] );
+                }
+            }  
+            my $lhs = join( '', @toks );
+	    $transfmt{$header}{pat} =
+              "    s{^$lhs}\n     {\Q$header\E}s\n\t&& return 1;\n";
+            $transfmt{$header}{len} = $conlen;
 	} else {
-	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+            $transfmt{$header}{pat} =
+	      "    m{^\Q$header\E} && return 1;\n";
+            $transfmt{$header}{len} = length( $header );
 	} 
 
 	print STDERR "$WHOAMI: Duplicate entry: \"$header\"\n"
@@ -390,6 +404,12 @@ my %msg;
 
     die "No diagnostics?" unless %msg;
 
+    # Apply patterns in order of decreasing sum of lengths of fixed parts
+    # Seems the best way of hitting the right one.
+    for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} }
+                  keys %transfmt ){
+        $transmo .= $transfmt{$hdr}{pat};
+    }
     $transmo .= "    return 0;\n}\n";
     print STDERR $transmo if $DEBUG;
     eval $transmo;
@@ -505,15 +525,33 @@ sub splainthis {
     s/\.?\n+$//;
     my $orig = $_;
     # return unless defined;
+
+    # get rid of the where-are-we-in-input part
     s/, <.*?> (?:line|chunk).*$//;
-    my $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+
+    # Discard 1st " at <file> line <no>" and all text beyond
+    # but be aware of messsages containing " at this-or-that"
+    my $real = 0;
+    my @secs = split( / at / );
+    $_ = $secs[0];
+    for my $i ( 1..$#secs ){
+        if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){
+            $real = 1;
+            last;
+        } else {
+            $_ .= ' at ' . $secs[$i];
+	}
+    }
+    
+    # remove parenthesis occurring at the end of some messages 
     s/^\((.*)\)$/$1/;
+
     if ($exact_duplicate{$orig}++) {
 	return &transmo;
-    }
-    else {
+    } else {
 	return 0 unless &transmo;
     }
+
     $orig = shorten($orig);
     if ($old_diag{$_}) {
 	autodescribe();
diff --git a/gnu/usr.bin/perl/lib/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
index 12c9e91f0ad..474818a6571 100644
--- a/gnu/usr.bin/perl/lib/dumpvar.pl
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -30,7 +30,8 @@ sub main::dumpValue {
   local $^W=0;
   (print "undef\n"), return unless defined $_[0];
   (print &stringify($_[0]), "\n"), return unless ref $_[0];
-  dumpvar::unwrap($_[0],0, $_[1]);
+  push @_, -1 if @_ == 1;
+  dumpvar::unwrap($_[0], 0, $_[1]);
 }
 
 # This one is good for variable names:
@@ -115,7 +116,7 @@ sub DumpElem {
 	    join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
   } else {
     print "$short\n";
-    unwrap($_[0],$_[1],$_[2]);
+    unwrap($_[0],$_[1],$_[2]) if ref $_[0];
   }
 }
 
@@ -136,7 +137,19 @@ sub unwrap {
       my $val = $v;
       $val = &{'overload::StrVal'}($v) 
 	if %overload:: and defined &{'overload::StrVal'};
-      ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; 
+      # Match type and address.                      
+      # Unblessed references will look like TYPE(0x...)
+      # Blessed references will look like Class=TYPE(0x...)
+      ($start_part, $val) = split /=/,$val;
+      $val = $start_part unless defined $val;
+      ($item_type, $address) = 
+        $val =~ /([^\(]+)        # Keep stuff that's     
+                                 # not an open paren
+                 \(              # Skip open paren
+                 (0x[0-9a-f]+)   # Save the address
+                 \)              # Skip close paren
+                 $/x;            # Should be at end now
+
       if (!$dumpReused && defined $address) { 
 	$address{$address}++ ;
 	if ( $address{$address} > 1 ) { 
@@ -145,6 +158,7 @@ sub unwrap {
 	} 
       }
     } elsif (ref \$v eq 'GLOB') {
+      # This is a raw glob. Special handling for that.
       $address = "$v" . "";	# To avoid a bug with globs
       $address{$address}++ ;
       if ( $address{$address} > 1 ) { 
@@ -154,14 +168,16 @@ sub unwrap {
     }
 
     if (ref $v eq 'Regexp') {
+      # Reformat the regexp to look the standard way.
       my $re = "$v";
       $re =~ s,/,\\/,g;
       print "$sp-> qr/$re/\n";
       return;
     }
 
-    if ( UNIVERSAL::isa($v, 'HASH') ) { 
-	@sortKeys = sort keys(%$v) ;
+    if ( $item_type eq 'HASH' ) { 
+        # Hash ref or hash-based object.
+	my @sortKeys = sort keys(%$v) ;
 	undef $more ; 
 	$tHashDepth = $#sortKeys ; 
 	$tHashDepth = $#sortKeys < $hashDepth-1 ? $#sortKeys : $hashDepth-1
@@ -193,14 +209,19 @@ sub unwrap {
 	}
 	print "$sp  empty hash\n" unless @sortKeys;
 	print "$sp$more" if defined $more ;
-    } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) { 
+    } elsif ( $item_type eq 'ARRAY' ) { 
+        # Array ref or array-based object. Also: undef.
+        # See how big the array is.
 	$tArrayDepth = $#{$v} ; 
 	undef $more ; 
+        # Bigger than the max?
 	$tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 
 	  if defined $arrayDepth && $arrayDepth ne '';
+        # Yep. Don't show it all.
 	$more = "....\n" if $tArrayDepth < $#{$v} ; 
 	$shortmore = "";
 	$shortmore = " ..." if $tArrayDepth < $#{$v} ;
+
 	if ($compactDump && !grep(ref $_, @{$v})) {
 	  if ($#$v >= 0) {
 	    $short = $sp . "0..$#{$v}  " . 
@@ -220,20 +241,35 @@ sub unwrap {
 	    return if $DB::signal;
 	    print "$sp$num  ";
 	    if (exists $v->[$num]) {
-	        DumpElem $v->[$num], $s, $m-1;
+                if (defined $v->[$num]) {
+	          DumpElem $v->[$num], $s, $m-1;
+                } 
+                else {
+                  print "undef\n";
+                }
 	    } else {
 	    	print "empty slot\n";
 	    }
 	}
 	print "$sp  empty array\n" unless @$v;
 	print "$sp$more" if defined $more ;  
-    } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { 
+    } elsif ( $item_type eq 'SCALAR' ) { 
+            unless (defined $$v) {
+              print "$sp-> undef\n";
+              return;
+            }
 	    print "$sp-> ";
 	    DumpElem $$v, $s, $m-1;
-    } elsif ( UNIVERSAL::isa($v, 'CODE') ) { 
+    } elsif ( $item_type eq 'REF' ) { 
+	    print "$sp-> $$v\n";
+            return unless defined $$v;
+	    unwrap($$v, $s+3, $m-1);
+    } elsif ( $item_type eq 'CODE' ) { 
+            # Code object or reference.
 	    print "$sp-> ";
 	    dumpsub (0, $v);
-    } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
+    } elsif ( $item_type eq 'GLOB' ) {
+      # Glob object or reference.
       print "$sp-> ",&stringify($$v,1),"\n";
       if ($globPrint) {
 	$s += 3;
@@ -242,6 +278,7 @@ sub unwrap {
 	print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
       }
     } elsif (ref \$v eq 'GLOB') {
+      # Raw glob (again?)
       if ($globPrint) {
        dumpglob($s, "{$v}", $v, 1, $m-1) if $globPrint;
       } elsif (defined ($fileno = fileno(\$v))) {
diff --git a/gnu/usr.bin/perl/lib/fields.t b/gnu/usr.bin/perl/lib/fields.t
deleted file mode 100644
index ce57f86859c..00000000000
--- a/gnu/usr.bin/perl/lib/fields.t
+++ /dev/null
@@ -1,238 +0,0 @@
-#!./perl -w
-
-my $w;
-
-BEGIN {
-   chdir 't' if -d 't';
-   @INC = '../lib';
-   $SIG{__WARN__} = sub {
-       if ($_[0] =~ /^Hides field 'b1' in base class/) {
-           $w++;
-           return;
-       }
-       print $_[0];
-   };
-}
-
-use strict;
-use warnings;
-use vars qw($DEBUG);
-
-package B1;
-use fields qw(b1 b2 b3);
-
-package B2;
-use fields '_b1';
-use fields qw(b1 _b2 b2);
-
-sub new { bless [], shift }
-
-package D1;
-use base 'B1';
-use fields qw(d1 d2 d3);
-
-package D2;
-use base 'B1';
-use fields qw(_d1 _d2);
-use fields qw(d1 d2);
-
-package D3;
-use base 'B2';
-use fields qw(b1 d1 _b1 _d1);  # hide b1
-
-package D4;
-use base 'D3';
-use fields qw(_d3 d3);
-
-package M;
-sub m {}
-
-package D5;
-use base qw(M B2);
-
-package Foo::Bar;
-use base 'B1';
-
-package Foo::Bar::Baz;
-use base 'Foo::Bar';
-use fields qw(foo bar baz);
-
-# Test repeatability for when modules get reloaded.
-package B1;
-use fields qw(b1 b2 b3);
-
-package D3;
-use base 'B2';
-use fields qw(b1 d1 _b1 _d1);  # hide b1
-
-package main;
-
-sub fstr {
-   my $h = shift;
-   my @tmp;
-   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
-	my $v = $h->{$k};
-        push(@tmp, "$k:$v");
-   }
-   my $str = join(",", @tmp);
-   print "$h => $str\n" if $DEBUG;
-   $str;
-}
-
-my %expect = (
-    B1 => "b1:1,b2:2,b3:3",
-    B2 => "_b1:1,b1:2,_b2:3,b2:4",
-    D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
-    D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
-    D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
-    D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
-    D5 => "b1:2,b2:4",
-    'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
-);
-
-print "1..", int(keys %expect)+21, "\n";
-my $testno = 0;
-while (my($class, $exp) = each %expect) {
-   no strict 'refs';
-   my $fstr = fstr(\%{$class."::FIELDS"});
-   print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp;
-   print "ok ", ++$testno, "\n";
-}
-
-# Did we get the appropriate amount of warnings?
-print "not " unless $w == 1;
-print "ok ", ++$testno, "\n";
-
-# A simple object creation and AVHV attribute access test
-my B2 $obj1 = D3->new;
-$obj1->{b1} = "B2";
-my D3 $obj2 = $obj1;
-$obj2->{b1} = "D3";
-
-print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3";
-print "ok ", ++$testno, "\n";
-
-# We should get compile time failures field name typos
-eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
-print "ok ", ++$testno, "\n";
-
-# Slices
-@$obj1{"_b1", "b1"} = (17, 29);
-print "not " unless "@$obj1[1,2]" eq "17 29";
-print "ok ", ++$testno, "\n";
-@$obj1[1,2] = (44,28);
-print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
-print "ok ", ++$testno, "\n";
-
-my $ph = fields::phash(a => 1, b => 2, c => 3);
-print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
-print "ok ", ++$testno, "\n";
-
-$ph = fields::phash([qw/a b c/], [1, 2, 3]);
-print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
-print "ok ", ++$testno, "\n";
-
-$ph = fields::phash([qw/a b c/], [1]);
-print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
-print "ok ", ++$testno, "\n";
-
-eval '$ph = fields::phash("odd")';
-print "not " unless $@ && $@ =~ /^Odd number of/;
-print "ok ", ++$testno, "\n";
-
-#fields::_dump();
-
-# check if fields autovivify
-{
-    package Foo;
-    use fields qw(foo bar);
-    sub new { bless [], $_[0]; }
-
-    package main;
-    my Foo $a = Foo->new();
-    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
-    $a->{bar} = { A => 'ok ' . ++$testno };
-    print $a->{foo}[1], "\n";
-    print $a->{bar}->{A}, "\n";
-}
-
-# check if fields autovivify
-{
-    package Bar;
-    use fields qw(foo bar);
-    sub new { return fields::new($_[0]) }
-
-    package main;
-    my Bar $a = Bar::->new();
-    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
-    $a->{bar} = { A => 'ok ' . ++$testno };
-    print $a->{foo}[1], "\n";
-    print $a->{bar}->{A}, "\n";
-}
-
-
-# Test $VERSION bug
-package No::Version;
-
-use vars qw($Foo);
-sub VERSION { 42 }
-
-package Test::Version;
-
-use base qw(No::Version);
-print "# $No::Version::VERSION\nnot " unless $No::Version::VERSION =~ /set by base\.pm/;
-print "ok ", ++$testno ,"\n";
-
-# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
-package Has::Version;
-
-BEGIN { $Has::Version::VERSION = '42' };
-
-package Test::Version2;
-
-use base qw(Has::Version);
-print "#$Has::Version::VERSION\nnot " unless $Has::Version::VERSION eq '42';
-print "ok ", ++$testno ," # Has::Version\n";
-
-package main;
-
-our $eval1 = q{
-  {
-    package Eval1;
-    {
-      package Eval2;
-      use base 'Eval1';
-      $Eval2::VERSION = "1.02";
-    }
-    $Eval1::VERSION = "1.01";
-  }
-};
-
-eval $eval1;
-printf "# %s\nnot ", $@ if $@;
-print "ok ", ++$testno ," # eval1\n";
-
-print "# $Eval1::VERSION\nnot " unless $Eval1::VERSION == 1.01;
-print "ok ", ++$testno ," # Eval1::VERSION\n";
-
-print "# $Eval2::VERSION\nnot " unless $Eval2::VERSION == 1.02;
-print "ok ", ++$testno ," # Eval2::VERSION\n";
-
-
-eval q{use base reallyReAlLyNotexists;};
-print "not " unless $@;
-print "ok ", ++$testno, " # really not I\n";
-
-eval q{use base reallyReAlLyNotexists;};
-print "not " unless $@;
-print "ok ", ++$testno, " # really not II\n";
-
-BEGIN { $Has::Version_0::VERSION = 0 }
-
-package Test::Version3;
-
-use base qw(Has::Version_0);
-print "#$Has::Version_0::VERSION\nnot " unless $Has::Version_0::VERSION == 0;
-print "ok ", ++$testno ," # Version_0\n";
-
diff --git a/gnu/usr.bin/perl/lib/ftp.pl b/gnu/usr.bin/perl/lib/ftp.pl
deleted file mode 100644
index 910dad49dd3..00000000000
--- a/gnu/usr.bin/perl/lib/ftp.pl
+++ /dev/null
@@ -1,1092 +0,0 @@
-#-*-perl-*-
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Net::FTP
-#
-# This is a wrapper to the chat2.pl routines that make life easier
-# to do ftp type work.
-# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
-# based on original version by Alan R. Martello <al@ee.pitt.edu>
-# And by A.Macpherson@bnr.co.uk for multi-homed hosts
-#
-# $Header: /cvs/OpenBSD/src/gnu/usr.bin/perl/lib/Attic/ftp.pl,v 1.7 2002/12/09 00:45:36 millert Exp $
-# $Log: ftp.pl,v $
-# Revision 1.7  2002/12/09 00:45:36  millert
-# From Andrushock, s/sucess/success/g
-#
-# Revision 1.6  2002/10/27 22:25:26  millert
-# Resolve conflicts, remove old files, merge local changes
-#
-# Revision 1.17  1993/04/21  10:06:54  lmjm
-# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
-# Allow target file to be '-' meaning STDOUT
-# Added ftp'quote
-#
-# Revision 1.16  1993/01/28  18:59:05  lmjm
-# Allow socket arguemtns to come from main.
-# Minor cleanups - removed old comments.
-#
-# Revision 1.15  1992/11/25  21:09:30  lmjm
-# Added another REST return code.
-#
-# Revision 1.14  1992/08/12  14:33:42  lmjm
-# Fail ftp'write if out of space.
-#
-# Revision 1.13  1992/03/20  21:01:03  lmjm
-# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
-# Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
-#
-# Revision 1.12  1992/02/06  23:25:56  lmjm
-# Moved code around so can use this as a lib for both mirror and ftpmail.
-# Time out opens.  In case Unix doesn't bother to.
-#
-# Revision 1.11  1991/11/27  22:05:57  lmjm
-# Match the response code number at the start of a line allowing
-# for any leading junk.
-#
-# Revision 1.10  1991/10/23  22:42:20  lmjm
-# Added better timeout code.
-# Tried to optimise file transfer
-# Moved open/close code to not leak file handles.
-# Cleaned up the alarm code.
-# Added $fatalerror to show wether the ftp link is really dead.
-#
-# Revision 1.9  1991/10/07  18:30:35  lmjm
-# Made the timeout-read code work.
-# Added restarting file gets.
-# Be more verbose if ever have to call die.
-#
-# Revision 1.8  1991/09/17  22:53:16  lmjm
-# Spot when open_data_socket fails and return a failure rather than dying.
-#
-# Revision 1.7  1991/09/12  22:40:25  lmjm
-# Added Andrew Macpherson's patches for hosts without ip forwarding.
-#
-# Revision 1.6  1991/09/06  19:53:52  lmjm
-# Relaid out the code the way I like it!
-# Changed the debuggin to produce more "appropriate" messages
-# Fixed bugs in the ordering of put and dir listing.
-# Allow for hash printing when getting files (a la ftp).
-# Added the new commands from Al.
-# Don't print passwords in debugging.
-#
-# Revision 1.5  1991/08/29  16:23:49  lmjm
-# Timeout reads from the remote ftp server.
-# No longer call die expect on fatal errors.  Just return fail codes.
-# Changed returns so higher up routines can tell whats happening.
-# Get expect/accept in correct order for dir listing.
-# When ftp_show is set then print hashes every 1k transferred (like ftp).
-# Allow for stripping returns out of incoming data.
-# Save last error in a global string.
-#
-# Revision 1.4  1991/08/14  21:04:58  lmjm
-# ftp'get now copes with ungetable files.
-# ftp'expect code changed such that the string_to_print is
-# ignored and the string sent back from the remote system is printed
-# instead.
-# Implemented patches from al.  Removed spuiours tracing statements.
-#
-# Revision 1.3  1991/08/09  21:32:18  lmjm
-# Allow for another ok code on cwd's
-# Rejigger the log levels
-# Send \r\n for some odd ftp daemons
-#
-# Revision 1.2  1991/08/09  18:07:37  lmjm
-# Don't print messages unless ftp_show says to.
-#
-# Revision 1.1  1991/08/08  20:31:00  lmjm
-# Initial revision
-#
-
-require 'chat2.pl';	# into main
-eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
-	|| die "socket.ph missing: $!\n";
-
-
-package ftp;
-
-if( defined( &main'PF_INET ) ){
-	$pf_inet = &main'PF_INET;
-	$sock_stream = &main'SOCK_STREAM;
-	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
-	$tcp_proto = $proto;
-}
-else {
-	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
-	# but who the heck would change these anyway? (:-)
-	$pf_inet = 2;
-	$sock_stream = 1;
-	$tcp_proto = 6;
-}
-
-# If the remote ftp daemon doesn't respond within this time presume its dead
-# or something.
-$timeout = 30;
-
-# Timeout a read if I don't get data back within this many seconds
-$timeout_read = 20 * $timeout;
-
-# Timeout an open
-$timeout_open = $timeout;
-
-# This is a "global" it contains the last response from the remote ftp server
-# for use in error messages
-$ftp'response = "";
-# Also ftp'NS is the socket containing the data coming in from the remote ls
-# command.
-
-# The size of block to be read or written when talking to the remote
-# ftp server
-$ftp'ftpbufsize = 4096;
-
-# How often to print a hash out, when debugging
-$ftp'hashevery = 1024;
-# Output a newline after this many hashes to prevent outputing very long lines
-$ftp'hashnl = 70;
-
-# If a proxy connection then who am I really talking to?
-$real_site = "";
-
-# This is just a tracing aid.
-$ftp_show = 0;
-sub ftp'debug
-{
-	$ftp_show = $_[0];
-#	if( $ftp_show ){
-#		print STDERR "ftp debugging on\n";
-#	}
-}
-
-sub ftp'set_timeout
-{
-	$timeout = $_[0];
-	$timeout_open = $timeout;
-	$timeout_read = 20 * $timeout;
-	if( $ftp_show ){
-		print STDERR "ftp timeout set to $timeout\n";
-	}
-}
-
-
-sub ftp'open_alarm
-{
-	die "timeout: open";
-}
-
-sub ftp'timed_open
-{
-	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
-	local( $connect_site, $connect_port );
-	local( $res );
-
-	alarm( $timeout_open );
-
-	while( $attempts-- ){
-		if( $ftp_show ){
-			print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
-			print STDERR "Connecting to $site";
-			if( $ftp_port != 21 ){
-				print STDERR " [port $ftp_port]";
-			}
-			print STDERR "\n";
-		}
-		
-		if( $proxy ) {
-			if( ! $proxy_gateway ) {
-				# if not otherwise set
-				$proxy_gateway = "internet-gateway";
-			}
-			if( $debug ) {
-				print STDERR "using proxy services of $proxy_gateway, ";
-				print STDERR "at $proxy_ftp_port\n";
-			}
-			$connect_site = $proxy_gateway;
-			$connect_port = $proxy_ftp_port;
-			$real_site = $site;
-		}
-		else {
-			$connect_site = $site;
-			$connect_port = $ftp_port;
-		}
-		if( ! &chat'open_port( $connect_site, $connect_port ) ){
-			if( $retry_call ){
-				print STDERR "Failed to connect\n" if $ftp_show;
-				next;
-			}
-			else {
-				print STDERR "proxy connection failed " if $proxy;
-				print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
-				return 0;
-			}
-		}
-		$res = &ftp'expect( $timeout,
-				    120, "service unavailable to $site", 0, 
-	                            220, "ready for login to $site", 1,
-				    421, "service unavailable to $site, closing connection", 0);
-		if( ! $res ){
-			&chat'close();
-			next;
-		}
-		return 1;
-	}
-	continue {
-		print STDERR "Pausing between retries\n";
-		sleep( $retry_pause );
-	}
-	return 0;
-}
-
-sub ftp'open
-{
-	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
-
-	$SIG{ 'ALRM' } = "ftp\'open_alarm";
-
-	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
-	alarm( 0 );
-
-	if( $@ =~ /^timeout/ ){
-		return -1;
-	}
-	return $ret;
-}
-
-sub ftp'login
-{
-	local( $remote_user, $remote_password ) = @_;
-
-	if( $proxy ){
-		&ftp'send( "USER $remote_user\@$site" );
-	}
-	else {
-		&ftp'send( "USER $remote_user" );
-	}
-        local( $val ) =
-               &ftp'expect($timeout,
-	           230, "$remote_user logged in", 1,
-		   331, "send password for $remote_user", 2,
-
-		   500, "syntax error", 0,
-		   501, "syntax error", 0,
-		   530, "not logged in", 0,
-		   332, "account for login not supported", 0,
-
-		   421, "service unavailable, closing connection", 0);
-	if( $val == 1 ){
-		return 1;
-	}
-	if( $val == 2 ){
-		# A password is needed
-		&ftp'send( "PASS $remote_password" );
-
-		$val = &ftp'expect( $timeout,
-		   230, "$remote_user logged in", 1,
-
-		   202, "command not implemented", 0,
-		   332, "account for login not supported", 0,
-
-		   530, "not logged in", 0,
-		   500, "syntax error", 0,
-		   501, "syntax error", 0,
-		   503, "bad sequence of commands", 0, 
-
-		   421, "service unavailable, closing connection", 0);
-		if( $val == 1){
-			# Logged in
-			return 1;
-		}
-	}
-	# If I got here I failed to login
-	return 0;
-}
-
-sub ftp'close
-{
-	&ftp'quit();
-	&chat'close();
-}
-
-# Change directory
-# return 1 if successful
-# 0 on a failure
-sub ftp'cwd
-{
-	local( $dir ) = @_;
-
-	&ftp'send( "CWD $dir" );
-
-	return &ftp'expect( $timeout,
-		200, "working directory = $dir", 1,
-		250, "working directory = $dir", 1,
-
-		500, "syntax error", 0,
-		501, "syntax error", 0,
-                502, "command not implemented", 0,
-		530, "not logged in", 0,
-                550, "cannot change directory", 0,
-		421, "service unavailable, closing connection", 0 );
-}
-
-# Get a full directory listing:
-# &ftp'dir( remote LIST options )
-# Start a list going with the given options.
-# Presuming that the remote deamon uses the ls command to generate the
-# data to send back then you can send it some extra options (eg: -lRa)
-# return 1 if successful and 0 on a failure
-sub ftp'dir_open
-{
-	local( $options ) = @_;
-	local( $ret );
-	
-	if( ! &ftp'open_data_socket() ){
-		return 0;
-	}
-	
-	if( $options ){
-		&ftp'send( "LIST $options" );
-	}
-	else {
-		&ftp'send( "LIST" );
-	}
-	
-	$ret = &ftp'expect( $timeout,
-		150, "reading directory", 1,
-	
-		125, "data connection already open?", 0,
-	
-		450, "file unavailable", 0,
-		500, "syntax error", 0,
-		501, "syntax error", 0,
-		502, "command not implemented", 0,
-		530, "not logged in", 0,
-	
-		   421, "service unavailable, closing connection", 0 );
-	if( ! $ret ){
-		&ftp'close_data_socket;
-		return 0;
-	}
-	
-	# 
-	# the data should be coming at us now
-	#
-	
-	# now accept
-	accept(NS,S) || die "accept failed $!";
-	
-	return 1;
-}
-
-
-# Close down reading the result of a remote ls command
-# return 1 if successful and 0 on failure
-sub ftp'dir_close
-{
-	local( $ret );
-
-	# read the close
-	#
-	$ret = &ftp'expect($timeout,
-        	226, "", 1,     # transfer complete, closing connection
-        	250, "", 1,     # action completed
-
-	        425, "can't open data connection", 0,
-        	426, "connection closed, transfer aborted", 0,
-	        451, "action aborted, local error", 0,
-	        421, "service unavailable, closing connection", 0);
-
-	# shut down our end of the socket
-	&ftp'close_data_socket;
-
-	if( ! $ret ){
-		return 0;
-	}
-
-	return 1;
-}
-
-# Quit from the remote ftp server
-# return 1 if successful and 0 on failure
-sub ftp'quit
-{
-	$site_command_check = 0;
-	@site_command_list = ();
-
-	&ftp'send("QUIT");
-
-	return &ftp'expect($timeout, 
-		221, "Goodbye", 1,     # transfer complete, closing connection
-	
-		500, "error quitting??", 0);
-}
-
-sub ftp'read_alarm
-{
-	die "timeout: read";
-}
-
-sub ftp'timed_read
-{
-	alarm( $timeout_read );
-	return sysread( NS, $buf, $ftpbufsize );
-}
-
-sub ftp'read
-{
-	$SIG{ 'ALRM' } = "ftp\'read_alarm";
-
-	local( $ret ) = eval '&timed_read()';
-	alarm( 0 );
-
-	if( $@ =~ /^timeout/ ){
-		return -1;
-	}
-	return $ret;
-}
-
-# Get a remote file back into a local file.
-# If no loc_fname passed then uses rem_fname.
-# returns 1 on success and 0 on failure
-sub ftp'get
-{
-	local($rem_fname, $loc_fname, $restart ) = @_;
-	
-	if ($loc_fname eq "") {
-		$loc_fname = $rem_fname;
-	}
-	
-	if( ! &ftp'open_data_socket() ){
-		print STDERR "Cannot open data socket\n";
-		return 0;
-	}
-
-	if( $loc_fname ne '-' ){
-		# Find the size of the target file
-		local( $restart_at ) = &ftp'filesize( $loc_fname );
-		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
-			$restart = 1;
-			# Make sure the file can be updated
-			chmod( 0644, $loc_fname );
-		}
-		else {
-			$restart = 0;
-			unlink( $loc_fname );
-		}
-	}
-
-	&ftp'send( "RETR $rem_fname" );
-	
-	local( $ret ) =
-		&ftp'expect($timeout, 
-                   150, "receiving $rem_fname", 1,
-
-                   125, "data connection already open?", 0,
-
-                   450, "file unavailable", 2,
-                   550, "file unavailable", 2,
-
-		   500, "syntax error", 0,
-		   501, "syntax error", 0,
-		   530, "not logged in", 0,
-
-		   421, "service unavailable, closing connection", 0);
-	if( $ret != 1 ){
-		print STDERR "Failure on RETR command\n";
-
-		# shut down our end of the socket
-		&ftp'close_data_socket;
-
-		return 0;
-	}
-
-	# 
-	# the data should be coming at us now
-	#
-
-	# now accept
-	accept(NS,S) || die "accept failed: $!";
-
-	#
-	#  open the local fname
-	#  concatenate on the end if restarting, else just overwrite
-	if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
-		print STDERR "Cannot create local file $loc_fname\n";
-
-		# shut down our end of the socket
-		&ftp'close_data_socket;
-
-		return 0;
-	}
-
-#    while (<NS>) {
-#        print FH ;
-#    }
-
-	local( $start_time ) = time;
-	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
-	while( ($len = &ftp'read()) > 0 ){
-		$bytes += $len;
-		if( $strip_cr ){
-			$ftp'buf =~ s/\r//g;
-		}
-		if( $ftp_show ){
-			while( $bytes > ($lasthash + $ftp'hashevery) ){
-				print STDERR '#';
-				$lasthash += $ftp'hashevery;
-				$hashes++;
-				if( ($hashes % $ftp'hashnl) == 0 ){
-					print STDERR "\n";
-				}
-			}
-		}
-		if( ! print FH $ftp'buf ){
-			print STDERR "\nfailed to write data";
-			return 0;
-		}
-	}
-	close( FH );
-
-	# shut down our end of the socket
-	&ftp'close_data_socket;
-
-	if( $len < 0 ){
-		print STDERR "\ntimed out reading data!\n";
-
-		return 0;
-	}
-		
-	if( $ftp_show ){
-		if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
-			print STDERR "\n";
-		}
-		local( $secs ) = (time - $start_time);
-		if( $secs <= 0 ){
-			$secs = 1; # To avoid a divide by zero;
-		}
-
-		local( $rate ) = int( $bytes / $secs );
-		print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
-	}
-
-	#
-	# read the close
-	#
-
-	$ret = &ftp'expect($timeout, 
-		226, "Got file", 1,     # transfer complete, closing connection
-	        250, "Got file", 1,     # action completed
-	
-	        110, "restart not supported", 0,
-	        425, "can't open data connection", 0,
-	        426, "connection closed, transfer aborted", 0,
-	        451, "action aborted, local error", 0,
-		421, "service unavailable, closing connection", 0);
-
-	return $ret;
-}
-
-sub ftp'delete
-{
-	local( $rem_fname, $val ) = @_;
-
-	&ftp'send("DELE $rem_fname" );
-	$val = &ftp'expect( $timeout, 
-			   250,"Deleted $rem_fname", 1,
-			   550,"Permission denied",0
-			   );
-	return $val == 1;
-}
-
-sub ftp'deldir
-{
-    local( $fname ) = @_;
-
-    # not yet implemented
-    # RMD
-}
-
-# UPDATE ME!!!!!!
-# Add in the hash printing and newline conversion
-sub ftp'put
-{
-	local( $loc_fname, $rem_fname ) = @_;
-	local( $strip_cr );
-	
-	if ($loc_fname eq "") {
-		$loc_fname = $rem_fname;
-	}
-	
-	if( ! &ftp'open_data_socket() ){
-		return 0;
-	}
-	
-	&ftp'send("STOR $rem_fname");
-	
-	# 
-	# the data should be coming at us now
-	#
-	
-	local( $ret ) =
-	&ftp'expect($timeout, 
-		150, "sending $loc_fname", 1,
-
-		125, "data connection already open?", 0,
-		450, "file unavailable", 0,
-
-		532, "need account for storing files", 0,
-		452, "insufficient storage on system", 0,
-		553, "file name not allowed", 0,
-
-		500, "syntax error", 0,
-		501, "syntax error", 0,
-		530, "not logged in", 0,
-
-		421, "service unavailable, closing connection", 0);
-
-	if( $ret != 1 ){
-		# shut down our end of the socket
-		&ftp'close_data_socket;
-
-		return 0;
-	}
-
-
-	# 
-	# the data should be coming at us now
-	#
-	
-	# now accept
-	accept(NS,S) || die "accept failed: $!";
-	
-	#
-	#  open the local fname
-	#
-	if( !open(FH, "<$loc_fname") ){
-		print STDERR "Cannot open local file $loc_fname\n";
-
-		# shut down our end of the socket
-		&ftp'close_data_socket;
-
-		return 0;
-	}
-	
-	while (<FH>) {
-		print NS ;
-	}
-	close(FH);
-	
-	# shut down our end of the socket to signal EOF
-	&ftp'close_data_socket;
-	
-	#
-	# read the close
-	#
-	
-	$ret = &ftp'expect($timeout, 
-		226, "file put", 1,     # transfer complete, closing connection
-		250, "file put", 1,     # action completed
-	
-		110, "restart not supported", 0,
-		425, "can't open data connection", 0,
-		426, "connection closed, transfer aborted", 0,
-		451, "action aborted, local error", 0,
-		551, "page type unknown", 0,
-		552, "storage allocation exceeded", 0,
-	
-		421, "service unavailable, closing connection", 0);
-	if( ! $ret ){
-		print STDERR "error putting $loc_fname\n";
-	}
-	return $ret;
-}
-
-sub ftp'restart
-{
-	local( $restart_point, $ret ) = @_;
-
-	&ftp'send("REST $restart_point");
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect($timeout, 
-			   350, "restarting at $restart_point", 1,
-			   
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   502, "REST not implemented", 2,
-			   530, "not logged in", 0,
-			   554, "REST not implemented", 2,
-			   
-			   421, "service unavailable, closing connection", 0);
-	return $ret;
-}
-
-# Set the file transfer type
-sub ftp'type
-{
-	local( $type ) = @_;
-
-	&ftp'send("TYPE $type");
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect($timeout, 
-			   200, "file type set to $type", 1,
-			   
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   504, "Invalid form or byte size for type $type", 0,
-			   
-			   421, "service unavailable, closing connection", 0);
-	return $ret;
-}
-
-$site_command_check = 0;
-@site_command_list = ();
-
-# routine to query the remote server for 'SITE' commands supported
-sub ftp'site_commands
-{
-	local( $ret );
-	
-	# if we havent sent a 'HELP SITE', send it now
-	if( !$site_command_check ){
-	
-		$site_command_check = 1;
-	
-		&ftp'send( "HELP SITE" );
-	
-		# assume the line in the HELP SITE response with the 'HELP'
-		# command is the one for us
-		$ret = &ftp'expect( $timeout,
-			".*HELP.*", "", "\$1",
-			214, "", "0",
-			202, "", "0" );
-	
-		if( $ret eq "0" ){
-			print STDERR "No response from HELP SITE\n" if( $ftp_show );
-		}
-	
-		@site_command_list = split(/\s+/, $ret);
-	}
-	
-	return @site_command_list;
-}
-
-# return the pwd, or null if we can't get the pwd
-sub ftp'pwd
-{
-	local( $ret, $cwd );
-
-	&ftp'send( "PWD" );
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect( $timeout, 
-			   257, "working dir is", 1,
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   502, "PWD not implemented", 0,
-	                   550, "file unavailable", 0,
-
-			   421, "service unavailable, closing connection", 0 );
-	if( $ret ){
-		if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
-			$cwd = $1;
-		}
-	}
-	return $cwd;
-}
-
-# return 1 for success, 0 for failure
-sub ftp'mkdir
-{
-	local( $path ) = @_;
-	local( $ret );
-
-	&ftp'send( "MKD $path" );
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect( $timeout, 
-			   257, "made directory $path", 1,
-			   
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   502, "MKD not implemented", 0,
-			   530, "not logged in", 0,
-	                   550, "file unavailable", 0,
-
-			   421, "service unavailable, closing connection", 0 );
-	return $ret;
-}
-
-# return 1 for success, 0 for failure
-sub ftp'chmod
-{
-	local( $path, $mode ) = @_;
-	local( $ret );
-
-	&ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect( $timeout, 
-			   200, "chmod $mode $path succeeded", 1,
-			   
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   502, "CHMOD not implemented", 0,
-			   530, "not logged in", 0,
-	                   550, "file unavailable", 0,
-
-			   421, "service unavailable, closing connection", 0 );
-	return $ret;
-}
-
-# rename a file
-sub ftp'rename
-{
-	local( $old_name, $new_name ) = @_;
-	local( $ret );
-
-	&ftp'send( "RNFR $old_name" );
-
-	# 
-	# see what they say
-
-	$ret = &ftp'expect( $timeout, 
-			   350, "", 1,
-			   
-			   500, "syntax error", 0,
-			   501, "syntax error", 0,
-			   502, "RNFR not implemented", 0,
-			   530, "not logged in", 0,
-	                   550, "file unavailable", 0,
-	                   450, "file unavailable", 0,
-			   
-			   421, "service unavailable, closing connection", 0);
-
-
-	# check if the "rename from" occurred ok
-	if( $ret ) {
-		&ftp'send( "RNTO $new_name" );
-	
-		# 
-		# see what they say
-	
-		$ret = &ftp'expect( $timeout, 
-			           250, "rename $old_name to $new_name", 1, 
-
-				   500, "syntax error", 0,
-				   501, "syntax error", 0,
-				   502, "RNTO not implemented", 0,
-				   503, "bad sequence of commands", 0,
-				   530, "not logged in", 0,
-		                   532, "need account for storing files", 0,
-		                   553, "file name not allowed", 0,
-				   
-				   421, "service unavailable, closing connection", 0);
-	}
-
-	return $ret;
-}
-
-
-sub ftp'quote
-{
-      local( $cmd ) = @_;
-
-      &ftp'send( $cmd );
-
-      return &ftp'expect( $timeout, 
-              200, "Remote '$cmd' OK", 1,
-              500, "error in remote '$cmd'", 0 );
-}
-
-# ------------------------------------------------------------------------------
-# These are the lower level support routines
-
-sub ftp'expectgot
-{
-	($ftp'response, $ftp'fatalerror) = @_;
-	if( $ftp_show ){
-		print STDERR "$ftp'response\n";
-	}
-}
-
-#
-#  create the list of parameters for chat'expect
-#
-#  ftp'expect(time_out, {value, string_to_print, return value});
-#     if the string_to_print is "" then nothing is printed
-#  the last response is stored in $ftp'response
-#
-# NOTE: lmjm has changed this code such that the string_to_print is
-# ignored and the string sent back from the remote system is printed
-# instead.
-#
-sub ftp'expect {
-	local( $ret );
-	local( $time_out );
-	local( $expect_args );
-	
-	$ftp'response = '';
-	$ftp'fatalerror = 0;
-
-	@expect_args = ();
-	
-	$time_out = shift(@_);
-	
-	while( @_ ){
-		local( $code ) = shift( @_ );
-		local( $pre ) = '^';
-		if( $code =~ /^\d/ ){
-			$pre =~ "[.|\n]*^";
-		}
-		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
-		shift( @_ );
-		push( @expect_args, 
-			"&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
-	}
-	
-	# Treat all unrecognised lines as continuations
-	push( @expect_args, "^(.*)\\015\\n" );
-	push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
-	
-	# add patterns TIMEOUT and EOF
-	
-	push( @expect_args, 'TIMEOUT' );
-	push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
-	
-	push( @expect_args, 'EOF' );
-	push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
-	
-	if( $ftp_show > 9 ){
-		&printargs( $time_out, @expect_args );
-	}
-	
-	$ret = &chat'expect( $time_out, @expect_args );
-	if( $ret == 100 ){
-		# we saw a continuation line, wait for the end
-		push( @expect_args, "^.*\n" );
-		push( @expect_args, "100" );
-	
-		while( $ret == 100 ){
-			$ret = &chat'expect( $time_out, @expect_args );
-		}
-	}
-	
-	return $ret;
-}
-
-#
-#  opens NS for io
-#
-sub ftp'open_data_socket
-{
-	local( $ret );
-	local( $hostname );
-	local( $sockaddr, $name, $aliases, $proto, $port );
-	local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
-	local( $mysockaddr, $family, $hi, $lo );
-	
-	
-	$sockaddr = 'S n a4 x8';
-	chop( $hostname = `hostname` );
-	
-	$port = "ftp";
-	
-	($name, $aliases, $proto) = getprotobyname( 'tcp' );
-	($name, $aliases, $port) = getservbyname( $port, 'tcp' );
-	
-#	($name, $aliases, $type, $len, $thisaddr) =
-#	gethostbyname( $hostname );
-	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
-	
-#	$this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
-	$this = $chat'thisproc;
-	
-	socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
-	bind(S, $this) || die "bind: $!";
-	
-	# get the port number
-	$mysockaddr = getsockname(S);
-	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
-	
-	$hi = ($port >> 8) & 0x00ff;
-	$lo = $port & 0x00ff;
-	
-	#
-	# we MUST do a listen before sending the port otherwise
-	# the PORT may fail
-	#
-	listen( S, 5 ) || die "listen";
-	
-	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
-	
-	return &ftp'expect($timeout,
-		200, "PORT command successful", 1,
-		250, "PORT command successful", 1 ,
-
-		500, "syntax error", 0,
-		501, "syntax error", 0,
-		530, "not logged in", 0,
-
-		421, "service unavailable, closing connection", 0);
-}
-	
-sub ftp'close_data_socket
-{
-	close(NS);
-}
-
-sub ftp'send
-{
-	local($send_cmd) = @_;
-	if( $send_cmd =~ /\n/ ){
-		print STDERR "ERROR, \\n in send string for $send_cmd\n";
-	}
-	
-	if( $ftp_show ){
-		local( $sc ) = $send_cmd;
-
-		if( $send_cmd =~ /^PASS/){
-			$sc = "PASS <somestring>";
-		}
-		print STDERR "---> $sc\n";
-	}
-	
-	&chat'print( "$send_cmd\r\n" );
-}
-
-sub ftp'printargs
-{
-	while( @_ ){
-		print STDERR shift( @_ ) . "\n";
-	}
-}
-
-sub ftp'filesize
-{
-	local( $fname ) = @_;
-
-	if( ! -f $fname ){
-		return -1;
-	}
-
-	return (stat( _ ))[ 7 ];
-	
-}
-
-# make this package return true
-1;
diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm
index fb1a0d1236e..6fc69d60672 100644
--- a/gnu/usr.bin/perl/lib/overload.pm
+++ b/gnu/usr.bin/perl/lib/overload.pm
@@ -1,8 +1,8 @@
 package overload;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
-$overload::hint_bits = 0x20000;
+$overload::hint_bits = 0x20000; # HINT_LOCALIZE_HH
 
 sub nil {}
 
@@ -84,10 +84,13 @@ sub Method {
 sub AddrRef {
   my $package = ref $_[0];
   return "$_[0]" unless $package;
-  bless $_[0], overload::Fake;	# Non-overloaded package
-  my $str = "$_[0]";
-  bless $_[0], $package;	# Back
-  $package . substr $str, index $str, '=';
+
+	require Scalar::Util;
+	my $class = Scalar::Util::blessed($_[0]);
+	my $class_prefix = defined($class) ? "$class=" : "";
+	my $type = Scalar::Util::reftype($_[0]);
+	my $addr = Scalar::Util::refaddr($_[0]);
+	return sprintf("$class_prefix$type(0x%x)", $addr);
 }
 
 sub StrVal {
@@ -108,11 +111,11 @@ sub mycan {				# Real can would leave stubs.
 }
 
 %constants = (
-	      'integer'	  =>  0x1000,
-	      'float'	  =>  0x2000,
-	      'binary'	  =>  0x4000,
-	      'q'	  =>  0x8000,
-	      'qr'	  => 0x10000,
+	      'integer'	  =>  0x1000, # HINT_NEW_INTEGER
+	      'float'	  =>  0x2000, # HINT_NEW_FLOAT
+	      'binary'	  =>  0x4000, # HINT_NEW_BINARY
+	      'q'	  =>  0x8000, # HINT_NEW_STRING
+	      'qr'	  => 0x10000, # HINT_NEW_RE
 	     );
 
 %ops = ( with_assign	  => "+ - * / % ** << >> x .",
diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl
index 997b836d93a..580a70dcf27 100644
--- a/gnu/usr.bin/perl/lib/perl5db.pl
+++ b/gnu/usr.bin/perl/lib/perl5db.pl
@@ -1,124 +1,685 @@
+=head1 NAME 
+
+C<perl5db.pl> - the perl debugger
+
+=head1 SYNOPSIS
+
+    perl -d  your_Perl_script
+
+=head1 DESCRIPTION
+
+C<perl5db.pl> is the perl debugger. It is loaded automatically by Perl when
+you invoke a script with C<perl -d>. This documentation tries to outline the
+structure and services provided by C<perl5db.pl>, and to describe how you
+can use them.
+
+=head1 GENERAL NOTES
+
+The debugger can look pretty forbidding to many Perl programmers. There are
+a number of reasons for this, many stemming out of the debugger's history.
+
+When the debugger was first written, Perl didn't have a lot of its nicer
+features - no references, no lexical variables, no closures, no object-oriented
+programming. So a lot of the things one would normally have done using such
+features was done using global variables, globs and the C<local()> operator 
+in creative ways.
+
+Some of these have survived into the current debugger; a few of the more
+interesting and still-useful idioms are noted in this section, along with notes
+on the comments themselves.
+
+=head2 Why not use more lexicals?
+
+Experienced Perl programmers will note that the debugger code tends to use
+mostly package globals rather than lexically-scoped variables. This is done
+to allow a significant amount of control of the debugger from outside the
+debugger itself.       
+
+Unfortunately, though the variables are accessible, they're not well
+documented, so it's generally been a decision that hasn't made a lot of
+difference to most users. Where appropriate, comments have been added to
+make variables more accessible and usable, with the understanding that these
+i<are> debugger internals, and are therefore subject to change. Future
+development should probably attempt to replace the globals with a well-defined
+API, but for now, the variables are what we've got.
+
+=head2 Automated variable stacking via C<local()>
+
+As you may recall from reading C<perlfunc>, the C<local()> operator makes a 
+temporary copy of a variable in the current scope. When the scope ends, the
+old copy is restored. This is often used in the debugger to handle the 
+automatic stacking of variables during recursive calls:
+
+     sub foo {
+        local $some_global++;
+
+        # Do some stuff, then ...
+        return;
+     }
+
+What happens is that on entry to the subroutine, C<$some_global> is localized,
+then altered. When the subroutine returns, Perl automatically undoes the 
+localization, restoring the previous value. Voila, automatic stack management.
+
+The debugger uses this trick a I<lot>. Of particular note is C<DB::eval>, 
+which lets the debugger get control inside of C<eval>'ed code. The debugger
+localizes a saved copy of C<$@> inside the subroutine, which allows it to
+keep C<$@> safe until it C<DB::eval> returns, at which point the previous
+value of C<$@> is restored. This makes it simple (well, I<simpler>) to keep 
+track of C<$@> inside C<eval>s which C<eval> other C<eval's>.
+
+In any case, watch for this pattern. It occurs fairly often.
+
+=head2 The C<^> trick
+
+This is used to cleverly reverse the sense of a logical test depending on 
+the value of an auxiliary variable. For instance, the debugger's C<S>
+(search for subroutines by pattern) allows you to negate the pattern 
+like this:
+
+   # Find all non-'foo' subs:
+   S !/foo/      
+
+Boolean algebra states that the truth table for XOR looks like this:
+
+=over 4
+
+=item * 0 ^ 0 = 0 
+
+(! not present and no match) --> false, don't print
+
+=item * 0 ^ 1 = 1 
+
+(! not present and matches) --> true, print
+
+=item * 1 ^ 0 = 1 
+
+(! present and no match) --> true, print
+
+=item * 1 ^ 1 = 0 
+
+(! present and matches) --> false, don't print
+
+=back
+
+As you can see, the first pair applies when C<!> isn't supplied, and
+the second pair applies when it isn't. The XOR simply allows us to
+compact a more complicated if-then-elseif-else into a more elegant 
+(but perhaps overly clever) single test. After all, it needed this
+explanation...
+
+=head2 FLAGS, FLAGS, FLAGS
+
+There is a certain C programming legacy in the debugger. Some variables,
+such as C<$single>, C<$trace>, and C<$frame>, have "magical" values composed
+of 1, 2, 4, etc. (powers of 2) OR'ed together. This allows several pieces
+of state to be stored independently in a single scalar. 
+
+A test like
+
+    if ($scalar & 4) ...
+
+is checking to see if the appropriate bit is on. Since each bit can be 
+"addressed" independently in this way, C<$scalar> is acting sort of like
+an array of bits. Obviously, since the contents of C<$scalar> are just a 
+bit-pattern, we can save and restore it easily (it will just look like
+a number).
+
+The problem, is of course, that this tends to leave magic numbers scattered
+all over your program whenever a bit is set, cleared, or checked. So why do 
+it?
+
+=over 4
+
+
+=item * First, doing an arithmetical or bitwise operation on a scalar is
+just about the fastest thing you can do in Perl: C<use constant> actually
+creates a subroutine call, and array hand hash lookups are much slower. Is
+this over-optimization at the expense of readability? Possibly, but the 
+debugger accesses these  variables a I<lot>. Any rewrite of the code will
+probably have to benchmark alternate implementations and see which is the
+best balance of readability and speed, and then document how it actually 
+works.
+
+=item * Second, it's very easy to serialize a scalar number. This is done in 
+the restart code; the debugger state variables are saved in C<%ENV> and then
+restored when the debugger is restarted. Having them be just numbers makes
+this trivial. 
+
+=item * Third, some of these variables are being shared with the Perl core 
+smack in the middle of the interpreter's execution loop. It's much faster for 
+a C program (like the interpreter) to check a bit in a scalar than to access 
+several different variables (or a Perl array).
+
+=back
+
+=head2 What are those C<XXX> comments for?
+
+Any comment containing C<XXX> means that the comment is either somewhat
+speculative - it's not exactly clear what a given variable or chunk of 
+code is doing, or that it is incomplete - the basics may be clear, but the
+subtleties are not completely documented.
+
+Send in a patch if you can clear up, fill out, or clarify an C<XXX>.
+
+=head1 DATA STRUCTURES MAINTAINED BY CORE         
+
+There are a number of special data structures provided to the debugger by
+the Perl interpreter.
+
+The array C<@{$main::{'_<'.$filename}}> (aliased locally to C<@dbline> via glob
+assignment) contains the text from C<$filename>, with each element
+corresponding to a single line of C<$filename>.
+
+The hash C<%{'_<'.$filename}> (aliased locally to C<%dbline> via glob 
+assignment) contains breakpoints and actions.  The keys are line numbers; 
+you can set individual values, but not the whole hash. The Perl interpreter 
+uses this hash to determine where breakpoints have been set. Any true value is
+considered to be a breakpoint; C<perl5db.pl> uses "$break_condition\0$action".
+Values are magical in numeric context: 1 if the line is breakable, 0 if not.
+
+The scalar ${'_<'.$filename} contains $filename  XXX What?
+
+=head1 DEBUGGER STARTUP
+
+When C<perl5db.pl> starts, it reads an rcfile (C<perl5db.ini> for
+non-interactive sessions, C<.perldb> for interactive ones) that can set a number
+of options. In addition, this file may define a subroutine C<&afterinit>
+that will be executed (in the debugger's context) after the debugger has 
+initialized itself.
+
+Next, it checks the C<PERLDB_OPTS> environment variable and treats its 
+contents as the argument of a debugger <C<O> command.
+
+=head2 STARTUP-ONLY OPTIONS
+
+The following options can only be specified at startup.
+To set them in your rcfile, add a call to
+C<&parse_options("optionName=new_value")>.
+
+=over 4
+
+=item * TTY 
+
+the TTY to use for debugging i/o.
+
+=item * noTTY 
+
+if set, goes in NonStop mode.  On interrupt, if TTY is not set,
+uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
+Term::Rendezvous.  Current variant is to have the name of TTY in this
+file.
+
+=item * ReadLine 
+
+If false, a dummy  ReadLine is used, so you can debug
+ReadLine applications.
+
+=item * NonStop 
+
+if true, no i/o is performed until interrupt.
+
+=item * LineInfo 
+
+file or pipe to print line number info to.  If it is a
+pipe, a short "emacs like" message is used.
+
+=item * RemotePort 
+
+host:port to connect to on remote host for remote debugging.
+
+=back
+
+=head3 SAMPLE RCFILE
+
+ &parse_options("NonStop=1 LineInfo=db.out");
+  sub afterinit { $trace = 1; }
+
+The script will run without human intervention, putting trace
+information into C<db.out>.  (If you interrupt it, you had better
+reset C<LineInfo> to something "interactive"!)
+
+=head1 INTERNALS DESCRIPTION
+
+=head2 DEBUGGER INTERFACE VARIABLES
+
+Perl supplies the values for C<%sub>.  It effectively inserts
+a C<&DB'DB();> in front of each place that can have a
+breakpoint. At each subroutine call, it calls C<&DB::sub> with
+C<$DB::sub> set to the called subroutine. It also inserts a C<BEGIN
+{require 'perl5db.pl'}> before the first line.
+
+After each C<require>d file is compiled, but before it is executed, a
+call to C<&DB::postponed($main::{'_<'.$filename})> is done. C<$filename>
+is the expanded name of the C<require>d file (as found via C<%INC>).
+
+=head3 IMPORTANT INTERNAL VARIABLES
+
+=head4 C<$CreateTTY>
+
+Used to control when the debugger will attempt to acquire another TTY to be
+used for input. 
+
+=over   
+
+=item * 1 -  on C<fork()>
+
+=item * 2 - debugger is started inside debugger
+
+=item * 4 -  on startup
+
+=back
+
+=head4 C<$doret>
+
+The value -2 indicates that no return value should be printed.
+Any other positive value causes C<DB::sub> to print return values.
+
+=head4 C<$evalarg>
+
+The item to be eval'ed by C<DB::eval>. Used to prevent messing with the current
+contents of C<@_> when C<DB::eval> is called.
+
+=head4 C<$frame>
+
+Determines what messages (if any) will get printed when a subroutine (or eval)
+is entered or exited. 
+
+=over 4
+
+=item * 0 -  No enter/exit messages
+
+=item * 1 - Print "entering" messages on subroutine entry
+
+=item * 2 - Adds exit messages on subroutine exit. If no other flag is on, acts like 1+2.
+
+=item * 4 - Extended messages: C<in|out> I<context>=I<fully-qualified sub name> from I<file>:I<line>>. If no other flag is on, acts like 1+4.
+
+=item * 8 - Adds parameter information to messages, and overloaded stringify and tied FETCH is enabled on the printed arguments. Ignored if C<4> is not on.
+
+=item * 16 - Adds C<I<context> return from I<subname>: I<value>> messages on subroutine/eval exit. Ignored if C<4> is is not on.
+
+=back
+
+To get everything, use C<$frame=30> (or C<o f-30> as a debugger command).
+The debugger internally juggles the value of C<$frame> during execution to
+protect external modules that the debugger uses from getting traced.
+
+=head4 C<$level>
+
+Tracks current debugger nesting level. Used to figure out how many 
+C<E<lt>E<gt>> pairs to surround the line number with when the debugger 
+outputs a prompt. Also used to help determine if the program has finished
+during command parsing.
+
+=head4 C<$onetimeDump>
+
+Controls what (if anything) C<DB::eval()> will print after evaluating an
+expression.
+
+=over 4
+
+=item * C<undef> - don't print anything
+
+=item * C<dump> - use C<dumpvar.pl> to display the value returned
+
+=item * C<methods> - print the methods callable on the first item returned
+
+=back
+
+=head4 C<$onetimeDumpDepth>
+
+Controls how far down C<dumpvar.pl> will go before printing '...' while
+dumping a structure. Numeric. If C<undef>, print all levels.
+
+=head4 C<$signal>
+
+Used to track whether or not an C<INT> signal has been detected. C<DB::DB()>,
+which is called before every statement, checks this and puts the user into
+command mode if it finds C<$signal> set to a true value.
+
+=head4 C<$single>
+
+Controls behavior during single-stepping. Stacked in C<@stack> on entry to
+each subroutine; popped again at the end of each subroutine.
+
+=over 4 
+
+=item * 0 - run continuously.
+
+=item * 1 - single-step, go into subs. The 's' command.
+
+=item * 2 - single-step, don't go into subs. The 'n' command.
+
+=item * 4 - print current sub depth (turned on to force this when "too much
+recursion" occurs.
+
+=back
+
+=head4 C<$trace>
+
+Controls the output of trace information. 
+
+=over 4
+
+=item * 1 - The C<t> command was entered to turn on tracing (every line executed is printed)
+
+=item * 2 - watch expressions are active
+
+=item * 4 - user defined a C<watchfunction()> in C<afterinit()>
+
+=back
+
+=head4 C<$slave_editor>
+
+1 if C<LINEINFO> was directed to a pipe; 0 otherwise.
+
+=head4 C<@cmdfhs>
+
+Stack of filehandles that C<DB::readline()> will read commands from.
+Manipulated by the debugger's C<source> command and C<DB::readline()> itself.
+
+=head4 C<@dbline>
+
+Local alias to the magical line array, C<@{$main::{'_<'.$filename}}> , 
+supplied by the Perl interpreter to the debugger. Contains the source.
+
+=head4 C<@old_watch>
+
+Previous values of watch expressions. First set when the expression is
+entered; reset whenever the watch expression changes.
+
+=head4 C<@saved>
+
+Saves important globals (C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, C<$^W>)
+so that the debugger can substitute safe values while it's running, and
+restore them when it returns control.
+
+=head4 C<@stack>
+
+Saves the current value of C<$single> on entry to a subroutine.
+Manipulated by the C<c> command to turn off tracing in all subs above the
+current one.
+
+=head4 C<@to_watch>
+
+The 'watch' expressions: to be evaluated before each line is executed.
+
+=head4 C<@typeahead>
+
+The typeahead buffer, used by C<DB::readline>.
+
+=head4 C<%alias>
+
+Command aliases. Stored as character strings to be substituted for a command
+entered.
+
+=head4 C<%break_on_load>
+
+Keys are file names, values are 1 (break when this file is loaded) or undef
+(don't break when it is loaded).
+
+=head4 C<%dbline>
+
+Keys are line numbers, values are "condition\0action". If used in numeric
+context, values are 0 if not breakable, 1 if breakable, no matter what is
+in the actual hash entry.
+
+=head4 C<%had_breakpoints>
+
+Keys are file names; values are bitfields:
+
+=over 4 
+
+=item * 1 - file has a breakpoint in it.
+
+=item * 2 - file has an action in it.
+
+=back
+
+A zero or undefined value means this file has neither.
+
+=head4 C<%option>
+
+Stores the debugger options. These are character string values.
+
+=head4 C<%postponed>
+
+Saves breakpoints for code that hasn't been compiled yet.
+Keys are subroutine names, values are:
+
+=over 4
+
+=item * 'compile' - break when this sub is compiled
+
+=item * 'break +0 if <condition>' - break (conditionally) at the start of this routine. The condition will be '1' if no condition was specified.
+
+=back
+
+=head4 C<%postponed_file>
+
+This hash keeps track of breakpoints that need to be set for files that have
+not yet been compiled. Keys are filenames; values are references to hashes.
+Each of these hashes is keyed by line number, and its values are breakpoint
+definitions ("condition\0action").
+
+=head1 DEBUGGER INITIALIZATION
+
+The debugger's initialization actually jumps all over the place inside this
+package. This is because there are several BEGIN blocks (which of course 
+execute immediately) spread through the code. Why is that? 
+
+The debugger needs to be able to change some things and set some things up 
+before the debugger code is compiled; most notably, the C<$deep> variable that
+C<DB::sub> uses to tell when a program has recursed deeply. In addition, the
+debugger has to turn off warnings while the debugger code is compiled, but then
+restore them to their original setting before the program being debugged begins
+executing.
+
+The first C<BEGIN> block simply turns off warnings by saving the current
+setting of C<$^W> and then setting it to zero. The second one initializes
+the debugger variables that are needed before the debugger begins executing.
+The third one puts C<$^X> back to its former value. 
+
+We'll detail the second C<BEGIN> block later; just remember that if you need
+to initialize something before the debugger starts really executing, that's
+where it has to go.
+
+=cut
+
 package DB;
 
+use IO::Handle;
+
 # Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.19;
+$VERSION = 1.22;
 $header  = "perl5db.pl version $VERSION";
 
-# It is crucial that there is no lexicals in scope of `eval ""' down below
+=head1 DEBUGGER ROUTINES
+
+=head2 C<DB::eval()>
+
+This function replaces straight C<eval()> inside the debugger; it simplifies
+the process of evaluating code in the user's context.
+
+The code to be evaluated is passed via the package global variable 
+C<$DB::evalarg>; this is done to avoid fiddling with the contents of C<@_>.
+
+We preserve the current settings of X<C<$trace>>, X<C<$single>>, and X<C<$^D>>;
+add the X<C<$usercontext>> (that's the preserved values of C<$@>, C<$!>,
+C<$^E>, C<$,>, C<$/>, C<$\>, and C<$^W>, grabbed when C<DB::DB> got control,
+and the user's current package) and a add a newline before we do the C<eval()>.
+This causes the proper context to be used when the eval is actually done.
+Afterward, we restore C<$trace>, C<$single>, and C<$^D>.
+
+Next we need to handle C<$@> without getting confused. We save C<$@> in a
+local lexical, localize C<$saved[0]> (which is where C<save()> will put 
+C<$@>), and then call C<save()> to capture C<$@>, C<$!>, C<$^E>, C<$,>, 
+C<$/>, C<$\>, and C<$^W>) and set C<$,>, C<$/>, C<$\>, and C<$^W> to values
+considered sane by the debugger. If there was an C<eval()> error, we print 
+it on the debugger's output. If X<C<$onetimedump>> is defined, we call 
+X<C<dumpit>> if it's set to 'dump', or X<C<methods>> if it's set to 
+'methods'. Setting it to something else causes the debugger to do the eval 
+but not print the result - handy if you want to do something else with it 
+(the "watch expressions" code does this to get the value of the watch
+expression but not show it unless it matters).
+
+In any case, we then return the list of output from C<eval> to the caller, 
+and unwinding restores the former version of C<$@> in C<@saved> as well 
+(the localization of C<$saved[0]> goes away at the end of this scope).
+
+=head3 Parameters and variables influencing execution of DB::eval()
+
+C<DB::eval> isn't parameterized in the standard way; this is to keep the
+debugger's calls to C<DB::eval()> from mucking with C<@_>, among other things.
+The variables listed below influence C<DB::eval()>'s execution directly. 
+
+=over 4
+
+=item C<$evalarg> - the thing to actually be eval'ed
+
+=item C<$trace> - Current state of execution tracing (see X<$trace>)
+
+=item C<$single> - Current state of single-stepping (see X<$single>)        
+
+=item C<$onetimeDump> - what is to be displayed after the evaluation 
+
+=item C<$onetimeDumpDepth> - how deep C<dumpit()> should go when dumping results
+
+=back
+
+The following variables are altered by C<DB::eval()> during its execution. They
+are "stacked" via C<local()>, enabling recursive calls to C<DB::eval()>. 
+
+=over 4
+
+=item C<@res> - used to capture output from actual C<eval>.
+
+=item C<$otrace> - saved value of C<$trace>.
+
+=item C<$osingle> - saved value of C<$single>.      
+
+=item C<$od> - saved value of C<$^D>.
+
+=item C<$saved[0]> - saved value of C<$@>.
+
+=item $\ - for output of C<$@> if there is an evaluation error.      
+
+=back
+
+=head3 The problem of lexicals
+
+The context of C<DB::eval()> presents us with some problems. Obviously,
+we want to be 'sandboxed' away from the debugger's internals when we do
+the eval, but we need some way to control how punctuation variables and
+debugger globals are used. 
+
+We can't use local, because the code inside C<DB::eval> can see localized
+variables; and we can't use C<my> either for the same reason. The code
+in this routine compromises and uses C<my>.
+
+After this routine is over, we don't have user code executing in the debugger's
+context, so we can use C<my> freely.
+
+=cut
+
+############################################## Begin lexical danger zone
+
+# 'my' variables used here could leak into (that is, be visible in)
+# the context that the code being evaluated is executing in. This means that
+# the code could modify the debugger's variables.
+#
+# Fiddling with the debugger's context could be Bad. We insulate things as
+# much as we can.
+
 sub eval {
+
     # 'my' would make it visible from user code
-    #    but so does local! --tchrist  [... into @DB::res, not @res. IZ]
+    #    but so does local! --tchrist  
+    # Remember: this localizes @DB::res, not @main::res.
     local @res;
     {
-	local $otrace = $trace;
-	local $osingle = $single;
-	local $od = $^D;
-	{ ($evalarg) = $evalarg =~ /(.*)/s; }
-	@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
-	$trace = $otrace;
-	$single = $osingle;
-	$^D = $od;
+        # Try to keep the user code from messing  with us. Save these so that 
+        # even if the eval'ed code changes them, we can put them back again. 
+        # Needed because the user could refer directly to the debugger's 
+        # package globals (and any 'my' variables in this containing scope)
+        # inside the eval(), and we want to try to stay safe.
+        local $otrace  = $trace; 
+        local $osingle = $single;
+        local $od      = $^D;
+
+        # Untaint the incoming eval() argument.
+        { ($evalarg) = $evalarg =~ /(.*)/s; }
+
+        # $usercontext built in DB::DB near the comment 
+        # "set up the context for DB::eval ..."
+        # Evaluate and save any results.
+        @res =
+          eval "$usercontext $evalarg;\n";    # '\n' for nice recursive debug
+
+        # Restore those old values.
+        $trace  = $otrace;
+        $single = $osingle;
+        $^D     = $od;
     }
+
+    # Save the current value of $@, and preserve it in the debugger's copy
+    # of the saved precious globals.
     my $at = $@;
-    local $saved[0];		# Preserve the old value of $@
+
+    # Since we're only saving $@, we only have to localize the array element
+    # that it will be stored in.
+    local $saved[0];                          # Preserve the old value of $@
     eval { &DB::save };
+
+    # Now see whether we need to report an error back to the user.
     if ($at) {
-	local $\ = '';
-	print $OUT $at;
-    } elsif ($onetimeDump) {
-      if ($onetimeDump eq 'dump')  {
-        local $option{dumpDepth} = $onetimedumpDepth 
-          if defined $onetimedumpDepth;
-	dumpit($OUT, \@res);
-      } elsif ($onetimeDump eq 'methods') {
-	methods($res[0]) ;
-      }
+        local $\ = '';
+        print $OUT $at;
     }
+
+    # Display as required by the caller. $onetimeDump and $onetimedumpDepth
+    # are package globals.
+    elsif ($onetimeDump) {
+        if ($onetimeDump eq 'dump') {
+            local $option{dumpDepth} = $onetimedumpDepth
+              if defined $onetimedumpDepth;
+            dumpit($OUT, \@res);
+        }
+        elsif ($onetimeDump eq 'methods') {
+            methods($res[0]);
+        }
+    } ## end elsif ($onetimeDump)
     @res;
-}
+} ## end sub eval
 
-# After this point it is safe to introduce lexicals
-# However, one should not overdo it: leave as much control from outside as possible
+############################################## End lexical danger zone
+
+# After this point it is safe to introduce lexicals.
+# The code being debugged will be executing in its own context, and 
+# can't see the inside of the debugger.
 #
+# However, one should not overdo it: leave as much control from outside as    
+# possible. If you make something a lexical, it's not going to be addressable
+# from outside the debugger even if you know its name.
+
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
 #
 # Before venturing further into these twisty passages, it is 
 # wise to read the perldebguts man page or risk the ire of dragons.
 #
-# Perl supplies the values for %sub.  It effectively inserts
-# a &DB::DB(); in front of every place that can have a
-# breakpoint. Instead of a subroutine call it calls &DB::sub with
-# $DB::sub being the called subroutine. It also inserts a BEGIN
-# {require 'perl5db.pl'} before the first line.
-#
-# After each `require'd file is compiled, but before it is executed, a
-# call to DB::postponed($main::{'_<'.$filename}) is emulated. Here the
-# $filename is the expanded name of the `require'd file (as found as
-# value of %INC).
-#
-# Additional services from Perl interpreter:
-#
-# if caller() is called from the package DB, it provides some
-# additional data.
-#
-# The array @{$main::{'_<'.$filename}} (herein called @dbline) is the
-# line-by-line contents of $filename.
-#
-# The hash %{'_<'.$filename} (herein called %dbline) contains
-# breakpoints and action (it is keyed by line number), and individual
-# entries are settable (as opposed to the whole hash). Only true/false
-# is important to the interpreter, though the values used by
-# perl5db.pl have the form "$break_condition\0$action". Values are
-# magical in numeric context.
-#
-# The scalar ${'_<'.$filename} contains $filename.
-#
+# (It should be noted that perldebguts will tell you a lot about
+# the uderlying mechanics of how the debugger interfaces into the
+# Perl interpreter, but not a lot about the debugger itself. The new
+# comments in this code try to address this problem.)
+
 # Note that no subroutine call is possible until &DB::sub is defined
 # (for subroutines defined outside of the package DB). In fact the same is
 # true if $deep is not defined.
 #
 # $Log:	perldb.pl,v $
 
-#
-# At start reads $rcfile that may set important options.  This file
-# may define a subroutine &afterinit that will be executed after the
-# debugger is initialized.
-#
-# After $rcfile is read reads environment variable PERLDB_OPTS and parses
-# it as a rest of `O ...' line in debugger prompt.
-#
-# The options that can be specified only at startup:
-# [To set in $rcfile, call &parse_options("optionName=new_value").]
-#
-# TTY  - the TTY to use for debugging i/o.
-#
-# noTTY - if set, goes in NonStop mode.  On interrupt if TTY is not set
-# uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
-# Term::Rendezvous.  Current variant is to have the name of TTY in this
-# file.
-#
-# ReadLine - If false, dummy ReadLine is used, so you can debug
-# ReadLine applications.
-#
-# NonStop - if true, no i/o is performed until interrupt.
-#
-# LineInfo - file or pipe to print line number info to.  If it is a
-# pipe, a short "emacs like" message is used.
-#
-# RemotePort - host:port to connect to on remote host for remote debugging.
-#
-# Example $rcfile: (delete leading hashes!)
-#
-# &parse_options("NonStop=1 LineInfo=db.out");
-# sub afterinit { $trace = 1; }
-#
-# The script will run without human intervention, putting trace
-# information into db.out.  (If you interrupt it, you would better
-# reset LineInfo to something "interactive"!)
-#
-##################################################################
-
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
 
 # modified Perl debugger, to be run from Emacs in perldb-mode
@@ -126,62 +687,68 @@ sub eval {
 # Johan Vromans -- upgrade to 4.0 pl 10
 # Ilya Zakharevich -- patches after 5.001 (and some before ;-)
 
-# Changelog:
-
-# A lot of things changed after 0.94. First of all, core now informs
-# debugger about entry into XSUBs, overloaded operators, tied operations,
-# BEGIN and END. Handy with `O f=2'.
-
-# This can make debugger a little bit too verbose, please be patient
-# and report your problems promptly.
-
-# Now the option frame has 3 values: 0,1,2.
-
-# Note that if DESTROY returns a reference to the object (or object),
-# the deletion of data may be postponed until the next function call,
-# due to the need to examine the return value.
-
-# Changes: 0.95: `v' command shows versions.
-# Changes: 0.96: `v' command shows version of readline.
-#	primitive completion works (dynamic variables, subs for `b' and `l',
-#		options). Can `p %var'
-#	Better help (`h <' now works). New commands <<, >>, {, {{.
-#	{dump|print}_trace() coded (to be able to do it from <<cmd).
-#	`c sub' documented.
-#	At last enough magic combined to stop after the end of debuggee.
-#	!! should work now (thanks to Emacs bracket matching an extra
-#	`]' in a regexp is caught).
-#	`L', `D' and `A' span files now (as documented).
-#	Breakpoints in `require'd code are possible (used in `R').
-#	Some additional words on internal work of debugger.
-#	`b load filename' implemented.
-#	`b postpone subr' implemented.
-#	now only `q' exits debugger (overwritable on $inhibit_exit).
-#	When restarting debugger breakpoints/actions persist.
-#     Buglet: When restarting debugger only one breakpoint/action per 
-#		autoloaded function persists.
+# (We have made efforts to  clarify the comments in the change log
+# in other places; some of them may seem somewhat obscure as they
+# were originally written, and explaining them away from the code
+# in question seems conterproductive.. -JM)
+
+########################################################################
+# Changes: 0.94
+#   + A lot of things changed after 0.94. First of all, core now informs
+#     debugger about entry into XSUBs, overloaded operators, tied operations,
+#     BEGIN and END. Handy with `O f=2'.
+#   + This can make debugger a little bit too verbose, please be patient
+#     and report your problems promptly.
+#   + Now the option frame has 3 values: 0,1,2. XXX Document!
+#   + Note that if DESTROY returns a reference to the object (or object),
+#     the deletion of data may be postponed until the next function call,
+#     due to the need to examine the return value.
+#
+# Changes: 0.95
+#   + `v' command shows versions.
+#
+# Changes: 0.96 
+#   + `v' command shows version of readline.
+#     primitive completion works (dynamic variables, subs for `b' and `l',
+#     options). Can `p %var'
+#   + Better help (`h <' now works). New commands <<, >>, {, {{.
+#     {dump|print}_trace() coded (to be able to do it from <<cmd).
+#   + `c sub' documented.
+#   + At last enough magic combined to stop after the end of debuggee.
+#   + !! should work now (thanks to Emacs bracket matching an extra
+#     `]' in a regexp is caught).
+#   + `L', `D' and `A' span files now (as documented).
+#   + Breakpoints in `require'd code are possible (used in `R').
+#   +  Some additional words on internal work of debugger.
+#   + `b load filename' implemented.
+#   + `b postpone subr' implemented.
+#   + now only `q' exits debugger (overwritable on $inhibit_exit).
+#   + When restarting debugger breakpoints/actions persist.
+#   + Buglet: When restarting debugger only one breakpoint/action per 
+#             autoloaded function persists.
+#
 # Changes: 0.97: NonStop will not stop in at_exit().
-#	Option AutoTrace implemented.
-#	Trace printed differently if frames are printed too.
-#	new `inhibitExit' option.
-#	printing of a very long statement interruptible.
+#   + Option AutoTrace implemented.
+#   + Trace printed differently if frames are printed too.
+#   + new `inhibitExit' option.
+#   + printing of a very long statement interruptible.
 # Changes: 0.98: New command `m' for printing possible methods
-#	'l -' is a synonym for `-'.
-#	Cosmetic bugs in printing stack trace.
-#	`frame' & 8 to print "expanded args" in stack trace.
-#	Can list/break in imported subs.
-#	new `maxTraceLen' option.
-#	frame & 4 and frame & 8 granted.
-#	new command `m'
-#	nonstoppable lines do not have `:' near the line number.
-#	`b compile subname' implemented.
-#	Will not use $` any more.
-#	`-' behaves sane now.
+#   + 'l -' is a synonym for `-'.
+#   + Cosmetic bugs in printing stack trace.
+#   +  `frame' & 8 to print "expanded args" in stack trace.
+#   + Can list/break in imported subs.
+#   + new `maxTraceLen' option.
+#   + frame & 4 and frame & 8 granted.
+#   + new command `m'
+#   + nonstoppable lines do not have `:' near the line number.
+#   + `b compile subname' implemented.
+#   + Will not use $` any more.
+#   + `-' behaves sane now.
 # Changes: 0.99: Completion for `f', `m'.
-#	`m' will remove duplicate names instead of duplicate functions.
-#	`b load' strips trailing whitespace.
-#	completion ignores leading `|'; takes into account current package
-#	when completing a subroutine name (same for `l').
+#   +  `m' will remove duplicate names instead of duplicate functions.
+#   + `b load' strips trailing whitespace.
+#     completion ignores leading `|'; takes into account current package
+#     when completing a subroutine name (same for `l').
 # Changes: 1.07: Many fixed by tchrist 13-March-2000
 #   BUG FIXES:
 #   + Added bare minimal security checks on perldb rc files, plus
@@ -233,25 +800,26 @@ sub eval {
 #     tabs don't seem to help much here.
 #
 # Changes: 1.09: May 19, 2001  Ilya Zakharevich <ilya@math.ohio-state.edu>
-#   0) Minor bugs corrected;
-#   a) Support for auto-creation of new TTY window on startup, either
-#      unconditionally, or if started as a kid of another debugger session;
-#   b) New `O'ption CreateTTY
-#       I<CreateTTY>       bits control attempts to create a new TTY on events:
-#                          1: on fork()   2: debugger is started inside debugger
-#                          4: on startup
-#   c) Code to auto-create a new TTY window on OS/2 (currently one
-#      extra window per session - need named pipes to have more...);
-#   d) Simplified interface for custom createTTY functions (with a backward
-#      compatibility hack); now returns the TTY name to use; return of ''
-#      means that the function reset the I/O handles itself;
-#   d') Better message on the semantic of custom createTTY function;
-#   e) Convert the existing code to create a TTY into a custom createTTY
-#      function;
-#   f) Consistent support for TTY names of the form "TTYin,TTYout";
-#   g) Switch line-tracing output too to the created TTY window;
-#   h) make `b fork' DWIM with CORE::GLOBAL::fork;
-#   i) High-level debugger API cmd_*():
+#   Minor bugs corrected;
+#   + Support for auto-creation of new TTY window on startup, either
+#     unconditionally, or if started as a kid of another debugger session;
+#   + New `O'ption CreateTTY
+#       I<CreateTTY>      bits control attempts to create a new TTY on events:
+#                         1: on fork()   
+#                         2: debugger is started inside debugger
+#                         4: on startup
+#   + Code to auto-create a new TTY window on OS/2 (currently one
+#     extra window per session - need named pipes to have more...);
+#   + Simplified interface for custom createTTY functions (with a backward
+#     compatibility hack); now returns the TTY name to use; return of ''
+#     means that the function reset the I/O handles itself;
+#   + Better message on the semantic of custom createTTY function;
+#   + Convert the existing code to create a TTY into a custom createTTY
+#     function;
+#   + Consistent support for TTY names of the form "TTYin,TTYout";
+#   + Switch line-tracing output too to the created TTY window;
+#   + make `b fork' DWIM with CORE::GLOBAL::fork;
+#   + High-level debugger API cmd_*():
 #      cmd_b_load($filenamepart)            # b load filenamepart
 #      cmd_b_line($lineno [, $cond])        # b lineno [cond]
 #      cmd_b_sub($sub [, $cond])            # b sub [cond]
@@ -259,16 +827,18 @@ sub eval {
 #      cmd_d($lineno)                       # d lineno (B)
 #      The cmd_*() API returns FALSE on failure; in this case it outputs
 #      the error message to the debugging output.
-#   j) Low-level debugger API
+#   + Low-level debugger API
 #      break_on_load($filename)             # b load filename
 #      @files = report_break_on_load()      # List files with load-breakpoints
 #      breakable_line_in_filename($name, $from [, $to])
 #                                           # First breakable line in the
 #                                           # range $from .. $to.  $to defaults
-#                                           # to $from, and may be less than $to
+#                                           # to $from, and may be less than 
+#                                           # $to
 #      breakable_line($from [, $to])        # Same for the current file
 #      break_on_filename_line($name, $lineno [, $cond])
-#                                           # Set breakpoint,$cond defaults to 1
+#                                           # Set breakpoint,$cond defaults to 
+#                                           # 1
 #      break_on_filename_line_range($name, $from, $to [, $cond])
 #                                           # As above, on the first
 #                                           # breakable line in range
@@ -303,7 +873,7 @@ sub eval {
 #   + Added *dbline explainatory comments
 #   + Mentioning perldebguts man page
 # Changes: 1.16: Feb 15, 2002 Mark-Jason Dominus <mjd@plover.com>
-#	+ $onetimeDump improvements
+#   + $onetimeDump improvements
 # Changes: 1.17: Feb 20, 2002 Richard Foley <richard.foley@rfi.net>
 #   Moved some code to cmd_[.]()'s for clarity and ease of handling,
 #   rationalised the following commands and added cmd_wrapper() to 
@@ -311,7 +881,8 @@ sub eval {
 #   behaviours for diehards: 'o CommandSet=pre580' (sigh...)
 #     a(add),       A(del)            # action expr   (added del by line)
 #   + b(add),       B(del)            # break  [line] (was b,D)
-#   + w(add),       W(del)            # watch  expr   (was W,W) added del by expr
+#   + w(add),       W(del)            # watch  expr   (was W,W) 
+#                                     # added del by expr
 #   + h(summary), h h(long)           # help (hh)     (was h h,h)
 #   + m(methods),   M(modules)        # ...           (was m,v)
 #   + o(option)                       # lc            (was O)
@@ -320,166 +891,397 @@ sub eval {
 #   + fixed missing cmd_O bug
 # Changes: 1.19: Mar 29, 2002 Spider Boardman
 #   + Added missing local()s -- DB::DB is called recursively.
-# 
+# Changes: 1.20: Feb 17, 2003 Richard Foley <richard.foley@rfi.net>
+#   + pre'n'post commands no longer trashed with no args
+#   + watch val joined out of eval()
+# Changes: 1.21: Jun 04, 2003 Joe McMahon <mcmahon@ibiblio.org>
+#   + Added comments and reformatted source. No bug fixes/enhancements.
+#   + Includes cleanup by Robin Barker and Jarkko Hietaniemi.
+# Changes: 1.22  Jun 09, 2003 Alex Vandiver <alexmv@MIT.EDU>
+#   + Flush stdout/stderr before the debugger prompt is printed.
+
 ####################################################################
 
-# Needed for the statement after exec():
+=head1 DEBUGGER INITIALIZATION
+
+The debugger starts up in phases.
+
+=head2 BASIC SETUP
+
+First, it initializes the environment it wants to run in: turning off
+warnings during its own compilation, defining variables which it will need
+to avoid warnings later, setting itself up to not exit when the program
+terminates, and defaulting to printing return values for the C<r> command.
 
-BEGIN { $ini_warn = $^W; $^W = 0 } # Switch compilation warnings off until another BEGIN.
-local($^W) = 0;			# Switch run-time warnings off during init.
-warn (			# Do not ;-)
-      $dumpvar::hashDepth,     
-      $dumpvar::arrayDepth,    
-      $dumpvar::dumpDBFiles,   
-      $dumpvar::dumpPackages,  
-      $dumpvar::quoteHighBit,  
-      $dumpvar::printUndef,    
-      $dumpvar::globPrint,     
-      $dumpvar::usageOnly,
-      @ARGS,
-      $Carp::CarpLevel,
-      $panic,
-      $second_time,
-     ) if 0;
+=cut
+
+# Needed for the statement after exec():
+#
+# This BEGIN block is simply used to switch off warnings during debugger
+# compiliation. Probably it would be better practice to fix the warnings,
+# but this is how it's done at the moment.
+
+BEGIN {
+    $ini_warn = $^W;
+    $^W       = 0;
+}    # Switch compilation warnings off until another BEGIN.
+
+local ($^W) = 0;    # Switch run-time warnings off during init.
+
+# This would probably be better done with "use vars", but that wasn't around
+# when this code was originally written. (Neither was "use strict".) And on
+# the principle of not fiddling with something that was working, this was
+# left alone.
+warn(               # Do not ;-)
+    # These variables control the execution of 'dumpvar.pl'.
+    $dumpvar::hashDepth,
+    $dumpvar::arrayDepth,
+    $dumpvar::dumpDBFiles,
+    $dumpvar::dumpPackages,
+    $dumpvar::quoteHighBit,
+    $dumpvar::printUndef,
+    $dumpvar::globPrint,
+    $dumpvar::usageOnly,
+
+    # used to save @ARGV and extract any debugger-related flags.
+    @ARGS,
+
+    # used to control die() reporting in diesignal()
+    $Carp::CarpLevel,
+
+    # used to prevent multiple entries to diesignal()
+    # (if for instance diesignal() itself dies)
+    $panic,
+
+    # used to prevent the debugger from running nonstop
+    # after a restart
+    $second_time,
+  )
+  if 0;
 
 # Command-line + PERLLIB:
+# Save the contents of @INC before they are modified elsewhere.
 @ini_INC = @INC;
 
+# This was an attempt to clear out the previous values of various
+# trapped errors. Apparently it didn't help. XXX More info needed!
 # $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!
 
-$trace = $signal = $single = 0;	# Uninitialized warning suppression
-                                # (local $^W cannot help - other packages!).
-$inhibit_exit = $option{PrintRet} = 1;
+# We set these variables to safe values. We don't want to blindly turn
+# off warnings, because other packages may still want them.
+$trace = $signal = $single = 0;   # Uninitialized warning suppression
+                                  # (local $^W cannot help - other packages!).
 
-@options     = qw(hashDepth arrayDepth CommandSet dumpDepth
-                  DumpDBFiles DumpPackages DumpReused
-		  compactDump veryCompact quote HighBit undefPrint
-		  globPrint PrintRet UsageOnly frame AutoTrace
-		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
-		  recallCommand ShellBang pager tkRunning ornaments
-		  signalLevel warnLevel dieLevel inhibit_exit
-		  ImmediateStop bareStringify CreateTTY
-		  RemotePort windowSize);
-
-%optionVars    = (
-		 hashDepth	=> \$dumpvar::hashDepth,
-		 arrayDepth	=> \$dumpvar::arrayDepth,
-		 CommandSet => \$CommandSet,
-		 DumpDBFiles	=> \$dumpvar::dumpDBFiles,
-		 DumpPackages	=> \$dumpvar::dumpPackages,
-		 DumpReused	=> \$dumpvar::dumpReused,
-		 HighBit	=> \$dumpvar::quoteHighBit,
-		 undefPrint	=> \$dumpvar::printUndef,
-		 globPrint	=> \$dumpvar::globPrint,
-		 UsageOnly	=> \$dumpvar::usageOnly,
-		 CreateTTY	=> \$CreateTTY,
-		 bareStringify	=> \$dumpvar::bareStringify,
-		 frame          => \$frame,
-		 AutoTrace      => \$trace,
-		 inhibit_exit   => \$inhibit_exit,
-		 maxTraceLen	=> \$maxtrace,
-		 ImmediateStop	=> \$ImmediateStop,
-		 RemotePort	=> \$remoteport,
-		 windowSize	=> \$window,
-);
-
-%optionAction  = (
-		  compactDump	=> \&dumpvar::compactDump,
-		  veryCompact	=> \&dumpvar::veryCompact,
-		  quote		=> \&dumpvar::quote,
-		  TTY		=> \&TTY,
-		  noTTY		=> \&noTTY,
-		  ReadLine	=> \&ReadLine,
-		  NonStop	=> \&NonStop,
-		  LineInfo	=> \&LineInfo,
-		  recallCommand	=> \&recallCommand,
-		  ShellBang	=> \&shellBang,
-		  pager		=> \&pager,
-		  signalLevel	=> \&signalLevel,
-		  warnLevel	=> \&warnLevel,
-		  dieLevel	=> \&dieLevel,
-		  tkRunning	=> \&tkRunning,
-		  ornaments	=> \&ornaments,
-		  RemotePort	=> \&RemotePort,
-		 );
+# Default to not exiting when program finishes; print the return
+# value when the 'r' command is used to return from a subroutine.
+$inhibit_exit = $option{PrintRet} = 1;
 
+=head1 OPTION PROCESSING
+
+The debugger's options are actually spread out over the debugger itself and 
+C<dumpvar.pl>; some of these are variables to be set, while others are 
+subs to be called with a value. To try to make this a little easier to
+manage, the debugger uses a few data structures to define what options
+are legal and how they are to be processed.
+
+First, the C<@options> array defines the I<names> of all the options that
+are to be accepted.
+
+=cut
+
+@options = qw(
+             CommandSet
+             hashDepth    arrayDepth    dumpDepth
+             DumpDBFiles  DumpPackages  DumpReused
+             compactDump  veryCompact   quote
+             HighBit      undefPrint    globPrint 
+             PrintRet     UsageOnly     frame
+             AutoTrace    TTY           noTTY 
+             ReadLine     NonStop       LineInfo 
+             maxTraceLen  recallCommand ShellBang
+             pager        tkRunning     ornaments
+             signalLevel  warnLevel     dieLevel 
+             inhibit_exit ImmediateStop bareStringify 
+             CreateTTY    RemotePort    windowSize
+           );
+
+=pod
+
+Second, C<optionVars> lists the variables that each option uses to save its
+state.
+
+=cut
+
+%optionVars = (
+    hashDepth     => \$dumpvar::hashDepth,
+    arrayDepth    => \$dumpvar::arrayDepth,
+    CommandSet    => \$CommandSet,
+    DumpDBFiles   => \$dumpvar::dumpDBFiles,
+    DumpPackages  => \$dumpvar::dumpPackages,
+    DumpReused    => \$dumpvar::dumpReused,
+    HighBit       => \$dumpvar::quoteHighBit,
+    undefPrint    => \$dumpvar::printUndef,
+    globPrint     => \$dumpvar::globPrint,
+    UsageOnly     => \$dumpvar::usageOnly,
+    CreateTTY     => \$CreateTTY,
+    bareStringify => \$dumpvar::bareStringify,
+    frame         => \$frame,
+    AutoTrace     => \$trace,
+    inhibit_exit  => \$inhibit_exit,
+    maxTraceLen   => \$maxtrace,
+    ImmediateStop => \$ImmediateStop,
+    RemotePort    => \$remoteport,
+    windowSize    => \$window,
+    );
+
+=pod
+
+Third, C<%optionAction> defines the subroutine to be called to process each
+option.
+
+=cut 
+
+%optionAction = (
+    compactDump   => \&dumpvar::compactDump,
+    veryCompact   => \&dumpvar::veryCompact,
+    quote         => \&dumpvar::quote,
+    TTY           => \&TTY,
+    noTTY         => \&noTTY,
+    ReadLine      => \&ReadLine,
+    NonStop       => \&NonStop,
+    LineInfo      => \&LineInfo,
+    recallCommand => \&recallCommand,
+    ShellBang     => \&shellBang,
+    pager         => \&pager,
+    signalLevel   => \&signalLevel,
+    warnLevel     => \&warnLevel,
+    dieLevel      => \&dieLevel,
+    tkRunning     => \&tkRunning,
+    ornaments     => \&ornaments,
+    RemotePort    => \&RemotePort,
+    );
+
+=pod
+
+Last, the C<%optionRequire> notes modules that must be C<require>d if an
+option is used.
+
+=cut
+
+# Note that this list is not complete: several options not listed here
+# actually require that dumpvar.pl be loaded for them to work, but are
+# not in the table. A subsequent patch will correct this problem; for
+# the moment, we're just recommenting, and we are NOT going to change
+# function.
 %optionRequire = (
-		  compactDump	=> 'dumpvar.pl',
-		  veryCompact	=> 'dumpvar.pl',
-		  quote		=> 'dumpvar.pl',
-		 );
+    compactDump => 'dumpvar.pl',
+    veryCompact => 'dumpvar.pl',
+    quote       => 'dumpvar.pl',
+    );
+
+=pod
+
+There are a number of initialization-related variables which can be set
+by putting code to set them in a BEGIN block in the C<PERL5DB> environment
+variable. These are:
+
+=over 4
+
+=item C<$rl> - readline control XXX needs more explanation
+
+=item C<$warnLevel> - whether or not debugger takes over warning handling
+
+=item C<$dieLevel> - whether or not debugger takes over die handling
+
+=item C<$signalLevel> - whether or not debugger takes over signal handling
+
+=item C<$pre> - preprompt actions (array reference)
+
+=item C<$post> - postprompt actions (array reference)
+
+=item C<$pretype>
+
+=item C<$CreateTTY> - whether or not to create a new TTY for this debugger
+
+=item C<$CommandSet> - which command set to use (defaults to new, documented set)
+
+=back
+
+=cut
 
 # These guys may be defined in $ENV{PERL5DB} :
-$rl		= 1	unless defined $rl;
-$warnLevel	= 1	unless defined $warnLevel;
-$dieLevel	= 1	unless defined $dieLevel;
-$signalLevel	= 1	unless defined $signalLevel;
-$pre		= []	unless defined $pre;
-$post		= []	unless defined $post;
-$pretype	= []	unless defined $pretype;
-$CreateTTY	= 3	unless defined $CreateTTY;
-$CommandSet = '580'	unless defined $CommandSet;
+$rl          = 1     unless defined $rl;
+$warnLevel   = 1     unless defined $warnLevel;
+$dieLevel    = 1     unless defined $dieLevel;
+$signalLevel = 1     unless defined $signalLevel;
+$pre         = []    unless defined $pre;
+$post        = []    unless defined $post;
+$pretype     = []    unless defined $pretype;
+$CreateTTY   = 3     unless defined $CreateTTY;
+$CommandSet  = '580' unless defined $CommandSet;
+
+=pod
+
+The default C<die>, C<warn>, and C<signal> handlers are set up.
+
+=cut
 
 warnLevel($warnLevel);
 dieLevel($dieLevel);
 signalLevel($signalLevel);
 
+=pod
+
+The pager to be used is needed next. We try to get it from the
+environment first.  if it's not defined there, we try to find it in
+the Perl C<Config.pm>.  If it's not there, we default to C<more>. We
+then call the C<pager()> function to save the pager name.
+
+=cut
+
+# This routine makes sure $pager is set up so that '|' can use it.
 pager(
-      defined $ENV{PAGER}              ? $ENV{PAGER} :
-      eval { require Config } && 
-        defined $Config::Config{pager} ? $Config::Config{pager}
-                                       : 'more'
-     ) unless defined $pager;
+    # If PAGER is defined in the environment, use it.
+    defined $ENV{PAGER} 
+      ? $ENV{PAGER}
+
+      # If not, see if Config.pm defines it.
+      : eval { require Config } && defined $Config::Config{pager} 
+        ? $Config::Config{pager}
+
+      # If not, fall back to 'more'.
+        : 'more'
+  )
+  unless defined $pager;
+
+=pod
+
+We set up the command to be used to access the man pages, the command
+recall character ("!" unless otherwise defined) and the shell escape
+character ("!" unless otherwise defined). Yes, these do conflict, and
+neither works in the debugger at the moment.
+
+=cut
+
 setman();
+
+# Set up defaults for command recall and shell escape (note:
+# these currently don't work in linemode debugging).
 &recallCommand("!") unless defined $prc;
-&shellBang("!") unless defined $psh;
+&shellBang("!")     unless defined $psh;
+
+=pod
+
+We then set up the gigantic string containing the debugger help.
+We also set the limit on the number of arguments we'll display during a
+trace.
+
+=cut
+
 sethelp();
+
+# If we didn't get a default for the length of eval/stack trace args,
+# set it here.
 $maxtrace = 400 unless defined $maxtrace;
+
+=head2 SETTING UP THE DEBUGGER GREETING
+
+The debugger 'greeting'  helps to inform the user how many debuggers are
+running, and whether the current debugger is the primary or a child.
+
+If we are the primary, we just hang onto our pid so we'll have it when
+or if we start a child debugger. If we are a child, we'll set things up
+so we'll have a unique greeting and so the parent will give us our own
+TTY later.
+
+We save the current contents of the C<PERLDB_PIDS> environment variable
+because we mess around with it. We'll also need to hang onto it because
+we'll need it if we restart.
+
+Child debuggers make a label out of the current PID structure recorded in
+PERLDB_PIDS plus the new PID. They also mark themselves as not having a TTY
+yet so the parent will give them one later via C<resetterm()>.
+
+=cut
+
+# Save the current contents of the environment; we're about to 
+# much with it. We'll need this if we have to restart.
 $ini_pids = $ENV{PERLDB_PIDS};
-if (defined $ENV{PERLDB_PIDS}) {
-  $pids = "[$ENV{PERLDB_PIDS}]";
-  $ENV{PERLDB_PIDS} .= "->$$";
-  $term_pid = -1;
-} else {
-  $ENV{PERLDB_PIDS} = "$$";
-  $pids = "{pid=$$}";
-  $term_pid = $$;
+
+if (defined $ENV{PERLDB_PIDS}) { 
+    # We're a child. Make us a label out of the current PID structure
+    # recorded in PERLDB_PIDS plus our (new) PID. Mark us as not having 
+    # a term yet so the parent will give us one later via resetterm().
+    $pids = "[$ENV{PERLDB_PIDS}]";
+    $ENV{PERLDB_PIDS} .= "->$$";
+    $term_pid = -1;
+} ## end if (defined $ENV{PERLDB_PIDS...
+else {
+    # We're the parent PID. Initialize PERLDB_PID in case we end up with a 
+    # child debugger, and mark us as the parent, so we'll know to set up
+    # more TTY's is we have to.
+    $ENV{PERLDB_PIDS} = "$$";
+    $pids     = "{pid=$$}";
+    $term_pid = $$;
 }
+
 $pidprompt = '';
-*emacs = $slave_editor if $slave_editor;	# May be used in afterinit()...
 
-if (-e "/dev/tty") {  # this is the wrong metric!
-  $rcfile=".perldb";
-} else {
-  $rcfile="perldb.ini";
+# Sets up $emacs as a synonym for $slave_editor.
+*emacs     = $slave_editor if $slave_editor;   # May be used in afterinit()...
+
+=head2 READING THE RC FILE
+
+The debugger will read a file of initialization options if supplied. If    
+running interactively, this is C<.perldb>; if not, it's C<perldb.ini>.
+
+=cut      
+
+# As noted, this test really doesn't check accurately that the debugger
+# is running at a terminal or not.
+if (-e "/dev/tty") {                           # this is the wrong metric!
+    $rcfile = ".perldb";
 }
+else {
+    $rcfile = "perldb.ini";
+}
+
+=pod
+
+The debugger does a safety test of the file to be read. It must be owned
+either by the current user or root, and must only be writable by the owner.
+
+=cut
 
+# This wraps a safety test around "do" to read and evaluate the init file.
+#
 # This isn't really safe, because there's a race
 # between checking and opening.  The solution is to
 # open and fstat the handle, but then you have to read and
 # eval the contents.  But then the silly thing gets
-# your lexical scope, which is unfortunately at best.
-sub safe_do { 
+# your lexical scope, which is unfortunate at best.
+sub safe_do {
     my $file = shift;
 
     # Just exactly what part of the word "CORE::" don't you understand?
-    local $SIG{__WARN__};  
-    local $SIG{__DIE__};    
+    local $SIG{__WARN__};
+    local $SIG{__DIE__};
 
     unless (is_safe_file($file)) {
-	CORE::warn <<EO_GRIPE;
+        CORE::warn <<EO_GRIPE;
 perldb: Must not source insecure rcfile $file.
         You or the superuser must be the owner, and it must not 
-	be writable by anyone but its owner.
+        be writable by anyone but its owner.
 EO_GRIPE
-	return;
-    } 
+        return;
+    } ## end unless (is_safe_file($file...
 
     do $file;
     CORE::warn("perldb: couldn't parse $file: $@") if $@;
-}
-
+} ## end sub safe_do
 
+# This is the safety test itself.
+#
 # Verifies that owner is either real user or superuser and that no
 # one but owner may write to it.  This function is of limited use
 # when called on a path instead of upon a handle, because there are
@@ -488,1797 +1290,4541 @@ EO_GRIPE
 # Assumes that the file's existence is not in doubt.
 sub is_safe_file {
     my $path = shift;
-    stat($path) || return;	# mysteriously vaporized
-    my($dev,$ino,$mode,$nlink,$uid,$gid) = stat(_);
+    stat($path) || return;    # mysteriously vaporized
+    my ($dev, $ino, $mode, $nlink, $uid, $gid) = stat(_);
 
     return 0 if $uid != 0 && $uid != $<;
     return 0 if $mode & 022;
     return 1;
-}
+} ## end sub is_safe_file
 
+# If the rcfile (whichever one we decided was the right one to read)
+# exists, we safely do it. 
 if (-f $rcfile) {
     safe_do("./$rcfile");
-} 
+}
+# If there isn't one here, try the user's home directory.
 elsif (defined $ENV{HOME} && -f "$ENV{HOME}/$rcfile") {
     safe_do("$ENV{HOME}/$rcfile");
 }
+# Else try the login directory.
 elsif (defined $ENV{LOGDIR} && -f "$ENV{LOGDIR}/$rcfile") {
     safe_do("$ENV{LOGDIR}/$rcfile");
 }
 
+# If the PERLDB_OPTS variable has options in it, parse those out next.
 if (defined $ENV{PERLDB_OPTS}) {
-  parse_options($ENV{PERLDB_OPTS});
+    parse_options($ENV{PERLDB_OPTS});
 }
 
-if ( not defined &get_fork_TTY and defined $ENV{TERM} and $ENV{TERM} eq 'xterm'
-     and defined $ENV{WINDOWID} and defined $ENV{DISPLAY} ) { # _inside_ XTERM?
-    *get_fork_TTY = \&xterm_get_fork_TTY;
-} elsif ($^O eq 'os2') {
-    *get_fork_TTY = \&os2_get_fork_TTY;
+=pod
+
+The last thing we do during initialization is determine which subroutine is
+to be used to obtain a new terminal when a new debugger is started. Right now,
+the debugger only handles X Windows and OS/2.
+
+=cut
+
+# Set up the get_fork_TTY subroutine to be aliased to the proper routine.
+# Works if you're running an xterm or xterm-like window, or you're on
+# OS/2. This may need some expansion: for instance, this doesn't handle
+# OS X Terminal windows.       
+
+if (not defined &get_fork_TTY                        # no routine exists,
+    and defined $ENV{TERM}                           # and we know what kind
+                                                     # of terminal this is,
+    and $ENV{TERM} eq 'xterm'                        # and it's an xterm,
+    and defined $ENV{WINDOWID}                       # and we know what
+                                                     # window this is,
+    and defined $ENV{DISPLAY})                       # and what display it's
+                                                     # on,
+{
+    *get_fork_TTY = \&xterm_get_fork_TTY;            # use the xterm version
+} ## end if (not defined &get_fork_TTY...
+elsif ($^O eq 'os2') {                               # If this is OS/2,
+    *get_fork_TTY = \&os2_get_fork_TTY;              # use the OS/2 version
 }
 
-# Here begin the unreadable code.  It needs fixing.
+# "Here begin the unreadable code.  It needs fixing." 
+
+=head2 RESTART PROCESSING
+
+This section handles the restart command. When the C<R> command is invoked, it
+tries to capture all of the state it can into environment variables, and
+then sets C<PERLDB_RESTART>. When we start executing again, we check to see
+if C<PERLDB_RESTART> is there; if so, we reload all the information that
+the R command stuffed into the environment variables.
+
+  PERLDB_RESTART   - flag only, contains no restart data itself.       
+  PERLDB_HIST      - command history, if it's available
+  PERLDB_ON_LOAD   - breakpoints set by the rc file
+  PERLDB_POSTPONE  - subs that have been loaded/not executed, and have actions
+  PERLDB_VISITED   - files that had breakpoints
+  PERLDB_FILE_...  - breakpoints for a file
+  PERLDB_OPT       - active options
+  PERLDB_INC       - the original @INC
+  PERLDB_PRETYPE   - preprompt debugger actions
+  PERLDB_PRE       - preprompt Perl code
+  PERLDB_POST      - post-prompt Perl code
+  PERLDB_TYPEAHEAD - typeahead captured by readline()
+
+We chug through all these variables and plug the values saved in them
+back into the appropriate spots in the debugger.
+
+=cut
 
 if (exists $ENV{PERLDB_RESTART}) {
-  delete $ENV{PERLDB_RESTART};
-  # $restart = 1;
-  @hist = get_list('PERLDB_HIST');
-  %break_on_load = get_list("PERLDB_ON_LOAD");
-  %postponed = get_list("PERLDB_POSTPONE");
-  my @had_breakpoints= get_list("PERLDB_VISITED");
-  for (0 .. $#had_breakpoints) {
-    my %pf = get_list("PERLDB_FILE_$_");
-    $postponed_file{$had_breakpoints[$_]} = \%pf if %pf;
-  }
-  my %opt = get_list("PERLDB_OPT");
-  my ($opt,$val);
-  while (($opt,$val) = each %opt) {
-    $val =~ s/[\\\']/\\$1/g;
-    parse_options("$opt'$val'");
-  }
-  @INC = get_list("PERLDB_INC");
-  @ini_INC = @INC;
-  $pretype = [get_list("PERLDB_PRETYPE")];
-  $pre = [get_list("PERLDB_PRE")];
-  $post = [get_list("PERLDB_POST")];
-  @typeahead = get_list("PERLDB_TYPEAHEAD", @typeahead);
-}
+    # We're restarting, so we don't need the flag that says to restart anymore.
+    delete $ENV{PERLDB_RESTART};
+    # $restart = 1;
+    @hist          = get_list('PERLDB_HIST');
+    %break_on_load = get_list("PERLDB_ON_LOAD");
+    %postponed     = get_list("PERLDB_POSTPONE");
+
+    # restore breakpoints/actions
+    my @had_breakpoints = get_list("PERLDB_VISITED");
+    for (0 .. $#had_breakpoints) {
+        my %pf = get_list("PERLDB_FILE_$_");
+        $postponed_file{ $had_breakpoints[$_] } = \%pf if %pf;
+    }
+
+    # restore options
+    my %opt = get_list("PERLDB_OPT");
+    my ($opt, $val);
+    while (($opt, $val) = each %opt) {
+        $val =~ s/[\\\']/\\$1/g;
+        parse_options("$opt'$val'");
+    }
+
+    # restore original @INC
+    @INC       = get_list("PERLDB_INC");
+    @ini_INC   = @INC;
+
+    # return pre/postprompt actions and typeahead buffer
+    $pretype   = [get_list("PERLDB_PRETYPE")];
+    $pre       = [get_list("PERLDB_PRE")];
+    $post      = [get_list("PERLDB_POST")];
+    @typeahead = get_list("PERLDB_TYPEAHEAD", @typeahead);
+} ## end if (exists $ENV{PERLDB_RESTART...
+
+=head2 SETTING UP THE TERMINAL
+
+Now, we'll decide how the debugger is going to interact with the user.
+If there's no TTY, we set the debugger to run non-stop; there's not going
+to be anyone there to enter commands.
+
+=cut
 
 if ($notty) {
-  $runnonstop = 1;
-} else {
-  # Is Perl being run from a slave editor or graphical debugger?
-  $slave_editor = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
-  $rl = 0, shift(@main::ARGV) if $slave_editor;
-
-  #require Term::ReadLine;
-
-  if ($^O eq 'cygwin') {
-    # /dev/tty is binary. use stdin for textmode
-    undef $console;
-  } elsif (-e "/dev/tty") {
-    $console = "/dev/tty";
-  } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
-    $console = "con";
-  } elsif ($^O eq 'MacOS') {
-    if ($MacPerl::Version !~ /MPW/) {
-      $console = "Dev:Console:Perl Debug"; # Separate window for application
-    } else {
-      $console = "Dev:Console";
-    }
-  } else {
-    $console = "sys\$command";
-  }
-
-  if (($^O eq 'MSWin32') and ($slave_editor or defined $ENV{EMACS})) {
-    $console = undef;
-  }
-
-  if ($^O eq 'NetWare') {
-	$console = undef;
-  }
-
-  # Around a bug:
-  if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID})) { # In OS/2
-    $console = undef;
-  }
-
-  if ($^O eq 'epoc') {
-    $console = undef;
-  }
-
-  $console = $tty if defined $tty;
-
-  if (defined $remoteport) {
-    require IO::Socket;
-    $OUT = new IO::Socket::INET( Timeout  => '10',
-                                 PeerAddr => $remoteport,
-                                 Proto    => 'tcp',
-                               );
-    if (!$OUT) { die "Unable to connect to remote host: $remoteport\n"; }
-    $IN = $OUT;
-  } else {
-    create_IN_OUT(4) if $CreateTTY & 4;
-    if ($console) {
-      my ($i, $o) = split /,/, $console;
-      $o = $i unless defined $o;
-      open(IN,"+<$i") || open(IN,"<$i") || open(IN,"<&STDIN");
-      open(OUT,"+>$o") || open(OUT,">$o") || open(OUT,">&STDERR")
-        || open(OUT,">&STDOUT");	# so we don't dongle stdout
-    } elsif (not defined $console) {
-      open(IN,"<&STDIN");
-      open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
-      $console = 'STDIN/OUT';
-    }
-    # so open("|more") can read from STDOUT and so we don't dingle stdin
-    $IN = \*IN, $OUT = \*OUT if $console or not defined $console;
-  }
-  my $previous = select($OUT);
-  $| = 1;			# for DB::OUT
-  select($previous);
-
-  $LINEINFO = $OUT unless defined $LINEINFO;
-  $lineinfo = $console unless defined $lineinfo;
-
-  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
-  unless ($runnonstop) {
-    local $\ = '';
-    local $, = '';
-    if ($term_pid eq '-1') {
-      print $OUT "\nDaughter DB session started...\n";
-    } else {
-      print $OUT "\nLoading DB routines from $header\n";
-      print $OUT ("Editor support ",
-		  $slave_editor ? "enabled" : "available",
-		  ".\n");
-      print $OUT "\nEnter h or `h h' for help, or `$doccmd perldebug' for more help.\n\n";
-    }
-  }
+    $runnonstop = 1;
 }
 
+=pod
+
+If there is a TTY, we have to determine who it belongs to before we can
+proceed. If this is a slave editor or graphical debugger (denoted by
+the first command-line switch being '-emacs'), we shift this off and
+set C<$rl> to 0 (XXX ostensibly to do straight reads).
+
+=cut
+
+else {
+    # Is Perl being run from a slave editor or graphical debugger?
+    # If so, don't use readline, and set $slave_editor = 1.
+    $slave_editor =
+      ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
+    $rl = 0, shift (@main::ARGV) if $slave_editor;
+    #require Term::ReadLine;
+
+=pod
+
+We then determine what the console should be on various systems:
+
+=over 4
+
+=item * Cygwin - We use C<stdin> instead of a separate device.
+
+=cut
+
+
+    if ($^O eq 'cygwin') {
+        # /dev/tty is binary. use stdin for textmode
+        undef $console;
+    }
+
+=item * Unix - use C</dev/tty>.
+
+=cut
+
+    elsif (-e "/dev/tty") {
+        $console = "/dev/tty";
+    }
+
+=item * Windows or MSDOS - use C<con>.
+
+=cut
+
+    elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
+        $console = "con";
+    }
+
+=item * MacOS - use C<Dev:Console:Perl Debug> if this is the MPW version; C<Dev:
+Console> if not. (Note that Mac OS X returns 'darwin', not 'MacOS'. Also note that the debugger doesn't do anything special for 'darwin'. Maybe it should.)
+
+=cut
+
+    elsif ($^O eq 'MacOS') {
+        if ($MacPerl::Version !~ /MPW/) {
+            $console =
+              "Dev:Console:Perl Debug";    # Separate window for application
+        }
+        else {
+            $console = "Dev:Console";
+        }
+    } ## end elsif ($^O eq 'MacOS')
+
+=item * VMS - use C<sys$command>.
+
+=cut
+
+    else {
+        # everything else is ...
+        $console = "sys\$command";
+    }
+
+=pod
+
+=back
+
+Several other systems don't use a specific console. We C<undef $console>
+for those (Windows using a slave editor/graphical debugger, NetWare, OS/2
+with a slave editor, Epoc).
+
+=cut
+
+    if (($^O eq 'MSWin32') and ($slave_editor or defined $ENV{EMACS})) {
+        # /dev/tty is binary. use stdin for textmode
+        $console = undef;
+    }
+
+    if ($^O eq 'NetWare') {
+        # /dev/tty is binary. use stdin for textmode
+        $console = undef;
+    }
+
+    # In OS/2, we need to use STDIN to get textmode too, even though
+    # it pretty much looks like Unix otherwise.
+    if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID}))
+    {    # In OS/2
+        $console = undef;
+    }
+    # EPOC also falls into the 'got to use STDIN' camp.
+    if ($^O eq 'epoc') {
+        $console = undef;
+    }
+
+=pod
+
+If there is a TTY hanging around from a parent, we use that as the console.
+
+=cut
+
+    $console = $tty if defined $tty;
+
+=head2 SOCKET HANDLING   
+
+The debugger is capable of opening a socket and carrying out a debugging
+session over the socket.
+
+If C<RemotePort> was defined in the options, the debugger assumes that it
+should try to start a debugging session on that port. It builds the socket
+and then tries to connect the input and output filehandles to it.
+
+=cut
+
+    # Handle socket stuff.
+    if (defined $remoteport) {
+        # If RemotePort was defined in the options, connect input and output
+        # to the socket.
+        require IO::Socket;
+        $OUT = new IO::Socket::INET(
+            Timeout  => '10',
+            PeerAddr => $remoteport,
+            Proto    => 'tcp',
+            );
+        if (!$OUT) { die "Unable to connect to remote host: $remoteport\n"; }
+        $IN = $OUT;
+    } ## end if (defined $remoteport)
+
+=pod
+
+If no C<RemotePort> was defined, and we want to create a TTY on startup,
+this is probably a situation where multiple debuggers are running (for example,
+a backticked command that starts up another debugger). We create a new IN and
+OUT filehandle, and do the necessary mojo to create a new TTY if we know how
+and if we can.
+
+=cut
+
+    # Non-socket.
+    else {
+        # Two debuggers running (probably a system or a backtick that invokes
+        # the debugger itself under the running one). create a new IN and OUT
+        # filehandle, and do the necessary mojo to create a new tty if we 
+        # know how, and we can.
+        create_IN_OUT(4) if $CreateTTY & 4;
+        if ($console) {
+            # If we have a console, check to see if there are separate ins and
+            # outs to open. (They are assumed identiical if not.)
+            my ($i, $o) = split /,/, $console;
+            $o = $i unless defined $o;
+
+            # read/write on in, or just read, or read on STDIN.
+            open(IN, "+<$i") || 
+             open(IN, "<$i") || 
+              open(IN, "<&STDIN");
+
+            # read/write/create/clobber out, or write/create/clobber out,
+            # or merge with STDERR, or merge with STDOUT.
+            open(OUT,   "+>$o")     ||
+              open(OUT, ">$o")      ||
+              open(OUT, ">&STDERR") ||
+              open(OUT, ">&STDOUT");    # so we don't dongle stdout
+
+        } ## end if ($console)
+        elsif (not defined $console) {
+           # No console. Open STDIN.
+            open(IN,    "<&STDIN");
+
+           # merge with STDERR, or with STDOUT.
+            open(OUT,   ">&STDERR") ||
+              open(OUT, ">&STDOUT");     # so we don't dongle stdout
+
+            $console = 'STDIN/OUT';
+        } ## end elsif (not defined $console)
+
+        # Keep copies of the filehandles so that when the pager runs, it
+        # can close standard input without clobbering ours.
+        $IN = \*IN, $OUT = \*OUT if $console or not defined $console;
+    } ## end elsif (from if(defined $remoteport))
+
+    # Unbuffer DB::OUT. We need to see responses right away. 
+    my $previous = select($OUT);
+    $| = 1;                              # for DB::OUT
+    select($previous);
+
+    # Line info goes to debugger output unless pointed elsewhere.
+    # Pointing elsewhere makes it possible for slave editors to
+    # keep track of file and position. We have both a filehandle 
+    # and a I/O description to keep track of.
+    $LINEINFO = $OUT     unless defined $LINEINFO;
+    $lineinfo = $console unless defined $lineinfo;
+
+=pod
+
+To finish initialization, we show the debugger greeting,
+and then call the C<afterinit()> subroutine if there is one.
+
+=cut
+
+    # Show the debugger greeting.
+    $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+    unless ($runnonstop) {
+        local $\ = '';
+        local $, = '';
+        if ($term_pid eq '-1') {
+            print $OUT "\nDaughter DB session started...\n";
+        }
+        else {
+            print $OUT "\nLoading DB routines from $header\n";
+            print $OUT (
+                "Editor support ",
+                $slave_editor ? "enabled" : "available", ".\n"
+                );
+            print $OUT
+"\nEnter h or `h h' for help, or `$doccmd perldebug' for more help.\n\n";
+        } ## end else [ if ($term_pid eq '-1')
+    } ## end unless ($runnonstop)
+} ## end else [ if ($notty)
+
+# XXX This looks like a bug to me.
+# Why copy to @ARGS and then futz with @args?
 @ARGS = @ARGV;
 for (@args) {
+    # Make sure backslashes before single quotes are stripped out, and
+    # keep args unless they are numeric (XXX why?)
     s/\'/\\\'/g;
     s/(.*)/'$1'/ unless /^-?[\d.]+$/;
 }
 
-if (defined &afterinit) {	# May be defined in $rcfile
-  &afterinit();
+# If there was an afterinit() sub defined, call it. It will get 
+# executed in our scope, so it can fiddle with debugger globals.
+if (defined &afterinit) {    # May be defined in $rcfile
+    &afterinit();
 }
-
+# Inform us about "Stack dump during die enabled ..." in dieLevel().
 $I_m_init = 1;
 
 ############################################################ Subroutines
 
+=head1 SUBROUTINES
+
+=head2 DB
+
+This gigantic subroutine is the heart of the debugger. Called before every
+statement, its job is to determine if a breakpoint has been reached, and
+stop if so; read commands from the user, parse them, and execute
+them, and hen send execution off to the next statement.
+
+Note that the order in which the commands are processed is very important;
+some commands earlier in the loop will actually alter the C<$cmd> variable
+to create other commands to be executed later. This is all highly "optimized"
+but can be confusing. Check the comments for each C<$cmd ... && do {}> to
+see what's happening in any given command.
+
+=cut
+
 sub DB {
+
+    # Check for whether we should be running continuously or not.
     # _After_ the perl program is compiled, $single is set to 1:
     if ($single and not $second_time++) {
-      if ($runnonstop) {	# Disable until signal
-	for ($i=0; $i <= $stack_depth; ) {
-	    $stack[$i++] &= ~1;
-	}
-	$single = 0;
-	# return;			# Would not print trace!
-      } elsif ($ImmediateStop) {
-	$ImmediateStop = 0;
-	$signal = 1;
-      }
-    }
-    $runnonstop = 0 if $single or $signal; # Disable it if interactive.
+        # Options say run non-stop. Run until we get an interrupt.
+        if ($runnonstop) {    # Disable until signal
+            # If there's any call stack in place, turn off single
+            # stepping into subs throughout the stack.
+            for ($i = 0 ; $i <= $stack_depth ;) {
+                $stack[$i++] &= ~1;
+            }
+            # And we are now no longer in single-step mode.
+            $single = 0;
+
+            # If we simply returned at this point, we wouldn't get
+            # the trace info. Fall on through.
+            # return; 
+        } ## end if ($runnonstop)
+
+        elsif ($ImmediateStop) {
+            # We are supposed to stop here; XXX probably a break. 
+            $ImmediateStop = 0;               # We've processed it; turn it off
+            $signal        = 1;               # Simulate an interrupt to force
+                                              # us into the command loop
+        }
+    } ## end if ($single and not $second_time...
+
+    # If we're in single-step mode, or an interrupt (real or fake)
+    # has occurred, turn off non-stop mode.
+    $runnonstop = 0 if $single or $signal;
+
+    # Preserve current values of $@, $!, $^E, $,, $/, $\, $^W.
+    # The code being debugged may have altered them.
     &save;
-    local($package, $filename, $line) = caller;
+
+    # Since DB::DB gets called after every line, we can use caller() to
+    # figure out where we last were executing. Sneaky, eh? This works because
+    # caller is returning all the extra information when called from the 
+    # debugger.
+    local ($package, $filename, $line) = caller;
     local $filename_ini = $filename;
-    local $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
-      "package $package;";	# this won't let them modify, alas
-    local(*dbline) = $main::{'_<' . $filename};
+
+    # set up the context for DB::eval, so it can properly execute
+    # code on behalf of the user. We add the package in so that the
+    # code is eval'ed in the proper package (not in the debugger!).
+    local $usercontext  =
+      '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
+      "package $package;"; 
+
+    # Create an alias to the active file magical array to simplify
+    # the code here.
+    local (*dbline) = $main::{ '_<' . $filename };
 
     # we need to check for pseudofiles on Mac OS (these are files
     # not attached to a filename, but instead stored in Dev:Pseudo)
     if ($^O eq 'MacOS' && $#dbline < 0) {
-	$filename_ini = $filename = 'Dev:Pseudo';
-	*dbline = $main::{'_<' . $filename};
+        $filename_ini = $filename = 'Dev:Pseudo';
+        *dbline = $main::{ '_<' . $filename };
     }
 
+    # Last line in the program.
     local $max = $#dbline;
-    if ($dbline{$line} && (($stop,$action) = split(/\0/,$dbline{$line}))) {
-		if ($stop eq '1') {
-			$signal |= 1;
-		} elsif ($stop) {
-			$evalarg = "\$DB::signal |= 1 if do {$stop}"; &eval;
-			$dbline{$line} =~ s/;9($|\0)/$1/;
-		}
-    }
+
+    # if we have something here, see if we should break.
+    if ($dbline{$line} && (($stop, $action) = split (/\0/, $dbline{$line}))) {
+        # Stop if the stop criterion says to just stop.
+        if ($stop eq '1') {
+            $signal |= 1;
+        }
+        # It's a conditional stop; eval it in the user's context and
+        # see if we should stop. If so, remove the one-time sigil.
+        elsif ($stop) {
+            $evalarg = "\$DB::signal |= 1 if do {$stop}";
+            &eval;
+            $dbline{$line} =~ s/;9($|\0)/$1/;
+        }
+    } ## end if ($dbline{$line} && ...
+
+    # Preserve the current stop-or-not, and see if any of the W
+    # (watch expressions) has changed.
     my $was_signal = $signal;
+
+    # If we have any watch expressions ...
     if ($trace & 2) {
-      for (my $n = 0; $n <= $#to_watch; $n++) {
-		$evalarg = $to_watch[$n];
-		local $onetimeDump;	# Do not output results
-		my ($val) = &eval;	# Fix context (&eval is doing array)?
-		$val = ( (defined $val) ? "'$val'" : 'undef' );
-		if ($val ne $old_watch[$n]) {
-		  $signal = 1;
-		  print $OUT <<EOP;
+        for (my $n = 0 ; $n <= $#to_watch ; $n++) {
+            $evalarg = $to_watch[$n];
+            local $onetimeDump;    # Tell DB::eval() to not output results
+
+            # Fix context DB::eval() wants to return an array, but
+            # we need a scalar here.
+            my ($val) =
+              join ( "', '", &eval );
+            $val = ((defined $val) ? "'$val'" : 'undef');
+
+            # Did it change?
+            if ($val ne $old_watch[$n]) {
+                # Yep! Show the difference, and fake an interrupt.
+                $signal = 1;
+                print $OUT <<EOP;
 Watchpoint $n:\t$to_watch[$n] changed:
 	old value:\t$old_watch[$n]
 	new value:\t$val
 EOP
-		  $old_watch[$n] = $val;
-		}
-      }
-    }
-    if ($trace & 4) {		# User-installed watch
-      return if watchfunction($package, $filename, $line) 
-	and not $single and not $was_signal and not ($trace & ~4);
-    }
+                $old_watch[$n] = $val;
+            } ## end if ($val ne $old_watch...
+        } ## end for (my $n = 0 ; $n <= ...
+    } ## end if ($trace & 2)
+
+=head2 C<watchfunction()>
+
+C<watchfunction()> is a function that can be defined by the user; it is a
+function which will be run on each entry to C<DB::DB>; it gets the 
+current package, filename, and line as its parameters.
+
+The watchfunction can do anything it likes; it is executing in the 
+debugger's context, so it has access to all of the debugger's internal
+data structures and functions.
+
+C<watchfunction()> can control the debugger's actions. Any of the following
+will cause the debugger to return control to the user's program after
+C<watchfunction()> executes:
+
+=over 4 
+
+=item * Returning a false value from the C<watchfunction()> itself.
+
+=item * Altering C<$single> to a false value.
+
+=item * Altering C<$signal> to a false value.
+
+=item *  Turning off the '4' bit in C<$trace> (this also disables the
+check for C<watchfunction()>. This can be done with
+
+    $trace &= ~4;
+
+=back
+
+=cut
+
+    # If there's a user-defined DB::watchfunction, call it with the 
+    # current package, filename, and line. The function executes in
+    # the DB:: package.
+    if ($trace & 4) {    # User-installed watch
+        return
+          if watchfunction($package, $filename, $line)
+          and not $single
+          and not $was_signal
+          and not($trace & ~4);
+    } ## end if ($trace & 4)
+
+
+    # Pick up any alteration to $signal in the watchfunction, and 
+    # turn off the signal now.
     $was_signal = $signal;
-    $signal = 0;
+    $signal     = 0;
+
+=head2 GETTING READY TO EXECUTE COMMANDS
+
+The debugger decides to take control if single-step mode is on, the
+C<t> command was entered, or the user generated a signal. If the program
+has fallen off the end, we set things up so that entering further commands
+won't cause trouble, and we say that the program is over.
+
+=cut
+
+    # Check to see if we should grab control ($single true,
+    # trace set appropriately, or we got a signal).
     if ($single || ($trace & 1) || $was_signal) {
-	if ($slave_editor) {
-	    $position = "\032\032$filename:$line:0\n";
-	    print_lineinfo($position);
-	} elsif ($package eq 'DB::fake') {
-	  $term || &setterm;
-	  print_help(<<EOP);
+        # Yes, grab control.
+        if ($slave_editor) {
+            # Tell the editor to update its position.
+            $position = "\032\032$filename:$line:0\n";
+            print_lineinfo($position);
+        }
+
+=pod
+
+Special check: if we're in package C<DB::fake>, we've gone through the 
+C<END> block at least once. We set up everything so that we can continue
+to enter commands and have a valid context to be in.
+
+=cut
+
+        elsif ($package eq 'DB::fake') {
+            # Fallen off the end already.
+            $term || &setterm;
+            print_help(<<EOP);
 Debugged program terminated.  Use B<q> to quit or B<R> to restart,
   use B<O> I<inhibit_exit> to avoid stopping after program termination,
   B<h q>, B<h R> or B<h O> to get additional info.  
 EOP
-	  $package = 'main';
-	  $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
-	    "package $package;";	# this won't let them modify, alas
-	} else {
-	    $sub =~ s/\'/::/;
-	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
-	    $prefix .= "$sub($filename:";
-	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
-	    if (length($prefix) > 30) {
-	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
-			$prefix = "";
-			$infix = ":\t";
-	    } else {
-			$infix = "):\t";
-			$position = "$prefix$line$infix$dbline[$line]$after";
-	    }
-	    if ($frame) {
-			print_lineinfo(' ' x $stack_depth, "$line:\t$dbline[$line]$after");
-	    } else {
-			print_lineinfo($position);
-	    }
-	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
-			last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
-			last if $signal;
-			$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
-			$incr_pos = "$prefix$i$infix$dbline[$i]$after";
-			$position .= $incr_pos;
-			if ($frame) {
-				print_lineinfo(' ' x $stack_depth, "$i:\t$dbline[$i]$after");
-			} else {
-				print_lineinfo($incr_pos);
-			}
-	    }
-	}
-    }
+
+            # Set the DB::eval context appropriately.
+            $package     = 'main';
+            $usercontext =
+              '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
+              "package $package;";    # this won't let them modify, alas
+        } ## end elsif ($package eq 'DB::fake')
+
+=pod
+
+If the program hasn't finished executing, we scan forward to the
+next executable line, print that out, build the prompt from the file and line
+number information, and print that.   
+
+=cut
+
+        else {
+            # Still somewhere in the midst of execution. Set up the
+            #  debugger prompt.
+            $sub =~ s/\'/::/;    # Swap Perl 4 package separators (') to
+                                 # Perl 5 ones (sorry, we don't print Klingon 
+                                 #module names)
+
+            $prefix = $sub =~ /::/ ? "" : "${'package'}::";
+            $prefix .= "$sub($filename:";
+            $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
+
+            # Break up the prompt if it's really long.
+            if (length($prefix) > 30) {
+                $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+                $prefix   = "";
+                $infix    = ":\t";
+            }
+            else {
+                $infix    = "):\t";
+                $position = "$prefix$line$infix$dbline[$line]$after";
+            }
+
+            # Print current line info, indenting if necessary.
+            if ($frame) {
+                print_lineinfo(' ' x $stack_depth,
+                    "$line:\t$dbline[$line]$after");
+            }
+            else {
+                print_lineinfo($position);
+            }
+
+            # Scan forward, stopping at either the end or the next
+            # unbreakable line.
+            for ($i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i)
+            {    #{ vi
+
+                # Drop out on null statements, block closers, and comments.
+                last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+
+                # Drop out if the user interrupted us.
+                last if $signal;
+               
+                # Append a newline if the line doesn't have one. Can happen
+                # in eval'ed text, for instance.
+                $after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
+
+                # Next executable line.
+                $incr_pos = "$prefix$i$infix$dbline[$i]$after";
+                $position .= $incr_pos;
+                if ($frame) {
+                    # Print it indented if tracing is on.
+                    print_lineinfo(' ' x $stack_depth,
+                        "$i:\t$dbline[$i]$after");
+                }
+                else {
+                    print_lineinfo($incr_pos);
+                }
+            } ## end for ($i = $line + 1 ; $i...
+        } ## end else [ if ($slave_editor)
+    } ## end if ($single || ($trace...
+
+=pod
+
+If there's an action to be executed for the line we stopped at, execute it.
+If there are any preprompt actions, execute those as well.      
+
+=cut
+
+    # If there's an action, do it now.
     $evalarg = $action, &eval if $action;
+
+    # Are we nested another level (e.g., did we evaluate a function
+    # that had a breakpoint in it at the debugger prompt)?
     if ($single || $was_signal) {
-	  local $level = $level + 1;
-	  foreach $evalarg (@$pre) {
-	    &eval;
-	  }
-	  print $OUT $stack_depth . " levels deep in subroutine calls!\n"
-              if $single & 4;
-		$start = $line;
-		$incr = -1;		# for backward motion.
-		@typeahead = (@$pretype, @typeahead);
-    CMD:
-	while (($term || &setterm),
-	       ($term_pid == $$ or resetterm(1)),
-	       defined ($cmd=&readline("$pidprompt  DB" . ('<' x $level) .
-				       ($#hist+1) . ('>' x $level) . " "))) 
+        # Yes, go down a level.
+        local $level = $level + 1;
+
+        # Do any pre-prompt actions.
+        foreach $evalarg (@$pre) {
+            &eval;
+        }
+
+        # Complain about too much recursion if we passed the limit.
+        print $OUT $stack_depth . " levels deep in subroutine calls!\n"
+          if $single & 4;
+
+        # The line we're currently on. Set $incr to -1 to stay here
+        # until we get a command that tells us to advance.
+        $start     = $line;
+        $incr      = -1;                        # for backward motion.
+
+        # Tack preprompt debugger actions ahead of any actual input.
+        @typeahead = (@$pretype, @typeahead);
+
+=head2 WHERE ARE WE?
+
+XXX Relocate this section?
+
+The debugger normally shows the line corresponding to the current line of
+execution. Sometimes, though, we want to see the next line, or to move elsewhere
+in the file. This is done via the C<$incr>, C<$start>, and C<$max> variables.
+
+C<$incr> controls by how many lines the "current" line should move forward
+after a command is executed. If set to -1, this indicates that the "current"
+line shouldn't change.
+
+C<$start> is the "current" line. It is used for things like knowing where to
+move forwards or backwards from when doing an C<L> or C<-> command.
+
+C<$max> tells the debugger where the last line of the current file is. It's
+used to terminate loops most often.
+
+=head2 THE COMMAND LOOP
+
+Most of C<DB::DB> is actually a command parsing and dispatch loop. It comes
+in two parts:
+
+=over 4
+
+=item * The outer part of the loop, starting at the C<CMD> label. This loop
+reads a command and then executes it.
+
+=item * The inner part of the loop, starting at the C<PIPE> label. This part
+is wholly contained inside the C<CMD> block and only executes a command.
+Used to handle commands running inside a pager.
+
+=back
+
+So why have two labels to restart the loop? Because sometimes, it's easier to
+have a command I<generate> another command and then re-execute the loop to do
+the new command. This is faster, but perhaps a bit more convoluted.
+
+=cut
+
+        # The big command dispatch loop. It keeps running until the
+        # user yields up control again.
+        #
+        # If we have a terminal for input, and we get something back
+        # from readline(), keep on processing.
+      CMD:
+        while (
+            # We have a terminal, or can get one ...
+            ($term || &setterm),
+            # ... and it belogs to this PID or we get one for this PID ...
+            ($term_pid == $$ or resetterm(1)),
+            # ... and we got a line of command input ...
+            defined(
+                $cmd = &readline(
+                    "$pidprompt  DB" . ('<' x $level) . ($#hist + 1) .
+                      ('>' x $level) . " "
+                )
+            )
+          )
         {
-		$single = 0;
-		$signal = 0;
-		$cmd =~ s/\\$/\n/ && do {
-		    $cmd .= &readline("  cont: ");
-		    redo CMD;
-		};
-		$cmd =~ /^$/ && ($cmd = $laststep);
-		push(@hist,$cmd) if length($cmd) > 1;
-	      PIPE: {
-		    $cmd =~ s/^\s+//s;   # trim annoying leading whitespace
-		    $cmd =~ s/\s+$//s;   # trim annoying trailing whitespace
-		    ($i) = split(/\s+/,$cmd);
-		    if ($alias{$i}) { 
-					# squelch the sigmangler
-					local $SIG{__DIE__};
-					local $SIG{__WARN__};
-					eval "\$cmd =~ $alias{$i}";
-					if ($@) {
-                                                local $\ = '';
-						print $OUT "Couldn't evaluate `$i' alias: $@";
-						next CMD;
-					} 
-		    }
-                    $cmd =~ /^q$/ && do {
-                        $fall_off_end = 1;
-                        clean_ENV();
-                        exit $?;
-                    };
-		    $cmd =~ /^t$/ && do {
-			$trace ^= 1;
-			local $\ = '';
-			print $OUT "Trace = " .
-			    (($trace & 1) ? "on" : "off" ) . "\n";
-			next CMD; };
-		    $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
-			$Srev = defined $2; $Spatt = $3; $Snocheck = ! defined $1;
-			local $\ = '';
-			local $, = '';
-			foreach $subname (sort(keys %sub)) {
-			    if ($Snocheck or $Srev^($subname =~ /$Spatt/)) {
-				print $OUT $subname,"\n";
-			    }
-			}
-			next CMD; };
-		    $cmd =~ s/^X\b/V $package/;
-		    $cmd =~ /^V$/ && do {
-			$cmd = "V $package"; };
-		    $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
-			local ($savout) = select($OUT);
-			$packname = $1;
-			@vars = split(' ',$2);
-			do 'dumpvar.pl' unless defined &main::dumpvar;
-			if (defined &main::dumpvar) {
-			    local $frame = 0;
-			    local $doret = -2;
-			    # must detect sigpipe failures
-                           eval { &main::dumpvar($packname,
-                                                 defined $option{dumpDepth}
-                                                  ? $option{dumpDepth} : -1,
-                                                 @vars) };
-			    if ($@) {
-				die unless $@ =~ /dumpvar print failed/;
-			    } 
-			} else {
-			    print $OUT "dumpvar.pl not available.\n";
-			}
-			select ($savout);
-			next CMD; };
-		    $cmd =~ s/^x\b/ / && do { # So that will be evaled
-			$onetimeDump = 'dump'; 
-                        # handle special  "x 3 blah" syntax
-                        if ($cmd =~ s/^\s*(\d+)(?=\s)/ /) {
-                          $onetimedumpDepth = $1;
+            # ... try to execute the input as debugger commands.
+
+            # Don't stop running.
+            $single = 0;
+
+            # No signal is active.
+            $signal = 0;
+
+            # Handle continued commands (ending with \):
+            $cmd =~ s/\\$/\n/ && do {
+                $cmd .= &readline("  cont: ");
+                redo CMD;
+            };
+
+=head4 The null command
+
+A newline entered by itself means "re-execute the last command". We grab the
+command out of C<$laststep> (where it was recorded previously), and copy it
+back into C<$cmd> to be executed below. If there wasn't any previous command,
+we'll do nothing below (no command will match). If there was, we also save it
+in the command history and fall through to allow the command parsing to pick
+it up.
+
+=cut
+
+            # Empty input means repeat the last command.
+            $cmd =~ /^$/ && ($cmd = $laststep);
+            push (@hist, $cmd) if length($cmd) > 1;
+
+
+          # This is a restart point for commands that didn't arrive
+          # via direct user input. It allows us to 'redo PIPE' to
+          # re-execute command processing without reading a new command.
+          PIPE: {
+                $cmd =~ s/^\s+//s;    # trim annoying leading whitespace
+                $cmd =~ s/\s+$//s;    # trim annoying trailing whitespace
+                ($i) = split (/\s+/, $cmd);
+
+=head3 COMMAND ALIASES
+
+The debugger can create aliases for commands (these are stored in the
+C<%alias> hash). Before a command is executed, the command loop looks it up
+in the alias hash and substitutes the contents of the alias for the command,
+completely replacing it.
+
+=cut
+
+                # See if there's an alias for the command, and set it up if so.
+                if ($alias{$i}) {
+                    # Squelch signal handling; we want to keep control here
+                    # if something goes loco during the alias eval.
+                    local $SIG{__DIE__};
+                    local $SIG{__WARN__};
+
+                    # This is a command, so we eval it in the DEBUGGER's
+                    # scope! Otherwise, we can't see the special debugger
+                    # variables, or get to the debugger's subs. (Well, we
+                    # _could_, but why make it even more complicated?)
+                    eval "\$cmd =~ $alias{$i}";
+                    if ($@) {
+                        local $\ = '';
+                        print $OUT "Couldn't evaluate `$i' alias: $@";
+                        next CMD;
+                    }
+                } ## end if ($alias{$i})
+
+=head3 MAIN-LINE COMMANDS
+
+All of these commands work up to and after the program being debugged has
+terminated. 
+
+=head4 C<q> - quit
+
+Quit the debugger. This entails setting the C<$fall_off_end> flag, so we don't 
+try to execute further, cleaning any restart-related stuff out of the
+environment, and executing with the last value of C<$?>.
+
+=cut
+
+                $cmd =~ /^q$/ && do {
+                    $fall_off_end = 1;
+                    clean_ENV();
+                    exit $?;
+                };
+
+=head4 C<t> - trace
+
+Turn tracing on or off. Inverts the appropriate bit in C<$trace> (q.v.).
+
+=cut
+
+                $cmd =~ /^t$/ && do {
+                    $trace ^= 1;
+                    local $\ = '';
+                    print $OUT "Trace = " . (($trace & 1) ? "on" : "off") .
+                      "\n";
+                    next CMD;
+                };
+
+=head4 C<S> - list subroutines matching/not matching a pattern
+
+Walks through C<%sub>, checking to see whether or not to print the name.
+
+=cut
+
+                $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
+
+                    $Srev     = defined $2;     # Reverse scan? 
+                    $Spatt    = $3;             # The pattern (if any) to use.
+                    $Snocheck = !defined $1;    # No args - print all subs.
+
+                    # Need to make these sane here.
+                    local $\ = '';
+                    local $, = '';
+
+                    # Search through the debugger's magical hash of subs.
+                    # If $nocheck is true, just print the sub name.
+                    # Otherwise, check it against the pattern. We then use
+                    # the XOR trick to reverse the condition as required.
+                    foreach $subname (sort(keys %sub)) {
+                        if ($Snocheck or $Srev ^ ($subname =~ /$Spatt/)) {
+                            print $OUT $subname, "\n";
+                        }
+                    }
+                    next CMD;
+                };
+
+=head4 C<X> - list variables in current package
+
+Since the C<V> command actually processes this, just change this to the 
+appropriate C<V> command and fall through.
+
+=cut
+
+                $cmd =~ s/^X\b/V $package/;
+
+=head4 C<V> - list variables
+
+Uses C<dumpvar.pl> to dump out the current values for selected variables. 
+
+=cut
+
+                # Bare V commands get the currently-being-debugged package
+                # added.
+                $cmd =~ /^V$/ && do {
+                    $cmd = "V $package";
+                };
+
+
+                # V - show variables in package.
+                $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+                    # Save the currently selected filehandle and
+                    # force output to debugger's filehandle (dumpvar
+                    # just does "print" for output).
+                    local ($savout) = select($OUT);
+
+                    # Grab package name and variables to dump.
+                    $packname = $1;
+                    @vars = split (' ', $2);
+
+                    # If main::dumpvar isn't here, get it.
+                    do 'dumpvar.pl' unless defined &main::dumpvar;
+                    if (defined &main::dumpvar) {
+                        # We got it. Turn off subroutine entry/exit messages
+                        # for the moment, along with return values.
+                        local $frame = 0;
+                        local $doret = -2;
+
+                        # must detect sigpipe failures  - not catching
+                        # then will cause the debugger to die.
+                        eval {
+                            &main::dumpvar(
+                                $packname,
+                                defined $option{dumpDepth}
+                                ? $option{dumpDepth}
+                                : -1,          # assume -1 unless specified
+                                @vars
+                                );
+                        };
+
+                        # The die doesn't need to include the $@, because 
+                        # it will automatically get propagated for us.
+                        if ($@) {
+                            die unless $@ =~ /dumpvar print failed/;
                         }
-                      };
-		    $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
-			methods($1); next CMD};
-		    $cmd =~ s/^m\b/ / && do { # So this will be evaled
-			$onetimeDump = 'methods'; };
-		    $cmd =~ /^f\b\s*(.*)/ && do {
-			$file = $1;
-			$file =~ s/\s+$//;
-			if (!$file) {
-			    print $OUT "The old f command is now the r command.\n"; # hint
-			    print $OUT "The new f command switches filenames.\n";
-			    next CMD;
-			}
-			if (!defined $main::{'_<' . $file}) {
-			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
-					      $try = substr($try,2);
-					      print $OUT "Choosing $try matching `$file':\n";
-					      $file = $try;
-					  }}
-			}
-			if (!defined $main::{'_<' . $file}) {
-			    print $OUT "No file matching `$file' is loaded.\n";
-			    next CMD;
-			} elsif ($file ne $filename) {
-			    *dbline = $main::{'_<' . $file};
-			    $max = $#dbline;
-			    $filename = $file;
-			    $start = 1;
-			    $cmd = "l";
-			  } else {
-			    print $OUT "Already in $file.\n";
-			    next CMD;
-			  }
-		      };
-		    $cmd =~ /^\.$/ && do {
-			$incr = -1;		# for backward motion.
-			$start = $line;
-			$filename = $filename_ini;
-			*dbline = $main::{'_<' . $filename};
-			$max = $#dbline;
-			print_lineinfo($position);
-			next CMD };
-		    $cmd =~ /^-$/ && do {
-			$start -= $incr + $window + 1;
-			$start = 1 if $start <= 0;
-			$incr = $window - 1;
-			$cmd = 'l ' . ($start) . '+'; };
-			# rjsf ->
-		  $cmd =~ /^([aAbBhlLMoOvwW])\b\s*(.*)/s && do { 
-				&cmd_wrapper($1, $2, $line); 
-				next CMD; 
-			};
-			# <- rjsf
-		  $cmd =~ /^\<\<\s*(.*)/ && do { # \<\< for CPerl sake: not HERE
-			push @$pre, action($1);
-			next CMD; };
-		    $cmd =~ /^>>\s*(.*)/ && do {
-			push @$post, action($1);
-			next CMD; };
-		    $cmd =~ /^<\s*(.*)/ && do {
-			unless ($1) {
-			    print $OUT "All < actions cleared.\n";
-			    $pre = [];
-			    next CMD;
-			} 
-			if ($1 eq '?') {
-			    unless (@$pre) {
-				print $OUT "No pre-prompt Perl actions.\n";
-				next CMD;
-			    } 
-			    print $OUT "Perl commands run before each prompt:\n";
-			    for my $action ( @$pre ) {
-				print $OUT "\t< -- $action\n";
-			    } 
-			    next CMD;
-			} 
-			$pre = [action($1)];
-			next CMD; };
-		    $cmd =~ /^>\s*(.*)/ && do {
-			unless ($1) {
-			    print $OUT "All > actions cleared.\n";
-			    $post = [];
-			    next CMD;
-			}
-			if ($1 eq '?') {
-			    unless (@$post) {
-				print $OUT "No post-prompt Perl actions.\n";
-				next CMD;
-			    } 
-			    print $OUT "Perl commands run after each prompt:\n";
-			    for my $action ( @$post ) {
-				print $OUT "\t> -- $action\n";
-			    } 
-			    next CMD;
-			} 
-			$post = [action($1)];
-			next CMD; };
-		    $cmd =~ /^\{\{\s*(.*)/ && do {
-			if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,2))) { 
-			    print $OUT "{{ is now a debugger command\n",
-				"use `;{{' if you mean Perl code\n";
-			    $cmd = "h {{";
-			    redo CMD;
-			} 
-			push @$pretype, $1;
-			next CMD; };
-		    $cmd =~ /^\{\s*(.*)/ && do {
-			unless ($1) {
-			    print $OUT "All { actions cleared.\n";
-			    $pretype = [];
-			    next CMD;
-			}
-			if ($1 eq '?') {
-			    unless (@$pretype) {
-				print $OUT "No pre-prompt debugger actions.\n";
-				next CMD;
-			    } 
-			    print $OUT "Debugger commands run before each prompt:\n";
-			    for my $action ( @$pretype ) {
-				print $OUT "\t{ -- $action\n";
-			    } 
-			    next CMD;
-			} 
-			if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,1))) { 
-			    print $OUT "{ is now a debugger command\n",
-				"use `;{' if you mean Perl code\n";
-			    $cmd = "h {";
-			    redo CMD;
-			} 
-			$pretype = [$1];
-			next CMD; };
-                   $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/ && do {
-                       eval { require PadWalker; PadWalker->VERSION(0.08) }
-                         or &warn($@ =~ /locate/
-                            ? "PadWalker module not found - please install\n"
-                            : $@)
-                          and next CMD;
-                       do 'dumpvar.pl' unless defined &main::dumpvar;
-                       defined &main::dumpvar
-                          or print $OUT "dumpvar.pl not available.\n"
-                          and next CMD;
-                       my @vars = split(' ', $2 || '');
-                       my $h = eval { PadWalker::peek_my(($1 || 0) + 1) };
-                       $@ and $@ =~ s/ at .*//, &warn($@), next CMD;
-                       my $savout = select($OUT);
-                       dumpvar::dumplex($_, $h->{$_}, 
-                                       defined $option{dumpDepth}
-                                       ? $option{dumpDepth} : -1,
-                                       @vars)
-                           for sort keys %$h;
-                       select($savout);
-                       next CMD; };
-                   $cmd =~ /^n$/ && do {
-		        end_report(), next CMD if $finished and $level <= 1;
-			$single = 2;
-			$laststep = $cmd;
-			last CMD; };
-		    $cmd =~ /^s$/ && do {
-		        end_report(), next CMD if $finished and $level <= 1;
-			$single = 1;
-			$laststep = $cmd;
-			last CMD; };
-		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
-		        end_report(), next CMD if $finished and $level <= 1;
-			$subname = $i = $1;
-			#  Probably not needed, since we finish an interactive
-			#  sub-session anyway...
-			# local $filename = $filename;
-			# local *dbline = *dbline;	# XXX Would this work?!
-			if ($subname =~ /\D/) { # subroutine name
-			    $subname = $package."::".$subname 
-			        unless $subname =~ /::/;
-			    ($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
-			    $i += 0;
-			    if ($i) {
-			        $filename = $file;
-				*dbline = $main::{'_<' . $filename};
-				$had_breakpoints{$filename} |= 1;
-				$max = $#dbline;
-				++$i while $dbline[$i] == 0 && $i < $max;
-			    } else {
-				print $OUT "Subroutine $subname not found.\n";
-				next CMD; 
-			    }
-			}
-			if ($i) {
-			    if ($dbline[$i] == 0) {
-				print $OUT "Line $i not breakable.\n";
-				next CMD;
-			    }
-			    $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
-			}
-			for ($i=0; $i <= $stack_depth; ) {
-			    $stack[$i++] &= ~1;
-			}
-			last CMD; };
-		    $cmd =~ /^r$/ && do {
-		        end_report(), next CMD if $finished and $level <= 1;
-			$stack[$stack_depth] |= 1;
-			$doret = $option{PrintRet} ? $stack_depth - 1 : -2;
-			last CMD; };
-		    $cmd =~ /^R$/ && do {
-		        print $OUT "Warning: some settings and command-line options may be lost!\n";
-			my (@script, @flags, $cl);
-			push @flags, '-w' if $ini_warn;
-			# Put all the old includes at the start to get
-			# the same debugger.
-			for (@ini_INC) {
-			  push @flags, '-I', $_;
-			}
-			push @flags, '-T' if ${^TAINT};
-			# Arrange for setting the old INC:
-			set_list("PERLDB_INC", @ini_INC);
-			if ($0 eq '-e') {
-			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
-			        chomp ($cl =  ${'::_<-e'}[$_]);
-			    push @script, '-e', $cl;
-			  }
-			} else {
-			  @script = $0;
-			}
-			set_list("PERLDB_HIST", 
-				 $term->Features->{getHistory} 
-				 ? $term->GetHistory : @hist);
-			my @had_breakpoints = keys %had_breakpoints;
-			set_list("PERLDB_VISITED", @had_breakpoints);
-			set_list("PERLDB_OPT", %option);
-			set_list("PERLDB_ON_LOAD", %break_on_load);
-			my @hard;
-			for (0 .. $#had_breakpoints) {
-			  my $file = $had_breakpoints[$_];
-			  *dbline = $main::{'_<' . $file};
-			  next unless %dbline or $postponed_file{$file};
-			  (push @hard, $file), next 
-			    if $file =~ /^\(\w*eval/;
-			  my @add;
-			  @add = %{$postponed_file{$file}}
-			    if $postponed_file{$file};
-			  set_list("PERLDB_FILE_$_", %dbline, @add);
-			}
-			for (@hard) { # Yes, really-really...
-			  # Find the subroutines in this eval
-			  *dbline = $main::{'_<' . $_};
-			  my ($quoted, $sub, %subs, $line) = quotemeta $_;
-			  for $sub (keys %sub) {
-			    next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
-			    $subs{$sub} = [$1, $2];
-			  }
-			  unless (%subs) {
-			    print $OUT
-			      "No subroutines in $_, ignoring breakpoints.\n";
-			    next;
-			  }
-			LINES: for $line (keys %dbline) {
-			    # One breakpoint per sub only:
-			    my ($offset, $sub, $found);
-			  SUBS: for $sub (keys %subs) {
-			      if ($subs{$sub}->[1] >= $line # Not after the subroutine
-				  and (not defined $offset # Not caught
-				       or $offset < 0 )) { # or badly caught
-				$found = $sub;
-				$offset = $line - $subs{$sub}->[0];
-				$offset = "+$offset", last SUBS if $offset >= 0;
-			      }
-			    }
-			    if (defined $offset) {
-			      $postponed{$found} =
-				"break $offset if $dbline{$line}";
-			    } else {
-			      print $OUT "Breakpoint in $_:$line ignored: after all the subroutines.\n";
-			    }
-			  }
-			}
-			set_list("PERLDB_POSTPONE", %postponed);
-			set_list("PERLDB_PRETYPE", @$pretype);
-			set_list("PERLDB_PRE", @$pre);
-			set_list("PERLDB_POST", @$post);
-			set_list("PERLDB_TYPEAHEAD", @typeahead);
-			$ENV{PERLDB_RESTART} = 1;
-			delete $ENV{PERLDB_PIDS}; # Restore ini state
-			$ENV{PERLDB_PIDS} = $ini_pids if defined $ini_pids;
-			#print "$^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS";
-			exec($^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS) ||
-			print $OUT "exec failed: $!\n";
-			last CMD; };
-		    $cmd =~ /^T$/ && do {
-			print_trace($OUT, 1); # skip DB
-			next CMD; };
-		    $cmd =~ /^w\b\s*(.*)/s && do { &cmd_w($1); next CMD; };
-		    $cmd =~ /^W\b\s*(.*)/s && do { &cmd_W($1); next CMD; };
-		    $cmd =~ /^\/(.*)$/ && do {
-			$inpat = $1;
-			$inpat =~ s:([^\\])/$:$1:;
-			if ($inpat ne "") {
-			    # squelch the sigmangler
-			    local $SIG{__DIE__};
-			    local $SIG{__WARN__};
-			    eval '$inpat =~ m'."\a$inpat\a";	
-			    if ($@ ne "") {
-				print $OUT "$@";
-				next CMD;
-			    }
-			    $pat = $inpat;
-			}
-			$end = $start;
-			$incr = -1;
-			eval '
-			    for (;;) {
-				++$start;
-				$start = 1 if ($start > $max);
-				last if ($start == $end);
-				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
-				    if ($slave_editor) {
-					print $OUT "\032\032$filename:$start:0\n";
-				    } else {
-					print $OUT "$start:\t", $dbline[$start], "\n";
-				    }
-				    last;
-				}
-			    } ';
-			print $OUT "/$pat/: not found\n" if ($start == $end);
-			next CMD; };
-		    $cmd =~ /^\?(.*)$/ && do {
-			$inpat = $1;
-			$inpat =~ s:([^\\])\?$:$1:;
-			if ($inpat ne "") {
-			    # squelch the sigmangler
-			    local $SIG{__DIE__};
-			    local $SIG{__WARN__};
-			    eval '$inpat =~ m'."\a$inpat\a";	
-			    if ($@ ne "") {
-				print $OUT $@;
-				next CMD;
-			    }
-			    $pat = $inpat;
-			}
-			$end = $start;
-			$incr = -1;
-			eval '
-			    for (;;) {
-				--$start;
-				$start = $max if ($start <= 0);
-				last if ($start == $end);
-				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
-				    if ($slave_editor) {
-					print $OUT "\032\032$filename:$start:0\n";
-				    } else {
-					print $OUT "$start:\t", $dbline[$start], "\n";
-				    }
-				    last;
-				}
-			    } ';
-			print $OUT "?$pat?: not found\n" if ($start == $end);
-			next CMD; };
-		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
-			pop(@hist) if length($cmd) > 1;
-			$i = $1 ? ($#hist-($2||1)) : ($2||$#hist);
-			$cmd = $hist[$i];
-			print $OUT $cmd, "\n";
-			redo CMD; };
-		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
-			&system($1);
-			next CMD; };
-		    $cmd =~ /^$rc([^$rc].*)$/ && do {
-			$pat = "^$1";
-			pop(@hist) if length($cmd) > 1;
-			for ($i = $#hist; $i; --$i) {
-			    last if $hist[$i] =~ /$pat/;
-			}
-			if (!$i) {
-			    print $OUT "No such command!\n\n";
-			    next CMD;
-			}
-			$cmd = $hist[$i];
-			print $OUT $cmd, "\n";
-			redo CMD; };
-		    $cmd =~ /^$sh$/ && do {
-			&system($ENV{SHELL}||"/bin/sh");
-			next CMD; };
-		    $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
-			# XXX: using csh or tcsh destroys sigint retvals!
-			#&system($1);  # use this instead
-			&system($ENV{SHELL}||"/bin/sh","-c",$1);
-			next CMD; };
-		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
-			$end = $2 ? ($#hist-$2) : 0;
-			$hist = 0 if $hist < 0;
-			for ($i=$#hist; $i>$end; $i--) {
-			    print $OUT "$i: ",$hist[$i],"\n"
-			      unless $hist[$i] =~ /^.?$/;
-			};
-			next CMD; };
-		    $cmd =~ /^(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?$/ && do {
-			runman($1);
-			next CMD; };
-		    $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
-		    $cmd =~ s/^p\b/print {\$DB::OUT} /;
-		    $cmd =~ s/^=\s*// && do {
-			my @keys;
-			if (length $cmd == 0) {
-			    @keys = sort keys %alias;
-			} elsif (my($k,$v) = ($cmd =~ /^(\S+)\s+(\S.*)/)) {
-			    # can't use $_ or kill //g state
-			    for my $x ($k, $v) { $x =~ s/\a/\\a/g }
-			    $alias{$k} = "s\a$k\a$v\a";
-			    # squelch the sigmangler
-			    local $SIG{__DIE__};
-			    local $SIG{__WARN__};
-			    unless (eval "sub { s\a$k\a$v\a }; 1") {
-				print $OUT "Can't alias $k to $v: $@\n"; 
-				delete $alias{$k};
-				next CMD;
-			    } 
-			    @keys = ($k);
-			} else {
-			    @keys = ($cmd);
-			} 
-			for my $k (@keys) {
-			    if ((my $v = $alias{$k}) =~ ss\a$k\a(.*)\a$1) {
-				print $OUT "$k\t= $1\n";
-			    } 
-			    elsif (defined $alias{$k}) {
-				    print $OUT "$k\t$alias{$k}\n";
-			    } 
-			    else {
-				print "No alias for $k\n";
-			    } 
-			}
-			next CMD; };
-                    $cmd =~ /^source\s+(.*\S)/ && do {
-		      if (open my $fh, $1) {
-			push @cmdfhs, $fh;
-		      } else {
-			&warn("Can't execute `$1': $!\n");
-		      }
-		      next CMD; };
-		    $cmd =~ /^\|\|?\s*[^|]/ && do {
-			if ($pager =~ /^\|/) {
-			    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
-			    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
-			} else {
-			    open(SAVEOUT,">&OUT") || &warn("Can't save DB::OUT");
-			}
-			fix_less();
-			unless ($piped=open(OUT,$pager)) {
-			    &warn("Can't pipe output to `$pager'");
-			    if ($pager =~ /^\|/) {
-				open(OUT,">&STDOUT") # XXX: lost message
-				    || &warn("Can't restore DB::OUT");
-				open(STDOUT,">&SAVEOUT")
-				  || &warn("Can't restore STDOUT");
-				close(SAVEOUT);
-			    } else {
-				open(OUT,">&STDOUT") # XXX: lost message
-				    || &warn("Can't restore DB::OUT");
-			    }
-			    next CMD;
-			}
-			$SIG{PIPE}= \&DB::catch if $pager =~ /^\|/
-			    && ("" eq $SIG{PIPE}  ||  "DEFAULT" eq $SIG{PIPE});
-			$selected= select(OUT);
-			$|= 1;
-			select( $selected ), $selected= "" unless $cmd =~ /^\|\|/;
-			$cmd =~ s/^\|+\s*//;
-			redo PIPE; 
-		    };
-		    # XXX Local variants do not work!
-		    $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
-		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
-		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
-		}		# PIPE:
-	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
-	    if ($onetimeDump) {
-		$onetimeDump = undef;
+                    } ## end if (defined &main::dumpvar)
+                    else {
+                        # Couldn't load dumpvar.
+                        print $OUT "dumpvar.pl not available.\n";
+                    }
+                    # Restore the output filehandle, and go round again.
+                    select($savout);
+                    next CMD;
+                };
+
+=head4 C<x> - evaluate and print an expression
+
+Hands the expression off to C<DB::eval>, setting it up to print the value
+via C<dumpvar.pl> instead of just printing it directly.
+
+=cut
+
+                $cmd =~ s/^x\b/ / && do {   # Remainder gets done by DB::eval()
+                    $onetimeDump = 'dump';  # main::dumpvar shows the output
+
+                    # handle special  "x 3 blah" syntax XXX propagate
+                    # doc back to special variables.
+                    if ($cmd =~ s/^\s*(\d+)(?=\s)/ /) {
+                        $onetimedumpDepth = $1;
+                    }
+                };
+
+=head4 C<m> - print methods
+
+Just uses C<DB::methods> to determine what methods are available.
+
+=cut
+
+                $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
+                    methods($1);
+                    next CMD;
+                };
+
+                # m expr - set up DB::eval to do the work
+                $cmd =~ s/^m\b/ / && do {     # Rest gets done by DB::eval()
+                    $onetimeDump = 'methods'; #  method output gets used there
+                };
+
+=head4 C<f> - switch files
+
+=cut
+
+                $cmd =~ /^f\b\s*(.*)/ && do {
+                    $file = $1;
+                    $file =~ s/\s+$//;
+
+                    # help for no arguments (old-style was return from sub).
+                    if (!$file) {
+                        print $OUT
+                          "The old f command is now the r command.\n";  # hint
+                        print $OUT "The new f command switches filenames.\n";
+                        next CMD;
+                    } ## end if (!$file)
+
+                    # if not in magic file list, try a close match.
+                    if (!defined $main::{ '_<' . $file }) {
+                        if (($try) = grep(m#^_<.*$file#, keys %main::)) {
+                            {
+                                $try = substr($try, 2);
+                                print $OUT
+                                  "Choosing $try matching `$file':\n";
+                                $file = $try;
+                            }
+                        } ## end if (($try) = grep(m#^_<.*$file#...
+                    } ## end if (!defined $main::{ ...
+
+                    # If not successfully switched now, we failed.
+                    if (!defined $main::{ '_<' . $file }) {
+                        print $OUT "No file matching `$file' is loaded.\n";
+                        next CMD;
+                    }
+
+                    # We switched, so switch the debugger internals around.
+                    elsif ($file ne $filename) {
+                        *dbline   = $main::{ '_<' . $file };
+                        $max      = $#dbline;
+                        $filename = $file;
+                        $start    = 1;
+                        $cmd      = "l";
+                    } ## end elsif ($file ne $filename)
+
+                    # We didn't switch; say we didn't.
+                    else {
+                        print $OUT "Already in $file.\n";
+                        next CMD;
+                    }
+                };
+
+=head4 C<.> - return to last-executed line.
+
+We set C<$incr> to -1 to indicate that the debugger shouldn't move ahead,
+and then we look up the line in the magical C<%dbline> hash.
+
+=cut
+
+                # . command.
+                $cmd =~ /^\.$/ && do {
+                    $incr     = -1;              # stay at current line
+
+                    # Reset everything to the old location.
+                    $start    = $line;
+                    $filename = $filename_ini;
+                    *dbline = $main::{ '_<' . $filename };
+                    $max    = $#dbline;
+
+                    # Now where are we?
+                    print_lineinfo($position);
+                    next CMD;
+                };
+
+=head4 C<-> - back one window
+
+We change C<$start> to be one window back; if we go back past the first line,
+we set it to be the first line. We ser C<$incr> to put us back at the
+currently-executing line, and then put a C<l $start +> (list one window from
+C<$start>) in C<$cmd> to be executed later.
+
+=cut
+
+                # - - back a window.
+                $cmd =~ /^-$/ && do {
+                    # back up by a window; go to 1 if back too far.
+                    $start -= $incr + $window + 1;
+                    $start = 1 if $start <= 0;
+                    $incr = $window - 1;
+
+                    # Generate and execute a "l +" command (handled below).
+                    $cmd = 'l ' . ($start) . '+';
+                };
+
+=head3 PRE-580 COMMANDS VS. NEW COMMANDS: C<a, A, b, B, h, l, L, M, o, O, P, v, w, W, E<lt>, E<lt>E<lt>, {, {{>
+
+In Perl 5.8.0, a realignment of the commands was done to fix up a number of
+problems, most notably that the default case of several commands destroying
+the user's work in setting watchpoints, actions, etc. We wanted, however, to
+retain the old commands for those who were used to using them or who preferred
+them. At this point, we check for the new commands and call C<cmd_wrapper> to
+deal with them instead of processing them in-line.
+
+=cut
+
+                # All of these commands were remapped in perl 5.8.0;
+                # we send them off to the secondary dispatcher (see below). 
+                $cmd =~ /^([aAbBhlLMoOvwW]\b|[<>\{]{1,2})\s*(.*)/so && do {
+                    &cmd_wrapper($1, $2, $line);
+                    next CMD;
+                };
+
+=head4 C<y> - List lexicals in higher scope
+
+Uses C<PadWalker> to find the lexicals supplied as arguments in a scope    
+above the current one and then displays then using C<dumpvar.pl>.
+
+=cut
+
+                $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/ && do {
+
+                    # See if we've got the necessary support.
+                    eval { require PadWalker; PadWalker->VERSION(0.08) }
+                      or &warn(
+                        $@ =~ /locate/
+                        ? "PadWalker module not found - please install\n"
+                        : $@
+                      )
+                      and next CMD;
+
+                    # Load up dumpvar if we don't have it. If we can, that is.
+                    do 'dumpvar.pl' unless defined &main::dumpvar;
+                    defined &main::dumpvar
+                      or print $OUT "dumpvar.pl not available.\n"
+                      and next CMD;
+
+                    # Got all the modules we need. Find them and print them.
+                    my @vars = split (' ', $2 || '');
+
+                    # Find the pad.
+                    my $h = eval { PadWalker::peek_my(($1 || 0) + 1) };
+
+                    # Oops. Can't find it.
+                    $@ and $@ =~ s/ at .*//, &warn($@), next CMD;
+
+                    # Show the desired vars with dumplex().
+                    my $savout = select($OUT);
+
+                    # Have dumplex dump the lexicals.
+                    dumpvar::dumplex(
+                        $_,
+                        $h->{$_},
+                        defined $option{dumpDepth} ? $option{dumpDepth} : -1,
+                        @vars
+                    ) for sort keys %$h;
+                    select($savout);
+                    next CMD;
+                };
+
+=head3 COMMANDS NOT WORKING AFTER PROGRAM ENDS
+
+All of the commands below this point don't work after the program being
+debugged has ended. All of them check to see if the program has ended; this
+allows the commands to be relocated without worrying about a 'line of
+demarcation' above which commands can be entered anytime, and below which
+they can't.
+
+=head4 C<n> - single step, but don't trace down into subs
+
+Done by setting C<$single> to 2, which forces subs to execute straight through
+when entered (see X<DB::sub>). We also save the C<n> command in C<$laststep>,
+so a null command knows what to re-execute. 
+
+=cut
+
+                # n - next 
+                $cmd =~ /^n$/ && do {
+                    end_report(), next CMD if $finished and $level <= 1;
+                    # Single step, but don't enter subs.
+                    $single   = 2;
+                    # Save for empty command (repeat last).
+                    $laststep = $cmd;
+                    last CMD;
+                };
+
+=head4 C<s> - single-step, entering subs
+
+Sets C<$single> to 1, which causes X<DB::sub> to continue tracing inside     
+subs. Also saves C<s> as C<$lastcmd>.
+
+=cut
+
+                # s - single step.
+                $cmd =~ /^s$/ && do {
+                    # Get out and restart the command loop if program
+                    # has finished.
+                    end_report(), next CMD if $finished and $level <= 1;
+                    # Single step should enter subs.
+                    $single   = 1;
+                    # Save for empty command (repeat last).
+                    $laststep = $cmd;
+                    last CMD;
+                };
+
+=head4 C<c> - run continuously, setting an optional breakpoint
+
+Most of the code for this command is taken up with locating the optional
+breakpoint, which is either a subroutine name or a line number. We set
+the appropriate one-time-break in C<@dbline> and then turn off single-stepping
+in this and all call levels above this one.
+
+=cut
+
+                # c - start continuous execution.
+                $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+                    # Hey, show's over. The debugged program finished
+                    # executing already.
+                    end_report(), next CMD if $finished and $level <= 1;
+
+                    # Capture the place to put a one-time break.
+                    $subname = $i = $1;
+
+                    #  Probably not needed, since we finish an interactive
+                    #  sub-session anyway...
+                    # local $filename = $filename;
+                    # local *dbline = *dbline; # XXX Would this work?!
+                    #
+                    # The above question wonders if localizing the alias
+                    # to the magic array works or not. Since it's commented
+                    # out, we'll just leave that to speculation for now.
+
+                    # If the "subname" isn't all digits, we'll assume it
+                    # is a subroutine name, and try to find it.
+                    if ($subname =~ /\D/) {    # subroutine name
+                        # Qualify it to the current package unless it's
+                        # already qualified.
+                        $subname = $package . "::" . $subname
+                          unless $subname =~ /::/;
+                        # find_sub will return "file:line_number" corresponding
+                        # to where the subroutine is defined; we call find_sub,
+                        # break up the return value, and assign it in one 
+                        # operation.
+                        ($file, $i) = (find_sub($subname) =~ /^(.*):(.*)$/);
+
+                        # Force the line number to be numeric.
+                        $i += 0;
+
+                        # If we got a line number, we found the sub.
+                        if ($i) {
+                            # Switch all the debugger's internals around so
+                            # we're actually working with that file.
+                            $filename = $file;
+                            *dbline   = $main::{ '_<' . $filename };
+                            # Mark that there's a breakpoint in this file.
+                            $had_breakpoints{$filename} |= 1;
+                            # Scan forward to the first executable line
+                            # after the 'sub whatever' line.
+                            $max = $#dbline;
+                            ++$i while $dbline[$i] == 0 && $i < $max;
+                        } ## end if ($i)
+
+                        # We didn't find a sub by that name.
+                        else {
+                            print $OUT "Subroutine $subname not found.\n";
+                            next CMD;
+                        }
+                    } ## end if ($subname =~ /\D/)
+
+                    # At this point, either the subname was all digits (an
+                    # absolute line-break request) or we've scanned through
+                    # the code following the definition of the sub, looking
+                    # for an executable, which we may or may not have found.
+                    #
+                    # If $i (which we set $subname from) is non-zero, we
+                    # got a request to break at some line somewhere. On 
+                    # one hand, if there wasn't any real subroutine name 
+                    # involved, this will be a request to break in the current 
+                    # file at the specified line, so we have to check to make 
+                    # sure that the line specified really is breakable.
+                    #
+                    # On the other hand, if there was a subname supplied, the
+                    # preceeding block has moved us to the proper file and
+                    # location within that file, and then scanned forward
+                    # looking for the next executable line. We have to make
+                    # sure that one was found.
+                    #
+                    # On the gripping hand, we can't do anything unless the
+                    # current value of $i points to a valid breakable line.
+                    # Check that.
+                    if ($i) {
+                        # Breakable?
+                        if ($dbline[$i] == 0) {
+                            print $OUT "Line $i not breakable.\n";
+                            next CMD;
+                        }
+                        # Yes. Set up the one-time-break sigil.
+                        $dbline{$i} =~
+                          s/($|\0)/;9$1/;    # add one-time-only b.p.
+                    } ## end if ($i)
+
+                    # Turn off stack tracing from here up.
+                    for ($i = 0 ; $i <= $stack_depth ;) {
+                        $stack[$i++] &= ~1;
+                    }
+                    last CMD;
+                };
+
+=head4 C<r> - return from a subroutine
+
+For C<r> to work properly, the debugger has to stop execution again
+immediately after the return is executed. This is done by forcing
+single-stepping to be on in the call level above the current one. If
+we are printing return values when a C<r> is executed, set C<$doret>
+appropriately, and force us out of the command loop.
+
+=cut
+
+                # r - return from the current subroutine.
+                $cmd =~ /^r$/ && do {
+                    # Can't do anythign if the program's over.
+                    end_report(), next CMD if $finished and $level <= 1;
+                    # Turn on stack trace.
+                    $stack[$stack_depth] |= 1;
+                    # Print return value unless the stack is empty.
+                    $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
+                    last CMD;
+                };
+
+=head4 C<R> - restart
+
+Restarting the debugger is a complex operation that occurs in several phases.
+First, we try to reconstruct the command line that was used to invoke Perl
+and the debugger.
+
+=cut
+
+                # R - restart execution.
+                $cmd =~ /^R$/ && do {
+                    # I may not be able to resurrect you, but here goes ...
+                    print $OUT
+"Warning: some settings and command-line options may be lost!\n";
+                    my (@script, @flags, $cl);
+
+                    # If warn was on before, turn it on again.
+                    push @flags, '-w' if $ini_warn;
+
+                    # Rebuild the -I flags that were on the initial
+                    # command line.
+                    for (@ini_INC) {
+                        push @flags, '-I', $_;
+                    }
+
+                    # Turn on taint if it was on before.
+                    push @flags, '-T' if ${^TAINT};
+
+                    # Arrange for setting the old INC:
+                    # Save the current @init_INC in the environment.
+                    set_list("PERLDB_INC", @ini_INC);
+
+                    # If this was a perl one-liner, go to the "file"
+                    # corresponding to the one-liner read all the lines
+                    # out of it (except for the first one, which is going
+                    # to be added back on again when 'perl -d' runs: that's
+                    # the 'require perl5db.pl;' line), and add them back on
+                    # to the command line to be executed.
+                    if ($0 eq '-e') {
+                        for (1 .. $#{'::_<-e'}) {  # The first line is PERL5DB
+                            chomp($cl = ${'::_<-e'}[$_]);
+                            push @script, '-e', $cl;
+                        }
+                    } ## end if ($0 eq '-e')
+
+                    # Otherwise we just reuse the original name we had 
+                    # before.
+                    else {
+                        @script = $0;
+                    }
+
+=pod
+
+After the command line  has been reconstructed, the next step is to save
+the debugger's status in environment variables. The C<DB::set_list> routine
+is used to save aggregate variables (both hashes and arrays); scalars are
+just popped into environment variables directly.
+
+=cut
+
+                    # If the terminal supported history, grab it and
+                    # save that in the environment.
+                    set_list("PERLDB_HIST",
+                        $term->Features->{getHistory}
+                        ? $term->GetHistory
+                        : @hist);
+                    # Find all the files that were visited during this
+                    # session (i.e., the debugger had magic hashes
+                    # corresponding to them) and stick them in the environment.
+                    my @had_breakpoints = keys %had_breakpoints;
+                    set_list("PERLDB_VISITED", @had_breakpoints);
+
+                    # Save the debugger options we chose.
+                    set_list("PERLDB_OPT",     %option);
+
+                    # Save the break-on-loads.
+                    set_list("PERLDB_ON_LOAD", %break_on_load);
+
+=pod 
+
+The most complex part of this is the saving of all of the breakpoints. They
+can live in an awful lot of places, and we have to go through all of them,
+find the breakpoints, and then save them in the appropriate environment
+variable via C<DB::set_list>.
+
+=cut
+
+                    # Go through all the breakpoints and make sure they're
+                    # still valid.
+                    my @hard;
+                    for (0 .. $#had_breakpoints) {
+                        # We were in this file.
+                        my $file = $had_breakpoints[$_];
+
+                        # Grab that file's magic line hash.
+                        *dbline = $main::{ '_<' . $file };
+
+                        # Skip out if it doesn't exist, or if the breakpoint
+                        # is in a postponed file (we'll do postponed ones 
+                        # later).
+                        next unless %dbline or $postponed_file{$file};
+
+                        # In an eval. This is a little harder, so we'll
+                        # do more processing on that below.
+                        (push @hard, $file), next
+                          if $file =~ /^\(\w*eval/;
+                        # XXX I have no idea what this is doing. Yet. 
+                        my @add;
+                        @add = %{ $postponed_file{$file} }
+                          if $postponed_file{$file};
+
+                        # Save the list of all the breakpoints for this file.
+                        set_list("PERLDB_FILE_$_", %dbline, @add);
+                    } ## end for (0 .. $#had_breakpoints)
+
+                    # The breakpoint was inside an eval. This is a little
+                    # more difficult. XXX and I don't understand it.
+                    for (@hard) {    
+                        # Get over to the eval in question.
+                        *dbline = $main::{ '_<' . $_ };
+                        my ($quoted, $sub, %subs, $line) = quotemeta $_;
+                        for $sub (keys %sub) {
+                            next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
+                            $subs{$sub} = [$1, $2];
+                        }
+                        unless (%subs) {
+                            print $OUT
+                              "No subroutines in $_, ignoring breakpoints.\n";
+                            next;
+                        }
+                      LINES: for $line (keys %dbline) {
+
+                            # One breakpoint per sub only:
+                            my ($offset, $sub, $found);
+                          SUBS: for $sub (keys %subs) {
+                                if (
+                                    $subs{$sub}->[1] >=
+                                    $line    # Not after the subroutine
+                                    and (
+                                        not defined $offset    # Not caught
+                                        or $offset < 0
+                                    )
+                                  )
+                                {    # or badly caught
+                                    $found  = $sub;
+                                    $offset = $line - $subs{$sub}->[0];
+                                    $offset = "+$offset", last SUBS
+                                      if $offset >= 0;
+                                } ## end if ($subs{$sub}->[1] >=...
+                            } ## end for $sub (keys %subs)
+                            if (defined $offset) {
+                                $postponed{$found} =
+                                  "break $offset if $dbline{$line}";
+                            }
+                            else {
+                                print $OUT
+"Breakpoint in $_:$line ignored: after all the subroutines.\n";
+                            }
+                        } ## end for $line (keys %dbline)
+                    } ## end for (@hard)
+
+                    # Save the other things that don't need to be 
+                    # processed.
+                    set_list("PERLDB_POSTPONE",  %postponed);
+                    set_list("PERLDB_PRETYPE",   @$pretype);
+                    set_list("PERLDB_PRE",       @$pre);
+                    set_list("PERLDB_POST",      @$post);
+                    set_list("PERLDB_TYPEAHEAD", @typeahead);
+
+                    # We are oficially restarting.
+                    $ENV{PERLDB_RESTART} = 1;
+
+                    # We are junking all child debuggers.
+                    delete $ENV{PERLDB_PIDS};    # Restore ini state
+
+                    # Set this back to the initial pid.
+                    $ENV{PERLDB_PIDS} = $ini_pids if defined $ini_pids;
+
+=pod 
+
+After all the debugger status has been saved, we take the command we built
+up and then C<exec()> it. The debugger will spot the C<PERLDB_RESTART>
+environment variable and realize it needs to reload its state from the
+environment.
+
+=cut
+
+                    # And run Perl again. Add the "-d" flag, all the 
+                    # flags we built up, the script (whether a one-liner
+                    # or a file), add on the -emacs flag for a slave editor,
+                    # and then the old arguments. We use exec() to keep the
+                    # PID stable (and that way $ini_pids is still valid).
+                    exec($^X, '-d', @flags, @script,
+                        ($slave_editor ? '-emacs' : ()), @ARGS) ||
+                      print $OUT "exec failed: $!\n";
+                    last CMD;
+                };
+
+=head4 C<T> - stack trace
+
+Just calls C<DB::print_trace>.
+
+=cut
+
+                $cmd =~ /^T$/ && do {
+                    print_trace($OUT, 1);        # skip DB
+                    next CMD;
+                };
+
+=head4 C<w> - List window around current line.
+
+Just calls C<DB::cmd_w>.
+
+=cut
+
+                $cmd =~ /^w\b\s*(.*)/s && do { &cmd_w('w', $1); next CMD; };
+
+=head4 C<W> - watch-expression processing.
+
+Just calls C<DB::cmd_W>. 
+
+=cut
+
+                $cmd =~ /^W\b\s*(.*)/s && do { &cmd_W('W', $1); next CMD; };
+
+=head4 C</> - search forward for a string in the source
+
+We take the argument and treat it as a pattern. If it turns out to be a 
+bad one, we return the error we got from trying to C<eval> it and exit.
+If not, we create some code to do the search and C<eval> it so it can't 
+mess us up.
+
+=cut
+
+                $cmd =~ /^\/(.*)$/     && do {
+
+                    # The pattern as a string.
+                    $inpat = $1;
+
+                    # Remove the final slash.
+                    $inpat =~ s:([^\\])/$:$1:;
+
+                    # If the pattern isn't null ...
+                    if ($inpat ne "") {
+
+                        # Turn of warn and die procesing for a bit.
+                        local $SIG{__DIE__};
+                        local $SIG{__WARN__};
+
+                        # Create the pattern.
+                        eval '$inpat =~ m' . "\a$inpat\a";
+                        if ($@ ne "") {
+                            # Oops. Bad pattern. No biscuit.
+                            # Print the eval error and go back for more 
+                            # commands.
+                            print $OUT "$@";
+                            next CMD;
+                        }
+                        $pat = $inpat;
+                    } ## end if ($inpat ne "")
+
+                    # Set up to stop on wrap-around.
+                    $end  = $start;
+
+                    # Don't move off the current line.
+                    $incr = -1;
+
+                    # Done in eval so nothing breaks if the pattern
+                    # does something weird.
+                    eval '
+                        for (;;) {
+                            # Move ahead one line.
+                            ++$start;
+
+                            # Wrap if we pass the last line.
+                            $start = 1 if ($start > $max);
+
+                            # Stop if we have gotten back to this line again,
+                            last if ($start == $end);
+
+                            # A hit! (Note, though, that we are doing
+                            # case-insensitive matching. Maybe a qr//
+                            # expression would be better, so the user could
+                            # do case-sensitive matching if desired.
+                            if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+                                if ($slave_editor) {
+                                    # Handle proper escaping in the slave.
+                                    print $OUT "\032\032$filename:$start:0\n";
+                                } 
+                                else {
+                                    # Just print the line normally.
+                                    print $OUT "$start:\t",$dbline[$start],"\n";
+                                }
+                                # And quit since we found something.
+                                last;
+                            }
+                         } ';
+                    # If we wrapped, there never was a match.
+                    print $OUT "/$pat/: not found\n" if ($start == $end);
+                    next CMD;
+                };
+
+=head4 C<?> - search backward for a string in the source
+
+Same as for C</>, except the loop runs backwards.
+
+=cut
+
+                # ? - backward pattern search.
+                $cmd =~ /^\?(.*)$/ && do {
+
+                    # Get the pattern, remove trailing question mark.
+                    $inpat = $1;
+                    $inpat =~ s:([^\\])\?$:$1:;
+
+                    # If we've got one ...
+                    if ($inpat ne "") {
+
+                        # Turn off die & warn handlers.
+                        local $SIG{__DIE__};
+                        local $SIG{__WARN__};
+                        eval '$inpat =~ m' . "\a$inpat\a";
+
+                        if ($@ ne "") {
+                            # Ouch. Not good. Print the error.
+                            print $OUT $@;
+                            next CMD;
+                        }
+                        $pat = $inpat;
+                    } ## end if ($inpat ne "")
+
+                    # Where we are now is where to stop after wraparound.
+                    $end  = $start;
+
+                    # Don't move away from this line.
+                    $incr = -1;
+
+                    # Search inside the eval to prevent pattern badness
+                    # from killing us.
+                    eval '
+                        for (;;) {
+                            # Back up a line.
+                            --$start;
+
+                            # Wrap if we pass the first line.
+                            $start = $max if ($start <= 0);
+
+                            # Quit if we get back where we started,
+                            last if ($start == $end);
+
+                            # Match?
+                            if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+                                if ($slave_editor) {
+                                    # Yep, follow slave editor requirements.
+                                    print $OUT "\032\032$filename:$start:0\n";
+                                } 
+                                else {
+                                    # Yep, just print normally.
+                                    print $OUT "$start:\t",$dbline[$start],"\n";
+                                }
+
+                                # Found, so done.
+                                last;
+                            }
+                        } ';
+
+                    # Say we failed if the loop never found anything,
+                    print $OUT "?$pat?: not found\n" if ($start == $end);
+                    next CMD;
+                };
+
+=head4 C<$rc> - Recall command
+
+Manages the commands in C<@hist> (which is created if C<Term::ReadLine> reports
+that the terminal supports history). It find the command required, puts it
+into C<$cmd>, and redoes the loop to execute it.
+
+=cut
+
+                # $rc - recall command. 
+                $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
+
+                    # No arguments, take one thing off history.
+                    pop (@hist) if length($cmd) > 1;
+
+                    # Relative (- found)? 
+                    #  Y - index back from most recent (by 1 if bare minus)
+                    #  N - go to that particular command slot or the last 
+                    #      thing if nothing following.
+                    $i = $1 ? ($#hist - ($2 || 1)) : ($2 || $#hist);
+
+                    # Pick out the command desired.
+                    $cmd = $hist[$i];
+
+                    # Print the command to be executed and restart the loop
+                    # with that command in the buffer.
+                    print $OUT $cmd, "\n";
+                    redo CMD;
+                };
+
+=head4 C<$sh$sh> - C<system()> command
+
+Calls the C<DB::system()> to handle the command. This keeps the C<STDIN> and
+C<STDOUT> from getting messed up.
+
+=cut
+
+                # $sh$sh - run a shell command (if it's all ASCII).
+                # Can't run shell commands with Unicode in the debugger, hmm.
+                $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
+                    # System it.
+                    &system($1);
+                    next CMD;
+                };
+
+=head4 C<$rc I<pattern> $rc> - Search command history
+
+Another command to manipulate C<@hist>: this one searches it with a pattern.
+If a command is found, it is placed in C<$cmd> and executed via <redo>.
+
+=cut
+
+                # $rc pattern $rc - find a command in the history. 
+                $cmd =~ /^$rc([^$rc].*)$/ && do {
+                    # Create the pattern to use.
+                    $pat = "^$1";
+
+                    # Toss off last entry if length is >1 (and it always is).
+                    pop (@hist) if length($cmd) > 1;
+
+                    # Look backward through the history.
+                    for ($i = $#hist ; $i ; --$i) {
+                        # Stop if we find it.
+                        last if $hist[$i] =~ /$pat/;
+                    }
+
+                    if (!$i) {
+                        # Never found it.
+                        print $OUT "No such command!\n\n";
+                        next CMD;
+                    }
+
+                    # Found it. Put it in the buffer, print it, and process it.
+                    $cmd = $hist[$i];
+                    print $OUT $cmd, "\n";
+                    redo CMD;
+                };
+
+=head4 C<$sh> - Invoke a shell     
+
+Uses C<DB::system> to invoke a shell.
+
+=cut
+
+                # $sh - start a shell.
+                $cmd =~ /^$sh$/ && do {
+                    # Run the user's shell. If none defined, run Bourne.
+                    # We resume execution when the shell terminates.
+                    &system($ENV{SHELL} || "/bin/sh");
+                    next CMD;
+                };
+
+=head4 C<$sh I<command>> - Force execution of a command in a shell
+
+Like the above, but the command is passed to the shell. Again, we use
+C<DB::system> to avoid problems with C<STDIN> and C<STDOUT>.
+
+=cut
+
+                # $sh command - start a shell and run a command in it.
+                $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
+                    # XXX: using csh or tcsh destroys sigint retvals!
+                    #&system($1);  # use this instead
+
+                    # use the user's shell, or Bourne if none defined.
+                    &system($ENV{SHELL} || "/bin/sh", "-c", $1);
+                    next CMD;
+                };
+
+=head4 C<H> - display commands in history
+
+Prints the contents of C<@hist> (if any).
+
+=cut
+
+                $cmd =~ /^H\b\s*(-(\d+))?/ && do {
+                    # Anything other than negative numbers is ignored by 
+                    # the (incorrect) pattern, so this test does nothing.
+                    $end = $2 ? ($#hist - $2) : 0;
+
+                    # Set to the minimum if less than zero.
+                    $hist = 0 if $hist < 0;
+
+                    # Start at the end of the array. 
+                    # Stay in while we're still above the ending value.
+                    # Tick back by one each time around the loop.
+                    for ($i = $#hist ; $i > $end ; $i--) {
+
+                        # Print the command  unless it has no arguments.
+                        print $OUT "$i: ", $hist[$i], "\n"
+                          unless $hist[$i] =~ /^.?$/;
+                    }
+                    next CMD;
+                };
+
+=head4 C<man, doc, perldoc> - look up documentation
+
+Just calls C<runman()> to print the appropriate document.
+
+=cut
+
+                # man, perldoc, doc - show manual pages.               
+                $cmd =~ /^(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?$/ && do {
+                    runman($1);
+                    next CMD;
+                };
+
+=head4 C<p> - print
+
+Builds a C<print EXPR> expression in the C<$cmd>; this will get executed at
+the bottom of the loop.
+
+=cut
+
+                # p - print (no args): print $_.
+                $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
+
+                # p - print the given expression.
+                $cmd =~ s/^p\b/print {\$DB::OUT} /;
+
+=head4 C<=> - define command alias
+
+Manipulates C<%alias> to add or list command aliases.
+
+=cut
+
+                 # = - set up a command alias.
+                $cmd =~ s/^=\s*// && do {
+                    my @keys;
+                    if (length $cmd == 0) {
+                        # No args, get current aliases.
+                        @keys = sort keys %alias;
+                    }
+                    elsif (my ($k, $v) = ($cmd =~ /^(\S+)\s+(\S.*)/)) {
+                        # Creating a new alias. $k is alias name, $v is
+                        # alias value.
+
+                        # can't use $_ or kill //g state
+                        for my $x ($k, $v) { 
+                          # Escape "alarm" characters.
+                          $x =~ s/\a/\\a/g 
+                        }
+
+                        # Substitute key for value, using alarm chars
+                        # as separators (which is why we escaped them in 
+                        # the command).
+                        $alias{$k} = "s\a$k\a$v\a";
+
+                        # Turn off standard warn and die behavior.
+                        local $SIG{__DIE__};
+                        local $SIG{__WARN__};
+
+                        # Is it valid Perl?
+                        unless (eval "sub { s\a$k\a$v\a }; 1") {
+                            # Nope. Bad alias. Say so and get out.
+                            print $OUT "Can't alias $k to $v: $@\n";
+                            delete $alias{$k};
+                            next CMD;
+                        }
+                        # We'll only list the new one.
+                        @keys = ($k);
+                    } ## end elsif (my ($k, $v) = ($cmd...
+
+                    # The argument is the alias to list.
+                    else {
+                        @keys = ($cmd);
+                    }
+
+                    # List aliases.
+                    for my $k (@keys) {
+                        # Messy metaquoting: Trim the substiution code off.
+                        # We use control-G as the delimiter because it's not
+                        # likely to appear in the alias.
+                        if ((my $v = $alias{$k}) =~ ss\a$k\a(.*)\a$1) {
+                            # Print the alias.
+                            print $OUT "$k\t= $1\n";
+                        }
+                        elsif (defined $alias{$k}) {
+                            # Couldn't trim it off; just print the alias code.
+                            print $OUT "$k\t$alias{$k}\n";
+                        }
+                        else {
+                            # No such, dude.
+                            print "No alias for $k\n";
+                        }
+                    } ## end for my $k (@keys)
+                    next CMD;
+                };
+
+=head4 C<source> - read commands from a file.
+
+Opens a lexical filehandle and stacks it on C<@cmdfhs>; C<DB::readline> will
+pick it up.
+
+=cut
+
+                # source - read commands from a file (or pipe!) and execute. 
+                $cmd =~ /^source\s+(.*\S)/ && do {
+                    if (open my $fh, $1) {
+                        # Opened OK; stick it in the list of file handles.
+                        push @cmdfhs, $fh;
+                    }
+                    else {
+                        # Couldn't open it. 
+                        &warn("Can't execute `$1': $!\n");
+                    }
+                    next CMD;
+                };
+
+=head4 C<|, ||> - pipe output through the pager.
+
+FOR C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT>
+(the program's standard output). For C<||>, we only save C<OUT>. We open a
+pipe to the pager (restoring the output filehandles if this fails). If this
+is the C<|> command, we also set up a C<SIGPIPE> handler which will simply 
+set C<$signal>, sending us back into the debugger.
+
+We then trim off the pipe symbols and C<redo> the command loop at the
+C<PIPE> label, causing us to evaluate the command in C<$cmd> without
+reading another.
+
+=cut
+
+                # || - run command in the pager, with output to DB::OUT.
+                $cmd =~ /^\|\|?\s*[^|]/ && do {
+                    if ($pager =~ /^\|/) {
+                        # Default pager is into a pipe. Redirect I/O.
+                        open(SAVEOUT, ">&STDOUT") ||
+                          &warn("Can't save STDOUT");
+                        open(STDOUT, ">&OUT") ||
+                          &warn("Can't redirect STDOUT");
+                    } ## end if ($pager =~ /^\|/)
+                    else {
+                        # Not into a pipe. STDOUT is safe.
+                        open(SAVEOUT, ">&OUT") || &warn("Can't save DB::OUT");
+                    }
+
+                    # Fix up environment to record we have less if so.
+                    fix_less();
+
+                    unless ($piped = open(OUT, $pager)) {
+                        # Couldn't open pipe to pager.
+                        &warn("Can't pipe output to `$pager'");
+                        if ($pager =~ /^\|/) {
+                            # Redirect I/O back again.
+                            open(OUT, ">&STDOUT")    # XXX: lost message
+                              || &warn("Can't restore DB::OUT");
+                            open(STDOUT, ">&SAVEOUT") ||
+                              &warn("Can't restore STDOUT");
+                            close(SAVEOUT);
+                        } ## end if ($pager =~ /^\|/)
+                        else {
+                            # Redirect I/O. STDOUT already safe.
+                            open(OUT, ">&STDOUT")    # XXX: lost message
+                              || &warn("Can't restore DB::OUT");
+                        }
+                        next CMD;
+                    } ## end unless ($piped = open(OUT,...
+
+                    # Set up broken-pipe handler if necessary.
+                    $SIG{PIPE} = \&DB::catch
+                      if $pager =~ /^\|/ &&
+                      ("" eq $SIG{PIPE} || "DEFAULT" eq $SIG{PIPE});
+
+                    # Save current filehandle, unbuffer out, and put it back.
+                    $selected = select(OUT);
+                    $|        = 1;
+
+                    # Don't put it back if pager was a pipe.
+                    select($selected), $selected = "" unless $cmd =~ /^\|\|/;
+
+                    # Trim off the pipe symbols and run the command now.
+                    $cmd =~ s/^\|+\s*//;
+                    redo PIPE;
+                };
+
+
+=head3 END OF COMMAND PARSING
+
+Anything left in C<$cmd> at this point is a Perl expression that we want to 
+evaluate. We'll always evaluate in the user's context, and fully qualify 
+any variables we might want to address in the C<DB> package.
+
+=cut
+
+                # t - turn trace on.
+                $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
+
+                # s - single-step. Remember the last command was 's'.
+                $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do { $laststep = 's' };
+
+                # n - single-step, but not into subs. Remember last command
+                # was 'n'.
+                $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do { $laststep = 'n' };
+
+            }    # PIPE:
+
+            # Make sure the flag that says "the debugger's running" is 
+            # still on, to make sure we get control again.
+            $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd";
+
+            # Run *our* eval that executes in the caller's context.
+            &eval;
+
+            # Turn off the one-time-dump stuff now.
+            if ($onetimeDump) {
+                $onetimeDump      = undef;
                 $onetimedumpDepth = undef;
-	    } elsif ($term_pid == $$) {
-		print $OUT "\n";
-	    }
-	} continue {		# CMD:
-	    if ($piped) {
-		if ($pager =~ /^\|/) {
-		    $? = 0;  
-		    # we cannot warn here: the handle is missing --tchrist
-		    close(OUT) || print SAVEOUT "\nCan't close DB::OUT\n";
-
-		    # most of the $? crud was coping with broken cshisms
-		    if ($?) {
-			print SAVEOUT "Pager `$pager' failed: ";
-			if ($? == -1) {
-			    print SAVEOUT "shell returned -1\n";
-			} elsif ($? >> 8) {
-			    print SAVEOUT 
-			      ( $? & 127 ) ? " (SIG#".($?&127).")" : "", 
-			      ( $? & 128 ) ? " -- core dumped" : "", "\n";
-			} else {
-			    print SAVEOUT "status ", ($? >> 8), "\n";
-			} 
-		    } 
-
-		    open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
-		    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
-		    $SIG{PIPE} = "DEFAULT" if $SIG{PIPE} eq \&DB::catch;
-		    # Will stop ignoring SIGPIPE if done like nohup(1)
-		    # does SIGINT but Perl doesn't give us a choice.
-		} else {
-		    open(OUT,">&SAVEOUT") || &warn("Can't restore DB::OUT");
-		}
-		close(SAVEOUT);
-		select($selected), $selected= "" unless $selected eq "";
-		$piped= "";
-	    }
-	}			# CMD:
-    $fall_off_end = 1 unless defined $cmd; # Emulate `q' on EOF
-	foreach $evalarg (@$post) {
-	  &eval;
-	}
-    }				# if ($single || $signal)
+            }
+            elsif ($term_pid == $$) {
+                STDOUT->flush();
+                STDERR->flush();
+                # XXX If this is the master pid, print a newline.
+                print $OUT "\n";
+            }
+        } ## end while (($term || &setterm...
+
+=head3 POST-COMMAND PROCESSING
+
+After each command, we check to see if the command output was piped anywhere.
+If so, we go through the necessary code to unhook the pipe and go back to
+our standard filehandles for input and output.
+
+=cut
+
+        continue {    # CMD:
+
+            # At the end of every command:
+            if ($piped) {
+                # Unhook the pipe mechanism now.
+                if ($pager =~ /^\|/) {
+                    # No error from the child.
+                    $? = 0;
+
+                    # we cannot warn here: the handle is missing --tchrist
+                    close(OUT) || print SAVEOUT "\nCan't close DB::OUT\n";
+
+                    # most of the $? crud was coping with broken cshisms
+                    # $? is explicitly set to 0, so this never runs.
+                    if ($?) {
+                        print SAVEOUT "Pager `$pager' failed: ";
+                        if ($? == -1) {
+                            print SAVEOUT "shell returned -1\n";
+                        }
+                        elsif ($? >> 8) {
+                            print SAVEOUT ($? & 127)
+                              ? " (SIG#" . ($? & 127) . ")"
+                              : "", ($? & 128) ? " -- core dumped" : "", "\n";
+                        }
+                        else {
+                            print SAVEOUT "status ", ($? >> 8), "\n";
+                        }
+                    } ## end if ($?)
+
+                    # Reopen filehandle for our output (if we can) and 
+                    # restore STDOUT (if we can).
+                    open(OUT, ">&STDOUT") || &warn("Can't restore DB::OUT");
+                    open(STDOUT, ">&SAVEOUT") ||
+                      &warn("Can't restore STDOUT");
+
+                    # Turn off pipe exception handler if necessary.
+                    $SIG{PIPE} = "DEFAULT" if $SIG{PIPE} eq \&DB::catch;
+
+                    # Will stop ignoring SIGPIPE if done like nohup(1)
+                    # does SIGINT but Perl doesn't give us a choice.
+                } ## end if ($pager =~ /^\|/)
+                else {
+                    # Non-piped "pager". Just restore STDOUT.
+                    open(OUT, ">&SAVEOUT") || &warn("Can't restore DB::OUT");
+                }
+
+                # Close filehandle pager was using, restore the normal one
+                # if necessary,
+                close(SAVEOUT);
+                select($selected), $selected = "" unless $selected eq "";
+
+                # No pipes now.
+                $piped = "";
+            } ## end if ($piped)
+        }    # CMD:
+
+=head3 COMMAND LOOP TERMINATION
+
+When commands have finished executing, we come here. If the user closed the
+input filehandle, we turn on C<$fall_off_end> to emulate a C<q> command. We
+evaluate any post-prompt items. We restore C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>,
+C<$\>, and C<$^W>, and return a null list as expected by the Perl interpreter.
+The interpreter will then execute the next line and then return control to us
+again.
+
+=cut
+
+        # No more commands? Quit.
+        $fall_off_end = 1 unless defined $cmd;    # Emulate `q' on EOF
+
+        # Evaluate post-prompt commands.
+        foreach $evalarg (@$post) {
+            &eval;
+        }
+    }    # if ($single || $signal)
+
+    # Put the user's globals back where you found them.
     ($@, $!, $^E, $,, $/, $\, $^W) = @saved;
     ();
-}
+} ## end sub DB
 
 # The following code may be executed now:
 # BEGIN {warn 4}
 
+=head2 sub
+
+C<sub> is called whenever a subroutine call happens in the program being 
+debugged. The variable C<$DB::sub> contains the name of the subroutine
+being called.
+
+The core function of this subroutine is to actually call the sub in the proper
+context, capturing its output. This of course causes C<DB::DB> to get called
+again, repeating until the subroutine ends and returns control to C<DB::sub>
+again. Once control returns, C<DB::sub> figures out whether or not to dump the
+return value, and returns its captured copy of the return value as its own
+return value. The value then feeds back into the program being debugged as if
+C<DB::sub> hadn't been there at all.
+
+C<sub> does all the work of printing the subroutine entry and exit messages
+enabled by setting C<$frame>. It notes what sub the autoloader got called for,
+and also prints the return value if needed (for the C<r> command and if 
+the 16 bit is set in C<$frame>).
+
+It also tracks the subroutine call depth by saving the current setting of
+C<$single> in the C<@stack> package global; if this exceeds the value in
+C<$deep>, C<sub> automatically turns on printing of the current depth by
+setting the 4 bit in C<$single>. In any case, it keeps the current setting
+of stop/don't stop on entry to subs set as it currently is set.
+
+=head3 C<caller()> support
+
+If C<caller()> is called from the package C<DB>, it provides some
+additional data, in the following order:
+
+=over 4
+
+=item * C<$package>
+
+The package name the sub was in
+
+=item * C<$filename>
+
+The filename it was defined in
+
+=item * C<$line>
+
+The line number it was defined on
+
+=item * C<$subroutine>
+
+The subroutine name; C<'(eval)'> if an C<eval>().
+
+=item * C<$hasargs>
+
+1 if it has arguments, 0 if not
+
+=item * C<$wantarray>
+
+1 if array context, 0 if scalar context
+
+=item * C<$evaltext>
+
+The C<eval>() text, if any (undefined for C<eval BLOCK>)
+
+=item * C<$is_require>
+
+frame was created by a C<use> or C<require> statement
+
+=item * C<$hints>
+
+pragma information; subject to change between versions
+
+=item * C<$bitmask>
+
+pragma information: subject to change between versions
+
+=item * C<@DB::args>
+
+arguments with which the subroutine was invoked
+
+=back
+
+=cut
+
 sub sub {
+
+    # Whether or not the autoloader was running, a scalar to put the
+    # sub's return value in (if needed), and an array to put the sub's
+    # return value in (if needed).
     my ($al, $ret, @ret) = "";
+
+    # If the last ten characters are C'::AUTOLOAD', note we've traced
+    # into AUTOLOAD for $sub.
     if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
-	$al = " for $$sub";
+        $al = " for $$sub";
     }
-    local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+
+    # We stack the stack pointer and then increment it to protect us
+    # from a situation that might unwind a whole bunch of call frames
+    # at once. Localizing the stack pointer means that it will automatically
+    # unwind the same amount when multiple stack frames are unwound.
+    local $stack_depth = $stack_depth + 1;    # Protect from non-local exits
+
+    # Expand @stack.
     $#stack = $stack_depth;
+
+    # Save current single-step setting.
     $stack[-1] = $single;
+
+    # Turn off all flags except single-stepping. 
     $single &= 1;
+
+    # If we've gotten really deeply recursed, turn on the flag that will
+    # make us stop with the 'deep recursion' message.
     $single |= 4 if $stack_depth == $deep;
-    ($frame & 4 
-     ? ( print_lineinfo(' ' x ($stack_depth - 1), "in  "),
-	 # Why -1? But it works! :-(
-	 print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-     : print_lineinfo(' ' x ($stack_depth - 1), "entering $sub$al\n")) if $frame;
+
+    # If frame messages are on ...
+    (
+        $frame & 4    # Extended frame entry message
+        ? (
+            print_lineinfo(' ' x ($stack_depth - 1), "in  "),
+
+            # Why -1? But it works! :-(
+            # Because print_trace will call add 1 to it and then call
+            # dump_trace; this results in our skipping -1+1 = 0 stack frames
+            # in dump_trace.
+            print_trace($LINEINFO, -1, 1, 1, "$sub$al")
+          )
+        : print_lineinfo(' ' x ($stack_depth - 1), "entering $sub$al\n")
+          # standard frame entry message
+      )
+      if $frame;
+
+    # Determine the sub's return type,and capture approppriately.
     if (wantarray) {
-	@ret = &$sub;
-	$single |= $stack[$stack_depth--];
-	($frame & 4 
-	 ? ( print_lineinfo(' ' x $stack_depth, "out "), 
-	     print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-	 : print_lineinfo(' ' x $stack_depth, "exited $sub$al\n")) if $frame & 2;
-	if ($doret eq $stack_depth or $frame & 16) {
-	    local $\ = '';
+        # Called in array context. call sub and capture output.
+        # DB::DB will recursively get control again if appropriate; we'll come
+        # back here when the sub is finished.
+        @ret = &$sub;
+
+        # Pop the single-step value back off the stack.
+        $single |= $stack[$stack_depth--];
+
+        # Check for exit trace messages...
+        (
+            $frame & 4         # Extended exit message
+            ? (
+                print_lineinfo(' ' x $stack_depth, "out "),
+                print_trace($LINEINFO, -1, 1, 1, "$sub$al")
+              )
+            : print_lineinfo(' ' x $stack_depth, "exited $sub$al\n")
+              # Standard exit message
+          )
+          if $frame & 2;
+
+        # Print the return info if we need to.
+        if ($doret eq $stack_depth or $frame & 16) {
+            # Turn off output record separator.
+            local $\ = '';
             my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
-	    print $fh ' ' x $stack_depth if $frame & 16;
-	    print $fh "list context return from $sub:\n"; 
-	    dumpit($fh, \@ret );
-	    $doret = -2;
-	}
-	@ret;
-    } else {
+
+            # Indent if we're printing because of $frame tracing.
+            print $fh ' ' x $stack_depth if $frame & 16;
+
+            # Print the return value.
+            print $fh "list context return from $sub:\n";
+            dumpit($fh, \@ret);
+
+            # And don't print it again.
+            $doret = -2;
+        } ## end if ($doret eq $stack_depth...
+        # And we have to return the return value now.
+        @ret;
+
+    } ## end if (wantarray)
+
+    # Scalar context.
+    else {
         if (defined wantarray) {
-	    $ret = &$sub;
-        } else {
-            &$sub; undef $ret;
-        };
-	$single |= $stack[$stack_depth--];
-	($frame & 4 
-	 ? (  print_lineinfo(' ' x $stack_depth, "out "),
-	      print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-	 : print_lineinfo(' ' x $stack_depth, "exited $sub$al\n")) if $frame & 2;
-	if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
-	    local $\ = '';
+            # Save the value if it's wanted at all. 
+            $ret = &$sub;
+        }
+        else {
+            # Void return, explicitly.
+            &$sub;
+            undef $ret;
+        }
+
+        # Pop the single-step value off the stack.
+        $single |= $stack[$stack_depth--];
+
+        # If we're doing exit messages...
+        (
+            $frame & 4                        # Extended messsages
+            ? (
+                print_lineinfo(' ' x $stack_depth, "out "),
+                print_trace($LINEINFO, -1, 1, 1, "$sub$al")
+              )
+            : print_lineinfo(' ' x $stack_depth, "exited $sub$al\n")
+                                              # Standard messages
+          )
+          if $frame & 2;
+
+        # If we are supposed to show the return value... same as before.
+        if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
+            local $\ = '';
             my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
-	    print $fh (' ' x $stack_depth) if $frame & 16;
-	    print $fh (defined wantarray 
-			 ? "scalar context return from $sub: " 
-			 : "void context return from $sub\n");
-	    dumpit( $fh, $ret ) if defined wantarray;
-	    $doret = -2;
-	}
-	$ret;
-    }
-}
+            print $fh (' ' x $stack_depth) if $frame & 16;
+            print $fh (
+                defined wantarray
+                ? "scalar context return from $sub: "
+                : "void context return from $sub\n"
+                );
+            dumpit($fh, $ret) if defined wantarray;
+            $doret = -2;
+        } ## end if ($doret eq $stack_depth...
+
+        # Return the appropriate scalar value.
+        $ret;
+    } ## end else [ if (wantarray)
+} ## end sub sub
+
+=head1 EXTENDED COMMAND HANDLING AND THE COMMAND API
+
+In Perl 5.8.0, there was a major realignment of the commands and what they did,
+Most of the changes were to systematize the command structure and to eliminate
+commands that threw away user input without checking.
+
+The following sections describe the code added to make it easy to support 
+multiple command sets with conflicting command names. This section is a start 
+at unifying all command processing to make it simpler to develop commands.
+
+Note that all the cmd_[a-zA-Z] subroutines require the command name, a line 
+number, and C<$dbline> (the current line) as arguments.
+
+Support functions in this section which have multiple modes of failure C<die> 
+on error; the rest simply return a false value.
+
+The user-interface functions (all of the C<cmd_*> functions) just output
+error messages.
+
+=head2 C<%set>
+
+The C<%set> hash defines the mapping from command letter to subroutine
+name suffix. 
+
+C<%set> is a two-level hash, indexed by set name and then by command name.
+Note that trying to set the CommandSet to 'foobar' simply results in the
+5.8.0 command set being used, since there's no top-level entry for 'foobar'.
+
+=cut 
 
 ### The API section
 
-### Functions with multiple modes of failure die on error, the rest
-### returns FALSE on error.
-### User-interface functions cmd_* output error message.
-
-### Note all cmd_[a-zA-Z]'s require $line, $dblineno as first arguments
-
-my %set = ( # 
-	'pre580'	=> {
-		'a'	=> 'pre580_a', 
-		'A'	=> 'pre580_null',
-		'b'	=> 'pre580_b', 
-		'B'	=> 'pre580_null',
-		'd'	=> 'pre580_null',
-		'D'	=> 'pre580_D',
-		'h'	=> 'pre580_h',
-		'M'	=> 'pre580_null',
-		'O'	=> 'o',
-		'o'	=> 'pre580_null',
-		'v'	=> 'M',
-		'w'	=> 'v',
-		'W'	=> 'pre580_W',
-	},
-);
+my %set = (    #
+    'pre580' => {
+        'a' => 'pre580_a',
+        'A' => 'pre580_null',
+        'b' => 'pre580_b',
+        'B' => 'pre580_null',
+        'd' => 'pre580_null',
+        'D' => 'pre580_D',
+        'h' => 'pre580_h',
+        'M' => 'pre580_null',
+        'O' => 'o',
+        'o' => 'pre580_null',
+        'v' => 'M',
+        'w' => 'v',
+        'W' => 'pre580_W',
+    },
+    'pre590' => {
+        '<'  => 'pre590_prepost',
+        '<<' => 'pre590_prepost',
+        '>'  => 'pre590_prepost',
+        '>>' => 'pre590_prepost',
+        '{'  => 'pre590_prepost',
+        '{{' => 'pre590_prepost',
+    },
+  );
+
+=head2 C<cmd_wrapper()> (API)
+
+C<cmd_wrapper()> allows the debugger to switch command sets 
+depending on the value of the C<CommandSet> option. 
+
+It tries to look up the command in the X<C<%set>> package-level I<lexical>
+(which means external entities can't fiddle with it) and create the name of 
+the sub to call based on the value found in the hash (if it's there). I<All> 
+of the commands to be handled in a set have to be added to C<%set>; if they 
+aren't found, the 5.8.0 equivalent is called (if there is one).
+
+This code uses symbolic references. 
+
+=cut
 
 sub cmd_wrapper {
-	my $cmd      = shift;
-	my $line     = shift;
-	my $dblineno = shift;
-
-	# with this level of indirection we can wrap 
-	# to old (pre580) or other command sets easily
-	# 
-	my $call = 'cmd_'.(
-		$set{$CommandSet}{$cmd} || $cmd
-	);
-	# print "cmd_wrapper($cmd): $CommandSet($set{$CommandSet}{$cmd}) => call($call)\n";
-
-	return &$call($line, $dblineno);
-}
+    my $cmd      = shift;
+    my $line     = shift;
+    my $dblineno = shift;
+
+    # Assemble the command subroutine's name by looking up the 
+    # command set and command name in %set. If we can't find it,
+    # default to the older version of the command.
+    my $call = 'cmd_'
+      . ( $set{$CommandSet}{$cmd}
+          || ( $cmd =~ /^[<>{]+/o ? 'prepost' : $cmd ) );
+
+    # Call the command subroutine, call it by name.
+    return &$call($cmd, $line, $dblineno);
+} ## end sub cmd_wrapper
+
+=head3 C<cmd_a> (command)
+
+The C<a> command handles pre-execution actions. These are associated with a
+particular line, so they're stored in C<%dbline>. We default to the current 
+line if none is specified. 
+
+=cut
 
 sub cmd_a {
-	my $line   = shift || ''; # [.|line] expr
-	my $dbline = shift; $line =~ s/^(\.|(?:[^\d]))/$dbline/;
-	if ($line =~ /^\s*(\d*)\s*(\S.+)/) {
-		my ($lineno, $expr) = ($1, $2);
-		if (length $expr) {
-			if ($dbline[$lineno] == 0) {
-				print $OUT "Line $lineno($dbline[$lineno]) does not have an action?\n";
-			} else {
-				$had_breakpoints{$filename} |= 2;
-				$dbline{$lineno} =~ s/\0[^\0]*//;
-				$dbline{$lineno} .= "\0" . action($expr);
-			}
-		}
-	} else {
-		print $OUT "Adding an action requires an optional lineno and an expression\n"; # hint
-	}
-}
+    my $cmd  = shift;
+    my $line = shift || '';    # [.|line] expr
+    my $dbline = shift;
+
+    # If it's dot (here), or not all digits,  use the current line.
+    $line =~ s/^(\.|(?:[^\d]))/$dbline/;
+
+    # Should be a line number followed by an expression. 
+    if ($line =~ /^\s*(\d*)\s*(\S.+)/) {
+        my ($lineno, $expr) = ($1, $2);
+
+        # If we have an expression ...
+        if (length $expr) {
+            # ... but the line isn't breakable, complain.
+            if ($dbline[$lineno] == 0) {
+                print $OUT
+                  "Line $lineno($dbline[$lineno]) does not have an action?\n";
+            }
+            else {
+                # It's executable. Record that the line has an action.
+                $had_breakpoints{$filename} |= 2;
+
+                # Remove any action, temp breakpoint, etc.
+                $dbline{$lineno} =~ s/\0[^\0]*//;
+
+                # Add the action to the line.
+                $dbline{$lineno} .= "\0" . action($expr);
+            }
+        } ## end if (length $expr)
+    } ## end if ($line =~ /^\s*(\d*)\s*(\S.+)/)
+    else {
+        # Syntax wrong.
+        print $OUT
+          "Adding an action requires an optional lineno and an expression\n"
+          ;    # hint
+    }
+} ## end sub cmd_a
+
+=head3 C<cmd_A> (command)
+
+Delete actions. Similar to above, except the delete code is in a separate
+subroutine, C<delete_action>.
+
+=cut
 
 sub cmd_A {
-	my $line   = shift || '';
-	my $dbline = shift; $line =~ s/^\./$dbline/;
-	if ($line eq '*') {
-		eval { &delete_action(); 1 } or print $OUT $@ and return;
-	} elsif ($line =~ /^(\S.*)/) {
-		eval { &delete_action($1); 1 } or print $OUT $@ and return;
-	} else {
-		print $OUT "Deleting an action requires a line number, or '*' for all\n"; # hint
-	}
-}
+    my $cmd  = shift;
+    my $line = shift || '';
+    my $dbline = shift;
+
+    # Dot is this line.
+    $line =~ s/^\./$dbline/;
+
+    # Call delete_action with a null param to delete them all.
+    # The '1' forces the eval to be true. It'll be false only
+    # if delete_action blows up for some reason, in which case
+    # we print $@ and get out.
+    if ($line eq '*') {
+        eval { &delete_action(); 1 } or print $OUT $@ and return;
+    }
+
+    # There's a real line  number. Pass it to delete_action.
+    # Error trapping is as above.
+    elsif ($line =~ /^(\S.*)/) {
+        eval { &delete_action($1); 1 } or print $OUT $@ and return;
+    }
+
+    # Swing and a miss. Bad syntax.
+    else {
+        print $OUT
+          "Deleting an action requires a line number, or '*' for all\n"
+          ;    # hint
+    }
+} ## end sub cmd_A
+
+=head3 C<delete_action> (API)
+
+C<delete_action> accepts either a line number or C<undef>. If a line number
+is specified, we check for the line being executable (if it's not, it 
+couldn't have had an  action). If it is, we just take the action off (this
+will get any kind of an action, including breakpoints).
+
+=cut
 
 sub delete_action {
-  my $i = shift;
-  if (defined($i)) {
-		die "Line $i has no action .\n" if $dbline[$i] == 0;
-		$dbline{$i} =~ s/\0[^\0]*//; # \^a
-		delete $dbline{$i} if $dbline{$i} eq '';
-	} else {
-		print $OUT "Deleting all actions...\n";
-		for my $file (keys %had_breakpoints) {
-			local *dbline = $main::{'_<' . $file};
-			my $max = $#dbline;
-			my $was;
-			for ($i = 1; $i <= $max ; $i++) {
-					if (defined $dbline{$i}) {
-							$dbline{$i} =~ s/\0[^\0]*//;
-							delete $dbline{$i} if $dbline{$i} eq '';
-					}
-				unless ($had_breakpoints{$file} &= ~2) {
-						delete $had_breakpoints{$file};
-				}
-			}
-		}
-	}
-}
+    my $i = shift;
+    if (defined($i)) {
+        # Can there be one?
+        die "Line $i has no action .\n" if $dbline[$i] == 0;
+
+        # Nuke whatever's there.
+        $dbline{$i} =~ s/\0[^\0]*//;    # \^a
+        delete $dbline{$i} if $dbline{$i} eq '';
+    }
+    else {
+        print $OUT "Deleting all actions...\n";
+        for my $file (keys %had_breakpoints) {
+            local *dbline = $main::{ '_<' . $file };
+            my $max = $#dbline;
+            my $was;
+            for ($i = 1 ; $i <= $max ; $i++) {
+                if (defined $dbline{$i}) {
+                    $dbline{$i} =~ s/\0[^\0]*//;
+                    delete $dbline{$i} if $dbline{$i} eq '';
+                }
+                unless ($had_breakpoints{$file} &= ~2) {
+                    delete $had_breakpoints{$file};
+                }
+            } ## end for ($i = 1 ; $i <= $max...
+        } ## end for my $file (keys %had_breakpoints)
+    } ## end else [ if (defined($i))
+} ## end sub delete_action
+
+=head3 C<cmd_b> (command)
+
+Set breakpoints. Since breakpoints can be set in so many places, in so many
+ways, conditionally or not, the breakpoint code is kind of complex. Mostly,
+we try to parse the command type, and then shuttle it off to an appropriate
+subroutine to actually do the work of setting the breakpoint in the right
+place.
+
+=cut
 
 sub cmd_b {
-	my $line   = shift; # [.|line] [cond]
-	my $dbline = shift; $line =~ s/^\./$dbline/;
-	if ($line =~ /^\s*$/) {
-		&cmd_b_line($dbline, 1);
-	} elsif ($line =~ /^load\b\s*(.*)/) {
-		my $file = $1; $file =~ s/\s+$//;
-		&cmd_b_load($file);
-	} elsif ($line =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/) {
-		my $cond = length $3 ? $3 : '1';
-		my ($subname, $break) = ($2, $1 eq 'postpone');
-		$subname =~ s/\'/::/g;
-		$subname = "${'package'}::" . $subname unless $subname =~ /::/;
-		$subname = "main".$subname if substr($subname,0,2) eq "::";
-		$postponed{$subname} = $break ? "break +0 if $cond" : "compile";
-	} elsif ($line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/) { 
-		$subname = $1;
-		$cond = length $2 ? $2 : '1';
-		&cmd_b_sub($subname, $cond);
-	} elsif ($line =~ /^(\d*)\s*(.*)/) { 
-		$line = $1 || $dbline;
-		$cond = length $2 ? $2 : '1';
-		&cmd_b_line($line, $cond);
-	} else {
-		print "confused by line($line)?\n";
-	}
-}
+    my $cmd    = shift;
+    my $line   = shift;    # [.|line] [cond]
+    my $dbline = shift;
+
+    # Make . the current line number if it's there..
+    $line =~ s/^\./$dbline/;
+
+    # No line number, no condition. Simple break on current line. 
+    if ($line =~ /^\s*$/) {
+        &cmd_b_line($dbline, 1);
+    }
+
+    # Break on load for a file.
+    elsif ($line =~ /^load\b\s*(.*)/) {
+        my $file = $1;
+        $file =~ s/\s+$//;
+        &cmd_b_load($file);
+    }
+
+    # b compile|postpone <some sub> [<condition>]
+    # The interpreter actually traps this one for us; we just put the 
+    # necessary condition in the %postponed hash.
+    elsif ($line =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/) {
+        # Capture the condition if there is one. Make it true if none.
+        my $cond = length $3 ? $3 : '1';
+
+        # Save the sub name and set $break to 1 if $1 was 'postpone', 0
+        # if it was 'compile'.
+        my ($subname, $break) = ($2, $1 eq 'postpone');
+
+        # De-Perl4-ify the name - ' separators to ::.
+        $subname =~ s/\'/::/g;
+
+        # Qualify it into the current package unless it's already qualified.
+        $subname = "${'package'}::" . $subname unless $subname =~ /::/;
+
+        # Add main if it starts with ::.
+        $subname = "main" . $subname if substr($subname, 0, 2) eq "::";
+
+        # Save the break type for this sub.
+        $postponed{$subname} = $break ? "break +0 if $cond" : "compile";
+    } ## end elsif ($line =~ ...
+
+    # b <sub name> [<condition>]
+    elsif ($line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/) {
+        # 
+        $subname = $1;
+        $cond = length $2 ? $2 : '1';
+        &cmd_b_sub($subname, $cond);
+    }
+
+    # b <line> [<condition>].
+    elsif ($line =~ /^(\d*)\s*(.*)/) {
+        # Capture the line. If none, it's the current line.
+        $line = $1 || $dbline;
+
+        # If there's no condition, make it '1'.
+        $cond = length $2 ? $2 : '1';
+
+        # Break on line.
+        &cmd_b_line($line, $cond);
+    }
+
+    # Line didn't make sense.
+    else {
+        print "confused by line($line)?\n";
+    }
+} ## end sub cmd_b
+
+=head3 C<break_on_load> (API)
+
+We want to break when this file is loaded. Mark this file in the
+C<%break_on_load> hash, and note that it has a breakpoint in 
+C<%had_breakpoints>.
+
+=cut
 
 sub break_on_load {
-  my $file = shift;
-  $break_on_load{$file} = 1;
-  $had_breakpoints{$file} |= 1;
+    my $file = shift;
+    $break_on_load{$file} = 1;
+    $had_breakpoints{$file} |= 1;
 }
 
+=head3 C<report_break_on_load> (API)
+
+Gives us an array of filenames that are set to break on load. Note that 
+only files with break-on-load are in here, so simply showing the keys
+suffices.
+
+=cut
+
 sub report_break_on_load {
-  sort keys %break_on_load;
+    sort keys %break_on_load;
 }
 
+=head3 C<cmd_b_load> (command)
+
+We take the file passed in and try to find it in C<%INC> (which maps modules
+to files they came from). We mark those files for break-on-load via 
+C<break_on_load> and then report that it was done.
+
+=cut
+
 sub cmd_b_load {
-  my $file = shift;
-  my @files;
-  {
-    push @files, $file;
-    push @files, $::INC{$file} if $::INC{$file};
-    $file .= '.pm', redo unless $file =~ /\./;
-  }
-  break_on_load($_) for @files;
-  @files = report_break_on_load;
-  local $\ = '';
-  local $" = ' ';
-  print $OUT "Will stop on load of `@files'.\n";
-}
+    my $file = shift;
+    my @files;
+
+    # This is a block because that way we can use a redo inside it
+    # even without there being any looping structure at all outside it.
+    {
+        # Save short name and full path if found.
+        push @files, $file;
+        push @files, $::INC{$file} if $::INC{$file};
+
+        # Tack on .pm and do it again unless there was a '.' in the name 
+        # already.
+        $file .= '.pm', redo unless $file =~ /\./;
+    }
+
+    # Do the real work here.
+    break_on_load($_) for @files;
+
+    # All the files that have break-on-load breakpoints.
+    @files = report_break_on_load;
+
+    # Normalize for the purposes of our printing this.
+    local $\ = '';
+    local $" = ' ';
+    print $OUT "Will stop on load of `@files'.\n";
+} ## end sub cmd_b_load
+
+=head3 C<$filename_error> (API package global)
+
+Several of the functions we need to implement in the API need to work both
+on the current file and on other files. We don't want to duplicate code, so
+C<$filename_error> is used to contain the name of the file that's being 
+worked on (if it's not the current one).
+
+We can now build functions in pairs: the basic function works on the current
+file, and uses C<$filename_error> as part of its error message. Since this is
+initialized to C<''>, no filename will appear when we are working on the
+current file.
+
+The second function is a wrapper which does the following:
+
+=over 4 
+
+=item * Localizes C<$filename_error> and sets it to the name of the file to be processed.
+
+=item * Localizes the C<*dbline> glob and reassigns it to point to the file we want to process. 
+
+=item * Calls the first function. 
+
+The first function works on the "current" (i.e., the one we changed to) file,
+and prints C<$filename_error> in the error message (the name of the other file)
+if it needs to. When the functions return, C<*dbline> is restored to point to the actual current file (the one we're executing in) and C<$filename_error> is 
+restored to C<''>. This restores everything to the way it was before the 
+second function was called at all.
+
+See the comments in C<breakable_line> and C<breakable_line_in_file> for more
+details.
+
+=back
+
+=cut
 
 $filename_error = '';
 
+=head3 breakable_line($from, $to) (API)
+
+The subroutine decides whether or not a line in the current file is breakable.
+It walks through C<@dbline> within the range of lines specified, looking for
+the first line that is breakable.
+
+If C<$to> is greater than C<$from>, the search moves forwards, finding the 
+first line I<after> C<$to> that's breakable, if there is one.
+
+If C<$from> is greater than C<$to>, the search goes I<backwards>, finding the
+first line I<before> C<$to> that's breakable, if there is one.
+
+=cut
+
 sub breakable_line {
-  my ($from, $to) = @_;
-  my $i = $from;
-  if (@_ >= 2) {
-    my $delta = $from < $to ? +1 : -1;
-    my $limit = $delta > 0 ? $#dbline : 1;
-    $limit = $to if ($limit - $to) * $delta > 0;
-    $i += $delta while $dbline[$i] == 0 and ($limit - $i) * $delta > 0;
-  }
-  return $i unless $dbline[$i] == 0;
-  my ($pl, $upto) = ('', '');
-  ($pl, $upto) = ('s', "..$to") if @_ >=2 and $from != $to;
-  die "Line$pl $from$upto$filename_error not breakable\n";
-}
+    
+    my ($from, $to) = @_;
+
+    # $i is the start point. (Where are the FORTRAN programs of yesteryear?)
+    my $i = $from;
+
+    # If there are at least 2 arguments, we're trying to search a range.
+    if (@_ >= 2) {
+
+        # $delta is positive for a forward search, negative for a backward one.
+        my $delta = $from < $to ? +1 : -1;
+
+        # Keep us from running off the ends of the file.
+        my $limit = $delta > 0 ? $#dbline : 1;
+
+        # Clever test. If you're a mathematician, it's obvious why this
+        # test works. If not:
+        # If $delta is positive (going forward), $limit will be $#dbline.
+        #    If $to is less than $limit, ($limit - $to) will be positive, times
+        #    $delta of 1 (positive), so the result is > 0 and we should use $to
+        #    as the stopping point. 
+        #
+        #    If $to is greater than $limit, ($limit - $to) is negative,
+        #    times $delta of 1 (positive), so the result is < 0 and we should 
+        #    use $limit ($#dbline) as the stopping point.
+        #
+        # If $delta is negative (going backward), $limit will be 1. 
+        #    If $to is zero, ($limit - $to) will be 1, times $delta of -1
+        #    (negative) so the result is > 0, and we use $to as the stopping
+        #    point.
+        #
+        #    If $to is less than zero, ($limit - $to) will be positive,
+        #    times $delta of -1 (negative), so the result is not > 0, and 
+        #    we use $limit (1) as the stopping point. 
+        #
+        #    If $to is 1, ($limit - $to) will zero, times $delta of -1
+        #    (negative), still giving zero; the result is not > 0, and 
+        #    we use $limit (1) as the stopping point.
+        #
+        #    if $to is >1, ($limit - $to) will be negative, times $delta of -1
+        #    (negative), giving a positive (>0) value, so we'll set $limit to
+        #    $to.
+        
+        $limit = $to if ($limit - $to) * $delta > 0;
+
+        # The real search loop.
+        # $i starts at $from (the point we want to start searching from).
+        # We move through @dbline in the appropriate direction (determined
+        # by $delta: either -1 (back) or +1 (ahead). 
+        # We stay in as long as we haven't hit an executable line 
+        # ($dbline[$i] == 0 means not executable) and we haven't reached
+        # the limit yet (test similar to the above).
+        $i += $delta while $dbline[$i] == 0 and ($limit - $i) * $delta > 0;
+
+    } ## end if (@_ >= 2)
+
+    # If $i points to a line that is executable, return that.
+    return $i unless $dbline[$i] == 0;
+
+    # Format the message and print it: no breakable lines in range.
+    my ($pl, $upto) = ('', '');
+    ($pl, $upto) = ('s', "..$to") if @_ >= 2 and $from != $to;
+
+    # If there's a filename in filename_error, we'll see it.
+    # If not, not.
+    die "Line$pl $from$upto$filename_error not breakable\n";
+} ## end sub breakable_line
+
+=head3 breakable_line_in_filename($file, $from, $to) (API)
+
+Like C<breakable_line>, but look in another file.
+
+=cut
 
 sub breakable_line_in_filename {
-  my ($f) = shift;
-  local *dbline = $main::{'_<' . $f};
-  local $filename_error = " of `$f'";
-  breakable_line(@_);
-}
+    # Capture the file name.
+    my ($f) = shift;
+
+    # Swap the magic line array over there temporarily.
+    local *dbline         = $main::{ '_<' . $f };
+
+    # If there's an error, it's in this other file.
+    local $filename_error = " of `$f'";
+
+    # Find the breakable line.
+    breakable_line(@_);
+
+    # *dbline and $filename_error get restored when this block ends.
+
+} ## end sub breakable_line_in_filename
+
+=head3 break_on_line(lineno, [condition]) (API)
+
+Adds a breakpoint with the specified condition (or 1 if no condition was 
+specified) to the specified line. Dies if it can't.
+
+=cut
 
 sub break_on_line {
-  my ($i, $cond) = @_;
-  $cond = 1 unless @_ >= 2;
-  my $inii = $i;
-  my $after = '';
-  my $pl = '';
-  die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
-  $had_breakpoints{$filename} |= 1;
-  if ($dbline{$i}) { $dbline{$i} =~ s/^[^\0]*/$cond/; }
-  else { $dbline{$i} = $cond; }
-}
+    my ($i, $cond) = @_;
+
+    # Always true if no condition supplied.
+    $cond = 1 unless @_ >= 2;
+
+    my $inii  = $i;
+    my $after = '';
+    my $pl    = '';
+
+    # Woops, not a breakable line. $filename_error allows us to say
+    # if it was in a different file.
+    die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
+
+    # Mark this file as having breakpoints in it.
+    $had_breakpoints{$filename} |= 1;
+
+    # If there is an action or condition here already ... 
+    if ($dbline{$i}) { 
+        # ... swap this condition for the existing one.
+        $dbline{$i} =~ s/^[^\0]*/$cond/; 
+    }
+    else { 
+        # Nothing here - just add the condition.
+        $dbline{$i} = $cond; 
+    }
+} ## end sub break_on_line
+
+=head3 cmd_b_line(line, [condition]) (command)
+
+Wrapper for C<break_on_line>. Prints the failure message if it 
+doesn't work.
+
+=cut 
 
 sub cmd_b_line {
-  eval { break_on_line(@_); 1 } or do {
-    local $\ = '';
-    print $OUT $@ and return;
-  };
-}
+    eval { break_on_line(@_); 1 } or do {
+        local $\ = '';
+        print $OUT $@ and return;
+    };
+} ## end sub cmd_b_line
+
+=head3 break_on_filename_line(file, line, [condition]) (API)
+
+Switches to the file specified and then calls C<break_on_line> to set 
+the breakpoint.
+
+=cut
 
 sub break_on_filename_line {
-  my ($f, $i, $cond) = @_;
-  $cond = 1 unless @_ >= 3;
-  local *dbline = $main::{'_<' . $f};
-  local $filename_error = " of `$f'";
-  local $filename = $f;
-  break_on_line($i, $cond);
-}
+    my ($f, $i, $cond) = @_;
+
+    # Always true if condition left off.
+    $cond = 1 unless @_ >= 3;
+
+    # Switch the magical hash temporarily.
+    local *dbline         = $main::{ '_<' . $f };
+
+    # Localize the variables that break_on_line uses to make its message.
+    local $filename_error = " of `$f'";
+    local $filename       = $f;
+
+    # Add the breakpoint.
+    break_on_line($i, $cond);
+} ## end sub break_on_filename_line
+
+=head3 break_on_filename_line_range(file, from, to, [condition]) (API)
+
+Switch to another file, search the range of lines specified for an 
+executable one, and put a breakpoint on the first one you find.
+
+=cut
 
 sub break_on_filename_line_range {
-  my ($f, $from, $to, $cond) = @_;
-  my $i = breakable_line_in_filename($f, $from, $to);
-  $cond = 1 unless @_ >= 3;
-  break_on_filename_line($f,$i,$cond);
-}
+    my ($f, $from, $to, $cond) = @_;
+
+    # Find a breakable line if there is one.
+    my $i = breakable_line_in_filename($f, $from, $to);
+
+    # Always true if missing.
+    $cond = 1 unless @_ >= 3;
+
+    # Add the breakpoint.
+    break_on_filename_line($f, $i, $cond);
+} ## end sub break_on_filename_line_range
+
+=head3 subroutine_filename_lines(subname, [condition]) (API)
+
+Search for a subroutine within a given file. The condition is ignored.
+Uses C<find_sub> to locate the desired subroutine.
+
+=cut
 
 sub subroutine_filename_lines {
-  my ($subname,$cond) = @_;
-  # Filename below can contain ':'
-  find_sub($subname) =~ /^(.*):(\d+)-(\d+)$/;
-}
+    my ($subname, $cond) = @_;
+
+    # Returned value from find_sub() is fullpathname:startline-endline.
+    # The match creates the list (fullpathname, start, end). Falling off
+    # the end of the subroutine returns this implicitly.
+    find_sub($subname) =~ /^(.*):(\d+)-(\d+)$/;
+} ## end sub subroutine_filename_lines
+
+=head3 break_subroutine(subname) (API)
+
+Places a break on the first line possible in the specified subroutine. Uses
+C<subroutine_filename_lines> to find the subroutine, and 
+C<break_on_filename_line_range> to place the break.
+
+=cut
 
 sub break_subroutine {
-  my $subname = shift;
-  my ($file,$s,$e) = subroutine_filename_lines($subname) or
-    die "Subroutine $subname not found.\n";
-  $cond = 1 unless @_ >= 2;
-  break_on_filename_line_range($file,$s,$e,@_);
-}
+    my $subname = shift;
+
+    # Get filename, start, and end.
+    my ($file, $s, $e) = subroutine_filename_lines($subname)
+      or die "Subroutine $subname not found.\n";
+
+    # Null condition changes to '1' (always true).
+    $cond = 1 unless @_ >= 2;
+
+    # Put a break the first place possible in the range of lines
+    # that make up this subroutine.
+    break_on_filename_line_range($file, $s, $e, @_);
+} ## end sub break_subroutine
+
+=head3 cmd_b_sub(subname, [condition]) (command)
+
+We take the incoming subroutine name and fully-qualify it as best we can.
+
+=over 4
+
+=item 1. If it's already fully-qualified, leave it alone. 
+
+=item 2. Try putting it in the current package.
+
+=item 3. If it's not there, try putting it in CORE::GLOBAL if it exists there.
+
+=item 4. If it starts with '::', put it in 'main::'.
+
+=back
+
+After all this cleanup, we call C<break_subroutine> to try to set the 
+breakpoint.
+
+=cut
 
 sub cmd_b_sub {
-  my ($subname,$cond) = @_;
-  $cond = 1 unless @_ >= 2;
-  unless (ref $subname eq 'CODE') {
-    $subname =~ s/\'/::/g;
-    my $s = $subname;
-    $subname = "${'package'}::" . $subname
-      unless $subname =~ /::/;
-    $subname = "CORE::GLOBAL::$s"
-      if not defined &$subname and $s !~ /::/ and defined &{"CORE::GLOBAL::$s"};
-    $subname = "main".$subname if substr($subname,0,2) eq "::";
-  }
-  eval { break_subroutine($subname,$cond); 1 } or do {
-    local $\ = '';
-    print $OUT $@ and return;
-  }
-}
+    my ($subname, $cond) = @_;
+
+    # Add always-true condition if we have none.
+    $cond = 1 unless @_ >= 2;
+
+    # If the subname isn't a code reference, qualify it so that 
+    # break_subroutine() will work right.
+    unless (ref $subname eq 'CODE') {
+        # Not Perl4.
+        $subname =~ s/\'/::/g;
+        my $s = $subname;
+
+        # Put it in this package unless it's already qualified.
+        $subname = "${'package'}::" . $subname
+          unless $subname =~ /::/;
+
+        # Requalify it into CORE::GLOBAL if qualifying it into this
+        # package resulted in its not being defined, but only do so
+        # if it really is in CORE::GLOBAL.
+        $subname = "CORE::GLOBAL::$s"
+          if not defined &$subname
+          and $s !~ /::/
+          and defined &{"CORE::GLOBAL::$s"};
+
+        # Put it in package 'main' if it has a leading ::.
+        $subname = "main" . $subname if substr($subname, 0, 2) eq "::";
+
+    } ## end unless (ref $subname eq 'CODE')
+
+    # Try to set the breakpoint.
+    eval { break_subroutine($subname, $cond); 1 } or do {
+        local $\ = '';
+        print $OUT $@ and return;
+      }
+} ## end sub cmd_b_sub
+
+=head3 C<cmd_B> - delete breakpoint(s) (command)
+
+The command mostly parses the command line and tries to turn the argument
+into a line spec. If it can't, it uses the current line. It then calls
+C<delete_breakpoint> to actually do the work.
+
+If C<*> is  specified, C<cmd_B> calls C<delete_breakpoint> with no arguments,
+thereby deleting all the breakpoints.
+
+=cut
 
 sub cmd_B {
-	my $line   = ($_[0] =~ /^\./) ? $dbline : shift || ''; 
-	my $dbline = shift; $line =~ s/^\./$dbline/;
-	if ($line eq '*') {
-		eval { &delete_breakpoint(); 1 } or print $OUT $@ and return;
-	} elsif ($line =~ /^(\S.*)/) {
-		eval { &delete_breakpoint($line || $dbline); 1 } or do {
-                    local $\ = '';
-                    print $OUT $@ and return;
-                };
-	} else {
-		print $OUT "Deleting a breakpoint requires a line number, or '*' for all\n"; # hint
-	}
-}
+    my $cmd  = shift;
+
+    # No line spec? Use dbline. 
+    # If there is one, use it if it's non-zero, or wipe it out if it is.
+    my $line = ($_[0] =~ /^\./) ? $dbline : shift || '';
+    my $dbline = shift;
+
+    # If the line was dot, make the line the current one.
+    $line =~ s/^\./$dbline/;
+
+    # If it's * we're deleting all the breakpoints.
+    if ($line eq '*') {
+        eval { &delete_breakpoint(); 1 } or print $OUT $@ and return;
+    }
+
+    # If there is a line spec, delete the breakpoint on that line.
+    elsif ($line =~ /^(\S.*)/) {
+        eval { &delete_breakpoint($line || $dbline); 1 } or do {
+            local $\ = '';
+            print $OUT $@ and return;
+        };
+    } ## end elsif ($line =~ /^(\S.*)/)
+
+    # No line spec. 
+    else {
+        print $OUT
+          "Deleting a breakpoint requires a line number, or '*' for all\n"
+          ;    # hint
+    }
+} ## end sub cmd_B
+
+=head3 delete_breakpoint([line]) (API)
+
+This actually does the work of deleting either a single breakpoint, or all
+of them.
+
+For a single line, we look for it in C<@dbline>. If it's nonbreakable, we
+just drop out with a message saying so. If it is, we remove the condition
+part of the 'condition\0action' that says there's a breakpoint here. If,
+after we've done that, there's nothing left, we delete the corresponding
+line in C<%dbline> to signal that no action needs to be taken for this line.
+
+For all breakpoints, we iterate through the keys of C<%had_breakpoints>, 
+which lists all currently-loaded files which have breakpoints. We then look
+at each line in each of these files, temporarily switching the C<%dbline>
+and C<@dbline> structures to point to the files in question, and do what
+we did in the single line case: delete the condition in C<@dbline>, and
+delete the key in C<%dbline> if nothing's left.
+
+We then wholesale delete C<%postponed>, C<%postponed_file>, and 
+C<%break_on_load>, because these structures contain breakpoints for files
+and code that haven't been loaded yet. We can just kill these off because there
+are no magical debugger structures associated with them.
+
+=cut
 
 sub delete_breakpoint {
-  my $i = shift;
-  if (defined($i)) {
-	  die "Line $i not breakable.\n" if $dbline[$i] == 0;
-	  $dbline{$i} =~ s/^[^\0]*//;
-	  delete $dbline{$i} if $dbline{$i} eq '';
-  } else {
-		  print $OUT "Deleting all breakpoints...\n";
-		  for my $file (keys %had_breakpoints) {
-					local *dbline = $main::{'_<' . $file};
-					my $max = $#dbline;
-					my $was;
-					for ($i = 1; $i <= $max ; $i++) {
-							if (defined $dbline{$i}) {
-						$dbline{$i} =~ s/^[^\0]+//;
-						if ($dbline{$i} =~ s/^\0?$//) {
-								delete $dbline{$i};
-						}
-							}
-					}
-					if (not $had_breakpoints{$file} &= ~1) {
-							delete $had_breakpoints{$file};
-					}
-		  }
-		  undef %postponed;
-		  undef %postponed_file;
-		  undef %break_on_load;
-	}
-}
+    my $i = shift;
 
-sub cmd_stop {			# As on ^C, but not signal-safy.
-  $signal = 1;
+    # If we got a line, delete just that one.
+    if (defined($i)) {
+
+        # Woops. This line wasn't breakable at all.
+        die "Line $i not breakable.\n" if $dbline[$i] == 0;
+
+        # Kill the condition, but leave any action.
+        $dbline{$i} =~ s/^[^\0]*//;
+
+        # Remove the entry entirely if there's no action left.
+        delete $dbline{$i} if $dbline{$i} eq '';
+    }
+
+    # No line; delete them all.
+    else {
+        print $OUT "Deleting all breakpoints...\n";
+
+        # %had_breakpoints lists every file that had at least one
+        # breakpoint in it.
+        for my $file (keys %had_breakpoints) {
+            # Switch to the desired file temporarily.
+            local *dbline = $main::{ '_<' . $file };
+
+            my $max = $#dbline;
+            my $was;
+
+            # For all lines in this file ...
+            for ($i = 1 ; $i <= $max ; $i++) {
+                # If there's a breakpoint or action on this line ...
+                if (defined $dbline{$i}) {
+                    # ... remove the breakpoint.
+                    $dbline{$i} =~ s/^[^\0]+//;
+                    if ($dbline{$i} =~ s/^\0?$//) {
+                        # Remove the entry altogether if no action is there.
+                        delete $dbline{$i};
+                    }
+                } ## end if (defined $dbline{$i...
+            } ## end for ($i = 1 ; $i <= $max...
+
+            # If, after we turn off the "there were breakpoints in this file"
+            # bit, the entry in %had_breakpoints for this file is zero, 
+            # we should remove this file from the hash.
+            if (not $had_breakpoints{$file} &= ~1) {
+                delete $had_breakpoints{$file};
+            }
+        } ## end for my $file (keys %had_breakpoints)
+
+        # Kill off all the other breakpoints that are waiting for files that
+        # haven't been loaded yet.
+        undef %postponed;
+        undef %postponed_file;
+        undef %break_on_load;
+    } ## end else [ if (defined($i))
+} ## end sub delete_breakpoint
+
+=head3 cmd_stop (command)
+
+This is meant to be part of the new command API, but it isn't called or used
+anywhere else in the debugger. XXX It is probably meant for use in development
+of new commands.
+
+=cut
+
+sub cmd_stop {    # As on ^C, but not signal-safy.
+    $signal = 1;
 }
 
+=head3 C<cmd_h> - help command (command)
+
+Does the work of either
+
+=over 4
+
+=item * Showing all the debugger help
+
+=item * Showing help for a specific command
+
+=back
+
+=cut
+
 sub cmd_h {
-	my $line   = shift || '';
-	if ($line  =~ /^h\s*/) {
-		print_help($help);
-	} elsif ($line =~ /^(\S.*)$/) { 
-			# support long commands; otherwise bogus errors
-			# happen when you ask for h on <CR> for example
-			my $asked = $1;			# for proper errmsg
-			my $qasked = quotemeta($asked); # for searching
-			# XXX: finds CR but not <CR>
-			if ($help =~ /^<?(?:[IB]<)$qasked/m) {
-			  while ($help =~ /^(<?(?:[IB]<)$qasked([\s\S]*?)\n)(?!\s)/mg) {
-			    print_help($1);
-			  }
-			} else {
-			    print_help("B<$asked> is not a debugger command.\n");
-			}
-	} else {
-			print_help($summary);
-	}
-}
+    my $cmd  = shift;
+
+    # If we have no operand, assume null.
+    my $line = shift || '';
+
+    # 'h h'. Print the long-format help.
+    if ($line =~ /^h\s*/) {
+        print_help($help);
+    }
+
+    # 'h <something>'. Search for the command and print only its help.
+    elsif ($line =~ /^(\S.*)$/) {
+
+        # support long commands; otherwise bogus errors
+        # happen when you ask for h on <CR> for example
+        my $asked  = $1;                   # the command requested
+                                           # (for proper error message)
+
+        my $qasked = quotemeta($asked);    # for searching; we don't
+                                           # want to use it as a pattern.
+                                           # XXX: finds CR but not <CR>
+
+        # Search the help string for the command.
+        if ($help =~ /^                    # Start of a line
+                      <?                   # Optional '<'
+                      (?:[IB]<)            # Optional markup
+                      $qasked              # The requested command
+                     /mx) {
+            # It's there; pull it out and print it.
+            while ($help =~ /^
+                              (<?            # Optional '<'
+                                 (?:[IB]<)   # Optional markup
+                                 $qasked     # The command
+                                 ([\s\S]*?)  # Description line(s)
+                              \n)            # End of last description line
+                              (?!\s)         # Next line not starting with 
+                                             # whitespace
+                             /mgx) {
+                print_help($1);
+            }
+        }
+
+        # Not found; not a debugger command.
+        else {
+            print_help("B<$asked> is not a debugger command.\n");
+        }
+    } ## end elsif ($line =~ /^(\S.*)$/)
+
+    # 'h' - print the summary help.
+    else {
+        print_help($summary);
+    }
+} ## end sub cmd_h
+
+=head3 C<cmd_l> - list lines (command)
+
+Most of the command is taken up with transforming all the different line
+specification syntaxes into 'start-stop'. After that is done, the command
+runs a loop over C<@dbline> for the specified range of lines. It handles 
+the printing of each line and any markers (C<==E<gt>> for current line,
+C<b> for break on this line, C<a> for action on this line, C<:> for this
+line breakable). 
+
+We save the last line listed in the C<$start> global for further listing
+later.
+
+=cut
 
 sub cmd_l {
-	my $line = shift;
-	$line =~ s/^-\s*$/-/;
-	if ($line =~ /^(\$.*)/s) {
-		$evalarg = $2;
-		my ($s) = &eval;
-		print($OUT "Error: $@\n"), next CMD if $@;
-		$s = CvGV_name($s);
-		print($OUT "Interpreted as: $1 $s\n");
-		$line = "$1 $s";
-		&cmd_l($s);
-	} elsif ($line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s) { 
-		my $s = $subname = $1;
-		$subname =~ s/\'/::/;
-		$subname = $package."::".$subname 
-		unless $subname =~ /::/;
-		$subname = "CORE::GLOBAL::$s"
-		if not defined &$subname and $s !~ /::/
-			 and defined &{"CORE::GLOBAL::$s"};
-		$subname = "main".$subname if substr($subname,0,2) eq "::";
-		@pieces = split(/:/,find_sub($subname) || $sub{$subname});
-		$subrange = pop @pieces;
-		$file = join(':', @pieces);
-		if ($file ne $filename) {
-			print $OUT "Switching to file '$file'.\n"
-		unless $slave_editor;
-			*dbline = $main::{'_<' . $file};
-			$max = $#dbline;
-			$filename = $file;
-		}
-		if ($subrange) {
-			if (eval($subrange) < -$window) {
-		$subrange =~ s/-.*/+/;
-			}
-			$line = $subrange;
-			&cmd_l($subrange);
-		} else {
-			print $OUT "Subroutine $subname not found.\n";
-		}
-	} elsif ($line =~ /^\s*$/) {
-		$incr = $window - 1;
-		$line = $start . '-' . ($start + $incr); 
-		&cmd_l($line);
-	} elsif ($line =~ /^(\d*)\+(\d*)$/) { 
-		$start = $1 if $1;
-		$incr = $2;
-		$incr = $window - 1 unless $incr;
-		$line = $start . '-' . ($start + $incr); 
-		&cmd_l($line);	
-	} elsif ($line =~ /^((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/) { 
-		$end = (!defined $2) ? $max : ($4 ? $4 : $2);
-		$end = $max if $end > $max;
-		$i = $2;
-		$i = $line if $i eq '.';
-		$i = 1 if $i < 1;
-		$incr = $end - $i;
-		if ($slave_editor) {
-			print $OUT "\032\032$filename:$i:0\n";
-			$i = $end;
-		} else {
-			for (; $i <= $end; $i++) {
-				my ($stop,$action);
-				($stop,$action) = split(/\0/, $dbline{$i}) if
-						$dbline{$i};
-							$arrow = ($i==$line 
-						and $filename eq $filename_ini) 
-					?  '==>' 
-						: ($dbline[$i]+0 ? ':' : ' ') ;
-				$arrow .= 'b' if $stop;
-				$arrow .= 'a' if $action;
-				print $OUT "$i$arrow\t", $dbline[$i];
-				$i++, last if $signal;
-			}
-			print $OUT "\n" unless $dbline[$i-1] =~ /\n$/;
-		}
-		$start = $i; # remember in case they want more
-		$start = $max if $start > $max;
-	}
-}
+    my $current_line  = $line;
+
+    my $cmd           = shift;
+    my $line          = shift;
+
+    # If this is '-something', delete any spaces after the dash.
+    $line =~ s/^-\s*$/-/;
+
+    # If the line is '$something', assume this is a scalar containing a 
+    # line number.
+    if ($line =~ /^(\$.*)/s) {
+
+        # Set up for DB::eval() - evaluate in *user* context.
+        $evalarg = $1;
+        my ($s) = &eval;
+
+        # Ooops. Bad scalar.
+        print($OUT "Error: $@\n"), next CMD if $@;
+
+        # Good scalar. If it's a reference, find what it points to.
+        $s = CvGV_name($s);
+        print($OUT "Interpreted as: $1 $s\n");
+        $line = "$1 $s";
+
+        # Call self recursively to really do the command.
+        &cmd_l('l', $s);
+    } ## end if ($line =~ /^(\$.*)/s)
+
+    # l name. Try to find a sub by that name. 
+    elsif ($line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s) {
+        my $s = $subname = $1;
+
+        # De-Perl4.
+        $subname =~ s/\'/::/;
+
+        # Put it in this package unless it starts with ::.
+        $subname = $package . "::" . $subname unless $subname =~ /::/;
+
+        # Put it in CORE::GLOBAL if t doesn't start with :: and
+        # it doesn't live in this package and it lives in CORE::GLOBAL.
+        $subname = "CORE::GLOBAL::$s"
+          if not defined &$subname
+          and $s !~ /::/
+          and defined &{"CORE::GLOBAL::$s"};
+
+        # Put leading '::' names into 'main::'.
+        $subname = "main" . $subname if substr($subname, 0, 2) eq "::";
+
+        # Get name:start-stop from find_sub, and break this up at 
+        # colons.
+        @pieces = split (/:/, find_sub($subname) || $sub{$subname});
+
+        # Pull off start-stop.
+        $subrange = pop @pieces;
+
+        # If the name contained colons, the split broke it up.
+        # Put it back together.
+        $file     = join (':', @pieces);
+
+        # If we're not in that file, switch over to it.
+        if ($file ne $filename) {
+            print $OUT "Switching to file '$file'.\n"
+              unless $slave_editor;
+
+            # Switch debugger's magic structures.
+            *dbline   = $main::{ '_<' . $file };
+            $max      = $#dbline;
+            $filename = $file;
+        } ## end if ($file ne $filename)
+
+        # Subrange is 'start-stop'. If this is less than a window full,
+        # swap it to 'start+', which will list a window from the start point.
+        if ($subrange) {
+            if (eval($subrange) < -$window) {
+                $subrange =~ s/-.*/+/;
+            }
+            # Call self recursively to list the range.
+            $line = $subrange;
+            &cmd_l('l', $subrange);
+        } ## end if ($subrange)
+
+        # Couldn't find it.
+        else {
+            print $OUT "Subroutine $subname not found.\n";
+        }
+    } ## end elsif ($line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s)
+
+    # Bare 'l' command.
+    elsif ($line =~ /^\s*$/) {
+        # Compute new range to list.
+        $incr = $window - 1;
+        $line = $start . '-' . ($start + $incr);
+        # Recurse to do it.
+        &cmd_l('l', $line);
+    }
+
+    # l [start]+number_of_lines
+    elsif ($line =~ /^(\d*)\+(\d*)$/) {
+        # Don't reset start for 'l +nnn'.
+        $start = $1 if $1;
+
+        # Increment for list. Use window size if not specified.
+        # (Allows 'l +' to work.)
+        $incr = $2;
+        $incr = $window - 1 unless $incr;
+
+        # Create a line range we'll understand, and recurse to do it.
+        $line = $start . '-' . ($start + $incr);
+        &cmd_l('l', $line);
+    } ## end elsif ($line =~ /^(\d*)\+(\d*)$/)
+
+    # l start-stop or l start,stop
+    elsif ($line =~ /^((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/) {
+
+        # Determine end point; use end of file if not specified.
+        $end = (!defined $2) ? $max : ($4 ? $4 : $2);
+
+        # Go on to the end, and then stop.
+        $end = $max if $end > $max;
+
+        # Determine start line.  
+        $i = $2;
+        $i = $line if $i eq '.';
+        $i = 1 if $i < 1;
+        $incr = $end - $i;
+
+        # If we're running under a slave editor, force it to show the lines.
+        if ($slave_editor) {
+            print $OUT "\032\032$filename:$i:0\n";
+            $i = $end;
+        }
+
+        # We're doing it ourselves. We want to show the line and special
+        # markers for:
+        # - the current line in execution 
+        # - whether a line is breakable or not
+        # - whether a line has a break or not
+        # - whether a line has an action or not
+        else {
+            for (; $i <= $end ; $i++) {
+                # Check for breakpoints and actions.
+                my ($stop, $action);
+                ($stop, $action) = split (/\0/, $dbline{$i})
+                  if $dbline{$i};
+
+                # ==> if this is the current line in execution,
+                # : if it's breakable.
+                $arrow =
+                  ($i == $current_line and $filename eq $filename_ini)
+                  ? '==>'
+                  : ($dbline[$i] + 0 ? ':' : ' ');
+
+                # Add break and action indicators.
+                $arrow .= 'b' if $stop;
+                $arrow .= 'a' if $action;
+
+                # Print the line.
+                print $OUT "$i$arrow\t", $dbline[$i];
+
+                # Move on to the next line. Drop out on an interrupt.
+                $i++, last if $signal;
+            } ## end for (; $i <= $end ; $i++)
+
+            # Line the prompt up; print a newline if the last line listed
+            # didn't have a newline.
+            print $OUT "\n" unless $dbline[$i - 1] =~ /\n$/;
+        } ## end else [ if ($slave_editor)
+
+        # Save the point we last listed to in case another relative 'l'
+        # command is desired. Don't let it run off the end.
+        $start = $i;
+        $start = $max if $start > $max;
+    } ## end elsif ($line =~ /^((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/)
+} ## end sub cmd_l
+
+=head3 C<cmd_L> - list breakpoints, actions, and watch expressions (command)
+
+To list breakpoints, the command has to look determine where all of them are
+first. It starts a C<%had_breakpoints>, which tells us what all files have
+breakpoints and/or actions. For each file, we switch the C<*dbline> glob (the 
+magic source and breakpoint data structures) to the file, and then look 
+through C<%dbline> for lines with breakpoints and/or actions, listing them 
+out. We look through C<%postponed> not-yet-compiled subroutines that have 
+breakpoints, and through C<%postponed_file> for not-yet-C<require>'d files 
+that have breakpoints.
+
+Watchpoints are simpler: we just list the entries in C<@to_watch>.
+
+=cut
 
 sub cmd_L {
-	my $arg    = shift || 'abw'; $arg = 'abw' unless $CommandSet eq '580'; # sigh...
-	my $action_wanted = ($arg =~ /a/) ? 1 : 0;
-	my $break_wanted  = ($arg =~ /b/) ? 1 : 0;
-	my $watch_wanted  = ($arg =~ /w/) ? 1 : 0;
-
-	if ($break_wanted or $action_wanted) {
-		for my $file (keys %had_breakpoints) {
-			local *dbline = $main::{'_<' . $file};
-			my $max = $#dbline;
-			my $was;
-			for ($i = 1; $i <= $max; $i++) {
-				if (defined $dbline{$i}) {
-					print $OUT "$file:\n" unless $was++;
-					print $OUT " $i:\t", $dbline[$i];
-					($stop,$action) = split(/\0/, $dbline{$i});
-					print $OUT "   break if (", $stop, ")\n"
-						if $stop and $break_wanted;
-					print $OUT "   action:  ", $action, "\n"
-						if $action and $action_wanted;
-					last if $signal;
-				}
-			}
-		}
-	}
-	if (%postponed and $break_wanted) {
-		print $OUT "Postponed breakpoints in subroutines:\n";
-		my $subname;
-		for $subname (keys %postponed) {
-		  print $OUT " $subname\t$postponed{$subname}\n";
-		  last if $signal;
-		}
-	}
-	my @have = map { # Combined keys
-			keys %{$postponed_file{$_}}
-	} keys %postponed_file;
-	if (@have and ($break_wanted or $action_wanted)) {
-		print $OUT "Postponed breakpoints in files:\n";
-		my ($file, $line);
-		for $file (keys %postponed_file) {
-		  my $db = $postponed_file{$file};
-		  print $OUT " $file:\n";
-		  for $line (sort {$a <=> $b} keys %$db) {
-			print $OUT "  $line:\n";
-			my ($stop,$action) = split(/\0/, $$db{$line});
-			print $OUT "    break if (", $stop, ")\n"
-			  if $stop and $break_wanted;
-			print $OUT "    action:  ", $action, "\n"
-			  if $action and $action_wanted;
-			last if $signal;
-		  }
-		  last if $signal;
-		}
-	}
-  if (%break_on_load and $break_wanted) {
-		print $OUT "Breakpoints on load:\n";
-		my $file;
-		for $file (keys %break_on_load) {
-		  print $OUT " $file\n";
-		  last if $signal;
-		}
-  }
-  if ($watch_wanted) {
-	if ($trace & 2) {
-		print $OUT "Watch-expressions:\n" if @to_watch;
-		for my $expr (@to_watch) {
-			print $OUT " $expr\n";
-			last if $signal;
-		}
-	}
-  }
-}
+    my $cmd = shift;
+
+    # If no argument, list everything. Pre-5.8.0 version always lists 
+    # everything
+    my $arg = shift || 'abw';
+    $arg = 'abw' unless $CommandSet eq '580';    # sigh...
+
+    # See what is wanted.
+    my $action_wanted = ($arg =~ /a/) ? 1 : 0;
+    my $break_wanted  = ($arg =~ /b/) ? 1 : 0;
+    my $watch_wanted  = ($arg =~ /w/) ? 1 : 0;
+
+    # Breaks and actions are found together, so we look in the same place
+    # for both.
+    if ($break_wanted or $action_wanted) {
+        # Look in all the files with breakpoints...
+        for my $file (keys %had_breakpoints) {
+            # Temporary switch to this file.
+            local *dbline = $main::{ '_<' . $file };
+
+            # Set up to look through the whole file.
+            my $max = $#dbline;
+            my $was;                         # Flag: did we print something
+                                             # in this file?
+
+            # For each line in the file ...
+            for ($i = 1 ; $i <= $max ; $i++) {
+                # We've got something on this line.
+                if (defined $dbline{$i}) {
+                    # Print the header if we haven't.
+                    print $OUT "$file:\n" unless $was++;
+
+                    # Print the line.
+                    print $OUT " $i:\t", $dbline[$i];
+
+                    # Pull out the condition and the action.
+                    ($stop, $action) = split (/\0/, $dbline{$i});
+
+                    # Print the break if there is one and it's wanted.
+                    print $OUT "   break if (", $stop, ")\n"
+                      if $stop
+                      and $break_wanted;
+
+                    # Print the action if there is one and it's wanted.
+                    print $OUT "   action:  ", $action, "\n"
+                      if $action
+                      and $action_wanted;
+
+                    # Quit if the user hit interrupt.
+                    last if $signal;
+                } ## end if (defined $dbline{$i...
+            } ## end for ($i = 1 ; $i <= $max...
+        } ## end for my $file (keys %had_breakpoints)
+    } ## end if ($break_wanted or $action_wanted)
+
+    # Look for breaks in not-yet-compiled subs:
+    if (%postponed and $break_wanted) {
+        print $OUT "Postponed breakpoints in subroutines:\n";
+        my $subname;
+        for $subname (keys %postponed) {
+            print $OUT " $subname\t$postponed{$subname}\n";
+            last if $signal;
+        }
+    } ## end if (%postponed and $break_wanted)
+
+    # Find files that have not-yet-loaded breaks:
+    my @have = map {    # Combined keys
+        keys %{ $postponed_file{$_} }
+    } keys %postponed_file;
+
+    # If there are any, list them.
+    if (@have and ($break_wanted or $action_wanted)) {
+        print $OUT "Postponed breakpoints in files:\n";
+        my ($file, $line);
+
+        for $file (keys %postponed_file) {
+            my $db = $postponed_file{$file};
+            print $OUT " $file:\n";
+            for $line (sort { $a <=> $b } keys %$db) {
+                print $OUT "  $line:\n";
+                my ($stop, $action) = split (/\0/, $$db{$line});
+                print $OUT "    break if (", $stop, ")\n"
+                  if $stop
+                  and $break_wanted;
+                print $OUT "    action:  ", $action, "\n"
+                  if $action
+                  and $action_wanted;
+                last if $signal;
+            } ## end for $line (sort { $a <=>...
+            last if $signal;
+        } ## end for $file (keys %postponed_file)
+    } ## end if (@have and ($break_wanted...
+    if (%break_on_load and $break_wanted) {
+        print $OUT "Breakpoints on load:\n";
+        my $file;
+        for $file (keys %break_on_load) {
+            print $OUT " $file\n";
+            last if $signal;
+        }
+    } ## end if (%break_on_load and...
+    if ($watch_wanted) {
+        if ($trace & 2) {
+            print $OUT "Watch-expressions:\n" if @to_watch;
+            for my $expr (@to_watch) {
+                print $OUT " $expr\n";
+                last if $signal;
+            }
+        } ## end if ($trace & 2)
+    } ## end if ($watch_wanted)
+} ## end sub cmd_L
+
+=head3 C<cmd_M> - list modules (command)
+
+Just call C<list_modules>.
+
+=cut
 
 sub cmd_M {
-	&list_modules();
+    &list_modules();
 }
 
+=head3 C<cmd_o> - options (command)
+
+If this is just C<o> by itself, we list the current settings via 
+C<dump_option>. If there's a nonblank value following it, we pass that on to
+C<parse_options> for processing.
+
+=cut
+
 sub cmd_o {
-	my $opt      = shift || ''; # opt[=val]
-	if ($opt =~ /^(\S.*)/) {
-		&parse_options($1);
-	} else {
-		for (@options) {
-			&dump_option($_);
-		}
-	}
-}
+    my $cmd = shift;
+    my $opt = shift || '';    # opt[=val]
+
+    # Nonblank. Try to parse and process.
+    if ($opt =~ /^(\S.*)/) {
+        &parse_options($1);
+    }
+
+    # Blank. List the current option settings.
+    else {
+        for (@options) {
+            &dump_option($_);
+        }
+    }
+} ## end sub cmd_o
+
+=head3 C<cmd_O> - nonexistent in 5.8.x (command)
+
+Advises the user that the O command has been renamed.
+
+=cut
 
 sub cmd_O {
-	print $OUT "The old O command is now the o command.\n";        # hint
-	print $OUT "Use 'h' to get current command help synopsis or\n"; # 
-	print $OUT "use 'o CommandSet=pre580' to revert to old usage\n"; # 
+    print $OUT "The old O command is now the o command.\n";             # hint
+    print $OUT "Use 'h' to get current command help synopsis or\n";     #
+    print $OUT "use 'o CommandSet=pre580' to revert to old usage\n";    #
 }
 
+=head3 C<cmd_v> - view window (command)
+
+Uses the C<$preview> variable set in the second C<BEGIN> block (q.v.) to
+move back a few lines to list the selected line in context. Uses C<cmd_l>
+to do the actual listing after figuring out the range of line to request.
+
+=cut 
+
 sub cmd_v {
-	my $line = shift;
-
-	if ($line =~ /^(\d*)$/) {
-		$incr = $window - 1;
-		$start = $1 if $1;
-		$start -= $preview;
-		$line = $start . '-' . ($start + $incr);
-		&cmd_l($line);
-	}
-}
+    my $cmd  = shift;
+    my $line = shift;
+
+    # Extract the line to list around. (Astute readers will have noted that
+    # this pattern will match whether or not a numeric line is specified,
+    # which means that we'll always enter this loop (though a non-numeric
+    # argument results in no action at all)).
+    if ($line =~ /^(\d*)$/) {
+        # Total number of lines to list (a windowful).
+        $incr = $window - 1;
+
+        # Set the start to the argument given (if there was one).
+       $start = $1 if $1;
+
+        # Back up by the context amount.
+        $start -= $preview;
+
+        # Put together a linespec that cmd_l will like.
+        $line = $start . '-' . ($start + $incr);
+
+        # List the lines.
+        &cmd_l('l', $line);
+    } ## end if ($line =~ /^(\d*)$/)
+} ## end sub cmd_v
+
+=head3 C<cmd_w> - add a watch expression (command)
+
+The 5.8 version of this command adds a watch expression if one is specified;
+it does nothing if entered with no operands.
+
+We extract the expression, save it, evaluate it in the user's context, and
+save the value. We'll re-evaluate it each time the debugger passes a line,
+and will stop (see the code at the top of the command loop) if the value
+of any of the expressions changes.
+
+=cut
 
 sub cmd_w {
-	my $expr     = shift || '';
-	if ($expr =~ /^(\S.*)/) {
-		push @to_watch, $expr;
-		$evalarg = $expr;
-		my ($val) = &eval;
-		$val = (defined $val) ? "'$val'" : 'undef' ;
-		push @old_watch, $val;
-		$trace |= 2;
-	} else {
-		print $OUT "Adding a watch-expression requires an expression\n"; # hint
-	}
-}
+    my $cmd  = shift;
+
+    # Null expression if no arguments.
+    my $expr = shift || '';
+
+    # If expression is not null ...
+    if ($expr =~ /^(\S.*)/) {
+        # ... save it.
+        push @to_watch, $expr;
+
+        # Parameterize DB::eval and call it to get the expression's value
+        # in the user's context. This version can handle expressions which
+        # return a list value.
+        $evalarg = $expr;
+        my ($val) = join(' ', &eval);
+        $val = (defined $val) ? "'$val'" : 'undef';
+
+        # Save the current value of the expression.
+        push @old_watch, $val;
+
+        # We are now watching expressions.
+        $trace |= 2;
+    } ## end if ($expr =~ /^(\S.*)/)
+
+    # You have to give one to get one.
+    else {
+        print $OUT
+          "Adding a watch-expression requires an expression\n";    # hint
+    }
+} ## end sub cmd_w
+
+=head3 C<cmd_W> - delete watch expressions (command)
+
+This command accepts either a watch expression to be removed from the list
+of watch expressions, or C<*> to delete them all.
+
+If C<*> is specified, we simply empty the watch expression list and the 
+watch expression value list. We also turn off the bit that says we've got 
+watch expressions.
+
+If an expression (or partial expression) is specified, we pattern-match
+through the expressions and remove the ones that match. We also discard
+the corresponding values. If no watch expressions are left, we turn off 
+the 'watching expressions' bit.
+
+=cut
 
 sub cmd_W {
-	my $expr     = shift || '';
-	if ($expr eq '*') {
-		$trace &= ~2;
-		print $OUT "Deleting all watch expressions ...\n";
-		@to_watch = @old_watch = ();
-	} elsif ($expr =~ /^(\S.*)/) {
-		my $i_cnt = 0;
-		foreach (@to_watch) {
-			my $val = $to_watch[$i_cnt];
-			if ($val eq $expr) { # =~ m/^\Q$i$/) {
-				splice(@to_watch, $i_cnt, 1);
-			}
-			$i_cnt++;
-		}
-	} else {
-		print $OUT "Deleting a watch-expression requires an expression, or '*' for all\n"; # hint
-	}
-}
+    my $cmd  = shift;
+    my $expr = shift || '';
+
+    # Delete them all.
+    if ($expr eq '*') {
+        # Not watching now.
+        $trace &= ~2;
+
+        print $OUT "Deleting all watch expressions ...\n";
+
+        # And all gone.
+        @to_watch = @old_watch = ();
+    }
+
+    # Delete one of them.
+    elsif ($expr =~ /^(\S.*)/) {
+        # Where we are in the list.
+        my $i_cnt = 0;
+
+        # For each expression ...
+        foreach (@to_watch) {
+            my $val = $to_watch[$i_cnt];
+
+            # Does this one match the command argument?
+            if ($val eq $expr) {    # =~ m/^\Q$i$/) {
+                # Yes. Turn it off, and its value too.
+                splice(@to_watch, $i_cnt, 1);
+                splice(@old_watch, $i_cnt, 1);
+            }
+            $i_cnt++;
+        } ## end foreach (@to_watch)
+
+        # We don't bother to turn watching off because
+        #  a) we don't want to stop calling watchfunction() it it exists
+        #  b) foreach over a null list doesn't do anything anyway
+
+    } ## end elsif ($expr =~ /^(\S.*)/)
+
+    # No command arguments entered.
+    else {
+        print $OUT
+"Deleting a watch-expression requires an expression, or '*' for all\n"
+          ;                         # hint
+    }
+} ## end sub cmd_W
 
 ### END of the API section
 
+=head1 SUPPORT ROUTINES
+
+These are general support routines that are used in a number of places
+throughout the debugger.
+
+=head2 save
+
+save() saves the user's versions of globals that would mess us up in C<@saved>,
+and installs the versions we like better. 
+
+=cut
+
 sub save {
+    # Save eval failure, command failure, extended OS error, output field 
+    # separator, input record separator, output record separator and 
+    # the warning setting.
     @saved = ($@, $!, $^E, $,, $/, $\, $^W);
-    $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
-}
+
+    $,     = "";             # output field separator is null string
+    $/     = "\n";           # input record separator is newline
+    $\     = "";             # output record separator is null string
+    $^W    = 0;              # warnings are off
+} ## end sub save
+
+=head2 C<print_lineinfo> - show where we are now
+
+print_lineinfo prints whatever it is that it is handed; it prints it to the
+C<$LINEINFO> filehandle instead of just printing it to STDOUT. This allows
+us to feed line information to a slave editor without messing up the 
+debugger output.
+
+=cut
 
 sub print_lineinfo {
-  resetterm(1) if $LINEINFO eq $OUT and $term_pid != $$;
-  local $\ = '';
-  local $, = '';
-  print $LINEINFO @_;
-}
+    # Make the terminal sensible if we're not the primary debugger.
+    resetterm(1) if $LINEINFO eq $OUT and $term_pid != $$;
+    local $\ = '';
+    local $, = '';
+    print $LINEINFO @_;
+} ## end sub print_lineinfo
+
+=head2 C<postponed_sub>
+
+Handles setting postponed breakpoints in subroutines once they're compiled.
+For breakpoints, we use C<DB::find_sub> to locate the source file and line
+range for the subroutine, then mark the file as having a breakpoint,
+temporarily switch the C<*dbline> glob over to the source file, and then 
+search the given range of lines to find a breakable line. If we find one,
+we set the breakpoint on it, deleting the breakpoint from C<%postponed>.
+
+=cut 
 
 # The following takes its argument via $evalarg to preserve current @_
 
 sub postponed_sub {
-  my $subname = shift;
-  if ($postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s//) {
-    my $offset = $1 || 0;
-    # Filename below can contain ':'
-    my ($file,$i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
-    if ($i) {
-      $i += $offset;
-      local *dbline = $main::{'_<' . $file};
-      local $^W = 0;		# != 0 is magical below
-      $had_breakpoints{$file} |= 1;
-      my $max = $#dbline;
-      ++$i until $dbline[$i] != 0 or $i >= $max;
-      $dbline{$i} = delete $postponed{$subname};
-    } else {
-      local $\ = '';
-      print $OUT "Subroutine $subname not found.\n";
-    }
-    return;
-  }
-  elsif ($postponed{$subname} eq 'compile') { $signal = 1 }
-  #print $OUT "In postponed_sub for `$subname'.\n";
-}
+    # Get the subroutine name.
+    my $subname = shift;
+
+    # If this is a 'break +<n> if <condition>' ...
+    if ($postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s//) {
+        # If there's no offset, use '+0'.
+        my $offset = $1 || 0;
+
+        # find_sub's value is 'fullpath-filename:start-stop'. It's
+        # possible that the filename might have colons in it too.
+        my ($file, $i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
+        if ($i) {
+            # We got the start line. Add the offset '+<n>' from 
+            # $postponed{subname}.
+            $i += $offset;
+
+            # Switch to the file this sub is in, temporarily.
+            local *dbline = $main::{ '_<' . $file };
+
+            # No warnings, please.
+            local $^W     = 0;                         # != 0 is magical below
+
+            # This file's got a breakpoint in it.
+            $had_breakpoints{$file} |= 1;
+
+            # Last line in file.
+            my $max = $#dbline;
+
+            # Search forward until we hit a breakable line or get to
+            # the end of the file.
+            ++$i until $dbline[$i] != 0 or $i >= $max;
+
+            # Copy the breakpoint in and delete it from %postponed.
+            $dbline{$i} = delete $postponed{$subname};
+        } ## end if ($i)
+
+        # find_sub didn't find the sub.
+        else {
+            local $\ = '';
+            print $OUT "Subroutine $subname not found.\n";
+        }
+        return;
+    } ## end if ($postponed{$subname...
+    elsif ($postponed{$subname} eq 'compile') { $signal = 1 }
+
+    #print $OUT "In postponed_sub for `$subname'.\n";
+} ## end sub postponed_sub
+
+=head2 C<postponed>
+
+Called after each required file is compiled, but before it is executed;
+also called if the name of a just-compiled subroutine is a key of 
+C<%postponed>. Propagates saved breakpoints (from C<b compile>, C<b load>,
+etc.) into the just-compiled code.
+
+If this is a C<require>'d file, the incoming parameter is the glob 
+C<*{"_<$filename"}>, with C<$filename> the name of the C<require>'d file.
+
+If it's a subroutine, the incoming parameter is the subroutine name.
+
+=cut
 
 sub postponed {
-  if ($ImmediateStop) {
-    $ImmediateStop = 0;
-    $signal = 1;
-  }
-  return &postponed_sub
-    unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
-  # Cannot be done before the file is compiled
-  local *dbline = shift;
-  my $filename = $dbline;
-  $filename =~ s/^_<//;
-  local $\ = '';
-  $signal = 1, print $OUT "'$filename' loaded...\n"
-    if $break_on_load{$filename};
-  print_lineinfo(' ' x $stack_depth, "Package $filename.\n") if $frame;
-  return unless $postponed_file{$filename};
-  $had_breakpoints{$filename} |= 1;
-  #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
-  my $key;
-  for $key (keys %{$postponed_file{$filename}}) {
-    $dbline{$key} = ${$postponed_file{$filename}}{$key};
-  }
-  delete $postponed_file{$filename};
-}
+    # If there's a break, process it.
+    if ($ImmediateStop) {
+        # Right, we've stopped. Turn it off.
+        $ImmediateStop = 0;
+
+        # Enter the command loop when DB::DB gets called.
+        $signal        = 1;
+    }
+
+    # If this is a subroutine, let postponed_sub() deal with it.
+    return &postponed_sub unless ref \$_[0] eq 'GLOB';
+
+    # Not a subroutine. Deal with the file.
+    local *dbline = shift;
+    my $filename = $dbline;
+    $filename =~ s/^_<//;
+    local $\ = '';
+    $signal = 1, print $OUT "'$filename' loaded...\n"
+      if $break_on_load{$filename};
+    print_lineinfo(' ' x $stack_depth, "Package $filename.\n") if $frame;
+
+    # Do we have any breakpoints to put in this file?
+    return unless $postponed_file{$filename};
+
+    # Yes. Mark this file as having breakpoints.
+    $had_breakpoints{$filename} |= 1;
+
+    # "Cannot be done: unsufficient magic" - we can't just put the
+    # breakpoints saved in %postponed_file into %dbline by assigning
+    # the whole hash; we have to do it one item at a time for the
+    # breakpoints to be set properly.
+    #%dbline = %{$postponed_file{$filename}}; 
+
+    # Set the breakpoints, one at a time.
+    my $key;
+
+    for $key (keys %{ $postponed_file{$filename} }) {
+        # Stash the saved breakpoint into the current file's magic line array.
+        $dbline{$key} = ${ $postponed_file{$filename} }{$key};
+    }
+
+    # This file's been compiled; discard the stored breakpoints.
+    delete $postponed_file{$filename};
+
+} ## end sub postponed
+
+=head2 C<dumpit>
+
+C<dumpit> is the debugger's wrapper around dumpvar.pl. 
+
+It gets a filehandle (to which C<dumpvar.pl>'s output will be directed) and
+a reference to a variable (the thing to be dumped) as its input. 
+
+The incoming filehandle is selected for output (C<dumpvar.pl> is printing to
+the currently-selected filehandle, thank you very much). The current
+values of the package globals C<$single> and C<$trace> are backed up in 
+lexicals, and they are turned off (this keeps the debugger from trying
+to single-step through C<dumpvar.pl> (I think.)). C<$frame> is localized to
+preserve its current value and it is set to zero to prevent entry/exit
+messages from printing, and C<$doret> is localized as well and set to -2 to 
+prevent return values from being shown.
+
+C<dumpit()> then checks to see if it needs to load C<dumpvar.pl> and 
+tries to load it (note: if you have a C<dumpvar.pl>  ahead of the 
+installed version in @INC, yours will be used instead. Possible security 
+problem?).
+
+It then checks to see if the subroutine C<main::dumpValue> is now defined
+(it should have been defined by C<dumpvar.pl>). If it has, C<dumpit()> 
+localizes the globals necessary for things to be sane when C<main::dumpValue()>
+is called, and picks up the variable to be dumped from the parameter list. 
+
+It checks the package global C<%options> to see if there's a C<dumpDepth> 
+specified. If not, -1 is assumed; if so, the supplied value gets passed on to 
+C<dumpvar.pl>. This tells C<dumpvar.pl> where to leave off when dumping a 
+structure: -1 means dump everything.
+
+C<dumpValue()> is then called if possible; if not, C<dumpit()>just prints a 
+warning.
+
+In either case, C<$single>, C<$trace>, C<$frame>, and C<$doret> are restored
+and we then return to the caller.
+
+=cut
 
 sub dumpit {
+    # Save the current output filehandle and switch to the one
+    # passed in as the first parameter.
     local ($savout) = select(shift);
+
+    # Save current settings of $single and $trace, and then turn them off.
     my $osingle = $single;
-    my $otrace = $trace;
+    my $otrace  = $trace;
     $single = $trace = 0;
+
+    # XXX Okay, what do $frame and $doret do, again?
     local $frame = 0;
     local $doret = -2;
+
+    # Load dumpvar.pl unless we've already got the sub we need from it.
     unless (defined &main::dumpValue) {
-	do 'dumpvar.pl';
+        do 'dumpvar.pl';
     }
+
+    # If the load succeeded (or we already had dumpvalue()), go ahead
+    # and dump things.
     if (defined &main::dumpValue) {
         local $\ = '';
         local $, = '';
         local $" = ' ';
         my $v = shift;
         my $maxdepth = shift || $option{dumpDepth};
-        $maxdepth = -1 unless defined $maxdepth;   # -1 means infinite depth
-	&main::dumpValue($v, $maxdepth);
-    } else {
+        $maxdepth = -1 unless defined $maxdepth;    # -1 means infinite depth
+        &main::dumpValue($v, $maxdepth);
+    } ## end if (defined &main::dumpValue)
+
+    # Oops, couldn't load dumpvar.pl.
+    else {
         local $\ = '';
-	print $OUT "dumpvar.pl not available.\n";
+        print $OUT "dumpvar.pl not available.\n";
     }
+
+    # Reset $single and $trace to their old values.
     $single = $osingle;
-    $trace = $otrace;
-    select ($savout);    
-}
+    $trace  = $otrace;
+
+    # Restore the old filehandle.
+    select($savout);
+} ## end sub dumpit
+
+=head2 C<print_trace>
+
+C<print_trace>'s job is to print a stack trace. It does this via the 
+C<dump_trace> routine, which actually does all the ferreting-out of the
+stack trace data. C<print_trace> takes care of formatting it nicely and
+printing it to the proper filehandle.
+
+Parameters:
+
+=over 4
+
+=item * The filehandle to print to.
+
+=item * How many frames to skip before starting trace.
+
+=item * How many frames to print.
+
+=item * A flag: if true, print a "short" trace without filenames, line numbers, or arguments
+
+=back
+
+The original comment below seems to be noting that the traceback may not be
+correct if this routine is called in a tied method.
+
+=cut
 
 # Tied method do not create a context, so may get wrong message:
 
 sub print_trace {
-  local $\ = '';
-  my $fh = shift;
-  resetterm(1) if $fh eq $LINEINFO and $LINEINFO eq $OUT and $term_pid != $$;
-  my @sub = dump_trace($_[0] + 1, $_[1]);
-  my $short = $_[2];		# Print short report, next one for sub name
-  my $s;
-  for ($i=0; $i <= $#sub; $i++) {
-    last if $signal;
-    local $" = ', ';
-    my $args = defined $sub[$i]{args} 
-    ? "(@{ $sub[$i]{args} })"
-      : '' ;
-    $args = (substr $args, 0, $maxtrace - 3) . '...' 
-      if length $args > $maxtrace;
-    my $file = $sub[$i]{file};
-    $file = $file eq '-e' ? $file : "file `$file'" unless $short;
-    $s = $sub[$i]{sub};
-    $s = (substr $s, 0, $maxtrace - 3) . '...' if length $s > $maxtrace;    
-    if ($short) {
-      my $sub = @_ >= 4 ? $_[3] : $s;
-      print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
-    } else {
-      print $fh "$sub[$i]{context} = $s$args" .
-	" called from $file" . 
-	  " line $sub[$i]{line}\n";
-    }
-  }
-}
+    local $\ = '';
+    my $fh = shift;
+    # If this is going to a slave editor, but we're not the primary
+    # debugger, reset it first.
+    resetterm(1)
+      if $fh eq $LINEINFO          # slave editor
+      and $LINEINFO eq $OUT        # normal output
+      and $term_pid != $$;         # not the primary
+
+    # Collect the actual trace information to be formatted.
+    # This is an array of hashes of subroutine call info.
+    my @sub = dump_trace($_[0] + 1, $_[1]);
+
+    # Grab the "short report" flag from @_.
+    my $short = $_[2];    # Print short report, next one for sub name
+
+    # Run through the traceback info, format it, and print it.
+    my $s;
+    for ($i = 0 ; $i <= $#sub ; $i++) {
+        # Drop out if the user has lost interest and hit control-C.
+        last if $signal;
+
+        # Set the separator so arrys print nice. 
+        local $" = ', ';
+
+        # Grab and stringify the arguments if they are there.
+        my $args =
+          defined $sub[$i]{args}
+          ? "(@{ $sub[$i]{args} })"
+          : '';
+        # Shorten them up if $maxtrace says they're too long.
+        $args = (substr $args, 0, $maxtrace - 3) . '...'
+          if length $args > $maxtrace;
+
+        # Get the file name.
+        my $file = $sub[$i]{file};
+
+        # Put in a filename header if short is off.
+        $file = $file eq '-e' ? $file : "file `$file'" unless $short;
+
+        # Get the actual sub's name, and shorten to $maxtrace's requirement.
+        $s = $sub[$i]{sub};
+        $s = (substr $s, 0, $maxtrace - 3) . '...' if length $s > $maxtrace;
+
+        # Short report uses trimmed file and sub names.
+        if ($short) {
+            my $sub = @_ >= 4 ? $_[3] : $s;
+            print $fh
+              "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
+        } ## end if ($short)
+
+        # Non-short report includes full names.
+        else {
+            print $fh "$sub[$i]{context} = $s$args" . " called from $file" .
+              " line $sub[$i]{line}\n";
+        }
+    } ## end for ($i = 0 ; $i <= $#sub...
+} ## end sub print_trace
+
+=head2 dump_trace(skip[,count])
+
+Actually collect the traceback information available via C<caller()>. It does
+some filtering and cleanup of the data, but mostly it just collects it to
+make C<print_trace()>'s job easier.
+
+C<skip> defines the number of stack frames to be skipped, working backwards
+from the most current. C<count> determines the total number of frames to 
+be returned; all of them (well, the first 10^9) are returned if C<count>
+is omitted.
+
+This routine returns a list of hashes, from most-recent to least-recent
+stack frame. Each has the following keys and values:
+
+=over 4
+
+=item * C<context> - C<.> (null), C<$> (scalar), or C<@> (array)
+
+=item * C<sub> - subroutine name, or C<eval> information
+
+=item * C<args> - undef, or a reference to an array of arguments
+
+=item * C<file> - the file in which this item was defined (if any)
+
+=item * C<line> - the line on which it was defined
+
+=back
+
+=cut
 
 sub dump_trace {
-  my $skip = shift;
-  my $count = shift || 1e9;
-  $skip++;
-  $count += $skip;
-  my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context);
-  my $nothard = not $frame & 8;
-  local $frame = 0;		# Do not want to trace this.
-  my $otrace = $trace;
-  $trace = 0;
-  for ($i = $skip; 
-       $i < $count and ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); 
-       $i++) {
-    @a = ();
-    for $arg (@args) {
-      my $type;
-      if (not defined $arg) {
-	push @a, "undef";
-      } elsif ($nothard and tied $arg) {
-	push @a, "tied";
-      } elsif ($nothard and $type = ref $arg) {
-	push @a, "ref($type)";
-      } else {
-	local $_ = "$arg";	# Safe to stringify now - should not call f().
-	s/([\'\\])/\\$1/g;
-	s/(.*)/'$1'/s
-	  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
-	s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-	s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
-	push(@a, $_);
-      }
-    }
-    $context = $context ? '@' : (defined $context ? "\$" : '.');
-    $args = $h ? [@a] : undef;
-    $e =~ s/\n\s*\;\s*\Z// if $e;
-    $e =~ s/([\\\'])/\\$1/g if $e;
-    if ($r) {
-      $sub = "require '$e'";
-    } elsif (defined $r) {
-      $sub = "eval '$e'";
-    } elsif ($sub eq '(eval)') {
-      $sub = "eval {...}";
-    }
-    push(@sub, {context => $context, sub => $sub, args => $args,
-		file => $file, line => $line});
-    last if $signal;
-  }
-  $trace = $otrace;
-  @sub;
-}
+
+    # How many levels to skip.
+    my $skip = shift;
+
+    # How many levels to show. (1e9 is a cheap way of saying "all of them";
+    # it's unlikely that we'll have more than a billion stack frames. If you
+    # do, you've got an awfully big machine...)
+    my $count = shift || 1e9;
+
+    # We increment skip because caller(1) is the first level *back* from
+    # the current one.  Add $skip to the count of frames so we have a 
+    # simple stop criterion, counting from $skip to $count+$skip.
+    $skip++;
+    $count += $skip;
+
+    # These variables are used to capture output from caller();
+    my ($p, $file, $line, $sub, $h, $context);
+
+    my ($e, $r, @a, @sub, $args);
+
+    # XXX Okay... why'd we do that?
+    my $nothard = not $frame & 8;
+    local $frame = 0;    
+
+    # Do not want to trace this.
+    my $otrace = $trace;
+    $trace = 0;
+
+    # Start out at the skip count.
+    # If we haven't reached the number of frames requested, and caller() is
+    # still returning something, stay in the loop. (If we pass the requested
+    # number of stack frames, or we run out - caller() returns nothing - we
+    # quit.
+    # Up the stack frame index to go back one more level each time.
+    for (
+        $i = $skip ;
+        $i < $count
+        and ($p, $file, $line, $sub, $h, $context, $e, $r) = caller($i) ;
+        $i++
+      )
+    {
+
+        # Go through the arguments and save them for later.
+        @a = ();
+        for $arg (@args) {
+            my $type;
+            if (not defined $arg) {                    # undefined parameter
+                push @a, "undef";
+            }
+
+            elsif ($nothard and tied $arg) {           # tied parameter
+                push @a, "tied";
+            }
+            elsif ($nothard and $type = ref $arg) {    # reference
+                push @a, "ref($type)";
+            }
+            else {                                     # can be stringified
+                local $_ =
+                  "$arg";    # Safe to stringify now - should not call f().
+
+                # Backslash any single-quotes or backslashes.
+                s/([\'\\])/\\$1/g;
+
+                # Single-quote it unless it's a number or a colon-separated
+                # name.
+                s/(.*)/'$1'/s
+                  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+
+                # Turn high-bit characters into meta-whatever.
+                s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+
+                # Turn control characters into ^-whatever.
+                s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+
+                push (@a, $_);
+            } ## end else [ if (not defined $arg)
+        } ## end for $arg (@args)
+
+        # If context is true, this is array (@)context.
+        # If context is false, this is scalar ($) context.
+        # If neither, context isn't defined. (This is apparently a 'can't 
+        # happen' trap.)
+        $context = $context ? '@' : (defined $context ? "\$" : '.');
+
+        # if the sub has args ($h true), make an anonymous array of the
+        # dumped args.
+        $args = $h ? [@a] : undef;
+
+        # remove trailing newline-whitespace-semicolon-end of line sequence
+        # from the eval text, if any.
+        $e =~ s/\n\s*\;\s*\Z//  if $e;
+
+        # Escape backslashed single-quotes again if necessary.
+        $e =~ s/([\\\'])/\\$1/g if $e;
+
+        # if the require flag is true, the eval text is from a require.
+        if ($r) {
+            $sub = "require '$e'";
+        }
+        # if it's false, the eval text is really from an eval.
+        elsif (defined $r) {
+            $sub = "eval '$e'";
+        }
+
+        # If the sub is '(eval)', this is a block eval, meaning we don't
+        # know what the eval'ed text actually was.
+        elsif ($sub eq '(eval)') {
+            $sub = "eval {...}";
+        }
+
+        # Stick the collected information into @sub as an anonymous hash.
+        push (
+            @sub,
+            {
+                context => $context,
+                sub     => $sub,
+                args    => $args,
+                file    => $file,
+                line    => $line
+            }
+            );
+
+        # Stop processing frames if the user hit control-C.
+        last if $signal;
+    } ## end for ($i = $skip ; $i < ...
+
+    # Restore the trace value again.
+    $trace = $otrace;
+    @sub;
+} ## end sub dump_trace
+
+=head2 C<action()>
+
+C<action()> takes input provided as the argument to an add-action command,
+either pre- or post-, and makes sure it's a complete command. It doesn't do
+any fancy parsing; it just keeps reading input until it gets a string
+without a trailing backslash.
+
+=cut
 
 sub action {
     my $action = shift;
+
     while ($action =~ s/\\$//) {
-	#print $OUT "+ ";
-	#$action .= "\n";
-	$action .= &gets;
-    }
+        # We have a backslash on the end. Read more.
+        $action .= &gets;
+    } ## end while ($action =~ s/\\$//)
+
+    # Return the assembled action.
     $action;
-}
+} ## end sub action
+
+=head2 unbalanced
 
-sub unbalanced { 
-    # i hate using globals!
+This routine mostly just packages up a regular expression to be used
+to check that the thing it's being matched against has properly-matched
+curly braces.
+
+Of note is the definition of the $balanced_brace_re global via ||=, which
+speeds things up by only creating the qr//'ed expression once; if it's 
+already defined, we don't try to define it again. A speed hack.
+
+=cut
+
+sub unbalanced {
+
+    # I hate using globals!
     $balanced_brace_re ||= qr{ 
-	^ \{
-	      (?:
-		 (?> [^{}] + )    	    # Non-parens without backtracking
-	       |
-		 (??{ $balanced_brace_re }) # Group with matching parens
-	      ) *
-	  \} $
+        ^ \{
+             (?:
+                 (?> [^{}] + )              # Non-parens without backtracking
+                |
+                 (??{ $balanced_brace_re }) # Group with matching parens
+              ) *
+          \} $
    }x;
-   return $_[0] !~ m/$balanced_brace_re/;
-}
+    return $_[0] !~ m/$balanced_brace_re/;
+} ## end sub unbalanced
+
+=head2 C<gets()>
+
+C<gets()> is a primitive (very primitive) routine to read continuations.
+It was devised for reading continuations for actions.
+it just reads more input with X<C<readline()>> and returns it.
+
+=cut
 
 sub gets {
     &readline("cont: ");
 }
 
+=head2 C<DB::system()> - handle calls to<system()> without messing up the debugger
+
+The C<system()> function assumes that it can just go ahead and use STDIN and
+STDOUT, but under the debugger, we want it to use the debugger's input and 
+outout filehandles. 
+
+C<DB::system()> socks away the program's STDIN and STDOUT, and then substitutes
+the debugger's IN and OUT filehandles for them. It does the C<system()> call,
+and then puts everything back again.
+
+=cut
+
 sub system {
+
     # We save, change, then restore STDIN and STDOUT to avoid fork() since
     # some non-Unix systems can do system() but have problems with fork().
-    open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
-    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
-    open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
-    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
+    open(SAVEIN,  "<&STDIN")  || &warn("Can't save STDIN");
+    open(SAVEOUT, ">&STDOUT") || &warn("Can't save STDOUT");
+    open(STDIN,   "<&IN")     || &warn("Can't redirect STDIN");
+    open(STDOUT,  ">&OUT")    || &warn("Can't redirect STDOUT");
 
     # XXX: using csh or tcsh destroys sigint retvals!
     system(@_);
-    open(STDIN,"<&SAVEIN") || &warn("Can't restore STDIN");
-    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
-    close(SAVEIN); 
+    open(STDIN,  "<&SAVEIN")  || &warn("Can't restore STDIN");
+    open(STDOUT, ">&SAVEOUT") || &warn("Can't restore STDOUT");
+    close(SAVEIN);
     close(SAVEOUT);
 
-
     # most of the $? crud was coping with broken cshisms
     if ($? >> 8) {
-	&warn("(Command exited ", ($? >> 8), ")\n");
-    } elsif ($?) { 
-	&warn( "(Command died of SIG#",  ($? & 127),
-	    (($? & 128) ? " -- core dumped" : "") , ")", "\n");
-    } 
+        &warn("(Command exited ", ($? >> 8), ")\n");
+    }
+    elsif ($?) {
+        &warn(
+            "(Command died of SIG#",
+            ($? & 127),
+            (($? & 128) ? " -- core dumped" : ""),
+            ")", "\n"
+            );
+    } ## end elsif ($?)
 
     return $?;
 
-}
+} ## end sub system
+
+=head1 TTY MANAGEMENT
+
+The subs here do some of the terminal management for multiple debuggers.
+
+=head2 setterm
+
+Top-level function called when we want to set up a new terminal for use
+by the debugger.
+
+If the C<noTTY> debugger option was set, we'll either use the terminal
+supplied (the value of the C<noTTY> option), or we'll use C<Term::Rendezvous>
+to find one. If we're a forked debugger, we call C<resetterm> to try to 
+get a whole new terminal if we can. 
+
+In either case, we set up the terminal next. If the C<ReadLine> option was
+true, we'll get a C<Term::ReadLine> object for the current terminal and save
+the appropriate attributes. We then 
+
+=cut
 
 sub setterm {
+    # Load Term::Readline, but quietly; don't debug it and don't trace it.
     local $frame = 0;
     local $doret = -2;
     eval { require Term::ReadLine } or die $@;
+
+    # If noTTY is set, but we have a TTY name, go ahead and hook up to it.
     if ($notty) {
-	if ($tty) {
-	    my ($i, $o) = split $tty, /,/;
-	    $o = $i unless defined $o;
-	    open(IN,"<$i") or die "Cannot open TTY `$i' for read: $!";
-	    open(OUT,">$o") or die "Cannot open TTY `$o' for write: $!";
-	    $IN = \*IN;
-	    $OUT = \*OUT;
-	    my $sel = select($OUT);
-	    $| = 1;
-	    select($sel);
-	} else {
-	    eval "require Term::Rendezvous;" or die;
-	    my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
-	    my $term_rv = new Term::Rendezvous $rv;
-	    $IN = $term_rv->IN;
-	    $OUT = $term_rv->OUT;
-	}
-    }
-    if ($term_pid eq '-1') {		# In a TTY with another debugger
-	resetterm(2);
+        if ($tty) {
+            my ($i, $o) = split $tty, /,/;
+            $o = $i unless defined $o;
+            open(IN,  "<$i") or die "Cannot open TTY `$i' for read: $!";
+            open(OUT, ">$o") or die "Cannot open TTY `$o' for write: $!";
+            $IN  = \*IN;
+            $OUT = \*OUT;
+            my $sel = select($OUT);
+            $| = 1;
+            select($sel);
+        } ## end if ($tty)
+
+        # We don't have a TTY - try to find one via Term::Rendezvous.
+        else {
+            eval "require Term::Rendezvous;" or die;
+            # See if we have anything to pass to Term::Rendezvous.
+            # Use /tmp/perldbtty$$ if not.
+            my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
+
+            # Rendezvous and get the filehandles.
+            my $term_rv = new Term::Rendezvous $rv;
+            $IN  = $term_rv->IN;
+            $OUT = $term_rv->OUT;
+        } ## end else [ if ($tty)
+    } ## end if ($notty)
+
+
+    # We're a daughter debugger. Try to fork off another TTY.
+    if ($term_pid eq '-1') {    # In a TTY with another debugger
+        resetterm(2);
     }
+
+    # If we shouldn't use Term::ReadLine, don't.
     if (!$rl) {
-	$term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
-    } else {
-	$term = new Term::ReadLine 'perldb', $IN, $OUT;
-
-	$rl_attribs = $term->Attribs;
-	$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}' 
-	  if defined $rl_attribs->{basic_word_break_characters} 
-	    and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
-	$rl_attribs->{special_prefixes} = '$@&%';
-	$rl_attribs->{completer_word_break_characters} .= '$@&%';
-	$rl_attribs->{completion_function} = \&db_complete; 
-    }
-    $LINEINFO = $OUT unless defined $LINEINFO;
+        $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+    }
+
+    # We're using Term::ReadLine. Get all the attributes for this terminal.
+    else {
+        $term = new Term::ReadLine 'perldb', $IN, $OUT;
+
+        $rl_attribs = $term->Attribs;
+        $rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}'
+          if defined $rl_attribs->{basic_word_break_characters}
+          and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
+        $rl_attribs->{special_prefixes} = '$@&%';
+        $rl_attribs->{completer_word_break_characters} .= '$@&%';
+        $rl_attribs->{completion_function} = \&db_complete;
+    } ## end else [ if (!$rl)
+
+    # Set up the LINEINFO filehandle.
+    $LINEINFO = $OUT     unless defined $LINEINFO;
     $lineinfo = $console unless defined $lineinfo;
+
     $term->MinLine(2);
+
     if ($term->Features->{setHistory} and "@hist" ne "?") {
-      $term->SetHistory(@hist);
+        $term->SetHistory(@hist);
     }
+
+    # XXX Ornaments are turned on unconditionally, which is not
+    # always a good thing.
     ornaments($ornaments) if defined $ornaments;
     $term_pid = $$;
-}
+} ## end sub setterm
+
+=head1 GET_FORK_TTY EXAMPLE FUNCTIONS
+
+When the process being debugged forks, or the process invokes a command
+via C<system()> which starts a new debugger, we need to be able to get a new
+C<IN> and C<OUT> filehandle for the new debugger. Otherwise, the two processes
+fight over the terminal, and you can never quite be sure who's going to get the
+input you're typing.
+
+C<get_fork_TTY> is a glob-aliased function which calls the real function that 
+is tasked with doing all the necessary operating system mojo to get a new 
+TTY (and probably another window) and to direct the new debugger to read and
+write there.
+
+The debugger provides C<get_fork_TTY> functions which work for X Windows and
+OS/2. Other systems are not supported. You are encouraged to write 
+C<get_fork_TTY> functions which work for I<your> platform and contribute them.
+
+=head3 C<xterm_get_fork_TTY>
+
+This function provides the C<get_fork_TTY> function for X windows. If a 
+program running under the debugger forks, a new <xterm> window is opened and
+the subsidiary debugger is directed there.
+
+The C<open()> call is of particular note here. We have the new C<xterm>
+we're spawning route file number 3 to STDOUT, and then execute the C<tty> 
+command (which prints the device name of the TTY we'll want to use for input 
+and output to STDOUT, then C<sleep> for a very long time, routing this output
+to file number 3. This way we can simply read from the <XT> filehandle (which
+is STDOUT from the I<commands> we ran) to get the TTY we want to use. 
+
+Only works if C<xterm> is in your path and C<$ENV{DISPLAY}>, etc. are 
+properly set up.
+
+=cut
 
-# Example get_fork_TTY functions
 sub xterm_get_fork_TTY {
-  (my $name = $0) =~ s,^.*[/\\],,s;
-  open XT, qq[3>&1 xterm -title "Daughter Perl debugger $pids $name" -e sh -c 'tty 1>&3;\
+    (my $name = $0) =~ s,^.*[/\\],,s;
+    open XT,
+qq[3>&1 xterm -title "Daughter Perl debugger $pids $name" -e sh -c 'tty 1>&3;\
  sleep 10000000' |];
-  my $tty = <XT>;
-  chomp $tty;
-  $pidprompt = '';		# Shown anyway in titlebar
-  return $tty;
-}
+
+    # Get the output from 'tty' and clean it up a little.
+    my $tty = <XT>;
+    chomp $tty;
+
+    $pidprompt = '';    # Shown anyway in titlebar
+
+    # There's our new TTY.
+    return $tty;
+} ## end sub xterm_get_fork_TTY
+
+=head3 C<os2_get_fork_TTY>
+
+XXX It behooves an OS/2 expert to write the necessary documentation for this!
+
+=cut
 
 # This example function resets $IN, $OUT itself
 sub os2_get_fork_TTY {
-  local $^F = 40;			# XXXX Fixme!
-  local $\ = '';
-  my ($in1, $out1, $in2, $out2);
-  # Having -d in PERL5OPT would lead to a disaster...
-  local $ENV{PERL5OPT} = $ENV{PERL5OPT}    if $ENV{PERL5OPT};
-  $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\b//  if $ENV{PERL5OPT};
-  $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\B/-/ if $ENV{PERL5OPT};
-  print $OUT "Making kid PERL5OPT->`$ENV{PERL5OPT}'.\n" if $ENV{PERL5OPT};
-  local $ENV{PERL5LIB} = $ENV{PERL5LIB} ? $ENV{PERL5LIB} : $ENV{PERLLIB};
-  $ENV{PERL5LIB} = '' unless defined $ENV{PERL5LIB};
-  $ENV{PERL5LIB} = join ';', @ini_INC, split /;/, $ENV{PERL5LIB};
-  (my $name = $0) =~ s,^.*[/\\],,s;
-  my @args;
-  if ( pipe $in1, $out1 and pipe $in2, $out2
-       # system P_SESSION will fail if there is another process
-       # in the same session with a "dependent" asynchronous child session.
-       and @args = ($rl, fileno $in1, fileno $out2,
-		    "Daughter Perl debugger $pids $name") and
-       (($kpid = CORE::system 4, $^X, '-we', <<'ES', @args) >= 0 # P_SESSION
+    local $^F = 40;     # XXXX Fixme!
+    local $\  = '';
+    my ($in1, $out1, $in2, $out2);
+
+    # Having -d in PERL5OPT would lead to a disaster...
+    local $ENV{PERL5OPT} = $ENV{PERL5OPT} if $ENV{PERL5OPT};
+    $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\b//  if $ENV{PERL5OPT};
+    $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\B/-/ if $ENV{PERL5OPT};
+    print $OUT "Making kid PERL5OPT->`$ENV{PERL5OPT}'.\n" if $ENV{PERL5OPT};
+    local $ENV{PERL5LIB} = $ENV{PERL5LIB} ? $ENV{PERL5LIB} : $ENV{PERLLIB};
+    $ENV{PERL5LIB} = '' unless defined $ENV{PERL5LIB};
+    $ENV{PERL5LIB} = join ';', @ini_INC, split /;/, $ENV{PERL5LIB};
+    (my $name = $0) =~ s,^.*[/\\],,s;
+    my @args;
+
+    if (
+            pipe $in1, $out1
+        and pipe $in2, $out2
+
+        # system P_SESSION will fail if there is another process
+        # in the same session with a "dependent" asynchronous child session.
+        and @args = (
+            $rl, fileno $in1, fileno $out2,
+            "Daughter Perl debugger $pids $name"
+        )
+        and (
+            ($kpid = CORE::system 4, $^X, '-we',
+                <<'ES', @args) >= 0    # P_SESSION
 END {sleep 5 unless $loaded}
 BEGIN {open STDIN,  '</dev/con' or warn "reopen stdin: $!"}
 use OS2::Process;
 
-my ($rl, $in) = (shift, shift);		# Read from $in and pass through
+my ($rl, $in) = (shift, shift);        # Read from $in and pass through
 set_title pop;
 system P_NOWAIT, $^X, '-we', <<EOS or die "Cannot start a grandkid";
   open IN, '<&=$in' or die "open <&=$in: \$!";
@@ -2292,33 +5838,68 @@ require Term::ReadKey if $rl;
 Term::ReadKey::ReadMode(4) if $rl; # Nodelay on kbd.  Pipe is automatically nodelay...
 print while sysread STDIN, $_, 1<<($rl ? 16 : 0);
 ES
-	 or warn "system P_SESSION: $!, $^E" and 0)
-	and close $in1 and close $out2 ) {
-      $pidprompt = '';			# Shown anyway in titlebar
-      reset_IN_OUT($in2, $out1);
-      $tty = '*reset*';
-      return '';			# Indicate that reset_IN_OUT is called
-   }
-   return;
-}
+            or warn "system P_SESSION: $!, $^E" and 0
+        )
+        and close $in1
+        and close $out2
+      )
+    {
+        $pidprompt = '';    # Shown anyway in titlebar
+        reset_IN_OUT($in2, $out1);
+        $tty = '*reset*';
+        return '';          # Indicate that reset_IN_OUT is called
+    } ## end if (pipe $in1, $out1 and...
+    return;
+} ## end sub os2_get_fork_TTY
+
+=head2 C<create_IN_OUT($flags)>
+
+Create a new pair of filehandles, pointing to a new TTY. If impossible,
+try to diagnose why.
+
+Flags are:
 
-sub create_IN_OUT {	# Create a window with IN/OUT handles redirected there
+=over 4
+
+=item * 1 - Don't know how to create a new TTY.
+
+=item * 2 - Debugger has forked, but we can't get a new TTY.
+
+=item * 4 - standard debugger startup is happening.
+
+=back
+
+=cut
+
+sub create_IN_OUT {    # Create a window with IN/OUT handles redirected there
+
+    # If we know how to get a new TTY, do it! $in will have
+    # the TTY name if get_fork_TTY works.
     my $in = &get_fork_TTY if defined &get_fork_TTY;
-    $in = $fork_TTY if defined $fork_TTY; # Backward compatibility
+
+    # It used to be that 
+    $in = $fork_TTY if defined $fork_TTY;    # Backward compatibility
+
     if (not defined $in) {
-      my $why = shift;
-      print_help(<<EOP) if $why == 1;
+        my $why = shift;
+
+        # We don't know how.
+        print_help(<<EOP) if $why == 1;
 I<#########> Forked, but do not know how to create a new B<TTY>. I<#########>
 EOP
-      print_help(<<EOP) if $why == 2;
+
+        # Forked debugger.
+        print_help(<<EOP) if $why == 2;
 I<#########> Daughter session, do not know how to change a B<TTY>. I<#########>
   This may be an asynchronous session, so the parent debugger may be active.
 EOP
-      print_help(<<EOP) if $why != 4;
+
+        # Note that both debuggers are fighting over the same input.
+        print_help(<<EOP) if $why != 4;
   Since two debuggers fight for the same TTY, input is severely entangled.
 
 EOP
-      print_help(<<EOP);
+        print_help(<<EOP);
   I know how to switch the output to a different window in xterms
   and OS/2 consoles only.  For a manual switch, put the name of the created I<TTY>
   in B<\$DB::fork_TTY>, or define a function B<DB::get_fork_TTY()> returning this.
@@ -2327,250 +5908,563 @@ EOP
   by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
 
 EOP
-    } elsif ($in ne '') {
-      TTY($in);
-    } else {
-      $console = '';		# Indicate no need to open-from-the-console 
+    } ## end if (not defined $in)
+    elsif ($in ne '') {
+        TTY($in);
+    }
+    else {
+        $console = '';    # Indicate no need to open-from-the-console
     }
     undef $fork_TTY;
-}
+} ## end sub create_IN_OUT
+
+=head2 C<resetterm>
+
+Handles rejiggering the prompt when we've forked off a new debugger.
+
+If the new debugger happened because of a C<system()> that invoked a 
+program under the debugger, the arrow between the old pid and the new
+in the prompt has I<two> dashes instead of one.
+
+We take the current list of pids and add this one to the end. If there
+isn't any list yet, we make one up out of the initial pid associated with 
+the terminal and our new pid, sticking an arrow (either one-dashed or 
+two dashed) in between them.
+
+If C<CreateTTY> is off, or C<resetterm> was called with no arguments,
+we don't try to create a new IN and OUT filehandle. Otherwise, we go ahead
+and try to do that.
 
-sub resetterm {			# We forked, so we need a different TTY
+=cut
+
+sub resetterm {           # We forked, so we need a different TTY
+
+    # Needs to be passed to create_IN_OUT() as well.
     my $in = shift;
+
+    # resetterm(2): got in here because of a system() starting a debugger.
+    # resetterm(1): just forked.
     my $systemed = $in > 1 ? '-' : '';
+
+    # If there's already a list of pids, add this to the end.
     if ($pids) {
-      $pids =~ s/\]/$systemed->$$]/;
-    } else {
-      $pids = "[$term_pid->$$]";
+        $pids =~ s/\]/$systemed->$$]/;
+    }
+
+    # No pid list. Time to make one.
+    else {
+        $pids = "[$term_pid->$$]";
     }
+
+    # The prompt we're going to be using for this debugger.
     $pidprompt = $pids;
-    $term_pid = $$;
+
+    # We now 0wnz this terminal.
+    $term_pid  = $$;
+
+    # Just return if we're not supposed to try to create a new TTY.
     return unless $CreateTTY & $in;
+
+    # Try to create a new IN/OUT pair.
     create_IN_OUT($in);
-}
+} ## end sub resetterm
+
+=head2 C<readline>
+
+First, we handle stuff in the typeahead buffer. If there is any, we shift off
+the next line, print a message saying we got it, add it to the terminal
+history (if possible), and return it.
+
+If there's nothing in the typeahead buffer, check the command filehandle stack.
+If there are any filehandles there, read from the last one, and return the line
+if we got one. If not, we pop the filehandle off and close it, and try the
+next one up the stack.
+
+If we've emptied the filehandle stack, we check to see if we've got a socket 
+open, and we read that and return it if we do. If we don't, we just call the 
+core C<readline()> and return its value.
+
+=cut
 
 sub readline {
-  local $.;
-  if (@typeahead) {
-    my $left = @typeahead;
-    my $got = shift @typeahead;
-    local $\ = '';
-    print $OUT "auto(-$left)", shift, $got, "\n";
-    $term->AddHistory($got) 
-      if length($got) > 1 and defined $term->Features->{addHistory};
-    return $got;
-  }
-  local $frame = 0;
-  local $doret = -2;
-  while (@cmdfhs) {
-    my $line = CORE::readline($cmdfhs[-1]);
-    defined $line ? (print $OUT ">> $line" and return $line)
-                  : close pop @cmdfhs;
-  }
-  if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
-    $OUT->write(join('', @_));
-    my $stuff;
-    $IN->recv( $stuff, 2048 );  # XXX: what's wrong with sysread?
-    $stuff;
-  }
-  else {
-    $term->readline(@_);
-  }
-}
+
+    # Localize to prevent it from being smashed in the program being debugged.
+    local $.;
+
+    # Pull a line out of the typeahead if there's stuff there.
+    if (@typeahead) {
+        # How many lines left.
+        my $left = @typeahead;
+
+        # Get the next line.
+        my $got  = shift @typeahead;
+
+        # Print a message saying we got input from the typeahead.
+        local $\ = '';
+        print $OUT "auto(-$left)", shift, $got, "\n";
+
+        # Add it to the terminal history (if possible).
+        $term->AddHistory($got)
+          if length($got) > 1
+          and defined $term->Features->{addHistory};
+        return $got;
+    } ## end if (@typeahead)
+
+    # We really need to read some input. Turn off entry/exit trace and 
+    # return value printing.
+    local $frame = 0;
+    local $doret = -2;
+
+    # If there are stacked filehandles to read from ...
+    while (@cmdfhs) {
+        # Read from the last one in the stack.
+        my $line = CORE::readline($cmdfhs[-1]);
+        # If we got a line ...
+        defined $line
+          ? (print $OUT ">> $line" and return $line)  # Echo and return
+          : close pop @cmdfhs;                        # Pop and close
+    } ## end while (@cmdfhs)
+
+    # Nothing on the filehandle stack. Socket?
+    if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
+        # Send anyting we have to send.
+        $OUT->write(join ('', @_));
+
+        # Receive anything there is to receive.
+        my $stuff;
+        $IN->recv($stuff, 2048);    # XXX "what's wrong with sysread?"
+                                    # XXX Don't know. You tell me.
+
+        # What we got.
+        $stuff;
+    } ## end if (ref $OUT and UNIVERSAL::isa...
+
+    # No socket. Just read from the terminal.
+    else {
+        $term->readline(@_);
+    }
+} ## end sub readline
+
+=head1 OPTIONS SUPPORT ROUTINES
+
+These routines handle listing and setting option values.
+
+=head2 C<dump_option> - list the current value of an option setting
+
+This routine uses C<option_val> to look up the value for an option.
+It cleans up escaped single-quotes and then displays the option and
+its value.
+
+=cut
 
 sub dump_option {
-    my ($opt, $val)= @_;
-    $val = option_val($opt,'N/A');
+    my ($opt, $val) = @_;
+    $val = option_val($opt, 'N/A');
     $val =~ s/([\\\'])/\\$1/g;
     printf $OUT "%20s = '%s'\n", $opt, $val;
-}
+} ## end sub dump_option
+
+=head2 C<option_val> - find the current value of an option
+
+This can't just be a simple hash lookup because of the indirect way that
+the option values are stored. Some are retrieved by calling a subroutine,
+some are just variables.
+
+You must supply a default value to be used in case the option isn't set.
+
+=cut
 
 sub option_val {
-    my ($opt, $default)= @_;
+    my ($opt, $default) = @_;
     my $val;
-    if (defined $optionVars{$opt}
-	and defined ${$optionVars{$opt}}) {
-	$val = ${$optionVars{$opt}};
-    } elsif (defined $optionAction{$opt}
-	and defined &{$optionAction{$opt}}) {
-	$val = &{$optionAction{$opt}}();
-    } elsif (defined $optionAction{$opt}
-	     and not defined $option{$opt}
-	     or defined $optionVars{$opt}
-	     and not defined ${$optionVars{$opt}}) {
-	$val = $default;
-    } else {
-	$val = $option{$opt};
+
+    # Does this option exist, and is it a variable?
+    # If so, retrieve the value via the value in %optionVars.
+    if (    defined $optionVars{$opt}
+        and defined ${ $optionVars{$opt} }) {
+        $val = ${ $optionVars{$opt} };
+    }
+
+    # Does this option exist, and it's a subroutine?
+    # If so, call the subroutine via the ref in %optionAction
+    # and capture the value.
+    elsif ( defined $optionAction{$opt}
+        and defined &{ $optionAction{$opt} }) {
+        $val = &{ $optionAction{$opt} }();
+    }
+
+    # If there's an action or variable for the supplied option,
+    # but no value was set, use the default.
+    elsif (defined $optionAction{$opt} and not defined $option{$opt}
+        or defined $optionVars{$opt} and not defined ${ $optionVars{$opt} })
+    {
+        $val = $default;
     }
+
+    # Otherwise, do the simple hash lookup.
+    else {
+        $val = $option{$opt};
+    }
+
+    # If the value isn't defined, use the default.
+    # Then return whatever the value is.
     $val = $default unless defined $val;
-    $val
-}
+    $val;
+} ## end sub option_val
+
+=head2 C<parse_options>
+
+Handles the parsing and execution of option setting/displaying commands.
+
+An option entered by itself is assumed to be 'set me to 1' (the default value)
+if the option is a boolean one. If not, the user is prompted to enter a valid
+value or to query the current value (via 'option? ').
+
+If 'option=value' is entered, we try to extract a quoted string from the
+value (if it is quoted). If it's not, we just use the whole value as-is.
+
+We load any modules required to service this option, and then we set it: if
+it just gets stuck in a variable, we do that; if there's a subroutine to 
+handle setting the option, we call that.
+
+Finally, if we're running in interactive mode, we display the effect of the
+user's command back to the terminal, skipping this if we're setting things
+during initialization.
+
+=cut
 
 sub parse_options {
-    local($_)= @_;
+    local ($_) = @_;
     local $\ = '';
-    # too dangerous to let intuitive usage overwrite important things
-    # defaultion should never be the default
-    my %opt_needs_val = map { ( $_ => 1 ) } qw{
-        dumpDepth arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
-        pager quote ReadLine recallCommand RemotePort ShellBang TTY
-    };
+
+    # These options need a value. Don't allow them to be clobbered by accident.
+    my %opt_needs_val = map { ($_ => 1) } qw{
+      dumpDepth arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
+      pager quote ReadLine recallCommand RemotePort ShellBang TTY CommandSet
+      };
+
     while (length) {
-	my $val_defaulted;
-	s/^\s+// && next;
-	s/^(\w+)(\W?)// or print($OUT "Invalid option `$_'\n"), last;
-	my ($opt,$sep) = ($1,$2);
-	my $val;
-	if ("?" eq $sep) {
-	    print($OUT "Option query `$opt?' followed by non-space `$_'\n"), last
-	      if /^\S/;
-	    #&dump_option($opt);
-	} elsif ($sep !~ /\S/) {
-	    $val_defaulted = 1;
-	    $val = "1";  #  this is an evil default; make 'em set it!
-	} elsif ($sep eq "=") {
-            if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x) { 
+        my $val_defaulted;
+
+        # Clean off excess leading whitespace.
+        s/^\s+// && next;
+
+        # Options are always all word characters, followed by a non-word
+        # separator.
+        s/^(\w+)(\W?)// or print($OUT "Invalid option `$_'\n"), last;
+        my ($opt, $sep) = ($1, $2);
+
+        # Make sure that such an option exists.
+        my $matches = grep(/^\Q$opt/ && ($option = $_), @options) ||
+          grep(/^\Q$opt/i && ($option = $_), @options);
+
+        print($OUT "Unknown option `$opt'\n"), next unless $matches;
+        print($OUT "Ambiguous option `$opt'\n"), next if $matches > 1;
+
+        my $val;
+
+        # '?' as separator means query, but must have whitespace after it.
+        if ("?" eq $sep) {
+            print($OUT "Option query `$opt?' followed by non-space `$_'\n"),
+              last
+              if /^\S/;
+
+            #&dump_option($opt);
+        } ## end if ("?" eq $sep)
+
+        # Separator is whitespace (or just a carriage return).
+        # They're going for a default, which we assume is 1.
+        elsif ($sep !~ /\S/) {
+            $val_defaulted = 1;
+            $val           = "1"; #  this is an evil default; make 'em set it!
+        }
+
+        # Separator is =. Trying to set a value.
+        elsif ($sep eq "=") {
+            # If quoted, extract a quoted string.
+            if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x) {
                 my $quote = $1;
                 ($val = $2) =~ s/\\([$quote\\])/$1/g;
-	    } else { 
-		s/^(\S*)//;
-	    $val = $1;
-		print OUT qq(Option better cleared using $opt=""\n)
-		    unless length $val;
-	    }
-
-	} else { #{ to "let some poor schmuck bounce on the % key in B<vi>."
-	    my ($end) = "\\" . substr( ")]>}$sep", index("([<{",$sep), 1 ); #}
-	    s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)// or
-	      print($OUT "Unclosed option value `$opt$sep$_'\n"), last;
-	    ($val = $1) =~ s/\\([\\$end])/$1/g;
-	}
-
-	my $option;
-	my $matches = grep( /^\Q$opt/  && ($option = $_),  @options  )
-		   || grep( /^\Q$opt/i && ($option = $_),  @options  );
-
-	print($OUT "Unknown option `$opt'\n"), next 	unless $matches;
-	print($OUT "Ambiguous option `$opt'\n"), next 	if $matches > 1;
-
-       if ($opt_needs_val{$option} && $val_defaulted) {
-			 my $cmd = ($CommandSet eq '580') ? 'o' : 'O';
-	    print $OUT "Option `$opt' is non-boolean.  Use `$cmd $option=VAL' to set, `$cmd $option?' to query\n";
-	    next;
-	} 
-
-	$option{$option} = $val if defined $val;
-
-	eval qq{
-		local \$frame = 0; 
-		local \$doret = -2; 
-	        require '$optionRequire{$option}';
-		1;
-	 } || die  # XXX: shouldn't happen
-	    if  defined $optionRequire{$option}	    &&
-	        defined $val;
-
-	${$optionVars{$option}} = $val 	    
-	    if  defined $optionVars{$option}        &&
-		defined $val;
-
-	&{$optionAction{$option}} ($val)    
-	    if defined $optionAction{$option}	    &&
-               defined &{$optionAction{$option}}    &&
-               defined $val;
-
-	# Not $rcfile
-	dump_option($option) 	unless $OUT eq \*STDERR; 
-    }
-}
+            }
+
+            # Not quoted. Use the whole thing. Warn about 'option='.
+            else {
+                s/^(\S*)//;
+                $val = $1;
+                print OUT qq(Option better cleared using $opt=""\n)
+                  unless length $val;
+            } ## end else [ if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x)
+
+        } ## end elsif ($sep eq "=")
+
+        # "Quoted" with [], <>, or {}.  
+        else {    #{ to "let some poor schmuck bounce on the % key in B<vi>."
+            my ($end) = "\\" . substr(")]>}$sep", index("([<{", $sep), 1);  #}
+            s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)//
+              or print($OUT "Unclosed option value `$opt$sep$_'\n"), last;
+            ($val = $1) =~ s/\\([\\$end])/$1/g;
+        } ## end else [ if ("?" eq $sep)
+
+        # Impedance-match the code above to the code below.
+        my $option = $opt;
+
+        # Exclude non-booleans from getting set to 1 by default.
+        if ($opt_needs_val{$option} && $val_defaulted) {
+            my $cmd = ($CommandSet eq '580') ? 'o' : 'O';
+            print $OUT
+"Option `$opt' is non-boolean.  Use `$cmd $option=VAL' to set, `$cmd $option?' to query\n";
+            next;
+        } ## end if ($opt_needs_val{$option...
+
+        # Save the option value.
+        $option{$option} = $val if defined $val;
+
+        # Load any module that this option requires.
+        eval qq{
+                local \$frame = 0; 
+                local \$doret = -2; 
+                require '$optionRequire{$option}';
+                1;
+               } || die    # XXX: shouldn't happen
+          if defined $optionRequire{$option} &&
+             defined $val;
+
+        # Set it. 
+        # Stick it in the proper variable if it goes in a variable.
+        ${ $optionVars{$option} } = $val
+          if defined $optionVars{$option} &&
+          defined $val;
+
+        # Call the appropriate sub if it gets set via sub.
+        &{ $optionAction{$option} }($val)
+          if defined $optionAction{$option} &&
+          defined &{ $optionAction{$option} } &&
+          defined $val;
+
+        # Not initialization - echo the value we set it to.
+        dump_option($option) unless $OUT eq \*STDERR;
+    } ## end while (length)
+} ## end sub parse_options
+
+=head1 RESTART SUPPORT
+
+These routines are used to store (and restore) lists of items in environment 
+variables during a restart.
+
+=head2 set_list
+
+Set_list packages up items to be stored in a set of environment variables
+(VAR_n, containing the number of items, and VAR_0, VAR_1, etc., containing
+the values). Values outside the standard ASCII charset are stored by encoding
+then as hexadecimal values.
+
+=cut
 
 sub set_list {
-  my ($stem,@list) = @_;
-  my $val;
-  $ENV{"${stem}_n"} = @list;
-  for $i (0 .. $#list) {
-    $val = $list[$i];
-    $val =~ s/\\/\\\\/g;
-    $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
-    $ENV{"${stem}_$i"} = $val;
-  }
-}
+    my ($stem, @list) = @_;
+    my $val;
+
+    # VAR_n: how many we have. Scalar assignment gets the number of items.
+    $ENV{"${stem}_n"} = @list;
+
+    # Grab each item in the list, escape the backslashes, encode the non-ASCII
+    # as hex, and then save in the appropriate VAR_0, VAR_1, etc.
+    for $i (0 .. $#list) {
+        $val = $list[$i];
+        $val =~ s/\\/\\\\/g;
+        $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
+        $ENV{"${stem}_$i"} = $val;
+    } ## end for $i (0 .. $#list)
+} ## end sub set_list
+
+=head2 get_list
+
+Reverse the set_list operation: grab VAR_n to see how many we should be getting
+back, and then pull VAR_0, VAR_1. etc. back out.
+
+=cut 
 
 sub get_list {
-  my $stem = shift;
-  my @list;
-  my $n = delete $ENV{"${stem}_n"};
-  my $val;
-  for $i (0 .. $n - 1) {
-    $val = delete $ENV{"${stem}_$i"};
-    $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
-    push @list, $val;
-  }
-  @list;
-}
+    my $stem = shift;
+    my @list;
+    my $n = delete $ENV{"${stem}_n"};
+    my $val;
+    for $i (0 .. $n - 1) {
+        $val = delete $ENV{"${stem}_$i"};
+        $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
+        push @list, $val;
+    }
+    @list;
+} ## end sub get_list
+
+=head1 MISCELLANEOUS SIGNAL AND I/O MANAGEMENT
+
+=head2 catch()
+
+The C<catch()> subroutine is the essence of fast and low-impact. We simply
+set an already-existing global scalar variable to a constant value. This 
+avoids allocating any memory possibly in the middle of something that will
+get all confused if we do.
+
+=cut
 
 sub catch {
     $signal = 1;
-    return;			# Put nothing on the stack - malloc/free land!
+    return;    # Put nothing on the stack - malloc/free land!
 }
 
+=head2 C<warn()>
+
+C<warn> emits a warning, by joining together its arguments and printing
+them, with couple of fillips.
+
+If the composited message I<doesn't> end with a newline, we automatically 
+add C<$!> and a newline to the end of the message. The subroutine expects $OUT 
+to be set to the filehandle to be used to output warnings; it makes no 
+assumptions about what filehandles are available.
+
+=cut
+
 sub warn {
-    my($msg)= join("",@_);
+    my ($msg) = join ("", @_);
     $msg .= ": $!\n" unless $msg =~ /\n$/;
     local $\ = '';
     print $OUT $msg;
-}
+} ## end sub warn
+
+=head1 INITIALIZATION TTY SUPPORT
+
+=head2 C<reset_IN_OUT>
+
+This routine handles restoring the debugger's input and output filehandles
+after we've tried and failed to move them elsewhere.  In addition, it assigns 
+the debugger's output filehandle to $LINEINFO if it was already open there.
+
+=cut
 
 sub reset_IN_OUT {
     my $switch_li = $LINEINFO eq $OUT;
+
+    # If there's a term and it's able to get a new tty, try to get one.
     if ($term and $term->Features->{newTTY}) {
-      ($IN, $OUT) = (shift, shift);
-      $term->newTTY($IN, $OUT);
-    } elsif ($term) {
-	&warn("Too late to set IN/OUT filehandles, enabled on next `R'!\n");
-    } else {
-      ($IN, $OUT) = (shift, shift);
+        ($IN, $OUT) = (shift, shift);
+        $term->newTTY($IN, $OUT);
+    }
+
+    # This term can't get a new tty now. Better luck later.
+    elsif ($term) {
+        &warn("Too late to set IN/OUT filehandles, enabled on next `R'!\n");
+    }
+
+    # Set the filehndles up as they were.
+    else {
+        ($IN, $OUT) = (shift, shift);
     }
+
+    # Unbuffer the output filehandle.
     my $o = select $OUT;
     $| = 1;
     select $o;
+
+    # Point LINEINFO to the same output filehandle if it was there before.
     $LINEINFO = $OUT if $switch_li;
-}
+} ## end sub reset_IN_OUT
+
+=head1 OPTION SUPPORT ROUTINES
+
+The following routines are used to process some of the more complicated 
+debugger options.
+
+=head2 C<TTY>
+
+Sets the input and output filehandles to the specified files or pipes.
+If the terminal supports switching, we go ahead and do it. If not, and
+there's already a terminal in place, we save the information to take effect
+on restart.
+
+If there's no terminal yet (for instance, during debugger initialization),
+we go ahead and set C<$console> and C<$tty> to the file indicated.
+
+=cut
 
 sub TTY {
     if (@_ and $term and $term->Features->{newTTY}) {
-      my ($in, $out) = shift;
-      if ($in =~ /,/) {
-	($in, $out) = split /,/, $in, 2;
-      } else {
-	$out = $in;
-      }
-      open IN, $in or die "cannot open `$in' for read: $!";
-      open OUT, ">$out" or die "cannot open `$out' for write: $!";
-      reset_IN_OUT(\*IN,\*OUT);
-      return $tty = $in;
-    }
+        # This terminal supports switching to a new TTY.
+        # Can be a list of two files, or on string containing both names,
+        # comma-separated.
+        # XXX Should this perhaps be an assignment from @_?
+        my ($in, $out) = shift; 
+        if ($in =~ /,/) {
+            # Split list apart if supplied.
+            ($in, $out) = split /,/, $in, 2;
+        }
+        else {
+            # Use the same file for both input and output.
+            $out = $in;
+        }
+
+        # Open file onto the debugger's filehandles, if you can.
+        open IN, $in or die "cannot open `$in' for read: $!";
+        open OUT, ">$out" or die "cannot open `$out' for write: $!";
+
+        # Swap to the new filehandles.
+        reset_IN_OUT(\*IN, \*OUT);
+
+        # Save the setting for later.
+        return $tty = $in;
+    } ## end if (@_ and $term and $term...
+
+    # Terminal doesn't support new TTY, or doesn't support readline.
+    # Can't do it now, try restarting.
     &warn("Too late to set TTY, enabled on next `R'!\n") if $term and @_;
+    
     # Useful if done through PERLDB_OPTS:
     $console = $tty = shift if @_;
+
+    # Return whatever the TTY is.
     $tty or $console;
-}
+} ## end sub TTY
+
+=head2 C<noTTY>
+
+Sets the C<$notty> global, controlling whether or not the debugger tries to
+get a terminal to read from. If called after a terminal is already in place,
+we save the value to use it if we're restarted.
+
+=cut
 
 sub noTTY {
     if ($term) {
-	&warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
+        &warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
     }
     $notty = shift if @_;
     $notty;
-}
+} ## end sub noTTY
+
+=head2 C<ReadLine>
+
+Sets the C<$rl> option variable. If 0, we use C<Term::ReadLine::Stub> 
+(essentially, no C<readline> processing on this "terminal"). Otherwise, we
+use C<Term::ReadLine>. Can't be changed after a terminal's in place; we save
+the value in case a restart is done so we can change it then.
+
+=cut
 
 sub ReadLine {
     if ($term) {
-	&warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
+        &warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
     }
     $rl = shift if @_;
     $rl;
-}
+} ## end sub ReadLine
+
+=head2 C<RemotePort>
+
+Sets the port that the debugger will try to connect to when starting up.
+If the terminal's already been set up, we can't do it, but we remember the
+setting in case the user does a restart.
+
+=cut
 
 sub RemotePort {
     if ($term) {
@@ -2578,105 +6472,231 @@ sub RemotePort {
     }
     $remoteport = shift if @_;
     $remoteport;
-}
+} ## end sub RemotePort
+
+=head2 C<tkRunning>
+
+Checks with the terminal to see if C<Tk> is running, and returns true or
+false. Returns false if the current terminal doesn't support C<readline>.
+
+=cut
 
 sub tkRunning {
-    if (${$term->Features}{tkRunning}) {
+    if (${ $term->Features }{tkRunning}) {
         return $term->tkRunning(@_);
-    } else {
-	local $\ = '';
-	print $OUT "tkRunning not supported by current ReadLine package.\n";
-	0;
     }
-}
+    else {
+        local $\ = '';
+        print $OUT "tkRunning not supported by current ReadLine package.\n";
+        0;
+    }
+} ## end sub tkRunning
+
+=head2 C<NonStop>
+
+Sets nonstop mode. If a terminal's already been set up, it's too late; the
+debugger remembers the setting in case you restart, though.
+
+=cut
 
 sub NonStop {
     if ($term) {
-	&warn("Too late to set up NonStop mode, enabled on next `R'!\n") if @_;
+        &warn("Too late to set up NonStop mode, enabled on next `R'!\n")
+          if @_;
     }
     $runnonstop = shift if @_;
     $runnonstop;
-}
+} ## end sub NonStop
+
+=head2 C<pager>
+
+Set up the C<$pager> variable. Adds a pipe to the front unless there's one
+there already.
+
+=cut
 
 sub pager {
     if (@_) {
-	$pager = shift;
-	$pager="|".$pager unless $pager =~ /^(\+?\>|\|)/;
+        $pager = shift;
+        $pager = "|" . $pager unless $pager =~ /^(\+?\>|\|)/;
     }
     $pager;
-}
+} ## end sub pager
+
+=head2 C<shellBang>
+
+Sets the shell escape command, and generates a printable copy to be used 
+in the help.
+
+=cut
 
 sub shellBang {
+
+    # If we got an argument, meta-quote it, and add '\b' if it
+    # ends in a word character.
     if (@_) {
-	$sh = quotemeta shift;
-	$sh .= "\\b" if $sh =~ /\w$/;
+        $sh = quotemeta shift;
+        $sh .= "\\b" if $sh =~ /\w$/;
     }
-    $psh = $sh;
-    $psh =~ s/\\b$//;
-    $psh =~ s/\\(.)/$1/g;
-    $psh;
-}
+
+    # Generate the printable version for the help:
+    $psh = $sh;                       # copy it
+    $psh =~ s/\\b$//;                 # Take off trailing \b if any
+    $psh =~ s/\\(.)/$1/g;             # De-escape
+    $psh;                             # return the printable version
+} ## end sub shellBang
+
+=head2 C<ornaments>
+
+If the terminal has its own ornaments, fetch them. Otherwise accept whatever
+was passed as the argument. (This means you can't override the terminal's
+ornaments.)
+
+=cut 
 
 sub ornaments {
-  if (defined $term) {
-    local ($warnLevel,$dieLevel) = (0, 1);
-    return '' unless $term->Features->{ornaments};
-    eval { $term->ornaments(@_) } || '';
-  } else {
-    $ornaments = shift;
-  }
-}
+    if (defined $term) {
+        # We don't want to show warning backtraces, but we do want die() ones.
+        local ($warnLevel, $dieLevel) = (0, 1);
+
+        # No ornaments if the terminal doesn't support them.
+        return '' unless $term->Features->{ornaments};
+        eval { $term->ornaments(@_) } || '';
+    }
+
+    # Use what was passed in if we can't determine it ourselves.
+    else {
+        $ornaments = shift;
+    }
+} ## end sub ornaments
+
+=head2 C<recallCommand>
+
+Sets the recall command, and builds a printable version which will appear in
+the help text.
+
+=cut
 
 sub recallCommand {
+
+    # If there is input, metaquote it. Add '\b' if it ends with a word
+    # character.
     if (@_) {
-	$rc = quotemeta shift;
-	$rc .= "\\b" if $rc =~ /\w$/;
+        $rc = quotemeta shift;
+        $rc .= "\\b" if $rc =~ /\w$/;
     }
-    $prc = $rc;
-    $prc =~ s/\\b$//;
-    $prc =~ s/\\(.)/$1/g;
-    $prc;
-}
+
+    # Build it into a printable version.
+    $prc = $rc;                             # Copy it
+    $prc =~ s/\\b$//;                       # Remove trailing \b
+    $prc =~ s/\\(.)/$1/g;                   # Remove escapes
+    $prc;                                   # Return the printable version
+} ## end sub recallCommand
+
+=head2 C<LineInfo> - where the line number information goes
+
+Called with no arguments, returns the file or pipe that line info should go to.
+
+Called with an argument (a file or a pipe), it opens that onto the 
+C<LINEINFO> filehandle, unbuffers the filehandle, and then returns the 
+file or pipe again to the caller.
+
+=cut
 
 sub LineInfo {
     return $lineinfo unless @_;
     $lineinfo = shift;
+
+    #  If this is a valid "thing to be opened for output", tack a 
+    # '>' onto the front.
     my $stream = ($lineinfo =~ /^(\+?\>|\|)/) ? $lineinfo : ">$lineinfo";
+
+    # If this is a pipe, the stream points to a slave editor.
     $slave_editor = ($stream =~ /^\|/);
+
+    # Open it up and unbuffer it.
     open(LINEINFO, "$stream") || &warn("Cannot open `$stream' for write");
     $LINEINFO = \*LINEINFO;
     my $save = select($LINEINFO);
     $| = 1;
     select($save);
+
+    # Hand the file or pipe back again.
     $lineinfo;
-}
+} ## end sub LineInfo
 
-sub list_modules { # versions
-  my %version;
-  my $file;
-  for (keys %INC) {
-    $file = $_;
-    s,\.p[lm]$,,i ;
-    s,/,::,g ;
-    s/^perl5db$/DB/;
-    s/^Term::ReadLine::readline$/readline/;
-    if (defined ${ $_ . '::VERSION' }) {
-      $version{$file} = "${ $_ . '::VERSION' } from ";
-    } 
-    $version{$file} .= $INC{$file};
-  }
-  dumpit($OUT,\%version);
-}
+=head1 COMMAND SUPPORT ROUTINES
+
+These subroutines provide functionality for various commands.
+
+=head2 C<list_modules>
+
+For the C<M> command: list modules loaded and their versions.
+Essentially just runs through the keys in %INC, picks up the 
+$VERSION package globals from each package, gets the file name, and formats the
+information for output.
+
+=cut
+
+sub list_modules {    # versions
+    my %version;
+    my $file;
+    # keys are the "as-loaded" name, values are the fully-qualified path
+    # to the file itself.
+    for (keys %INC) {
+        $file = $_;                                # get the module name
+        s,\.p[lm]$,,i;                             # remove '.pl' or '.pm'
+        s,/,::,g;                                  # change '/' to '::'
+        s/^perl5db$/DB/;                           # Special case: debugger
+                                                   # moves to package DB
+        s/^Term::ReadLine::readline$/readline/;    # simplify readline
+
+        # If the package has a $VERSION package global (as all good packages
+        # should!) decode it and save as partial message.
+        if (defined ${ $_ . '::VERSION' }) {
+            $version{$file} = "${ $_ . '::VERSION' } from ";
+        }
+
+        # Finish up the message with the file the package came from.
+        $version{$file} .= $INC{$file};
+    } ## end for (keys %INC)
+
+    # Hey, dumpit() formats a hash nicely, so why not use it?
+    dumpit($OUT, \%version);
+} ## end sub list_modules
+
+=head2 C<sethelp()>
+
+Sets up the monster string used to format and print the help.
+
+=head3 HELP MESSAGE FORMAT
+
+The help message is a peculiar format unto itself; it mixes C<pod> 'ornaments'
+(BE<lt>E<gt>, IE<gt>E<lt>) with tabs to come up with a format that's fairly
+easy to parse and portable, but which still allows the help to be a little
+nicer than just plain text.
+
+Essentially, you define the command name (usually marked up with BE<gt>E<lt>
+and IE<gt>E<lt>), followed by a tab, and then the descriptive text, ending in a newline. The descriptive text can also be marked up in the same way. If you 
+need to continue the descriptive text to another line, start that line with 
+just tabs and then enter the marked-up text.
+
+If you are modifying the help text, I<be careful>. The help-string parser is 
+not very sophisticated, and if you don't follow these rules it will mangle the 
+help beyond hope until you fix the string.
+
+=cut
 
 sub sethelp {
+
     # XXX: make sure there are tabs between the command and explanation,
     #      or print_help will screw up your formatting if you have
     #      eeevil ornaments enabled.  This is an insane mess.
 
     $help = "
-Help is currently only available for the new 580 CommandSet, 
-if you really want old behaviour, presumably you know what 
-you're doing ?-)
+Help is currently only available for the new 5.8 command set. 
+No help is available for the old command set. 
+We assume you know what you're doing if you switch to it.
 
 B<T>		Stack trace.
 B<s> [I<expr>]	Single step [in I<expr>].
@@ -2743,23 +6763,32 @@ B<m> I<expr>		Evals expression in list context, prints methods callable
 		on the first element of the result.
 B<m> I<class>		Prints methods callable via the given class.
 B<M>		Show versions of loaded modules.
+B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 
 B<<> ?			List Perl commands to run before each prompt.
 B<<> I<expr>		Define Perl command to run before each prompt.
 B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
+B<< *>				Delete the list of perl commands to run before each prompt.
 B<>> ?			List Perl commands to run after each prompt.
 B<>> I<expr>		Define Perl command to run after each prompt.
 B<>>B<>> I<expr>		Add to the list of Perl commands to run after each prompt.
+B<>>B< *>		Delete the list of Perl commands to run after each prompt.
 B<{> I<db_command>	Define debugger command to run before each prompt.
 B<{> ?			List debugger commands to run before each prompt.
+B<{ *>				Delete the list of debugger commands to run before each prompt.
 B<{{> I<db_command>	Add to the list of debugger commands to run before each prompt.
 B<$prc> I<number>	Redo a previous command (default previous command).
 B<$prc> I<-number>	Redo number'th-to-last command.
 B<$prc> I<pattern>	Redo last command that started with I<pattern>.
 		See 'B<O> I<recallCommand>' too.
 B<$psh$psh> I<cmd>  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
-  . ( $rc eq $sh ? "" : "
-B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+      . (
+        $rc eq $sh
+        ? ""
+        : "
+B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")."
+      ) 
+      . "
 		See 'B<O> I<shellBang>' too.
 B<source> I<file>		Execute I<file> containing debugger commands (may nest).
 B<H> I<-number>	Display last number commands (default all).
@@ -2818,7 +6847,7 @@ B<$doccmd> I<manpage>	Runs the external doc viewer B<$doccmd> command on the
 
 Type `|h h' for a paged display if this was too hard to read.
 
-"; # Fix balance of vi % matching: }}}}
+";    # Fix balance of vi % matching: }}}}
 
     #  note: tabs in the following section are not-so-helpful
     $summary = <<"END_SUM";
@@ -2848,14 +6877,15 @@ I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t>
   B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
 END_SUM
-				# ')}}; # Fix balance of vi % matching
 
-	# and this is really numb...
-	$pre580_help = "
+    # ')}}; # Fix balance of vi % matching
+
+    # and this is really numb...
+    $pre580_help = "
 B<T>		Stack trace.
 B<s> [I<expr>]	Single step [in I<expr>].
 B<n> [I<expr>]	Next, steps over subroutine calls [in I<expr>].
-<B<CR>>		Repeat last B<n> or B<s> command.
+B<CR>>			Repeat last B<n> or B<s> command.
 B<r>		Return from current subroutine.
 B<c> [I<line>|I<sub>]	Continue; optionally inserts a one-time-only breakpoint
 		at the specified position.
@@ -2927,8 +6957,13 @@ B<$prc> I<-number>	Redo number'th-to-last command.
 B<$prc> I<pattern>	Redo last command that started with I<pattern>.
 		See 'B<O> I<recallCommand>' too.
 B<$psh$psh> I<cmd>  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
-  . ( $rc eq $sh ? "" : "
-B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+      . (
+        $rc eq $sh
+        ? ""
+        : "
+B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")."
+      ) .
+      "
 		See 'B<O> I<shellBang>' too.
 B<source> I<file>		Execute I<file> containing debugger commands (may nest).
 B<H> I<-number>	Display last number commands (default all).
@@ -2987,7 +7022,7 @@ B<$doccmd> I<manpage>	Runs the external doc viewer B<$doccmd> command on the
 
 Type `|h' for a paged display if this was too hard to read.
 
-"; # Fix balance of vi % matching: }}}}
+";    # Fix balance of vi % matching: }}}}
 
     #  note: tabs in the following section are not-so-helpful
     $pre580_summary = <<"END_SUM";
@@ -3016,9 +7051,19 @@ I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t>
   B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
 For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
 END_SUM
-				# ')}}; # Fix balance of vi % matching
 
-}
+    # ')}}; # Fix balance of vi % matching
+
+} ## end sub sethelp
+
+=head2 C<print_help()>
+
+Most of what C<print_help> does is just text formatting. It finds the
+C<B> and C<I> ornaments, cleans them off, and substitutes the proper
+terminal control characters to simulate them (courtesy of 
+<Term::ReadLine::TermCap>).
+
+=cut
 
 sub print_help {
     local $_ = shift;
@@ -3030,562 +7075,1452 @@ sub print_help {
     # the first tab sequence padded into a field 16 (or if indented 20)
     # wide.  If it's wider than that, an extra space will be added.
     s{
-	^ 		    	# only matters at start of line
-	  ( \040{4} | \t )*	# some subcommands are indented
-	  ( < ? 		# so <CR> works
-	    [BI] < [^\t\n] + )  # find an eeevil ornament
-	  ( \t+ )		# original separation, discarded
-	  ( .* )		# this will now start (no earlier) than 
-				# column 16
+        ^                       # only matters at start of line
+          ( \040{4} | \t )*     # some subcommands are indented
+          ( < ?                 # so <CR> works
+            [BI] < [^\t\n] + )  # find an eeevil ornament
+          ( \t+ )               # original separation, discarded
+          ( .* )                # this will now start (no earlier) than 
+                                # column 16
     } {
-	my($leadwhite, $command, $midwhite, $text) = ($1, $2, $3, $4);
-	my $clean = $command;
-	$clean =~ s/[BI]<([^>]*)>/$1/g;  
-    # replace with this whole string:
-	($leadwhite ? " " x 4 : "")
+        my($leadwhite, $command, $midwhite, $text) = ($1, $2, $3, $4);
+        my $clean = $command;
+        $clean =~ s/[BI]<([^>]*)>/$1/g;  
+
+        # replace with this whole string:
+        ($leadwhite ? " " x 4 : "")
       . $command
       . ((" " x (16 + ($leadwhite ? 4 : 0) - length($clean))) || " ")
       . $text;
 
     }mgex;
 
-    s{				# handle bold ornaments
-	B < ( [^>] + | > ) >
+    s{                          # handle bold ornaments
+       B < ( [^>] + | > ) >
     } {
-	  $Term::ReadLine::TermCap::rl_term_set[2] 
-	. $1
-	. $Term::ReadLine::TermCap::rl_term_set[3]
+          $Term::ReadLine::TermCap::rl_term_set[2] 
+        . $1
+        . $Term::ReadLine::TermCap::rl_term_set[3]
     }gex;
 
-    s{				# handle italic ornaments
-	I < ( [^>] + | > ) >
+    s{                         # handle italic ornaments
+       I < ( [^>] + | > ) >
     } {
-	  $Term::ReadLine::TermCap::rl_term_set[0] 
-	. $1
-	. $Term::ReadLine::TermCap::rl_term_set[1]
+          $Term::ReadLine::TermCap::rl_term_set[0] 
+        . $1
+        . $Term::ReadLine::TermCap::rl_term_set[1]
     }gex;
 
     local $\ = '';
     print $OUT $_;
-}
+} ## end sub print_help
+
+=head2 C<fix_less> 
+
+This routine does a lot of gyrations to be sure that the pager is C<less>.
+It checks for C<less> masquerading as C<more> and records the result in
+C<$ENV{LESS}> so we don't have to go through doing the stats again.
+
+=cut
 
 sub fix_less {
+
+    # We already know if this is set.
     return if defined $ENV{LESS} && $ENV{LESS} =~ /r/;
+
+    # Pager is less for sure.
     my $is_less = $pager =~ /\bless\b/;
-    if ($pager =~ /\bmore\b/) { 
-	my @st_more = stat('/usr/bin/more');
-	my @st_less = stat('/usr/bin/less');
-	$is_less = @st_more    && @st_less 
-		&& $st_more[0] == $st_less[0] 
-		&& $st_more[1] == $st_less[1];
-    }
+    if ($pager =~ /\bmore\b/) {
+        # Nope, set to more. See what's out there.
+        my @st_more = stat('/usr/bin/more');
+        my @st_less = stat('/usr/bin/less');
+
+        # is it really less, pretending to be more?
+        $is_less = @st_more &&
+          @st_less &&
+          $st_more[0] == $st_less[0] &&
+          $st_more[1] == $st_less[1];
+    } ## end if ($pager =~ /\bmore\b/)
+
     # changes environment!
-    $ENV{LESS} .= 'r' 	if $is_less;
-}
+    # 'r' added so we don't do (slow) stats again.
+    $ENV{LESS} .= 'r' if $is_less;
+} ## end sub fix_less
+
+=head1 DIE AND WARN MANAGEMENT
+
+=head2 C<diesignal>
+
+C<diesignal> is a just-drop-dead C<die> handler. It's most useful when trying
+to debug a debugger problem.
+
+It does its best to report the error that occurred, and then forces the
+program, debugger, and everything to die.
+
+=cut
 
 sub diesignal {
+    # No entry/exit messages.
     local $frame = 0;
+
+    # No return value prints.
     local $doret = -2;
+
+    # set the abort signal handling to the default (just terminate).
     $SIG{'ABRT'} = 'DEFAULT';
+
+    # If we enter the signal handler recursively, kill myself with an
+    # abort signal (so we just terminate).
     kill 'ABRT', $$ if $panic++;
+
+    # If we can show detailed info, do so.
     if (defined &Carp::longmess) {
-	local $SIG{__WARN__} = '';
-	local $Carp::CarpLevel = 2;		# mydie + confess
-	&warn(Carp::longmess("Signal @_"));
+        # Don't recursively enter the warn handler, since we're carping.
+        local $SIG{__WARN__} = '';
+
+        # Skip two levels before reporting traceback: we're skipping 
+        # mydie and confess. 
+        local $Carp::CarpLevel = 2;    # mydie + confess
+
+        # Tell us all about it.
+        &warn(Carp::longmess("Signal @_"));
     }
+
+    # No Carp. Tell us about the signal as best we can.
     else {
-	local $\ = '';
-	print $DB::OUT "Got signal @_\n";
+        local $\ = '';
+        print $DB::OUT "Got signal @_\n";
     }
+
+    # Drop dead.
     kill 'ABRT', $$;
-}
+} ## end sub diesignal
 
-sub dbwarn { 
-  local $frame = 0;
-  local $doret = -2;
-  local $SIG{__WARN__} = '';
-  local $SIG{__DIE__} = '';
-  eval { require Carp } if defined $^S;	# If error/warning during compilation,
-                                        # require may be broken.
-  CORE::warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
-    return unless defined &Carp::longmess;
-  my ($mysingle,$mytrace) = ($single,$trace);
-  $single = 0; $trace = 0;
-  my $mess = Carp::longmess(@_);
-  ($single,$trace) = ($mysingle,$mytrace);
-  &warn($mess); 
-}
+=head2 C<dbwarn>
+
+The debugger's own default C<$SIG{__WARN__}> handler. We load C<Carp> to
+be able to get a stack trace, and output the warning message vi C<DB::dbwarn()>.
+
+=cut
+
+sub dbwarn {
+    # No entry/exit trace. 
+    local $frame = 0;
+
+    # No return value printing.
+    local $doret = -2;
+
+    # Turn off warn and die handling to prevent recursive entries to this
+    # routine.
+    local $SIG{__WARN__} = '';
+    local $SIG{__DIE__}  = '';
+
+    # Load Carp if we can. If $^S is false (current thing being compiled isn't
+    # done yet), we may not be able to do a require.
+    eval { require Carp }
+      if defined $^S;    # If error/warning during compilation,
+                         # require may be broken.
+
+    # Use the core warn() unless Carp loaded OK.
+    CORE::warn(@_,
+        "\nCannot print stack trace, load with -MCarp option to see stack"),
+      return
+      unless defined &Carp::longmess;
+
+    # Save the current values of $single and $trace, and then turn them off.
+    my ($mysingle, $mytrace) = ($single, $trace);
+    $single = 0;
+    $trace  = 0;
+
+    # We can call Carp::longmess without its being "debugged" (which we 
+    # don't want - we just want to use it!). Capture this for later.
+    my $mess = Carp::longmess(@_);
+
+    # Restore $single and $trace to their original values.
+    ($single, $trace) = ($mysingle, $mytrace);
+
+    # Use the debugger's own special way of printing warnings to print
+    # the stack trace message.
+    &warn($mess);
+} ## end sub dbwarn
+
+=head2 C<dbdie>
+
+The debugger's own C<$SIG{__DIE__}> handler. Handles providing a stack trace
+by loading C<Carp> and calling C<Carp::longmess()> to get it. We turn off 
+single stepping and tracing during the call to C<Carp::longmess> to avoid 
+debugging it - we just want to use it.
+
+If C<dieLevel> is zero, we let the program being debugged handle the
+exceptions. If it's 1, you get backtraces for any exception. If it's 2,
+the debugger takes over all exception handling, printing a backtrace and
+displaying the exception via its C<dbwarn()> routine. 
+
+=cut
 
 sub dbdie {
-  local $frame = 0;
-  local $doret = -2;
-  local $SIG{__DIE__} = '';
-  local $SIG{__WARN__} = '';
-  my $i = 0; my $ineval = 0; my $sub;
-  if ($dieLevel > 2) {
-      local $SIG{__WARN__} = \&dbwarn;
-      &warn(@_);		# Yell no matter what
-      return;
-  }
-  if ($dieLevel < 2) {
-    die @_ if $^S;		# in eval propagate
-  }
-  # No need to check $^S, eval is much more robust nowadays
-  eval { require Carp }; #if defined $^S;# If error/warning during compilation,
-                                	# require may be broken.
-
-  die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
-    unless defined &Carp::longmess;
-
-  # We do not want to debug this chunk (automatic disabling works
-  # inside DB::DB, but not in Carp).
-  my ($mysingle,$mytrace) = ($single,$trace);
-  $single = 0; $trace = 0;
-  my $mess = "@_";
-  { 
-    package Carp;		# Do not include us in the list
-    eval {
-      $mess = Carp::longmess(@_);
-    };
-  }
-  ($single,$trace) = ($mysingle,$mytrace);
-  die $mess;
-}
+    local $frame = 0;
+    local $doret = -2;
+    local $SIG{__DIE__}  = '';
+    local $SIG{__WARN__} = '';
+    my $i      = 0;
+    my $ineval = 0;
+    my $sub;
+    if ($dieLevel > 2) {
+        local $SIG{__WARN__} = \&dbwarn;
+        &warn(@_);    # Yell no matter what
+        return;
+    }
+    if ($dieLevel < 2) {
+        die @_ if $^S;    # in eval propagate
+    }
+
+    # The code used to check $^S to see if compiliation of the current thing
+    # hadn't finished. We don't do it anymore, figuring eval is pretty stable.
+    eval { require Carp }; 
+
+    die (@_,
+        "\nCannot print stack trace, load with -MCarp option to see stack")
+      unless defined &Carp::longmess;
+
+    # We do not want to debug this chunk (automatic disabling works
+    # inside DB::DB, but not in Carp). Save $single and $trace, turn them off,
+    # get the stack trace from Carp::longmess (if possible), restore $signal
+    # and $trace, and then die with the stack trace.
+    my ($mysingle, $mytrace) = ($single, $trace);
+    $single = 0;
+    $trace  = 0;
+    my $mess = "@_";
+    {
+
+        package Carp;    # Do not include us in the list
+        eval { $mess = Carp::longmess(@_); };
+    }
+    ($single, $trace) = ($mysingle, $mytrace);
+    die $mess;
+} ## end sub dbdie
+
+=head2 C<warnlevel()>
+
+Set the C<$DB::warnLevel> variable that stores the value of the
+C<warnLevel> option. Calling C<warnLevel()> with a positive value
+results in the debugger taking over all warning handlers. Setting
+C<warnLevel> to zero leaves any warning handlers set up by the program
+being debugged in place.
+
+=cut
 
 sub warnLevel {
-  if (@_) {
-    $prevwarn = $SIG{__WARN__} unless $warnLevel;
-    $warnLevel = shift;
-    if ($warnLevel) {
-      $SIG{__WARN__} = \&DB::dbwarn;
-    } elsif ($prevwarn) {
-      $SIG{__WARN__} = $prevwarn;
-    }
-  }
-  $warnLevel;
-}
+    if (@_) {
+        $prevwarn = $SIG{__WARN__} unless $warnLevel;
+        $warnLevel = shift;
+        if ($warnLevel) {
+            $SIG{__WARN__} = \&DB::dbwarn;
+        }
+        elsif ($prevwarn) {
+            $SIG{__WARN__} = $prevwarn;
+        }
+    } ## end if (@_)
+    $warnLevel;
+} ## end sub warnLevel
+
+=head2 C<dielevel>
+
+Similar to C<warnLevel>. Non-zero values for C<dieLevel> result in the 
+C<DB::dbdie()> function overriding any other C<die()> handler. Setting it to
+zero lets you use your own C<die()> handler.
+
+=cut
 
 sub dieLevel {
-  local $\ = '';
-  if (@_) {
-    $prevdie = $SIG{__DIE__} unless $dieLevel;
-    $dieLevel = shift;
-    if ($dieLevel) {
-      $SIG{__DIE__} = \&DB::dbdie; # if $dieLevel < 2;
-      #$SIG{__DIE__} = \&DB::diehard if $dieLevel >= 2;
-      print $OUT "Stack dump during die enabled", 
-        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n"
-	  if $I_m_init;
-      print $OUT "Dump printed too.\n" if $dieLevel > 2;
-    } elsif ($prevdie) {
-      $SIG{__DIE__} = $prevdie;
-      print $OUT "Default die handler restored.\n";
-    }
-  }
-  $dieLevel;
-}
+    local $\ = '';
+    if (@_) {
+        $prevdie = $SIG{__DIE__} unless $dieLevel;
+        $dieLevel = shift;
+        if ($dieLevel) {
+            # Always set it to dbdie() for non-zero values.
+            $SIG{__DIE__} = \&DB::dbdie;    # if $dieLevel < 2;
+
+           # No longer exists, so don't try  to use it.
+           #$SIG{__DIE__} = \&DB::diehard if $dieLevel >= 2;
+
+            # If we've finished initialization, mention that stack dumps
+            # are enabled, If dieLevel is 1, we won't stack dump if we die
+            # in an eval().
+            print $OUT "Stack dump during die enabled",
+              ($dieLevel == 1 ? " outside of evals" : ""), ".\n"
+              if $I_m_init;
+
+            # XXX This is probably obsolete, given that diehard() is gone.
+            print $OUT "Dump printed too.\n" if $dieLevel > 2;
+        } ## end if ($dieLevel)
+
+        # Put the old one back if there was one.
+        elsif ($prevdie) {
+            $SIG{__DIE__} = $prevdie;
+            print $OUT "Default die handler restored.\n";
+        }
+    } ## end if (@_)
+    $dieLevel;
+} ## end sub dieLevel
+
+=head2 C<signalLevel>
+
+Number three in a series: set C<signalLevel> to zero to keep your own
+signal handler for C<SIGSEGV> and/or C<SIGBUS>. Otherwise, the debugger 
+takes over and handles them with C<DB::diesignal()>.
+
+=cut
 
 sub signalLevel {
-  if (@_) {
-    $prevsegv = $SIG{SEGV} unless $signalLevel;
-    $prevbus = $SIG{BUS} unless $signalLevel;
-    $signalLevel = shift;
-    if ($signalLevel) {
-      $SIG{SEGV} = \&DB::diesignal;
-      $SIG{BUS} = \&DB::diesignal;
-    } else {
-      $SIG{SEGV} = $prevsegv;
-      $SIG{BUS} = $prevbus;
-    }
-  }
-  $signalLevel;
-}
+    if (@_) {
+        $prevsegv = $SIG{SEGV} unless $signalLevel;
+        $prevbus  = $SIG{BUS}  unless $signalLevel;
+        $signalLevel = shift;
+        if ($signalLevel) {
+            $SIG{SEGV} = \&DB::diesignal;
+            $SIG{BUS}  = \&DB::diesignal;
+        }
+        else {
+            $SIG{SEGV} = $prevsegv;
+            $SIG{BUS}  = $prevbus;
+        }
+    } ## end if (@_)
+    $signalLevel;
+} ## end sub signalLevel
+
+=head1 SUBROUTINE DECODING SUPPORT
+
+These subroutines are used during the C<x> and C<X> commands to try to
+produce as much information as possible about a code reference. They use
+L<Devel::Peek> to try to find the glob in which this code reference lives
+(if it does) - this allows us to actually code references which correspond
+to named subroutines (including those aliased via glob assignment).
+
+=head2 C<CvGV_name()>
+
+Wrapper for X<CvGV_name_or_bust>; tries to get the name of a reference
+via that routine. If this fails, return the reference again (when the
+reference is stringified, it'll come out as "SOMETHING(0X...)").
+
+=cut
 
 sub CvGV_name {
-  my $in = shift;
-  my $name = CvGV_name_or_bust($in);
-  defined $name ? $name : $in;
+    my $in   = shift;
+    my $name = CvGV_name_or_bust($in);
+    defined $name ? $name : $in;
 }
 
+=head2 C<CvGV_name_or_bust> I<coderef>
+
+Calls L<Devel::Peek> to try to find the glob the ref lives in; returns
+C<undef> if L<Devel::Peek> can't be loaded, or if C<Devel::Peek::CvGV> can't
+find a glob for this ref.
+
+Returns "I<package>::I<glob name>" if the code ref is found in a glob.
+
+=cut
+
 sub CvGV_name_or_bust {
-  my $in = shift;
-  return if $skipCvGV;		# Backdoor to avoid problems if XS broken...
-  return unless ref $in;
-  $in = \&$in;			# Hard reference...
-  eval {require Devel::Peek; 1} or return;
-  my $gv = Devel::Peek::CvGV($in) or return;
-  *$gv{PACKAGE} . '::' . *$gv{NAME};
-}
+    my $in = shift;
+    return if $skipCvGV;    # Backdoor to avoid problems if XS broken...
+    return unless ref $in;
+    $in = \&$in;            # Hard reference...
+    eval { require Devel::Peek; 1 } or return;
+    my $gv = Devel::Peek::CvGV($in) or return;
+    *$gv{PACKAGE} . '::' . *$gv{NAME};
+} ## end sub CvGV_name_or_bust
+
+=head2 C<find_sub>
+
+A utility routine used in various places; finds the file where a subroutine 
+was defined, and returns that filename and a line-number range.
+
+Tries to use X<@sub> first; if it can't find it there, it tries building a
+reference to the subroutine and uses X<CvGV_name_or_bust> to locate it,
+loading it into X<@sub> as a side effect (XXX I think). If it can't find it
+this way, it brute-force searches X<%sub>, checking for identical references.
+
+=cut
 
 sub find_sub {
-  my $subr = shift;
-  $sub{$subr} or do {
-    return unless defined &$subr;
-    my $name = CvGV_name_or_bust($subr);
-    my $data;
-    $data = $sub{$name} if defined $name;
-    return $data if defined $data;
-
-    # Old stupid way...
-    $subr = \&$subr;		# Hard reference
-    my $s;
-    for (keys %sub) {
-      $s = $_, last if $subr eq \&$_;
-    }
-    $sub{$s} if $s;
-  }
-}
+    my $subr = shift;
+    $sub{$subr} or do {
+        return unless defined &$subr;
+        my $name = CvGV_name_or_bust($subr);
+        my $data;
+        $data = $sub{$name} if defined $name;
+        return $data if defined $data;
+
+        # Old stupid way...
+        $subr = \&$subr;    # Hard reference
+        my $s;
+        for (keys %sub) {
+            $s = $_, last if $subr eq \&$_;
+        }
+        $sub{$s} if $s;
+      } ## end do
+} ## end sub find_sub
+
+=head2 C<methods>
+
+A subroutine that uses the utility function X<methods_via> to find all the
+methods in the class corresponding to the current reference and in 
+C<UNIVERSAL>.
+
+=cut
 
 sub methods {
-  my $class = shift;
-  $class = ref $class if ref $class;
-  local %seen;
-  local %packs;
-  methods_via($class, '', 1);
-  methods_via('UNIVERSAL', 'UNIVERSAL', 0);
-}
+
+    # Figure out the class - either this is the class or it's a reference
+    # to something blessed into that class.
+    my $class = shift;
+    $class = ref $class if ref $class;
+
+    local %seen;
+    local %packs;
+
+    # Show the methods that this class has.
+    methods_via($class, '', 1);
+
+    # Show the methods that UNIVERSAL has.
+    methods_via('UNIVERSAL', 'UNIVERSAL', 0);
+} ## end sub methods
+
+=head2 C<methods_via($class, $prefix, $crawl_upward)>
+
+C<methods_via> does the work of crawling up the C<@ISA> tree and reporting
+all the parent class methods. C<$class> is the name of the next class to
+try; C<$prefix> is the message prefix, which gets built up as we go up the
+C<@ISA> tree to show parentage; C<$crawl_upward> is 1 if we should try to go
+higher in the C<@ISA> tree, 0 if we should stop.
+
+=cut
 
 sub methods_via {
-  my $class = shift;
-  return if $packs{$class}++;
-  my $prefix = shift;
-  my $prepend = $prefix ? "via $prefix: " : '';
-  my $name;
-  for $name (grep {defined &{${"${class}::"}{$_}}} 
-	     sort keys %{"${class}::"}) {
-    next if $seen{ $name }++;
-    local $\ = '';
-    local $, = '';
-    print $DB::OUT "$prepend$name\n";
-  }
-  return unless shift;		# Recurse?
-  for $name (@{"${class}::ISA"}) {
-    $prepend = $prefix ? $prefix . " -> $name" : $name;
-    methods_via($name, $prepend, 1);
-  }
-}
+    # If we've processed this class already, just quit.
+    my $class = shift;
+    return if $seen{$class}++;
+
+    # This is a package that is contributing the methods we're about to print. 
+    my $prefix = shift;
+    my $prepend = $prefix ? "via $prefix: " : '';
+
+    my $name;
+    for $name (
+        # Keep if this is a defined subroutine in this class.
+        grep { defined &{ ${"${class}::"}{$_} } }
+             # Extract from all the symbols in this class.
+             sort keys %{"${class}::"}
+      ) {
+        # If we printed this already, skip it.
+        next if $seen{$name}++;
+ 
+        # Print the new method name.
+        local $\ = '';
+        local $, = '';
+        print $DB::OUT "$prepend$name\n";
+    } ## end for $name (grep { defined...
+
+    # If the $crawl_upward argument is false, just quit here.
+    return unless shift; 
+
+    # $crawl_upward true: keep going up the tree.
+    # Find all the classes this one is a subclass of.
+    for $name (@{"${class}::ISA"}) {
+        # Set up the new prefix.
+        $prepend = $prefix ? $prefix . " -> $name" : $name;
+        # Crawl up the tree and keep trying to crawl up. 
+        methods_via($name, $prepend, 1);
+    }
+} ## end sub methods_via
 
-sub setman { 
-    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
-		? "man"             # O Happy Day!
-		: "perldoc";        # Alas, poor unfortunates
-}
+=head2 C<setman> - figure out which command to use to show documentation
+
+Just checks the contents of C<$^O> and sets the C<$doccmd> global accordingly.
+
+=cut
+
+sub setman {
+    $doccmd =
+      $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
+      ? "man"               # O Happy Day!
+      : "perldoc";          # Alas, poor unfortunates
+} ## end sub setman
+
+=head2 C<runman> - run the appropriate command to show documentation
+
+Accepts a man page name; runs the appropriate command to display it (set up
+during debugger initialization). Uses C<DB::system> to avoid mucking up the
+program's STDIN and STDOUT.
+
+=cut
 
 sub runman {
     my $page = shift;
     unless ($page) {
-	&system("$doccmd $doccmd");
-	return;
-    } 
+        &system("$doccmd $doccmd");
+        return;
+    }
+
     # this way user can override, like with $doccmd="man -Mwhatever"
     # or even just "man " to disable the path check.
     unless ($doccmd eq 'man') {
-	&system("$doccmd $page");
-	return;
-    } 
+        &system("$doccmd $page");
+        return;
+    }
 
     $page = 'perl' if lc($page) eq 'help';
 
     require Config;
     my $man1dir = $Config::Config{'man1dir'};
     my $man3dir = $Config::Config{'man3dir'};
-    for ($man1dir, $man3dir) { s#/[^/]*\z## if /\S/ } 
+    for ($man1dir, $man3dir) { s#/[^/]*\z## if /\S/ }
     my $manpath = '';
     $manpath .= "$man1dir:" if $man1dir =~ /\S/;
     $manpath .= "$man3dir:" if $man3dir =~ /\S/ && $man1dir ne $man3dir;
     chop $manpath if $manpath;
+
     # harmless if missing, I figure
     my $oldpath = $ENV{MANPATH};
     $ENV{MANPATH} = $manpath if $manpath;
     my $nopathopt = $^O =~ /dunno what goes here/;
-    if (CORE::system($doccmd, 
-		# I just *know* there are men without -M
-		(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),  
-	    split ' ', $page) )
+    if (
+        CORE::system(
+            $doccmd,
+
+            # I just *know* there are men without -M
+            (($manpath && !$nopathopt) ? ("-M", $manpath) : ()),
+            split ' ', $page
+        )
+      )
     {
-	unless ($page =~ /^perl\w/) {
-	    if (grep { $page eq $_ } qw{ 
-		5004delta 5005delta amiga api apio book boot bot call compile
-		cygwin data dbmfilter debug debguts delta diag doc dos dsc embed
-		faq faq1 faq2 faq3 faq4 faq5 faq6 faq7 faq8 faq9 filter fork
-		form func guts hack hist hpux intern ipc lexwarn locale lol mod
-		modinstall modlib number obj op opentut os2 os390 pod port 
-		ref reftut run sec style sub syn thrtut tie toc todo toot tootc
-		trap unicode var vms win32 xs xstut
-	      }) 
-	    {
-		$page =~ s/^/perl/;
-		CORE::system($doccmd, 
-			(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),  
-			$page);
-	    }
-	}
-    } 
+        unless ($page =~ /^perl\w/) {
+            if (
+                grep { $page eq $_ }
+                qw{
+                5004delta 5005delta amiga api apio book boot bot call compile
+                cygwin data dbmfilter debug debguts delta diag doc dos dsc embed
+                faq faq1 faq2 faq3 faq4 faq5 faq6 faq7 faq8 faq9 filter fork
+                form func guts hack hist hpux intern ipc lexwarn locale lol mod
+                modinstall modlib number obj op opentut os2 os390 pod port
+                ref reftut run sec style sub syn thrtut tie toc todo toot tootc
+                trap unicode var vms win32 xs xstut
+                }
+              )
+            {
+                $page =~ s/^/perl/;
+                CORE::system($doccmd,
+                    (($manpath && !$nopathopt) ? ("-M", $manpath) : ()),
+                    $page);
+            } ## end if (grep { $page eq $_...
+        } ## end unless ($page =~ /^perl\w/)
+    } ## end if (CORE::system($doccmd...
     if (defined $oldpath) {
-	$ENV{MANPATH} = $manpath;
-    } else {
-	delete $ENV{MANPATH};
-    } 
-} 
+        $ENV{MANPATH} = $manpath;
+    }
+    else {
+        delete $ENV{MANPATH};
+    }
+} ## end sub runman
+
+#use Carp;                          # This did break, left for debugging
+
+=head1 DEBUGGER INITIALIZATION - THE SECOND BEGIN BLOCK
+
+Because of the way the debugger interface to the Perl core is designed, any
+debugger package globals that C<DB::sub()> requires have to be defined before
+any subroutines can be called. These are defined in the second C<BEGIN> block.
+
+This block sets things up so that (basically) the world is sane
+before the debugger starts executing. We set up various variables that the
+debugger has to have set up before the Perl core starts running:
+
+=over 4 
+
+=item * The debugger's own filehandles (copies of STD and STDOUT for now).
+
+=item * Characters for shell escapes, the recall command, and the history command.
+
+=item * The maximum recursion depth.
+
+=item * The size of a C<w> command's window.
+
+=item * The before-this-line context to be printed in a C<v> (view a window around this line) command.
+
+=item * The fact that we're not in a sub at all right now.
+
+=item * The default SIGINT handler for the debugger.
+
+=item * The appropriate value of the flag in C<$^D> that says the debugger is running
+
+=item * The current debugger recursion level
+
+=item * The list of postponed (XXX define) items and the C<$single> stack
+
+=item * That we want no return values and no subroutine entry/exit trace.
+
+=back
+
+=cut
 
 # The following BEGIN is very handy if debugger goes havoc, debugging debugger?
 
-BEGIN {			# This does not compile, alas.
-  $IN = \*STDIN;		# For bugs before DB::OUT has been opened
-  $OUT = \*STDERR;		# For errors before DB::OUT has been opened
-  $sh = '!';
-  $rc = ',';
-  @hist = ('?');
-  $deep = 100;			# warning if stack gets this deep
-  $window = 10;
-  $preview = 3;
-  $sub = '';
-  $SIG{INT} = \&DB::catch;
-  # This may be enabled to debug debugger:
-  #$warnLevel = 1 unless defined $warnLevel;
-  #$dieLevel = 1 unless defined $dieLevel;
-  #$signalLevel = 1 unless defined $signalLevel;
-
-  $db_stop = 0;			# Compiler warning
-  $db_stop = 1 << 30;
-  $level = 0;			# Level of recursive debugging
-  # @stack and $doret are needed in sub sub, which is called for DB::postponed.
-  # Triggers bug (?) in perl is we postpone this until runtime:
-  @postponed = @stack = (0);
-  $stack_depth = 0;		# Localized $#stack
-  $doret = -2;
-  $frame = 0;
-}
+BEGIN {    # This does not compile, alas. (XXX eh?)
+    $IN      = \*STDIN;     # For bugs before DB::OUT has been opened
+    $OUT     = \*STDERR;    # For errors before DB::OUT has been opened
+
+    # Define characters used by command parsing. 
+    $sh      = '!';         # Shell escape (does not work)
+    $rc      = ',';         # Recall command (does not work)
+    @hist    = ('?');       # Show history (does not work)
 
-BEGIN {$^W = $ini_warn;}	# Switch warnings back
+    # This defines the point at which you get the 'deep recursion' 
+    # warning. It MUST be defined or the debugger will not load.
+    $deep    = 100;
 
-#use Carp;			# This did break, left for debugging
+    # Number of lines around the current one that are shown in the 
+    # 'w' command.
+    $window  = 10;
+
+    # How much before-the-current-line context the 'v' command should
+    # use in calculating the start of the window it will display.
+    $preview = 3;
+
+    # We're not in any sub yet, but we need this to be a defined value.
+    $sub     = '';
+
+    # Set up the debugger's interrupt handler. It simply sets a flag 
+    # ($signal) that DB::DB() will check before each command is executed.
+    $SIG{INT} = \&DB::catch;
+
+    # The following lines supposedly, if uncommented, allow the debugger to
+    # debug itself. Perhaps we can try that someday. 
+    # This may be enabled to debug debugger:
+    #$warnLevel = 1 unless defined $warnLevel;
+    #$dieLevel = 1 unless defined $dieLevel;
+    #$signalLevel = 1 unless defined $signalLevel;
+
+    # This is the flag that says "a debugger is running, please call
+    # DB::DB and DB::sub". We will turn it on forcibly before we try to
+    # execute anything in the user's context, because we always want to
+    # get control back.
+    $db_stop = 0;           # Compiler warning ...
+    $db_stop = 1 << 30;     # ... because this is only used in an eval() later.
+
+    # This variable records how many levels we're nested in debugging. Used
+    # Used in the debugger prompt, and in determining whether it's all over or 
+    # not.
+    $level   = 0;           # Level of recursive debugging
+
+    # "Triggers bug (?) in perl if we postpone this until runtime."
+    # XXX No details on this yet, or whether we should fix the bug instead
+    # of work around it. Stay tuned. 
+    @postponed = @stack = (0);
+
+    # Used to track the current stack depth using the auto-stacked-variable
+    # trick.
+    $stack_depth = 0;    # Localized repeatedly; simple way to track $#stack
+
+    # Don't print return values on exiting a subroutine.
+    $doret       = -2;
+
+    # No extry/exit tracing.
+    $frame       = 0;
+
+} ## end BEGIN
+
+BEGIN { $^W = $ini_warn; }    # Switch warnings back
+
+=head1 READLINE SUPPORT - COMPLETION FUNCTION
+
+=head2 db_complete
+
+C<readline> support - adds command completion to basic C<readline>. 
+
+Returns a list of possible completions to C<readline> when invoked. C<readline>
+will print the longest common substring following the text already entered. 
+
+If there is only a single possible completion, C<readline> will use it in full.
+
+This code uses C<map> and C<grep> heavily to create lists of possible 
+completion. Think LISP in this section.
+
+=cut
 
 sub db_complete {
-  # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
-  my($text, $line, $start) = @_;
-  my ($itext, $search, $prefix, $pack) =
-    ($text, "^\Q${'package'}::\E([^:]+)\$");
-  
-  return sort grep /^\Q$text/, (keys %sub), qw(postpone load compile), # subroutines
-                               (map { /$search/ ? ($1) : () } keys %sub)
-    if (substr $line, 0, $start) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
-  return sort grep /^\Q$text/, values %INC # files
-    if (substr $line, 0, $start) =~ /^\|*b\s+load\s+$/;
-  return sort map {($_, db_complete($_ . "::", "V ", 2))}
-    grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : ()} keys %:: # top-packages
+
+    # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
+    # $text is the text to be completed.
+    # $line is the incoming line typed by the user.
+    # $start is the start of the text to be completed in the incoming line.
+    my ($text, $line, $start) = @_;
+
+    # Save the initial text.
+    # The search pattern is current package, ::, extract the next qualifier
+    # Prefix and pack are set to undef.
+    my ($itext, $search, $prefix, $pack) =
+      ($text, "^\Q${'package'}::\E([^:]+)\$");
+
+=head3 C<b postpone|compile> 
+
+=over 4
+
+=item * Find all the subroutines that might match in this package
+
+=item * Add "postpone", "load", and "compile" as possibles (we may be completing the keyword itself
+
+=item * Include all the rest of the subs that are known
+
+=item * C<grep> out the ones that match the text we have so far
+
+=item * Return this as the list of possible completions
+
+=back
+
+=cut 
+
+    return sort grep /^\Q$text/, (keys %sub),
+      qw(postpone load compile),    # subroutines
+      (map { /$search/ ? ($1) : () } keys %sub)
+      if (substr $line, 0, $start) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
+
+=head3 C<b load>
+
+Get all the possible files from @INC as it currently stands and
+select the ones that match the text so far.
+
+=cut
+
+    return sort grep /^\Q$text/, values %INC    # files
+      if (substr $line, 0, $start) =~ /^\|*b\s+load\s+$/;
+
+=head3  C<V> (list variable) and C<m> (list modules)
+
+There are two entry points for these commands:
+
+=head4 Unqualified package names
+
+Get the top-level packages and grab everything that matches the text
+so far. For each match, recursively complete the partial packages to
+get all possible matching packages. Return this sorted list.
+
+=cut
+
+    return sort map { ($_, db_complete($_ . "::", "V ", 2)) }
+      grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : () } keys %::  # top-packages
       if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ and $text =~ /^\w*$/;
-  return sort map {($_, db_complete($_ . "::", "V ", 2))}
-    grep !/^main::/,
-      grep /^\Q$text/, map { /^(.*)::$/ ? ($prefix . "::$1") : ()} keys %{$prefix . '::'}
-				 # packages
-	if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ 
-	  and $text =~ /^(.*[^:])::?(\w*)$/  and $prefix = $1;
-  if ( $line =~ /^\|*f\s+(.*)/ ) { # Loaded files
-    # We may want to complete to (eval 9), so $text may be wrong
-    $prefix = length($1) - length($text);
-    $text = $1;
-    return sort 
-	map {substr $_, 2 + $prefix} grep /^_<\Q$text/, (keys %main::), $0
-  }
-  if ((substr $text, 0, 1) eq '&') { # subroutines
-    $text = substr $text, 1;
-    $prefix = "&";
-    return sort map "$prefix$_", 
-               grep /^\Q$text/, 
-                 (keys %sub),
-                 (map { /$search/ ? ($1) : () } 
-		    keys %sub);
-  }
-  if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
-    $pack = ($1 eq 'main' ? '' : $1) . '::';
-    $prefix = (substr $text, 0, 1) . $1 . '::';
-    $text = $2;
-    my @out 
-      = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/, keys %$pack ;
-    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
-      return db_complete($out[0], $line, $start);
-    }
-    return sort @out;
-  }
-  if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
-    $pack = ($package eq 'main' ? '' : $package) . '::';
-    $prefix = substr $text, 0, 1;
-    $text = substr $text, 1;
-    my @out = map "$prefix$_", grep /^\Q$text/, 
-       (grep /^_?[a-zA-Z]/, keys %$pack), 
-       ( $pack eq '::' ? () : (grep /::$/, keys %::) ) ;
-    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
-      return db_complete($out[0], $line, $start);
-    }
-    return sort @out;
-  }
-  if ((substr $line, 0, $start) =~ /^\|*O\b.*\s$/) { # Options after a space
-    my @out = grep /^\Q$text/, @options;
-    my $val = option_val($out[0], undef);
-    my $out = '? ';
-    if (not defined $val or $val =~ /[\n\r]/) {
-      # Can do nothing better
-    } elsif ($val =~ /\s/) {
-      my $found;
-      foreach $l (split //, qq/\"\'\#\|/) {
-	$out = "$l$val$l ", last if (index $val, $l) == -1;
-      }
-    } else {
-      $out = "=$val ";
-    }
-    # Default to value if one completion, to question if many
-    $rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
-    return sort @out;
-  }
-  return $term->filename_list($text); # filenames
-}
+
+=head4 Qualified package names
+
+Take a partially-qualified package and find all subpackages for it
+by getting all the subpackages for the package so far, matching all
+the subpackages against the text, and discarding all of them which 
+start with 'main::'. Return this list.
+
+=cut
+
+    return sort map { ($_, db_complete($_ . "::", "V ", 2)) }
+      grep !/^main::/, grep /^\Q$text/,
+        map { /^(.*)::$/ ? ($prefix . "::$1") : () } keys %{ $prefix . '::' }
+          if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/
+              and $text =~ /^(.*[^:])::?(\w*)$/
+              and $prefix = $1;
+
+=head3 C<f> - switch files
+
+Here, we want to get a fully-qualified filename for the C<f> command.
+Possibilities are:
+
+=over 4
+
+=item 1. The original source file itself
+
+=item 2. A file from C<@INC>
+
+=item 3. An C<eval> (the debugger gets a C<(eval N)> fake file for each C<eval>).
+
+=back
+
+=cut
+
+    if ($line =~ /^\|*f\s+(.*)/) {                              # Loaded files
+        # We might possibly want to switch to an eval (which has a "filename"
+        # like '(eval 9)'), so we may need to clean up the completion text 
+        # before proceeding. 
+        $prefix = length($1) - length($text);
+        $text   = $1;
+
+=pod
+
+Under the debugger, source files are represented as C<_E<lt>/fullpath/to/file> 
+(C<eval>s are C<_E<lt>(eval NNN)>) keys in C<%main::>. We pull all of these 
+out of C<%main::>, add the initial source file, and extract the ones that 
+match the completion text so far.
+
+=cut
+
+        return sort
+          map { substr $_, 2 + $prefix } grep /^_<\Q$text/, (keys %main::),
+          $0;
+    } ## end if ($line =~ /^\|*f\s+(.*)/)
+
+=head3 Subroutine name completion
+
+We look through all of the defined subs (the keys of C<%sub>) and
+return both all the possible matches to the subroutine name plus
+all the matches qualified to the current package.
+
+=cut
+
+    if ((substr $text, 0, 1) eq '&') {    # subroutines
+        $text = substr $text, 1;
+        $prefix = "&";
+        return sort map "$prefix$_", grep /^\Q$text/, (keys %sub),
+          (
+            map { /$search/ ? ($1) : () }
+              keys %sub
+              );
+    } ## end if ((substr $text, 0, ...
+
+=head3  Scalar, array, and hash completion: partially qualified package
+
+Much like the above, except we have to do a little more cleanup:
+
+=cut
+
+    if ($text =~ /^[\$@%](.*)::(.*)/) {    # symbols in a package
+
+=pod
+
+=over 4 
+
+=item * Determine the package that the symbol is in. Put it in C<::> (effectively C<main::>) if no package is specified.
+
+=cut
+
+        $pack = ($1 eq 'main' ? '' : $1) . '::';
+
+=pod
+
+=item * Figure out the prefix vs. what needs completing.
+
+=cut
+
+        $prefix = (substr $text, 0, 1) . $1 . '::';
+        $text = $2;
+
+=pod
+
+=item * Look through all the symbols in the package. C<grep> out all the possible hashes/arrays/scalars, and then C<grep> the possible matches out of those. C<map> the prefix onto all the possibilities.
+
+=cut
+
+        my @out = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/,
+          keys %$pack;
+
+=pod
+
+=item * If there's only one hit, and it's a package qualifier, and it's not equal to the initial text, re-complete it using the symbol we actually found.
+
+=cut
+
+        if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+            return db_complete($out[0], $line, $start);
+        }
+
+        # Return the list of possibles.
+        return sort @out;
+
+    } ## end if ($text =~ /^[\$@%](.*)::(.*)/)
+
+=pod
+
+=back
+
+=head3 Symbol completion: current package or package C<main>.
+
+=cut
+
+
+    if ($text =~ /^[\$@%]/) {    # symbols (in $package + packages in main)
+
+=pod
+
+=over 4
+
+=item * If it's C<main>, delete main to just get C<::> leading.
+
+=cut
+
+        $pack = ($package eq 'main' ? '' : $package) . '::';
+
+=pod
+
+=item * We set the prefix to the item's sigil, and trim off the sigil to get the text to be completed.
+
+=cut
+
+        $prefix = substr $text, 0, 1;
+        $text = substr $text, 1;
+
+=pod
+
+=item * If the package is C<::> (C<main>), create an empty list; if it's something else, create a list of all the packages known.  Append whichever list to a list of all the possible symbols in the current package. C<grep> out the matches to the text entered so far, then C<map> the prefix back onto the symbols.
+
+=cut
+
+        my @out = map "$prefix$_", grep /^\Q$text/,
+          (grep /^_?[a-zA-Z]/, keys %$pack),
+          ($pack eq '::' ? () : (grep /::$/, keys %::));
+
+=item * If there's only one hit, it's a package qualifier, and it's not equal to the initial text, recomplete using this symbol.
+
+=back
+
+=cut
+
+        if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+            return db_complete($out[0], $line, $start);
+        }
+
+        # Return the list of possibles.
+        return sort @out;
+    } ## end if ($text =~ /^[\$@%]/)
+
+=head3 Options 
+
+We use C<option_val()> to look up the current value of the option. If there's
+only a single value, we complete the command in such a way that it is a 
+complete command for setting the option in question. If there are multiple
+possible values, we generate a command consisting of the option plus a trailing
+question mark, which, if executed, will list the current value of the option.
+
+=cut
+
+    my $cmd = ($CommandSet eq '580') ? 'o' : 'O';
+    if ((substr $line, 0, $start) =~ /^\|*$cmd\b.*\s$/) { # Options after space
+        # We look for the text to be matched in the list of possible options, 
+        # and fetch the current value. 
+        my @out = grep /^\Q$text/, @options;
+        my $val = option_val($out[0], undef);
+
+        # Set up a 'query option's value' command.
+        my $out = '? ';
+        if (not defined $val or $val =~ /[\n\r]/) {
+           # There's really nothing else we can do.
+        }
+
+        # We have a value. Create a proper option-setting command.
+        elsif ($val =~ /\s/) {
+            # XXX This may be an extraneous variable.
+            my $found;
+
+            # We'll want to quote the string (because of the embedded
+            # whtespace), but we want to make sure we don't end up with
+            # mismatched quote characters. We try several possibilities.
+            foreach $l (split //, qq/\"\'\#\|/) {
+                # If we didn't find this quote character in the value,
+                # quote it using this quote character.
+                $out = "$l$val$l ", last if (index $val, $l) == -1;
+            }
+        } ## end elsif ($val =~ /\s/)
+
+        # Don't need any quotes.
+        else {
+            $out = "=$val ";
+        }
+
+        # If there were multiple possible values, return '? ', which
+        # makes the command into a query command. If there was just one,
+        # have readline append that.
+        $rl_attribs->{completer_terminator_character} =
+          (@out == 1 ? $out : '? ');
+
+        # Return list of possibilities.
+        return sort @out;
+    } ## end if ((substr $line, 0, ...
+
+=head3 Filename completion
+
+For entering filenames. We simply call C<readline>'s C<filename_list()>
+method with the completion text to get the possible completions.
+
+=cut
+
+    return $term->filename_list($text);    # filenames
+
+} ## end sub db_complete
+
+=head1 MISCELLANEOUS SUPPORT FUNCTIONS
+
+Functions that possibly ought to be somewhere else.
+
+=head2 end_report
+
+Say we're done.
+
+=cut
 
 sub end_report {
-  local $\ = '';
-  print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n"
+    local $\ = '';
+    print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n";
 }
 
+=head2 clean_ENV
+
+If we have $ini_pids, save it in the environment; else remove it from the
+environment. Used by the C<R> (restart) command.
+
+=cut
+
 sub clean_ENV {
     if (defined($ini_pids)) {
         $ENV{PERLDB_PIDS} = $ini_pids;
-    } else {
+    }
+    else {
         delete($ENV{PERLDB_PIDS});
     }
-}
+} ## end sub clean_ENV
+
+=head1 END PROCESSING - THE C<END> BLOCK
+
+Come here at the very end of processing. We want to go into a 
+loop where we allow the user to enter commands and interact with the 
+debugger, but we don't want anything else to execute. 
+
+First we set the C<$finished> variable, so that some commands that
+shouldn't be run after the end of program quit working.
+
+We then figure out whether we're truly done (as in the user entered a C<q>
+command, or we finished execution while running nonstop). If we aren't,
+we set C<$single> to 1 (causing the debugger to get control again).
+
+We then call C<DB::fake::at_exit()>, which returns the C<Use 'q' to quit ...">
+message and returns control to the debugger. Repeat.
+
+When the user finally enters a C<q> command, C<$fall_off_end> is set to
+1 and the C<END> block simply exits with C<$single> set to 0 (don't 
+break, run to completion.).
+
+=cut
 
 END {
-  $finished = 1 if $inhibit_exit;      # So that some keys may be disabled.
-  $fall_off_end = 1 unless $inhibit_exit;
-  # Do not stop in at_exit() and destructors on exit:
-  $DB::single = !$fall_off_end && !$runnonstop;
-  DB::fake::at_exit() unless $fall_off_end or $runnonstop;
-}
+    $finished = 1 if $inhibit_exit;    # So that some commands may be disabled.
+    $fall_off_end = 1 unless $inhibit_exit;
 
+    # Do not stop in at_exit() and destructors on exit:
+    $DB::single = !$fall_off_end && !$runnonstop;
+    DB::fake::at_exit() unless $fall_off_end or $runnonstop;
+} ## end END
 
-# ===================================== pre580 ================================
-# this is very sad below here...
-#
+=head1 PRE-5.8 COMMANDS
+
+Some of the commands changed function quite a bit in the 5.8 command 
+realignment, so much so that the old code had to be replaced completely.
+Because we wanted to retain the option of being able to go back to the
+former command set, we moved the old code off to this section.
+
+There's an awful lot of duplicated code here. We've duplicated the 
+comments to keep things clear.
+
+=head2 Null command
+
+Does nothing. Used to 'turn off' commands.
+
+=cut
 
 sub cmd_pre580_null {
-	# do nothing...
+
+    # do nothing...
 }
 
+=head2 Old C<a> command.
+
+This version added actions if you supplied them, and deleted them
+if you didn't.
+
+=cut
+
 sub cmd_pre580_a {
-	my $cmd = shift;
-	if ($cmd =~ /^(\d*)\s*(.*)/) {
-		$i = $1 || $line; $j = $2;
-		if (length $j) {
-			if ($dbline[$i] == 0) {
-				print $OUT "Line $i may not have an action.\n";
-			} else {
-				$had_breakpoints{$filename} |= 2;
-				$dbline{$i} =~ s/\0[^\0]*//;
-				$dbline{$i} .= "\0" . action($j);
-			}
-		} else {
-			$dbline{$i} =~ s/\0[^\0]*//;
-			delete $dbline{$i} if $dbline{$i} eq '';
-		}
-	}
-}
+    my $xcmd = shift;
+    my $cmd  = shift;
+
+    # Argument supplied. Add the action.
+    if ($cmd =~ /^(\d*)\s*(.*)/) {
+
+        # If the line isn't there, use the current line.
+        $i = $1 || $line;
+        $j = $2;
+
+        # If there is an action ...
+        if (length $j) {
+
+            # ... but the line isn't breakable, skip it.
+            if ($dbline[$i] == 0) {
+                print $OUT "Line $i may not have an action.\n";
+            }
+            else {
+                # ... and the line is breakable:
+                # Mark that there's an action in this file.
+                $had_breakpoints{$filename} |= 2;
+
+                # Delete any current action.
+                $dbline{$i} =~ s/\0[^\0]*//;
+
+                # Add the new action, continuing the line as needed.
+                $dbline{$i} .= "\0" . action($j);
+            }
+        } ## end if (length $j)
+
+        # No action supplied.
+        else {
+            # Delete the action.
+            $dbline{$i} =~ s/\0[^\0]*//;
+            # Mark as having no break or action if nothing's left.
+            delete $dbline{$i} if $dbline{$i} eq '';
+        }
+    } ## end if ($cmd =~ /^(\d*)\s*(.*)/)
+} ## end sub cmd_pre580_a
+
+=head2 Old C<b> command 
+
+Add breakpoints.
+
+=cut
 
 sub cmd_pre580_b {
-	my $cmd    = shift;
-	my $dbline = shift;
-	if ($cmd =~ /^load\b\s*(.*)/) {
-		my $file = $1; $file =~ s/\s+$//;
-		&cmd_b_load($file);
-	} elsif ($cmd =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/) {
-		my $cond = length $3 ? $3 : '1';
-		my ($subname, $break) = ($2, $1 eq 'postpone');
-		$subname =~ s/\'/::/g;
-		$subname = "${'package'}::" . $subname
-		unless $subname =~ /::/;
-		$subname = "main".$subname if substr($subname,0,2) eq "::";
-		$postponed{$subname} = $break ? "break +0 if $cond" : "compile";
-	} elsif ($cmd =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/) { 
-		my $subname = $1;
-		my $cond = length $2 ? $2 : '1';
-		&cmd_b_sub($subname, $cond);
-	} elsif ($cmd =~ /^(\d*)\s*(.*)/) {
-		my $i = $1 || $dbline;
-		my $cond = length $2 ? $2 : '1';
-		&cmd_b_line($i, $cond);
-	}
-}
+    my $xcmd    = shift;
+    my $cmd     = shift;
+    my $dbline = shift;
+
+    # Break on load.
+    if ($cmd =~ /^load\b\s*(.*)/) {
+        my $file = $1;
+        $file =~ s/\s+$//;
+        &cmd_b_load($file);
+    }
+
+    # b compile|postpone <some sub> [<condition>]
+    # The interpreter actually traps this one for us; we just put the 
+    # necessary condition in the %postponed hash.
+    elsif ($cmd =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/) {
+        # Capture the condition if there is one. Make it true if none.
+        my $cond = length $3 ? $3 : '1';
+
+        # Save the sub name and set $break to 1 if $1 was 'postpone', 0
+        # if it was 'compile'.
+        my ($subname, $break) = ($2, $1 eq 'postpone');
+
+        # De-Perl4-ify the name - ' separators to ::.
+        $subname =~ s/\'/::/g;
+
+        # Qualify it into the current package unless it's already qualified.
+        $subname = "${'package'}::" . $subname
+          unless $subname =~ /::/;
+
+        # Add main if it starts with ::.
+        $subname = "main" . $subname if substr($subname, 0, 2) eq "::";
+
+        # Save the break type for this sub.
+        $postponed{$subname} = $break ? "break +0 if $cond" : "compile";
+    } ## end elsif ($cmd =~ ...
+
+    # b <sub name> [<condition>]
+    elsif ($cmd =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/) {
+        my $subname = $1;
+        my $cond = length $2 ? $2 : '1';
+        &cmd_b_sub($subname, $cond);
+    }
+
+    # b <line> [<condition>].
+    elsif ($cmd =~ /^(\d*)\s*(.*)/) {
+        my $i = $1 || $dbline;
+        my $cond = length $2 ? $2 : '1';
+        &cmd_b_line($i, $cond);
+    }
+} ## end sub cmd_pre580_b
+
+=head2 Old C<D> command.
+
+Delete all breakpoints unconditionally.
+
+=cut
 
 sub cmd_pre580_D {
-	my $cmd = shift;
-	if ($cmd =~ /^\s*$/) {
-		print $OUT "Deleting all breakpoints...\n";
-		my $file;
-		for $file (keys %had_breakpoints) {
-			local *dbline = $main::{'_<' . $file};
-			my $max = $#dbline;
-			my $was;
-
-			for ($i = 1; $i <= $max ; $i++) {
-				if (defined $dbline{$i}) {
-					$dbline{$i} =~ s/^[^\0]+//;
-					if ($dbline{$i} =~ s/^\0?$//) {
-						delete $dbline{$i};
-					}
-				}
-			}
-
-			if (not $had_breakpoints{$file} &= ~1) {
-				delete $had_breakpoints{$file};
-			}
-		}
-		undef %postponed;
-		undef %postponed_file;
-		undef %break_on_load;
-	}
-}
+    my $xcmd = shift;
+    my $cmd  = shift;
+    if ($cmd =~ /^\s*$/) {
+        print $OUT "Deleting all breakpoints...\n";
+
+        # %had_breakpoints lists every file that had at least one
+        # breakpoint in it.
+        my $file;
+        for $file (keys %had_breakpoints) {
+            # Switch to the desired file temporarily.
+            local *dbline = $main::{ '_<' . $file };
+
+            my $max = $#dbline;
+            my $was;
+
+            # For all lines in this file ...
+            for ($i = 1 ; $i <= $max ; $i++) {
+                # If there's a breakpoint or action on this line ...
+                if (defined $dbline{$i}) {
+                    # ... remove the breakpoint.
+                    $dbline{$i} =~ s/^[^\0]+//;
+                    if ($dbline{$i} =~ s/^\0?$//) {
+                        # Remove the entry altogether if no action is there.
+                        delete $dbline{$i};
+                    }
+                } ## end if (defined $dbline{$i...
+            } ## end for ($i = 1 ; $i <= $max...
+
+            # If, after we turn off the "there were breakpoints in this file"
+            # bit, the entry in %had_breakpoints for this file is zero, 
+            # we should remove this file from the hash.
+            if (not $had_breakpoints{$file} &= ~1) {
+                delete $had_breakpoints{$file};
+            }
+        } ## end for $file (keys %had_breakpoints)
+
+        # Kill off all the other breakpoints that are waiting for files that
+        # haven't been loaded yet.
+        undef %postponed;
+        undef %postponed_file;
+        undef %break_on_load;
+    } ## end if ($cmd =~ /^\s*$/)
+} ## end sub cmd_pre580_D
+
+=head2 Old C<h> command
+
+Print help. Defaults to printing the long-form help; the 5.8 version 
+prints the summary by default.
+
+=cut
 
 sub cmd_pre580_h {
-	my $cmd = shift;
-	if ($cmd =~ /^\s*$/) {
-		print_help($pre580_help);
-	} elsif ($cmd =~ /^h\s*/) {
-		print_help($pre580_summary);
-	} elsif ($cmd =~ /^h\s+(\S.*)$/) { 
-		my $asked = $1;			# for proper errmsg
-		my $qasked = quotemeta($asked); # for searching
-		# XXX: finds CR but not <CR>
-		if ($pre580_help =~ /^<?(?:[IB]<)$qasked/m) {
-			while ($pre580_help =~ /^(<?(?:[IB]<)$qasked([\s\S]*?)\n)(?!\s)/mg) {
-				print_help($1);
-			}
-		} else {
-			print_help("B<$asked> is not a debugger command.\n");
-		}
-	}
-}
+    my $xcmd = shift;
+    my $cmd  = shift;
+
+    # Print the *right* help, long format.
+    if ($cmd =~ /^\s*$/) {
+        print_help($pre580_help);
+    }
+
+    # 'h h' - explicitly-requested summary. 
+    elsif ($cmd =~ /^h\s*/) {
+        print_help($pre580_summary);
+    }
+
+    # Find and print a command's help.
+    elsif ($cmd =~ /^h\s+(\S.*)$/) {
+        my $asked  = $1;                   # for proper errmsg
+        my $qasked = quotemeta($asked);    # for searching
+                                           # XXX: finds CR but not <CR>
+        if ($pre580_help =~ /^
+                              <?           # Optional '<'
+                              (?:[IB]<)    # Optional markup
+                              $qasked      # The command name
+                            /mx) {
+
+            while (
+                $pre580_help =~ /^
+                                  (             # The command help:
+                                   <?           # Optional '<'
+                                   (?:[IB]<)    # Optional markup
+                                   $qasked      # The command name
+                                   ([\s\S]*?)   # Lines starting with tabs
+                                   \n           # Final newline
+                                  )
+                                  (?!\s)/mgx)   # Line not starting with space
+                                                # (Next command's help)
+            {
+                print_help($1);
+            }
+        } ## end if ($pre580_help =~ /^<?(?:[IB]<)$qasked/m)
+
+        # Help not found.
+        else {
+            print_help("B<$asked> is not a debugger command.\n");
+        }
+    } ## end elsif ($cmd =~ /^h\s+(\S.*)$/)
+} ## end sub cmd_pre580_h
+
+=head2 Old C<W> command
+
+C<W E<lt>exprE<gt>> adds a watch expression, C<W> deletes them all.
+
+=cut
 
 sub cmd_pre580_W {
-	my $cmd = shift;
-	if ($cmd =~ /^$/) { 
-		$trace &= ~2;
-		@to_watch = @old_watch = ();
-	} elsif ($cmd =~ /^(.*)/s) {
-		push @to_watch, $1;
-		$evalarg = $1;
-		my ($val) = &eval;
-		$val = (defined $val) ? "'$val'" : 'undef' ;
-		push @old_watch, $val;
-		$trace |= 2;
-	}
-}
+    my $xcmd = shift;
+    my $cmd  = shift;
+
+    # Delete all watch expressions.
+    if ($cmd =~ /^$/) {
+        # No watching is going on.
+        $trace &= ~2;
+        # Kill all the watch expressions and values.
+        @to_watch = @old_watch = ();
+    }
+
+    # Add a watch expression.
+    elsif ($cmd =~ /^(.*)/s) {
+        # add it to the list to be watched.
+        push @to_watch, $1;
+
+        # Get the current value of the expression. 
+        # Doesn't handle expressions returning list values!
+        $evalarg = $1;
+        my ($val) = &eval;
+        $val = (defined $val) ? "'$val'" : 'undef';
+
+        # Save it.
+        push @old_watch, $val;
+
+        # We're watching stuff.
+        $trace |= 2;
+
+    } ## end elsif ($cmd =~ /^(.*)/s)
+} ## end sub cmd_pre580_W
+
+=head1 PRE-AND-POST-PROMPT COMMANDS AND ACTIONS
+
+The debugger used to have a bunch of nearly-identical code to handle 
+the pre-and-post-prompt action commands. C<cmd_pre590_prepost> and
+C<cmd_prepost> unify all this into one set of code to handle the 
+appropriate actions.
+
+=head2 C<cmd_pre590_prepost>
+
+A small wrapper around C<cmd_prepost>; it makes sure that the default doesn't
+do something destructive. In pre 5.8 debuggers, the default action was to
+delete all the actions.
+
+=cut
+
+sub cmd_pre590_prepost {
+    my $cmd    = shift;
+    my $line   = shift || '*';
+    my $dbline = shift;
+
+    return &cmd_prepost( $cmd, $line, $dbline );
+} ## end sub cmd_pre590_prepost
+
+=head2 C<cmd_prepost>
+
+Actually does all the handling foe C<E<lt>>, C<E<gt>>, C<{{>, C<{>, etc.
+Since the lists of actions are all held in arrays that are pointed to by
+references anyway, all we have to do is pick the right array reference and
+then use generic code to all, delete, or list actions.
+
+=cut
+
+sub cmd_prepost { my $cmd = shift;
+
+    # No action supplied defaults to 'list'.
+    my $line = shift || '?';
+
+    # Figure out what to put in the prompt.
+    my $which = '';
+
+    # Make sure we have some array or another to address later.
+    # This means that if ssome reason the tests fail, we won't be
+    # trying to stash actions or delete them from the wrong place.
+    my $aref  = [];
+
+   # < - Perl code to run before prompt.
+    if ( $cmd =~ /^\</o ) {
+        $which = 'pre-perl';
+        $aref  = $pre;
+    }
+
+    # > - Perl code to run after prompt.
+    elsif ( $cmd =~ /^\>/o ) {
+        $which = 'post-perl';
+        $aref  = $post;
+    }
+
+    # { - first check for properly-balanced braces.
+    elsif ( $cmd =~ /^\{/o ) {
+        if ( $cmd =~ /^\{.*\}$/o && unbalanced( substr( $cmd, 1 ) ) ) {
+            print $OUT
+"$cmd is now a debugger command\nuse `;$cmd' if you mean Perl code\n";
+        }
+
+        # Properly balanced. Pre-prompt debugger actions.
+        else {
+            $which = 'pre-debugger';
+            $aref  = $pretype;
+        }
+    } ## end elsif ( $cmd =~ /^\{/o )
+
+    # Did we find something that makes sense?
+    unless ($which) {
+        print $OUT "Confused by command: $cmd\n";
+    }
+
+    # Yes. 
+    else {
+        # List actions.
+        if ( $line =~ /^\s*\?\s*$/o ) {
+            unless (@$aref) {
+                # Nothing there. Complain.
+                print $OUT "No $which actions.\n";
+            }
+            else {
+                # List the actions in the selected list.
+                print $OUT "$which commands:\n";
+                foreach my $action (@$aref) {
+                    print $OUT "\t$cmd -- $action\n";
+                }
+            } ## end else
+        } ## end if ( $line =~ /^\s*\?\s*$/o)
+
+        # Might be a delete.
+        else {
+            if ( length($cmd) == 1 ) {
+                if ( $line =~ /^\s*\*\s*$/o ) {
+                    # It's a delete. Get rid of the old actions in the 
+                    # selected list..
+                    @$aref = ();
+                    print $OUT "All $cmd actions cleared.\n";
+                }
+                else {
+                    # Replace all the actions. (This is a <, >, or {).
+                    @$aref = action($line);
+                }
+            } ## end if ( length($cmd) == 1)
+            elsif ( length($cmd) == 2 ) { 
+                # Add the action to the line. (This is a <<, >>, or {{).
+                push @$aref, action($line);
+            }
+            else {
+                # <<<, >>>>, {{{{{{ ... something not a command.
+                print $OUT
+                  "Confused by strange length of $which command($cmd)...\n";
+            }
+        } ## end else [ if ( $line =~ /^\s*\?\s*$/o)
+    } ## end else
+} ## end sub cmd_prepost
+
+
+=head1 C<DB::fake>
+
+Contains the C<at_exit> routine that the debugger uses to issue the
+C<Debugged program terminated ...> message after the program completes. See
+the C<END> block documentation for more details.
+
+=cut
 
 package DB::fake;
 
 sub at_exit {
-  "Debugged program terminated.  Use `q' to quit or `R' to restart.";
+    "Debugged program terminated.  Use `q' to quit or `R' to restart.";
 }
 
-package DB;			# Do not trace this 1; below!
+package DB;    # Do not trace this 1; below!
 
 1;
 
diff --git a/gnu/usr.bin/perl/lib/strict.pm b/gnu/usr.bin/perl/lib/strict.pm
index 737cb18b1ad..d14391add44 100644
--- a/gnu/usr.bin/perl/lib/strict.pm
+++ b/gnu/usr.bin/perl/lib/strict.pm
@@ -1,5 +1,42 @@
 package strict;
 
+$strict::VERSION = "1.03";
+
+my %bitmask = (
+refs => 0x00000002,
+subs => 0x00000200,
+vars => 0x00000400
+);
+
+sub bits {
+    my $bits = 0;
+    my @wrong;
+    foreach my $s (@_) {
+	push @wrong, $s unless exists $bitmask{$s};
+        $bits |= $bitmask{$s} || 0;
+    }
+    if (@wrong) {
+        require Carp;
+        Carp::croak("Unknown 'strict' tag(s) '@wrong'");
+    }
+    $bits;
+}
+
+my $default_bits = bits(qw(refs subs vars));
+
+sub import {
+    shift;
+    $^H |= @_ ? bits(@_) : $default_bits;
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ (@_ ? bits(@_) : $default_bits);
+}
+
+1;
+__END__
+
 =head1 NAME
 
 strict - Perl pragma to restrict unsafe constructs
@@ -48,7 +85,7 @@ is allowed so that C<goto &$AUTOLOAD> would not break under stricture.
 =item C<strict vars>
 
 This generates a compile-time error if you access a variable that wasn't
-declared via "our" or C<use vars>,
+declared via C<our> or C<use vars>,
 localized via C<my()>, or wasn't fully qualified.  Because this is to avoid
 variable suicide problems and subtle dynamic scoping issues, a merely
 local() variable isn't good enough.  See L<perlfunc/my> and
@@ -73,45 +110,27 @@ exempted from this check.
 
 This disables the poetry optimization, generating a compile-time error if
 you try to use a bareword identifier that's not a subroutine, unless it
-appears in curly braces or on the left hand side of the "=E<gt>" symbol.
-
+is a simple identifier (no colons) and that it appears in curly braces or
+on the left hand side of the C<< => >> symbol.
 
     use strict 'subs';
     $SIG{PIPE} = Plumber;   	# blows up
-    $SIG{PIPE} = "Plumber"; 	# just fine: bareword in curlies always ok
+    $SIG{PIPE} = "Plumber"; 	# just fine: quoted string is always ok
     $SIG{PIPE} = \&Plumber; 	# preferred form
 
-
-
 =back
 
 See L<perlmodlib/Pragmatic Modules>.
 
+=head1 HISTORY
 
-=cut
+C<strict 'subs'>, with Perl 5.6.1, erroneously permitted to use an unquoted
+compound identifier (e.g. C<Foo::Bar>) as a hash key (before C<< => >> or
+inside curlies), but without forcing it always to a literal string.
 
-$strict::VERSION = "1.02";
+Starting with Perl 5.8.1 strict is strict about its restrictions:
+if unknown restrictions are used, the strict pragma will abort with
 
-my %bitmask = (
-refs => 0x00000002,
-subs => 0x00000200,
-vars => 0x00000400
-);
+    Unknown 'strict' tag(s) '...'
 
-sub bits {
-    my $bits = 0;
-    foreach my $s (@_){ $bits |= $bitmask{$s} || 0; };
-    $bits;
-}
-
-sub import {
-    shift;
-    $^H |= bits(@_ ? @_ : qw(refs subs vars));
-}
-
-sub unimport {
-    shift;
-    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
-}
-
-1;
+=cut
diff --git a/gnu/usr.bin/perl/lib/utf8.t b/gnu/usr.bin/perl/lib/utf8.t
index fd01970802a..33cd5966af5 100644
--- a/gnu/usr.bin/perl/lib/utf8.t
+++ b/gnu/usr.bin/perl/lib/utf8.t
@@ -37,7 +37,7 @@ no utf8; # Ironic, no?
 #
 #
 
-plan tests => 94;
+plan tests => 143;
 
 {
     # bug id 20001009.001
@@ -265,3 +265,147 @@ BANG
         like ($result, $expect, $why);
     }
 }
+
+#
+# bug fixed by change #17928
+# separate perl used because we rely on 'strict' not yet loaded;
+# before the patch, the eval died with an error like:
+#   "my" variable $strict::VERSION can't be in a package
+#
+SKIP: {
+    skip("Embedded UTF-8 does not work in EBCDIC", 1) if ord("A") == 193;
+    ok('' eq runperl(prog => <<'CODE'), "change #17928");
+	my $code = qq{ my \$\xe3\x83\x95\xe3\x83\xbc = 5; };
+    {
+	use utf8;
+	eval $code;
+	print $@ if $@;
+    }
+CODE
+}
+
+{
+    use utf8;
+    $a = <<'END';
+0 ....... 1 ....... 2 ....... 3 ....... 4 ....... 5 ....... 6 ....... 7 ....... 
+END
+    my (@i, $s);
+
+    @i = ();
+    push @i, $s = index($a, '6');     # 60
+    push @i, $s = index($a, '.', $s); # next . after 60 is 62
+    push @i, $s = index($a, '5');     # 50
+    push @i, $s = index($a, '.', $s); # next . after 52 is 52
+    push @i, $s = index($a, '7');     # 70 
+    push @i, $s = index($a, '.', $s); # next . after 70 is 72
+    push @i, $s = index($a, '4');     # 40
+    push @i, $s = index($a, '.', $s); # next . after 40 is 42
+    is("@i", "60 62 50 52 70 72 40 42", "utf8 heredoc index");
+
+    @i = ();
+    push @i, $s = rindex($a, '6');     # 60
+    push @i, $s = rindex($a, '.', $s); # previous . before 60 is 58
+    push @i, $s = rindex($a, '5');     # 50
+    push @i, $s = rindex($a, '.', $s); # previous . before 52 is 48
+    push @i, $s = rindex($a, '7');     # 70 
+    push @i, $s = rindex($a, '.', $s); # previous . before 70 is 68
+    push @i, $s = rindex($a, '4');     # 40
+    push @i, $s = rindex($a, '.', $s); # previous . before 40 is 38
+    is("@i", "60 58 50 48 70 68 40 38", "utf8 heredoc rindex");
+
+    @i = ();
+    push @i, $s =  index($a, '6');     # 60
+    push @i,  index($a, '.', $s);      # next     . after  60 is 62
+    push @i, rindex($a, '.', $s);      # previous . before 60 is 58
+    push @i, $s = rindex($a, '5');     # 60
+    push @i,  index($a, '.', $s);      # next     . after  50 is 52
+    push @i, rindex($a, '.', $s);      # previous . before 50 is 48
+    push @i, $s =  index($a, '7', $s); # 70
+    push @i,  index($a, '.', $s);      # next     . after  70 is 72
+    push @i, rindex($a, '.', $s);      # previous . before 70 is 68
+    is("@i", "60 62 58 50 52 48 70 72 68", "utf8 heredoc index and rindex");
+}
+
+SKIP: {
+    skip("Embedded UTF-8 does not work in EBCDIC", 1) if ord("A") == 193;
+    use utf8;
+    eval qq{is(q \xc3\xbc test \xc3\xbc, qq\xc2\xb7 test \xc2\xb7,
+	       "utf8 quote delimiters [perl #16823]");};
+}
+
+# Test the "internals".
+
+{
+    my $a = "A";
+    my $b = chr(0x0FF);
+    my $c = chr(0x100);
+
+    ok( utf8::valid($a), "utf8::valid basic");
+    ok( utf8::valid($b), "utf8::valid beyond");
+    ok( utf8::valid($c), "utf8::valid unicode");
+
+    ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
+    ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
+    ok( utf8::is_utf8($c), "utf8::is_utf8 unicode");
+
+    is(utf8::upgrade($a), 1, "utf8::upgrade basic");
+    is(utf8::upgrade($b), 2, "utf8::upgrade beyond");
+    is(utf8::upgrade($c), 2, "utf8::upgrade unicode");
+
+    is($a, "A",       "basic");
+    is($b, "\xFF",    "beyond");
+    is($c, "\x{100}", "unicode");
+
+    ok( utf8::valid($a), "utf8::valid basic");
+    ok( utf8::valid($b), "utf8::valid beyond");
+    ok( utf8::valid($c), "utf8::valid unicode");
+
+    ok( utf8::is_utf8($a), "utf8::is_utf8 basic");
+    ok( utf8::is_utf8($b), "utf8::is_utf8 beyond");
+    ok( utf8::is_utf8($c), "utf8::is_utf8 unicode");
+
+    is(utf8::downgrade($a), 1, "utf8::downgrade basic");
+    is(utf8::downgrade($b), 1, "utf8::downgrade beyond");
+
+    is($a, "A",       "basic");
+    is($b, "\xFF",    "beyond");
+
+    ok( utf8::valid($a), "utf8::valid basic");
+    ok( utf8::valid($b), "utf8::valid beyond");
+
+    ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
+    ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
+
+    utf8::encode($a);
+    utf8::encode($b);
+    utf8::encode($c);
+
+    is($a, "A",       "basic");
+    is(length($b), 2, "beyond length");
+    is(length($c), 2, "unicode length");
+
+    ok(utf8::valid($a), "utf8::valid basic");
+    ok(utf8::valid($b), "utf8::valid beyond");
+    ok(utf8::valid($c), "utf8::valid unicode");
+
+    # encode() clears the UTF-8 flag (unlike upgrade()).
+    ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
+    ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
+    ok(!utf8::is_utf8($c), "!utf8::is_utf8 unicode");
+
+    utf8::decode($a);
+    utf8::decode($b);
+    utf8::decode($c);
+
+    is($a, "A",       "basic");
+    is($b, "\xFF",    "beyond");
+    is($c, "\x{100}", "unicode");
+
+    ok(utf8::valid($a), "!utf8::valid basic");
+    ok(utf8::valid($b), "!utf8::valid beyond");
+    ok(utf8::valid($c), " utf8::valid unicode");
+
+    ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
+    ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8.
+    ok( utf8::is_utf8($c), " utf8::is_utf8 unicode");
+}