merge in perl 5.8.8

71 files changed, 3829 insertions, 3788 deletions

diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm
index d48f8f26a08..ad04a754bbb 100644
--- a/gnu/usr.bin/perl/lib/Benchmark.pm
+++ b/gnu/usr.bin/perl/lib/Benchmark.pm
@@ -435,7 +435,7 @@ our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
 	      clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 
-$VERSION = 1.06;
+$VERSION = 1.07;
 
 # --- ':hireswallclock' special handling
 
@@ -648,7 +648,7 @@ sub runloop {
     # &runloop a lot, and thus reduce additive errors.
     my $tbase = Benchmark->new(0)->[1];
     while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
-    &$subref;
+    $subref->();
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
     timedebug("runloop:",$td);
diff --git a/gnu/usr.bin/perl/lib/CGI.pm b/gnu/usr.bin/perl/lib/CGI.pm
index c31df7d4b30..d7b56c35646 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.9 2004/08/09 18:09:28 millert Exp $';
-$CGI::VERSION=3.05;
+$CGI::revision = '$Id: CGI.pm,v 1.10 2006/03/28 19:23:04 millert Exp $';
+$CGI::VERSION='3.15';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -77,6 +77,9 @@ sub initialize_globals {
     #    2) CGI::private_tempfiles(1);
     $PRIVATE_TEMPFILES = 0;
 
+    # Set this to 1 to generate automatic tab indexes
+    $TABINDEX = 0;
+
     # Set this to 1 to cause files uploaded in multipart documents
     # to be closed, instead of caching the file handle
     # or:
@@ -177,20 +180,18 @@ $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
 
 # Turn on special checking for Doug MacEachern's modperl
 if (exists $ENV{MOD_PERL}) {
-  eval "require mod_perl";
   # mod_perl handlers may run system() on scripts using CGI.pm;
   # Make sure so we don't get fooled by inherited $ENV{MOD_PERL}
-  if (defined $mod_perl::VERSION) {
-    if ($mod_perl::VERSION >= 1.99) {
-      $MOD_PERL = 2;
-      require Apache::Response;
-      require Apache::RequestRec;
-      require Apache::RequestUtil;
-      require APR::Pool;
-    } else {
-      $MOD_PERL = 1;
-      require Apache;
-    }
+  if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
+    $MOD_PERL = 2;
+    require Apache2::Response;
+    require Apache2::RequestRec;
+    require Apache2::RequestUtil;
+    require Apache2::RequestIO;
+    require APR::Pool;
+  } else {
+    $MOD_PERL = 1;
+    require Apache;
   }
 }
 
@@ -233,7 +234,8 @@ if ($needs_binmode) {
 			  submit reset defaults radio_group popup_menu button autoEscape
 			  scrolling_list image_button start_form end_form startform endform
 			  start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
-		':cgi'=>[qw/param upload path_info path_translated url self_url script_name cookie Dump
+		':cgi'=>[qw/param upload path_info path_translated request_uri url self_url script_name 
+			 cookie Dump
 			 raw_cookie request_method query_string Accept user_agent remote_host content_type
 			 remote_addr referer server_name server_software server_port server_protocol virtual_port
 			 virtual_host remote_ident auth_type http append
@@ -248,6 +250,33 @@ if ($needs_binmode) {
 		':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/]
 		);
 
+# Custom 'can' method for both autoloaded and non-autoloaded subroutines.
+# Author: Cees Hek <cees@sitesuite.com.au>
+
+sub can {
+	my($class, $method) = @_;
+
+	# See if UNIVERSAL::can finds it.
+
+	if (my $func = $class -> SUPER::can($method) ){
+		return $func;
+	}
+
+	# Try to compile the function.
+
+	eval {
+		# _compile looks at $AUTOLOAD for the function name.
+
+		local $AUTOLOAD = join "::", $class, $method;
+		&_compile;
+	};
+
+	# Now that the function is loaded (if it exists)
+	# just use UNIVERSAL::can again to do the work.
+
+	return $class -> SUPER::can($method);
+}
+
 # to import symbols into caller
 sub import {
     my $self = shift;
@@ -303,7 +332,7 @@ sub new {
   if (ref($initializer[0])
       && (UNIVERSAL::isa($initializer[0],'Apache')
 	  ||
-	  UNIVERSAL::isa($initializer[0],'Apache::RequestRec')
+	  UNIVERSAL::isa($initializer[0],'Apache2::RequestRec')
 	 )) {
     $self->r(shift @initializer);
   }
@@ -312,14 +341,16 @@ sub new {
     $self->upload_hook(shift @initializer, shift @initializer);
   }
   if ($MOD_PERL) {
-    $self->r(Apache->request) unless $self->r;
-    my $r = $self->r;
     if ($MOD_PERL == 1) {
+      $self->r(Apache->request) unless $self->r;
+      my $r = $self->r;
       $r->register_cleanup(\&CGI::_reset_globals);
     }
     else {
       # XXX: once we have the new API
       # will do a real PerlOptions -SetupEnv check
+      $self->r(Apache2::RequestUtil->request) unless $self->r;
+      my $r = $self->r;
       $r->subprocess_env unless exists $ENV{REQUEST_METHOD};
       $r->pool->cleanup_register(\&CGI::_reset_globals);
     }
@@ -339,9 +370,11 @@ sub new {
 # user is still holding any reference to them as well.
 sub DESTROY {
   my $self = shift;
-  foreach my $href (values %{$self->{'.tmpfiles'}}) {
-    $href->{hndl}->DESTROY if defined $href->{hndl};
-    $href->{name}->DESTROY if defined $href->{name};
+  if ($OS eq 'WINDOWS') {
+    foreach my $href (values %{$self->{'.tmpfiles'}}) {
+      $href->{hndl}->DESTROY if defined $href->{hndl};
+      $href->{name}->DESTROY if defined $href->{name};
+    }
   }
 }
 
@@ -353,7 +386,13 @@ sub r {
 }
 
 sub upload_hook {
-  my ($self,$hook,$data) = self_or_default(@_);
+  my $self;
+  if (ref $_[0] eq 'CODE') {
+    $CGI::Q = $self = $CGI::DefaultClass->new(@_);
+  } else {
+    $self = shift;
+  }
+  my ($hook,$data) = @_;
   $self->{'.upload_hook'} = $hook;
   $self->{'.upload_data'} = $data;
 }
@@ -471,16 +510,15 @@ sub init {
       if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
 	# quietly read and discard the post
 	  my $buffer;
-	  my $max = $content_length;
-	  while ($max > 0 &&
-		 (my $bytes = $MOD_PERL
-                  ? $self->r->read($buffer,$max < 10000 ? $max : 10000)
-                  : read(STDIN,$buffer,$max < 10000 ? $max : 10000)
-                 )) {
-	    $self->cgi_error("413 Request entity too large");
-	    last METHOD;
-	  }
-	}
+          my $tmplength = $content_length;
+          while($tmplength > 0) {
+                 my $maxbuffer = ($tmplength < 10000)?$tmplength:10000;
+                 my $bytesread = $MOD_PERL ? $self->r->read($buffer,$maxbuffer) : read(STDIN,$buffer,$maxbuffer);
+                 $tmplength -= $bytesread;
+          }
+          $self->cgi_error("413 Request entity too large");
+          last METHOD;
+       }
 
       # Process multipart postings, but only if the initializer is
       # not defined.
@@ -759,6 +797,7 @@ sub _compile {
         my($sub) = \%{"$pack\:\:SUBS"};
         unless (%$sub) {
 	   my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
+	   local ($@,$!);
 	   eval "package $pack; $$auto";
 	   croak("$AUTOLOAD: $@") if $@;
            $$auto = '';  # Free the unneeded storage (but don't undef it!!!)
@@ -777,6 +816,7 @@ sub _compile {
 	   }
        }
        croak("Undefined subroutine $AUTOLOAD\n") unless $code;
+       local ($@,$!);
        eval "package $pack; $code";
        if ($@) {
 	   $@ =~ s/ at .*\n//;
@@ -791,14 +831,14 @@ sub _selected {
   my $self = shift;
   my $value = shift;
   return '' unless $value;
-  return $XHTML ? qq( selected="selected") : qq( selected);
+  return $XHTML ? qq(selected="selected" ) : qq(selected );
 }
 
 sub _checked {
   my $self = shift;
   my $value = shift;
   return '' unless $value;
-  return $XHTML ? qq( checked="checked") : qq( checked);
+  return $XHTML ? qq(checked="checked" ) : qq(checked );
 }
 
 sub _reset_globals { initialize_globals(); }
@@ -821,6 +861,7 @@ sub _setup_symbols {
 	$XHTML=0,                next if /^[:-]no_?xhtml$/;
 	$USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
 	$PRIVATE_TEMPFILES++,    next if /^[:-]private_tempfiles$/;
+	$TABINDEX++,             next if /^[:-]tabindex$/;
 	$CLOSE_UPLOAD_FILES++,   next if /^[:-]close_upload_files$/;
 	$EXPORT{$_}++,           next if /^[:-]any$/;
 	$compile++,              next if /^[:-]compile$/;
@@ -852,6 +893,21 @@ sub charset {
   $self->{'.charset'};
 }
 
+sub element_id {
+  my ($self,$new_value) = self_or_default(@_);
+  $self->{'.elid'} = $new_value if defined $new_value;
+  sprintf('%010d',$self->{'.elid'}++);
+}
+
+sub element_tab {
+  my ($self,$new_value) = self_or_default(@_);
+  $self->{'.etab'} ||= 1;
+  $self->{'.etab'} = $new_value if defined $new_value;
+  my $tab = $self->{'.etab'}++;
+  return '' unless $TABINDEX or defined $new_value;
+  return qq(tabindex="$tab" );
+}
+
 ###############################################################################
 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
 ###############################################################################
@@ -1092,7 +1148,7 @@ END_OF_FUNC
 ####
 'append' => <<'EOF',
 sub append {
-    my($self,@p) = @_;
+    my($self,@p) = self_or_default(@_);
     my($name,$value) = rearrange([NAME,[VALUE,VALUES]],@p);
     my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
     if (@values) {
@@ -1483,8 +1539,12 @@ END_OF_FUNC
 sub start_html {
     my($self,@p) = &self_or_default(@_);
     my($title,$author,$base,$xbase,$script,$noscript,
-        $target,$meta,$head,$style,$dtd,$lang,$encoding,@other) = 
-	rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG,ENCODING],@p);
+        $target,$meta,$head,$style,$dtd,$lang,$encoding,$declare_xml,@other) = 
+	rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,
+                   META,HEAD,STYLE,DTD,LANG,ENCODING,DECLARE_XML],@p);
+
+    $self->element_id(0);
+    $self->element_tab(0);
 
     $encoding = 'iso-8859-1' unless defined $encoding;
 
@@ -1502,7 +1562,7 @@ sub start_html {
 
     $xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
     $xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
-    push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd; 
+    push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd && $declare_xml;
 
     if (ref($dtd) && ref($dtd) eq 'ARRAY') {
         push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t "$dtd->[1]">));
@@ -1526,12 +1586,16 @@ sub start_html {
 	$lang = 'en-US' unless defined $lang;
     }
 
-    push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang" xml:lang="$lang"><head><title>$title</title>)
-                        : ($lang ? qq(<html lang="$lang">) : "<html>") 
+    my $lang_bits = $lang ne '' ? qq( lang="$lang" xml:lang="$lang") : '';
+    my $meta_bits = qq(<meta http-equiv="Content-Type" content="text/html; charset=$encoding" />) 
+                    if $XHTML && $encoding && !$declare_xml;
+
+    push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml"$lang_bits>\n<head>\n<title>$title</title>)
+                        : ($lang ? qq(<html lang="$lang">) : "<html>")
 	                  . "<head><title>$title</title>");
 	if (defined $author) {
     push(@result,$XHTML ? "<link rev=\"made\" href=\"mailto:$author\" />"
-								: "<link rev=\"made\" href=\"mailto:$author\">");
+			: "<link rev=\"made\" href=\"mailto:$author\">");
 	}
 
     if ($base || $xbase || $target) {
@@ -1550,6 +1614,7 @@ sub start_html {
     # handle the infrequently-used -style and -script parameters
     push(@result,$self->_style($style))   if defined $style;
     push(@result,$self->_script($script)) if defined $script;
+    push(@result,$meta_bits)              if defined $meta_bits;
 
     # handle -noscript parameter
     push(@result,<<END) if $noscript;
@@ -1559,7 +1624,7 @@ $noscript
 END
     ;
     my($other) = @other ? " @other" : '';
-    push(@result,"</head><body$other>");
+    push(@result,"</head>\n<body$other>\n");
     return join("\n",@result);
 }
 END_OF_FUNC
@@ -1659,8 +1724,8 @@ sub _script {
      push(@satts,'src'=>$src) if $src;
      push(@satts,'language'=>$language) unless defined $type;
      push(@satts,'type'=>$type);
-     $code = "$cdata_start$code$cdata_end" if defined $code;
-     push(@result,script({@satts},$code || ''));
+     $code = $cdata_start . $code . $cdata_end if defined $code;
+     push(@result,$self->script({@satts},$code || ''));
     }
     @result;
 }
@@ -1672,7 +1737,7 @@ END_OF_FUNC
 ####
 'end_html' => <<'END_OF_FUNC',
 sub end_html {
-    return "</body></html>";
+    return "\n</body>\n</html>";
 }
 END_OF_FUNC
 
@@ -1717,10 +1782,7 @@ sub startform {
        $action = $self->escapeHTML($action);
     }
     else {
-       $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1));
-       if (exists $ENV{QUERY_STRING} && length($ENV{QUERY_STRING})>0) {
-           $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1);
-       }
+       $action = $self->escapeHTML($self->request_uri);
     }
     $action = qq(action="$action");
     my($other) = @other ? " @other" : '';
@@ -1734,7 +1796,7 @@ END_OF_FUNC
 # synonym for startform
 'start_form' => <<'END_OF_FUNC',
 sub start_form {
-    &startform;
+    $XHTML ? &start_multipart_form : &startform;
 }
 END_OF_FUNC
 
@@ -1749,7 +1811,7 @@ END_OF_FUNC
 'start_multipart_form' => <<'END_OF_FUNC',
 sub start_multipart_form {
     my($self,@p) = self_or_default(@_);
-    if (defined($param[0]) && substr($param[0],0,1) eq '-') {
+    if (defined($p[0]) && substr($p[0],0,1) eq '-') {
 	my(%p) = @p;
 	$p{'-enctype'}=&MULTIPART;
 	return $self->startform(%p);
@@ -1766,12 +1828,16 @@ END_OF_FUNC
 # End a form
 'endform' => <<'END_OF_FUNC',
 sub endform {
-    my($self,@p) = self_or_default(@_);    
+    my($self,@p) = self_or_default(@_);
     if ( $NOSTICKY ) {
     return wantarray ? ("</form>") : "\n</form>";
     } else {
-    return wantarray ? ("<div>",$self->get_fields,"</div>","</form>") : 
-                        "<div>".$self->get_fields ."</div>\n</form>";
+      if (my @fields = $self->get_fields) {
+         return wantarray ? ("<div>",@fields,"</div>","</form>")
+                          : "<div>".(join '',@fields)."</div>\n</form>";
+      } else {
+         return "</form>";
+      }
     }
 }
 END_OF_FUNC
@@ -1780,8 +1846,8 @@ END_OF_FUNC
 '_textfield' => <<'END_OF_FUNC',
 sub _textfield {
     my($self,$tag,@p) = self_or_default(@_);
-    my($name,$default,$size,$maxlength,$override,@other) = 
-	rearrange([NAME,[DEFAULT,VALUE,VALUES],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+    my($name,$default,$size,$maxlength,$override,$tabindex,@other) = 
+	rearrange([NAME,[DEFAULT,VALUE,VALUES],SIZE,MAXLENGTH,[OVERRIDE,FORCE],TABINDEX],@p);
 
     my $current = $override ? $default : 
 	(defined($self->param($name)) ? $self->param($name) : $default);
@@ -1794,7 +1860,8 @@ sub _textfield {
     # this entered at cristy's request to fix problems with file upload fields
     # and WebTV -- not sure it won't break stuff
     my($value) = $current ne '' ? qq(value="$current") : '';
-    return $XHTML ? qq(<input type="$tag" name="$name" $value$s$m$other />) 
+    $tabindex = $self->element_tab($tabindex);
+    return $XHTML ? qq(<input type="$tag" name="$name" $tabindex$value$s$m$other />) 
                   : qq(<input type="$tag" name="$name" $value$s$m$other>);
 }
 END_OF_FUNC
@@ -1864,9 +1931,8 @@ END_OF_FUNC
 'textarea' => <<'END_OF_FUNC',
 sub textarea {
     my($self,@p) = self_or_default(@_);
-    
-    my($name,$default,$rows,$cols,$override,@other) =
-	rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
+    my($name,$default,$rows,$cols,$override,$tabindex,@other) =
+	rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE],TABINDEX],@p);
 
     my($current)= $override ? $default :
 	(defined($self->param($name)) ? $self->param($name) : $default);
@@ -1876,7 +1942,8 @@ sub textarea {
     my($r) = $rows ? qq/ rows="$rows"/ : '';
     my($c) = $cols ? qq/ cols="$cols"/ : '';
     my($other) = @other ? " @other" : '';
-    return qq{<textarea name="$name"$r$c$other>$current</textarea>};
+    $tabindex = $self->element_tab($tabindex);
+    return qq{<textarea name="$name" $tabindex$r$c$other>$current</textarea>};
 }
 END_OF_FUNC
 
@@ -1895,8 +1962,8 @@ END_OF_FUNC
 sub button {
     my($self,@p) = self_or_default(@_);
 
-    my($label,$value,$script,@other) = rearrange([NAME,[VALUE,LABEL],
-							 [ONCLICK,SCRIPT]],@p);
+    my($label,$value,$script,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],
+						            [ONCLICK,SCRIPT],TABINDEX],@p);
 
     $label=$self->escapeHTML($label);
     $value=$self->escapeHTML($value,1);
@@ -1909,7 +1976,8 @@ sub button {
     $val = qq/ value="$value"/ if $value;
     $script = qq/ onclick="$script"/ if $script;
     my($other) = @other ? " @other" : '';
-    return $XHTML ? qq(<input type="button"$name$val$script$other />)
+    $tabindex = $self->element_tab($tabindex);
+    return $XHTML ? qq(<input type="button" $tabindex$name$val$script$other />)
                   : qq(<input type="button"$name$val$script$other>);
 }
 END_OF_FUNC
@@ -1928,19 +1996,20 @@ END_OF_FUNC
 sub submit {
     my($self,@p) = self_or_default(@_);
 
-    my($label,$value,@other) = rearrange([NAME,[VALUE,LABEL]],@p);
+    my($label,$value,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],TABINDEX],@p);
 
     $label=$self->escapeHTML($label);
     $value=$self->escapeHTML($value,1);
 
-    my $name = $NOSTICKY ? '' : ' name=".submit"';
-    $name = qq/ name="$label"/ if defined($label);
+    my $name = $NOSTICKY ? '' : 'name=".submit" ';
+    $name = qq/name="$label" / if defined($label);
     $value = defined($value) ? $value : $label;
     my $val = '';
-    $val = qq/ value="$value"/ if defined($value);
-    my($other) = @other ? " @other" : '';
-    return $XHTML ? qq(<input type="submit"$name$val$other />)
-                  : qq(<input type="submit"$name$val$other>);
+    $val = qq/value="$value" / if defined($value);
+    $tabindex = $self->element_tab($tabindex);
+    my($other) = @other ? "@other " : '';
+    return $XHTML ? qq(<input type="submit" $tabindex$name$val$other/>)
+                  : qq(<input type="submit" $name$val$other>);
 }
 END_OF_FUNC
 
@@ -1955,7 +2024,7 @@ END_OF_FUNC
 'reset' => <<'END_OF_FUNC',
 sub reset {
     my($self,@p) = self_or_default(@_);
-    my($label,$value,@other) = rearrange(['NAME',['VALUE','LABEL']],@p);
+    my($label,$value,$tabindex,@other) = rearrange(['NAME',['VALUE','LABEL'],TABINDEX],@p);
     $label=$self->escapeHTML($label);
     $value=$self->escapeHTML($value,1);
     my ($name) = ' name=".reset"';
@@ -1964,7 +2033,8 @@ sub reset {
     my($val) = '';
     $val = qq/ value="$value"/ if defined($value);
     my($other) = @other ? " @other" : '';
-    return $XHTML ? qq(<input type="reset"$name$val$other />)
+    $tabindex = $self->element_tab($tabindex);
+    return $XHTML ? qq(<input type="reset" $tabindex$name$val$other />)
                   : qq(<input type="reset"$name$val$other>);
 }
 END_OF_FUNC
@@ -1985,13 +2055,14 @@ END_OF_FUNC
 sub defaults {
     my($self,@p) = self_or_default(@_);
 
-    my($label,@other) = rearrange([[NAME,VALUE]],@p);
+    my($label,$tabindex,@other) = rearrange([[NAME,VALUE],TABINDEX],@p);
 
     $label=$self->escapeHTML($label,1);
     $label = $label || "Defaults";
     my($value) = qq/ value="$label"/;
     my($other) = @other ? " @other" : '';
-    return $XHTML ? qq(<input type="submit" name=".defaults"$value$other />)
+    $tabindex = $self->element_tab($tabindex);
+    return $XHTML ? qq(<input type="submit" name=".defaults" $tabindex$value$other />)
                   : qq/<input type="submit" NAME=".defaults"$value$other>/;
 }
 END_OF_FUNC
@@ -2023,9 +2094,9 @@ END_OF_FUNC
 sub checkbox {
     my($self,@p) = self_or_default(@_);
 
-    my($name,$checked,$value,$label,$override,@other) = 
-	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
-    
+    my($name,$checked,$value,$label,$override,$tabindex,@other) = 
+	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX],@p);
+
     $value = defined $value ? $value : 'on';
 
     if (!$override && ($self->{'.fieldnames'}->{$name} || 
@@ -2038,85 +2109,15 @@ sub checkbox {
     $name = $self->escapeHTML($name);
     $value = $self->escapeHTML($value,1);
     $the_label = $self->escapeHTML($the_label);
-    my($other) = @other ? " @other" : '';
+    my($other) = @other ? "@other " : '';
+    $tabindex = $self->element_tab($tabindex);
     $self->register_parameter($name);
-    return $XHTML ? qq{<input type="checkbox" name="$name" value="$value"$checked$other />$the_label}
+    return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
                   : qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
 }
 END_OF_FUNC
 
 
-#### Method: checkbox_group
-# Create a list of logically-linked checkboxes.
-# Parameters:
-#   $name -> Common name for all the check boxes
-#   $values -> A pointer to a regular array containing the
-#             values for each checkbox in the group.
-#   $defaults -> (optional)
-#             1. If a pointer to a regular array of checkbox values,
-#             then this will be used to decide which
-#             checkboxes to turn on by default.
-#             2. If a scalar, will be assumed to hold the
-#             value of a single checkbox in the group to turn on. 
-#   $linebreak -> (optional) Set to true to place linebreaks
-#             between the buttons.
-#   $labels -> (optional)
-#             A pointer to an associative array of labels to print next to each checkbox
-#             in the form $label{'value'}="Long explanatory label".
-#             Otherwise the provided values are used as the labels.
-# Returns:
-#   An ARRAY containing a series of <input type="checkbox"> fields
-####
-'checkbox_group' => <<'END_OF_FUNC',
-sub checkbox_group {
-    my($self,@p) = self_or_default(@_);
-
-    my($name,$values,$defaults,$linebreak,$labels,$attributes,$rows,$columns,
-       $rowheaders,$colheaders,$override,$nolabels,@other) =
-	rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
-            LINEBREAK,LABELS,ATTRIBUTES,ROWS,[COLUMNS,COLS],
-			  ROWHEADERS,COLHEADERS,
-			  [OVERRIDE,FORCE],NOLABELS],@p);
-
-    my($checked,$break,$result,$label);
-
-    my(%checked) = $self->previous_or_default($name,$defaults,$override);
-
-	if ($linebreak) {
-    $break = $XHTML ? "<br />" : "<br>";
-	}
-	else {
-	$break = '';
-	}
-    $name=$self->escapeHTML($name);
-
-    # Create the elements
-    my(@elements,@values);
-
-    @values = $self->_set_values_and_labels($values,\$labels,$name);
-
-    my($other) = @other ? " @other" : '';
-    foreach (@values) {
-	$checked = $self->_checked($checked{$_});
-	$label = '';
-	unless (defined($nolabels) && $nolabels) {
-	    $label = $_;
-	    $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-	    $label = $self->escapeHTML($label);
-	}
-        my $attribs = $self->_set_attributes($_, $attributes);
-	$_ = $self->escapeHTML($_,1);
-        push(@elements,$XHTML ? qq(<input type="checkbox" name="$name" value="$_"$checked$other$attribs />${label}${break})
-                              : qq/<input type="checkbox" name="$name" value="$_"$checked$other$attribs>${label}${break}/);
-    }
-    $self->register_parameter($name);
-    return wantarray ? @elements : join(' ',@elements)
-        unless defined($columns) || defined($rows);
-    $rows = 1 if $rows && $rows < 1;
-    $cols = 1 if $cols && $cols < 1;
-    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
-}
-END_OF_FUNC
 
 # Escape HTML -- used internally
 'escapeHTML' => <<'END_OF_FUNC',
@@ -2181,8 +2182,8 @@ END_OF_FUNC
 '_tableize' => <<'END_OF_FUNC',
 sub _tableize {
     my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
-    $rowheaders = [] unless defined $rowheaders;
-    $colheaders = [] unless defined $colheaders;
+    my @rowheaders = $rowheaders ? @$rowheaders : ();
+    my @colheaders = $colheaders ? @$colheaders : ();
     my($result);
 
     if (defined($columns)) {
@@ -2191,18 +2192,18 @@ sub _tableize {
     if (defined($rows)) {
 	$columns = int(0.99 + @elements/$rows) unless defined($columns);
     }
-    
+
     # rearrange into a pretty table
     $result = "<table>";
     my($row,$column);
-    unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
-    $result .= "<tr>" if @{$colheaders};
-    foreach (@{$colheaders}) {
+    unshift(@colheaders,'') if @colheaders && @rowheaders;
+    $result .= "<tr>" if @colheaders;
+    foreach (@colheaders) {
 	$result .= "<th>$_</th>";
     }
     for ($row=0;$row<$rows;$row++) {
 	$result .= "<tr>";
-	$result .= "<th>$rowheaders->[$row]</th>" if @$rowheaders;
+	$result .= "<th>$rowheaders[$row]</th>" if @rowheaders;
 	for ($column=0;$column<$columns;$column++) {
 	    $result .= "<td>" . $elements[$column*$rows + $row] . "</td>"
 		if defined($elements[$column*$rows + $row]);
@@ -2235,30 +2236,80 @@ END_OF_FUNC
 'radio_group' => <<'END_OF_FUNC',
 sub radio_group {
     my($self,@p) = self_or_default(@_);
+   $self->_box_group('radio',@p);
+}
+END_OF_FUNC
+
+#### Method: checkbox_group
+# Create a list of logically-linked checkboxes.
+# Parameters:
+#   $name -> Common name for all the check boxes
+#   $values -> A pointer to a regular array containing the
+#             values for each checkbox in the group.
+#   $defaults -> (optional)
+#             1. If a pointer to a regular array of checkbox values,
+#             then this will be used to decide which
+#             checkboxes to turn on by default.
+#             2. If a scalar, will be assumed to hold the
+#             value of a single checkbox in the group to turn on. 
+#   $linebreak -> (optional) Set to true to place linebreaks
+#             between the buttons.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   An ARRAY containing a series of <input type="checkbox"> fields
+####
+
+'checkbox_group' => <<'END_OF_FUNC',
+sub checkbox_group {
+    my($self,@p) = self_or_default(@_);
+   $self->_box_group('checkbox',@p);
+}
+END_OF_FUNC
+
+'_box_group' => <<'END_OF_FUNC',
+sub _box_group {
+    my $self     = shift;
+    my $box_type = shift;
 
-    my($name,$values,$default,$linebreak,$labels,$attributes,
-       $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
-  rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,ATTRIBUTES,
-			  ROWS,[COLUMNS,COLS],
-			  ROWHEADERS,COLHEADERS,
-			  [OVERRIDE,FORCE],NOLABELS],@p);
+    my($name,$values,$defaults,$linebreak,$labels,$attributes,
+       $rows,$columns,$rowheaders,$colheaders,
+       $override,$nolabels,$tabindex,@other) =
+       rearrange([      NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES,
+		        ROWS,[COLUMNS,COLS],ROWHEADERS,COLHEADERS,
+			[OVERRIDE,FORCE],NOLABELS,TABINDEX
+                 ],@_);
     my($result,$checked);
 
-    if (!$override && defined($self->param($name))) {
-	$checked = $self->param($name);
-    } else {
-	$checked = $default;
-    }
+
     my(@elements,@values);
     @values = $self->_set_values_and_labels($values,\$labels,$name);
+    my %checked = $self->previous_or_default($name,$defaults,$override);
 
     # If no check array is specified, check the first by default
-    $checked = $values[0] unless defined($checked) && $checked ne '';
+    $checked{$values[0]}++ if $box_type eq 'radio' && !%checked;
+
     $name=$self->escapeHTML($name);
 
-    my($other) = @other ? " @other" : '';
+    my %tabs = ();
+    if ($TABINDEX && $tabindex) {
+      if (!ref $tabindex) {
+          $self->element_tab($tabindex);
+      } elsif (ref $tabindex eq 'ARRAY') {
+          %tabs = map {$_=>$self->element_tab} @$tabindex;
+      } elsif (ref $tabindex eq 'HASH') {
+          %tabs = %$tabindex;
+      }
+    }
+    %tabs = map {$_=>$self->element_tab} @values unless %tabs;
+
+    my $other = @other ? "@other " : '';
+    my $radio_checked;
     foreach (@values) {
-	my($checkit) = $checked eq $_ ? qq/ checked="checked"/ : '';
+        my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++)
+                                                           : $checked{$_});
 	my($break);
 	if ($linebreak) {
           $break = $XHTML ? "<br />" : "<br>";
@@ -2272,13 +2323,19 @@ sub radio_group {
 	    $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
 	    $label = $self->escapeHTML($label,1);
 	}
-  my $attribs = $self->_set_attributes($_, $attributes);
+        my $attribs = $self->_set_attributes($_, $attributes);
+        my $tab     = $tabs{$_};
 	$_=$self->escapeHTML($_);
-  push(@elements,$XHTML ? qq(<input type="radio" name="$name" value="$_"$checkit$other$attribs />${label}${break})
-                              : qq/<input type="radio" name="$name" value="$_"$checkit$other$attribs>${label}${break}/);
+        if ($XHTML) {
+           push @elements,
+              CGI::label(
+                   qq(<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs/>$label)).${break};
+        } else {
+           push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs>${label}${break}/);
+        }
     }
     $self->register_parameter($name);
-    return wantarray ? @elements : join(' ',@elements) 
+    return wantarray ? @elements : "@elements"
            unless defined($columns) || defined($rows);
     return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
 }
@@ -2303,9 +2360,9 @@ END_OF_FUNC
 sub popup_menu {
     my($self,@p) = self_or_default(@_);
 
-    my($name,$values,$default,$labels,$attributes,$override,@other) =
+    my($name,$values,$default,$labels,$attributes,$override,$tabindex,@other) =
        rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,
-       ATTRIBUTES,[OVERRIDE,FORCE]],@p);
+       ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p);
     my($result,$selected);
 
     if (!$override && defined($self->param($name))) {
@@ -2318,8 +2375,8 @@ sub popup_menu {
 
     my(@values);
     @values = $self->_set_values_and_labels($values,\$labels,$name);
-
-    $result = qq/<select name="$name"$other>\n/;
+    $tabindex = $self->element_tab($tabindex);
+    $result = qq/<select name="$name" $tabindex$other>\n/;
     foreach (@values) {
         if (/<optgroup/) {
             foreach (split(/\n/)) {
@@ -2335,7 +2392,7 @@ sub popup_menu {
 	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
 	my($value) = $self->escapeHTML($_);
 	$label=$self->escapeHTML($label,1);
-            $result .= "<option$selectit$attribs value=\"$value\">$label</option>\n";
+            $result .= "<option $selectit${attribs}value=\"$value\">$label</option>\n";
         }
     }
 
@@ -2428,9 +2485,9 @@ END_OF_FUNC
 'scrolling_list' => <<'END_OF_FUNC',
 sub scrolling_list {
     my($self,@p) = self_or_default(@_);
-    my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,@other)
+    my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,$tabindex,@other)
 	= rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
-          SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE]],@p);
+          SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p);
 
     my($result,@values);
     @values = $self->_set_values_and_labels($values,\$labels,$name);
@@ -2443,7 +2500,8 @@ sub scrolling_list {
     my($other) = @other ? " @other" : '';
 
     $name=$self->escapeHTML($name);
-    $result = qq/<select name="$name"$has_size$is_multiple$other>\n/;
+    $tabindex = $self->element_tab($tabindex);
+    $result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
     foreach (@values) {
 	my($selectit) = $self->_selected($selected{$_});
 	my($label) = $_;
@@ -2451,7 +2509,7 @@ sub scrolling_list {
 	$label=$self->escapeHTML($label);
 	my($value)=$self->escapeHTML($_,1);
         my $attribs = $self->_set_attributes($_, $attributes);
-        $result .= "<option$selectit$attribs value=\"$value\">$label</option>\n";
+        $result .= "<option ${selectit}${attribs}value=\"$value\">$label</option>\n";
     }
     $result .= "</select>";
     $self->register_parameter($name);
@@ -2558,25 +2616,23 @@ END_OF_FUNC
 'url' => <<'END_OF_FUNC',
 sub url {
     my($self,@p) = self_or_default(@_);
-    my ($relative,$absolute,$full,$path_info,$query,$base) = 
-	rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p);
-    my $url;
+    my ($relative,$absolute,$full,$path_info,$query,$base,$rewrite) = 
+	rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE','REWRITE'],@p);
+    my $url  = '';
     $full++      if $base || !($relative || $absolute);
+    $rewrite++   unless defined $rewrite;
 
-    my $path = $self->path_info;
-    my $script_name = $self->script_name;
-
-    # for compatibility with Apache's MultiViews
-    if (exists($ENV{REQUEST_URI})) {
-        my $index;
-	$script_name = unescape($ENV{REQUEST_URI});
-        $script_name =~ s/\?.+$//s;   # strip query string
-        # and path
-        if (exists($ENV{PATH_INFO})) {
-           my $encoded_path = unescape($ENV{PATH_INFO});
-           $script_name      =~ s/\Q$encoded_path\E$//i;
-         }
-    }
+    my $path        =  $self->path_info;
+    my $script_name =  $self->script_name;
+    my $request_uri = $self->request_uri || '';
+    my $query_str   =  $self->query_string;
+
+    my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
+    undef $path if $rewrite_in_use && $rewrite;  # path not valid when rewriting active
+
+    my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
+    $uri            =~ s/\?.*$//;                                 # remove query string
+    $uri            =~ s/$path$//      if defined $path;          # remove path
 
     if ($full) {
 	my $protocol = $self->protocol();
@@ -2592,16 +2648,15 @@ sub url {
 		    || (lc($protocol) eq 'https' && $port == 443);
 	}
         return $url if $base;
-	$url .= $script_name;
+	$url .= $uri;
     } elsif ($relative) {
 	($url) = $script_name =~ m!([^/]+)$!;
     } elsif ($absolute) {
-	$url = $script_name;
+	$url = $uri;
     }
 
-    $url .= $path if $path_info and defined $path;
-    $url .= "?" . $self->query_string if $query and $self->query_string;
-    $url = '' unless defined $url;
+    $url .= $path         if $path_info and defined $path;
+    $url .= "?$query_str" if $query     and $query_str ne '';
     $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
     return $url;
 }
@@ -2695,9 +2750,8 @@ sub path_info {
 	$info = "/$info" if $info ne '' &&  substr($info,0,1) ne '/';
 	$self->{'.path_info'} = $info;
     } elsif (! defined($self->{'.path_info'}) ) {
-	$self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ? 
-	    $ENV{'PATH_INFO'} : '';
-
+        my (undef,$path_info) = $self->_name_and_path_from_env;
+	$self->{'.path_info'} = $path_info || '';
 	# hack to fix broken path info in IIS
 	$self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
 
@@ -2706,6 +2760,37 @@ sub path_info {
 }
 END_OF_FUNC
 
+# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH 2.0.54
+'_name_and_path_from_env' => <<'END_OF_FUNC',
+sub _name_and_path_from_env {
+   my $self = shift;
+   my $raw_script_name = $ENV{SCRIPT_NAME} || '';
+   my $raw_path_info   = $ENV{PATH_INFO}   || '';
+   my $uri             = $ENV{REQUEST_URI} || '';
+
+   if ($raw_script_name =~ m/$raw_path_info$/) {
+     $raw_script_name =~ s/$raw_path_info$//;
+   }
+
+   my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
+   my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
+
+   my $apache_bug      = @uri_double_slashes != @path_double_slashes;
+   return ($raw_script_name,$raw_path_info) unless $apache_bug;
+
+   my $path_info_search = $raw_path_info;
+   # these characters will not (necessarily) be escaped
+   $path_info_search    =~ s/([^a-zA-Z0-9$()':_.,+*\/;?=&-])/uc sprintf("%%%02x",ord($1))/eg;
+   $path_info_search    = quotemeta($path_info_search);
+   $path_info_search    =~ s!/!/+!g;
+   if ($uri =~ m/^(.+)($path_info_search)/) {
+       return ($1,$2);
+   } else {
+       return ($raw_script_name,$raw_path_info);
+   }
+}
+END_OF_FUNC
+
 
 #### Method: request_method
 # Returns 'POST', 'GET', 'PUT' or 'HEAD'
@@ -2736,6 +2821,16 @@ sub path_translated {
 END_OF_FUNC
 
 
+#### Method: request_uri
+# Return the literal request URI
+####
+'request_uri' => <<'END_OF_FUNC',
+sub request_uri {
+    return $ENV{'REQUEST_URI'};
+}
+END_OF_FUNC
+
+
 #### Method: query_string
 # Synthesize a query string from our current
 # parameters
@@ -2891,10 +2986,14 @@ END_OF_FUNC
 ####
 'script_name' => <<'END_OF_FUNC',
 sub script_name {
-    return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
-    # These are for debugging
-    return "/$0" unless $0=~/^\//;
-    return $0;
+    my ($self,@p) = self_or_default(@_);
+    if (@p) {
+        $self->{'.script_name'} = shift;
+    } elsif (!exists $self->{'.script_name'}) {
+        my ($script_name,$path_info) = $self->_name_and_path_from_env();
+        $self->{'.script_name'} = $script_name;
+    }
+    return $self->{'.script_name'};
 }
 END_OF_FUNC
 
@@ -2936,8 +3035,9 @@ END_OF_FUNC
 sub virtual_port {
     my($self) = self_or_default(@_);
     my $vh = $self->http('x_forwarded_host') || $self->http('host');
+    my $protocol = $self->protocol;
     if ($vh) {
-        return ($vh =~ /:(\d+)$/)[0] || '80';
+        return ($vh =~ /:(\d+)$/)[0] || ($protocol eq 'https' ? 443 : 80);
     } else {
         return $self->server_port();
     }
@@ -3248,7 +3348,7 @@ sub read_multipart {
           }
 
 	  # choose a relatively unpredictable tmpfile sequence number
-          my $seqno = unpack("%16C*",join('',localtime,values %ENV));
+          my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV));
           for (my $cnt=10;$cnt>0;$cnt--) {
 	    next unless $tmpfile = new CGITempFile($seqno);
 	    $tmp = $tmpfile->as_string;
@@ -3293,7 +3393,11 @@ sub read_multipart {
 
 	  # Save some information about the uploaded file where we can get
 	  # at it later.
-	  $self->{'.tmpfiles'}->{fileno($filehandle)}= {
+	  # Use the typeglob as the key, as this is guaranteed to be
+	  # unique for each filehandle.  Don't use the file descriptor as
+	  # this will be re-used for each filehandle if the
+	  # close_upload_files feature is used.
+	  $self->{'.tmpfiles'}->{$$filehandle}= {
               hndl => $filehandle,
 	      name => $tmpfile,
 	      info => {%header},
@@ -3316,8 +3420,8 @@ END_OF_FUNC
 'tmpFileName' => <<'END_OF_FUNC',
 sub tmpFileName {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ?
-	$self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string
+    return $self->{'.tmpfiles'}->{$$filename}->{name} ?
+	$self->{'.tmpfiles'}->{$$filename}->{name}->as_string
 	    : '';
 }
 END_OF_FUNC
@@ -3325,7 +3429,7 @@ END_OF_FUNC
 'uploadInfo' => <<'END_OF_FUNC',
 sub uploadInfo {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{fileno($filename)}->{info};
+    return $self->{'.tmpfiles'}->{$$filename}->{info};
 }
 END_OF_FUNC
 
@@ -3386,6 +3490,11 @@ $FH='fh00000';
 
 *Fh::AUTOLOAD = \&CGI::AUTOLOAD;
 
+sub DESTROY {
+    my $self = shift;
+    close $self;
+}
+
 $AUTOLOADED_ROUTINES = '';      # prevent -w error
 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
 %SUBS =  (
@@ -3432,13 +3541,6 @@ sub new {
 }
 END_OF_FUNC
 
-'DESTROY'  => <<'END_OF_FUNC',
-sub DESTROY {
-    my $self = shift;
-    close $self;
-}
-END_OF_FUNC
-
 );
 END_OF_AUTOLOAD
 
@@ -3472,7 +3574,7 @@ sub new {
     my($package,$interface,$boundary,$length) = @_;
     $FILLUNIT = $INITIAL_FILLUNIT;
     $CGI::DefaultClass->binmode($IN); # if $CGI::needs_binmode;  # just do it always
-    
+
     # If the user types garbage into the file upload field,
     # then Netscape passes NOTHING to the server (not good).
     # We may hang on this read in that case. So we implement
@@ -3502,6 +3604,7 @@ sub new {
     }
 
     my $self = {LENGTH=>$length,
+		CHUNKED=>!defined $length,
 		BOUNDARY=>$boundary,
 		INTERFACE=>$interface,
 		BUFFER=>'',
@@ -3612,9 +3715,9 @@ sub read {
     my $start = index($self->{BUFFER},$boundary_start);
 
     warn "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n" if DEBUG;
-    # protect against malformed multipart POST operations
-    die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
 
+    # protect against malformed multipart POST operations
+    die "Malformed multipart POST\n" unless $self->{CHUNKED} || ($start >= 0 || $self->{LENGTH} > 0);
 
     #EBCDIC NOTE: want to translate boundary search into ASCII here.
 
@@ -3660,12 +3763,12 @@ END_OF_FUNC
 'fillBuffer' => <<'END_OF_FUNC',
 sub fillBuffer {
     my($self,$bytes) = @_;
-    return unless $self->{LENGTH};
+    return unless $self->{CHUNKED} || $self->{LENGTH};
 
     my($boundaryLength) = length($self->{BOUNDARY});
     my($bufferLength) = length($self->{BUFFER});
     my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
-    $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
+    $bytesToRead = $self->{LENGTH} if !$self->{CHUNKED} && $self->{LENGTH} < $bytesToRead;
 
     # Try to read some data.  We may hang here if the browser is screwed up.
     my $bytesRead = $self->{INTERFACE}->read_from_client(\$self->{BUFFER},
@@ -3679,14 +3782,14 @@ sub fillBuffer {
     # remote user aborts during a file transfer.  I don't know how
     # they manage this, but the workaround is to abort if we get
     # more than SPIN_LOOP_MAX consecutive zero reads.
-    if ($bytesRead == 0) {
+    if ($bytesRead <= 0) {
 	die  "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
 	    if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
     } else {
 	$self->{ZERO_LOOP_COUNTER}=0;
     }
 
-    $self->{LENGTH} -= $bytesRead;
+    $self->{LENGTH} -= $bytesRead if !$self->{CHUNKED} && $bytesRead;
 }
 END_OF_FUNC
 
@@ -3710,11 +3813,10 @@ END_OF_AUTOLOAD
 package CGITempFile;
 
 sub find_tempdir {
-  undef $TMPDIRECTORY;
   $SL = $CGI::SL;
   $MAC = $CGI::OS eq 'MACINTOSH';
   my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
-  unless ($TMPDIRECTORY) {
+  unless (defined $TMPDIRECTORY) {
     @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
 	   "C:${SL}temp","${SL}tmp","${SL}temp",
 	   "${vol}${SL}Temporary Items",
@@ -3834,9 +3936,12 @@ CGI - Simple Common Gateway Interface Class
         hr;
 
    if (param()) {
-       print "Your name is",em(param('name')),p,
-	     "The keywords are: ",em(join(", ",param('words'))),p,
-	     "Your favorite color is ",em(param('color')),
+       my $name      = param('name');
+       my $keywords  = join ', ',param('words');
+       my $color     = param('color');
+       print "Your name is",em(escapeHTML($name)),p,
+	     "The keywords are: ",em(escapeHTML($keywords)),p,
+	     "Your favorite color is ",em(escapeHTML($color)),
 	     hr;
    }
 
@@ -4195,6 +4300,21 @@ that all the defaults are taken when you create a fill-out form.
 
 Use Delete_all() instead if you are using the function call interface.
 
+=head2 HANDLING NON-URLENCODED ARGUMENTS
+
+
+If POSTed data is not of type application/x-www-form-urlencoded or
+multipart/form-data, then the POSTed data will not be processed, but
+instead be returned as-is in a parameter named POSTDATA.  To retrieve
+it, use code like this:
+
+   my $data = $query->param('POSTDATA');
+
+(If you don't know what the preceding means, don't worry about it.  It
+only affects people trying to use CGI for XML processing and other
+specialized tasks.)
+
+
 =head2 DIRECT ACCESS TO THE PARAMETER LIST:
 
    $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
@@ -4240,7 +4360,7 @@ function calls (also see the section on CGI-LIB compatibility).
 
 =head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
 
-    $query->save(FILEHANDLE)
+    $query->save(\*FILEHANDLE)
 
 This will write the current state of the form to the provided
 filehandle.  You can read it back in by providing a filehandle
@@ -4270,14 +4390,14 @@ a short example of creating multiple session records:
    foreach (0..$records) {
        my $q = new CGI;
        $q->param(-name=>'counter',-value=>$_);
-       $q->save(OUT);
+       $q->save(\*OUT);
    }
    close OUT;
 
    # reopen for reading
    open (IN,"test.out") || die;
    while (!eof(IN)) {
-       my $q = new CGI(IN);
+       my $q = new CGI(\*IN);
        print $q->param('counter'),"\n";
    }
 
@@ -4493,11 +4613,22 @@ then import the functions individually in each mod_perl script.
 
 =item -nosticky
 
-This makes CGI.pm not generating the hidden fields .submit
-and .cgifields. It is very useful if you don't want to
-have the hidden fields appear in the querystring in a GET method.
-For example, a search script generated this way will have
-a very nice url with search parameters for bookmarking.
+By default the CGI module implements a state-preserving behavior
+called "sticky" fields.  The way this works is that if you are
+regenerating a form, the methods that generate the form field values
+will interrogate param() to see if similarly-named parameters are
+present in the query string. If they find a like-named parameter, they
+will use it to set their default values.
+
+Sometimes this isn't what you want.  The B<-nosticky> pragma prevents
+this behavior.  You can also selectively change the sticky behavior in
+each element that you generate.
+
+=item -tabindex
+
+Automatically add tab index attributes to each form field. With this
+option turned off, you can still add tab indexes manually by passing a
+-tabindex option to each field-generating method.
 
 =item -no_undef_params
 
@@ -4668,19 +4799,19 @@ date, and whether to cache the document.  The header can also be
 manipulated for special purposes, such as server push and pay per view
 pages.
 
-	print $query->header;
+	print header;
 
 	     -or-
 
-	print $query->header('image/gif');
+	print header('image/gif');
 
 	     -or-
 
-	print $query->header('text/html','204 No response');
+	print header('text/html','204 No response');
 
 	     -or-
 
-	print $query->header(-type=>'image/gif',
+	print header(-type=>'image/gif',
 			     -nph=>1,
 			     -status=>'402 Payment required',
 			     -expires=>'+3d',
@@ -4702,7 +4833,7 @@ parameters will be stripped of their initial hyphens and turned into
 header fields, allowing you to specify any HTTP header you desire.
 Internal underscores will be turned into hyphens:
 
-    print $query->header(-Content_length=>3002);
+    print header(-Content_length=>3002);
 
 Most browsers will not cache the output from CGI scripts.  Every time
 the browser reloads the page, the script is invoked anew.  You can
@@ -4754,7 +4885,7 @@ In either case, the outgoing header will be formatted as:
 
 =head2 GENERATING A REDIRECTION HEADER
 
-   print $query->redirect('http://somewhere.else/in/movie/land');
+   print redirect('http://somewhere.else/in/movie/land');
 
 Sometimes you don't want to produce a document yourself, but simply
 redirect the browser elsewhere, perhaps choosing a URL based on the
@@ -4769,7 +4900,7 @@ redirection requests.  Relative URLs will not work correctly.
 
 You can also use named arguments:
 
-    print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
+    print redirect(-uri=>'http://somewhere.else/in/movie/land',
 			   -nph=>1,
                            -status=>301);
 
@@ -4792,7 +4923,7 @@ advised that changing the status to anything other than 301, 302 or
 
 =head2 CREATING THE HTML DOCUMENT HEADER
 
-   print $query->start_html(-title=>'Secrets of the Pyramids',
+   print start_html(-title=>'Secrets of the Pyramids',
 			    -author=>'fred@capricorn.org',
 			    -base=>'true',
 			    -target=>'_blank',
@@ -4858,6 +4989,13 @@ off in other cases by passing an empty string (-lang=>'').
 The B<-encoding> argument can be used to specify the character set for
 XHTML.  It defaults to iso-8859-1 if not specified.
 
+The B<-declare_xml> argument, when used in conjunction with XHTML,
+will put a <?xml> declaration at the top of the HTML header. The sole
+purpose of this declaration is to declare the character set
+encoding. In the absence of -declare_xml, the output HTML will contain
+a <meta> tag that specifies the encoding, allowing the HTML to pass
+most validators.  The default for -declare_xml is false.
+
 You can place other arbitrary HTML elements to the <head> section with the
 B<-head> tag.  For example, to place the rarely-used <link> element in the
 head section, use this:
@@ -4901,7 +5039,7 @@ browser.  Usually these parameters are calls to functions defined in the
 B<-script> field:
 
       $query = new CGI;
-      print $query->header;
+      print header;
       $JSCRIPT=<<END;
       // Ask a silly question
       function riddle_me_this() {
@@ -4918,7 +5056,7 @@ B<-script> field:
 	    alert("Wrong!  Guess again.");
       }
       END
-      print $query->start_html(-title=>'The Riddle of the Sphinx',
+      print start_html(-title=>'The Riddle of the Sphinx',
 			       -script=>$JSCRIPT);
 
 Use the B<-noScript> parameter to pass some HTML text that will be displayed on 
@@ -5002,13 +5140,13 @@ place to put Netscape extensions, such as colors and wallpaper patterns.
 
 =head2 ENDING THE HTML DOCUMENT:
 
-	print $query->end_html
+	print end_html
 
 This ends an HTML document by printing the </body></html> tags.
 
 =head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
 
-    $myself = $query->self_url;
+    $myself = self_url;
     print q(<a href="$myself">I'm talking to myself.</a>);
 
 self_url() will return a URL, that, when selected, will reinvoke
@@ -5017,7 +5155,7 @@ useful when you want to jump around within the document using
 internal anchors but you don't want to disrupt the current contents
 of the form(s).  Something like this will do the trick.
 
-     $myself = $query->self_url;
+     $myself = self_url;
      print "<a href=\"$myself#table1\">See table 1</a>";
      print "<a href=\"$myself#table2\">See table 2</a>";
      print "<a href=\"$myself#yourself\">See for yourself</a>";
@@ -5027,17 +5165,17 @@ method instead.
 
 You can also retrieve the unprocessed query string with query_string():
 
-    $the_string = $query->query_string;
+    $the_string = query_string;
 
 =head2 OBTAINING THE SCRIPT'S URL
 
-    $full_url      = $query->url();
-    $full_url      = $query->url(-full=>1);  #alternative syntax
-    $relative_url  = $query->url(-relative=>1);
-    $absolute_url  = $query->url(-absolute=>1);
-    $url_with_path = $query->url(-path_info=>1);
-    $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
-    $netloc        = $query->url(-base => 1);
+    $full_url      = url();
+    $full_url      = url(-full=>1);  #alternative syntax
+    $relative_url  = url(-relative=>1);
+    $absolute_url  = url(-absolute=>1);
+    $url_with_path = url(-path_info=>1);
+    $url_with_path_and_query = url(-path_info=>1,-query=>1);
+    $netloc        = url(-base => 1);
 
 B<url()> returns the script's URL in a variety of formats.  Called
 without any arguments, it returns the full form of the URL, including
@@ -5083,11 +5221,21 @@ as a synonym.
 
 Generate just the protocol and net location, as in http://www.foo.com:8000
 
+=item B<-rewrite>
+
+If Apache's mod_rewrite is turned on, then the script name and path
+info probably won't match the request that the user sent. Set
+-rewrite=>1 (default) to return URLs that match what the user sent
+(the original request URI). Set -rewrite->0 to return URLs that match
+the URL after mod_rewrite's rules have run. Because the additional
+path information only makes sense in the context of the rewritten URL,
+-rewrite is set to false when you request path info in the URL.
+
 =back
 
 =head2 MIXING POST AND URL PARAMETERS
 
-   $color = $query->url_param('color');
+   $color = 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
@@ -5115,7 +5263,6 @@ commonly, print out so that it displays in the browser window.
 
 This example shows how to use the HTML methods:
 
-   $q = new CGI;
    print $q->blockquote(
 		     "Many years ago on the island of",
 		     $q->a({href=>"http://crete.org/"},"Crete"),
@@ -5346,7 +5493,7 @@ choices:
 (2) use the -override (alias -force) parameter (a new feature in version 2.15).
 This forces the default value to be used, regardless of the previous value:
 
-   print $query->textfield(-name=>'field_name',
+   print textfield(-name=>'field_name',
 			   -default=>'starting value',
 			   -override=>1,
 			   -size=>50,
@@ -5360,7 +5507,7 @@ into your fields.  If you wish to turn off automatic escaping, call the
 autoEscape() method with a false value immediately after creating the CGI object:
 
    $query = new CGI;
-   $query->autoEscape(undef);
+   autoEscape(undef);
 
 I<A Lurking Trap!> Some of the form-element generating methods return
 multiple tags.  In a scalar context, the tags will be concatenated
@@ -5369,7 +5516,7 @@ global.  In a list context, the methods will return a list of
 elements, allowing you to modify them if you wish.  Usually you will
 not notice this behavior, but beware of this:
 
-    printf("%s\n",$query->end_form())
+    printf("%s\n",end_form())
 
 end_form() produces several tags, and only the first of them will be
 printed because the format only expects one value.
@@ -5379,11 +5526,11 @@ printed because the format only expects one value.
 
 =head2 CREATING AN ISINDEX TAG
 
-   print $query->isindex(-action=>$action);
+   print isindex(-action=>$action);
 
 	 -or-
 
-   print $query->isindex($action);
+   print isindex($action);
 
 Prints out an <isindex> tag.  Not very exciting.  The parameter
 -action specifies the URL of the script to process the query.  The
@@ -5391,17 +5538,17 @@ default is to process the query with the current script.
 
 =head2 STARTING AND ENDING A FORM
 
-    print $query->start_form(-method=>$method,
-			    -action=>$action,
-			    -enctype=>$encoding);
+    print start_form(-method=>$method,
+		    -action=>$action,
+		    -enctype=>$encoding);
       <... various form stuff ...>
-    print $query->endform;
+    print endform;
 
 	-or-
 
-    print $query->start_form($method,$action,$encoding);
+    print start_form($method,$action,$encoding);
       <... various form stuff ...>
-    print $query->endform;
+    print endform;
 
 start_form() will return a <form> tag with the optional method,
 action and form encoding that you specify.  The defaults are:
@@ -5442,6 +5589,9 @@ Forms that use this type of encoding are not easily interpreted
 by CGI scripts unless they use CGI.pm or another library designed
 to handle them.
 
+If XHTML is activated (the default), then forms will be automatically
+created using this type of encoding.
+
 =back
 
 For compatibility, the start_form() method uses the older form of
@@ -5463,17 +5613,67 @@ Usually the bulk of JavaScript functions are defined in a <script>
 block in the HTML header and -onSubmit points to one of these function
 call.  See start_html() for details.
 
+=head2 FORM ELEMENTS
+
+After starting a form, you will typically create one or more
+textfields, popup menus, radio groups and other form elements.  Each
+of these elements takes a standard set of named arguments.  Some
+elements also have optional arguments.  The standard arguments are as
+follows:
+
+=over 4
+
+=item B<-name>
+
+The name of the field. After submission this name can be used to
+retrieve the field's value using the param() method.
+
+=item B<-value>, B<-values>
+
+The initial value of the field which will be returned to the script
+after form submission.  Some form elements, such as text fields, take
+a single scalar -value argument. Others, such as popup menus, take a
+reference to an array of values. The two arguments are synonyms.
+
+=item B<-tabindex>
+
+A numeric value that sets the order in which the form element receives
+focus when the user presses the tab key. Elements with lower values
+receive focus first.
+
+=item B<-id>
+
+A string identifier that can be used to identify this element to
+JavaScript and DHTML.
+
+=item B<-override>
+
+A boolean, which, if true, forces the element to take on the value
+specified by B<-value>, overriding the sticky behavior described
+earlier for the B<-no_sticky> pragma.
+
+=item B<-onChange>, B<-onFocus>, B<-onBlur>, B<-onMouseOver>, B<-onMouseOut>, B<-onSelect>
+
+These are used to assign JavaScript event handlers. See the
+JavaScripting section for more details.
+
+=back
+
+Other common arguments are described in the next section. In addition
+to these, all attributes described in the HTML specifications are
+supported.
+
 =head2 CREATING A TEXT FIELD
 
-    print $query->textfield(-name=>'field_name',
-			    -default=>'starting value',
-			    -size=>50,
-			    -maxlength=>80);
+    print textfield(-name=>'field_name',
+		    -value=>'starting value',
+		    -size=>50,
+		    -maxlength=>80);
 	-or-
 
-    print $query->textfield('field_name','starting value',50,80);
+    print textfield('field_name','starting value',50,80);
 
-textfield() will return a text input field.  
+textfield() will return a text input field. 
 
 =over 4
 
@@ -5481,12 +5681,12 @@ textfield() will return a text input field.
 
 =item 1.
 
-The first parameter is the required name for the field (-name).  
+The first parameter is the required name for the field (-name). 
 
 =item 2.
 
 The optional second parameter is the default starting value for the field
-contents (-default).  
+contents (-value, formerly known as -default).
 
 =item 3.
 
@@ -5505,78 +5705,51 @@ previous contents from earlier invocations of the script.
 When the form is processed, the value of the text field can be
 retrieved with:
 
-       $value = $query->param('foo');
+       $value = param('foo');
 
 If you want to reset it from its initial value after the script has been
 called once, you can do so like this:
 
-       $query->param('foo',"I'm taking over this value!");
-
-NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
-value, you can force its current value by using the -override (alias -force)
-parameter:
-
-    print $query->textfield(-name=>'field_name',
-			    -default=>'starting value',
-			    -override=>1,
-			    -size=>50,
-			    -maxlength=>80);
-
-JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
-B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
-parameters to register JavaScript event handlers.  The onChange
-handler will be called whenever the user changes the contents of the
-text field.  You can do text validation if you like.  onFocus and
-onBlur are called respectively when the insertion point moves into and
-out of the text field.  onSelect is called when the user changes the
-portion of the text that is selected.
+       param('foo',"I'm taking over this value!");
 
 =head2 CREATING A BIG TEXT FIELD
 
-   print $query->textarea(-name=>'foo',
+   print textarea(-name=>'foo',
 			  -default=>'starting value',
 			  -rows=>10,
 			  -columns=>50);
 
 	-or
 
-   print $query->textarea('foo','starting value',10,50);
+   print textarea('foo','starting value',10,50);
 
 textarea() is just like textfield, but it allows you to specify
 rows and columns for a multiline text entry box.  You can provide
 a starting value for the field, which can be long and contain
 multiple lines.
 
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
-B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
-recognized.  See textfield().
-
 =head2 CREATING A PASSWORD FIELD
 
-   print $query->password_field(-name=>'secret',
+   print password_field(-name=>'secret',
 				-value=>'starting value',
 				-size=>50,
 				-maxlength=>80);
 	-or-
 
-   print $query->password_field('secret','starting value',50,80);
+   print password_field('secret','starting value',50,80);
 
 password_field() is identical to textfield(), except that its contents 
 will be starred out on the web page.
 
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
-B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
-recognized.  See textfield().
-
 =head2 CREATING A FILE UPLOAD FIELD
 
-    print $query->filefield(-name=>'uploaded_file',
+    print filefield(-name=>'uploaded_file',
 			    -default=>'starting value',
 			    -size=>50,
 			    -maxlength=>80);
 	-or-
 
-    print $query->filefield('uploaded_file','starting value',50,80);
+    print filefield('uploaded_file','starting value',50,80);
 
 filefield() will return a file upload field for Netscape 2.0 browsers.
 In order to take full advantage of this I<you must use the new 
@@ -5619,7 +5792,7 @@ field will accept (-maxlength).
 When the form is processed, you can retrieve the entered filename
 by calling param():
 
-       $filename = $query->param('uploaded_file');
+       $filename = param('uploaded_file');
 
 Different browsers will return slightly different things for the
 name.  Some browsers return the filename only.  Others return the full
@@ -5654,7 +5827,7 @@ To be safe, use the I<upload()> function (new in version 2.47).  When
 called with the name of an upload field, I<upload()> returns a
 filehandle, or undef if the parameter is not a valid filehandle.
 
-     $fh = $query->upload('uploaded_file');
+     $fh = upload('uploaded_file');
      while (<$fh>) {
 	   print;
      }
@@ -5672,8 +5845,8 @@ other information as well (such as modification date and size). To
 retrieve this information, call uploadInfo().  It returns a reference to
 an associative array containing all the document headers.
 
-       $filename = $query->param('uploaded_file');
-       $type = $query->uploadInfo($filename)->{'Content-Type'};
+       $filename = param('uploaded_file');
+       $type = uploadInfo($filename)->{'Content-Type'};
        unless ($type eq 'text/html') {
 	  die "HTML FILES ONLY!";
        }
@@ -5691,9 +5864,9 @@ uploaded file and set I<cgi_error()> to the string "400 Bad request
 you can incorporate it into a status code to be sent to the browser.
 Example:
 
-   $file = $query->upload('uploaded_file');
-   if (!$file && $query->cgi_error) {
-      print $query->header(-status=>$query->cgi_error);
+   $file = upload('uploaded_file');
+   if (!$file && cgi_error) {
+      print header(-status=>cgi_error);
       exit 0;
    }
 
@@ -5706,8 +5879,7 @@ UPLOAD_HOOK facility available in Apache::Request, with the exception
 that the first argument to the callback is an Apache::Upload object,
 here it's the remote filename.
 
- $q = CGI->new();
- $q->upload_hook(\&hook,$data);
+ $q = CGI->new(\&hook,$data);
 
  sub hook
  {
@@ -5735,7 +5907,7 @@ recognized.  See textfield() for details.
 
 =head2 CREATING A POPUP MENU
 
-   print $query->popup_menu('menu_name',
+   print popup_menu('menu_name',
 			    ['eenie','meenie','minie'],
 			    'meenie');
 
@@ -5745,13 +5917,13 @@ recognized.  See textfield() for details.
 	      'meenie'=>'your second choice',
 	      'minie'=>'your third choice');
    %attributes = ('eenie'=>{'class'=>'class of first choice'});
-   print $query->popup_menu('menu_name',
+   print popup_menu('menu_name',
 			    ['eenie','meenie','minie'],
           'meenie',\%labels,\%attributes);
 
 	-or (named parameter style)-
 
-   print $query->popup_menu(-name=>'menu_name',
+   print popup_menu(-name=>'menu_name',
 			    -values=>['eenie','meenie','minie'],
 			    -default=>'meenie',
           -labels=>\%labels,
@@ -5800,35 +5972,30 @@ attribute's value as the value.
 When the form is processed, the selected value of the popup menu can
 be retrieved using:
 
-      $popup_menu_value = $query->param('menu_name');
-
-JAVASCRIPTING: popup_menu() recognizes the following event handlers:
-B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
-B<-onBlur>.  See the textfield() section for details on when these
-handlers are called.
+      $popup_menu_value = param('menu_name');
 
 =head2 CREATING AN OPTION GROUP
 
 Named parameter style
 
-  print $query->popup_menu(-name=>'menu_name',
+  print popup_menu(-name=>'menu_name',
                   -values=>[qw/eenie meenie minie/,
-                            $q->optgroup(-name=>'optgroup_name',
-                                         -values ['moe','catch'],
-                                         -attributes=>{'catch'=>{'class'=>'red'}}),
+                            optgroup(-name=>'optgroup_name',
+                                             -values => ['moe','catch'],
+                                             -attributes=>{'catch'=>{'class'=>'red'}})],
                   -labels=>{'eenie'=>'one',
                             'meenie'=>'two',
                             'minie'=>'three'},
                   -default=>'meenie');
 
   Old style
-  print $query->popup_menu('menu_name',
+  print popup_menu('menu_name',
                   ['eenie','meenie','minie',
-                   $q->optgroup('optgroup_name', ['moe', 'catch'],
-                         {'catch'=>{'class'=>'red'}})],'meenie',
+                   optgroup('optgroup_name', ['moe', 'catch'],
+                                   {'catch'=>{'class'=>'red'}})],'meenie',
                   {'eenie'=>'one','meenie'=>'two','minie'=>'three'});
 
-optgroup creates an option group within a popup menu.
+optgroup() creates an option group within a popup menu.
 
 =over 4
 
@@ -5884,19 +6051,19 @@ attribute's value as the value.
 
 =head2 CREATING A SCROLLING LIST
 
-   print $query->scrolling_list('list_name',
+   print scrolling_list('list_name',
 				['eenie','meenie','minie','moe'],
         ['eenie','moe'],5,'true',{'moe'=>{'class'=>'red'}});
       -or-
 
-   print $query->scrolling_list('list_name',
+   print scrolling_list('list_name',
 				['eenie','meenie','minie','moe'],
 				['eenie','moe'],5,'true',
         \%labels,%attributes);
 
 	-or-
 
-   print $query->scrolling_list(-name=>'list_name',
+   print scrolling_list(-name=>'list_name',
 				-values=>['eenie','meenie','minie','moe'],
 				-default=>['eenie','moe'],
 				-size=>5,
@@ -5953,32 +6120,27 @@ When this form is processed, all selected list items will be returned as
 a list under the parameter name 'list_name'.  The values of the
 selected items can be retrieved with:
 
-      @selected = $query->param('list_name');
+      @selected = param('list_name');
 
 =back
 
-JAVASCRIPTING: scrolling_list() recognizes the following event
-handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
-and B<-onBlur>.  See textfield() for the description of when these
-handlers are called.
-
 =head2 CREATING A GROUP OF RELATED CHECKBOXES
 
-   print $query->checkbox_group(-name=>'group_name',
+   print checkbox_group(-name=>'group_name',
 				-values=>['eenie','meenie','minie','moe'],
 				-default=>['eenie','moe'],
 				-linebreak=>'true',
         -labels=>\%labels,
         -attributes=>\%attributes);
 
-   print $query->checkbox_group('group_name',
+   print checkbox_group('group_name',
 				['eenie','meenie','minie','moe'],
         ['eenie','moe'],'true',\%labels,
         {'moe'=>{'class'=>'red'}});
 
    HTML3-COMPATIBLE BROWSERS ONLY:
 
-   print $query->checkbox_group(-name=>'group_name',
+   print checkbox_group(-name=>'group_name',
 				-values=>['eenie','meenie','minie','moe'],
 				-rows=2,-columns=>2);
 
@@ -6011,68 +6173,66 @@ The optional fourth argument (-linebreak) can be set to true to place
 line breaks between the checkboxes so that they appear as a vertical
 list.  Otherwise, they will be strung together on a horizontal line.
 
-=item 4.
+=back
 
-The optional fifth argument is a pointer to an associative array
-relating the checkbox values to the user-visible labels that will
-be printed next to them (-labels).  If not provided, the values will
-be used as the default.
 
-=item 5.
+The optional b<-labels> argument is a pointer to an associative array
+relating the checkbox values to the user-visible labels that will be
+printed next to them.  If not provided, the values will be used as the
+default.
 
-B<HTML3-compatible browsers> (such as Netscape) can take advantage of
-the optional parameters B<-rows>, and B<-columns>.  These parameters
-cause checkbox_group() to return an HTML3 compatible table containing
-the checkbox group formatted with the specified number of rows and
-columns.  You can provide just the -columns parameter if you wish;
-checkbox_group will calculate the correct number of rows for you.
 
-=item 6.
+Modern browsers can take advantage of the optional parameters
+B<-rows>, and B<-columns>.  These parameters cause checkbox_group() to
+return an HTML3 compatible table containing the checkbox group
+formatted with the specified number of rows and columns.  You can
+provide just the -columns parameter if you wish; checkbox_group will
+calculate the correct number of rows for you.
 
-The optional sixth parameter (-attributes) is provided to assign
-any of the common HTML attributes to an individual menu item. It's
-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.
 
-To include row and column headings in the returned table, you
-can use the B<-rowheaders> and B<-colheaders> parameters.  Both
-of these accept a pointer to an array of headings to use.
-The headings are just decorative.  They don't reorganize the
-interpretation of the checkboxes -- they're still a single named
-unit.
+The optional B<-attributes> argument is provided to assign any of the
+common HTML attributes to an individual menu item. It's 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
+The optional B<-tabindex> argument can be used to control the order in which
+radio buttons receive focus when the user presses the tab button.  If
+passed a scalar numeric value, the first element in the group will
+receive this tab index and subsequent elements will be incremented by
+one.  If given a reference to an array of radio button values, then
+the indexes will be jiggered so that the order specified in the array
+will correspond to the tab order.  You can also pass a reference to a
+hash in which the hash keys are the radio button values and the values
+are the tab indexes of each button.  Examples:
+
+  -tabindex => 100    #  this group starts at index 100 and counts up
+  -tabindex => ['moe','minie','eenie','meenie']  # tab in this order
+  -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
 
 When the form is processed, all checked boxes will be returned as
 a list under the parameter name 'group_name'.  The values of the
 "on" checkboxes can be retrieved with:
 
-      @turned_on = $query->param('group_name');
+      @turned_on = param('group_name');
 
 The value returned by checkbox_group() is actually an array of button
 elements.  You can capture them and use them within tables, lists,
 or in other creative ways:
 
-    @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
+    @h = checkbox_group(-name=>'group_name',-values=>\@values);
     &use_in_creative_way(@h);
 
-JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
-parameter.  This specifies a JavaScript code fragment or
-function call to be executed every time the user clicks on
-any of the buttons in the group.  You can retrieve the identity
-of the particular button clicked on using the "this" variable.
-
 =head2 CREATING A STANDALONE CHECKBOX
 
-    print $query->checkbox(-name=>'checkbox_name',
+    print checkbox(-name=>'checkbox_name',
 			   -checked=>1,
 			   -value=>'ON',
 			   -label=>'CLICK ME');
 
 	-or-
 
-    print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
+    print checkbox('checkbox_name','checked','ON','CLICK ME');
 
 checkbox() is used to create an isolated checkbox that isn't logically
 related to any others.
@@ -6108,14 +6268,11 @@ used.
 
 The value of the checkbox can be retrieved using:
 
-    $turned_on = $query->param('checkbox_name');
-
-JAVASCRIPTING: checkbox() recognizes the B<-onClick>
-parameter.  See checkbox_group() for further details.
+    $turned_on = param('checkbox_name');
 
 =head2 CREATING A RADIO BUTTON GROUP
 
-   print $query->radio_group(-name=>'group_name',
+   print radio_group(-name=>'group_name',
 			     -values=>['eenie','meenie','minie'],
 			     -default=>'meenie',
 			     -linebreak=>'true',
@@ -6124,13 +6281,13 @@ parameter.  See checkbox_group() for further details.
 
 	-or-
 
-   print $query->radio_group('group_name',['eenie','meenie','minie'],
+   print radio_group('group_name',['eenie','meenie','minie'],
             'meenie','true',\%labels,\%attributes);
 
 
    HTML3-COMPATIBLE BROWSERS ONLY:
 
-   print $query->radio_group(-name=>'group_name',
+   print radio_group(-name=>'group_name',
 			     -values=>['eenie','meenie','minie','moe'],
 			     -rows=2,-columns=>2);
 
@@ -6172,24 +6329,15 @@ array relating the radio button values to user-visible labels to be
 used in the display.  If not provided, the values themselves are
 displayed.
 
-=item 6.
+=back
 
-B<HTML3-compatible browsers> (such as Netscape) can take advantage 
-of the optional 
-parameters B<-rows>, and B<-columns>.  These parameters cause
-radio_group() to return an HTML3 compatible table containing
-the radio group formatted with the specified number of rows
-and columns.  You can provide just the -columns parameter if you
-wish; radio_group will calculate the correct number of rows
-for you.
 
-=item 6.
-
-The optional sixth parameter (-attributes) is provided to assign
-any of the common HTML attributes to an individual menu item. It's
-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.
+All modern browsers can take advantage of the optional parameters
+B<-rows>, and B<-columns>.  These parameters cause radio_group() to
+return an HTML3 compatible table containing the radio group formatted
+with the specified number of rows and columns.  You can provide just
+the -columns parameter if you wish; radio_group will calculate the
+correct number of rows for you.
 
 To include row and column headings in the returned table, you
 can use the B<-rowheader> and B<-colheader> parameters.  Both
@@ -6198,28 +6346,47 @@ The headings are just decorative.  They don't reorganize the
 interpretation of the radio buttons -- they're still a single named
 unit.
 
-=back
+The optional B<-tabindex> argument can be used to control the order in which
+radio buttons receive focus when the user presses the tab button.  If
+passed a scalar numeric value, the first element in the group will
+receive this tab index and subsequent elements will be incremented by
+one.  If given a reference to an array of radio button values, then
+the indexes will be jiggered so that the order specified in the array
+will correspond to the tab order.  You can also pass a reference to a
+hash in which the hash keys are the radio button values and the values
+are the tab indexes of each button.  Examples:
+
+  -tabindex => 100    #  this group starts at index 100 and counts up
+  -tabindex => ['moe','minie','eenie','meenie']  # tab in this order
+  -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
+
+
+The optional B<-attributes> argument is provided to assign any of the
+common HTML attributes to an individual menu item. It's 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.
 
 When the form is processed, the selected radio button can
 be retrieved using:
 
-      $which_radio_button = $query->param('group_name');
+      $which_radio_button = param('group_name');
 
 The value returned by radio_group() is actually an array of button
 elements.  You can capture them and use them within tables, lists,
 or in other creative ways:
 
-    @h = $query->radio_group(-name=>'group_name',-values=>\@values);
+    @h = radio_group(-name=>'group_name',-values=>\@values);
     &use_in_creative_way(@h);
 
 =head2 CREATING A SUBMIT BUTTON 
 
-   print $query->submit(-name=>'button_name',
+   print submit(-name=>'button_name',
 			-value=>'value');
 
 	-or-
 
-   print $query->submit('button_name','value');
+   print submit('button_name','value');
 
 submit() will create the query submission button.  Every form
 should have one of these.
@@ -6251,14 +6418,11 @@ button.
 You can figure out which button was pressed by using different
 values for each one:
 
-     $which_one = $query->param('button_name');
-
-JAVASCRIPTING: radio_group() recognizes the B<-onClick>
-parameter.  See checkbox_group() for further details.
+     $which_one = param('button_name');
 
 =head2 CREATING A RESET BUTTON
 
-   print $query->reset
+   print reset
 
 reset() creates the "reset" button.  Note that it restores the
 form to its value from the last time the script was called, 
@@ -6269,7 +6433,7 @@ CORE::reset() to get the original reset function.
 
 =head2 CREATING A DEFAULT BUTTON
 
-   print $query->defaults('button_label')
+   print defaults('button_label')
 
 defaults() creates a button that, when invoked, will cause the
 form to be completely reset to its defaults, wiping out all the
@@ -6277,12 +6441,12 @@ changes the user ever made.
 
 =head2 CREATING A HIDDEN FIELD
 
-	print $query->hidden(-name=>'hidden_name',
+	print hidden(-name=>'hidden_name',
 			     -default=>['value1','value2'...]);
 
 		-or-
 
-	print $query->hidden('hidden_name','value1','value2'...);
+	print hidden('hidden_name','value1','value2'...);
 
 hidden() produces a text field that can't be seen by the user.  It
 is useful for passing state variable information from one invocation
@@ -6307,33 +6471,30 @@ a single value here or a reference to a whole list
 
 Fetch the value of a hidden field this way:
 
-     $hidden_value = $query->param('hidden_name');
+     $hidden_value = param('hidden_name');
 
 Note, that just like all the other form elements, the value of a
 hidden field is "sticky".  If you want to replace a hidden field with
 some other values after the script has been called once you'll have to
 do it manually:
 
-     $query->param('hidden_name','new','values','here');
+     param('hidden_name','new','values','here');
 
 =head2 CREATING A CLICKABLE IMAGE BUTTON
 
-     print $query->image_button(-name=>'button_name',
+     print image_button(-name=>'button_name',
 				-src=>'/source/URL',
 				-align=>'MIDDLE');      
 
 	-or-
 
-     print $query->image_button('button_name','/source/URL','MIDDLE');
+     print image_button('button_name','/source/URL','MIDDLE');
 
 image_button() produces a clickable image.  When it's clicked on the
 position of the click is returned to your script as "button_name.x"
 and "button_name.y", where "button_name" is the name you've assigned
 to it.
 
-JAVASCRIPTING: image_button() recognizes the B<-onClick>
-parameter.  See checkbox_group() for further details.
-
 =over 4
 
 =item B<Parameters:>
@@ -6354,18 +6515,18 @@ TOP, BOTTOM or MIDDLE
 =back
 
 Fetch the value of the button this way:
-     $x = $query->param('button_name.x');
-     $y = $query->param('button_name.y');
+     $x = param('button_name.x');
+     $y = param('button_name.y');
 
 =head2 CREATING A JAVASCRIPT ACTION BUTTON
 
-     print $query->button(-name=>'button_name',
+     print button(-name=>'button_name',
 			  -value=>'user visible label',
 			  -onClick=>"do_something()");
 
 	-or-
 
-     print $query->button('button_name',"do_something()");
+     print button('button_name',"do_something()");
 
 button() produces a button that is compatible with Netscape 2.0's
 JavaScript.  When it's pressed the fragment of JavaScript code
@@ -6431,13 +6592,13 @@ script if the CGI request is occurring on a secure channel, such as SSL.
 
 The interface to HTTP cookies is the B<cookie()> method:
 
-    $cookie = $query->cookie(-name=>'sessionID',
+    $cookie = cookie(-name=>'sessionID',
 			     -value=>'xyzzy',
 			     -expires=>'+1h',
 			     -path=>'/cgi-bin/database',
 			     -domain=>'.capricorn.org',
 			     -secure=>1);
-    print $query->header(-cookie=>$cookie);
+    print header(-cookie=>$cookie);
 
 B<cookie()> creates a new cookie.  Its parameters include:
 
@@ -6456,7 +6617,7 @@ The value of the cookie.  This can be any scalar value,
 array reference, or even associative array reference.  For example,
 you can store an entire associative array into a cookie this way:
 
-	$cookie=$query->cookie(-name=>'family information',
+	$cookie=cookie(-name=>'family information',
 			       -value=>\%childrens_ages);
 
 =item B<-path>
@@ -6486,23 +6647,23 @@ SSL session.
 The cookie created by cookie() must be incorporated into the HTTP
 header within the string returned by the header() method:
 
-	print $query->header(-cookie=>$my_cookie);
+	print header(-cookie=>$my_cookie);
 
 To create multiple cookies, give header() an array reference:
 
-	$cookie1 = $query->cookie(-name=>'riddle_name',
+	$cookie1 = cookie(-name=>'riddle_name',
 				  -value=>"The Sphynx's Question");
-	$cookie2 = $query->cookie(-name=>'answers',
+	$cookie2 = cookie(-name=>'answers',
 				  -value=>\%answers);
-	print $query->header(-cookie=>[$cookie1,$cookie2]);
+	print header(-cookie=>[$cookie1,$cookie2]);
 
 To retrieve a cookie, request it by name by calling cookie() method
 without the B<-value> parameter:
 
 	use CGI;
 	$query = new CGI;
-	$riddle = $query->cookie('riddle_name');
-        %answers = $query->cookie('answers');
+	$riddle = cookie('riddle_name');
+        %answers = cookie('answers');
 
 Cookies created with a single scalar value, such as the "riddle_name"
 cookie, will be returned in that form.  Cookies with array and hash
@@ -6514,9 +6675,9 @@ param() and cookie() are independent of each other.  However, it's
 simple to turn a CGI parameter into a cookie, and vice-versa:
 
    # turn a CGI parameter into a cookie
-   $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
+   $c=cookie(-name=>'answers',-value=>[param('answers')]);
    # vice-versa
-   $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
+   param(-name=>'answers',-value=>[cookie('answers')]);
 
 See the B<cookie.cgi> example script for some ideas on how to use
 cookies effectively.
@@ -6546,7 +6707,7 @@ documentation in Netscape's home pages for details
 
 You may provide a B<-target> parameter to the header() method:
 
-    print $q->header(-target=>'ResultsWindow');
+    print header(-target=>'ResultsWindow');
 
 This will tell the browser to load the output of your script into the
 frame named "ResultsWindow".  If a frame of that name doesn't already
@@ -6560,7 +6721,7 @@ details.
 You can specify the frame to load in the FORM tag itself.  With
 CGI.pm it looks like this:
 
-    print $q->start_form(-target=>'ResultsWindow');
+    print start_form(-target=>'ResultsWindow');
 
 When your script is reinvoked by the form, its output will be loaded
 into the frame named "ResultsWindow".  If one doesn't already exist
@@ -6572,6 +6733,155 @@ The script "frameset.cgi" in the examples directory shows one way to
 create pages in which the fill-out form and the response live in
 side-by-side frames.
 
+=head1 SUPPORT FOR JAVASCRIPT
+
+Netscape versions 2.0 and higher incorporate an interpreted language
+called JavaScript. Internet Explorer, 3.0 and higher, supports a
+closely-related dialect called JScript. JavaScript isn't the same as
+Java, and certainly isn't at all the same as Perl, which is a great
+pity. JavaScript allows you to programatically change the contents of
+fill-out forms, create new windows, and pop up dialog box from within
+Netscape itself. From the point of view of CGI scripting, JavaScript
+is quite useful for validating fill-out forms prior to submitting
+them.
+
+You'll need to know JavaScript in order to use it. There are many good
+sources in bookstores and on the web.
+
+The usual way to use JavaScript is to define a set of functions in a
+<SCRIPT> block inside the HTML header and then to register event
+handlers in the various elements of the page. Events include such
+things as the mouse passing over a form element, a button being
+clicked, the contents of a text field changing, or a form being
+submitted. When an event occurs that involves an element that has
+registered an event handler, its associated JavaScript code gets
+called.
+
+The elements that can register event handlers include the <BODY> of an
+HTML document, hypertext links, all the various elements of a fill-out
+form, and the form itself. There are a large number of events, and
+each applies only to the elements for which it is relevant. Here is a
+partial list:
+
+=over 4
+
+=item B<onLoad>
+
+The browser is loading the current document. Valid in:
+
+     + The HTML <BODY> section only.
+
+=item B<onUnload>
+
+The browser is closing the current page or frame. Valid for:
+
+     + The HTML <BODY> section only.
+
+=item B<onSubmit>
+
+The user has pressed the submit button of a form. This event happens
+just before the form is submitted, and your function can return a
+value of false in order to abort the submission.  Valid for:
+
+     + Forms only.
+
+=item B<onClick>
+
+The mouse has clicked on an item in a fill-out form. Valid for:
+
+     + Buttons (including submit, reset, and image buttons)
+     + Checkboxes
+     + Radio buttons
+
+=item B<onChange>
+
+The user has changed the contents of a field. Valid for:
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+     + Popup Menus
+     + Scrolling lists
+
+=item B<onFocus>
+
+The user has selected a field to work with. Valid for:
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+     + Popup Menus
+     + Scrolling lists
+
+=item B<onBlur>
+
+The user has deselected a field (gone to work somewhere else).  Valid
+for:
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+     + Popup Menus
+     + Scrolling lists
+
+=item B<onSelect>
+
+The user has changed the part of a text field that is selected.  Valid
+for:
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+
+=item B<onMouseOver>
+
+The mouse has moved over an element.
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+     + Popup Menus
+     + Scrolling lists
+
+=item B<onMouseOut>
+
+The mouse has moved off an element.
+
+     + Text fields
+     + Text areas
+     + Password fields
+     + File fields
+     + Popup Menus
+     + Scrolling lists
+
+=back
+
+In order to register a JavaScript event handler with an HTML element,
+just use the event name as a parameter when you call the corresponding
+CGI method. For example, to have your validateAge() JavaScript code
+executed every time the textfield named "age" changes, generate the
+field like this: 
+
+ print textfield(-name=>'age',-onChange=>"validateAge(this)");
+
+This example assumes that you've already declared the validateAge()
+function by incorporating it into a <SCRIPT> block. The CGI.pm
+start_html() method provides a convenient way to create this section.
+
+Similarly, you can create a form that checks itself over for
+consistency and alerts the user if some essential value is missing by
+creating it this way: 
+  print startform(-onSubmit=>"validateMe(this)");
+
+See the javascript.cgi script for a demonstration of how this all
+works.
+
+
 =head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
 
 CGI.pm has limited support for HTML3's cascading style sheets (css).
@@ -6650,7 +6960,7 @@ Should you wish to incorporate a verbatim stylesheet that includes
 arbitrary formatting in the header, you may pass a -verbatim tag to
 the -style hash, as follows:
 
-print $q->start_html (-STYLE  =>  {-verbatim => '@import
+print start_html (-STYLE  =>  {-verbatim => '@import
 url("/server-common/css/'.$cssFile.'");',
                       -src      =>  '/server-common/css/core.css'});
 </blockquote></pre>
@@ -6729,7 +7039,7 @@ The Dump() method produces a string consisting of all the query's
 name/value pairs formatted nicely as a nested list.  This is useful
 for debugging purposes:
 
-    print $query->Dump
+    print Dump
 
 
 Produces something that looks like:
@@ -6763,7 +7073,7 @@ through this interface.  The methods are as follows:
 
 Return a list of MIME types that the remote browser accepts. If you
 give this method a single argument corresponding to a MIME type, as in
-$query->Accept('text/html'), it will return a floating point value
+Accept('text/html'), it will return a floating point value
 corresponding to the browser's preference for this type from 0.0
 (don't want) to 1.0.  Glob types (e.g. text/*) in the browser's accept
 list are handled correctly.
@@ -6791,13 +7101,13 @@ method from the CGI::Cookie module.
 Returns the HTTP_USER_AGENT variable.  If you give
 this method a single argument, it will attempt to
 pattern match on it, allowing you to do something
-like $query->user_agent(netscape);
+like user_agent(netscape);
 
 =item B<path_info()>
 
 Returns additional path information from the script URL.
 E.G. fetching /cgi-bin/your_script/additional/stuff will result in
-$query->path_info() returning "/additional/stuff".
+path_info() returning "/additional/stuff".
 
 NOTE: The Microsoft Internet Information Server
 is broken with respect to additional path information.  If
@@ -6892,9 +7202,9 @@ of hyphens versus underscores are not significant.
 
 For example, all three of these examples are equivalent:
 
-   $requested_language = $q->http('Accept-language');
-   $requested_language = $q->http('Accept_language');
-   $requested_language = $q->http('HTTP_ACCEPT_LANGUAGE');
+   $requested_language = http('Accept-language');
+   $requested_language = http('Accept_language');
+   $requested_language = http('HTTP_ACCEPT_LANGUAGE');
 
 =item B<https()>
 
@@ -6955,7 +7265,7 @@ Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your
 
 in the B<header()> and B<redirect()>  statements:
 
-      print $q->header(-nph=>1);
+      print header(-nph=>1);
 
 =back
 
@@ -7135,7 +7445,7 @@ OLD VERSION
 
 NEW VERSION
     use CGI;
-    CGI::ReadParse;
+    CGI::ReadParse();
     print "The value of the antique is $in{antique}.\n";
 
 CGI.pm's ReadParse() routine creates a tied variable named %in,
@@ -7148,7 +7458,7 @@ Once you use ReadParse, you can retrieve the query object itself
 this way:
 
     $q = $in{CGI};
-    print $q->textfield(-name=>'wow',
+    print textfield(-name=>'wow',
 			-value=>'does this really work?');
 
 This allows you to start using the more interesting features
@@ -7225,48 +7535,44 @@ for suggestions and bug fixes.
 
 	#!/usr/local/bin/perl
 
-	use CGI;
-
-	$query = new CGI;
+	use CGI ':standard';
 
-	print $query->header;
-	print $query->start_html("Example CGI.pm Form");
+	print header;
+	print start_html("Example CGI.pm Form");
 	print "<h1> Example CGI.pm Form</h1>\n";
-	&print_prompt($query);
-	&do_work($query);
-	&print_tail;
-	print $query->end_html;
+        print_prompt();
+	do_work();
+	print_tail();
+	print end_html;
 
 	sub print_prompt {
-	   my($query) = @_;
-
-	   print $query->start_form;
+	   print start_form;
 	   print "<em>What's your name?</em><br>";
-	   print $query->textfield('name');
-	   print $query->checkbox('Not my real name');
+	   print textfield('name');
+	   print checkbox('Not my real name');
 
 	   print "<p><em>Where can you find English Sparrows?</em><br>";
-	   print $query->checkbox_group(
+	   print checkbox_group(
 				 -name=>'Sparrow locations',
 				 -values=>[England,France,Spain,Asia,Hoboken],
 				 -linebreak=>'yes',
 				 -defaults=>[England,Asia]);
 
 	   print "<p><em>How far can they fly?</em><br>",
-		$query->radio_group(
+		radio_group(
 			-name=>'how far',
 			-values=>['10 ft','1 mile','10 miles','real far'],
 			-default=>'1 mile');
 
 	   print "<p><em>What's your favorite color?</em>  ";
-	   print $query->popup_menu(-name=>'Color',
+	   print popup_menu(-name=>'Color',
 				    -values=>['black','brown','red','yellow'],
 				    -default=>'red');
 
-	   print $query->hidden('Reference','Monty Python and the Holy Grail');
+	   print hidden('Reference','Monty Python and the Holy Grail');
 
 	   print "<p><em>What have you got there?</em><br>";
-	   print $query->scrolling_list(
+	   print scrolling_list(
 			 -name=>'possessions',
 			 -values=>['A Coconut','A Grail','An Icon',
 				   'A Sword','A Ticket'],
@@ -7274,26 +7580,25 @@ for suggestions and bug fixes.
 			 -multiple=>'true');
 
 	   print "<p><em>Any parting comments?</em><br>";
-	   print $query->textarea(-name=>'Comments',
+	   print textarea(-name=>'Comments',
 				  -rows=>10,
 				  -columns=>50);
 
-	   print "<p>",$query->reset;
-	   print $query->submit('Action','Shout');
-	   print $query->submit('Action','Scream');
-	   print $query->endform;
+	   print "<p>",reset;
+	   print submit('Action','Shout');
+	   print submit('Action','Scream');
+	   print endform;
 	   print "<hr>\n";
 	}
 
 	sub do_work {
-	   my($query) = @_;
 	   my(@values,$key);
 
 	   print "<h2>Here are the current settings in this form</h2>";
 
-	   foreach $key ($query->param) {
+	   foreach $key (param) {
 	      print "<strong>$key</strong> -> ";
-	      @values = $query->param($key);
+	      @values = param($key);
 	      print join(", ",@values),"<br>\n";
 	  }
 	}
diff --git a/gnu/usr.bin/perl/lib/CGI/Carp.pm b/gnu/usr.bin/perl/lib/CGI/Carp.pm
index e25cd7f0557..3b5784b5800 100644
--- a/gnu/usr.bin/perl/lib/CGI/Carp.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Carp.pm
@@ -281,7 +281,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION    = '1.28';
+$CGI::Carp::VERSION    = '1.29';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 
@@ -371,7 +371,7 @@ sub _warn {
 # eval.  These evals don't count when looking at the stack backtrace.
 sub _longmess {
     my $message = Carp::longmess();
-    $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s
+    $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
         if exists $ENV{MOD_PERL};
     return $message;
 }
@@ -465,17 +465,20 @@ END
   ;
 
   if ($mod_perl) {
-    require mod_perl;
-    if ($mod_perl::VERSION >= 1.99) {
+    my $r;
+    if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
       $mod_perl = 2;
-      require Apache::RequestRec;
-      require Apache::RequestIO;
-      require Apache::RequestUtil;
+      require Apache2::RequestRec;
+      require Apache2::RequestIO;
+      require Apache2::RequestUtil;
       require APR::Pool;
       require ModPerl::Util;
-      require Apache::Response;
+      require Apache2::Response;
+      $r = Apache2::RequestUtil->request;
+    }
+    else {
+      $r = Apache->request;
     }
-    my $r = Apache->request;
     # If bytes have already been sent, then
     # we print the message out directly.
     # Otherwise we make a custom error
diff --git a/gnu/usr.bin/perl/lib/CGI/Cookie.pm b/gnu/usr.bin/perl/lib/CGI/Cookie.pm
index 27a93c55b0d..789aa25d1a2 100644
--- a/gnu/usr.bin/perl/lib/CGI/Cookie.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Cookie.pm
@@ -13,7 +13,7 @@ package CGI::Cookie;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.24';
+$CGI::Cookie::VERSION='1.26';
 
 use CGI::Util qw(rearrange unescape escape);
 use overload '""' => \&as_string,
@@ -23,15 +23,13 @@ use overload '""' => \&as_string,
 # Turn on special checking for Doug MacEachern's modperl
 my $MOD_PERL = 0;
 if (exists $ENV{MOD_PERL}) {
-  eval "require mod_perl";
-  if (defined $mod_perl::VERSION) {
-    if ($mod_perl::VERSION >= 1.99) {
+  if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
       $MOD_PERL = 2;
-      require Apache::RequestUtil;
-    } else {
-      $MOD_PERL = 1;
-      require Apache;
-    }
+      require Apache2::RequestUtil;
+      require APR::Table;
+  } else {
+    $MOD_PERL = 1;
+    require Apache;
   }
 }
 
@@ -71,7 +69,9 @@ sub fetch {
 
 sub get_raw_cookie {
   my $r = shift;
-  $r ||= eval { Apache->request() } if $MOD_PERL;
+  $r ||= eval { $MOD_PERL == 2                    ? 
+                  Apache2::RequestUtil->request() :
+                  Apache->request } if $MOD_PERL;
   if ($r) {
     $raw_cookie = $r->headers_in->{'Cookie'};
   } else {
@@ -159,7 +159,7 @@ sub as_string {
     push(@constant_values,"secure") if $secure = $self->secure;
 
     my($key) = escape($self->name);
-    my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
+    my($cookie) = join("=",($key||''),join("&",map escape($_||''),$self->value));
     return join("; ",$cookie,@constant_values);
 }
 
@@ -199,7 +199,7 @@ sub value {
 sub domain {
     my $self = shift;
     my $domain = shift;
-    $self->{'domain'} = $domain if defined $domain;
+    $self->{'domain'} = lc $domain if defined $domain;
     return $self->{'domain'};
 }
 
diff --git a/gnu/usr.bin/perl/lib/CGI/Pretty.pm b/gnu/usr.bin/perl/lib/CGI/Pretty.pm
index d824a025e4f..2147143e4a9 100644
--- a/gnu/usr.bin/perl/lib/CGI/Pretty.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Pretty.pm
@@ -148,11 +148,12 @@ sub new {
     my $this = $class->SUPER::new( @_ );
 
     if ($CGI::MOD_PERL) {
-        my $r = Apache->request;
         if ($CGI::MOD_PERL == 1) {
+            my $r = Apache->request;
             $r->register_cleanup(\&CGI::Pretty::_reset_globals);
         }
         else {
+            my $r = Apache2::RequestUtil->request;
             $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
         }
     }
diff --git a/gnu/usr.bin/perl/lib/CGI/Util.pm b/gnu/usr.bin/perl/lib/CGI/Util.pm
index 6af42de415e..523007c5ef5 100644
--- a/gnu/usr.bin/perl/lib/CGI/Util.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Util.pm
@@ -103,14 +103,14 @@ sub rearrange {
 	}
     }
 
-    push (@result,make_attributes(\%leftover,1)) if %leftover;
+    push (@result,make_attributes(\%leftover,defined $CGI::Q ? $CGI::Q->{escape} : 1)) if %leftover;
     @result;
 }
 
 sub make_attributes {
     my $attr = shift;
     return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
-    my $escape = shift || 0;
+    my $escape =  shift || 0;
     my(@att);
     foreach (keys %{$attr}) {
 	my($key) = $_;
@@ -141,6 +141,7 @@ sub simple_escape {
 
 sub utf8_chr {
         my $c = shift(@_);
+	return chr($c) if $] >= 5.006;
 
         if ($c < 0x80) {
                 return sprintf("%c", $c);
@@ -180,7 +181,7 @@ sub utf8_chr {
 
 # unescape URL-encoded data
 sub unescape {
-  shift() if @_ > 1 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
+  shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $todecode = shift;
   return undef unless defined($todecode);
   $todecode =~ tr/+/ /;       # pluses become spaces
diff --git a/gnu/usr.bin/perl/lib/CGI/t/form.t b/gnu/usr.bin/perl/lib/CGI/t/form.t
index 5b26a3d885c..54b37927895 100644
--- a/gnu/usr.bin/perl/lib/CGI/t/form.t
+++ b/gnu/usr.bin/perl/lib/CGI/t/form.t
@@ -1,15 +1,13 @@
 #!/usr/local/bin/perl -w
 
-use lib qw(t/lib ./lib ../blib/lib);
-
 # Due to a bug in older versions of MakeMaker & Test::Harness, we must
 # ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
+use lib qw(. ./blib/lib ./blib/arch);
 
-use Test::More tests => 17;
+use Test::More tests => 18;
 
 BEGIN { use_ok('CGI'); };
-use CGI (':standard','-no_debug');
+use CGI (':standard','-no_debug','-tabindex');
 
 my $CRLF = "\015\012";
 if ($^O eq 'VMS') {
@@ -31,47 +29,47 @@ $ENV{SERVER_PORT}     = 8080;
 $ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
 
 is(start_form(-action=>'foobar',-method=>'get'),
-   qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
+   qq(<form method="get" action="foobar" enctype="multipart/form-data">\n),
    "start_form()");
 
 is(submit(),
-   qq(<input type="submit" name=".submit" />),
+   qq(<input type="submit" tabindex="1" name=".submit" />),
    "submit()");
 
 is(submit(-name  => 'foo',
 	  -value => 'bar'),
-   qq(<input type="submit" name="foo" value="bar" />),
+   qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
    "submit(-name,-value)");
 
 is(submit({-name  => 'foo',
 	   -value => 'bar'}),
-   qq(<input type="submit" name="foo" value="bar" />),
+   qq(<input type="submit" tabindex="3" name="foo" value="bar" />),
    "submit({-name,-value})");
 
 is(textfield(-name => 'weather'),
-   qq(<input type="text" name="weather" value="dull" />),
+   qq(<input type="text" name="weather" tabindex="4" value="dull" />),
    "textfield({-name})");
 
 is(textfield(-name  => 'weather',
 	     -value => 'nice'),
-   qq(<input type="text" name="weather" value="dull" />),
+   qq(<input type="text" name="weather" tabindex="5" value="dull" />),
    "textfield({-name,-value})");
 
 is(textfield(-name     => 'weather',
 	     -value    => 'nice',
 	     -override => 1),
-   qq(<input type="text" name="weather" value="nice" />),
+   qq(<input type="text" name="weather" tabindex="6" value="nice" />),
    "textfield({-name,-value,-override})");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'nice'),
-   qq(<input type="checkbox" name="weather" value="nice" />weather),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />weather</label>),
    "checkbox()");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'nice',
 	    -label => 'forecast'),
-   qq(<input type="checkbox" name="weather" value="nice" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" />forecast</label>),
    "checkbox()");
 
 is(checkbox(-name     => 'weather',
@@ -79,50 +77,53 @@ is(checkbox(-name     => 'weather',
 	    -label    => 'forecast',
 	    -checked  => 1,
 	    -override => 1),
-   qq(<input type="checkbox" name="weather" value="nice" checked="checked" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="9" checked="checked" />forecast</label>),
    "checkbox()");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'dull',
 	    -label => 'forecast'),
-   qq(<input type="checkbox" name="weather" value="dull" checked="checked" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="dull" tabindex="10" checked="checked" />forecast</label>),
    "checkbox()");
 
 is(radio_group(-name => 'game'),
-   qq(<input type="radio" name="game" value="chess" checked="checked" />chess ).
-   qq(<input type="radio" name="game" value="checkers" />checkers),
+   qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="11" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="12" />checkers</label>),
    'radio_group()');
 
 is(radio_group(-name   => 'game',
 	       -labels => {'chess' => 'ping pong'}),
-   qq(<input type="radio" name="game" value="chess" checked="checked" />ping pong ).
-   qq(<input type="radio" name="game" value="checkers" />checkers),
+   qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="13" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="14" />checkers</label>),
    'radio_group()');
 
 is(checkbox_group(-name   => 'game',
 		  -Values => [qw/checkers chess cribbage/]),
-   qq(<input type="checkbox" name="game" value="checkers" checked="checked" />checkers ).
-   qq(<input type="checkbox" name="game" value="chess" checked="checked" />chess ).
-   qq(<input type="checkbox" name="game" value="cribbage" />cribbage),
+   qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="15" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="16" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="17" />cribbage</label>),
    'checkbox_group()');
 
 is(checkbox_group(-name       => 'game',
 		  '-values'   => [qw/checkers chess cribbage/],
-		  '-defaults' => ['cribbage'],-override=>1),
-   qq(<input type="checkbox" name="game" value="checkers" />checkers ).
-   qq(<input type="checkbox" name="game" value="chess" />chess ).
-   qq(<input type="checkbox" name="game" value="cribbage" checked="checked" />cribbage),
+		  '-defaults' => ['cribbage'],
+		  -override=>1),
+   qq(<label><input type="checkbox" name="game" value="checkers" tabindex="18" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="19" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="20" />cribbage</label>),
    'checkbox_group()');
 
 is(popup_menu(-name     => 'game',
 	      '-values' => [qw/checkers chess cribbage/],
 	      -default  => 'cribbage',
-	      -override => 1)."\n",
-   <<END, 'checkbox_group()');
-<select name="game">
+	      -override => 1),
+   '<select name="game" tabindex="21" >
 <option value="checkers">checkers</option>
 <option value="chess">chess</option>
 <option selected="selected" value="cribbage">cribbage</option>
-</select>
-END
-
+</select>',
+   'popup_menu()');
+is(scrolling_list(-name => 'game',
+		  '-values' => [qw/checkers chess cribbage/],
+		  -default => 'cribbage',
+		  -override=>1),
+   '<select name="game" tabindex="22"  size="3">
+<option value="checkers">checkers</option>
+<option value="chess">chess</option>
+<option selected="selected" value="cribbage">cribbage</option>
+</select>',
+  'scrolling_list()');
diff --git a/gnu/usr.bin/perl/lib/CGI/t/html.t b/gnu/usr.bin/perl/lib/CGI/t/html.t
index dbab2fcdfd5..e91ba113f65 100644
--- a/gnu/usr.bin/perl/lib/CGI/t/html.t
+++ b/gnu/usr.bin/perl/lib/CGI/t/html.t
@@ -53,30 +53,37 @@ test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","
 test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
 test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
 test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
-test(13,start_html() ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="iso-8859-1"?>
+test(13,start_html() eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 	 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"><head><title>Untitled Document</title>
-</head><body>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>Untitled Document</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
 END
     ;
-test(14,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="iso-8859-1"?>
+test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 	 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"><head><title>The world of foo</title>
-</head><body>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>The world of foo</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
 END
     ;
 # Note that this test will turn off XHTML until we make a new CGI object.
-test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') ."\n" eq <<END,"start_html()");
+test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//IETF//DTD HTML 3.2//FR">
 <html lang="fr"><head><title>Untitled Document</title>
-</head><body>
+</head>
+<body>
 END
     ;
 test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
diff --git a/gnu/usr.bin/perl/lib/CPAN.pm b/gnu/usr.bin/perl/lib/CPAN.pm
index c2360c81f65..26b8f45ce61 100644
--- a/gnu/usr.bin/perl/lib/CPAN.pm
+++ b/gnu/usr.bin/perl/lib/CPAN.pm
@@ -1,12 +1,12 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.76_01';
+$VERSION = '1.76_02';
 $VERSION = eval $VERSION;
-# $Id: CPAN.pm,v 1.6 2003/12/03 03:02:35 millert Exp $
+# $Id: CPAN.pm,v 1.7 2006/03/28 19:23:05 millert Exp $
 
 # only used during development:
 $Revision = "";
-# $Revision = "[".substr(q$Revision: 1.6 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.7 $, 10)."]";
 
 use Carp ();
 use Config ();
@@ -739,7 +739,6 @@ sub has_inst {
     my $file = $mod;
     my $obj;
     $file =~ s|::|/|g;
-    $file =~ s|/|\\|g if $^O eq 'MSWin32';
     $file .= ".pm";
     if ($INC{$file}) {
 	# checking %INC is wrong, because $INC{LWP} may be true
diff --git a/gnu/usr.bin/perl/lib/CPAN/META.yml b/gnu/usr.bin/perl/lib/CPAN/META.yml
deleted file mode 100644
index 658d5c64b45..00000000000
--- a/gnu/usr.bin/perl/lib/CPAN/META.yml
+++ /dev/null
@@ -1,11 +0,0 @@
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         CPAN
-version:      1.76
-version_from: lib/CPAN.pm
-installdirs:  perl
-requires:
-    Test::More:                    0
-    File::Spec:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.12
diff --git a/gnu/usr.bin/perl/lib/CPAN/t/signature.t b/gnu/usr.bin/perl/lib/CPAN/t/signature.t
deleted file mode 100644
index cf81f88800a..00000000000
--- a/gnu/usr.bin/perl/lib/CPAN/t/signature.t
+++ /dev/null
@@ -1,16 +0,0 @@
-# -*- mode: cperl -*-
-
-use strict;
-print "1..1\n";
-
-if (!eval { require Module::Signature; 1 }) {
-  print "ok 1 # skip - no Module::Signature found\n";
-}
-elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
-  print "ok 1 # skip - Cannot connect to the keyserver";
-}
-else {
-  (Module::Signature::verify() == Module::Signature::SIGNATURE_OK())
-      or print "not ";
-  print "ok 1 # Valid signature\n";
-}
diff --git a/gnu/usr.bin/perl/lib/Carp.pm b/gnu/usr.bin/perl/lib/Carp.pm
index 86f0d921ee2..1a814ead34f 100644
--- a/gnu/usr.bin/perl/lib/Carp.pm
+++ b/gnu/usr.bin/perl/lib/Carp.pm
@@ -1,6 +1,6 @@
 package Carp;
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 =head1 NAME
 
@@ -224,8 +224,8 @@ sub export_fail {
 
 sub longmess {
     {
-	local $@;
-	# XXX fix require to not clear $@?
+	local($@, $!);
+	# XXX fix require to not clear $@ or $!?
 	# don't use require unless we need to (for Safe compartments)
 	require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
     }
@@ -249,8 +249,8 @@ sub longmess {
 
 sub shortmess {	# Short-circuit &longmess if called via multiple packages
     {
-	local $@;
-	# XXX fix require to not clear $@?
+	local($@, $!);
+	# XXX fix require to not clear $@ or $!?
 	# don't use require unless we need to (for Safe compartments)
 	require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
     }
diff --git a/gnu/usr.bin/perl/lib/Class/ISA/test.pl b/gnu/usr.bin/perl/lib/Class/ISA/test.pl
deleted file mode 100644
index b09e2a94a9c..00000000000
--- a/gnu/usr.bin/perl/lib/Class/ISA/test.pl
+++ /dev/null
@@ -1,40 +0,0 @@
-BEGIN {
-	chdir 't' if -d 't';
-	@INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Class::ISA;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
-  @Food::Fish::ISA = qw(Food);
-  @Food::ISA = qw(Matter);
-  @Life::Fungus::ISA = qw(Life);
-  @Chemicals::ISA = qw(Matter);
-  @Life::ISA = qw(Matter);
-  @Matter::ISA = qw();
-
-  use Class::ISA;
-  my @path = Class::ISA::super_path('Food::Fishstick');
-  my $flat_path = join ' ', @path;
-  print "# Food::Fishstick path is:\n# $flat_path\n";
-  print "not " unless
-   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path;
-  print "ok 2\n";
diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm
index febd296bd30..8d25af9f7cd 100644
--- a/gnu/usr.bin/perl/lib/Cwd.pm
+++ b/gnu/usr.bin/perl/lib/Cwd.pm
@@ -1,5 +1,4 @@
 package Cwd;
-$VERSION = $VERSION = '3.01';
 
 =head1 NAME
 
@@ -148,6 +147,19 @@ Originally by the perl5-porters.
 
 Maintained by Ken Williams <KWILLIAMS@cpan.org>
 
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Portions of the C code in this library are copyright (c) 1994 by the
+Regents of the University of California.  All rights reserved.  The
+license on this code is compatible with the licensing of the rest of
+the distribution - please see the source code in F<Cwd.xs> for the
+details.
+
 =head1 SEE ALSO
 
 L<File::chdir>
@@ -156,7 +168,9 @@ L<File::chdir>
 
 use strict;
 use Exporter;
-use vars qw(@ISA @EXPORT @EXPORT_OK);
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
+
+$VERSION = '3.12';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -185,12 +199,21 @@ if ($^O eq 'os2') {
     return 1;
 }
 
+# If loading the XS stuff doesn't work, we can fall back to pure perl
 eval {
+  if ( $] >= 5.006 ) {
     require XSLoader;
-    local $^W = 0;
-    XSLoader::load('Cwd');
+    XSLoader::load( __PACKAGE__, $VERSION );
+  } else {
+    require DynaLoader;
+    push @ISA, 'DynaLoader';
+    __PACKAGE__->bootstrap( $VERSION );
+  }
 };
 
+# Must be after the DynaLoader stuff:
+$VERSION = eval $VERSION;
+
 # Big nasty table of function aliases
 my %METHOD_MAP =
   (
@@ -292,7 +315,10 @@ sub _croak { require Carp; Carp::croak(@_) }
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
-    local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
+    # Localize %ENV entries in a way that won't create new hash keys
+    my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
+    local @ENV{@localize};
+    
     my $cwd = `$pwd_cmd`;
     # Belt-and-suspenders in case someone said "undef $/".
     local $/ = "\n";
@@ -307,7 +333,9 @@ sub _backtick_pwd {
 unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     # The pwd command is not available in some chroot(2)'ed environments
     my $sep = $Config::Config{path_sep} || ':';
-    if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
+    my $os = $^O;  # Protect $^O from tainting
+    if( $os eq 'MacOS' || (defined $ENV{PATH} &&
+			   $os ne 'MSWin32' &&  # no pwd on Windows
 			   grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
     {
 	*cwd = \&_backtick_pwd;
@@ -338,7 +366,7 @@ sub getcwd
 # This is a faster version of getcwd.  It's also more dangerous because
 # you might chdir out of a directory that you can't chdir back into.
     
-sub fastcwd {
+sub fastcwd_ {
     my($odev, $oino, $cdev, $cino, $tdev, $tino);
     my(@path, $path);
     local(*DIR);
@@ -376,6 +404,7 @@ sub fastcwd {
 	if $cdev != $orig_cdev || $cino != $orig_cino;
     $path;
 }
+if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
 
 
 # Keeps track of current working directory in PWD environment var
@@ -449,9 +478,7 @@ sub chdir {
 }
 
 
-# In case the XS version doesn't load.
-*abs_path = \&_perl_abs_path unless defined &abs_path;
-sub _perl_abs_path(;$)
+sub _perl_abs_path
 {
     my $start = @_ ? shift : '.';
     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
@@ -481,7 +508,7 @@ sub _perl_abs_path(;$)
 	    return abs_path($link_target);
 	}
 	
-	return abs_path($dir) . '/' . $file;
+	return $dir ? abs_path($dir) . "/$file" : "/$file";
     }
 
     $cwd = '';
@@ -529,12 +556,9 @@ sub _perl_abs_path(;$)
 }
 
 
-# added function alias for those of us more
-# used to the libc function.  --tchrist 27-Jan-00
-*realpath = \&abs_path;
-
 my $Curdir;
 sub fast_abs_path {
+    local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
     my $cwd = getcwd();
     require File::Spec;
     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
@@ -564,7 +588,9 @@ sub fast_abs_path {
 	    return fast_abs_path($link_target);
 	}
 	
-	return fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
+	return $dir eq File::Spec->rootdir
+	  ? File::Spec->catpath($vol, $dir, $file)
+	  : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
     }
 
     if (!CORE::chdir($path)) {
@@ -619,10 +645,7 @@ sub _win32_cwd {
     return $ENV{'PWD'};
 }
 
-*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 
-                            defined &Win32::GetCwd);
-
-*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
+*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
 
 sub _dos_cwd {
     if (!defined &Dos::GetCwd) {
@@ -651,7 +674,7 @@ sub _qnx_abs_path {
     my $path = @_ ? shift : '.';
     local *REALPATH;
 
-    open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or
+    defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
       die "Can't open /usr/bin/fullpath: $!";
     my $realpath = <REALPATH>;
     close REALPATH;
@@ -671,11 +694,17 @@ sub _epoc_cwd {
 if (exists $METHOD_MAP{$^O}) {
   my $map = $METHOD_MAP{$^O};
   foreach my $name (keys %$map) {
-    no warnings;	# assignments trigger 'subroutine redefined' warning
+    local $^W = 0;  # assignments trigger 'subroutine redefined' warning
     no strict 'refs';
     *{$name} = \&{$map->{$name}};
   }
 }
 
+# In case the XS version doesn't load.
+*abs_path = \&_perl_abs_path unless defined &abs_path;
+
+# added function alias for those of us more
+# used to the libc function.  --tchrist 27-Jan-00
+*realpath = \&abs_path;
 
 1;
diff --git a/gnu/usr.bin/perl/lib/English.pm b/gnu/usr.bin/perl/lib/English.pm
index 6516eb80400..4f287eced2f 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.01';
+our $VERSION = '1.02';
 
 require Exporter;
 @ISA = (Exporter);
@@ -114,6 +114,7 @@ sub import {
 	*PROGRAM_NAME
 	*PERL_VERSION
 	*ACCUMULATOR
+	*COMPILING
 	*DEBUGGING
 	*SYSTEM_FD_MAX
 	*INPLACE_EDIT
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
index 12e2b99ea5a..ecd7813bb31 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
@@ -8,10 +8,11 @@ use File::Compare;
 use File::Basename;
 use File::Path qw(rmtree);
 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.05';
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
+@ISA       = qw(Exporter);
+@EXPORT    = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f chmod 
+                dos2unix);
+$VERSION = '1.09';
 
 my $Is_VMS = $^O eq 'VMS';
 
@@ -21,16 +22,17 @@ 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 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...
+  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  -e chmod mode files...
+  ...
 
 =head1 DESCRIPTION
 
@@ -44,6 +46,8 @@ I<NOT>
 
   perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
 
+For that use L<Shell::Command>.
+
 Filenames with * and ? will be glob expanded.
 
 =over 4
@@ -58,7 +62,9 @@ sub expand_wildcards
 }
 
 
-=item cat 
+=item cat
+
+    cat file ...
 
 Concatenates all files mentioned on command line to STDOUT.
 
@@ -70,9 +76,11 @@ sub cat ()
  print while (<>);
 }
 
-=item eqtime src dst
+=item eqtime
+
+    eqtime source destination
 
-Sets modified time of dst to that of src
+Sets modified time of destination to that of source.
 
 =cut 
 
@@ -83,9 +91,11 @@ sub eqtime
  utime((stat($src))[8,9],$dst);
 }
 
-=item rm_rf files....
+=item rm_rf
 
-Removes directories - recursively (even if readonly)
+    rm_rf files or directories ...
+
+Removes files and directories - recursively (even if readonly)
 
 =cut 
 
@@ -95,26 +105,44 @@ sub rm_rf
  rmtree([grep -e $_,@ARGV],0,0);
 }
 
-=item rm_f files....
+=item rm_f
+
+    rm_f file ...
 
 Removes files (even if readonly)
 
 =cut 
 
-sub rm_f
-{
- expand_wildcards();
- foreach (@ARGV)
-  {
-   next unless -f $_;
-   next if unlink($_);
-   chmod(0777,$_);
-   next if unlink($_);
-   carp "Cannot delete $_:$!";
-  }
+sub rm_f {
+    expand_wildcards();
+
+    foreach my $file (@ARGV) {
+        next unless -f $file;
+
+        next if _unlink($file);
+
+        chmod(0777, $file);
+
+        next if _unlink($file);
+
+        carp "Cannot delete $file: $!";
+    }
 }
 
-=item touch files ...
+sub _unlink {
+    my $files_unlinked = 0;
+    foreach my $file (@_) {
+        my $delete_count = 0;
+        $delete_count++ while unlink $file;
+        $files_unlinked++ if $delete_count;
+    }
+    return $files_unlinked;
+}
+
+
+=item touch
+
+    touch file ...
 
 Makes files exist, with current timestamp 
 
@@ -130,53 +158,94 @@ sub touch {
     }
 }
 
-=item mv source... destination
+=item mv
+
+    mv source_file destination_file
+    mv source_file source_file destination_dir
+
+Moves source to destination.  Multiple sources are allowed if
+destination is an existing directory.
 
-Moves source to destination.
-Multiple sources are allowed if destination is an existing directory.
+Returns true if all moves succeeded, false otherwise.
 
 =cut 
 
 sub mv {
-    my $dst = pop(@ARGV);
     expand_wildcards();
-    croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
-    foreach my $src (@ARGV) {
-        move($src,$dst);
+    my @src = @ARGV;
+    my $dst = pop @src;
+
+    croak("Too many arguments") if (@src > 1 && ! -d $dst);
+
+    my $nok = 0;
+    foreach my $src (@src) {
+        $nok ||= !move($src,$dst);
     }
+    return !$nok;
 }
 
-=item cp source... destination
+=item cp
+
+    cp source_file destination_file
+    cp source_file source_file destination_dir
 
-Copies source to destination.
-Multiple sources are allowed if destination is an existing directory.
+Copies sources to the destination.  Multiple sources are allowed if
+destination is an existing directory.
+
+Returns true if all copies succeeded, false otherwise.
 
 =cut
 
 sub cp {
-    my $dst = pop(@ARGV);
     expand_wildcards();
-    croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
-    foreach my $src (@ARGV) {
-        copy($src,$dst);
+    my @src = @ARGV;
+    my $dst = pop @src;
+
+    croak("Too many arguments") if (@src > 1 && ! -d $dst);
+
+    my $nok = 0;
+    foreach my $src (@src) {
+        $nok ||= !copy($src,$dst);
     }
+    return $nok;
 }
 
-=item chmod mode files...
+=item chmod
+
+    chmod mode files ...
 
 Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
 
 =cut 
 
 sub chmod {
+    local @ARGV = @ARGV;
     my $mode = shift(@ARGV);
     expand_wildcards();
+
+    if( $Is_VMS ) {
+        foreach my $idx (0..$#ARGV) {
+            my $path = $ARGV[$idx];
+            next unless -d $path;
+
+            # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
+            # chmod 0777, [.foo]bar.dir
+            my @dirs = File::Spec->splitdir( $path );
+            $dirs[-1] .= '.dir';
+            $path = File::Spec->catfile(@dirs);
+
+            $ARGV[$idx] = $path;
+        }
+    }
+
     chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
 }
 
-=item mkpath directory...
+=item mkpath
+
+    mkpath directory ...
 
-Creates directory, including any parent directories.
+Creates directories, including any parent directories.
 
 =cut 
 
@@ -186,7 +255,9 @@ sub mkpath
  File::Path::mkpath([@ARGV],0,0777);
 }
 
-=item test_f file
+=item test_f
+
+    test_f file
 
 Tests if a file exists
 
@@ -194,26 +265,55 @@ Tests if a file exists
 
 sub test_f
 {
- exit !-f shift(@ARGV);
+ exit !-f $ARGV[0];
 }
 
+=item dos2unix
 
-1;
-__END__ 
+    dos2unix files or dirs ...
 
-=back
+Converts DOS and OS/2 linefeeds to Unix style recursively.
+
+=cut
 
-=head1 BUGS
+sub dos2unix {
+    require File::Find;
+    File::Find::find(sub {
+        return if -d;
+        return unless -w _;
+        return unless -r _;
+        return if -B _;
+
+        local $\;
+
+	my $orig = $_;
+	my $temp = '.dos2unix_tmp';
+	open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
+	open TEMP, ">$temp" or 
+	    do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
+        while (my $line = <ORIG>) { 
+            $line =~ s/\015\012/\012/g;
+            print TEMP $line;
+        }
+	close ORIG;
+	close TEMP;
+	rename $temp, $orig;
+
+    }, @ARGV);
+}
 
-Should probably be Auto/Self loaded.
+=back
 
 =head1 SEE ALSO 
 
-ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
+Shell::Command which is these same functions but take arguments normally.
+
 
 =head1 AUTHOR
 
-Nick Ing-Simmons <F<nick@ni-s.u-net.com>>.
+Nick Ing-Simmons C<ni-s@cpan.org>
+
+Currently maintained by Michael G Schwern C<schwern@pobox.com>.
 
 =cut
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm b/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
index eedb2684a3e..945a026b161 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
@@ -1,4 +1,4 @@
-# $Id: Embed.pm,v 1.1.1.1 2002/01/16 19:27:19 schwern Exp $
+# $Id: Embed.pm,v 1.6 2003/12/03 03:02:37 millert Exp $
 require 5.002;
 
 package ExtUtils::Embed;
@@ -18,7 +18,7 @@ use vars qw(@ISA @EXPORT $VERSION
 	    );
 use strict;
 
-$VERSION = 1.2506_01;
+$VERSION = 1.26;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(&xsinit &ldopts 
@@ -226,7 +226,10 @@ sub ldopts {
 	$libperl = $Config{libperl};
     }
     else {
-	$libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl";
+	$libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0]
+	    || ($Config{libperl} =~ /^lib(\w+)(\Q$lib_ext\E|\.\Q$Config{dlext}\E)$/
+		? "-l$1" : '')
+	    || "-lperl";
     }
 
     my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
index 18510ade4b7..30740e07312 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
@@ -2,7 +2,7 @@ package ExtUtils::Install;
 
 use 5.00503;
 use vars qw(@ISA @EXPORT $VERSION);
-$VERSION = 1.32;
+$VERSION = '1.33';
 
 use Exporter;
 use Carp ();
@@ -273,12 +273,12 @@ sub install_default {
   @_ < 2 or die "install_default should be called with 0 or 1 argument";
   my $FULLEXT = @_ ? shift : $ARGV[0];
   defined $FULLEXT or die "Do not know to where to write install log";
-  my $INST_LIB = File::Spec->catdir(File::Spec->curdir,"blib","lib");
-  my $INST_ARCHLIB = File::Spec->catdir(File::Spec->curdir,"blib","arch");
-  my $INST_BIN = File::Spec->catdir(File::Spec->curdir,'blib','bin');
-  my $INST_SCRIPT = File::Spec->catdir(File::Spec->curdir,'blib','script');
-  my $INST_MAN1DIR = File::Spec->catdir(File::Spec->curdir,'blib','man1');
-  my $INST_MAN3DIR = File::Spec->catdir(File::Spec->curdir,'blib','man3');
+  my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
+  my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
+  my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
+  my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
+  my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
+  my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
   install({
 	   read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
 	   write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
@@ -398,6 +398,7 @@ sub run_filter {
 
 Copies each key of %from_to to its corresponding value efficiently.
 Filenames with the extension .pm are autosplit into the $autosplit_dir.
+Any destination directories are created.
 
 $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,
@@ -416,19 +417,6 @@ sub pm_to_blib {
     use File::Path qw(mkpath);
     use File::Compare qw(compare);
     use AutoSplit;
-    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
-    # require $my_req; # Hairy, but for the first
-
-    if (!ref($fromto) && -r $fromto)
-     {
-      # Win32 has severe command line length limitations, but
-      # can generate temporary files on-the-fly
-      # so we pass name of file here - eval it to get hash 
-      open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
-      my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
-      eval $str;
-      close(FROMTO);
-     }
 
     mkpath($autodir,0,0755);
     while(my($from, $to) = each %$fromto) {
@@ -533,14 +521,14 @@ Will be prepended to each install path.
 
 Original author lost in the mists of time.  Probably the same as Makemaker.
 
-Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
+Currently maintained by Michael G Schwern C<schwern@pobox.com>
 
-Send patches and ideas to <F<makemaker@perl.org>>.
+Send patches and ideas to C<makemaker@perl.org>.
 
 Send bug reports via http://rt.cpan.org/.  Please send your
 generated Makefile along with your report.
 
-For more up-to-date information, see http://www.makemaker.org.
+For more up-to-date information, see L<http://www.makemaker.org>.
 
 
 =head1 LICENSE
@@ -548,7 +536,7 @@ For more up-to-date information, see http://www.makemaker.org.
 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>
+See L<http://www.perl.com/perl/misc/Artistic.html>
 
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
index b85a0075990..6bfb4a3f0eb 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.04';
+$VERSION = '1.05';
 
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
@@ -32,7 +32,7 @@ the semantics.
 
 =over 4
 
-=item init_dist (o)
+=item init_dist
 
 Define TO_UNIX to convert OS2 linefeeds to Unix style.
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
index 3cd6cd37ce1..dc08990eba5 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
@@ -6,41 +6,48 @@ use strict;
 
 use Exporter ();
 use Carp;
-use Config         qw(%Config);
-use File::Basename qw(basename dirname fileparse);
+use ExtUtils::MakeMaker::Config;
+use File::Basename qw(basename dirname);
 use DirHandle;
 
 use vars qw($VERSION @ISA
-            $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
+            $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos
+            $Is_OSF $Is_IRIX  $Is_NetBSD $Is_BSD
+            $Is_SunOS4 $Is_Solaris $Is_SunOS $Is_Interix
+            $Verbose %pm
             %Config_Override
            );
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue);
 
-$VERSION = '1.42';
+$VERSION = '1.50';
 
 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_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$/;
+BEGIN { 
+    $Is_OS2     = $^O eq 'os2';
+    $Is_Win32   = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare';
+    $Is_Dos     = $^O eq 'dos';
+    $Is_VMS     = $^O eq 'VMS';
+    $Is_OSF     = $^O eq 'dec_osf';
+    $Is_IRIX    = $^O eq 'irix';
+    $Is_NetBSD  = $^O eq 'netbsd';
+    $Is_Interix = $^O eq 'interix';
+    $Is_SunOS4  = $^O eq 'sunos';
+    $Is_Solaris = $^O eq 'solaris';
+    $Is_SunOS   = $Is_SunOS4 || $Is_Solaris;
+    $Is_BSD     = $^O =~ /^(?:free|net|open)bsd$/ or
+                  $^O eq 'bsdos' or $^O eq 'interix';
+}
+
+BEGIN {
+    if( $Is_VMS ) {
+        # For things like vmsify()
+        require VMS::Filespec;
+        VMS::Filespec->import;
+    }
+}
 
 
 =head1 NAME
@@ -82,8 +89,10 @@ 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
-overridable by a platform specific MM_*.pm file (See
-L<ExtUtils::MM_VMS>) and L<ExtUtils::MM_OS2>).
+overridable by a platform specific MM_*.pm file.
+
+Cross-platform methods are being moved into MM_Any.  If you can't find
+something that used to be in here, look in MM_Any.
 
 =cut
 
@@ -98,7 +107,7 @@ my $Updir   = __PACKAGE__->updir;
 
 =over 4
 
-=item os_flavor (o)
+=item os_flavor
 
 Simply says that we're Unix.
 
@@ -265,92 +274,6 @@ MPOLLUTE = $pollute
 
 }
 
-=item clean (o)
-
-Defines the clean target.
-
-=cut
-
-sub clean {
-# --- Cleanup and Distribution Sections ---
-
-    my($self, %attribs) = @_;
-    my(@m,$dir);
-    push(@m, '
-# 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_subdirs
-');
-
-    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
-    if ( $Is_QNX ) {
-      my @errfiles = @{$self->{C}};
-      for ( @errfiles ) {
-	s/.c$/.err/;
-      }
-      push( @otherfiles, @errfiles, 'perlmain.err' );
-    }
-    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
-			 $(BASEEXT).def lib$(BASEEXT).def
-			 $(BASEEXT).exp $(BASEEXT).x
-			]);
-    if( $Is_VOS ) {
-        push(@otherfiles, qw[*.kp]);
-    }
-    else {
-        push(@otherfiles, qw[core core.*perl.*.? *perl.core]);
-
-        # core.\d+
-        push(@otherfiles, map { "core." . "[0-9]"x$_ } (1..5));
-    }
-
-    push @m, "\t-\$(RM_RF) @otherfiles\n";
-    # See realclean and ext/utils/make_ext for usage of Makefile.old
-    push(@m,
-	 "\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)
 
@@ -413,11 +336,18 @@ sub const_loadlibs {
 };
     my($tmp);
     for $tmp (qw/
-	 EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH
+	 EXTRALIBS LDLOADLIBS BSLOADLIBS
 	 /) {
 	next unless defined $self->{$tmp};
 	push @m, "$tmp = $self->{$tmp}\n";
     }
+    # don't set LD_RUN_PATH if empty
+    for $tmp (qw/
+	 LD_RUN_PATH
+	 /) {
+	next unless $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
     return join "", @m;
 }
 
@@ -433,17 +363,18 @@ sub constants {
     my($self) = @_;
     my @m = ();
 
+    $self->{DFSEP} = '$(DIRFILESEP)';  # alias for internal use
+
     for my $macro (qw(
 
-              AR_STATIC_ARGS DIRFILESEP
+              AR_STATIC_ARGS DIRFILESEP DFSEP
               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
-              DESTDIR PREFIX
+              INSTALLDIRS INSTALLBASE DESTDIR PREFIX
               PERLPREFIX      SITEPREFIX      VENDORPREFIX
                    ),
                    (map { ("INSTALL".$_,
@@ -485,8 +416,9 @@ MM_REVISION = $self->{MM_REVISION}
 };
 
     for my $macro (qw/
+              MAKE
 	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
-	      LDFROM LINKTYPE PM_FILTER
+	      LDFROM LINKTYPE BOOTDEP
 	      /	) 
     {
 	next unless defined $self->{$macro};
@@ -506,7 +438,7 @@ MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})."
 
     push @m, q{
 # Where is the Config information that we are using/depend on
-CONFIGDEP = $(PERL_ARCHLIB)$(DIRFILESEP)Config.pm $(PERL_INC)$(DIRFILESEP)config.h
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
 };
 
 
@@ -558,49 +490,6 @@ sub depend {
     join "", @m;
 }
 
-=item dir_target (o)
-
-Takes an array of directories that need to exist and returns a
-Makefile entry for a .exists file in these directories. Returns
-nothing, if the entry has already been processed. We're helpless
-though, if the same directory comes as $(FOO) _and_ as "bar". Both of
-them get an entry, that's why we use "::".
-
-=cut
-
-sub dir_target {
-# --- Make-Directories section (internal method) ---
-# dir_target(@array) returns a Makefile entry for the file .exists in each
-# named directory. Returns nothing, if the entry has already been processed.
-# We're helpless though, if the same directory comes as $(FOO) _and_ as "bar".
-# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the
-# prerequisite, because there has to be one, something that doesn't change
-# too often :)
-
-    my($self,@dirs) = @_;
-    my(@m,$dir,$targdir);
-    foreach $dir (@dirs) {
-	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::;
-	}
-	else { # while elsewhere we expect to see the dir separator in $targ
-	    $targdir = dirname($targ);
-	}
-	next if $self->{DIR_TARGET}{$self}{$targdir}++;
-	push @m, qq{
-$targ :: $src
-	\$(NOECHO) \$(MKPATH) $targdir
-	\$(NOECHO) \$(EQUALIZE_TIMESTAMP) $src $targ
-};
-	push(@m, qq{
-	-\$(NOECHO) \$(CHMOD) \$(PERM_RWX) $targdir
-}) unless $Is_VMS;
-    }
-    join "", @m;
-}
 
 =item init_DEST
 
@@ -939,102 +828,19 @@ shdist : distdir
 MAKE_FRAG
 }
 
-=item distdir
-
-Defines the scratch directory target that will hold the distribution
-before tar-ing (or shar-ing).
-
-=cut
-
-# For backwards compatibility.
-*dist_dir = *distdir;
-
-sub distdir {
-    my($self) = shift;
-
-    return <<'MAKE_FRAG';
-distdir : metafile metafile_addtomanifest
-	$(RM_RF) $(DISTVNAME)
-	$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
-		-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
-
-MAKE_FRAG
-
-}
-
-=item dist_test
-
-Defines a target that produces the distribution in the
-scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that
-subdirectory.
-
-=cut
-
-sub dist_test {
-    my($self) = shift;
-    my @m;
-    push @m, q{
-disttest : distdir
-	cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
-	cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
-	cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
-};
-    join "", @m;
-}
 
 =item dlsyms (o)
 
-Used by AIX and VMS to define DL_FUNCS and DL_VARS and write the *.exp
-files.
+Used by some OS' to define DL_FUNCS and DL_VARS and write the *.exp files.
+
+Normally just returns an empty string.
 
 =cut
 
 sub dlsyms {
-    my($self,%attribs) = @_;
-
-    return '' unless ($Is_AIX && $self->needs_linking() );
-
-    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
-    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
-    my($funclist)  = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
-    my(@m);
-
-    push(@m,"
-dynamic :: $self->{BASEEXT}.exp
-
-") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so...
-
-    push(@m,"
-static :: $self->{BASEEXT}.exp
-
-") unless $self->{SKIPHASH}{'static'};  # we avoid a warning if we tick them
-
-    push(@m,"
-$self->{BASEEXT}.exp: Makefile.PL
-",'	$(PERLRUN) -e \'use ExtUtils::Mksymlists; \\
-	Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
-	neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
-	', "DL_VARS" => ', neatvalue($vars), ');\'
-');
-
-    join('',@m);
+    return '';
 }
 
-=item dynamic (o)
-
-Defines the dynamic target.
-
-=cut
-
-sub dynamic {
-# --- Dynamic Loading Sections ---
-
-    my($self) = shift;
-    '
-dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
-	$(NOECHO) $(NOOP)
-';
-}
 
 =item dynamic_bs (o)
 
@@ -1048,24 +854,26 @@ sub dynamic_bs {
 BOOTSTRAP =
 ' unless $self->has_link_code();
 
-    return <<'MAKE_FRAG';
+    my $target = $Is_VMS ? '$(MMS$TARGET)' : '$@';
+
+    return sprintf <<'MAKE_FRAG', ($target) x 5;
 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): $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
 	$(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
 	$(NOECHO) $(PERLRUN) \
 		"-MExtUtils::Mkbootstrap" \
 		-e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
-	$(NOECHO) $(TOUCH) $(BOOTSTRAP)
-	$(CHMOD) $(PERM_RW) $@
+	$(NOECHO) $(TOUCH) %s
+	$(CHMOD) $(PERM_RW) %s
 
-$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
-	$(NOECHO) $(RM_RF) $(INST_BOOT)
-	-$(CP) $(BOOTSTRAP) $(INST_BOOT)
-	$(CHMOD) $(PERM_RW) $@
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists
+	$(NOECHO) $(RM_RF) %s
+	- $(CP) $(BOOTSTRAP) %s
+	$(CHMOD) $(PERM_RW) %s
 MAKE_FRAG
 }
 
@@ -1097,7 +905,7 @@ OTHERLDFLAGS = '.$ld_opt.$otherldflags.'
 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 INST_DYNAMIC_FIX = '.$ld_fix.'
 
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
 ');
     if ($armaybe ne ':'){
 	$ldfrom = 'tmp$(LIB_EXT)';
@@ -1120,29 +928,34 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILE
 
     my $libs = '$(LDLOADLIBS)';
 
-    if ($Is_NetBSD) {
+    if (($Is_NetBSD || $Is_Interix) && $Config{'useshrplib'}) {
 	# 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
 	# or -R to add paths to the run-time library search path.
-	if ($Config{'useshrplib'}) {
-	    if ($Config{'lddlflags'} =~ /-Wl,-R/) {
-		$libs .= ' -L$(PERL_INC) -Wl,-R$(INSTALLARCHLIB)/CORE -lperl';
-	    } elsif ($Config{'lddlflags'} =~ /-R/) {
-		$libs .= ' -L$(PERL_INC) -R$(INSTALLARCHLIB)/CORE -lperl';
-	    }
-	}
+        if ($Config{'lddlflags'} =~ /-Wl,-R/) {
+            $libs .= ' -L$(PERL_INC) -Wl,-R$(INSTALLARCHLIB)/CORE -Wl,-R$(PERL_ARCHLIB)/CORE -lperl';
+        } elsif ($Config{'lddlflags'} =~ /-R/) {
+            $libs .= ' -L$(PERL_INC) -R$(INSTALLARCHLIB)/CORE -R$(PERL_ARCHLIB)/CORE -lperl';
+        }
     }
 
-    push(@m,
-'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
-' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
-    push @m, '
+    my $ld_run_path_shell = "";
+    if ($self->{LD_RUN_PATH} ne "") {
+	$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
+    }
+
+    push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $libs;
+	%s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) -o $@ $(MYEXTLIB)	\
+	  $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)	\
+	  $(INST_DYNAMIC_FIX)
+MAKE
+
+    push @m, <<'MAKE';
 	$(CHMOD) $(PERM_RWX) $@
-';
+MAKE
 
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
-    join('',@m);
+    return join('',@m);
 }
 
 =item exescan
@@ -1216,7 +1029,7 @@ WARNING
             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}"};
+            my $version_check = qq{$abs -le "require $ver; print qq{VER_OK}"};
             # 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
@@ -1243,28 +1056,6 @@ WARNING
     0; # false and not empty
 }
 
-=item find_tests
-
-  my $test = $mm->find_tests;
-
-Returns a string suitable for feeding to the shell to return all
-tests in t/*.t.
-
-=cut
-
-sub find_tests {
-    my($self) = shift;
-    return 't/*.t';
-}
-
-=back
-
-=head2 Methods to actually produce chunks of text for the Makefile
-
-The methods here are called for each MakeMaker object in the order
-specified by @ExtUtils::MakeMaker::MM_Sections.
-
-=over 2
 
 =item fixin
 
@@ -1347,13 +1138,13 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
 
         chmod 0666, $file_bak;
         unlink $file_bak;
-	unless ( rename($file, $file_bak) ) {	
+	unless ( _rename($file, $file_bak) ) {	
 	    warn "Can't rename $file to $file_bak: $!";
 	    next;
 	}
-	unless ( rename($file_new, $file) ) {	
+	unless ( _rename($file_new, $file) ) {	
 	    warn "Can't rename $file_new to $file: $!";
-	    unless ( rename($file_bak, $file) ) {
+	    unless ( _rename($file_bak, $file) ) {
 	        warn "Can't rename $file_bak back to $file either: $!";
 		warn "Leaving $file renamed as $file_bak\n";
 	    }
@@ -1366,9 +1157,25 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
     }
 }
 
+
+sub _rename {
+    my($old, $new) = @_;
+
+    foreach my $file ($old, $new) {
+        if( $Is_VMS and basename($file) !~ /\./ ) {
+            # rename() in 5.8.0 on VMS will not rename a file if it
+            # does not contain a dot yet it returns success.
+            $file = "$file.";
+        }
+    }
+
+    return rename($old, $new);
+}
+
+
 =item force (o)
 
-Just writes FORCE:
+Writes an empty FORCE: target.
 
 =cut
 
@@ -1431,10 +1238,10 @@ Called by init_main.
 
 sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     my($self) = @_;
-    my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
+    my($name, %dir, %xs, %c, %h, %pl_files, %manifypods);
     my %pm;
 
-    @ignore{qw(Makefile.PL test.pl t)} = (1,1,1);
+    my %ignore = map {( $_ => 1 )} qw(Makefile.PL Build.PL test.pl t);
 
     # ignore the distdir
     $Is_VMS ? $ignore{"$self->{DISTVNAME}.dir"} = 1
@@ -1768,8 +1575,6 @@ sub init_main {
 		&&
 		-s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt')
 		or
-		$Is_Mac
-		or
 		$Is_Win32
 	       ){
 	    warn qq{
@@ -1814,25 +1619,7 @@ from the perl source tree.
 EOP
 	      }
 	    }
-	}
-	
-	unless(-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")))
-        {
-	    die qq{
-Error: Unable to locate installed Perl libraries or Perl source code.
-
-It is recommended that you install perl in a standard location before
-building extensions. Some precompiled versions of perl do not contain
-these header files, so you cannot build extensions. In such a case,
-please build and install your perl from a fresh perl distribution. It
-usually solves this kind of problem.
-
-\(You get this message, because MakeMaker could not find "$perl_h"\)
-};
-	}
-#	 print STDOUT "Using header files found in $self->{PERL_INC}\n"
-#	     if $Verbose && $self->needs_linking();
-
+	}	
     }
 
     # We get SITELIBEXP and SITEARCHEXP directly via
@@ -1944,10 +1731,18 @@ sub init_others {	# --- Initialize Other Attributes
     $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->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE} || 'Makefile';
+    $self->{MAKEFILE}           ||= $self->{FIRST_MAKEFILE};
+    $self->{MAKEFILE_OLD}       ||= $self->{MAKEFILE}.'.old';
+    $self->{MAKE_APERL_FILE}    ||= $self->{MAKEFILE}.'.aperl';
+
+    # Some makes require a wrapper around macros passed in on the command 
+    # line.
+    $self->{MACROSTART}         ||= '';
+    $self->{MACROEND}           ||= '';
+
+    # Not everybody uses -f to indicate "use this Makefile instead"
+    $self->{USEMAKEFILE}        ||= '-f';
 
     $self->{SHELL}              ||= $Config{sh} || '/bin/sh';
 
@@ -1960,9 +1755,9 @@ sub init_others {	# --- Initialize Other Attributes
     $self->{CP}         ||= "cp";
     $self->{MV}         ||= "mv";
     $self->{CHMOD}      ||= "chmod";
-    $self->{MKPATH}     ||= '$(PERLRUN) "-MExtUtils::Command" -e mkpath';
+    $self->{MKPATH}     ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e mkpath';
     $self->{EQUALIZE_TIMESTAMP} ||= 
-      '$(PERLRUN) "-MExtUtils::Command" -e eqtime';
+      '$(ABSPERLRUN) "-MExtUtils::Command" -e eqtime';
 
     $self->{UNINST}     ||= 0;
     $self->{VERBINST}   ||= 0;
@@ -1970,12 +1765,14 @@ sub init_others {	# --- Initialize Other Attributes
       $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->{DOC_INSTALL}        ||= 
+      '$(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install';
+    $self->{UNINSTALL}          ||= 
+      '$(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall';
     $self->{WARN_IF_OLD_PACKLIST} ||= 
-      '$(PERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist';
+      '$(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist';
+    $self->{FIXIN}              ||= 
+      q{$(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"};
 
     $self->{UMASK_NULL}         ||= "umask 0";
     $self->{DEV_NULL}           ||= "> /dev/null 2>&1";
@@ -1983,255 +1780,6 @@ CODE
     return 1;
 }
 
-=item init_INST
-
-    $mm->init_INST;
-
-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} ||= $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
-    # you to build directly into, say $Config{privlibexp}.
-    unless ($self->{INST_LIB}){
-	if ($self->{PERL_CORE}) {
-            if (defined $Cross::platform) {
-                $self->{INST_LIB} = $self->{INST_ARCHLIB} = 
-                  $self->catdir($self->{PERL_LIB},"..","xlib",
-                                     $Cross::platform);
-            }
-            else {
-                $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
-            }
-	} else {
-	    $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
-	}
-    }
-
-    my @parentdir = split(/::/, $self->{PARENT_NAME});
-    $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}  ||= $self->catdir($Curdir,'blib','script');
-
-    $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
-    $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
-
-    return 1;
-}
-
-=item init_INSTALL
-
-    $mm->init_INSTALL;
-
-Called by init_main.  Sets up all INSTALL_* variables (except
-INSTALLDIRS) and *PREFIX.
-
-=cut
-
-sub init_INSTALL {
-    my($self) = shift;
-
-    $self->init_lib2arch;
-
-    # 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} || 
-                  $Config{prefixexp}        || $Config{prefix} || '';
-    my $vprefix = $Config{usevendorprefix}  ? $Config{vendorprefixexp} : '';
-    my $sprefix = $Config{siteprefixexp}    || '';
-
-    # 5.005_03 doesn't have a siteprefix.
-    $sprefix = $iprefix unless $sprefix;
-
-    # There are often no Config.pm defaults for these, but we can make
-    # it up.
-    unless( $Config{installsiteman1dir} ) {
-        $Config_Override{installsiteman1dir} = 
-          $self->catdir($sprefix, 'man', 'man1');
-    }
-
-    unless( $Config{installsiteman3dir} ) {
-        $Config_Override{installsiteman3dir} = 
-          $self->catdir($sprefix, 'man', 'man3');
-    }
-
-    unless( $Config{installsitebin} ) {
-        $Config_Override{installsitebin} =
-          $self->catdir($sprefix, 'bin');
-    }
-
-    $self->{PREFIX}       ||= '';
-
-    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 = $Config{installstyle} || 'lib/perl5';
-    my $manstyle = '';
-
-    if( $self->{LIBSTYLE} ) {
-        $libstyle = $self->{LIBSTYLE};
-        $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : '';
-    }
-
-    # Some systems, like VOS, set installman*dir to '' if they can't
-    # read man pages.
-    for my $num (1, 3) {
-        $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none'
-          unless $Config{'installman'.$num.'dir'};
-    }
-
-    my %bin_layouts = 
-    (
-        bin         => { s => $iprefix,
-                         t => 'perl',
-                         d => 'bin' },
-        vendorbin   => { s => $vprefix,
-                         t => 'vendor',
-                         d => 'bin' },
-        sitebin     => { s => $sprefix,
-                         t => 'site',
-                         d => 'bin' },
-        script      => { s => $iprefix,
-                         t => 'perl',
-                         d => 'bin' },
-    );
-    
-    my %man_layouts =
-    (
-        man1dir         => { s => $iprefix,
-                             t => 'perl',
-                             d => 'man/man1',
-                             style => $manstyle, },
-        siteman1dir     => { s => $sprefix,
-                             t => 'site',
-                             d => 'man/man1',
-                             style => $manstyle, },
-        vendorman1dir   => { s => $vprefix,
-                             t => 'vendor',
-                             d => 'man/man1',
-                             style => $manstyle, },
-
-        man3dir         => { s => $iprefix,
-                             t => 'perl',
-                             d => 'man/man3',
-                             style => $manstyle, },
-        siteman3dir     => { s => $sprefix,
-                             t => 'site',
-                             d => 'man/man3',
-                             style => $manstyle, },
-        vendorman3dir   => { s => $vprefix,
-                             t => 'vendor',
-                             d => 'man/man3',
-                             style => $manstyle, },
-    );
-
-    my %lib_layouts =
-    (
-        privlib     => { s => $iprefix,
-                         t => 'perl',
-                         d => '',
-                         style => $libstyle, },
-        vendorlib   => { s => $vprefix,
-                         t => 'vendor',
-                         d => '',
-                         style => $libstyle, },
-        sitelib     => { s => $sprefix,
-                         t => 'site',
-                         d => 'site_perl',
-                         style => $libstyle, },
-        
-        archlib     => { s => $iprefix,
-                         t => 'perl',
-                         d => "$version/$arch",
-                         style => $libstyle },
-        vendorarch  => { s => $vprefix,
-                         t => 'vendor',
-                         d => "$version/$arch",
-                         style => $libstyle },
-        sitearch    => { s => $sprefix,
-                         t => 'site',
-                         d => "site_perl/$version/$arch",
-                         style => $libstyle },
-    );
-
-
-    # Special case for LIB.
-    if( $self->{LIB} ) {
-        foreach my $var (keys %lib_layouts) {
-            my $Installvar = uc "install$var";
-
-            if( $var =~ /arch/ ) {
-                $self->{$Installvar} ||= 
-                  $self->catdir($self->{LIB}, $Config{archname});
-            }
-            else {
-                $self->{$Installvar} ||= $self->{LIB};
-            }
-        }
-    }
-
-    my %type2prefix = ( perl    => 'PERLPREFIX',
-                        site    => 'SITEPREFIX',
-                        vendor  => 'VENDORPREFIX'
-                      );
-
-    my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
-    while( my($var, $layout) = each(%layouts) ) {
-        my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
-        my $r = '$('.$type2prefix{$t}.')';
-
-        print STDERR "Prefixing $var\n" if $Verbose >= 2;
-
-        my $installvar = "install$var";
-        my $Installvar = uc $installvar;
-        next if $self->{$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
 
@@ -2373,7 +1921,8 @@ sub init_PERL {
     }
 
     # Are we building the core?
-    $self->{PERL_CORE} = 0 unless exists $self->{PERL_CORE};
+    $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE};
+    $self->{PERL_CORE} = 0               unless defined $self->{PERL_CORE};
 
     # How do we run perl?
     foreach my $perl (qw(PERL FULLPERL ABSPERL)) {
@@ -2393,11 +1942,11 @@ sub init_PERL {
 }
 
 
-=item init_platform (o)
+=item init_platform
 
-Add MM_Unix_VERSION.
+=item platform_constants
 
-=item platform_constants (o)
+Add MM_Unix_VERSION.
 
 =cut
 
@@ -2481,16 +2030,22 @@ sub install {
 
     push @m, q{
 install :: all pure_install doc_install
+	$(NOECHO) $(NOOP)
 
 install_perl :: all pure_perl_install doc_perl_install
+	$(NOECHO) $(NOOP)
 
 install_site :: all pure_site_install doc_site_install
+	$(NOECHO) $(NOOP)
 
 install_vendor :: all pure_vendor_install doc_vendor_install
+	$(NOECHO) $(NOOP)
 
 pure_install :: pure_$(INSTALLDIRS)_install
+	$(NOECHO) $(NOOP)
 
 doc_install :: doc_$(INSTALLDIRS)_install
+	$(NOECHO) $(NOOP)
 
 pure__install : pure_site_install
 	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
@@ -2573,6 +2128,7 @@ doc_vendor_install ::
 
     push @m, q{
 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+	$(NOECHO) $(NOOP)
 
 uninstall_from_perldirs ::
 	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
@@ -2595,51 +2151,56 @@ Defines targets to make and to install EXE_FILES.
 
 sub installbin {
     my($self) = shift;
+
     return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
-    return "" unless @{$self->{EXE_FILES}};
-    my(@m, $from, $to, %fromto, @to);
-    push @m, $self->dir_target(qw[$(INST_SCRIPT)]);
-    for $from (@{$self->{EXE_FILES}}) {
+    my @exefiles = @{$self->{EXE_FILES}};
+    return "" unless @exefiles;
+
+    @exefiles = map vmsify($_), @exefiles if $Is_VMS;
+
+    my %fromto;
+    for my $from (@exefiles) {
 	my($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
+
 	local($_) = $path; # for backwards compatibility
-	$to = $self->libscan($path);
+	my $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)"};
+        $to = vmsify($to) if $Is_VMS;
+	$fromto{$from} = $to;
     }
+    my @to   = values %fromto;
 
+    my @m;
     push(@m, qq{
-EXE_FILES = @{$self->{EXE_FILES}}
-
-FIXIN = $fixin
+EXE_FILES = @exefiles
 
 pure_all :: @to
 	\$(NOECHO) \$(NOOP)
 
 realclean ::
-	\$(RM_F) @to
 });
 
-    while (($from,$to) = each %fromto) {
+    # realclean can get rather large.
+    push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to);
+    push @m, "\n";
+
+
+    # A target for each exe file.
+    while (my($from,$to) = each %fromto) {
 	last unless defined $from;
-	my $todir = dirname($to);
-	push @m, "
-$to: $from \$(FIRST_MAKEFILE) " . $self->catdir($todir,'.exists') . "
-	\$(NOECHO) \$(RM_F) $to
-	\$(CP) $from $to
-	\$(FIXIN) $to
-	-\$(NOECHO) \$(CHMOD) \$(PERM_RWX) $to
-";
+
+	push @m, sprintf <<'MAKE', $to, $from, $to, $from, $to, $to, $to;
+%s : %s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
+	$(NOECHO) $(RM_F) %s
+	$(CP) %s %s
+	$(FIXIN) %s
+	-$(NOECHO) $(CHMOD) $(PERM_RWX) %s
+
+MAKE
+
     }
+
     join "", @m;
 }
 
@@ -2725,9 +2286,9 @@ FULLPERL      = $self->{FULLPERL}
     unless ($self->{MAKEAPERL}) {
 	push @m, q{
 $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
-	$(MAKE) -f $(MAKE_APERL_FILE) $@
+	$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
 
-$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
 	$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
 	$(NOECHO) $(PERLRUNINST) \
 		Makefile.PL DIR=}, $dir, q{ \
@@ -2765,12 +2326,16 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
     $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
 
     # Which *.a files could we make use of...
-    local(%static);
+    my %static;
     require File::Find;
     File::Find::find(sub {
 	return unless m/\Q$self->{LIB_EXT}\E$/;
-	return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/;
-	# Skip purified versions of libraries (e.g., DynaLoader_pure_p1_c0_032.a)
+
+        # Skip perl's libraries.
+        return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/;
+
+	# Skip purified versions of libraries 
+        # (e.g., DynaLoader_pure_p1_c0_032.a)
 	return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
 
 	if( exists $self->{INCLUDE_EXT} ){
@@ -2880,8 +2445,8 @@ MAP_LIBPERL = $libperl
 LLIBPERL    = $llibperl
 ";
 
-    push @m, "
-\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)\$(DIRFILESEP).exists ".join(" \\\n\t", @$extra).'
+    push @m, '
+$(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" \\\n\t", @$extra).'
 	$(NOECHO) $(RM_F)  $@
 	$(NOECHO) $(TOUCH) $@
 ';
@@ -2895,13 +2460,13 @@ 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)
 	\$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call'
-	\$(NOECHO) \$(ECHO) '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
+	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
 	\$(NOECHO) \$(ECHO) 'To remove the intermediate files say'
-	\$(NOECHO) \$(ECHO) '    make -f $makefilename map_clean'
+	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename map_clean'
 
 $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
 ";
-    push @m, qq{\tcd $tmp && $cccmd "-I\$(PERL_INC)" perlmain.c\n};
+    push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n";
 
     push @m, qq{
 $tmp/perlmain.c: $makefilename}, q{
@@ -2950,31 +2515,35 @@ Defines how to rewrite the Makefile.
 
 sub makefile {
     my($self) = shift;
-    my @m;
+    my $m;
     # We do not know what target was originally specified so we
     # must force a manual rerun to be sure. But as it should only
     # happen very rarely it is not a significant problem.
-    push @m, '
+    $m = '
 $(OBJECT) : $(FIRST_MAKEFILE)
+
 ' if $self->{OBJECT};
 
-    push @m, q{
+    my $newer_than_target = $Is_VMS ? '$(MMS$SOURCE_LIST)' : '$?';
+    my $mpl_args = join " ", map qq["$_"], @ARGV;
+
+    $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $mpl_args;
 # We take a very conservative approach here, but it's worth it.
 # We move Makefile to Makefile.old here to avoid gnu make looping.
 $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
-	$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+	$(NOECHO) $(ECHO) "Makefile out-of-date with respect to %s"
 	$(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{
+	-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+	-$(NOECHO) $(MV)   $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+	- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+	$(PERLRUN) Makefile.PL %s
 	$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
-	$(NOECHO) $(ECHO) "==> Please rerun the make command.  <=="
+	$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command.  <=="
 	false
 
-};
+MAKE_FRAG
 
-    join "", @m;
+    return $m;
 }
 
 
@@ -3076,6 +2645,7 @@ sub parse_version {
     my $result;
     local *FH;
     local $/ = "\n";
+    local $_;
     open(FH,$parsefile) or die "Could not open '$parsefile': $!";
     my $inpod = 0;
     while (<FH>) {
@@ -3119,11 +2689,16 @@ sub pasthru {
     my($sep) = $Is_VMS ? ',' : '';
     $sep .= "\\\n\t";
 
-    foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE)) {
+    foreach $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE
+                     PREFIX INSTALLBASE)
+                 ) 
+    {
+        next unless defined $self->{$key};
 	push @pasthru, "$key=\"\$($key)\"";
     }
 
     foreach $key (qw(DEFINE INC)) {
+        next unless defined $self->{$key};
 	push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\"";
     }
 
@@ -3155,7 +2730,10 @@ distribution.
 sub perldepend {
     my($self) = shift;
     my(@m);
-    push @m, q{
+
+    my $make_config = $self->cd('$(PERL_SRC)', '$(MAKE) lib/Config.pm');
+
+    push @m, sprintf <<'MAKE_FRAG', $make_config if $self->{PERL_SRC};
 # Check for unpropogated config.sh changes. Should never happen.
 # We do NOT just update config.h because that is not sufficient.
 # An out of date config.h is not fatal but complains loudly!
@@ -3164,8 +2742,8 @@ $(PERL_INC)/config.h: $(PERL_SRC)/config.sh
 
 $(PERL_ARCHLIB)/Config.pm: $(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};
+	%s
+MAKE_FRAG
 
     return join "", @m unless $self->needs_linking;
 
@@ -3263,7 +2841,7 @@ sub pm_to_blib {
     my $self = shift;
     my($autodir) = $self->catdir('$(INST_LIB)','auto');
     my $r = q{
-pm_to_blib: $(TO_INST_PM)
+pm_to_blib : $(TO_INST_PM)
 };
 
     my $pm_to_blib = $self->oneliner(<<CODE, ['-MExtUtils::Install']);
@@ -3273,7 +2851,7 @@ CODE
     my @cmds = $self->split_command($pm_to_blib, %{$self->{PM}});
 
     $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds;
-    $r .= q{	$(NOECHO) $(TOUCH) $@};
+    $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n};
 
     return $r;
 }
@@ -3429,7 +3007,9 @@ sub prefixify {
     print STDERR "  prefixify $var => $path\n" if $Verbose >= 2;
     print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
 
-    if( $path !~ s{^\Q$sprefix\E\b}{$rprefix}s && $self->{ARGS}{PREFIX} ) {
+    if( $self->{ARGS}{PREFIX} && $self->file_name_is_absolute($path) && 
+        $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) 
+    {
 
         print STDERR "    cannot prefix, using default.\n" if $Verbose >= 2;
         print STDERR "    no default!\n" if !$default && $Verbose >= 2;
@@ -3449,25 +3029,52 @@ Defines targets to run *.PL files.
 =cut
 
 sub processPL {
-    my($self) = shift;
-    return "" unless $self->{PL_FILES};
-    my(@m, $plfile);
-    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
-        my $list = ref($self->{PL_FILES}->{$plfile})
-		? $self->{PL_FILES}->{$plfile}
-		: [$self->{PL_FILES}->{$plfile}];
-	my $target;
-	foreach $target (@$list) {
-	push @m, "
+    my $self = shift;
+    my $pl_files = $self->{PL_FILES};
+
+    return "" unless $pl_files;
+
+    my $m = '';
+    foreach my $plfile (sort keys %$pl_files) {
+        my $list = ref($pl_files->{$plfile})
+                     ?  $pl_files->{$plfile}
+		     : [$pl_files->{$plfile}];
+
+	foreach my $target (@$list) {
+            if( $Is_VMS ) {
+                $plfile = vmsify($plfile);
+                $target = vmsify($target);
+            }
+
+	    # Normally a .PL file runs AFTER pm_to_blib so it can have
+	    # blib in its @INC and load the just built modules.  BUT if
+	    # the generated module is something in $(TO_INST_PM) which
+	    # pm_to_blib depends on then it can't depend on pm_to_blib
+	    # else we have a dependency loop.
+	    my $pm_dep;
+	    my $perlrun;
+	    if( defined $self->{PM}{$target} ) {
+		$pm_dep  = '';
+		$perlrun = 'PERLRUN';
+	    }
+	    else {
+		$pm_dep  = 'pm_to_blib';
+		$perlrun = 'PERLRUNINST';
+	    }
+
+            $m .= <<MAKE_FRAG;
+
 all :: $target
 	\$(NOECHO) \$(NOOP)
 
-$target :: $plfile
-	\$(PERLRUNINST) $plfile $target
-";
+$target :: $plfile $pm_dep
+	\$($perlrun) $plfile $target
+MAKE_FRAG
+
 	}
     }
-    join "", @m;
+
+    return $m;
 }
 
 =item quote_paren
@@ -3480,92 +3087,12 @@ but handles simple ones.
 
 sub quote_paren {
     my $arg = shift;
-    $arg =~ s/\$\((.+?)\)/\$\\\\($1\\\\)/g;	# protect $(...)
-    $arg =~ s/(?<!\\)([()])/\\$1/g;		# quote unprotected
-    $arg =~ s/\$\\\\\((.+?)\\\\\)/\$($1)/g;	# unprotect $(...)
+    $arg =~ s{\$\((.+?)\)}{\$\\\\($1\\\\)}g;	# protect $(...)
+    $arg =~ s{(?<!\\)([()])}{\\$1}g;		# quote unprotected
+    $arg =~ s{\$\\\\\((.+?)\\\\\)}{\$($1)}g;	# unprotect $(...)
     return $arg;
 }
 
-=item realclean (o)
-
-Defines the realclean target.
-
-=cut
-
-sub realclean {
-    my($self, %attribs) = @_;
-    my(@m);
-
-    push(@m,'
-# Delete temporary files (via clean) and also delete installed files
-realclean purge ::  clean realclean_subdirs
-	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
-	$(RM_RF) $(DISTVNAME)
-');
-
-    if( $self->has_link_code ){
-        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).
-    my $line = "";
-    foreach my $file (@files) {
-        if (length($line) + length($file) > 200) {
-            push @m, "\t\$(RM_F) $line\n";
-            $line = $file;
-        }
-        else {
-            $line .= " $file"; 
-        }
-    }
-    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);
@@ -3584,7 +3111,20 @@ sub replace_manpage_separator {
 }
 
 
-=item oneliner (o)
+=item cd
+
+=cut
+
+sub cd {
+    my($self, $dir, @cmds) = @_;
+
+    # No leading tab and no trailing newline makes for easier embedding
+    my $make_frag = join "\n\t", map { "cd $dir && $_" } @cmds;
+
+    return $make_frag;
+}
+
+=item oneliner
 
 =cut
 
@@ -3597,12 +3137,12 @@ sub oneliner {
     $cmd =~ s{\n+$}{};
 
     my @cmds = split /\n/, $cmd;
-    $cmd = join " \n\t-e ", map $self->quote_literal($_), @cmds;
+    $cmd = join " \n\t  -e ", map $self->quote_literal($_), @cmds;
     $cmd = $self->escape_newlines($cmd);
 
     $switches = join ' ', @$switches;
 
-    return qq{\$(PERLRUN) $switches -e $cmd};   
+    return qq{\$(ABSPERLRUN) $switches -e $cmd};   
 }
 
 
@@ -3687,7 +3227,7 @@ sub static_lib {
     my(@m);
     push(@m, <<'END');
 
-$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
 	$(RM_RF) $@
 END
 
@@ -3716,7 +3256,6 @@ MAKE_FRAG
 	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
 MAKE_FRAG
 
-    push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
     join('', @m);
 }
 
@@ -3770,11 +3309,16 @@ Helper subroutine for subdirs
 
 sub subdir_x {
     my($self, $subdir) = @_;
-    return sprintf <<'EOT', $subdir;
+
+    my $subdir_cmd = $self->cd($subdir, 
+      '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)'
+    );
+    return sprintf <<'EOT', $subdir_cmd;
 
 subdirs ::
-	$(NOECHO)cd %s && $(MAKE) -f $(FIRST_MAKEFILE) all $(PASTHRU)
+	$(NOECHO) %s
 EOT
+
 }
 
 =item subdirs (o)
@@ -3834,11 +3378,14 @@ testdb :: testdb_\$(LINKTYPE)
 test :: \$(TEST_TYPE)
 ");
 
-    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\$(NOECHO) cd $_ && \$(TEST_F) \$(FIRST_MAKEFILE) && \$(MAKE) test \$(PASTHRU)\n", @{$self->{DIR}}));
+    foreach my $dir (@{ $self->{DIR} }) {
+        my $test = $self->oneliner(sprintf <<'CODE', $dir);
+chdir '%s';  
+system '$(MAKE) test $(PASTHRU)' 
+    if -f '$(FIRST_MAKEFILE)';
+CODE
+
+        push(@m, "\t\$(NOECHO) $test\n");
     }
 
     push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n")
@@ -3903,14 +3450,8 @@ sub test_via_script {
 
     my $make_frag = $MM->tools_other;
 
-Returns a make fragment containing definitions for:
-
-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
-
-init_others() initializes all these values.
+Returns a make fragment containing definitions for the macros init_others() 
+initializes.
 
 =cut
 
@@ -3918,12 +3459,18 @@ sub tools_other {
     my($self) = shift;
     my @m;
 
+    # We set PM_FILTER as late as possible so it can see all the earlier
+    # on macro-order sensitive makes such as nmake.
     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
+		      MACROSTART MACROEND
+                      USEMAKEFILE
+                      PM_FILTER
+                      FIXIN
                     } ) 
     {
         next unless defined $self->{$tool};
@@ -3944,7 +3491,12 @@ sub tool_xsubpp {
     return "" unless $self->needs_linking;
 
     my $xsdir;
-    foreach my $dir (@INC) {
+    my @xsubpp_dirs = @INC;
+
+    # Make sure we pick up the new xsubpp if we're building perl.
+    unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE};
+
+    foreach my $dir (@xsubpp_dirs) {
         $xsdir = $self->catdir($dir, 'ExtUtils');
         if( -r $self->catfile($xsdir, "xsubpp") ) {
             last;
@@ -3970,12 +3522,22 @@ sub tool_xsubpp {
  	unshift( @tmargs, $self->{XSOPT} );
     }
 
+    if ($Is_VMS                          &&
+        $Config{'ldflags'}               && 
+        $Config{'ldflags'} =~ m!/Debug!i &&
+        (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)
+       ) 
+    {
+        unshift(@tmargs,'-nolinenumbers');
+    }
+
 
     $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
 
     return qq{
 XSUBPPDIR = $xsdir
-XSUBPP = \$(XSUBPPDIR)/xsubpp
+XSUBPP = \$(XSUBPPDIR)\$(DFSEP)xsubpp
+XSUBPPRUN = \$(PERLRUN) \$(XSUBPP)
 XSPROTOARG = $self->{XSPROTOARG}
 XSUBPPDEPS = @tmdeps \$(XSUBPP)
 XSUBPPARGS = @tmargs
@@ -4012,7 +3574,7 @@ sub top_targets {
     my(@m);
 
     push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'};
-    
+
     push @m, '
 pure_all :: config pm_to_blib subdirs linkext
 	$(NOECHO) $(NOOP)
@@ -4020,41 +3582,16 @@ pure_all :: config pm_to_blib subdirs linkext
 subdirs :: $(MYEXTLIB)
 	$(NOECHO) $(NOOP)
 
-config :: $(FIRST_MAKEFILE) $(INST_LIBDIR)$(DIRFILESEP).exists
-	$(NOECHO) $(NOOP)
-
-config :: $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
-	$(NOECHO) $(NOOP)
-
-config :: $(INST_AUTODIR)$(DIRFILESEP).exists
+config :: $(FIRST_MAKEFILE) blibdirs
 	$(NOECHO) $(NOOP)
 ';
 
-    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
-
-    if (%{$self->{MAN1PODS}}) {
-	push @m, q[
-config :: $(INST_MAN1DIR)$(DIRFILESEP).exists
-	$(NOECHO) $(NOOP)
-
-];
-	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
-    }
-    if (%{$self->{MAN3PODS}}) {
-	push @m, q[
-config :: $(INST_MAN3DIR)$(DIRFILESEP).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:
+help :
 	perldoc ExtUtils::MakeMaker
 };
 
@@ -4087,7 +3624,7 @@ sub xs_c {
     return '' unless $self->needs_linking();
     '
 .xs.c:
-	$(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
 ';
 }
 
@@ -4102,7 +3639,7 @@ sub xs_cpp {
     return '' unless $self->needs_linking();
     '
 .xs.cpp:
-	$(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp
 ';
 }
 
@@ -4118,7 +3655,7 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
     return '' unless $self->needs_linking();
     '
 .xs$(OBJ_EXT):
-	$(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
 	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
 ';
 }
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
index f9a50831e14..7677420c6ae 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
@@ -1,13 +1,8 @@
-#   MM_VMS.pm
-#   MakeMaker default methods for VMS
-#
-#   Author:  Charles Bailey  bailey@newman.upenn.edu
-
 package ExtUtils::MM_VMS;
 
 use strict;
 
-use Config;
+use ExtUtils::MakeMaker::Config;
 require Exporter;
 
 BEGIN {
@@ -19,15 +14,18 @@ BEGIN {
 }
 
 use File::Basename;
-use vars qw($Revision @ISA $VERSION);
-($VERSION) = '5.70';
-($Revision) = q$Revision: 1.7 $ =~ /Revision:\s+(\S+)/;
+
+# $Revision can't be on the same line or SVN/K gets confused
+use vars qw($Revision
+            $VERSION @ISA);
+$VERSION = '5.73';
 
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
 @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue);
+$Revision = $ExtUtils::MakeMaker::Revision;
 
 
 =head1 NAME
@@ -281,6 +279,51 @@ sub maybe_command {
     return 0;
 }
 
+
+=item pasthru (override)
+
+VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
+options.  This is used in every invokation of make in the VMS Makefile so
+PASTHRU should not be necessary.  Using PASTHRU tends to blow commands past
+the 256 character limit.
+
+=cut
+
+sub pasthru {
+    return "PASTHRU=\n";
+}
+
+
+=item pm_to_blib (override)
+
+VMS wants a dot in every file so we can't have one called 'pm_to_blib',
+it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
+you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
+
+So in VMS its pm_to_blib.ts.
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+
+    my $make = $self->SUPER::pm_to_blib;
+
+    $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
+    $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
+
+    $make = <<'MAKE' . $make;
+# 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)
+
+MAKE
+
+    return $make;
+}
+
+
 =item perl_script (override)
 
 If name passed in doesn't specify a readable file, appends F<.com> or
@@ -297,6 +340,7 @@ sub perl_script {
     return '';
 }
 
+
 =item replace_manpage_separator
 
 Use as separator a character which is legal in a VMS-syntax file name.
@@ -408,14 +452,18 @@ sub init_others {
     $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->{MACROSTART}         ||= '/Macro=(';
+    $self->{MACROEND}           ||= ')';
+    $self->{USEMAKEFILE}        ||= '/Descrip=';
+
+    $self->{ECHO}     ||= '$(ABSPERLRUN) -le "print qq{@ARGV}"';
+    $self->{ECHO_N}   ||= '$(ABSPERLRUN) -e  "print qq{@ARGV}"';
+    $self->{TOUCH}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e touch';
+    $self->{CHMOD}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e chmod'; 
+    $self->{RM_F}     ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_f';
+    $self->{RM_RF}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_rf';
+    $self->{TEST_F}   ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e test_f';
+    $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -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']);
@@ -424,11 +472,18 @@ CODE
 
     $self->{SHELL}    ||= 'Posix';
 
-    $self->{CP} = 'Copy/NoConfirm';
-    $self->{MV} = 'Rename/NoConfirm';
+    $self->SUPER::init_others;
+
+    # So we can copy files into directories with less fuss
+    $self->{CP}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e cp';
+    $self->{MV}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e mv';
+
     $self->{UMASK_NULL} = '! ';  
 
-    $self->SUPER::init_others;
+    # Redirection on VMS goes before the command, not after as on Unix.
+    # $(DEV_NULL) is used once and its not worth going nuts over making
+    # it work.  However, Unix's DEV_NULL is quite wrong for VMS.
+    $self->{DEV_NULL}   = '';
 
     if ($self->{OBJECT} =~ /\s/) {
         $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
@@ -563,6 +618,9 @@ sub constants {
         $self->{$macro} = \@tmp;
     }
 
+    # mms/k does not define a $(MAKE) macro.
+    $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
+
     return $self->SUPER::constants;
 }
 
@@ -724,62 +782,6 @@ sub const_cccmd {
 }
 
 
-=item tool_sxubpp (override)
-
-Use VMS-style quoting on xsubpp command line.
-
-=cut
-
-sub tool_xsubpp {
-    my($self) = @_;
-    return '' unless $self->needs_linking;
-
-    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}}){
-		if( ! -f  $typemap ){
-			warn "Typemap $typemap not found.\n";
-		}
-		else{
-			push(@tmdeps, $self->fixpath($typemap,0));
-		}
-	}
-    }
-    push(@tmdeps, "typemap") if -f "typemap";
-    my(@tmargs) = map("-typemap $_", @tmdeps);
-    if( exists $self->{XSOPT} ){
-	unshift( @tmargs, $self->{XSOPT} );
-    }
-
-    if ($Config{'ldflags'} && 
-        $Config{'ldflags'} =~ m!/Debug!i &&
-        (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)) {
-        unshift(@tmargs,'-nolinenumbers');
-    }
-
-
-    $self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
-
-    return "
-XSUBPPDIR = $xsdir
-XSUBPP = \$(PERLRUN) \$(XSUBPPDIR)xsubpp
-XSPROTOARG = $self->{XSPROTOARG}
-XSUBPPDEPS = @tmdeps
-XSUBPPARGS = @tmargs
-";
-}
-
-
 =item tools_other (override)
 
 Throw in some dubious extra macros for Makefile args.
@@ -795,14 +797,8 @@ sub tools_other {
     # than just typing the literal string.
     my $extra_tools = <<'EXTRA_TOOLS';
 
-# 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 = )
-
 # Just in case anyone is using the old macro.
+USEMACROS = $(MACROSTART)
 SAY = $(ECHO)
 
 EXTRA_TOOLS
@@ -880,7 +876,7 @@ sub xs_c {
     return '' unless $self->needs_linking();
     '
 .xs.c :
-	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
 ';
 }
 
@@ -895,7 +891,7 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
     return '' unless $self->needs_linking();
     '
 .xs$(OBJ_EXT) :
-	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
 	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
 ';
 }
@@ -1006,44 +1002,14 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
 
 ";
     push @m, '
-$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
-	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 	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
 ';
 
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
 
-=item dynamic_bs (override)
-
-Use VMS-style quoting on Mkbootstrap command line.
-
-=cut
-
-sub dynamic_bs {
-    my($self, %attribs) = @_;
-    return '
-BOOTSTRAP =
-' unless $self->has_link_code();
-    '
-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) : $(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)$(DIRFILESEP).exists
-	$(NOECHO) $(RM_RF) $(INST_BOOT)
-	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
-';
-}
 
 =item static_lib (override)
 
@@ -1063,7 +1029,7 @@ $(INST_STATIC) :
     my(@m,$lib);
     push @m,'
 # Rely on suffix rule for update action
-$(OBJECT) : $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+$(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
 
 $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 ';
@@ -1077,7 +1043,7 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
     # 'cause it's a library and you can't stick them in other libraries.
     # In that case, we use $OBJECT instead and hope for the best
     if ($self->{MYEXTLIB}) {
-      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); 
+      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
     } else {
       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
     }
@@ -1086,288 +1052,30 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
     foreach $lib (split ' ', $self->{EXTRALIBS}) {
       push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
     }
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
 
 
-=item processPL (override)
-
-Use VMS-style quoting on command line.
-
-=cut
-
-sub processPL {
-    my($self) = @_;
-    return "" unless $self->{PL_FILES};
-    my(@m, $plfile);
-    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
-        my $list = ref($self->{PL_FILES}->{$plfile})
-		? $self->{PL_FILES}->{$plfile}
-		: [$self->{PL_FILES}->{$plfile}];
-	foreach my $target (@$list) {
-	    my $vmsplfile = vmsify($plfile);
-	    my $vmsfile = vmsify($target);
-	    push @m, "
-all :: $vmsfile
-	\$(NOECHO) \$(NOOP)
-
-$vmsfile :: $vmsplfile
-",'	$(PERLRUNINST) '," $vmsplfile $vmsfile
-";
-	}
-    }
-    join "", @m;
-}
-
-=item installbin (override)
-
-Stay under DCL's 255 character command line limit once again by
-splitting potentially long list of files across multiple lines
-in C<realclean> target.
-
-=cut
-
-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);
-    my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
-    for $from (@exefiles) {
-	my($path) = '$(INST_SCRIPT)' . basename($from);
-	local($_) = $path;  # backward compatibility
-	$to = $self->libscan($path);
-	print "libscan($from) => '$to'\n" if ($Verbose >=2);
-	$fromto{$from} = vmsify($to);
-    }
-    @to = values %fromto;
-    push @m, "
-EXE_FILES = @exefiles
-
-pure_all :: @to
-	\$(NOECHO) \$(NOOP)
-
-realclean ::
-";
-
-    my $line = '';
-    foreach $to (@to) {
-	if (length($line) + length($to) > 80) {
-	    push @m, "\t\$(RM_F) $line\n";
-	    $line = $to;
-	}
-	else { $line .= " $to"; }
-    }
-    push @m, "\t\$(RM_F) $line\n\n" if $line;
-
-    while (($from,$to) = each %fromto) {
-	last unless defined $from;
-	my $todir;
-	if ($to =~ m#[/>:\]]#) {
-            $todir = dirname($to); 
-        }
-	else { 
-            ($todir = $to) =~ s/[^\)]+$//; 
-        }
-	$todir = $self->fixpath($todir,1);
-	push @m, "
-$to : $from \$(FIRST_MAKEFILE) ${todir}\$(DIRFILESEP).exists
-	\$(CP) $from $to
+=item extra_clean_files
 
-", $self->dir_target($todir);
-    }
-    join "", @m;
-}
-
-=item subdir_x (override)
-
-Use VMS commands to change default directory.
+Clean up some OS specific files.  Plus the temp file used to shorten
+a lot of commands.
 
 =cut
 
-sub subdir_x {
-    my($self, $subdir) = @_;
-    my(@m,$key);
-    $subdir = $self->fixpath($subdir,1);
-    push @m, '
-
-subdirs ::
-	olddef = F$Environment("Default")
-	Set Default ',$subdir,'
-	- $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
-	Set Default \'olddef\'
-';
-    join('',@m);
+sub extra_clean_files {
+    return qw(
+              *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
+              .MM_Tmp
+             );
 }
 
-=item clean (override)
 
-Split potentially long list of files across multiple commands (in
-order to stay under the magic command line limit).  Also use MM[SK]
-commands for handling subdirectories.
+=item zipfile_target
 
-=cut
-
-sub clean {
-    my($self, %attribs) = @_;
-    my(@m,$dir);
-    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_subdirs
-';
-    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
-';
-
-    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
-    # 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 @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) 
-                          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'));
+=item tarfile_target
 
-    # Occasionally files are repeated several times from different sources
-    { my(%of) = map { ($_ => 1) } @otherfiles; @otherfiles = keys %of; }
-    
-    my $line = '';
-    foreach my $file (@otherfiles) {
-	$file = $self->fixpath($file);
-	if (length($line) + length($file) > 80) {
-	    push @m, "\t\$(RM_RF) $line\n";
-	    $line = "$file";
-	}
-	else { $line .= " $file"; }
-    }
-    push @m, "\t\$(RM_RF) $line\n" if $line;
-    push(@m, "	$attribs{POSTOP}\n") if $attribs{POSTOP};
-    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.
-
-=cut
-
-sub realclean {
-    my($self, %attribs) = @_;
-    my(@m);
-    push(@m,'
-# Delete temporary files (via clean) and also delete installed files
-realclean :: clean
-');
-    foreach(@{$self->{DIR}}){
-	my($vmsdir) = $self->fixpath($_,1);
-	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";
-    push @m, "	\$(RM_RF) \$(DISTVNAME)\n";
-    # We can't expand several of the MMS macros here, since they don't have
-    # 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,$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) });
-    }
-
-    # Occasionally files are repeated several times from different sources
-    { my(%f) = map { ($_,1) } @files; @files = keys %f; }
-
-    my $line = '';
-    foreach $file (@files) {
-	if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
-	    push @m, "\t\$(RM_F) $line\n";
-	    $line = "$file";
-	    $fcnt = 0;
-	}
-	else { $line .= " $file"; }
-    }
-    push @m, "\t\$(RM_F) $line\n" if $line;
-    if ($attribs{FILES}) {
-	my($word,$key,@filist,@allfiles);
-	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(@allfiles, @{$self->{$key}});
-	    }
-	    else { push(@allfiles, $word); }
-	}
-	$line = '';
-	# Occasionally files are repeated several times from different sources
-	{ my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
-	foreach $file (@allfiles) {
-	    $file = $self->fixpath($file);
-	    if (length($line) + length($file) > 80) {
-		push @m, "\t\$(RM_RF) $line\n";
-		$line = "$file";
-	    }
-	    else { $line .= " $file"; }
-	}
-	push @m, "\t\$(RM_RF) $line\n" if $line;
-    }
-    push(@m, "	$attribs{POSTOP}\n")                     if $attribs{POSTOP};
-    join('', @m);
-}
-
-=item zipfile_target (o)
-
-=item tarfile_target (o)
-
-=item shdist_target (o)
+=item shdist_target
 
 Syntax for invoking shar, tar and zip differs from that for Unix.
 
@@ -1411,25 +1119,6 @@ shdist : distdir
 MAKE_FRAG
 }
 
-=item dist_test (override)
-
-Use VMS commands to change default directory, and use VMS-style
-quoting on command line.
-
-=cut
-
-sub dist_test {
-    my($self) = @_;
-q{
-disttest : distdir
-	startdir = F$Environment("Default")
-	Set Default [.$(DISTVNAME)]
-	$(ABSPERLRUN) Makefile.PL
-	$(MMS)$(MMSQUALIFIERS)
-	$(MMS)$(MMSQUALIFIERS) test
-	Set Default 'startdir'
-};
-}
 
 # --- Test and Installation Sections ---
 
@@ -1442,19 +1131,7 @@ VMS-style command line quoting in a few cases.
 
 sub install {
     my($self, %attribs) = @_;
-    my(@m,@exe_files);
-
-    if ($self->{EXE_FILES}) {
-	my($line,$file) = ('','');
-	foreach $file (@{$self->{EXE_FILES}}) {
-	    $line .= "$file ";
-	    if (length($line) > 128) {
-		push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]);
-		$line = '';
-	    }
-	}
-	push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]) if $line;
-    }
+    my(@m);
 
     push @m, q[
 install :: all pure_install doc_install
@@ -1524,8 +1201,7 @@ doc_perl_install ::
 	$(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) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
 	$(NOECHO) $(RM_F) .MM_tmp
 
 # And again
@@ -1534,8 +1210,7 @@ doc_site_install ::
 	$(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) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
 	$(NOECHO) $(RM_F) .MM_tmp
 
 doc_vendor_install ::
@@ -1543,8 +1218,7 @@ doc_vendor_install ::
 	$(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) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
 	$(NOECHO) $(RM_F) .MM_tmp
 
 ];
@@ -1638,108 +1312,6 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
     join('',@m);
 }
 
-=item makefile (override)
-
-Use VMS commands and quoting.
-
-=cut
-
-sub makefile {
-    my($self) = @_;
-    my(@m,@cmd);
-    # We do not know what target was originally specified so we
-    # must force a manual rerun to be sure. But as it should only
-    # happen very rarely it is not a significant problem.
-    push @m, q[
-$(OBJECT) : $(FIRST_MAKEFILE)
-] if $self->{OBJECT};
-
-    push @m,q[
-# 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) $(ECHO) "$(FIRST_MAKEFILE) has been rebuilt."
-	$(NOECHO) $(ECHO) "Please run $(MMS) to build the extension."
-];
-
-    join('',@m);
-}
-
-=item find_tests (override)
-
-=cut
-
-sub find_tests {
-    my $self = shift;
-    return -d 't' ? 't/*.t' : '';
-}
-
-=item test (override)
-
-Use VMS commands for handling subdirectories.
-
-=cut
-
-sub test {
-    my($self, %attribs) = @_;
-    my($tests) = $attribs{TESTS} || $self->find_tests;
-    my(@m);
-    push @m,"
-TEST_VERBOSE = 0
-TEST_TYPE = test_\$(LINKTYPE)
-TEST_FILE = test.pl
-TESTDB_SW = -d
-
-test :: \$(TEST_TYPE)
-	\$(NOECHO) \$(NOOP)
-
-testdb :: testdb_\$(LINKTYPE)
-	\$(NOECHO) \$(NOOP)
-
-";
-    foreach(@{$self->{DIR}}){
-      my($vmsdir) = $self->fixpath($_,1);
-      push(@m, '	If F$Search("',$vmsdir,'$(FIRST_MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
-           '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\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");
-
-    push(@m, "test_dynamic :: pure_all\n");
-    push(@m, $self->test_via_harness('$(FULLPERLRUN)', $tests)) if $tests;
-    push(@m, $self->test_via_script('$(FULLPERLRUN)', 'test.pl')) if -f "test.pl";
-    push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
-    push(@m, "\n");
-
-    push(@m, "testdb_dynamic :: pure_all\n");
-    push(@m, $self->test_via_script('$(FULLPERLRUN) "$(TESTDB_SW)"', '$(TEST_FILE)'));
-    push(@m, "\n");
-
-    # Occasionally we may face this degenerate target:
-    push @m, "test_ : test_dynamic\n\n";
- 
-    if ($self->needs_linking()) {
-	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
-	push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
-	push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
-	push(@m, "\n");
-	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
-	push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
-	push(@m, "\n");
-    }
-    else {
-	push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
-	push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
-    }
-
-    join('',@m);
-}
 
 =item makeaperl (override)
 
@@ -1777,7 +1349,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
 	push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
 
 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
-	$(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+	$(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
 };
 	push @m, "\n";
 
@@ -1945,9 +1517,9 @@ $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt
 $(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) "    $(MAKE)$(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"
+	$(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
 ';
     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";
@@ -2045,6 +1617,9 @@ sub prefixify {
         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
         $path = $self->_prefixify_default($rprefix, $default);
     }
+    elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
+        # do nothing if there's no prefix or if its relative
+    }
     elsif( $sprefix eq $rprefix ) {
         print STDERR "  no new prefix.\n" if $Verbose >= 2;
     }
@@ -2103,7 +1678,33 @@ sub _catprefix {
 }
 
 
-=item oneliner (o)
+=item cd
+
+=cut
+
+sub cd {
+    my($self, $dir, @cmds) = @_;
+
+    $dir = vmspath($dir);
+
+    my $cmd = join "\n\t", map "$_", @cmds;
+
+    # No leading tab makes it look right when embedded
+    my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
+startdir = F$Environment("Default")
+	Set Default %s
+	%s
+	Set Default 'startdir'
+MAKE_FRAG
+
+    # No trailing newline makes this easier to embed
+    chomp $make_frag;
+
+    return $make_frag;
+}
+
+
+=item oneliner
 
 =cut
 
@@ -2121,11 +1722,11 @@ sub oneliner {
     # Switches must be quoted else they will be lowercased.
     $switches = join ' ', map { qq{"$_"} } @$switches;
 
-    return qq{\$(PERLRUN) $switches -e $cmd};
+    return qq{\$(ABSPERLRUN) $switches -e $cmd};
 }
 
 
-=item B<echo> (o)
+=item B<echo>
 
 perl trips up on "<foo>" thinking it's an input redirect.  So we use the
 native Write command instead.  Besides, its faster.
@@ -2183,7 +1784,7 @@ sub max_exec_len {
     return $self->{_MAX_EXEC_LEN} ||= 256;
 }
 
-=item init_linker (o)
+=item init_linker
 
 =cut
 
@@ -2256,17 +1857,20 @@ sub eliminate_macros {
 
 =item fixpath
 
+   my $path = $mm->fixpath($path);
+   my $path = $mm->fixpath($path, $is_dir);
+
 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.
+fixpath() checks to see whether the result matches the name of a
+directory in the current default directory and returns a directory or
+file specification accordingly.  C<$is_dir> can be set to true to
+force fixpath() to consider the path to be a directory or false to force
+it to be a file.
 
 NOTE:  This is the canonical version of the method.  The version in
 File::Spec::VMS is deprecated.
@@ -2279,10 +1883,10 @@ sub fixpath {
     $self = bless {} unless ref $self;
     my($fixedpath,$prefix,$name);
 
-    if ($path =~ /\s/) {
+    if ($path =~ /[ \t]/) {
       return join ' ',
              map { $self->fixpath($_,$force_path) }
-	     split /\s+/, $path;
+	     split /[ \t]+/, $path;
     }
 
     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
@@ -2333,6 +1937,16 @@ sub os_flavor {
 
 =back
 
+
+=head1 AUTHOR
+
+Original author Charles Bailey F<bailey@newman.upenn.edu>
+
+Maintained by Michael G Schwern F<schwern@pobox.com>
+
+See L<ExtUtils::MakeMaker> for patching and contact information.
+
+
 =cut
 
 1;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
index 8fe0b96d955..4998c74f59d 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
@@ -19,7 +19,7 @@ the semantics.
 
 =cut 
 
-use Config;
+use ExtUtils::MakeMaker::Config;
 use File::Basename;
 use File::Spec;
 use ExtUtils::MakeMaker qw( neatvalue );
@@ -29,7 +29,7 @@ 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.09';
+$VERSION = '1.12';
 
 $ENV{EMXSHELL} = 'sh'; # to run `commands`
 
@@ -121,20 +121,6 @@ sub maybe_command {
 }
 
 
-=item B<find_tests>
-
-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
-
-sub find_tests {
-    return join(' ', <t\\*.t>);
-}
-
-
 =item B<init_DIRFILESEP>
 
 Using \ for Windows.
@@ -171,16 +157,20 @@ sub init_others {
     $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->{TOUCH}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
+    $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod'; 
+    $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
+    $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
+    $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
+    $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
     $self->{NOOP}     ||= 'rem';
-    $self->{TEST_F}   ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
+    $self->{TEST_F}   ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f';
     $self->{DEV_NULL} ||= '> NUL';
 
+    $self->{FIXIN}    ||= $self->{PERL_CORE} ? 
+      "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 
+      'pl2bat.bat';
+
     $self->{LD}     ||= $Config{ld} || 'link';
     $self->{AR}     ||= $Config{ar} || 'lib';
 
@@ -207,11 +197,11 @@ sub init_others {
 }
 
 
-=item init_platform (o)
+=item init_platform
 
 Add MM_Win32_VERSION.
 
-=item platform_constants (o)
+=item platform_constants
 
 =cut
 
@@ -235,7 +225,7 @@ sub platform_constants {
 }
 
 
-=item special_targets (o)
+=item special_targets
 
 Add .USESHELL target for dmake.
 
@@ -254,7 +244,7 @@ MAKE_FRAG
 }
 
 
-=item static_lib (o)
+=item static_lib
 
 Changes how to run the linker.
 
@@ -269,7 +259,7 @@ sub static_lib {
 
     my(@m);
     push(@m, <<'END');
-$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
 	$(RM_RF) $@
 END
 
@@ -292,12 +282,11 @@ q{	$(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
 	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
 MAKE_FRAG
 
-    push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
     join('', @m);
 }
 
 
-=item dynamic_lib (o)
+=item dynamic_lib
 
 Complicated stuff for Win32 that I don't understand. :(
 
@@ -331,7 +320,7 @@ sub dynamic_lib {
 OTHERLDFLAGS = '.$otherldflags.'
 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 ');
     if ($GCC) {
       push(@m,  
@@ -356,28 +345,20 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILE
 	$(CHMOD) $(PERM_RWX) $@
 ';
 
-    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
 
-=item clean
+=item extra_clean_files
 
 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;
-    my $s = $self->SUPER::clean(@_);
-    my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
-    $s .= <<END;
-clean ::
-	-\$(RM_F) $clean
+sub extra_clean_files {
+    my $self = shift;
 
-END
-    return $s;
+    return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
 }
 
 =item init_linker
@@ -409,7 +390,7 @@ sub perl_script {
 }
 
 
-=item xs_o (o)
+=item xs_o
 
 This target is stubbed out.  Not sure why.
 
@@ -420,7 +401,7 @@ sub xs_o {
 }
 
 
-=item pasthru (o)
+=item pasthru
 
 All we send is -nologo to nmake to prevent it from printing its damned
 banner.
@@ -433,7 +414,7 @@ sub pasthru {
 }
 
 
-=item oneliner (o)
+=item oneliner
 
 These are based on what command.com does on Win98.  They may be wrong
 for other Windows shells, I don't know.
@@ -453,7 +434,7 @@ sub oneliner {
 
     $switches = join ' ', @$switches;
 
-    return qq{\$(PERLRUN) $switches -e $cmd};
+    return qq{\$(ABSPERLRUN) $switches -e $cmd};
 }
 
 
@@ -487,6 +468,41 @@ sub escape_newlines {
 }
 
 
+=item cd
+
+dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
+wants:
+
+    cd dir
+    command
+    another_command
+    cd ..
+
+B<NOTE> This cd can only go one level down.  So far this sufficient for
+what MakeMaker needs.
+
+=cut
+
+sub cd {
+    my($self, $dir, @cmds) = @_;
+
+    return $self->SUPER::cd($dir, @cmds) unless $NMAKE;
+
+    my $cmd = join "\n\t", map "$_", @cmds;
+
+    # No leading tab and no trailing newline makes for easier embedding.
+    my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
+cd %s
+	%s
+	cd ..
+MAKE_FRAG
+
+    chomp $make_frag;
+
+    return $make_frag;
+}
+
+
 =item max_exec_len
 
 nmake 1.50 limits command length to 2048 characters.
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
index ad850de27eb..7613b685c68 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
@@ -1,24 +1,29 @@
+# $Id: MakeMaker.pm,v 1.8 2006/03/28 19:23:06 millert Exp $
 package ExtUtils::MakeMaker;
 
 BEGIN {require 5.005_03;}
 
-$VERSION = '6.17';
-($Revision) = q$Revision: 1.7 $ =~ /Revision:\s+(\S+)/;
-
 require Exporter;
-use Config;
+use ExtUtils::MakeMaker::Config;
 use Carp ();
 use File::Path;
 
 use vars qw(
             @ISA @EXPORT @EXPORT_OK
-            $Revision $VERSION $Verbose %Config 
+            $VERSION $Verbose %Config 
             @Prepend_parent @Parent
             %Recognized_Att_Keys @Get_from_Config @MM_Sections @Overridable 
             $Filename
            );
+
+# Has to be on its own line with no $ after it to avoid being noticed by
+# the version control system
+use vars qw($Revision);
 use strict;
 
+$VERSION = '6.30';
+($Revision = q$Revision: 1.8 $) =~ /Revision:\s+(\S+)/;
+
 @ISA = qw(Exporter);
 @EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
 @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists);
@@ -167,9 +172,11 @@ sub eval_in_subdirs {
 
     foreach my $dir (@{$self->{DIR}}){
         my($abs) = $self->catdir($pwd,$dir);
-        $self->eval_in_x($abs);
+        eval { $self->eval_in_x($abs); };
+        last if $@;
     }
     chdir $pwd;
+    die $@ if $@;
 }
 
 sub eval_in_x {
@@ -207,7 +214,7 @@ sub full_setup {
 
     INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR
     INSTALLDIRS
-    DESTDIR PREFIX
+    DESTDIR PREFIX INSTALLBASE
     PERLPREFIX      SITEPREFIX      VENDORPREFIX
     INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
     INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
@@ -226,7 +233,7 @@ sub full_setup {
     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
+    SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
     XS_VERSION clean depend dist dynamic_lib linkext macro realclean
     tool_autosplit
 
@@ -260,12 +267,12 @@ sub full_setup {
 
  special_targets
  c_o xs_c xs_o
- top_targets linkext dlsyms dynamic dynamic_bs
+ top_targets blibdirs linkext dlsyms dynamic dynamic_bs
  dynamic_lib static static_lib manifypods processPL
  installbin subdirs
  clean_subdirs clean realclean_subdirs realclean 
- metafile metafile_addtomanifest
- dist_basics dist_core distdir dist_test dist_ci
+ metafile signature
+ dist_basics dist_core distdir dist_test dist_ci distmeta distsignature
  install force perldepend makefile staticmake test ppd
 
           ); # loses section ordering
@@ -273,7 +280,7 @@ sub full_setup {
     @Overridable = @MM_Sections;
     push @Overridable, qw[
 
- dir_target libscan makeaperl needs_linking perm_rw perm_rwx
+ libscan makeaperl needs_linking perm_rw perm_rwx
  subdir_x test_via_harness test_via_script init_PERL
                          ];
 
@@ -380,7 +387,9 @@ sub new {
     foreach my $prereq (sort keys %{$self->{PREREQ_PM}}) {
         # 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 $file = "$prereq.pm";
+        $file =~ s{::}{/}g;
+        eval { require $file };
 
         my $pr_version = $prereq->VERSION || 0;
 
@@ -1013,7 +1022,7 @@ The generated Makefile enables the user of the extension to invoke
 The Makefile to be produced may be altered by adding arguments of the
 form C<KEY=VALUE>. E.g.
 
-  perl Makefile.PL PREFIX=/tmp/myperl5
+  perl Makefile.PL PREFIX=~
 
 Other interesting targets in the generated Makefile are
 
@@ -1091,6 +1100,15 @@ searched by perl, run
 
     perl -le 'print join $/, @INC'
 
+Sometimes older versions of the module you're installing live in other
+directories in @INC.  Because Perl loads the first version of a module it 
+finds, not the newest, you might accidentally get one of these older
+versions even after installing a brand new version.  To delete I<all other
+versions of the module you're installing> (not simply older ones) set the
+C<UNINST> variable.
+
+    make install UNINST=1
+
 
 =head2 PREFIX and LIB attribute
 
@@ -1355,13 +1373,13 @@ Something like C<"-DHAVE_UNISTD_H">
 
 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.
+would normally go into F</usr/local/lib/perl> you could set DESTDIR=~/tmp/
+and installation would go into F<~/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".
+slash on your DESTDIR.  F<~/tmp/> not F<~/tmp>.
 
 =item DIR
 
@@ -1854,18 +1872,39 @@ See also L<MM_Unix/perm_rwx>.
 
 =item PL_FILES
 
-Ref to hash of files to be processed as perl programs. MakeMaker
-will default to any found *.PL file (except Makefile.PL) being keys
-and the basename of the file being the value. E.g.
+MakeMaker can run programs to generate files for you at build time.
+By default any file named *.PL (except Makefile.PL and Build.PL) in
+the top level directory will be assumed to be a Perl program and run
+passing its own basename in as an argument.  For example...
+
+    perl foo.PL foo
+
+This behavior can be overridden by supplying your own set of files to
+search.  PL_FILES accepts a hash ref, the key being the file to run
+and the value is passed in as the first argument when the PL file is run.
+
+    PL_FILES => {'bin/foobar.PL' => 'bin/foobar'}
+
+Would run bin/foobar.PL like this:
+
+    perl bin/foobar.PL bin/foobar
+
+If multiple files from one program are desired an array ref can be used.
 
-  {'foobar.PL' => 'foobar'}
+    PL_FILES => {'bin/foobar.PL' => [qw(bin/foobar1 bin/foobar2)]}
 
-The *.PL files are expected to produce output to the target files
-themselves. If multiple files can be generated from the same *.PL
-file then the value in the hash can be a reference to an array of
-target file names. E.g.
+In this case the program will be run multiple times using each target file.
+
+    perl bin/foobar.PL bin/foobar1
+    perl bin/foobar.PL bin/foobar2
+
+PL files are normally run B<after> pm_to_blib and include INST_LIB and
+INST_ARCH in its C<@INC> so the just built modules can be
+accessed... unless the PL file is making a module (or anything else in
+PM) in which case it is run B<before> pm_to_blib and does not include
+INST_LIB and INST_ARCH in its C<@INC>.  This apparently odd behavior
+is there for backwards compatibility (and its somewhat DWIM).
 
-  {'foobar.PL' => ['foobar1','foobar2']}
 
 =item PM
 
@@ -1991,6 +2030,17 @@ $Config{installprefix} will be used.
 
 Overridable by PREFIX
 
+=item SIGN
+
+When true, perform the generation and addition to the MANIFEST of the
+SIGNATURE file in the distdir during 'make distdir', via 'cpansign
+-s'.
+
+Note that you need to install the Module::Signature module to
+perform this operation.
+
+Defaults to false.
+
 =item SKIP
 
 Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the
@@ -2040,7 +2090,7 @@ MakeMaker object. The following lines will be parsed o.k.:
 
     $VERSION = '1.00';
     *VERSION = \'1.01';
-    $VERSION = sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)/g;
+    $VERSION = sprintf "%d.%03d", q$Revision: 1.8 $ =~ /(\d+)/g;
     $FOO::VERSION = '1.10';
     *FOO::VERSION = \'1.11';
     our $VERSION = 1.2.3;       # new for perl5.6.0 
@@ -2192,7 +2242,7 @@ for embedding.
 
 If you still need a different solution, try to develop another
 subroutine that fits your needs and submit the diffs to
-F<makemaker@perl.org>
+C<makemaker@perl.org>
 
 For a complete description of all MakeMaker methods see
 L<ExtUtils::MM_Unix>.
@@ -2219,13 +2269,13 @@ Some of the most common mistakes:
 
 =over 2
 
-=item C<<MAN3PODS => ' '>>
+=item C<< MAN3PODS => ' ' >>
 
 This is commonly used to supress the creation of man pages.  MAN3PODS
 takes a hash ref not a string, but the above worked by accident in old
 versions of MakeMaker.
 
-The correct code is C<<MAN3PODS => { }>>.
+The correct code is C<< MAN3PODS => { } >>.
 
 =back
 
@@ -2285,9 +2335,9 @@ 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.
+Additionally, it will create a META.yml module meta-data file in the
+distdir and add this to the distdir's MANFIEST.  You can shut this
+behavior off with the NO_META flag.
 
 =item   make disttest
 
@@ -2431,6 +2481,10 @@ is processed before any actual command line arguments are processed.
 If set to a true value then MakeMaker's prompt function will
 always return the default without waiting for user input.
 
+=item PERL_CORE
+
+Same as the PERL_CORE parameter.  The parameter overrides this.
+
 =back
 
 =head1 SEE ALSO
@@ -2440,26 +2494,26 @@ ExtUtils::Embed
 
 =head1 AUTHORS
 
-Andy Dougherty <F<doughera@lafayette.edu>>, Andreas KE<ouml>nig
-<F<andreas.koenig@mind.de>>, Tim Bunce <F<timb@cpan.org>>.  VMS
-support by Charles Bailey <F<bailey@newman.upenn.edu>>.  OS/2 support
-by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>.
+Andy Dougherty C<doughera@lafayette.edu>, Andreas KE<ouml>nig
+C<andreas.koenig@mind.de>, Tim Bunce C<timb@cpan.org>.  VMS
+support by Charles Bailey C<bailey@newman.upenn.edu>.  OS/2 support
+by Ilya Zakharevich C<ilya@math.ohio-state.edu>.
 
-Currently maintained by Michael G Schwern <F<schwern@pobox.com>>
+Currently maintained by Michael G Schwern C<schwern@pobox.com>
 
-Send patches and ideas to <F<makemaker@perl.org>>.
+Send patches and ideas to C<makemaker@perl.org>.
 
 Send bug reports via http://rt.cpan.org/.  Please send your
 generated Makefile along with your report.
 
-For more up-to-date information, see http://www.makemaker.org.
+For more up-to-date information, see L<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>
+See L<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 df109192a1f..8896c27c5b3 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker/FAQ.pod
@@ -1,6 +1,7 @@
 package ExtUtils::MakeMaker::FAQ;
 
-(our $VERSION) = sprintf "%03d", q$Revision: 1.2 $ =~ /Revision:\s+(\S+)/;
+use vars qw($VERSION);
+$VERSION = '1.11';
 
 1;
 __END__
@@ -13,6 +14,46 @@ ExtUtils::MakeMaker::FAQ - Frequently Asked Questions About MakeMaker
 
 FAQs, tricks and tips for C<ExtUtils::MakeMaker>.
 
+
+=head2 Module Installation
+
+=over 4
+
+=item How do I keep from installing man pages?
+
+Recent versions of MakeMaker will only install man pages on Unix like
+operating systems.
+
+For an individual module:
+
+        perl Makefile.PL INSTALLMAN1DIR=none INSTALLMAN3DIR=none
+
+If you want to suppress man page installation for all modules you have
+to reconfigure Perl and tell it 'none' when it asks where to install
+man pages.
+
+
+=item How do I use a module without installing it?
+
+Two ways.  One is to build the module normally...
+
+        perl Makefile.PL
+        make
+
+...and then set the PERL5LIB environment variable to point at the
+blib/lib and blib/arch directories.
+
+The other is to install the module in a temporary location.
+
+        perl Makefile.PL PREFIX=~/tmp LIB=~/tmp/lib/perl
+
+And then set PERL5LIB to F<~/tmp/lib/perl>.  This works well when you have
+multiple modules to work with.  It also ensures that the module goes
+through its full installation process which may modify it.
+
+=back
+
+
 =head2 Philosophy and History
 
 =over 4
@@ -28,13 +69,13 @@ compatibility.
 Perl is one of the most ported pieces of software ever.  It works on
 operating systems I've never even heard of (see perlport for details).
 It needs a build tool that can work on all those platforms and with
-any wacky C compilers they might have.
+any wacky C compilers and linkers they might have.
 
-No such build tool existed at the time and I only know of one now
-(Module::Build).
+No such build tool exists.  Even make itself has wildly different
+dialects.  So we have to build our own.
 
 
-=item What's Module::Build and how does it relate to MakeMaker?
+=item What is Module::Build and how does it relate to MakeMaker?
 
 Module::Build is a project by Ken Williams to supplant MakeMaker.
 Its primary advantages are:
@@ -52,11 +93,12 @@ Its primary advantages are:
 =back
 
 Module::Build is the official heir apparent to MakeMaker and we
-encourage people to work on M::B rather than spending time improving
-MakeMaker.
+encourage people to work on M::B rather than spending time adding features
+to MakeMaker.
 
 =back
 
+
 =head2 Module Writing
 
 =over 4
@@ -73,22 +115,23 @@ by hand is a pain and you often forget.
 Simplest way to do it automatically is to use your version control
 system's revision number (you are using version control, right?).
 
-In CVS and RCS you use $Z<>Revision$ writing it like so:
+In CVS, RCS and SVN you use $Revision: 1.3 $ (see the documentation of your
+version control system for details) writing it like so:
 
-    $VERSION = sprintf "%d.%03d", q$Revision: 1.2 $ =~ /(\d+)/g;
+    $VERSION = sprintf "%d.%03d", q$Revision: 1.3 $ =~ /(\d+)/g;
 
-Every time the file is checked in the $Z<>Revision$ will be updated,
+Every time the file is checked in the $Revision: 1.3 $ will be updated,
 updating your $VERSION.
 
 In CVS version 1.9 is followed by 1.10.  Since CPAN compares version
 numbers numerically we use a sprintf() to convert 1.9 to 1.009 and
 1.10 to 1.010 which compare properly.
 
-If branches are involved (ie. $Z<>Revision: 1.5.3.4) its a little more
+If branches are involved (ie. $Revision: 1.3 $) its a little more
 complicated.
 
     # must be all on one line or MakeMaker will get confused.
-    $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
+    $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\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 f6dea291d91..0c96f63ca9a 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
@@ -2,8 +2,9 @@ package ExtUtils::Manifest;
 
 require Exporter;
 use Config;
-use File::Find;
+use File::Basename;
 use File::Copy 'copy';
+use File::Find;
 use File::Spec;
 use Carp;
 use strict;
@@ -12,7 +13,7 @@ use vars qw($VERSION @ISA @EXPORT_OK
           $Is_MacOS $Is_VMS 
           $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
 
-$VERSION = 1.42;
+$VERSION = '1.46';
 @ISA=('Exporter');
 @EXPORT_OK = qw(mkmanifest
                 manicheck  filecheck  fullcheck  skipcheck
@@ -29,9 +30,7 @@ $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
 $Quiet = 0;
 $MANIFEST = 'MANIFEST';
 
-my $Filename = __FILE__;
-$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
-                 "$MANIFEST.SKIP";
+$DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
 
 
 =head1 NAME
@@ -367,17 +366,21 @@ sub _maniskip {
 
 =item manicopy
 
-    manicopy($src, $dest_dir);
-    manicopy($src, $dest_dir, $how);
+    manicopy(\%src, $dest_dir);
+    manicopy(\%src, $dest_dir, $how);
+
+Copies the files that are the keys in %src to the $dest_dir.  %src is
+typically returned by the maniread() function.
 
-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
+    manicopy( maniread(), $dest_dir );
+
+This function is useful for producing a directory tree identical to the 
+intended distribution tree. 
+
+$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
+symbolic link to make a tree without any symbolic link.  C<cp> is the 
 default.
 
 =cut
@@ -429,7 +432,7 @@ sub cp_if_diff {
 	if (-e $to) {
 	    unlink($to) or confess "unlink $to: $!";
 	}
-      STRICT_SWITCH: {
+        STRICT_SWITCH: {
 	    best($from,$to), last STRICT_SWITCH if $how eq 'best';
 	    cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 	    ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
@@ -442,43 +445,43 @@ sub cp_if_diff {
 
 sub cp {
     my ($srcFile, $dstFile) = @_;
-    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+    my ($access,$mod) = (stat $srcFile)[8,9];
+
     copy($srcFile,$dstFile);
     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
-    # chmod a+rX-w,go-w
-    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) 
-      unless ($^O eq 'MacOS');
+    _manicopy_chmod($dstFile);
 }
 
+
 sub ln {
     my ($srcFile, $dstFile) = @_;
     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
     link($srcFile, $dstFile);
 
-    # chmod a+r,go-w+X (except "X" only applies to u=x)
-    local($_) = $dstFile;
-    my $mode= 0444 | (stat)[2] & 0700;
-    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
+    unless( _manicopy_chmod($dstFile) ) {
         unlink $dstFile;
         return;
     }
     1;
 }
 
-unless (defined $Config{d_link}) {
-    # Really cool fix from Ilya :)
-    local $SIG{__WARN__} = sub { 
-        warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
-    };
-    *ln = \&cp;
-}
-
-
+# 1) Strip off all group and world permissions.
+# 2) Let everyone read it.
+# 3) If the owner can execute it, everyone can.
+sub _manicopy_chmod {
+    my($file) = shift;
 
+    my $perm = 0444 | (stat $file)[2] & 0700;
+    chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $file );
+}
 
+# Files that are often modified in the distdir.  Don't hard link them.
+my @Exceptions = qw(MANIFEST META.yml SIGNATURE);
 sub best {
     my ($srcFile, $dstFile) = @_;
-    if (-l $srcFile) {
+
+    my $is_exception = grep $srcFile =~ /$_/, @Exceptions;
+    if ($is_exception or !$Config{d_link} or -l $srcFile) {
 	cp($srcFile, $dstFile);
     } else {
 	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
@@ -489,21 +492,21 @@ sub _macify {
     my($file) = @_;
 
     return $file unless $Is_MacOS;
-    
+
     $file =~ s|^\./||;
     if ($file =~ m|/|) {
 	$file =~ s|/+|:|g;
 	$file = ":$file";
     }
-    
+
     $file;
 }
 
 sub _maccat {
     my($f1, $f2) = @_;
-    
+
     return "$f1/$f2" unless $Is_MacOS;
-    
+
     $f1 .= ":$f2";
     $f1 =~ s/([^:]:):/$1/g;
     return $f1;
@@ -513,11 +516,11 @@ sub _unmacify {
     my($file) = @_;
 
     return $file unless $Is_MacOS;
-    
+
     $file =~ s|^:||;
     $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
     $file =~ y|:|/|;
-    
+
     $file;
 }
 
@@ -572,7 +575,7 @@ sub _fix_manifest {
         close MANIFEST;
     }
 }
-        
+
 
 # UNIMPLEMENTED
 sub _normalize {
@@ -584,9 +587,17 @@ sub _normalize {
 
 =head2 MANIFEST
 
+A list of files in the distribution, one file per line.  The MANIFEST
+always uses Unix filepath conventions even if you're not on Unix.  This
+means F<foo/bar> style not F<foo\bar>.
+
 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. 
+file is considered to be a comment.  Any line beginning with # is also
+a comment.
+
+    # this a comment
+    some/file
+    some/other/file            comment about some/file
 
 
 =head2 MANIFEST.SKIP
@@ -595,7 +606,9 @@ The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
 expressions should appear one on each line. Blank lines and lines
 which start with C<#> are skipped.  Use C<\#> if you need a regular
-expression to start with a sharp character. A typical example:
+expression to start with a C<#>.
+
+For example:
 
     # Version control files and dirs.
     \bRCS\b
@@ -686,7 +699,9 @@ L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 
 =head1 AUTHOR
 
-Andreas Koenig <F<andreas.koenig@anima.de>>
+Andreas Koenig C<andreas.koenig@anima.de>
+
+Currently maintained by Michael G Schwern C<schwern@pobox.com>
 
 =cut
 
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t b/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t
deleted file mode 100644
index 2d5b1ee5c1b..00000000000
--- a/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t
+++ /dev/null
@@ -1,109 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        @INC = ('../lib', 'lib');
-    }
-    else {
-        unshift @INC, 't/lib';
-    }
-}
-chdir 't';
-
-use strict;
-use Test::More tests => 9;
-use File::Basename;
-use File::Path;
-use File::Spec;
-
-my %Files = (
-             'Big-Dummy/lib/Big/Dummy.pm'     => <<'END',
-package Big::Dummy;
-
-$VERSION = 0.01;
-
-1;
-END
-
-             'Big-Dummy/Makefile.PL'          => <<'END',
-use ExtUtils::MakeMaker;
-
-printf "Current package is: %s\n", __PACKAGE__;
-
-WriteMakefile(
-    NAME          => 'Big::Dummy',
-    VERSION_FROM  => 'lib/Big/Dummy.pm',
-    PREREQ_PM     => {},
-);
-END
-
-             'Big-Dummy/t/compile.t'          => <<'END',
-print "1..2\n";
-
-print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n";
-print "ok 2 - TEST_VERBOSE\n";
-END
-
-             'Big-Dummy/Liar/t/sanity.t'      => <<'END',
-print "1..3\n";
-
-print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n";
-print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n";
-print "ok 3 - TEST_VERBOSE\n";
-END
-
-             'Big-Dummy/Liar/lib/Big/Liar.pm' => <<'END',
-package Big::Liar;
-
-$VERSION = 0.01;
-
-1;
-END
-
-             'Big-Dummy/Liar/Makefile.PL'     => <<'END',
-use ExtUtils::MakeMaker;
-
-my $mm = WriteMakefile(
-              NAME => 'Big::Liar',
-              VERSION_FROM => 'lib/Big/Liar.pm',
-              _KEEP_AFTER_FLUSH => 1
-             );
-
-print "Big::Liar's vars\n";
-foreach my $key (qw(INST_LIB INST_ARCHLIB)) {
-    print "$key = $mm->{$key}\n";
-}
-END
-
-             'Problem-Module/Makefile.PL'   => <<'END',
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
-    NAME    => 'Problem::Module',
-);
-END
-
-             'Problem-Module/subdir/Makefile.PL'    => <<'END',
-printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have";
-
-warn "I think I'm going to be sick\n";
-die "YYYAaaaakkk\n";
-END
-
-            );
-
-while(my($file, $text) = each %Files) {
-    # Convert to a relative, native file path.
-    $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
-
-    my $dir = dirname($file);
-    mkpath $dir;
-    open(FILE, ">$file");
-    print FILE $text;
-    close FILE;
-
-    ok( -e $file, "$file created" );
-}
-
-
-pass("Setup done");
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t b/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t
deleted file mode 100644
index 69738445966..00000000000
--- a/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        @INC = ('../lib', 'lib');
-    }
-    else {
-        unshift @INC, 't/lib';
-    }
-}
-chdir 't';
-
-
-use strict;
-use Test::More tests => 2;
-use File::Path;
-
-rmtree('Big-Dummy');
-ok(!-d 'Big-Dummy', 'Big-Dummy cleaned up');
-rmtree('Problem-Module');
-ok(!-d 'Problem-Module', 'Problem-Module cleaned up');
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
index 7ae8020e25b..9be40e64ec6 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
+++ b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-csuffix csuffix>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs
 
 =head1 DESCRIPTION
 
@@ -34,6 +34,12 @@ any makefiles generated by MakeMaker.
 
 Adds ``extern "C"'' to the C code.
 
+=item B<-csuffix csuffix>
+
+Set the suffix used for the generated C or C++ code.  Defaults to '.c'
+(even with B<-C++>), but some platforms might want to have e.g. '.cpp'.
+Don't forget the '.' from the front.
+
 =item B<-hiertype>
 
 Retains '::' in type names so that C++ hierachical types can be mapped.
@@ -126,7 +132,7 @@ if ($^O eq 'VMS') {
 
 $FH = 'File0000' ;
 
-$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
+$usage = "Usage: xsubpp [-v] [-C++] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
 
 $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
 
@@ -141,12 +147,14 @@ $Fallback = 'PL_sv_undef';
 
 my $process_inout = 1;
 my $process_argtypes = 1;
+my $csuffix = '.c';
 
 SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $flag = shift @ARGV;
     $flag =~ s/^-// ;
     $spat = quotemeta shift,	next SWITCH	if $flag eq 's';
     $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
+    $csuffix   = shift,	next SWITCH	if $flag eq 'csuffix';
     $hiertype  = 1,	next SWITCH	if $flag eq 'hiertype';
     $WantPrototypes = 0, next SWITCH	if $flag eq 'noprototypes';
     $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
@@ -357,7 +365,7 @@ if ($WantLineNumbers) {
     }
 
     my $cfile = $filename;
-    $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+    $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
     tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile);
     select PSEUDO_STDOUT;
 }
@@ -1059,6 +1067,7 @@ while (fetch_para()) {
     undef(%var_types);
     undef(%defaults);
     undef($class);
+    undef($externC);
     undef($static);
     undef($elipsis);
     undef($wantRETVAL) ;
@@ -1112,7 +1121,8 @@ while (fetch_para()) {
     blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
 	unless @line ;
 
-    $static = 1 if $ret_type =~ s/^static\s+//;
+    $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
+    $static  = 1 if $ret_type =~ s/^static\s+//;
 
     $func_header = shift(@line);
     blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
@@ -1251,8 +1261,11 @@ while (fetch_para()) {
 
     $xsreturn = 1 if $EXPLICIT_RETURN;
 
+    $externC = $externC ? qq[extern "C"] : "";
+
     # print function header
     print Q<<"EOF";
+#$externC
 #XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
 #XS(XS_${Full_func_name})
 #[[
diff --git a/gnu/usr.bin/perl/lib/File/Basename.pm b/gnu/usr.bin/perl/lib/File/Basename.pm
index 887c7bae4a9..837b753972a 100644
--- a/gnu/usr.bin/perl/lib/File/Basename.pm
+++ b/gnu/usr.bin/perl/lib/File/Basename.pm
@@ -1,12 +1,6 @@
-package File::Basename;
-
 =head1 NAME
 
-fileparse - split a pathname into pieces
-
-basename - extract just the filename from a path
-
-dirname - extract just the directory from a path
+File::Basename - Parse file paths into directory, filename and suffix.
 
 =head1 SYNOPSIS
 
@@ -14,120 +8,35 @@ dirname - extract just the directory from a path
 
     ($name,$path,$suffix) = fileparse($fullname,@suffixlist);
     $name = fileparse($fullname,@suffixlist);
-    fileparse_set_fstype($os_string);
+
     $basename = basename($fullname,@suffixlist);
-    $dirname = dirname($fullname);
+    $dirname  = dirname($fullname);
 
-    ($name,$path,$suffix) = fileparse("lib/File/Basename.pm",qr{\.pm});
-    fileparse_set_fstype("VMS");
-    $basename = basename("lib/File/Basename.pm",".pm");
-    $dirname = dirname("lib/File/Basename.pm");
 
 =head1 DESCRIPTION
 
-These routines allow you to parse file specifications into useful
-pieces using the syntax of different operating systems.
-
-=over 4
-
-=item fileparse_set_fstype
-
-You select the syntax via the routine fileparse_set_fstype().
-
-If the argument passed to it contains one of the substrings
-"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification 
-syntax of that operating system is used in future calls to 
-fileparse(), basename(), and dirname().  If it contains none of
-these substrings, Unix syntax is used.  This pattern matching is
-case-insensitive.  If you've selected VMS syntax, and the file
-specification you pass to one of these routines contains a "/",
-they assume you are using Unix emulation and apply the Unix syntax
-rules instead, for that function call only.
-
-If the argument passed to it contains one of the substrings "VMS",
-"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
-matching for suffix removal is performed without regard for case,
-since those systems are not case-sensitive when opening existing files
-(though some of them preserve case on file creation).
-
-If you haven't called fileparse_set_fstype(), the syntax is chosen
-by examining the builtin variable C<$^O> according to these rules.
-
-=item fileparse
-
-The fileparse() routine divides a file specification into three
-parts: a leading B<path>, a file B<name>, and a B<suffix>.  The
-B<path> contains everything up to and including the last directory
-separator in the input file specification.  The remainder of the input
-file specification is then divided into B<name> and B<suffix> based on
-the optional patterns you specify in C<@suffixlist>.  Each element of
-this list can be a qr-quoted pattern (or a string which is interpreted
-as a regular expression), and is matched
-against the end of B<name>.  If this succeeds, the matching portion of
-B<name> is removed and prepended to B<suffix>.  By proper use of
-C<@suffixlist>, you can remove file types or versions for examination.
-
-You are guaranteed that if you concatenate B<path>, B<name>, and
-B<suffix> together in that order, the result will denote the same
-file as the input file specification.
-
-In scalar context, fileparse() returns only the B<name> part of the filename.
+These routines allow you to parse file paths into their directory, filename
+and suffix.
 
-=back
-
-=head1 EXAMPLES
-
-Using Unix file syntax:
-
-    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
-				    qr{\.book\d+});
+B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and
+quirks, of the shell and C functions of the same name.  See each
+function's documentation for details.  If your concern is just parsing
+paths it is safer to use L<File::Spec>'s C<splitpath()> and
+C<splitdir()> methods.
 
-would yield
+It is guaranteed that
 
-    $base eq 'draft'
-    $path eq '/virgil/aeneid/',
-    $type eq '.book7'
+    # Where $path_separator is / for Unix, \ for Windows, etc...
+    dirname($path) . $path_separator . basename($path);
 
-Similarly, using VMS syntax:
+is equivalent to the original path for all systems but VMS.
 
-    ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
-				   qr{\..*});
-
-would yield
-
-    $name eq 'Rhetoric'
-    $dir  eq 'Doc_Root:[Help]'
-    $type eq '.Rnh'
-
-=over
-
-=item C<basename>
-
-The basename() routine returns the first element of the list produced
-by calling fileparse() with the same arguments, except that it always
-quotes metacharacters in the given suffixes.  It is provided for
-programmer compatibility with the Unix shell command basename(1).
-
-=item C<dirname>
-
-The dirname() routine returns the directory portion of the input file
-specification.  When using VMS or MacOS syntax, this is identical to the
-second element of the list produced by calling fileparse() with the same
-input file specification.  (Under VMS, if there is no directory information
-in the input file specification, then the current default device and
-directory are returned.)  When using Unix or MSDOS syntax, the return
-value conforms to the behavior of the Unix shell command dirname(1).  This
-is usually the same as the behavior of fileparse(), but differs in some
-cases.  For example, for the input file specification F<lib/>, fileparse()
-considers the directory name to be F<lib/>, while dirname() considers the
-directory name to be F<.>).
-
-=back
 
 =cut
 
 
-## use strict;
+package File::Basename;
+
 # A bit of juggling to insure that C<use re 'taint';> always works, since
 # File::Basename is used during the Perl build, when the re extension may
 # not be available.
@@ -138,73 +47,104 @@ BEGIN {
 }
 
 
-
+use strict;
 use 5.006;
 use warnings;
 our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.73";
+$VERSION = "2.74";
 
+fileparse_set_fstype($^O);
 
-#   fileparse_set_fstype() - specify OS-based rules used in future
-#                            calls to routines in this package
-#
-#   Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
-#       Any other name uses Unix-style rules and is case-sensitive
 
-sub fileparse_set_fstype {
-  my @old = ($Fileparse_fstype, $Fileparse_igncase);
-  if (@_) {
-    $Fileparse_fstype = $_[0];
-    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
-  }
-  wantarray ? @old : $old[0];
-}
+=over 4
+
+=item C<fileparse>
 
-#   fileparse() - parse file specification
-#
-#   Version 2.4  27-Sep-1996  Charles Bailey  bailey@genetics.upenn.edu
+    my($filename, $directories, $suffix) = fileparse($path);
+    my($filename, $directories, $suffix) = fileparse($path, @suffixes);
+    my $filename                         = fileparse($path, @suffixes);
+
+The C<fileparse()> routine divides a file path into its $directories, $filename
+and (optionally) the filename $suffix.
+
+$directories contains everything up to and including the last
+directory separator in the $path including the volume (if applicable).
+The remainder of the $path is the $filename.
+
+     # On Unix returns ("baz", "/foo/bar/", "")
+     fileparse("/foo/bar/baz");
+
+     # On Windows returns ("baz", "C:\foo\bar\", "")
+     fileparse("C:\foo\bar\baz");
+
+     # On Unix returns ("", "/foo/bar/baz/", "")
+     fileparse("/foo/bar/baz/");
+
+If @suffixes are given each element is a pattern (either a string or a
+C<qr//>) matched against the end of the $filename.  The matching
+portion is removed and becomes the $suffix.
+
+     # On Unix returns ("baz", "/foo/bar", ".txt")
+     fileparse("/foo/bar/baz", qr/\.[^.]*/);
+
+If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
+matching for suffix removal is performed case-insensitively, since
+those systems are not case-sensitive when opening existing files.
+
+You are guaranteed that C<$directories . $filename . $suffix> will
+denote the same location as the original $path.
+
+=cut
 
 
 sub fileparse {
   my($fullname,@suffices) = @_;
+
   unless (defined $fullname) {
       require Carp;
       Carp::croak("fileparse(): need a valid pathname");
   }
-  my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
-  my($dirpath,$tail,$suffix,$basename);
+
+  my $orig_type = '';
+  my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
+
   my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
 
-  if ($fstype =~ /^VMS/i) {
-    if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
-    else {
-      ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
-      $dirpath ||= '';  # should always be defined
-    }
+  if ($type eq "VMS" and $fullname =~ m{/} ) {
+    # We're doing Unix emulation
+    $orig_type = $type;
+    $type = 'Unix';
   }
-  if ($fstype =~ /^MS(DOS|Win32)|epoc/i) {
+
+  my($dirpath, $basename);
+
+  if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
     ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
     $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
   }
-  elsif ($fstype =~ /^os2/i) {
+  elsif ($type eq "OS2") {
     ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
     $dirpath = './' unless $dirpath;	# Can't be 0
     $dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
   }
-  elsif ($fstype =~ /^MacOS/si) {
+  elsif ($type eq "MacOS") {
     ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
     $dirpath = ':' unless $dirpath;
   }
-  elsif ($fstype =~ /^AmigaOS/i) {
+  elsif ($type eq "AmigaOS") {
     ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
     $dirpath = './' unless $dirpath;
   }
-  elsif ($fstype !~ /^VMS/i) {  # default to Unix
+  elsif ($type eq 'VMS' ) {
+    ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
+    $dirpath ||= '';  # should always be defined
+  }
+  else { # Default to Unix semantics.
     ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
-    if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
+    if ($orig_type eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
       # dev:[000000] is top of VMS tree, similar to Unix '/'
       # so strip it off and treat the rest as "normal"
       my $devspec  = $1;
@@ -215,9 +155,11 @@ sub fileparse {
     }
     $dirpath = './' unless $dirpath;
   }
+      
 
+  my $tail   = '';
+  my $suffix = '';
   if (@suffices) {
-    $tail = '';
     foreach $suffix (@suffices) {
       my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
       if ($basename =~ s/$pat//s) {
@@ -227,66 +169,230 @@ sub fileparse {
     }
   }
 
-  $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+  # Ensure taint is propgated from the path to its pieces.
+  $tail .= $taint;
   wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
             : ($basename .= $taint);
 }
 
 
-#   basename() - returns first element of list returned by fileparse()
+
+=item C<basename>
+
+    my $filename = basename($path);
+    my $filename = basename($path, @suffixes);
+
+This function is provided for compatibility with the Unix shell command 
+C<basename(1)>.  It does B<NOT> always return the file name portion of a
+path as you might expect.  To be safe, if you want the file name portion of
+a path use C<fileparse()>.
+
+C<basename()> returns the last level of a filepath even if the last
+level is clearly directory.  In effect, it is acting like C<pop()> for
+paths.  This differs from C<fileparse()>'s behaviour.
+
+    # Both return "bar"
+    basename("/foo/bar");
+    basename("/foo/bar/");
+
+@suffixes work as in C<fileparse()> except all regex metacharacters are
+quoted.
+
+    # These two function calls are equivalent.
+    my $filename = basename("/foo/bar/baz.txt",  ".txt");
+    my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
+
+Also note that in order to be compatible with the shell command,
+C<basename()> does not strip off a suffix if it is identical to the
+remaining characters in the filename.
+
+=cut
+
 
 sub basename {
-  my($name) = shift;
-  (fileparse($name, map("\Q$_\E",@_)))[0];
+  my($path) = shift;
+
+  # From BSD basename(1)
+  # The basename utility deletes any prefix ending with the last slash `/'
+  # character present in string (after first stripping trailing slashes)
+  _strip_trailing_sep($path);
+
+  my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
+
+  # From BSD basename(1)
+  # The suffix is not stripped if it is identical to the remaining 
+  # characters in string.
+  if( length $suffix and !length $basename ) {
+      $basename = $suffix;
+  }
+  
+  # Ensure that basename '/' == '/'
+  if( !length $basename ) {
+      $basename = $dirname;
+  }
+
+  return $basename;
 }
 
 
-#    dirname() - returns device and directory portion of file specification
-#        Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
-#        filespecs except for names ending with a separator, e.g., "/xx/yy/".
-#        This differs from the second element of the list returned
-#        by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and
-#        the last directory name if the filespec ends in a '/' or '\'), is lost.
+
+=item C<dirname>
+
+This function is provided for compatibility with the Unix shell
+command C<dirname(1)> and has inherited some of its quirks.  In spite of
+its name it does B<NOT> always return the directory name as you might
+expect.  To be safe, if you want the directory name of a path use
+C<fileparse()>.
+
+Only on VMS (where there is no ambiguity between the file and directory
+portions of a path) and AmigaOS (possibly due to an implementation quirk in
+this module) does C<dirname()> work like C<fileparse($path)>, returning just the
+$directories.
+
+    # On VMS and AmigaOS
+    my $directories = dirname($path);
+
+When using Unix or MSDOS syntax this emulates the C<dirname(1)> shell function
+which is subtly different from how C<fileparse()> works.  It returns all but
+the last level of a file path even if the last level is clearly a directory.
+In effect, it is not returning the directory portion but simply the path one
+level up acting like C<chop()> for file paths.
+
+Also unlike C<fileparse()>, C<dirname()> does not include a trailing slash on
+its returned path.
+
+    # returns /foo/bar.  fileparse() would return /foo/bar/
+    dirname("/foo/bar/baz");
+
+    # also returns /foo/bar despite the fact that baz is clearly a 
+    # directory.  fileparse() would return /foo/bar/baz/
+    dirname("/foo/bar/baz/");
+
+    # returns '.'.  fileparse() would return 'foo/'
+    dirname("foo/");
+
+Under VMS, if there is no directory information in the $path, then the
+current default device and directory is used.
+
+=cut
+
 
 sub dirname {
-    my($basename,$dirname) = fileparse($_[0]);
-    my($fstype) = $Fileparse_fstype;
+    my $path = shift;
 
-    if ($fstype =~ /VMS/i) { 
-        if ($_[0] =~ m#/#) { $fstype = '' }
-        else { return $dirname || $ENV{DEFAULT} }
+    my($type) = $Fileparse_fstype;
+
+    if( $type eq 'VMS' and $path =~ m{/} ) {
+        # Parse as Unix
+        local($File::Basename::Fileparse_fstype) = '';
+        return dirname($path);
     }
-    if ($fstype =~ /MacOS/i) {
+
+    my($basename, $dirname) = fileparse($path);
+
+    if ($type eq 'VMS') { 
+        $dirname ||= $ENV{DEFAULT};
+    }
+    elsif ($type eq 'MacOS') {
 	if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
-	    $dirname =~ s/([^:]):\z/$1/s;
+            _strip_trailing_sep($dirname);
 	    ($basename,$dirname) = fileparse $dirname;
 	}
 	$dirname .= ":" unless $dirname =~ /:\z/;
     }
-    elsif ($fstype =~ /MS(DOS|Win32)|os2/i) { 
-        $dirname =~ s/([^:])[\\\/]*\z/$1/;
+    elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { 
+        _strip_trailing_sep($dirname);
         unless( length($basename) ) {
 	    ($basename,$dirname) = fileparse $dirname;
-	    $dirname =~ s/([^:])[\\\/]*\z/$1/;
+	    _strip_trailing_sep($dirname);
 	}
     }
-    elsif ($fstype =~ /AmigaOS/i) {
+    elsif ($type eq 'AmigaOS') {
         if ( $dirname =~ /:\z/) { return $dirname }
         chop $dirname;
         $dirname =~ s#[^:/]+\z## unless length($basename);
     }
     else {
-        $dirname =~ s:(.)/*\z:$1:s;
+        _strip_trailing_sep($dirname);
         unless( length($basename) ) {
-	    local($File::Basename::Fileparse_fstype) = $fstype;
 	    ($basename,$dirname) = fileparse $dirname;
-	    $dirname =~ s:(.)/*\z:$1:s;
+	    _strip_trailing_sep($dirname);
 	}
     }
 
     $dirname;
 }
 
-fileparse_set_fstype $^O;
+
+# Strip the trailing path separator.
+sub _strip_trailing_sep  {
+    my $type = $Fileparse_fstype;
+
+    if ($type eq 'MacOS') {
+        $_[0] =~ s/([^:]):\z/$1/s;
+    }
+    elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { 
+        $_[0] =~ s/([^:])[\\\/]*\z/$1/;
+    }
+    else {
+        $_[0] =~ s{(.)/*\z}{$1}s;
+    }
+}
+
+
+=item C<fileparse_set_fstype>
+
+  my $type = fileparse_set_fstype();
+  my $previous_type = fileparse_set_fstype($type);
+
+Normally File::Basename will assume a file path type native to your current
+operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
+With this function you can override that assumption.
+
+Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
+"MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
+"Epoc" and "Unix" (all case-insensitive).  If an unrecognized $type is
+given "Unix" will be assumed.
+
+If you've selected VMS syntax, and the file specification you pass to
+one of these routines contains a "/", they assume you are using Unix
+emulation and apply the Unix syntax rules instead, for that function
+call only.
+
+=back
+
+=cut
+
+
+BEGIN {
+
+my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
+my @Types = (@Ignore_Case, qw(Unix));
+
+sub fileparse_set_fstype {
+    my $old = $Fileparse_fstype;
+
+    if (@_) {
+        my $new_type = shift;
+
+        $Fileparse_fstype = 'Unix';  # default
+        foreach my $type (@Types) {
+            $Fileparse_fstype = $type if $new_type =~ /^$type/i;
+        }
+
+        $Fileparse_igncase = 
+          (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
+    }
+
+    return $old;
+}
+
+}
+
 
 1;
+
+
+=head1 SEE ALSO
+
+L<dirname(1)>, L<basename(1)>, L<File::Spec>
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm
index a43a6c6c8a8..52ba7c6d81a 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.08';
+$VERSION = '2.09';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -74,7 +74,10 @@ sub copy {
 			 : (ref(\$to) eq 'GLOB'));
 
     if ($from eq $to) { # works for references, too
-	croak("'$from' and '$to' are identical (not copied)");
+	carp("'$from' and '$to' are identical (not copied)");
+        # The "copy" was a success as the source and destination contain
+        # the same data.
+        return 1;
     }
 
     if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
@@ -83,7 +86,8 @@ sub copy {
 	if (@fs) {
 	    my @ts = stat($to);
 	    if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
-		croak("'$from' and '$to' are identical (not copied)");
+		carp("'$from' and '$to' are identical (not copied)");
+                return 0;
 	    }
 	}
     }
@@ -178,7 +182,10 @@ sub copy {
 }
 
 sub move {
+    croak("Usage: move(FROM, TO) ") unless @_ == 2;
+
     my($from,$to) = @_;
+
     my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
 
     if (-d $to && ! -d $from) {
@@ -201,7 +208,18 @@ sub move {
                 $tosz2 == $fromsz;                         # it's all there
 
     ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
-    return 1 if copy($from,$to) && unlink($from);
+
+    {
+        local $@;
+        eval {
+            local $SIG{__DIE__};
+            copy($from,$to) or die;
+            my($atime, $mtime) = (stat($from))[8,9];
+            utime($atime, $mtime, $to);
+            unlink($from)   or die;
+        };
+        return 1 unless $@;
+    }
     ($sts,$ossts) = ($! + 0, $^E + 0);
 
     ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm
index 49fa48af9fc..497051e0635 100644
--- a/gnu/usr.bin/perl/lib/File/Find.pm
+++ b/gnu/usr.bin/perl/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
 use strict;
 use warnings;
 use warnings::register;
-our $VERSION = '1.07';
+our $VERSION = '1.10';
 require Exporter;
 require Cwd;
 
@@ -88,23 +88,23 @@ specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
 
 =item C<preprocess>
 
-The value should be a code reference. This code reference is used to 
-preprocess the current directory. The name of the currently processed 
+The value should be a code reference. This code reference is used to
+preprocess the current directory. The name of the currently processed
 directory is in C<$File::Find::dir>. Your preprocessing function is
 called after C<readdir()>, but before the loop that calls the C<wanted()>
-function. It is called with a list of strings (actually file/directory 
-names) and is expected to return a list of strings. The code can be 
-used to sort the file/directory names alphabetically, numerically, 
-or to filter out directory entries based on their name alone. When 
+function. It is called with a list of strings (actually file/directory
+names) and is expected to return a list of strings. The code can be
+used to sort the file/directory names alphabetically, numerically,
+or to filter out directory entries based on their name alone. When
 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
 
 =item C<postprocess>
 
-The value should be a code reference. It is invoked just before leaving 
-the currently processed directory. It is called in void context with no 
-arguments. The name of the current directory is in C<$File::Find::dir>. This 
-hook is handy for summarizing a directory, such as calculating its disk 
-usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a 
+The value should be a code reference. It is invoked just before leaving
+the currently processed directory. It is called in void context with no
+arguments. The name of the current directory is in C<$File::Find::dir>. This
+hook is handy for summarizing a directory, such as calculating its disk
+usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
 no-op.
 
 =item C<follow>
@@ -121,15 +121,20 @@ If either I<follow> or I<follow_fast> is in effect:
 =item *
 
 It is guaranteed that an I<lstat> has been called before the user's
-C<wanted()> function is called. This enables fast file checks involving S< _>.
+C<wanted()> function is called. This enables fast file checks involving S<_>.
+Note that this guarantee no longer holds if I<follow> or I<follow_fast>
+are not set.
 
 =item *
 
 There is a variable C<$File::Find::fullname> which holds the absolute
-pathname of the file with all symbolic links resolved
+pathname of the file with all symbolic links resolved.  If the link is
+a dangling symbolic link, then fullname will be set to C<undef>.
 
 =back
 
+This is a no-op on Win32.
+
 =item C<follow_fast>
 
 This is similar to I<follow> except that it may report some files more
@@ -138,11 +143,13 @@ have to be hashed, this is much cheaper both in space and time.  If
 processing a file more than once (by the user's C<wanted()> function)
 is worse than just taking time, the option I<follow> should be used.
 
+This is also a no-op on Win32.
+
 =item C<follow_skip>
 
 C<follow_skip==1>, which is the default, causes all files which are
 neither directories nor symbolic links to be ignored if they are about
-to be processed a second time. If a directory or a symbolic link 
+to be processed a second time. If a directory or a symbolic link
 are about to be processed a second time, File::Find dies.
 
 C<follow_skip==0> causes File::Find to die if any file is about to be
@@ -170,19 +177,19 @@ C<$_> will be the same as C<$File::Find::name>.
 If find is used in taint-mode (-T command line switch or if EUID != UID
 or if EGID != GID) then internally directory names have to be untainted
 before they can be chdir'ed to. Therefore they are checked against a regular
-expression I<untaint_pattern>.  Note that all names passed to the user's 
-I<wanted()> function are still tainted. If this option is used while 
+expression I<untaint_pattern>.  Note that all names passed to the user's
+I<wanted()> function are still tainted. If this option is used while
 not in taint-mode, C<untaint> is a no-op.
 
 =item C<untaint_pattern>
 
 See above. This should be set using the C<qr> quoting operator.
-The default is set to  C<qr|^([-+@\w./]+)$|>. 
+The default is set to  C<qr|^([-+@\w./]+)$|>.
 Note that the parentheses are vital.
 
 =item C<untaint_skip>
 
-If set, a directory which fails the I<untaint_pattern> is skipped, 
+If set, a directory which fails the I<untaint_pattern> is skipped,
 including all its sub-directories. The default is to 'die' in such a case.
 
 =back
@@ -216,7 +223,7 @@ For example, when examining the file F</some/path/foo.ext> you will have:
     $_                = foo.ext
     $File::Find::name = /some/path/foo.ext
 
-You are chdir()'d toC<$File::Find::dir> when the function is called,
+You are chdir()'d to C<$File::Find::dir> when the function is called,
 unless C<no_chdir> was specified. Note that when changing to
 directories is in effect the root directory (F</>) is a somewhat
 special case inasmuch as the concatenation of C<$File::Find::dir>,
@@ -308,7 +315,7 @@ If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
 Be aware that the option to follow symbolic links can be dangerous.
 Depending on the structure of the directory tree (including symbolic
 links to directories) you might traverse a given (physical) directory
-more than once (only if C<follow_fast> is in effect). 
+more than once (only if C<follow_fast> is in effect).
 Furthermore, deleting or changing files in a symbolically linked directory
 might cause very unpleasant surprises, since you delete or change files
 in an unknown directory.
@@ -325,46 +332,46 @@ Mac OS (Classic) users should note a few differences:
 
 =over 4
 
-=item *   
+=item *
 
-The path separator is ':', not '/', and the current directory is denoted 
-as ':', not '.'. You should be careful about specifying relative pathnames. 
-While a full path always begins with a volume name, a relative pathname 
-should always begin with a ':'.  If specifying a volume name only, a 
+The path separator is ':', not '/', and the current directory is denoted
+as ':', not '.'. You should be careful about specifying relative pathnames.
+While a full path always begins with a volume name, a relative pathname
+should always begin with a ':'.  If specifying a volume name only, a
 trailing ':' is required.
 
-=item *   
+=item *
 
-C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_> 
-contains the name of a directory, that name may or may not end with a 
-':'. Likewise, C<$File::Find::name>, which contains the complete 
-pathname to that directory, and C<$File::Find::fullname>, which holds 
+C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
+contains the name of a directory, that name may or may not end with a
+':'. Likewise, C<$File::Find::name>, which contains the complete
+pathname to that directory, and C<$File::Find::fullname>, which holds
 the absolute pathname of that directory with all symbolic links resolved,
 may or may not end with a ':'.
 
-=item *   
+=item *
 
-The default C<untaint_pattern> (see above) on Mac OS is set to  
+The default C<untaint_pattern> (see above) on Mac OS is set to
 C<qr|^(.+)$|>. Note that the parentheses are vital.
 
-=item *   
+=item *
 
-The invisible system file "Icon\015" is ignored. While this file may 
-appear in every directory, there are some more invisible system files 
-on every volume, which are all located at the volume root level (i.e. 
-"MacintoshHD:"). These system files are B<not> excluded automatically. 
-Your filter may use the following code to recognize invisible files or 
+The invisible system file "Icon\015" is ignored. While this file may
+appear in every directory, there are some more invisible system files
+on every volume, which are all located at the volume root level (i.e.
+"MacintoshHD:"). These system files are B<not> excluded automatically.
+Your filter may use the following code to recognize invisible files or
 directories (requires Mac::Files):
 
  use Mac::Files;
 
- # invisible() --  returns 1 if file/directory is invisible,  
+ # invisible() --  returns 1 if file/directory is invisible,
  # 0 if it's visible or undef if an error occurred
 
- sub invisible($) { 
+ sub invisible($) {
    my $file = shift;
-   my ($fileCat, $fileInfo); 
-   my $invisible_flag =  1 << 14; 
+   my ($fileCat, $fileInfo);
+   my $invisible_flag =  1 << 14;
 
    if ( $fileCat = FSpGetCatInfo($file) ) {
      if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
@@ -374,16 +381,16 @@ directories (requires Mac::Files):
    return undef;
  }
 
-Generally, invisible files are system files, unless an odd application 
-decides to use invisible files for its own purposes. To distinguish 
-such files from system files, you have to look at the B<type> and B<creator> 
-file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and 
-C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes 
+Generally, invisible files are system files, unless an odd application
+decides to use invisible files for its own purposes. To distinguish
+such files from system files, you have to look at the B<type> and B<creator>
+file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
+C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
 (see MacPerl.pm for details).
 
 Files that appear on the desktop actually reside in an (hidden) directory
 named "Desktop Folder" on the particular disk volume. Note that, although
-all desktop files appear to be on the same "virtual" desktop, each disk 
+all desktop files appear to be on the same "virtual" desktop, each disk
 volume actually maintains its own "Desktop Folder" directory.
 
 =back
@@ -443,7 +450,7 @@ sub contract_name {
 
 # return the absolute name of a directory or file
 sub contract_name_Mac {
-    my ($cdir,$fn) = @_; 
+    my ($cdir,$fn) = @_;
     my $abs_name;
 
     if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
@@ -453,8 +460,8 @@ sub contract_name_Mac {
 	    $abs_name = $cdir . $2;
 	    return $abs_name;
 	}
-	else { 
-	    # need to move up the tree, but 
+	else {
+	    # need to move up the tree, but
 	    # only if it's not a volume name
 	    for (my $i=1; $i<$colon_count; $i++) {
 		unless ($cdir =~ /^[^:]+:$/) { # volume name
@@ -482,7 +489,7 @@ sub contract_name_Mac {
 		return $abs_name;
 	    }
 	}
-	else { # argh!, $fn is not a valid directory/file 
+	else { # argh!, $fn is not a valid directory/file
 	     return undef;
 	}
     }
@@ -495,7 +502,7 @@ sub PathCombine($$) {
     if ($Is_MacOS) {
 	# $Name is the resolved symlink (always a full path on MacOS),
 	# i.e. there's no need to call contract_name_Mac()
-	$AbsName = $Name; 
+	$AbsName = $Name;
 
 	# (simple) check for recursion
 	if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
@@ -578,7 +585,7 @@ sub is_tainted_pp {
     local $@;
     eval { eval "# $nada" };
     return length($@) != 0;
-} 
+}
 
 sub _find_opt {
     my $wanted = shift;
@@ -602,8 +609,9 @@ sub _find_opt {
     $pre_process       = $wanted->{preprocess};
     $post_process      = $wanted->{postprocess};
     $no_chdir          = $wanted->{no_chdir};
-    $full_check        = $wanted->{follow};
-    $follow            = $full_check || $wanted->{follow_fast};
+    $full_check        = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
+    $follow            = $^O eq 'MSWin32' ? 0 :
+                             $full_check || $wanted->{follow_fast};
     $follow_skip       = $wanted->{follow_skip};
     $untaint           = $wanted->{untaint};
     $untaint_pat       = $wanted->{untaint_pattern};
@@ -615,21 +623,23 @@ sub _find_opt {
 
     # a symbolic link to a directory doesn't increase the link count
     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
-    
+
     my ($abs_dir, $Is_Dir);
 
     Proc_Top_Item:
     foreach my $TOP (@_) {
 	my $top_item = $TOP;
 
+	($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
+
 	if ($Is_MacOS) {
-	    ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 	    $top_item = ":$top_item"
 		if ( (-d _) && ( $top_item !~ /:/ ) );
+	} elsif ($^O eq 'MSWin32') {
+	    $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
 	}
 	else {
 	    $top_item =~ s|/\z|| unless $top_item eq '/';
-	    ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 	}
 
 	$Is_Dir= 0;
@@ -767,6 +777,8 @@ sub _find_dir($$$) {
 
     if ($Is_MacOS) {
 	$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
+    } elsif ($^O eq 'MSWin32') {
+	$dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
     }
     else {
 	$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
@@ -802,8 +814,8 @@ sub _find_dir($$$) {
 
     while (defined $SE) {
 	unless ($bydepth) {
-	    $dir= $p_dir; # $File::Find::dir 
-	    $name= $dir_name; # $File::Find::name 
+	    $dir= $p_dir; # $File::Find::dir
+	    $name= $dir_name; # $File::Find::name
 	    $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
 	    # prune may happen here
 	    $prune= 0;
@@ -825,7 +837,7 @@ sub _find_dir($$$) {
 			    die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
 			}
 		    } else { # $untaint_skip == 1
-			next; 
+			next;
 		    }
 		}
 	    }
@@ -846,7 +858,7 @@ sub _find_dir($$$) {
 	    $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
 	}
 
-	$dir= $dir_name; # $File::Find::dir 
+	$dir= $dir_name; # $File::Find::dir
 
 	# Get the list of files in the current directory.
 	unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
@@ -936,6 +948,10 @@ sub _find_dir($$$) {
 		$dir_name = "$p_dir$dir_rel";
 		$dir_pref = "$dir_name:";
 	    }
+	    elsif ($^O eq 'MSWin32') {
+		$dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
+		$dir_pref = "$dir_name/";
+	    }
 	    else {
 		$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
 		$dir_pref = "$dir_name/";
@@ -1014,8 +1030,8 @@ sub _find_dir_symlnk($$$) {
 	if (( $untaint ) && (is_tainted($dir_loc) )) {
 	    ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
 	     # once untainted, $updir_loc is pushed on the stack (as parent directory);
-	    # hence, we don't need to untaint the parent directory every time we chdir 
-	    # to it later 
+	    # hence, we don't need to untaint the parent directory every time we chdir
+	    # to it later
 	    unless (defined $updir_loc) {
 		if ($untaint_skip == 0) {
 		    die "directory $dir_loc is still tainted";
@@ -1063,7 +1079,7 @@ sub _find_dir_symlnk($$$) {
 	unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
 	    $updir_loc = $dir_loc;
 	    if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
-		# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir 
+		# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
 		( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
 		unless (defined $updir_loc) {
 		    if ($untaint_skip == 0) {
@@ -1101,13 +1117,27 @@ sub _find_dir_symlnk($$$) {
 	    $new_loc = Follow_SymLink($loc_pref.$FN);
 
 	    # ignore if invalid symlink
-	    next unless defined $new_loc;
+	    unless (defined $new_loc) {
+	        if ($dangling_symlinks) {
+	            if (ref $dangling_symlinks eq 'CODE') {
+	                $dangling_symlinks->($FN, $dir_pref);
+	            } else {
+	                warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
+	            }
+	        }
+
+	        $fullname = undef;
+	        $name = $dir_pref . $FN;
+	        $_ = ($no_chdir ? $name : $FN);
+	        { $wanted_callback->() };
+	        next;
+	    }
 
 	    if (-d _) {
 		push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
 	    }
 	    else {
-		$fullname = $new_loc; # $File::Find::fullname 
+		$fullname = $new_loc; # $File::Find::fullname
 		$name = $dir_pref . $FN; # $File::Find::name
 		$_ = ($no_chdir ? $name : $FN); # $_
 		{ $wanted_callback->() }; # protect against wild "next"
@@ -1132,7 +1162,7 @@ sub _find_dir_symlnk($$$) {
 	    }
 	    if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
 		unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
-		    unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted 
+		    unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
 			warnings::warnif "Can't cd to $updir_loc: $!\n";
 			next;
 		    }
@@ -1177,7 +1207,7 @@ sub wrap_wanted {
 	    $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
 	}
 	if ( $wanted->{untaint} ) {
-	    $wanted->{untaint_pattern} = $File::Find::untaint_pattern  
+	    $wanted->{untaint_pattern} = $File::Find::untaint_pattern
 		unless defined $wanted->{untaint_pattern};
 	    $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
 	}
@@ -1221,7 +1251,7 @@ $File::Find::current_dir = File::Spec->curdir || '.';
 
 $File::Find::dont_use_nlink = 1
     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
-       $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
+       $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
 	   $^O eq 'nto';
 
 # Set dont_use_nlink in your hint file if your system's stat doesn't
@@ -1233,8 +1263,8 @@ unless ($File::Find::dont_use_nlink) {
     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
 }
 
-# We need a function that checks if a scalar is tainted. Either use the 
-# Scalar::Util module's tainted() function or our (slower) pure Perl 
+# We need a function that checks if a scalar is tainted. Either use the
+# Scalar::Util module's tainted() function or our (slower) pure Perl
 # fallback is_tainted_pp()
 {
     local $@;
diff --git a/gnu/usr.bin/perl/lib/File/Path.pm b/gnu/usr.bin/perl/lib/File/Path.pm
index 7881b6b35af..2e41ff3f77f 100644
--- a/gnu/usr.bin/perl/lib/File/Path.pm
+++ b/gnu/usr.bin/perl/lib/File/Path.pm
@@ -33,7 +33,7 @@ to print the name of each directory as it is created
 =item *
 
 the numeric mode to use when creating the directories
-(defaults to 0777)
+(defaults to 0777), to be modified by the current umask.
 
 =back
 
@@ -84,14 +84,20 @@ than VMS is settled.  (defaults to FALSE)
 It returns the number of files successfully deleted.  Symlinks are
 simply deleted and not followed.
 
-B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
-in the face of failure or interruption.  Files and directories which
-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)>
-in situations where security is an issue.
+B<NOTE:> There are race conditions internal to the implementation of
+C<rmtree> making it unsafe to use on directory trees which may be
+altered or moved while C<rmtree> is running, and in particular on any
+directory trees with any path components or subdirectories potentially
+writable by untrusted users.
+
+Additionally, if the third parameter is not TRUE and C<rmtree> is
+interrupted, it may leave files and directories with permissions altered
+to allow deletion (and older versions of this module would even set
+files and directories to world-read/writable!)
+
+Note also that the occurrence of errors in C<rmtree> can be determined I<only>
+by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
+from the return value.
 
 =head1 DIAGNOSTICS
 
@@ -119,7 +125,7 @@ use Exporter ();
 use strict;
 use warnings;
 
-our $VERSION = "1.06";
+our $VERSION = "1.08";
 our @ISA = qw( Exporter );
 our @EXPORT = qw( mkpath rmtree );
 
@@ -159,7 +165,7 @@ sub mkpath {
 	unless (mkdir($path,$mode)) {
 	    my $e = $!;
 	    # allow for another process to have created it meanwhile
-	    croak "mkdir $path: $e" unless -d $path;
+	    $! = $e, croak ("mkdir $path: $e") unless -d $path;
 	}
 	push(@created, $path);
     }
@@ -192,11 +198,11 @@ sub rmtree {
 	(undef, undef, my $rp) = lstat $root or next;
 	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
 	if ( -d _ ) {
-	    # notabene: 0777 is for making readable in the first place,
+	    # notabene: 0700 is for making readable in the first place,
 	    # it's also intended to change it to writable in case we have
 	    # to recurse in which case we are better than rm -rf for 
 	    # subtrees with strange permissions
-	    chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+	    chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 	      or carp "Can't make directory $root read+writeable: $!"
 		unless $safe;
 
@@ -230,7 +236,7 @@ sub rmtree {
 		print "skipped $root\n" if $verbose;
 		next;
 	    }
-	    chmod 0777, $root
+	    chmod $rp | 0700, $root
 	      or carp "Can't make directory $root writeable: $!"
 		if $force_writeable;
 	    print "rmdir $root\n" if $verbose;
@@ -252,7 +258,7 @@ sub rmtree {
 		print "skipped $root\n" if $verbose;
 		next;
 	    }
-	    chmod 0666, $root
+	    chmod $rp | 0600, $root
 	      or carp "Can't make file $root writeable: $!"
 		if $force_writeable;
 	    print "unlink $root\n" if $verbose;
diff --git a/gnu/usr.bin/perl/lib/File/Temp.pm b/gnu/usr.bin/perl/lib/File/Temp.pm
index 4b9203310a1..6ddcb3619a7 100644
--- a/gnu/usr.bin/perl/lib/File/Temp.pm
+++ b/gnu/usr.bin/perl/lib/File/Temp.pm
@@ -8,11 +8,15 @@ File::Temp - return name and handle of a temporary file safely
 
 =head1 PORTABILITY
 
-This module is designed to be portable across operating systems
-and it currently supports Unix, VMS, DOS, OS/2, Windows and
-Mac OS (Classic). When
-porting to a new OS there are generally three main issues
-that have to be solved:
+This section is at the top in order to provide easier access to
+porters.  It is not expected to be rendered by a standard pod
+formatting tool. Please skip straight to the SYNOPSIS section if you
+are not trying to port this module to a new platform.
+
+This module is designed to be portable across operating systems and it
+currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
+(Classic). When porting to a new OS there are generally three main
+issues that have to be solved:
 
 =over 4
 
@@ -43,13 +47,15 @@ The C<_can_do_level> method should be modified accordingly.
 
   use File::Temp qw/ tempfile tempdir /;
 
-  $dir = tempdir( CLEANUP => 1 );
-  ($fh, $filename) = tempfile( DIR => $dir );
+  $fh = tempfile();
+  ($fh, $filename) = tempfile();
 
   ($fh, $filename) = tempfile( $template, DIR => $dir);
   ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
 
-  $fh = tempfile();
+
+  $dir = tempdir( CLEANUP => 1 );
+  ($fh, $filename) = tempfile( DIR => $dir );
 
 Object interface:
 
@@ -63,6 +69,8 @@ Object interface:
   print $tmp "Some data\n";
   print "Filename is $tmp\n";
 
+The following interfaces are provided for compatibility with
+existing APIs. They should not be used in new code.
 
 MkTemp family:
 
@@ -83,8 +91,6 @@ POSIX functions:
   $fh = tmpfile();
 
   ($fh, $file) = tmpnam();
-  $fh = tmpfile();
-
 
 Compatibility functions:
 
@@ -141,9 +147,10 @@ use overload '""' => "STRINGIFY";
 
 
 # use 'our' on v5.6.0
-use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
 
 $DEBUG = 0;
+$KEEP_ALL = 0;
 
 # We are exporting functions
 
@@ -161,6 +168,7 @@ use base qw/Exporter/;
 	      mkstemps
 	      mkdtemp
 	      unlink0
+	      cleanup
 		};
 
 # Groups of functions for export
@@ -175,7 +183,7 @@ Exporter::export_tags('POSIX','mktemp');
 
 # Version number
 
-$VERSION = '0.14';
+$VERSION = '0.16';
 
 # This is a list of characters that can be used in random filenames
 
@@ -186,7 +194,7 @@ my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
 
 # Maximum number of tries to make a temp file before failing
 
-use constant MAX_TRIES => 10;
+use constant MAX_TRIES => 1000;
 
 # Minimum number of X characters that should be in a template
 use constant MINX => 4;
@@ -207,7 +215,7 @@ use constant HIGH     => 2;
 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
 
 unless ($^O eq 'MacOS') {
-  for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+  for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
     my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
     no strict 'refs';
     $OPENFLAGS |= $bit if eval {
@@ -345,7 +353,7 @@ sub _gettemp {
   # we know where we are looking and what we are looking for
 
   if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
-    ${$options{ErrStr}} = "The template must contain at least ".
+    ${$options{ErrStr}} = "The template must end with at least ".
       MINX . " 'X' characters\n";
     return ();
   }
@@ -417,7 +425,7 @@ sub _gettemp {
     ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
     return ();
   }
-  unless (-w _) {
+  unless (-w $parent) {
     ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
       return ();
   }
@@ -467,12 +475,12 @@ sub _gettemp {
 
       # Attempt to open the file
       my $open_success = undef;
-      if ( $^O eq 'VMS' and $options{"unlink_on_close"} ) {
+      if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
         # make it auto delete on close by setting FAB$V_DLT bit
 	$fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
 	$open_success = $fh;
       } else {
-	my $flags = ( $options{"unlink_on_close"} ?
+	my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
 		      $OPENTEMPFLAGS :
 		      $OPENFLAGS );
 	$open_success = sysopen($fh, $path, $flags, 0600);
@@ -623,10 +631,21 @@ sub _replace_XX {
   } else {
     $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
   }
-
   return $path;
 }
 
+# Internal routine to force a temp file to be writable after
+# it is created so that we can unlink it. Windows seems to occassionally
+# force a file to be readonly when written to certain temp locations
+sub _force_writable {
+  my $file = shift;
+  my $umask = umask();
+  umask(066);
+  chmod 0600, $file;
+  umask($umask) if defined $umask;
+}
+
+
 # internal routine to check to see if the directory is safe
 # First checks to see if the directory is not owned by the
 # current user or root. Then checks to see if anyone else
@@ -680,13 +699,13 @@ sub _is_safe {
   if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
       ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
     # Must be a directory
-    unless (-d _) {
+    unless (-d $path) {
       $$err_ref = "Path ($path) is not a directory"
       if ref($err_ref);
       return 0;
     }
     # Must have sticky bit set
-    unless (-k _) {
+    unless (-k $path) {
       $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
 	if ref($err_ref);
       return 0;
@@ -832,35 +851,63 @@ sub _can_do_level {
 
 {
   # Will set up two lexical variables to contain all the files to be
-  # removed. One array for files, another for directories
-  # They will only exist in this block
-  # This means we only have to set up a single END block to remove all files
-  # @files_to_unlink contains an array ref with the filehandle and filename
-  my (@files_to_unlink, @dirs_to_unlink);
+  # removed. One array for files, another for directories They will
+  # only exist in this block.
+
+  #  This means we only have to set up a single END block to remove
+  #  all files. 
+
+  # in order to prevent child processes inadvertently deleting the parent
+  # temp files we use a hash to store the temp files and directories
+  # created by a particular process id.
+
+  # %files_to_unlink contains values that are references to an array of
+  # array references containing the filehandle and filename associated with
+  # the temp file.
+  my (%files_to_unlink, %dirs_to_unlink);
 
   # Set up an end block to use these arrays
   END {
-    # Files
-    foreach my $file (@files_to_unlink) {
-      # close the filehandle without checking its state
-      # in order to make real sure that this is closed
-      # if its already closed then I dont care about the answer
-      # probably a better way to do this
-      close($file->[0]);  # file handle is [0]
-
-      if (-f $file->[1]) {  # file name is [1]
-	unlink $file->[1] or warn "Error removing ".$file->[1];
+    cleanup();
+  }
+
+  # Cleanup function. Always triggered on END but can be invoked
+  # manually.
+  sub cleanup {
+    if (!$KEEP_ALL) {
+      # Files
+      my @files = (exists $files_to_unlink{$$} ?
+		   @{ $files_to_unlink{$$} } : () );
+      foreach my $file (@files) {
+	# close the filehandle without checking its state
+	# in order to make real sure that this is closed
+	# if its already closed then I dont care about the answer
+	# probably a better way to do this
+	close($file->[0]);  # file handle is [0]
+
+	if (-f $file->[1]) {  # file name is [1]
+	  _force_writable( $file->[1] ); # for windows
+	  unlink $file->[1] or warn "Error removing ".$file->[1];
+	}
       }
-    }
-    # Dirs
-    foreach my $dir (@dirs_to_unlink) {
-      if (-d $dir) {
-	rmtree($dir, $DEBUG, 0);
+      # Dirs
+      my @dirs = (exists $dirs_to_unlink{$$} ?
+		  @{ $dirs_to_unlink{$$} } : () );
+      foreach my $dir (@dirs) {
+	if (-d $dir) {
+	  rmtree($dir, $DEBUG, 0);
+	}
       }
-    }
 
+      # clear the arrays
+      @{ $files_to_unlink{$$} } = ()
+	if exists $files_to_unlink{$$};
+      @{ $dirs_to_unlink{$$} } = ()
+	if exists $dirs_to_unlink{$$};
+    }
   }
 
+
   # This is the sub called to register a file for deferred unlinking
   # This could simply store the input parameters and defer everything
   # until the END block. For now we do a bit of checking at this
@@ -884,7 +931,9 @@ sub _can_do_level {
 	# Directory exists so store it
 	# first on VMS turn []foo into [.foo] for rmtree
 	$fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
-	push (@dirs_to_unlink, $fname);
+	$dirs_to_unlink{$$} = [] 
+	  unless exists $dirs_to_unlink{$$};
+	push (@{ $dirs_to_unlink{$$} }, $fname);
 
       } else {
 	carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
@@ -895,7 +944,9 @@ sub _can_do_level {
       if (-f $fname) {
 
 	# file exists so store handle and name for later removal
-	push(@files_to_unlink, [$fh, $fname]);
+	$files_to_unlink{$$} = []
+	  unless exists $files_to_unlink{$$};
+	push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
 
       } else {
 	carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
@@ -908,7 +959,7 @@ sub _can_do_level {
 
 }
 
-=head1 OO INTERFACE
+=head1 OBJECT-ORIENTED INTERFACE
 
 This is the primary interface for interacting with
 C<File::Temp>. Using the OO interface a temporary file can be created
@@ -976,10 +1027,13 @@ sub new {
 
   # Store unlink information in hash slot (plus other constructor info)
   %{*$fh} = %args;
-  ${*$fh}{UNLINK} = $unlink;
 
+  # create the object
   bless $fh, $class;
 
+  # final method-based configuration
+  $fh->unlink_on_destroy( $unlink );
+
   return $fh;
 }
 
@@ -1004,6 +1058,25 @@ sub STRINGIFY {
   return $self->filename;
 }
 
+=item B<unlink_on_destroy>
+
+Control whether the file is unlinked when the object goes out of scope.
+The file is removed if this value is true and $KEEP_ALL is not.
+
+ $fh->unlink_on_destroy( 1 );
+
+Default is for the file to be removed.
+
+=cut
+
+sub unlink_on_destroy {
+  my $self = shift;
+  if (@_) {
+    ${*$self}{UNLINK} = shift;
+  }
+  return ${*$self}{UNLINK};
+}
+
 =item B<DESTROY>
 
 When the object goes out of scope, the destructor is called. This
@@ -1013,11 +1086,13 @@ if UNLINK is not specified).
 
 No error is given if the unlink fails.
 
+If the global variable $KEEP_ALL is true, the file will not be removed.
+
 =cut
 
 sub DESTROY {
   my $self = shift;
-  if (${*$self}{UNLINK}) {
+  if (${*$self}{UNLINK} && !$KEEP_ALL) {
     print "# --------->   Unlinking $self\n" if $DEBUG;
 
     # The unlink1 may fail if the file has been closed
@@ -1026,6 +1101,7 @@ sub DESTROY {
     # do an unlink without test. Seems to be silly
     # to do this when we are trying to be careful
     # about security
+    _force_writable( $self->filename ); # for windows
     unlink1( $self, $self->filename )
       or unlink($self->filename);
   }
@@ -1045,6 +1121,7 @@ temporary files and directories.
 This is the basic function to generate temporary files.
 The behaviour of the file can be changed using various options:
 
+  $fh = tempfile();
   ($fh, $filename) = tempfile();
 
 Create a temporary file in  the directory specified for temporary
@@ -1072,10 +1149,15 @@ is specified.
   ($fh, $filename) = tempfile($template, UNLINK => 1);
 
 Return the filename and filehandle as before except that the file is
-automatically removed when the program exits. Default is for the file
-to be removed if a file handle is requested and to be kept if the
-filename is requested. In a scalar context (where no filename is
-returned) the file is always deleted either on exit or when it is closed.
+automatically removed when the program exits (dependent on
+$KEEP_ALL). Default is for the file to be removed if a file handle is
+requested and to be kept if the filename is requested. In a scalar
+context (where no filename is returned) the file is always deleted
+either (depending on the operating system) on exit or when it is
+closed (unless $KEEP_ALL is true when the temp file is created).
+
+Use the object-oriented interface if fine-grained control of when
+a file is removed is required.
 
 If the template is not specified, a template is always
 automatically generated. This temporary file is placed in tmpdir()
@@ -1084,16 +1166,16 @@ DIR option.
 
   $fh = tempfile( $template, DIR => $dir );
 
-If called in scalar context, only the filehandle is returned
-and the file will automatically be deleted when closed (see
-the description of tmpfile() elsewhere in this document).
-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)
-the file is marked for deletion when the program ends (equivalent
-to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
+If called in scalar context, only the filehandle is returned and the
+file will automatically be deleted when closed on operating systems
+that support this (see the description of tmpfile() elsewhere in this
+document).  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) the file is marked for deletion when
+the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
+flag is ignored if present.
 
   (undef, $filename) = tempfile($template, OPEN => 0);
 
@@ -1180,7 +1262,8 @@ sub tempfile {
   # we have to indicate temporary-ness when we open the file. In general
   # we only want a true temporary file if we are returning just the
   # filehandle - if the user wants the filename they probably do not
-  # want the file to disappear as soon as they close it.
+  # want the file to disappear as soon as they close it (which may be
+  # important if they want a child process to use the file)
   # For this reason, tie unlink_on_close to the return context regardless
   # of OS.
   my $unlink_on_close = ( wantarray ? 0 : 1);
@@ -1695,7 +1778,8 @@ verify that the number of links on that file is now 0.  This is the
 closest you can come to making sure that the filename unlinked was the
 same as the file whose descriptor you hold.
 
-  unlink0($fh, $path) or die "Error unlinking file $path safely";
+  unlink0($fh, $path)
+     or die "Error unlinking file $path safely";
 
 Returns false on error. The filehandle is not closed since on some
 occasions this is not required.
@@ -1720,6 +1804,10 @@ Finally, on NFS file systems the link count of the file handle does
 not always go to zero immediately after unlinking. Currently, this
 command is expected to fail on NFS disks.
 
+This function is disabled if the global variable $KEEP_ALL is true
+and an unlink on open file is supported. If the unlink is to be deferred
+to the END block, the file is still registered for removal.
+
 =cut
 
 sub unlink0 {
@@ -1734,6 +1822,10 @@ sub unlink0 {
 
   # attempt remove the file (does not work on some platforms)
   if (_can_unlink_opened_file()) {
+
+    # return early (Without unlink) if we have been instructed to retain files.
+    return 1 if $KEEP_ALL;
+
     # XXX: do *not* call this on a directory; possible race
     #      resulting in recursive removal
     croak "unlink0: $path has become a directory!" if -d $path;
@@ -1765,7 +1857,8 @@ 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";
+  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.
@@ -1816,7 +1909,7 @@ sub cmpstat {
   }
 
   # this is no longer a file, but may be a directory, or worse
-  unless (-f _) {
+  unless (-f $path) {
     confess "panic: $path is no longer a file: SB=@fh";
   }
 
@@ -1861,12 +1954,15 @@ 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.
 
-  unlink1($fh, $path) or die "Error closing and unlinking file";
+  unlink1($fh, $path)
+     or die "Error closing and unlinking file";
 
 Usually called from the object destructor when using the OO interface.
 
 Not exported by default.
 
+This function is disabled if the global variable $KEEP_ALL is true.
+
 =cut
 
 sub unlink1 {
@@ -1881,10 +1977,32 @@ sub unlink1 {
   # Close the file
   close( $fh ) or return 0;
 
+  # Make sure the file is writable (for windows)
+  _force_writable( $path );
+
+  # return early (without unlink) if we have been instructed to retain files.
+  return 1 if $KEEP_ALL;
+
   # remove the file
   return unlink($path);
 }
 
+=item B<cleanup>
+
+Calling this function will cause any temp files or temp directories
+that are registered for removal to be removed. This happens automatically
+when the process exits but can be triggered manually if the caller is sure
+that none of the temp files are required. This method can be registered as
+an Apache callback.
+
+On OSes where temp files are automatically removed when the temp file
+is closed, calling this function will have no effect other than to remove
+temporary directories (which may include temporary files).
+
+  File::Temp::cleanup();
+
+Not exported by default.
+
 =back
 
 =head1 PACKAGE VARIABLES
@@ -2006,8 +2124,6 @@ UID.
 This value can be adjusted to reduce security checking if required.
 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
 
-=back
-
 =cut
 
 {
@@ -2024,6 +2140,32 @@ The value is only relevant when C<safe_level> is set to MEDIUM or higher.
   }
 }
 
+=item B<$KEEP_ALL>
+
+Controls whether temporary files and directories should be retained
+regardless of any instructions in the program to remove them
+automatically.  This is useful for debugging but should not be used in
+production code.
+
+  $File::Temp::KEEP_ALL = 1;
+
+Default is for files to be removed as requested by the caller.
+
+In some cases, files will only be retained if this variable is true
+when the file is created. This means that you can not create a temporary
+file, set this variable and expect the temp file to still be around
+when the program exits.
+
+=item B<$DEBUG>
+
+Controls whether debugging messages should be enabled.
+
+  $File::Temp::DEBUG = 1;
+
+Default is for debugging mode to be disabled.
+
+=back
+
 =head1 WARNING
 
 For maximum security, endeavour always to avoid ever looking at,
@@ -2052,26 +2194,42 @@ fail when the temp file is not local. Additionally, be aware that
 the performance of I/O operations over NFS will not be as good as for
 a local disk.
 
+=head2 Forking
+
+In some cases files created by File::Temp are removed from within an
+END block. Since END blocks are triggered when a child process exits
+(unless C<POSIX::_exit()> is used by the child) File::Temp takes care
+to only remove those temp files created by a particular process ID. This
+means that a child will not attempt to remove temp files created by the
+parent process.
+
+=head2 BINMODE
+
+The file returned by File::Temp will have been opened in binary mode
+if such a mode is available. If that is not correct, use the binmode()
+function to change the mode of the filehandle.
+
 =head1 HISTORY
 
 Originally began life in May 1999 as an XS interface to the system
 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
 translated to Perl for total control of the code's
 security checking, to ensure the presence of the function regardless of
-operating system and to help with portability.
+operating system and to help with portability. The module was shipped
+as a standard part of perl from v5.6.1.
 
 =head1 SEE ALSO
 
 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
 
-See L<IO::File> and L<File::MkTemp> for different implementations of
-temporary file handling.
+See L<IO::File> and L<File::MkTemp>, L<Apachae::TempFile> for
+different implementations of temporary file handling.
 
 =head1 AUTHOR
 
 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
 
-Copyright (C) 1999-2003 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2005 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.
diff --git a/gnu/usr.bin/perl/lib/FileCache.pm b/gnu/usr.bin/perl/lib/FileCache.pm
index b1a30dec3a3..02bde7e68f0 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.04_01';
+our $VERSION = '1.06';
 
 =head1 NAME
 
@@ -52,6 +52,8 @@ append them to the command string as you would system EXPR.
 Returns EXPR on success for convenience. You may neglect the
 return value and manipulate EXPR as the filehandle directly if you prefer.
 
+=back
+
 =head1 CAVEATS
 
 While it is permissible to C<close> a FileCache managed file,
@@ -81,21 +83,35 @@ use Carp;
 use Config;
 use strict;
 no strict 'refs';
+
 # 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);
+$cacheout_maxopen = 16;
+
+use base 'Exporter';
+our @EXPORT = qw[cacheout cacheout_close];
+
+
 my %isopen;
 my $cacheout_seq = 0;
 
 sub import {
     my ($pkg,%args) = @_;
-    $pkg = caller(1);
-    *{$pkg.'::cacheout'} = \&cacheout;
-    *{$pkg.'::close'}    = \&cacheout_close;
+
+    # Use Exporter. %args are for us, not Exporter.
+    # Make sure to up export_to_level, or we will import into ourselves,
+    # rather than our calling package;
+
+    __PACKAGE__->export_to_level(1);
+    Exporter::import( $pkg );
 
     # Truth is okay here because setting maxopen to 0 would be bad
     return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
+
+    # XXX This code is crazy.  Why is it a one element foreach loop?
+    # Why is it using $param both as a filename and filehandle?
     foreach my $param ( '/usr/include/sys/param.h' ){
       if (open($param, '<', $param)) {
 	local ($_, $.);
@@ -141,7 +157,7 @@ sub cacheout {
     if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[1] ){
       &cacheout_close($file, 1);
     }
-    
+
     if( $isopen{$file}) {
       $ret = $file;
       $isopen{$file}->[0]++;
@@ -160,7 +176,7 @@ sub cacheout {
       }
       #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];
     }
     return $ret;
diff --git a/gnu/usr.bin/perl/lib/FindBin.pm b/gnu/usr.bin/perl/lib/FindBin.pm
index 4610beb2cd3..0dbe5506203 100644
--- a/gnu/usr.bin/perl/lib/FindBin.pm
+++ b/gnu/usr.bin/perl/lib/FindBin.pm
@@ -24,9 +24,9 @@ Locates the full path to the script bin directory to allow the use
 of paths relative to the bin directory.
 
 This allows a user to setup a directory tree for some software with
-directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
-the use of modules in the lib directory without knowing where the software
-tree is installed.
+directories C<< <root>/bin >> and C<< <root>/lib >>, and then the above
+example will allow the use of modules in the lib directory without knowing
+where the software tree is installed.
 
 If perl is invoked using the B<-e> option or the perl script is read from
 C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
@@ -65,9 +65,10 @@ If perl is invoked as
 
    perl filename
 
-and I<filename> does not have executable rights and a program called I<filename>
-exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
-assumes that it was invoked via the C<$ENV{PATH}>.
+and I<filename> does not have executable rights and a program called
+I<filename> exists in the users C<$ENV{PATH}> which satisfies both B<-x>
+and B<-T> then FindBin assumes that it was invoked via the
+C<$ENV{PATH}>.
 
 Workaround is to invoke perl as
 
@@ -76,7 +77,8 @@ Workaround is to invoke perl as
 =head1 AUTHORS
 
 FindBin is supported as part of the core perl distribution. Please send bug
-reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl.
+reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program
+included with perl.
 
 Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
 Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
@@ -93,7 +95,7 @@ package FindBin;
 use Carp;
 require 5.000;
 require Exporter;
-use Cwd qw(getcwd abs_path);
+use Cwd qw(getcwd cwd abs_path);
 use Config;
 use File::Basename;
 use File::Spec;
@@ -102,7 +104,15 @@ use File::Spec;
 %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
 @ISA = qw(Exporter);
 
-$VERSION = "1.44";
+$VERSION = "1.47";
+
+sub cwd2 {
+   my $cwd = getcwd();
+   # getcwd might fail if it hasn't access to the current directory.
+   # try harder.
+   defined $cwd or $cwd = cwd();
+   $cwd;
+}
 
 sub init
 {
@@ -112,9 +122,8 @@ sub init
  if($0 eq '-e' || $0 eq '-')
   {
    # perl invoked with -e or script is on C<STDIN>
-
    $Script = $RealScript = $0;
-   $Bin    = $RealBin    = getcwd();
+   $Bin    = $RealBin    = cwd2();
   }
  else
   {
@@ -158,9 +167,9 @@ sub init
 
      croak("Cannot find current script '$0'") unless(-f $script);
 
-     # Ensure $script contains the complete path incase we C<chdir>
+     # Ensure $script contains the complete path in case we C<chdir>
 
-     $script = File::Spec->catfile(getcwd(), $script)
+     $script = File::Spec->catfile(cwd2(), $script)
        unless File::Spec->file_name_is_absolute($script);
 
      ($Script,$Bin) = fileparse($script);
@@ -179,7 +188,11 @@ sub init
       }
 
      # Get absolute paths to directories
-     $Bin     = abs_path($Bin)     if($Bin);
+     if ($Bin) {
+      my $BinOld = $Bin;
+      $Bin = abs_path($Bin);
+      defined $Bin or $Bin = File::Spec->canonpath($BinOld);
+     }
      $RealBin = abs_path($RealBin) if($RealBin);
     }
   }
@@ -190,4 +203,3 @@ BEGIN { init }
 *again = \&init;
 
 1; # Keep require happy
-
diff --git a/gnu/usr.bin/perl/lib/Getopt/Long.pm b/gnu/usr.bin/perl/lib/Getopt/Long.pm
index 8c1c40ae8dd..e9451b6482c 100644
--- a/gnu/usr.bin/perl/lib/Getopt/Long.pm
+++ b/gnu/usr.bin/perl/lib/Getopt/Long.pm
@@ -2,17 +2,17 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: Long.pm,v 1.7 2003/12/03 03:02:38 millert Exp $
+# RCS Status      : $Id: Long.pm,v 1.8 2006/03/28 19:23:07 millert Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Tue Sep 23 15:21:23 2003
-# Update Count    : 1364
+# Last Modified On: Wed Dec 14 21:17:21 2005
+# Update Count    : 1458
 # Status          : Released
 
 ################ Copyright ################
 
-# This program is Copyright 1990,2002 by Johan Vromans.
+# This program is Copyright 1990,2005 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
@@ -35,10 +35,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.34;
+$VERSION        =  2.35;
 # For testing versions only.
 #use vars qw($VERSION_STRING);
-#$VERSION_STRING = "2.33_03";
+#$VERSION_STRING = "2.35";
 
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -63,7 +63,7 @@ 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 $auto_help $auto_version);
+use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
 
 # Public subroutines.
 sub config(@);			# deprecated name
@@ -73,6 +73,7 @@ sub ConfigDefaults();
 sub ParseOptionSpec($$);
 sub OptCtl($);
 sub FindOption($$$$);
+sub ValidValue ($$$$$);
 
 ################ Local Variables ################
 
@@ -105,6 +106,7 @@ sub ConfigDefaults() {
     $ignorecase = 1;		# ignore case when matching options
     $passthrough = 0;		# leave unrecognized options alone
     $gnu_compat = 0;		# require --opt=val if value is optional
+    $longprefix = "(--)";       # what does a long prefix look like
 }
 
 # Override import.
@@ -230,7 +232,7 @@ use constant CTL_TYPE    => 0;
 
 use constant CTL_CNAME   => 1;
 
-use constant CTL_MAND    => 2;
+use constant CTL_DEFAULT => 2;
 
 use constant CTL_DEST    => 3;
  use constant   CTL_DEST_SCALAR => 0;
@@ -238,7 +240,8 @@ use constant CTL_DEST    => 3;
  use constant   CTL_DEST_HASH   => 2;
  use constant   CTL_DEST_CODE   => 3;
 
-use constant CTL_DEFAULT => 4;
+use constant CTL_AMIN    => 4;
+use constant CTL_AMAX    => 5;
 
 # FFU.
 #use constant CTL_RANGE   => ;
@@ -264,7 +267,7 @@ sub GetOptions(@) {
 	local ($^W) = 0;
 	print STDERR
 	  ("Getopt::Long $Getopt::Long::VERSION (",
-	   '$Revision: 1.7 $', ") ",
+	   '$Revision: 1.8 $', ") ",
 	   "called from package \"$pkg\".",
 	   "\n  ",
 	   "ARGV: (@ARGV)",
@@ -278,7 +281,8 @@ sub GetOptions(@) {
 	   "ignorecase=$ignorecase,",
 	   "requested_version=$requested_version,",
 	   "passthrough=$passthrough,",
-	   "genprefix=\"$genprefix\".",
+	   "genprefix=\"$genprefix\",",
+	   "longprefix=\"$longprefix\".",
 	   "\n");
     }
 
@@ -287,7 +291,7 @@ sub GetOptions(@) {
     # as it is really a hash underneath.
     $userlinkage = undef;
     if ( @optionlist && ref($optionlist[0]) and
-	 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
+	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
 	$userlinkage = shift (@optionlist);
 	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
     }
@@ -311,6 +315,11 @@ sub GetOptions(@) {
     while ( @optionlist ) {
 	my $opt = shift (@optionlist);
 
+	unless ( defined($opt) ) {
+	    $error .= "Undefined argument in option spec\n";
+	    next;
+	}
+
 	# Strip leading prefix so people can specify "--foo=i" if they like.
 	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
 
@@ -474,7 +483,8 @@ sub GetOptions(@) {
 	    # FindOption undefines $opt in case of errors.
 	    next unless defined $opt;
 
-	    if ( defined $arg ) {
+	    my $argcnt = 0;
+	    while ( defined $arg ) {
 
 		# Get the canonical name.
 		print STDERR ("=> cname for \"$opt\" is ") if $debug;
@@ -606,6 +616,36 @@ sub GetOptions(@) {
 			$userlinkage->{$opt} = $arg;
 		    }
 		}
+
+		$argcnt++;
+		last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
+		undef($arg);
+
+		# Need more args?
+		if ( $argcnt < $ctl->[CTL_AMIN] ) {
+		    if ( @ARGV ) {
+			if ( ValidValue($ctl, $ARGV[0], 1, $argend, $prefix) ) {
+			    $arg = shift(@ARGV);
+			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+			    next;
+			}
+			warn("Value \"$ARGV[0]\" invalid for option $opt\n");
+			$error++;
+		    }
+		    else {
+			warn("Insufficient arguments for option $opt\n");
+			$error++;
+		    }
+		}
+
+		# Any more args?
+		if ( @ARGV && ValidValue($ctl, $ARGV[0], 0, $argend, $prefix) ) {
+		    $arg = shift(@ARGV);
+		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+		    next;
+		}
 	    }
 	}
 
@@ -670,9 +710,10 @@ sub OptCtl ($) {
       join(",",
 	   "\"$v[CTL_TYPE]\"",
 	   "\"$v[CTL_CNAME]\"",
-	   $v[CTL_MAND] ? "O" : "M",
-	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
 	   "\"$v[CTL_DEFAULT]\"",
+	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
+	   $v[CTL_AMIN] || '',
+	   $v[CTL_AMAX] || '',
 #	   $v[CTL_RANGE] || '',
 #	   $v[CTL_REPEAT] || '',
 	  ). "]";
@@ -694,8 +735,8 @@ sub ParseOptionSpec ($$) {
 		     # Either modifiers ...
 		     [!+]
 		     |
-		     # ... or a value/dest specification
-		     [=:] [ionfs] [@%]?
+		     # ... or a value/dest/repeat specification
+		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
 		     |
 		     # ... or an optional-with-default spec
 		     : (?: -?\d+ | \+ ) [@%]?
@@ -729,9 +770,9 @@ sub ParseOptionSpec ($$) {
     my $entry;
     if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
 	# Fields are hard-wired here.
-	$entry = [$spec,$orig,0,CTL_DEST_SCALAR,undef];
+	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
     }
-    elsif ( $spec =~ /:(-?\d+|\+)([@%])?/ ) {
+    elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
 	my $def = $1;
 	my $dest = $2;
 	my $type = $def eq '+' ? 'I' : 'i';
@@ -739,16 +780,35 @@ sub ParseOptionSpec ($$) {
 	$dest = $dest eq '@' ? CTL_DEST_ARRAY
 	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
 	# Fields are hard-wired here.
-	$entry = [$type,$orig,0,$dest,$def eq '+' ? undef : $def];
+	$entry = [$type,$orig,$def eq '+' ? undef : $def,
+		  $dest,0,1];
     }
     else {
-	my ($mand, $type, $dest) = $spec =~ /([=:])([ionfs])([@%])?/;
+	my ($mand, $type, $dest) =
+	  $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
+	return (undef, "Cannot repeat while bundling: \"$opt\"\n")
+	  if $bundling && defined($4);
+	my ($mi, $cm, $ma) = ($5, $6, $7);
+	return (undef, "{0} is useless in option spec: \"$opt\"\n")
+	  if defined($mi) && !$mi && !defined($ma) && !defined($cm);
+
 	$type = 'i' if $type eq 'n';
 	$dest ||= '$';
 	$dest = $dest eq '@' ? CTL_DEST_ARRAY
 	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+	# Default minargs to 1/0 depending on mand status.
+	$mi = $mand eq '=' ? 1 : 0 unless defined $mi;
+	# Adjust mand status according to minargs.
+	$mand = $mi ? '=' : ':';
+	# Adjust maxargs.
+	$ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
+	return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
+	  if defined($ma) && !$ma;
+	return (undef, "Max less than min in option spec: \"$opt\"\n")
+	  if defined($ma) && $ma < $mi;
+
 	# Fields are hard-wired here.
-	$entry = [$type,$orig,$mand eq '=',$dest,undef];
+	$entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
     }
 
     # Process all names. First is canonical, the rest are aliases.
@@ -805,7 +865,7 @@ sub FindOption ($$$$) {
 
     # If it is a long option, it may include the value.
     # With getopt_compat, only if not bundling.
-    if ( ($starter eq "--" 
+    if ( ($starter=~/^$longprefix$/
           || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
 	  && $opt =~ /^([^=]+)=(.*)$/s ) {
 	$opt = $1;
@@ -860,9 +920,10 @@ sub FindOption ($$$$) {
 	    # See if all matches are for the same option.
 	    my %hit;
 	    foreach ( @hits ) {
-		$_ = $opctl->{$_}->[CTL_CNAME]
-		  if defined $opctl->{$_}->[CTL_CNAME];
-		$hit{$_} = 1;
+		my $hit = $_;
+		$hit = $opctl->{$hit}->[CTL_CNAME]
+		  if defined $opctl->{$hit}->[CTL_CNAME];
+		$hit{$hit} = 1;
 	    }
 	    # Remove auto-supplied options (version, help).
 	    if ( keys(%hit) == 2 ) {
@@ -903,7 +964,7 @@ sub FindOption ($$$$) {
     unless  ( defined $ctl ) {
 	return (0) if $passthrough;
 	# Pretend one char when bundling.
-	if ( $bundling == 1) {
+	if ( $bundling == 1 && length($starter) == 1 ) {
 	    $opt = substr($opt,0,1);
             unshift (@ARGV, $starter.$rest) if defined $rest;
 	}
@@ -942,7 +1003,7 @@ sub FindOption ($$$$) {
     }
 
     # Get mandatory status and type info.
-    my $mand = $ctl->[CTL_MAND];
+    my $mand = $ctl->[CTL_AMIN];
 
     # Check if there is an option argument available.
     if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
@@ -1101,6 +1162,47 @@ sub FindOption ($$$$) {
     return (1, $opt, $ctl, $arg, $key);
 }
 
+sub ValidValue ($$$$$) {
+    my ($ctl, $arg, $mand, $argend, $prefix) = @_;
+
+    if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+	return 0 unless $arg =~ /[^=]+=(.*)/;
+	$arg = $1;
+    }
+
+    my $type = $ctl->[CTL_TYPE];
+
+    if ( $type eq 's' ) {	# string
+	# A mandatory string takes anything.
+	return (1) if $mand;
+
+	return (1) if $arg eq "-";
+
+	# Check for option or option list terminator.
+	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
+	return 1;
+    }
+
+    elsif ( $type eq 'i'	# numeric/integer
+            || $type eq 'I'	# numeric/integer w/ incr default
+	    || $type eq 'o' ) { # dec/oct/hex/bin value
+
+	my $o_valid =
+	  $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
+	    : "[-+]?[0-9]+";
+
+	return $arg =~ /^$o_valid$/si;
+    }
+
+    elsif ( $type eq 'f' ) { # real number, int is also ok
+	# We require at least one digit before a point or 'e',
+	# and at least one digit following the point and 'e'.
+	# [-]NN[.NN][eNN]
+	return $arg =~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/;
+    }
+    die("ValidValue: Cannot happen\n");
+}
+
 # Getopt::Long Configuration.
 sub Configure (@) {
     my (@options) = @_;
@@ -1108,13 +1210,14 @@ sub Configure (@) {
     my $prevconfig =
       [ $error, $debug, $major_version, $minor_version,
 	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
-	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ];
+	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
+	$longprefix ];
 
     if ( ref($options[0]) eq 'ARRAY' ) {
 	( $error, $debug, $major_version, $minor_version,
 	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
-	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ) =
-	    @{shift(@options)};
+	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
+	  $longprefix ) = @{shift(@options)};
     }
 
     my $opt;
@@ -1189,9 +1292,17 @@ sub Configure (@) {
 	    # Parenthesize if needed.
 	    $genprefix = "(" . $genprefix . ")"
 	      unless $genprefix =~ /^\(.*\)$/;
-	    eval { '' =~ /$genprefix/; };
+	    eval { '' =~ m"$genprefix"; };
 	    die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
 	}
+	elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
+	    $longprefix = $1;
+	    # Parenthesize if needed.
+	    $longprefix = "(" . $longprefix . ")"
+	      unless $longprefix =~ /^\(.*\)$/;
+	    eval { '' =~ m"$longprefix"; };
+	    die("Getopt::Long: invalid long prefix pattern \"$longprefix\"") if $@;
+	}
 	elsif ( $try eq 'debug' ) {
 	    $debug = $action;
 	}
@@ -1371,12 +1482,15 @@ The C<+> form is now obsolete and strongly deprecated.
 
 =head1 Getting Started with Getopt::Long
 
-Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
-the first Perl module that provided support for handling the new style
-of command line options, hence the name Getopt::Long. This module
-also supports single-character options and bundling. In this case, the
-options are restricted to alphabetic characters only, and the
-characters C<?> and C<->.
+Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
+first Perl module that provided support for handling the new style of
+command line options, hence the name Getopt::Long. This module also
+supports single-character options and bundling. Single character
+options may be any alphabetic character, a question mark, and a dash.
+Long options may consist of a series of letters, digits, and dashes.
+Although this is currently not enforced by Getopt::Long, multiple
+consecutive dashes are not allowed, and the option name must not end
+with a dash.
 
 To use Getopt::Long from a Perl program, you must include the
 following line in your Perl program:
@@ -1511,7 +1625,7 @@ destination:
 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.
+only integer or floating point numbers are acceptable 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()
@@ -1523,6 +1637,26 @@ and join() operators:
 Of course, it is important to choose the right separator string for
 each purpose.
 
+Warning: What follows is an experimental feature.
+
+Options can take multiple values at once, for example
+
+    --coordinates 52.2 16.4 --rgbcolor 255 255 149
+
+This can be accomplished by adding a repeat specifier to the option
+specification. Repeat specifiers are very similar to the C<{...}>
+repeat specifiers that can be used with regular expression patterns.
+For example, the above command line would be handled as follows:
+
+    GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
+
+The destination for the option must be an array or array reference.
+
+It is also possible to specify the minimal and maximal number of
+arguments an option takes. C<foo=s{2,4}> indicates an option that
+takes at least two and at most 4 arguments. C<foo=s{,}> indicates one
+or more values; C<foo:s{,}> indicates zero or more option values.
+
 =head2 Options with hash values
 
 If the option destination is a reference to a hash, the option will
@@ -1542,7 +1676,7 @@ When used with command line options:
 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.
+are acceptable values. The keys are always taken to be strings.
 
 =head2 User-defined subroutines to handle options
 
@@ -1572,7 +1706,7 @@ the desired error message as its argument. GetOptions() will catch the
 die(), issue the error message, and record that an error result must
 be returned upon completion.
 
-If the text of the error message starts with an exclamantion mark C<!>
+If the text of the error message starts with an exclamation mark C<!>
 it is interpreted specially by GetOptions(). There is currently one
 special command implemented: C<die("!FINISH")> will cause GetOptions()
 to stop processing options, as if it encountered a double dash C<-->.
@@ -1588,7 +1722,8 @@ the above example:
     GetOptions ('length|height=f' => \$length);
 
 The first name is called the I<primary> name, the other names are
-called I<aliases>.
+called I<aliases>. When using a hash to store options, the key will
+always be the primary name.
 
 Multiple alternate names are possible.
 
@@ -1624,10 +1759,11 @@ The argument specification can be
 
 =item !
 
-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> and C<--no-foo> (a value of 0 will be assigned). If the
-option has aliases, this applies to the aliases as well.
+The option does not take an argument and may be negated by prefixing
+it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
+1 will be assigned) as well as 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
 pointless and will result in a warning.
@@ -1641,7 +1777,7 @@ resulting in a value of 3 (provided it was 0 or undefined at first).
 
 The C<+> specifier is ignored if the option destination is not a scalar.
 
-=item = I<type> [ I<desttype> ]
+=item = I<type> [ I<desttype> ] [ I<repeat> ]
 
 The option requires an argument of the given type. Supported types
 are:
@@ -1678,6 +1814,17 @@ list or a hash valued. This is only needed when the destination for
 the option value is not otherwise specified. It should be omitted when
 not needed.
 
+The I<repeat> specifies the number of values this option takes per
+occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
+
+I<min> denotes the minimal number of arguments. It defaults to 1 for
+options with C<=> and to 0 for options with C<:>, see below. Note that
+I<min> overrules the C<=> / C<:> semantics.
+
+I<max> denotes the maximum number of arguments. It must be at least
+I<min>. If I<max> is omitted, I<but the comma is not>, there is no
+upper bound to the number of argument values taken.
+
 =item : I<type> [ I<desttype> ]
 
 Like C<=>, but designates the argument as optional.
@@ -1765,14 +1912,14 @@ messages. For example:
 
     =head1 DESCRIPTION
 
-    B<This program> will read the given input file(s) and do someting
+    B<This program> will read the given input file(s) and do something
     useful with the contents thereof.
 
     =cut
 
 See L<Pod::Usage> for details.
 
-=head2 Storing options in a hash
+=head2 Storing option values in a hash
 
 Sometimes, for example when there are a lot of options, having a
 separate variable for each of them can be cumbersome. GetOptions()
@@ -1837,7 +1984,7 @@ The first level of bundling can be enabled with:
 
 Configured this way, single-character options can be bundled but long
 options B<must> always start with a double dash C<--> to avoid
-abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
+ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
 options,
 
     -vax
@@ -1990,7 +2137,7 @@ is equivalent to
     --foo --bar arg1 arg2 arg3
 
 If an argument callback routine is specified, C<@ARGV> will always be
-empty upon succesful return of GetOptions() since all options have been
+empty upon successful return of GetOptions() since all options have been
 processed. The only exception is when C<--> is used:
 
     --foo arg1 --bar arg2 -- arg3
@@ -2027,7 +2174,7 @@ auto_abbrev enabled, possible arguments and option settings are:
     -al, -la, -ala, -all,...     a, l
     --al, --all                  all
 
-The suprising part is that C<--a> sets option C<a> (due to auto
+The surprising part is that C<--a> sets option C<a> (due to auto
 completion), not C<all>.
 
 Note: disabling C<bundling> also disables C<bundling_override>.
@@ -2111,8 +2258,21 @@ sufficient, see C<prefix_pattern>.
 =item prefix_pattern
 
 A Perl pattern that identifies the strings that introduce options.
-Default is C<(--|-|\+)> unless environment variable
-POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
+Default is C<--|-|\+> unless environment variable
+POSIXLY_CORRECT has been set, in which case it is C<--|->.
+
+=item long_prefix_pattern
+
+A Perl pattern that allows the disambiguation of long and short
+prefixes. Default is C<-->.
+
+Typically you only need to set this if you are using nonstandard
+prefixes and want some or all of them to have the same semantics as
+'--' does under normal circumstances.
+
+For example, setting prefix_pattern to C<--|-|\+|\/> and
+long_prefix_pattern to C<--|\/> would add Win32 style argument
+handling.
 
 =item debug (default: disabled)
 
@@ -2324,7 +2484,7 @@ Johan Vromans <jvromans@squirrel.nl>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 2003,1990 by Johan Vromans.
+This program is Copyright 1990,2005 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/IPC/Open2.pm b/gnu/usr.bin/perl/lib/IPC/Open2.pm
index a5a3561794e..ecd1e7f9dec 100644
--- a/gnu/usr.bin/perl/lib/IPC/Open2.pm
+++ b/gnu/usr.bin/perl/lib/IPC/Open2.pm
@@ -6,7 +6,7 @@ our ($VERSION, @ISA, @EXPORT);
 require 5.000;
 require Exporter;
 
-$VERSION	= 1.01;
+$VERSION	= 1.02;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open2);
 
@@ -18,31 +18,31 @@ IPC::Open2, open2 - open a process for both reading and writing
 
     use IPC::Open2;
 
-    $pid = open2(\*RDRFH, \*WTRFH, 'some cmd and args');
+    $pid = open2(\*CHLD_OUT, \*CHLD_IN, 'some cmd and args');
       # or without using the shell
-    $pid = open2(\*RDRFH, \*WTRFH, 'some', 'cmd', 'and', 'args');
+    $pid = open2(\*CHLD_OUT, \*CHLD_IN, 'some', 'cmd', 'and', 'args');
 
     # or with handle autovivification
-    my($rdrfh, $wtrfh);
-    $pid = open2($rdrfh, $wtrfh, 'some cmd and args');
+    my($chld_out, $chld_in);
+    $pid = open2($chld_out, $chld_in, 'some cmd and args');
       # or without using the shell
-    $pid = open2($rdrfh, $wtrfh, 'some', 'cmd', 'and', 'args');
+    $pid = open2($chld_out, $chld_in, 'some', 'cmd', 'and', 'args');
 
 =head1 DESCRIPTION
 
-The open2() function runs the given $cmd and connects $rdrfh for
-reading and $wtrfh for writing.  It's what you think should work 
+The open2() function runs the given $cmd and connects $chld_out for
+reading and $chld_in for writing.  It's what you think should work 
 when you try
 
     $pid = open(HANDLE, "|cmd args|");
 
 The write filehandle will have autoflush turned on.
 
-If $rdrfh is a string (that is, a bareword filehandle rather than a glob
+If $chld_out is a string (that is, a bareword filehandle rather than a glob
 or a reference) and it begins with C<< >& >>, then the child will send output
-directly to that file handle.  If $wtrfh is a string that begins with
-C<< <& >>, then $wtrfh will be closed in the parent, and the child will read
-from it directly.  In both cases, there will be a dup(2) instead of a
+directly to that file handle.  If $chld_in is a string that begins with
+C<< <& >>, then $chld_in will be closed in the parent, and the child will
+read from it directly.  In both cases, there will be a dup(2) instead of a
 pipe(2) made.
 
 If either reader or writer is the null string, this will be replaced
diff --git a/gnu/usr.bin/perl/lib/IPC/Open3.pm b/gnu/usr.bin/perl/lib/IPC/Open3.pm
index 1d070b5deae..f857e98495b 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.0106;
+$VERSION	= 1.02;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open3);
 
@@ -19,7 +19,7 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 
 =head1 SYNOPSIS
 
-    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH,
+    $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR,
 		    'some cmd and args', 'optarg', ...);
 
     my($wtr, $rdr, $err);
@@ -29,15 +29,17 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 =head1 DESCRIPTION
 
 Extremely similar to open2(), open3() spawns the given $cmd and
-connects RDRFH for reading, WTRFH for writing, and ERRFH for errors.  If
-ERRFH is false, or the same file descriptor as RDRFH, then STDOUT and 
-STDERR of the child are on the same filehandle.  The WTRFH will have
-autoflush turned on.
-
-If WTRFH begins with C<< <& >>, then WTRFH will be closed in the parent, and
-the child will read from it directly.  If RDRFH or ERRFH begins with
-C<< >& >>, then the child will send output directly to that filehandle.
-In both cases, there will be a dup(2) instead of a pipe(2) made.
+connects CHLD_OUT for reading from the child, CHLD_IN for writing to
+the child, and CHLD_ERR for errors.  If CHLD_ERR is false, or the
+same file descriptor as CHLD_OUT, then STDOUT and STDERR of the child
+are on the same filehandle.  The CHLD_IN will have autoflush turned
+on.
+
+If CHLD_IN begins with C<< <& >>, then CHLD_IN will be closed in the
+parent, and the child will read from it directly.  If CHLD_OUT or
+CHLD_ERR begins with C<< >& >>, then the child will send output
+directly to that filehandle.  In both cases, there will be a dup(2)
+instead of a pipe(2) made.
 
 If either reader or writer is the null string, this will be replaced
 by an autogenerated filehandle.  If so, you must pass a valid lvalue
@@ -95,7 +97,7 @@ The order of arguments differs from that of open2().
 # 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.8 2004/08/09 18:09:35 millert Exp $
+# $Id: Open3.pm,v 1.9 2006/03/28 19:23:07 millert Exp $
 #
 # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
 #
diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm
index 541753581fb..e40809e4f36 100644
--- a/gnu/usr.bin/perl/lib/Math/BigInt.pm
+++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm
@@ -18,10 +18,11 @@ package Math::BigInt;
 my $class = "Math::BigInt";
 require 5.005;
 
-$VERSION = '1.73';
-use Exporter;
-@ISA =       qw( Exporter );
-@EXPORT_OK = qw( objectify bgcd blcm); 
+$VERSION = '1.77';
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(objectify bgcd blcm); 
+
 # _trap_inf and _trap_nan are internal and should never be accessed from the
 # outside
 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode 
@@ -53,17 +54,18 @@ use overload
 '^='	=>	sub { $_[0]->bxor($_[1]); },
 '&='	=>	sub { $_[0]->band($_[1]); },
 '|='	=>	sub { $_[0]->bior($_[1]); },
-'**='	=>	sub { $_[0]->bpow($_[1]); },
 
+'**='	=>	sub { $_[0]->bpow($_[1]); },
 '<<='	=>	sub { $_[0]->blsft($_[1]); },
 '>>='	=>	sub { $_[0]->brsft($_[1]); },
 
 # not supported by Perl yet
 '..'	=>	\&_pointpoint,
 
+# we might need '==' and '!=' to get things like "NaN == NaN" right
 '<=>'	=>	sub { $_[2] ?
                       ref($_[0])->bcmp($_[1],$_[0]) : 
-                      $_[0]->bcmp($_[1])},
+                      $_[0]->bcmp($_[1]); },
 'cmp'	=>	sub {
          $_[2] ? 
                "$_[1]" cmp $_[0]->bstr() :
@@ -73,7 +75,13 @@ use overload
 'cos'	=>	sub { cos($_[0]->numify()) }, 
 'sin'	=>	sub { sin($_[0]->numify()) }, 
 'exp'	=>	sub { exp($_[0]->numify()) }, 
-'atan2'	=>	sub { atan2($_[0]->numify(),$_[1]) }, 
+'atan2'	=>	sub { $_[2] ?
+			atan2($_[1],$_[0]->numify()) :
+			atan2($_[0]->numify(),$_[1]) },
+
+# are not yet overloadable
+#'hex'	=>	sub { print "hex"; $_[0]; }, 
+#'oct'	=>	sub { print "oct"; $_[0]; }, 
 
 'log'	=>	sub { $_[0]->copy()->blog($_[1]); }, 
 'int'	=>	sub { $_[0]->copy(); }, 
@@ -84,8 +92,8 @@ use overload
 
 # for subtract it's a bit tricky to not modify b: b-a => -a+b
 '-'	=>	sub { my $c = $_[0]->copy; $_[2] ?
-                   $c->bneg()->badd( $_[1]) :
-                   $c->bsub( $_[1]) },
+			$c->bneg()->badd( $_[1]) :
+			$c->bsub( $_[1]) },
 '+'	=>	sub { $_[0]->copy()->badd($_[1]); },
 '*'	=>	sub { $_[0]->copy()->bmul($_[1]); },
 
@@ -137,8 +145,8 @@ use overload
 ##############################################################################
 # global constants, flags and accessory
 
-# these are public, but their usage is not recommended, use the accessor
-# methods instead
+# These vars are public, but their direct usage is not recommended, use the
+# accessor methods instead
 
 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
 $accuracy   = undef;
@@ -148,20 +156,19 @@ $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
-
-sub MB_NEVER_ROUND () { 0x0001; }
+# These are internally, and not to be used from the outside at all
 
 $_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
-					# default is Calc.pm
+my $CALC = 'Math::BigInt::FastCalc';	# module to do the low level math
+					# default is FastCalc.pm
 my $IMPORT = 0;				# was import() called yet?
 					# used to make require work
 my %WARN;				# warn only once for low-level libs
 my %CAN;				# cache for $CALC->can(...)
+my %CALLBACKS;				# callbacks to notify on lib loads
 my $EMU_LIB = 'Math/BigInt/CalcEmu.pm';	# emulate low-level math
 
 ##############################################################################
@@ -212,8 +219,7 @@ sub upgrade
   # need to set new value?
   if (@_ > 0)
     {
-    my $u = shift;
-    return ${"${class}::upgrade"} = $u;
+    return ${"${class}::upgrade"} = $_[0];
     }
   ${"${class}::upgrade"};
   }
@@ -227,8 +233,7 @@ sub downgrade
   # need to set new value?
   if (@_ > 0)
     {
-    my $u = shift;
-    return ${"${class}::downgrade"} = $u;
+    return ${"${class}::downgrade"} = $_[0];
     }
   ${"${class}::downgrade"};
   }
@@ -245,7 +250,7 @@ sub div_scale
       {
       require Carp; Carp::croak ('div_scale must be greater than zero');
       }
-    ${"${class}::div_scale"} = shift;
+    ${"${class}::div_scale"} = $_[0];
     }
   ${"${class}::div_scale"};
   }
@@ -299,12 +304,12 @@ sub accuracy
     return $a;				# shortcut
     }
 
-  my $r;
+  my $a;
   # $object->accuracy() or fallback to global
-  $r = $x->{_a} if ref($x);
+  $a = $x->{_a} if ref($x);
   # but don't return global undef, when $x's accuracy is 0!
-  $r = ${"${class}::accuracy"} if !defined $r;
-  $r;
+  $a = ${"${class}::accuracy"} if !defined $a;
+  $a;
   }
 
 sub precision
@@ -345,12 +350,12 @@ sub precision
     return $p;				# shortcut
     }
 
-  my $r;
+  my $p;
   # $object->precision() or fallback to global
-  $r = $x->{_p} if ref($x);
+  $p = $x->{_p} if ref($x);
   # but don't return global undef, when $x's precision is 0!
-  $r = ${"${class}::precision"} if !defined $r;
-  $r;
+  $p = ${"${class}::precision"} if !defined $p;
+  $p;
   }
 
 sub config
@@ -419,22 +424,34 @@ sub _scale_a
   { 
   # select accuracy parameter based on precedence,
   # used by bround() and bfround(), may return undef for scale (means no op)
-  my ($x,$s,$m,$scale,$mode) = @_;
-  $scale = $x->{_a} if !defined $scale;
-  $scale = $s if (!defined $scale);
-  $mode = $m if !defined $mode;
-  return ($scale,$mode);
+  my ($x,$scale,$mode) = @_;
+
+  $scale = $x->{_a} unless defined $scale;
+
+  no strict 'refs';
+  my $class = ref($x);
+
+  $scale = ${ $class . '::accuracy' } unless defined $scale;
+  $mode = ${ $class . '::round_mode' } unless defined $mode;
+
+  ($scale,$mode);
   }
 
 sub _scale_p
   { 
   # select precision parameter based on precedence,
   # used by bround() and bfround(), may return undef for scale (means no op)
-  my ($x,$s,$m,$scale,$mode) = @_;
-  $scale = $x->{_p} if !defined $scale;
-  $scale = $s if (!defined $scale);
-  $mode = $m if !defined $mode;
-  return ($scale,$mode);
+  my ($x,$scale,$mode) = @_;
+  
+  $scale = $x->{_p} unless defined $scale;
+
+  no strict 'refs';
+  my $class = ref($x);
+
+  $scale = ${ $class . '::precision' } unless defined $scale;
+  $mode = ${ $class . '::round_mode' } unless defined $mode;
+
+  ($scale,$mode);
   }
 
 ##############################################################################
@@ -455,7 +472,7 @@ sub copy
     }
   return unless ref($x); # only for objects
 
-  my $self = {}; bless $self,$c;
+  my $self = bless {}, $c;
 
   $self->{sign} = $x->{sign};
   $self->{value} = $CALC->_copy($x->{value});
@@ -511,11 +528,10 @@ sub new
     }
 
   # handle '+inf', '-inf' first
-  if ($wanted =~ /^[+-]?inf$/)
+  if ($wanted =~ /^[+-]?inf\z/)
     {
-    $self->{value} = $CALC->_zero();
-    $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
-    return $self;
+    $self->{sign} = $wanted;		# set a default sign for bstr()
+    return $self->binf($wanted);
     }
   # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
   my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
@@ -646,7 +662,7 @@ sub binf
   if (${"${class}::_trap_inf"})
     {
     require Carp;
-    Carp::croak ("Tried to set $self to +-inf in $class\::binfn()");
+    Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
     }
   $self->import() if $IMPORT == 0;		# make require work
   return if $self->modify('binf');
@@ -761,8 +777,7 @@ sub bsstr
   # (ref to BFLOAT or num_str ) return num_str
   # Convert number from internal format to scientific string format.
   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
-  my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); 
-  # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 
 
   if ($x->{sign} !~ /^[+-]$/)
     {
@@ -778,8 +793,7 @@ sub bsstr
 sub bstr 
   {
   # make a string from bigint object
-  my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); 
-  # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 
 
   if ($x->{sign} !~ /^[+-]$/)
     {
@@ -832,9 +846,6 @@ sub _find_round_parameters
   # $r round_mode, if given by caller
   # @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;
-
   my $c = ref($self);				# find out class of argument(s)
   no strict 'refs';
 
@@ -892,10 +903,6 @@ sub round
   # $r round_mode, if given by caller
   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 
-  # leave bigfloat parts alone (that is only used in BigRat for now and can be
-  # removed once we rewrote BigRat))
-  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';
 
@@ -962,7 +969,7 @@ sub babs
   {
   # (BINT or num_str) return BINT
   # make number absolute, or return absolute BINT from string
-  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 
   return $x if $x->modify('babs');
   # post-normalized abs for internal use (does nothing for NaN)
@@ -974,12 +981,12 @@ sub bneg
   { 
   # (BINT or num_str) return BINT
   # negate number or make a negated number from string
-  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
   
   return $x if $x->modify('bneg');
 
-  # for +0 dont negate (to have always normalized)
-  $x->{sign} =~ tr/+-/-+/ if !$x->is_zero();	# does nothing for NaN
+  # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
+  $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
   $x;
   }
 
@@ -1117,8 +1124,7 @@ sub badd
       $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
       }
     }
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-  $x;
+  $x->round(@r);
   }
 
 sub bsub 
@@ -1139,21 +1145,19 @@ sub bsub
   return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
    ((!$x->isa($self)) || (!$y->isa($self)));
 
-  if ($y->is_zero())
-    { 
-    $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-    return $x;
-    }
+  return $x->round(@r) if $y->is_zero();
 
-  require Scalar::Util;
-  if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y)) 
+  # To correctly handle the lone special case $x->bsub($x), we note the sign
+  # of $x, then flip the sign from $y, and if the sign of $x did change, too,
+  # then we caught the special case:
+  my $xsign = $x->{sign};
+  $y->{sign} =~ tr/+\-/-+/; 	# does nothing for NaN
+  if ($xsign ne $x->{sign})
     {
-    # if we get the same variable twice, the result must be zero (the code
-    # below fails in that case)
-    return $x->bzero(@r) if $x->{sign} =~ /^[+-]$/;
+    # special case of $x->bsub($x) results in 0
+    return $x->bzero(@r) if $xsign =~ /^[+-]$/;
     return $x->bnan();          # NaN, -inf, +inf
     }
-  $y->{sign} =~ tr/+\-/-+/; 	# does nothing for NaN
   $x->badd($y,@r); 		# badd does not leave internal zeros
   $y->{sign} =~ tr/+\-/-+/; 	# refix $y (does nothing for NaN)
   $x;				# already rounded by badd() or no round necc.
@@ -1168,15 +1172,13 @@ sub binc
   if ($x->{sign} eq '+')
     {
     $x->{value} = $CALC->_inc($x->{value});
-    $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-    return $x;
+    return $x->round($a,$p,$r);
     }
   elsif ($x->{sign} eq '-')
     {
     $x->{value} = $CALC->_dec($x->{value});
     $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
-    $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-    return $x;
+    return $x->round($a,$p,$r);
     }
   # inf, nan handling etc
   $x->badd($self->bone(),$a,$p,$r);		# badd does round
@@ -1190,12 +1192,12 @@ sub bdec
   
   if ($x->{sign} eq '-')
     {
-    # < 0
+    # x already < 0
     $x->{value} = $CALC->_inc($x->{value});
     } 
   else
     {
-    return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf/NaN
+    return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; 	# inf or NaN
     # >= 0
     if ($CALC->_is_zero($x->{value}))
       {
@@ -1208,8 +1210,7 @@ sub bdec
       $x->{value} = $CALC->_dec($x->{value});
       }
     }
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-  $x;
+  $x->round(@r);
   }
 
 sub blog
@@ -1218,11 +1219,11 @@ sub blog
   # $base of $x)
 
   # set up parameters
-  my ($self,$x,$base,@r) = (ref($_[0]),@_);
+  my ($self,$x,$base,@r) = (undef,@_);
   # objectify is costly, so avoid it
   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
     {
-    ($self,$x,$base,@r) = objectify(1,$class,@_);
+    ($self,$x,$base,@r) = objectify(1,ref($x),@_);
     }
   
   return $x if $x->modify('blog');
@@ -1279,9 +1280,9 @@ sub bgcd
   while (@_)
     {
     $y = shift; $y = $self->new($y) if !ref($y);
-    next if $y->is_zero();
     return $x->bnan() if $y->{sign} !~ /^[+-]$/;	# y NaN?
-    $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
+    $x->{value} = $CALC->_gcd($x->{value},$y->{value});
+    last if $CALC->_is_one($x->{value});
     }
   $x;
   }
@@ -1365,8 +1366,11 @@ sub is_positive
   {
   # return true when arg (BINT or num_str) is positive (>= 0)
   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
-  
-  $x->{sign} =~ /^\+/ ? 1 : 0;		# +inf is also positive, but NaN not
+
+  return 1 if $x->{sign} eq '+inf';			# +inf is positive
+ 
+  # 0+ is neither positive nor negative
+  ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;	
   }
 
 sub is_negative
@@ -1374,7 +1378,7 @@ sub is_negative
   # return true when arg (BINT or num_str) is negative (< 0)
   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
   
-  $x->{sign} =~ /^-/ ? 1 : 0; 		# -inf is also negative, but NaN not
+  $x->{sign} =~ /^-/ ? 1 : 0; 		# -inf is negative, but NaN is not
   }
 
 sub is_int
@@ -1427,8 +1431,7 @@ sub bmul
   $x->{value} = $CALC->_mul($x->{value},$y->{value});	# do actual math
   $x->{sign} = '+' if $CALC->_is_zero($x->{value}); 	# no -0
 
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-  $x;
+  $x->round(@r);
   }
 
 sub _div_inf
@@ -1510,7 +1513,7 @@ sub bdiv
     $x->{sign} = '+' if $CALC->_is_zero($x->{value});
     $rem->{_a} = $x->{_a};
     $rem->{_p} = $x->{_p};
-    $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
+    $x->round(@r);
     if (! $CALC->_is_zero($rem->{value}))
       {
       $rem->{sign} = $y->{sign};
@@ -1520,15 +1523,14 @@ sub bdiv
       {
       $rem->{sign} = '+';			# dont leave -0
       }
-    $rem->round(@r) if !exists $rem->{_f} || ($rem->{_f} & MB_NEVER_ROUND) == 0;
+    $rem->round(@r);
     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;
+  $x->round(@r);
   }
 
 ###############################################################################
@@ -1561,20 +1563,15 @@ sub bmod
   $x->{value} = $CALC->_mod($x->{value},$y->{value});
   if (!$CALC->_is_zero($x->{value}))
     {
-    my $xsign = $x->{sign};
+    $x->{value} = $CALC->_sub($y->{value},$x->{value},1) 	# $y-$x
+      if ($x->{sign} ne $y->{sign});
     $x->{sign} = $y->{sign};
-    if ($xsign ne $y->{sign})
-      {
-      my $t = $CALC->_copy($x->{value});		# copy $x
-      $x->{value} = $CALC->_sub($y->{value},$t,1); 	# $y-$x
-      }
     }
    else
     {
     $x->{sign} = '+';				# dont leave -0
     }
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-  $x;
+  $x->round(@r);
   }
 
 sub bmodinv
@@ -1585,7 +1582,7 @@ sub bmodinv
   # (i.e. their gcd is not one) then NaN is returned.
 
   # set up parameters
-  my ($self,$x,$y,@r) = (ref($_[0]),@_);
+  my ($self,$x,$y,@r) = (undef,@_);
   # objectify is costly, so avoid it
   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
     {
@@ -1648,12 +1645,10 @@ sub bfac
   {
   # (BINT or num_str, BINT or num_str) return BINT
   # compute factorial number from $x, modify $x in place
-  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+  my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
 
-  return $x if $x->modify('bfac');
- 
-  return $x if $x->{sign} eq '+inf';		# inf => inf
-  return $x->bnan() if $x->{sign} ne '+';	# NaN, <0 etc => NaN
+  return $x if $x->modify('bfac') || $x->{sign} eq '+inf';	# inf => inf
+  return $x->bnan() if $x->{sign} ne '+';			# NaN, <0 etc => NaN
 
   $x->{value} = $CALC->_fac($x->{value});
   $x->round(@r);
@@ -1746,8 +1741,7 @@ sub bpow
   $x->{value} = $CALC->_pow($x->{value},$y->{value});
   $x->{sign} = $new_sign;
   $x->{sign} = '+' if $CALC->_is_zero($y->{value});
-  $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
-  $x;
+  $x->round(@r);
   }
 
 sub blsft 
@@ -1983,7 +1977,7 @@ sub _trailing_zeros
 sub bsqrt
   {
   # calculate square root of $x
-  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+  my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
 
   return $x if $x->modify('bsqrt');
 
@@ -2075,7 +2069,7 @@ sub bfround
   # $n == 0 || $n == 1 => round to integer
   my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
 
-  my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
+  my ($scale,$mode) = $x->_scale_p(@_);
 
   return $x if !defined $scale || $x->modify('bfround');	# no-op
 
@@ -2104,7 +2098,7 @@ sub fround
   {
   # Exists to make life easier for switch between MBF and MBI (should we
   # autoload fxxx() like MBF does for bxxx()?)
-  my $x = shift;
+  my $x = shift; $x = $class->new($x) unless ref $x;
   $x->bround(@_);
   }
 
@@ -2117,9 +2111,8 @@ sub bround
   # do not return $x->bnorm(), but $x
 
   my $x = shift; $x = $class->new($x) unless ref $x;
-  my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
-  return $x if !defined $scale;			# no-op
-  return $x if $x->modify('bround');
+  my ($scale,$mode) = $x->_scale_a(@_);
+  return $x if !defined $scale || $x->modify('bround');	# no-op
   
   if ($x->is_zero() || $scale == 0)
     {
@@ -2361,6 +2354,18 @@ sub objectify
   @a;
   }
 
+sub _register_callback
+  {
+  my ($class,$callback) = @_;
+
+  if (ref($callback) ne 'CODE')
+    { 
+    require Carp;
+    Carp::croak ("$callback is not a coderef");
+    }
+  $CALLBACKS{$class} = $callback;
+  }
+
 sub import 
   {
   my $self = shift;
@@ -2394,13 +2399,21 @@ sub import
       }
     }
   # any non :constant stuff is handled by our parent, Exporter
-  # even if @_ is empty, to give it a chance 
-  $self->SUPER::import(@a);			# need it for subclasses
-  $self->export_to_level(1,$self,@a);		# need it for MBF
+  if (@a > 0)
+    {
+    require Exporter;
+ 
+    $self->SUPER::import(@a);			# need it for subclasses
+    $self->export_to_level(1,$self,@a);		# need it for MBF
+    }
 
   # try to load core math lib
   my @c = split /\s*,\s*/,$CALC;
-  push @c,'Calc';				# if all fail, try this
+  foreach (@c)
+    {
+    $_ =~ tr/a-zA-Z0-9://cd;			# limit to sane characters
+    }
+  push @c, 'FastCalc', 'Calc';			# if all fail, try these
   $CALC = '';					# signal error
   foreach my $lib (@c)
     {
@@ -2409,8 +2422,8 @@ sub import
     $lib =~ s/\.pm$//;
     if ($] < 5.006)
       {
-      # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
-      # used in the same script, or eval inside import().
+      # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
+      # used in the same script, or eval("") inside import().
       my @parts = split /::/, $lib;             # Math::BigInt => Math BigInt
       my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
       require File::Spec;
@@ -2461,7 +2474,7 @@ sub import
 	{
 	if (($WARN{$lib}||0) < 2)
 	  {
-	  my $ver = eval "\$$lib\::VERSION";
+	  my $ver = eval "\$$lib\::VERSION" || 'unknown';
 	  require Carp;
 	  Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
 	  $WARN{$lib} = 2;		# never warn again
@@ -2474,22 +2487,28 @@ sub import
     require Carp;
     Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'");
     }
-  _fill_can_cache();		# for emulating lower math lib functions
-  }
 
-sub _fill_can_cache
-  {
-  # fill $CAN with the results of $CALC->can(...)
+  # notify callbacks
+  foreach my $class (keys %CALLBACKS)
+    {
+    &{$CALLBACKS{$class}}($CALC);
+    }
+
+  # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
+  # functions
 
   %CAN = ();
-  for my $method (qw/ signed_and or signed_or xor signed_xor /)
+  for my $method (qw/ signed_and signed_or signed_xor /)
     {
     $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
     }
+
+  # import done
   }
 
 sub __from_hex
   {
+  # internal
   # convert a (ref to) big hex string to BigInt, return undef for error
   my $hs = shift;
 
@@ -2511,6 +2530,7 @@ sub __from_hex
 
 sub __from_bin
   {
+  # internal
   # convert a (ref to) big binary string to BigInt, return undef for error
   my $bs = shift;
 
@@ -2530,10 +2550,11 @@ sub __from_bin
 
 sub _split
   {
-  # (ref to num_str) return num_str
-  # internal, take apart a string and return the pieces
-  # strip leading/trailing whitespace, leading zeros, underscore and reject
-  # invalid input
+  # input: num_str; output: undef for invalid or
+  # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,\$exp_sign,\$exp_value)
+  # Internal, take apart a string and return the pieces.
+  # Strip leading/trailing whitespace, leading zeros, underscore and reject
+  # invalid input.
   my $x = shift;
 
   # strip white space at front, also extranous leading zeros
@@ -2601,13 +2622,15 @@ sub __lcm
   # does modify first argument
   # LCM
  
-  my $x = shift; my $ty = shift;
+  my ($x,$ty) = @_;
   return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
-  $x * $ty / bgcd($x,$ty);
+  my $method = ref($x) . '::bgcd';
+  no strict 'refs';
+  $x * $ty / &$method($x,$ty);
   }
 
 ###############################################################################
-# this method return 0 if the object can be modified, or 1 for not
+# this method returns 0 if the object can be modified, or 1 if not.
 # We use a fast constant sub() here, to avoid costly calls. Subclasses
 # may override it with special code (f.i. Math::BigInt::Constant does so)
 
@@ -2616,9 +2639,11 @@ sub modify () { 0; }
 1;
 __END__
 
+=pod
+
 =head1 NAME
 
-Math::BigInt - Arbitrary size integer math package
+Math::BigInt - Arbitrary size integer/float math package
 
 =head1 SYNOPSIS
 
@@ -2727,7 +2752,7 @@ Math::BigInt - Arbitrary size integer math package
  
   $x->length();		   # return number of digits in number
   ($xl,$f) = $x->length(); # length of number and length of fraction part,
-			   # latter is always 0 digits long for BigInt's
+			   # latter is always 0 digits long for BigInts
 
   $x->exponent();	   # return exponent as BigInt
   $x->mantissa();	   # return (signed) mantissa as BigInt
@@ -2737,8 +2762,8 @@ Math::BigInt - Arbitrary size integer math package
   $x->numify();		   # return as scalar (might overflow!)
   
   # conversation to string (do not modify their argument)
-  $x->bstr();		   # normalized string
-  $x->bsstr();		   # normalized string in scientific notation
+  $x->bstr();		   # normalized string (e.g. '3')
+  $x->bsstr();		   # norm. string in scientific notation (e.g. '3E0')
   $x->as_hex();		   # as signed hexadecimal string with prefixed 0x
   $x->as_bin();		   # as signed binary string with prefixed 0b
 
@@ -2750,9 +2775,11 @@ Math::BigInt - Arbitrary size integer math package
   $x->accuracy($n);	   # set A $x to $n
 
   # 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
+  Math::BigInt->precision();	# get/set global P for all BigInt objects
+  Math::BigInt->accuracy(); 	# get/set global A for all BigInt objects
+  Math::BigInt->round_mode();	# get/set global round mode, one of
+				# 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+  Math::BigInt->config();	# return hash containing configuration
 
 =head1 DESCRIPTION
 
@@ -2796,19 +2823,20 @@ object from the input.
 
 =item Output
 
-Output values are BigInt objects (normalized), except for bstr(), which
-returns a string in normalized form.
+Output values are BigInt objects (normalized), except for the methods which
+return a string (see L<SYNOPSIS>).
+
 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
-C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
-return either undef, <0, 0 or >0 and are suited for sort.
+C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>)
+return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort.
 
 =back
 
 =head1 METHODS
 
 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
+accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R>
+are C<accuracy>, C<precision> and C<round_mode>. Please see the section about
 L<ACCURACY and PRECISION> for more information.
 
 =head2 config
@@ -2863,11 +2891,26 @@ Example:
 
 	$x->accuracy(5);		# local for $x
 	CLASS->accuracy(5);		# global for all members of CLASS
-	$A = $x->accuracy();		# read out
-	$A = CLASS->accuracy();		# read out
+					# Note: This also applies to new()!
+
+	$A = $x->accuracy();		# read out accuracy that affects $x
+	$A = CLASS->accuracy();		# read out global accuracy
 
 Set or get the global or local accuracy, aka how many significant digits the
-results have. 
+results have. If you set a global accuracy, then this also applies to new()!
+
+Warning! The accuracy I<sticks>, e.g. once you created a number under the
+influence of C<< CLASS->accuracy($A) >>, all results from math operations with
+that number will also be rounded. 
+
+In most cases, you should probably round the results explicitely using one of
+L<round()>, L<bround()> or L<bfround()> or by passing the desired accuracy
+to the math operation as additional parameter:
+
+        my $x = Math::BigInt->new(30000);
+        my $y = Math::BigInt->new(7);
+        print scalar $x->copy()->bdiv($y, 2);		# print 4300
+        print scalar $x->copy()->bdiv($y)->bround(2);	# print 4300
 
 Please see the section about L<ACCURACY AND PRECISION> for further details.
 
@@ -2882,7 +2925,7 @@ represents the accuracy that will be in effect for $x:
 
 	$y = Math::BigInt->new(1234567);	# unrounded
 	print Math::BigInt->accuracy(4),"\n";	# set 4, print 4
-	$x = Math::BigInt->new(123456);		# will be automatically rounded
+	$x = Math::BigInt->new(123456);		# $x will be automatically rounded!
 	print "$x $y\n";			# '123500 1234567'
 	print $x->accuracy(),"\n";		# will be 4
 	print $y->accuracy(),"\n";		# also 4, since global is 4
@@ -2897,35 +2940,46 @@ 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
+	$x->precision(-2);	# local for $x, round at the second digit right of the dot
+	$x->precision(2);	# ditto, round at the second digit left of the dot
+
+	CLASS->precision(5);	# Global for all members of CLASS
+				# This also applies to new()!
+	CLASS->precision(-5);	# ditto
+
+	$P = CLASS->precision();	# read out global precision 
+	$P = $x->precision();		# read out precision that affects $x
+
+Note: You probably want to use L<accuracy()> instead. With L<accuracy> you
+set the number of digits each result should have, with L<precision> you
+set the place where to round!
 
-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.
+C<precision()> sets or gets the global or local precision, aka at which digit
+before or after the dot to round all results. A set global precision also
+applies to all newly created numbers!
+
+In Math::BigInt, passing a negative number precision has no effect since no
+numbers have digits after the dot. In L<Math::BigFloat>, it will round all
+results to P 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:
+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:
+value represents the prevision 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
+	print $x;				# print "120000"!
 
-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
+Note: Works also for subclasses like L<Math::BigFloat>. Each class has its
+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.
 
@@ -3022,12 +3076,12 @@ like:
 
 =head2 is_pos()/is_neg()
 	
-	$x->is_pos();			# true if >= 0
-	$x->is_neg();			# true if <  0
+	$x->is_pos();			# true if > 0
+	$x->is_neg();			# true if < 0
 
 The methods return true if the argument is positive or negative, respectively.
 C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
-C<-inf> is negative. A C<zero> is positive.
+C<-inf> is negative. A C<zero> is neither positive nor negative.
 
 These methods are only testing the sign, and not the value.
 
@@ -3066,6 +3120,14 @@ Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
 
 Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
 
+If you want $x to have a certain sign, use one of the following methods:
+
+	$x->babs();		# '+'
+	$x->babs()->bneg();	# '-'
+	$x->bnan();		# 'NaN'
+	$x->binf();		# '+inf'
+	$x->binf('-');		# '-inf'
+
 =head2 digit
 
 	$x->digit($n);		# return the nth digit, counting from right
@@ -3645,12 +3707,58 @@ This is how it works now:
 
 =back
 
+=head1 Infinity and Not a Number
+
+While BigInt has extensive handling of inf and NaN, certain quirks remain.
+
+=over 2
+
+=item oct()/hex()
+
+These perl routines currently (as of Perl v.5.8.6) cannot handle passed
+inf.
+
+	te@linux:~> perl -wle 'print 2 ** 3333'
+	inf
+	te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
+	1
+	te@linux:~> perl -wle 'print oct(2 ** 3333)'
+	0
+	te@linux:~> perl -wle 'print hex(2 ** 3333)'
+	Illegal hexadecimal digit 'i' ignored at -e line 1.
+	0
+
+The same problems occur if you pass them Math::BigInt->binf() objects. Since
+overloading these routines is not possible, this cannot be fixed from BigInt.
+
+=item ==, !=, <, >, <=, >= with NaNs
+
+BigInt's bcmp() routine currently returns undef to signal that a NaN was
+involved in a comparisation. However, the overload code turns that into
+either 1 or '' and thus operations like C<< NaN != NaN >> might return
+wrong values.
+
+=item log(-inf)
+
+C<< log(-inf) >> is highly weird. Since log(-x)=pi*i+log(x), then
+log(-inf)=pi*i+inf. However, since the imaginary part is finite, the real
+infinity "overshadows" it, so the number might as well just be infinity.
+However, the result is a complex number, and since BigInt/BigFloat can only
+have real numbers as results, the result is NaN.
+
+=item exp(), cos(), sin(), atan2()
+
+These all might have problems handling infinity right.
+ 
+=back
+
 =head1 INTERNALS
 
 The actual numbers are stored as unsigned big integers (with seperate sign).
+
 You should neither care about nor depend on the internal representation; it
-might change without notice. Use only method calls like C<< $x->sign(); >>
-instead relying on the internal hash keys like in C<< $x->{sign}; >>. 
+might change without notice. Use B<ONLY> method calls like C<< $x->sign(); >>
+instead relying on the internal representation.
 
 =head2 MATH LIBRARY
 
@@ -3669,20 +3777,21 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
 	use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
 
 Since Math::BigInt::GMP is in almost all cases faster than Calc (especially in
-cases involving really big numbers, where it is B<much> faster), and there is
+math involving really big numbers, where it is B<much> faster), and there is
 no penalty if Math::BigInt::GMP is not installed, it is a good idea to always
 use the following:
 
 	use Math::BigInt lib => 'GMP';
 
 Different low-level libraries use different formats to store the
-numbers. You should not depend on the number having a specific format.
+numbers. You should B<NOT> depend on the number having a specific format
+internally.
 
 See the respective math library module documentation for further details.
 
 =head2 SIGN
 
-The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
+The sign is either '+', '-', 'NaN', '+inf' or '-inf'.
 
 A sign of 'NaN' is used to represent the result when input arguments are not
 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
@@ -4042,6 +4151,9 @@ Alternatively, simple use C<< <=> >> for comparisations, this will get it
 always right. There is not yet a way to get a number automatically represented
 as a string that matches exactly the way Perl represents it.
 
+See also the section about L<Infinity and Not a Number> for problems in
+comparing NaNs.
+
 =item int()
 
 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a 
@@ -4052,15 +4164,26 @@ Perl scalar:
 	$x = Math::BigFloat->new(123.45);
 	$y = int($x);				# BigInt 123
 
-In all Perl versions you can use C<as_number()> for the same effect:
+In all Perl versions you can use C<as_number()> or C<as_int> for the same
+effect:
 
 	$x = Math::BigFloat->new(123.45);
 	$y = $x->as_number();			# BigInt 123
+	$y = $x->as_int();			# ditto
 
 This also works for other subclasses, like Math::String.
 
 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
 
+If you want a real Perl scalar, use C<numify()>:
+
+	$y = $x->numify();			# 123 as scalar
+
+This is seldom necessary, though, because this is done automatically, like
+when you access an array:
+
+	$z = $array[$x];			# does work automatically
+
 =item length
 
 The following will probably not do what you expect:
@@ -4213,9 +4336,6 @@ since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
 needs to preserve $x since it does not know that it later will get overwritten.
 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
 
-With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
-since it is slower for all other things.
-
 =item Mixing different object types
 
 In Perl you will get a floating point value if you do one of the following:
@@ -4320,8 +4440,8 @@ 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 - 2003
-and still at it in 2004.
+Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2004
+and still at it in 2005.
 
 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
diff --git a/gnu/usr.bin/perl/lib/Math/Complex.pm b/gnu/usr.bin/perl/lib/Math/Complex.pm
index 400366ce757..e4b980bd658 100644
--- a/gnu/usr.bin/perl/lib/Math/Complex.pm
+++ b/gnu/usr.bin/perl/lib/Math/Complex.pm
@@ -7,9 +7,9 @@
 
 package Math::Complex;
 
-our($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $Inf);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $Inf);
 
-$VERSION = 1.34;
+$VERSION = 1.35;
 
 BEGIN {
     unless ($^O eq 'unicosmk') {
@@ -38,7 +38,8 @@ my $i;
 my %LOGN;
 
 # Regular expression for floating point numbers.
-my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?)))';
+# These days we could use Scalar::Util::lln(), I guess.
+my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?))|inf)'i;
 
 require Exporter;
 
@@ -61,9 +62,12 @@ my @trig = qw(
 	     sqrt log ln
 	     log10 logn cbrt root
 	     cplx cplxe
+	     atan2
 	     ),
 	   @trig);
 
+@EXPORT_OK = qw(decplx);
+
 %EXPORT_TAGS = (
     'trig' => [@trig],
 );
@@ -108,27 +112,53 @@ my $eps            = 1e-14;		# Epsilon
 # Die on bad *make() arguments.
 
 sub _cannot_make {
-    die "@{[(caller(1))[3]]}: Cannot take $_[0] of $_[1].\n";
+    die "@{[(caller(1))[3]]}: Cannot take $_[0] of '$_[1]'.\n";
 }
 
-sub _remake {
+sub _make {
     my $arg = shift;
-    my ($made, $p, $q);
+    my ($p, $q);
 
-    if ($arg =~ /^(?:$gre)?$gre\s*i\s*$/) {
+    if ($arg =~ /^$gre$/) {
+	($p, $q) = ($1, 0);
+    } elsif ($arg =~ /^(?:$gre)?$gre\s*i\s*$/) {
 	($p, $q) = ($1 || 0, $2);
-	$made = 'cart';
-    } elsif ($arg =~ /^\s*\[\s*$gre\s*(?:,\s*$gre\s*)?\]\s*$/) {
+    } elsif ($arg =~ /^\s*\(\s*$gre\s*(?:,\s*$gre\s*)?\)\s*$/) {
 	($p, $q) = ($1, $2 || 0);
-	$made = 'exp';
     }
 
-    if ($made) {
+    if (defined $p) {
 	$p =~ s/^\+//;
+	$p =~ s/^(-?)inf$/"${1}9**9**9"/e;
 	$q =~ s/^\+//;
+	$q =~ s/^(-?)inf$/"${1}9**9**9"/e;
     }
 
-    return ($made, $p, $q);
+    return ($p, $q);
+}
+
+sub _emake {
+    my $arg = shift;
+    my ($p, $q);
+
+    if ($arg =~ /^\s*\[\s*$gre\s*(?:,\s*$gre\s*)?\]\s*$/) {
+	($p, $q) = ($1, $2 || 0);
+    } elsif ($arg =~ m!^\s*\[\s*$gre\s*(?:,\s*([-+]?\d*\s*)?pi(?:/\s*(\d+))?\s*)?\]\s*$!) {
+	($p, $q) = ($1, ($2 eq '-' ? -1 : ($2 || 1)) * pi() / ($3 || 1));
+    } elsif ($arg =~ /^\s*\[\s*$gre\s*\]\s*$/) {
+	($p, $q) = ($1, 0);
+    } elsif ($arg =~ /^\s*$gre\s*$/) {
+	($p, $q) = ($1, 0);
+    }
+
+    if (defined $p) {
+	$p =~ s/^\+//;
+	$q =~ s/^\+//;
+	$p =~ s/^(-?)inf$/"${1}9**9**9"/e;
+	$q =~ s/^(-?)inf$/"${1}9**9**9"/e;
+    }
+
+    return ($p, $q);
 }
 
 #
@@ -137,42 +167,26 @@ sub _remake {
 # Create a new complex number (cartesian form)
 #
 sub make {
-	my $self = bless {}, shift;
-	my ($re, $im) = @_;
-	if (@_ == 1) {
-	    my ($remade, $p, $q) = _remake($re);
-	    if ($remade) {
-		if ($remade eq 'cart') {
-		    ($re, $im) = ($p, $q);
-		} else {
-		    return (ref $self)->emake($p, $q);
-		}
-	    }
-	}
-	my $rre = ref $re;
-	if ( $rre ) {
-	    if ( $rre eq ref $self ) {
-		$re = Re($re);
-	    } else {
-		_cannot_make("real part", $rre);
-	    }
-	}
-	my $rim = ref $im;
-	if ( $rim ) {
-	    if ( $rim eq ref $self ) {
-		$im = Im($im);
-	    } else {
-		_cannot_make("imaginary part", $rim);
-	    }
-	}
+    my $self = bless {}, shift;
+    my ($re, $im);
+    if (@_ == 0) {
+	($re, $im) = (0, 0);
+    } elsif (@_ == 1) {
+	return (ref $self)->emake($_[0])
+	    if ($_[0] =~ /^\s*\[/);
+	($re, $im) = _make($_[0]);
+    } elsif (@_ == 2) {
+	($re, $im) = @_;
+    }
+    if (defined $re) {
 	_cannot_make("real part",      $re) unless $re =~ /^$gre$/;
-	$im ||= 0;
-	_cannot_make("imaginary part", $im) unless $im =~ /^$gre$/;
-	$self->{'cartesian'} = [ $re, $im ];
-	$self->{c_dirty} = 0;
-	$self->{p_dirty} = 1;
-	$self->display_format('cartesian');
-	return $self;
+    }
+    $im ||= 0;
+    _cannot_make("imaginary part", $im) unless $im =~ /^$gre$/;
+    $self->set_cartesian([$re, $im ]);
+    $self->display_format('cartesian');
+
+    return $self;
 }
 
 #
@@ -181,46 +195,32 @@ sub make {
 # Create a new complex number (exponential form)
 #
 sub emake {
-	my $self = bless {}, shift;
-	my ($rho, $theta) = @_;
-	if (@_ == 1) {
-	    my ($remade, $p, $q) = _remake($rho);
-	    if ($remade) {
-		if ($remade eq 'exp') {
-		    ($rho, $theta) = ($p, $q);
-		} else {
-		    return (ref $self)->make($p, $q);
-		}
-	    }
-	}
-	my $rrh = ref $rho;
-	if ( $rrh ) {
-	    if ( $rrh eq ref $self ) {
-		$rho = rho($rho);
-	    } else {
-		_cannot_make("rho", $rrh);
-	    }
-	}
-	my $rth = ref $theta;
-	if ( $rth ) {
-	    if ( $rth eq ref $self ) {
-		$theta = theta($theta);
-	    } else {
-		_cannot_make("theta", $rth);
-	    }
-	}
+    my $self = bless {}, shift;
+    my ($rho, $theta);
+    if (@_ == 0) {
+	($rho, $theta) = (0, 0);
+    } elsif (@_ == 1) {
+	return (ref $self)->make($_[0])
+	    if ($_[0] =~ /^\s*\(/ || $_[0] =~ /i\s*$/);
+	($rho, $theta) = _emake($_[0]);
+    } elsif (@_ == 2) {
+	($rho, $theta) = @_;
+    }
+    if (defined $rho && defined $theta) {
 	if ($rho < 0) {
 	    $rho   = -$rho;
 	    $theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
 	}
+    }
+    if (defined $rho) {
 	_cannot_make("rho",   $rho)   unless $rho   =~ /^$gre$/;
-	$theta ||= 0;
-	_cannot_make("theta", $theta) unless $theta =~ /^$gre$/;
-	$self->{'polar'} = [$rho, $theta];
-	$self->{p_dirty} = 0;
-	$self->{c_dirty} = 1;
-	$self->display_format('polar');
-	return $self;
+    }
+    $theta ||= 0;
+    _cannot_make("theta", $theta) unless $theta =~ /^$gre$/;
+    $self->set_polar([$rho, $theta]);
+    $self->display_format('polar');
+
+    return $self;
 }
 
 sub new { &make }		# For backward compatibility only.
@@ -312,8 +312,10 @@ sub cartesian {$_[0]->{c_dirty} ?
 sub polar     {$_[0]->{p_dirty} ?
 		   $_[0]->update_polar : $_[0]->{'polar'}}
 
-sub set_cartesian { $_[0]->{p_dirty}++; $_[0]->{'cartesian'} = $_[1] }
-sub set_polar     { $_[0]->{c_dirty}++; $_[0]->{'polar'} = $_[1] }
+sub set_cartesian { $_[0]->{p_dirty}++; $_[0]->{c_dirty} = 0;
+		    $_[0]->{'cartesian'} = $_[1] }
+sub set_polar     { $_[0]->{c_dirty}++; $_[0]->{p_dirty} = 0;
+		    $_[0]->{'polar'} = $_[1] }
 
 #
 # ->update_cartesian
@@ -659,7 +661,7 @@ sub cbrt {
 # Die on bad root.
 #
 sub _rootbad {
-    my $mess = "Root $_[0] illegal, root rank must be positive integer.\n";
+    my $mess = "Root '$_[0]' illegal, root rank must be positive integer.\n";
 
     my @up = caller(1);
 
@@ -679,22 +681,27 @@ sub _rootbad {
 # z^(1/n) = r^(1/n) (cos ((t+2 k pi)/n) + i sin ((t+2 k pi)/n))
 #
 sub root {
-	my ($z, $n) = @_;
+	my ($z, $n, $k) = @_;
 	_rootbad($n) if ($n < 1 or int($n) != $n);
 	my ($r, $t) = ref $z ?
 	    @{$z->polar} : (CORE::abs($z), $z >= 0 ? 0 : pi);
-	my @root;
-	my $k;
 	my $theta_inc = pit2 / $n;
 	my $rho = $r ** (1/$n);
-	my $theta;
 	my $cartesian = ref $z && $z->{c_dirty} == 0;
-	for ($k = 0, $theta = $t / $n; $k < $n; $k++, $theta += $theta_inc) {
-	    my $w = cplxe($rho, $theta);
-	    # Yes, $cartesian is loop invariant.
-	    push @root, $cartesian ? cplx(@{$w->cartesian}) : $w;
+	if (@_ == 2) {
+	    my @root;
+	    for (my $i = 0, my $theta = $t / $n;
+		 $i < $n;
+		 $i++, $theta += $theta_inc) {
+		my $w = cplxe($rho, $theta);
+		# Yes, $cartesian is loop invariant.
+		push @root, $cartesian ? cplx(@{$w->cartesian}) : $w;
+	    }
+	    return @root;
+	} elsif (@_ == 3) {
+	    my $w = cplxe($rho, $t / $n + $k * $theta_inc);
+	    return $cartesian ? cplx(@{$w->cartesian}) : $w;
 	}
-	return @root;
 }
 
 #
@@ -1265,27 +1272,30 @@ sub acotanh { Math::Complex::acoth(@_) }
 #
 # (atan2)
 #
-# Compute atan(z1/z2).
+# Compute atan(z1/z2), minding the right quadrant.
 #
 sub atan2 {
 	my ($z1, $z2, $inverted) = @_;
 	my ($re1, $im1, $re2, $im2);
 	if ($inverted) {
 	    ($re1, $im1) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
-	    ($re2, $im2) = @{$z1->cartesian};
+	    ($re2, $im2) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
 	} else {
-	    ($re1, $im1) = @{$z1->cartesian};
+	    ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
 	    ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
 	}
-	if ($im2 == 0) {
-	    return CORE::atan2($re1, $re2) if $im1 == 0;
-	    return ($im1<=>0) * pip2 if $re2 == 0;
+	if ($im1 || $im2) {
+	    # In MATLAB the imaginary parts are ignored.
+	    # warn "atan2: Imaginary parts ignored";
+	    # http://documents.wolfram.com/mathematica/functions/ArcTan
+	    # NOTE: Mathematica ArcTan[x,y] while atan2(y,x)
+	    my $s = $z1 * $z1 + $z2 * $z2;
+	    _divbyzero("atan2") if $s == 0;
+	    my $i = &i;
+	    my $r = $z2 + $z1 * $i;
+	    return -$i * &log($r / &sqrt( $s ));
 	}
-	my $w = atan($z1/$z2);
-	my ($u, $v) = ref $w ? @{$w->cartesian} : ($w, 0);
-	$u += pi   if $re2 < 0;
-	$u -= pit2 if $u > pi;
-	return cplx($u, $v);
+	return CORE::atan2($re1, $re2);
 }
 
 #
@@ -1659,7 +1669,11 @@ the following (overloaded) operations are supported on complex numbers:
 	log(z) = log(r1) + i*t
 	sin(z) = 1/2i (exp(i * z1) - exp(-i * z))
 	cos(z) = 1/2 (exp(i * z1) + exp(-i * z))
-	atan2(z1, z2) = atan(z1/z2)
+	atan2(y, x) = atan(y / x) # Minding the right quadrant, note the order.
+
+The definition used for complex arguments of atan2() is
+
+       -i log((x + iy)/sqrt(x*x+y*y))
 
 The following extra operations are supported on both real and complex
 numbers:
@@ -1726,6 +1740,9 @@ The I<k>th root for C<z = [r,t]> is given by:
 
 	(root(z, n))[k] = r**(1/n) * exp(i * (t + 2*k*pi)/n)
 
+You can return the I<k>th root directly by C<root(z, n, k)>,
+indexing starting from I<zero> and ending at I<n - 1>.
+
 The I<spaceship> comparison operator, E<lt>=E<gt>, is also defined. In
 order to ensure its restriction to real numbers is conform to what you
 would expect, the comparison is run on the real part of the complex
@@ -1773,17 +1790,22 @@ understand a single (string) argument of the forms
     	2-3i
     	-3i
 	[2,3]
+	[2,-3pi/4]
 	[2]
 
 in which case the appropriate cartesian and exponential components
 will be parsed from the string and used to create new complex numbers.
 The imaginary component and the theta, respectively, will default to zero.
 
-=head1 STRINGIFICATION
+The C<new>, C<make>, C<emake>, C<cplx>, and C<cplxe> will also
+understand the case of no arguments: this means plain zero or (0, 0).
+
+=head1 DISPLAYING
 
 When printed, a complex number is usually shown under its cartesian
 style I<a+bi>, but there are legitimate cases where the polar style
-I<[r,t]> is more appropriate.
+I<[r,t]> is more appropriate.  The process of converting the complex
+number into a string that can be displayed is known as I<stringification>.
 
 By calling the class method C<Math::Complex::display_format> and
 supplying either C<"polar"> or C<"cartesian"> as an argument, you
@@ -1809,6 +1831,8 @@ The polar style attempts to emphasize arguments like I<k*pi/n>
 (where I<n> is a positive integer and I<k> an integer within [-9, +9]),
 this is called I<polar pretty-printing>.
 
+For the reverse of stringifying, see the C<make> and C<emake>.
+
 =head2 CHANGED IN PERL 5.6
 
 The C<display_format> class method and the corresponding
@@ -1902,7 +1926,8 @@ C<-1> (minus one).  For the C<atan>, C<acot>, the argument cannot be
 C<i> (the imaginary unit).  For the C<atan>, C<acoth>, the argument
 cannot be C<-i> (the negative imaginary unit).  For the C<tan>,
 C<sec>, C<tanh>, the argument cannot be I<pi/2 + k * pi>, where I<k>
-is any integer.
+is any integer.  atan2(0, 0) is undefined, and if the complex arguments
+are used for atan2(), a division by zero will happen if z1**2+z2**2 == 0.
 
 Note that because we are operating on approximations of real numbers,
 these errors can happen when merely `too close' to the singularities
@@ -1922,7 +1947,7 @@ messages like the following
 =head1 BUGS
 
 Saying C<use Math::Complex;> exports many mathematical routines in the
-caller environment and even overrides some (C<sqrt>, C<log>).
+caller environment and even overrides some (C<sqrt>, C<log>, C<atan2>).
 This is construed as a feature by the Authors, actually... ;-)
 
 All routines expect to be given real or complex numbers. Don't attempt to
diff --git a/gnu/usr.bin/perl/lib/Math/Trig.pm b/gnu/usr.bin/perl/lib/Math/Trig.pm
index 7560df54156..cd1735618ae 100644
--- a/gnu/usr.bin/perl/lib/Math/Trig.pm
+++ b/gnu/usr.bin/perl/lib/Math/Trig.pm
@@ -10,13 +10,14 @@ package Math::Trig;
 use 5.006;
 use strict;
 
+use Math::Complex 1.35;
 use Math::Complex qw(:trig);
 
 our($VERSION, $PACKAGE, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
 @ISA = qw(Exporter);
 
-$VERSION = 1.02;
+$VERSION = 1.03;
 
 my @angcnv = qw(rad2deg rad2grad
 		deg2rad deg2grad
@@ -32,12 +33,30 @@ my @rdlcnv = qw(cartesian_to_cylindrical
 		spherical_to_cartesian
 		spherical_to_cylindrical);
 
-@EXPORT_OK = (@rdlcnv, 'great_circle_distance', 'great_circle_direction');
+my @greatcircle = qw(
+		     great_circle_distance
+		     great_circle_direction
+		     great_circle_bearing
+		     great_circle_waypoint
+		     great_circle_midpoint
+		     great_circle_destination
+		    );
 
-%EXPORT_TAGS = ('radial' => [ @rdlcnv ]);
+my @pi = qw(pi2 pip2 pip4);
+
+@EXPORT_OK = (@rdlcnv, @greatcircle, @pi);
+
+# See e.g. the following pages:
+# http://www.movable-type.co.uk/scripts/LatLong.html
+# http://williams.best.vwh.net/avform.htm
+
+%EXPORT_TAGS = ('radial' => [ @rdlcnv ],
+	        'great_circle' => [ @greatcircle ],
+	        'pi'     => [ @pi ]);
 
 sub pi2  () { 2 * pi }
 sub pip2 () { pi / 2 }
+sub pip4 () { pi / 4 }
 
 sub DR  () { pi2/360 }
 sub RD  () { 360/pi2 }
@@ -148,6 +167,57 @@ sub great_circle_direction {
     return rad2rad($direction);
 }
 
+*great_circle_bearing = \&great_circle_direction;
+
+sub great_circle_waypoint {
+    my ( $theta0, $phi0, $theta1, $phi1, $point ) = @_;
+
+    $point = 0.5 unless defined $point;
+
+    my $d = great_circle_distance( $theta0, $phi0, $theta1, $phi1 );
+
+    return undef if $d == pi;
+
+    my $sd = sin($d);
+
+    return ($theta0, $phi0) if $sd == 0;
+
+    my $A = sin((1 - $point) * $d) / $sd;
+    my $B = sin(     $point  * $d) / $sd;
+
+    my $lat0 = pip2 - $phi0;
+    my $lat1 = pip2 - $phi1;
+
+    my $x = $A * cos($lat0) * cos($theta0) + $B * cos($lat1) * cos($theta1);
+    my $y = $A * cos($lat0) * sin($theta0) + $B * cos($lat1) * sin($theta1);
+    my $z = $A * sin($lat0)                + $B * sin($lat1);
+
+    my $theta = atan2($y, $x);
+    my $phi   = atan2($z, sqrt($x*$x + $y*$y));
+    
+    return ($theta, $phi);
+}
+
+sub great_circle_midpoint {
+    great_circle_waypoint(@_[0..3], 0.5);
+}
+
+sub great_circle_destination {
+    my ( $theta0, $phi0, $dir0, $dst ) = @_;
+
+    my $lat0 = pip2 - $phi0;
+
+    my $phi1   = asin(sin($lat0)*cos($dst)+cos($lat0)*sin($dst)*cos($dir0));
+    my $theta1 = $theta0 + atan2(sin($dir0)*sin($dst)*cos($lat0),
+				 cos($dst)-sin($lat0)*sin($phi1));
+
+    my $dir1 = great_circle_bearing($theta1, $phi1, $theta0, $phi0) + pi;
+
+    $dir1 -= pi2 if $dir1 > pi2;
+
+    return ($theta1, $phi1, $dir1);
+}
+
 1;
 
 __END__
@@ -169,12 +239,21 @@ Math::Trig - trigonometric functions
 
 	$rad = deg2rad(120);
 
+        # Import constants pi2, pip2, pip4 (2*pi, pi/2, pi/4).
+	use Math::Trig ':pi';
+
+        # Import the conversions between cartesian/spherical/cylindrical.
+	use Math::Trig ':radial';
+
+        # Import the great circle formulas.
+	use Math::Trig ':great_circle';
+
 =head1 DESCRIPTION
 
 C<Math::Trig> defines many trigonometric functions not defined by the
 core Perl which defines only the C<sin()> and C<cos()>.  The constant
 B<pi> is also defined as are a few convenience functions for angle
-conversions.
+conversions, and I<great circle formulas> for spherical movement.
 
 =head1 TRIGONOMETRIC FUNCTIONS
 
@@ -265,7 +344,7 @@ C<asech>, C<acsch>, the argument cannot be C<0> (zero).  For the
 C<atanh>, C<acoth>, the argument cannot be C<1> (one).  For the
 C<atanh>, C<acoth>, the argument cannot be C<-1> (minus one).  For the
 C<tan>, C<sec>, C<tanh>, C<sech>, the argument cannot be I<pi/2 + k *
-pi>, where I<k> is any integer.
+pi>, where I<k> is any integer.  atan2(0, 0) is undefined.
 
 =head2 SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS
 
@@ -338,8 +417,7 @@ B<All angles are in radians>.
 
 =head2 COORDINATE SYSTEMS
 
-B<Cartesian> coordinates are the usual rectangular I<(x, y,
-z)>-coordinates.
+B<Cartesian> coordinates are the usual rectangular I<(x, y, z)>-coordinates.
 
 Spherical coordinates, I<(rho, theta, pi)>, are three-dimensional
 coordinates which define a point in three-dimensional space.  They are
@@ -347,8 +425,8 @@ based on a sphere surface.  The radius of the sphere is B<rho>, also
 known as the I<radial> coordinate.  The angle in the I<xy>-plane
 (around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
 coordinate.  The angle from the I<z>-axis is B<phi>, also known as the
-I<polar> coordinate.  The `North Pole' is therefore I<0, 0, rho>, and
-the `Bay of Guinea' (think of the missing big chunk of Africa) I<0,
+I<polar> coordinate.  The North Pole is therefore I<0, 0, rho>, and
+the Gulf of Guinea (think of the missing big chunk of Africa) I<0,
 pi/2, rho>.  In geographical terms I<phi> is latitude (northward
 positive, southward negative) and I<theta> is longitude (eastward
 positive, westward negative).
@@ -430,16 +508,56 @@ degrees).
   $distance = great_circle_distance($lon0, pi/2 - $lat0,
                                     $lon1, pi/2 - $lat1, $rho);
 
-The direction you must follow the great circle can be computed by the
-great_circle_direction() function:
+The direction you must follow the great circle (also known as I<bearing>)
+can be computed by the great_circle_direction() function:
 
   use Math::Trig 'great_circle_direction';
 
   $direction = great_circle_direction($theta0, $phi0, $theta1, $phi1);
 
+(Alias 'great_circle_bearing' is also available.)
 The result is in radians, zero indicating straight north, pi or -pi
 straight south, pi/2 straight west, and -pi/2 straight east.
 
+You can inversely compute the destination if you know the
+starting point, direction, and distance:
+
+  use Math::Trig 'great_circle_destination';
+
+  # thetad and phid are the destination coordinates,
+  # dird is the final direction at the destination.
+
+  ($thetad, $phid, $dird) =
+    great_circle_destination($theta, $phi, $direction, $distance);
+
+or the midpoint if you know the end points:
+
+  use Math::Trig 'great_circle_midpoint';
+
+  ($thetam, $phim) =
+    great_circle_midpoint($theta0, $phi0, $theta1, $phi1);
+
+The great_circle_midpoint() is just a special case of
+
+  use Math::Trig 'great_circle_waypoint';
+
+  ($thetai, $phii) =
+    great_circle_waypoint($theta0, $phi0, $theta1, $phi1, $way);
+
+Where the $way is a value from zero ($theta0, $phi0) to one ($theta1,
+$phi1).  Note that antipodal points (where their distance is I<pi>
+radians) do not have waypoints between them (they would have an an
+"equator" between them), and therefore C<undef> is returned for
+antipodal points.  If the points are the same and the distance
+therefore zero and all waypoints therefore identical, the first point
+(either point) is returned.
+
+The thetas, phis, direction, and distance in the above are all in radians.
+
+You can import all the great circle formulas by
+
+  use Math::Trig ':great_circle';
+
 Notice that the resulting directions might be somewhat surprising if
 you are looking at a flat worldmap: in such map projections the great
 circles quite often do not look like the shortest routes-- but for
@@ -454,31 +572,31 @@ To calculate the distance between London (51.3N 0.5W) and Tokyo
         use Math::Trig qw(great_circle_distance deg2rad);
 
         # Notice the 90 - latitude: phi zero is at the North Pole.
-	@L = (deg2rad(-0.5), deg2rad(90 - 51.3));
-        @T = (deg2rad(139.8),deg2rad(90 - 35.7));
-
-        $km = great_circle_distance(@L, @T, 6378);
+	sub NESW { deg2rad($_[0]), deg2rad(90 - $_[1]) }
+	my @L = NESW( -0.5, 51.3);
+        my @T = NESW(139.8, 35.7);
+        my $km = great_circle_distance(@L, @T, 6378); # About 9600 km.
 
-The direction you would have to go from London to Tokyo
+The direction you would have to go from London to Tokyo (in radians,
+straight north being zero, straight east being pi/2).
 
         use Math::Trig qw(great_circle_direction);
 
-        $rad = great_circle_direction(@L, @T);
+        my $rad = great_circle_direction(@L, @T); # About 0.547 or 0.174 pi.
 
-=head2 CAVEAT FOR GREAT CIRCLE FORMULAS
+The midpoint between London and Tokyo being
 
-The answers may be off by few percentages because of the irregular
-(slightly aspherical) form of the Earth.  The formula used for
-grear circle distances
+        use Math::Trig qw(great_circle_midpoint);
+
+        my @M = great_circle_midpoint(@L, @T);
+
+or about 68.11N 24.74E, in the Finnish Lapland.
 
-	lat0 = 90 degrees - phi0
-	lat1 = 90 degrees - phi1
-	d = R * arccos(cos(lat0) * cos(lat1) * cos(lon1 - lon01) +
-                       sin(lat0) * sin(lat1))
+=head2 CAVEAT FOR GREAT CIRCLE FORMULAS
 
-is also somewhat unreliable for small distances (for locations
-separated less than about five degrees) because it uses arc cosine
-which is rather ill-conditioned for values close to zero.
+The answers may be off by few percentages because of the irregular
+(slightly aspherical) form of the Earth.  The errors are at worst
+about 0.55%, but generally below 0.3%.
 
 =head1 BUGS
 
@@ -492,6 +610,8 @@ the computations even when the arguments are not. This, however,
 cannot be completely avoided if we want things like C<asin(2)> to give
 an answer instead of giving a fatal runtime error.
 
+Do not attempt navigation using these formulas.
+
 =head1 AUTHORS
 
 Jarkko Hietaniemi <F<jhi@iki.fi>> and 
diff --git a/gnu/usr.bin/perl/lib/Pod/Functions.pm b/gnu/usr.bin/perl/lib/Pod/Functions.pm
index e185381bc44..0e250cf0b50 100644
--- a/gnu/usr.bin/perl/lib/Pod/Functions.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Functions.pm
@@ -27,13 +27,13 @@ It exports the following variables:
 
 =item %Kinds
 
-This holds a hash-of-lists. Each list contains the functions in the catagory
+This holds a hash-of-lists. Each list contains the functions in the category
 the key denotes.
 
 =item %Type
 
-In this hash each key represents a function and the value is the catagory.
-The catagory can be a comma separated list.
+In this hash each key represents a function and the value is the category.
+The category can be a comma separated list.
 
 =item %Flavor
 
@@ -42,12 +42,12 @@ description of that function.
 
 =item %Type_Description
 
-In this hash each key represents a catagory of functions and the value is 
-a short description of that catagory.
+In this hash each key represents a category of functions and the value is 
+a short description of that category.
 
 =item @Type_Order
 
-This list of catagories is used to produce the same order as the
+This list of categories is used to produce the same order as the
 L<perlfunc/"Perl Functions by Category"> section.
 
 =back
@@ -67,7 +67,7 @@ L<perlfunc/"Perl Functions by Category"> section.
 
 =cut
 
-our $VERSION = '1.02';
+our $VERSION = '1.03';
 
 require Exporter;
 
diff --git a/gnu/usr.bin/perl/lib/Pod/Html.pm b/gnu/usr.bin/perl/lib/Pod/Html.pm
index 3f697205bcd..aba3c9f6083 100644
--- a/gnu/usr.bin/perl/lib/Pod/Html.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Html.pm
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.0502;
+$VERSION = 1.0504;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
@@ -462,10 +462,12 @@ sub pod2html {
 END_OF_BLOCK
 
     print HTML <<END_OF_HEAD;
+<?xml version="1.0" ?>
 <!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
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:$Config{perladmin}" />
 </head>
 
@@ -524,13 +526,13 @@ END_OF_HEAD
 		} elsif (/^=over\s*(.*)/) {		# =over N
 		    process_over();
 		} elsif (/^=back/) {		# =back
-		    process_back();
+		    process_back($need_dd);
 		} elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
 		    process_for($1,$2);
 		} else {
 		    /^=(\S*)\s*/;
 		    warn "$0: $Podfile: unknown pod directive '$1' in "
-		       . "paragraph $Paragraph.  ignoring.\n";
+		       . "paragraph $Paragraph.  ignoring.\n" unless $Quiet;
 		}
 	    }
 	    $Top = 0;
@@ -571,11 +573,9 @@ END_OF_HEAD
 		## end of experimental
 
 		if( $after_item ){
-		    print HTML "$text\n";
 		    $After_Lpar = 1;
-		} else {
-		    print HTML "<p>$text</p>\n";
 		}
+		print HTML "<p>$text</p>\n";
 	    }
 	    print HTML "</dd>\n" if $need_dd;
 	    $after_item = 0;
@@ -637,7 +637,7 @@ Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
                    pods (empty by default).
   --podroot      - filesystem base directory from which all relative paths
                    in podpath stem (default is .).
-  --[no]quiet    - supress some benign warning messages (default is off).
+  --[no]quiet    - suppress some benign warning messages (default is off).
   --[no]recurse  - recurse on those subdirectories listed in podpath
                    (default behaviour).
   --title        - title that will appear in resulting html file.
@@ -889,7 +889,7 @@ sub scan_podpath {
 
 	    scan_items( \%Items, "$pod", @poddata);
 	} else {
-	    warn "$0: shouldn't be here (line ".__LINE__."\n";
+	    warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet;
 	}
     }
     @poddata = ();	# clean-up a bit
@@ -959,6 +959,19 @@ sub scan_dir {
 	    $Pages{$_}  = "" unless defined $Pages{$_};
 	    $Pages{$_} .= "$dir/$_.pm:";
 	    push(@pods, "$dir/$_.pm");
+	} elsif (-T "$dir/$_") {			    # script(?)
+	    local *F;
+	    if (open(F, "$dir/$_")) {
+		my $line;
+		while (defined($line = <F>)) {
+		    if ($line =~ /^=(?:pod|head1)/) {
+			$Pages{$_}  = "" unless defined $Pages{$_};
+			$Pages{$_} .= "$dir/$_.pod:";
+			last;
+		    }
+		}
+		close(F);
+	    }
 	}
     }
     closedir(DIR);
@@ -1065,7 +1078,7 @@ sub process_head {
     my $level = $1;
 
     if( $Listlevel ){
-	warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n";
+	warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
         while( $Listlevel ){
             process_back();
         }
@@ -1107,7 +1120,7 @@ sub emit_item_tag($$$){
         $name = anchorify($name);
 	print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
     }
-    print HTML "</strong><br />\n";
+    print HTML "</strong>\n";
     undef( $EmittedItem );
 }
 
@@ -1133,13 +1146,13 @@ sub process_item {
     # 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";
+	warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
 	process_over();
     }
 
     # formatting: insert a paragraph if preceding item has >1 paragraph
     if( $After_Lpar ){
-	print HTML "<p></p>\n";
+	print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
 	$After_Lpar = 0;
     }
 
@@ -1172,7 +1185,6 @@ sub process_item {
         }
         $need_dd = 1;
     }
-    print HTML "</$emitted>" if $emitted;
     print HTML "\n";
     return $need_dd;
 }
@@ -1191,8 +1203,9 @@ sub process_over {
 # process_back - process a pod back tag and convert it to HTML format.
 #
 sub process_back {
+    my $need_dd = shift;
     if( $Listlevel == 0 ){
-	warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n";
+	warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
 	return;
     }
 
@@ -1201,7 +1214,7 @@ sub process_back {
     # $Listend[$Listlevel] may have never been initialized.
     $Listlevel--;
     if( defined $Listend[$Listlevel] ){
-	print HTML '<p></p>' if $After_Lpar;
+	print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
 	print HTML $Listend[$Listlevel];
         print HTML "\n";
         pop( @Listend );
@@ -1395,7 +1408,7 @@ sub inIS_text($){
 sub process_puretext {
     my($text, $quote, $notinIS) = @_;
 
-    ## Guessing at func() or [$@%&]*var references in plain text is destined
+    ## Guessing at func() or [\$\@%&]*var references in plain text is destined
     ## to produce some strange looking ref's. uncomment to disable:
     ## $notinIS = 0;
 
@@ -1621,7 +1634,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" unless $Quiet;
         }
 
         # now we have a URL or just plain code
@@ -1644,7 +1657,7 @@ sub process_text1($$;$$){
     } elsif( $func eq 'Z' ){
 	# Z<> - empty
 	warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
-	    unless $$rstr =~ s/^>//;
+	    unless $$rstr =~ s/^>// or $Quiet;
 
     } else {
         my $term = pattern $closing;
@@ -1662,7 +1675,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" unless $Quiet;
 	}
     }
     return $res;
@@ -1686,7 +1699,7 @@ sub go_ahead($$$){
 	}
 	$res .= $2;
     }
-    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n";
+    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
     return $res;
 }
 
@@ -1883,7 +1896,7 @@ sub coderef($$){
     my( $url );
 
     my $fid = fragment_id( $item );
-    if( defined( $page ) ){
+    if( defined( $page ) && $page ne "" ){
 	# we have been given a $page...
 	$page =~ s{::}{/}g;
 
@@ -2059,7 +2072,7 @@ sub fragment_id {
 	return $1 if $text =~ /->\s*(\w+)\s*\(?/;
 
 	# a variable name?
-	return $1 if $text =~ /^([$@%*]\S+)/;
+	return $1 if $text =~ /^([\$\@%*]\S+)/;
 
 	# some pattern matching operator?
 	return $1 if $text =~ m|^(\w+/).*/\w*$|;
@@ -2069,7 +2082,7 @@ sub fragment_id {
 
 	# honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
 	# and some funnies with ... Module ...
-	return $1 if $text =~ m{^([a-z\d]+)(\s+[A-Z\d,/& ]+)?$};
+	return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z\d,/& ]+)?$};
 	return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};
 
 	# text? normalize!
diff --git a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm
index d895b104a48..fa5f61f9a70 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.14;  ## Current version of this package
+$VERSION = 1.30;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
diff --git a/gnu/usr.bin/perl/lib/Pod/LaTeX.pm b/gnu/usr.bin/perl/lib/Pod/LaTeX.pm
index 9582d340c94..a1d97393685 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.56';
+$VERSION = '0.58';
 
 # Definitions of =headN -> latex mapping
 @LatexSections = (qw/
@@ -1454,7 +1454,7 @@ sub add_item {
     my ($hunk1, $hunk2) = $self->_split_delimited( $paragraph, $maxlen );
 
     # Print the first hunk
-    $self->_output("\n\\item[$hunk1] ");
+    $self->_output("\n\\item[{$hunk1}] ");
 
     # and the second hunk if it is defined
     if ($hunk2) {
@@ -1851,8 +1851,9 @@ E<lt>mah@everybody.orgE<gt>, Marcel Grunauer
 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>,
-Ariel Scolnicov E<lt>ariels@compugen.co.ilE<gt> and
-Adriano Rodrigues Ferreira E<lt>ferreira@triang.com.brE<gt>.
+Ariel Scolnicov E<lt>ariels@compugen.co.ilE<gt>,
+Adriano Rodrigues Ferreira E<lt>ferreira@triang.com.brE<gt> and
+R. de Vries E<lt>r.de.vries@dutchspace.nlE<gt>.
 
 
 =head1 COPYRIGHT
@@ -1866,7 +1867,7 @@ it under the same terms as Perl itself.
 
 =head1 REVISION
 
-$Id: LaTeX.pm,v 1.5 2004/08/09 18:09:45 millert Exp $
+$Id: LaTeX.pm,v 1.6 2006/03/28 19:23:08 millert Exp $
 
 =end __PRIVATE__
 
diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
index e078dcf8a5f..28e9a33ec54 100644
--- a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm
@@ -12,7 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir);
 use vars qw($VERSION @Pagers $Bindir $Pod2man
   $Temp_Files_Created $Temp_File_Lifetime
 );
-$VERSION = '3.13';
+$VERSION = '3.14';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -1079,7 +1079,7 @@ sub MSWin_perldoc_tempfile {
   my $spec;
   
   do {
-    $spec = sprintf "%s/perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
+    $spec = sprintf "%s\\perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
       # Yes, we embed the create-time in the filename!
       $tempdir,
       $infix || 'x',
@@ -1232,6 +1232,13 @@ sub pagers_guessing {
         push @pagers, qw( more less pg view cat );
         unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
     }
+
+    if (IS_Cygwin) {
+        if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) {
+            unshift @pagers, '/usr/bin/less -isrR';
+        }
+    }
+
     unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
     
     return;   
@@ -1494,6 +1501,12 @@ sub page {  # apply a pager to the output file
         # extension get the wrong default extension (such as .LIS for TYPE)
 
         $output = VMS::Filespec::rmsexpand($output, '.') if IS_VMS;
+
+        $output =~ s{/}{\\}g if IS_MSWin32 || IS_Dos;
+          # Altho "/" under MSWin is in theory good as a pathsep,
+          #  many many corners of the OS don't like it.  So we
+          #  have to force it to be "\" to make everyone happy.
+
         foreach my $pager (@pagers) {
             $self->aside("About to try calling $pager $output\n");
             if (IS_VMS) {
diff --git a/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t b/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t
index 13b36318dec..47856b46ccc 100755
--- a/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t
+++ b/gnu/usr.bin/perl/lib/Pod/t/contains_pod.t
@@ -2,7 +2,7 @@
 
 # Copyright (C) 2005  Joshua Hoblitt
 #
-# $Id: contains_pod.t,v 1.1 2006/03/28 18:48:57 millert Exp $
+# $Id: contains_pod.t,v 1.2 2006/03/28 19:23:08 millert Exp $
 
 use strict;
 
diff --git a/gnu/usr.bin/perl/lib/SelectSaver.pm b/gnu/usr.bin/perl/lib/SelectSaver.pm
index 08104f47d4c..1207b88a4a2 100644
--- a/gnu/usr.bin/perl/lib/SelectSaver.pm
+++ b/gnu/usr.bin/perl/lib/SelectSaver.pm
@@ -1,6 +1,6 @@
 package SelectSaver;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 =head1 NAME
 
@@ -41,14 +41,14 @@ use Symbol;
 sub new {
     @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
     my $fh = select;
-    my $self = bless [$fh], $_[0];
+    my $self = bless \$fh, $_[0];
     select qualify($_[1], caller) if @_ > 1;
     $self;
 }
 
 sub DESTROY {
-    my $this = $_[0];
-    select $$this[0];
+    my $self = $_[0];
+    select $$self;
 }
 
 1;
diff --git a/gnu/usr.bin/perl/lib/Symbol.pm b/gnu/usr.bin/perl/lib/Symbol.pm
index 5c0843e7d7b..3bb5d9240c1 100644
--- a/gnu/usr.bin/perl/lib/Symbol.pm
+++ b/gnu/usr.bin/perl/lib/Symbol.pm
@@ -69,13 +69,12 @@ 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.
+C<Symbol::delete_package> is a bit too powerful. It undefines every symbol that
+lives in the specified package. 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
 
@@ -86,7 +85,7 @@ require Exporter;
 @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
 @EXPORT_OK = qw(delete_package geniosym);
 
-$VERSION = '1.05';
+$VERSION = '1.06';
 
 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 788f5d90ac8..9ad6b688021 100644
--- a/gnu/usr.bin/perl/lib/Term/ANSIColor.pm
+++ b/gnu/usr.bin/perl/lib/Term/ANSIColor.pm
@@ -1,8 +1,8 @@
 # Term::ANSIColor -- Color screen output using ANSI escape sequences.
-# $Id: ANSIColor.pm,v 1.6 2004/08/09 18:09:46 millert Exp $
+# $Id: ANSIColor.pm,v 1.7 2006/03/28 19:23:08 millert Exp $
 #
-# Copyright 1996, 1997, 1998, 2000, 2001, 2002
-#   by Russ Allbery <rra@stanford.edu> and Zenin <zenin@bawdycaste.com>
+# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005
+#   by Russ Allbery <rra@stanford.edu> and Zenin
 #
 # This program is free software; you may redistribute it and/or modify it
 # under the same terms as Perl itself.
@@ -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.08;
+$VERSION = '1.10';
 
 ##############################################################################
 # Internal data structures
@@ -182,8 +182,9 @@ sub colored {
     if (defined $EACHLINE) {
         my $attr = color (@codes);
         join '',
-            map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ }
-                split (/(\Q$EACHLINE\E)/, $string);
+            map { $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ }
+                grep { length ($_) > 0 }
+                    split (/(\Q$EACHLINE\E)/, $string);
     } else {
         color (@codes) . $string . "\e[0m";
     }
@@ -424,12 +425,14 @@ me flesh it out:
  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
+ Mac Terminal  yes      yes      no      yes      yes      yes      yes
 
-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.
+Windows is Windows telnet, Cygwin SSH is the OpenSSH implementation under
+Cygwin on Windows NT, and Mac Terminal is the Terminal application in Mac OS
+X.  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
@@ -463,7 +466,7 @@ with input from Zenin.  Russ Allbery now maintains this module.
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 1996, 1997, 1998, 2000, 2001, 2002 Russ Allbery <rra@stanford.edu>
-and Zenin <zenin@bawdycaste.org>.  This program is free software; you may
-redistribute it and/or modify it under the same terms as Perl itself.
+and Zenin.  This program is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself.
 
 =cut
diff --git a/gnu/usr.bin/perl/lib/Term/Complete.pm b/gnu/usr.bin/perl/lib/Term/Complete.pm
index c74907bb597..601e4956430 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.401';
+our $VERSION = '1.402';
 
 #      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91
 
@@ -113,6 +113,7 @@ sub Complete {
     }
     system $tty_raw_noecho if defined $tty_raw_noecho;
     LOOP: {
+        local $_;
         print($prompt, $return);
         while (($_ = getc(STDIN)) ne "\r") {
             CASE: {
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
index 8cb6ab3f2bf..48eb9911a6f 100644
--- a/gnu/usr.bin/perl/lib/Term/ReadLine.pm
+++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
@@ -18,10 +18,9 @@ If no real package is found, substitutes stubs instead of basic functions.
 
 =head1 DESCRIPTION
 
-This package is just a front end to some other packages. At the moment
-this description is written, the only such package is Term-ReadLine,
-available on CPAN near you. The real target of this stub package is to
-set up a common interface to whatever Readline emerges with time.
+This package is just a front end to some other packages. It's a stub to
+set up a common interface to the various ReadLine implementations found on
+CPAN (under the C<Term::ReadLine::*> namespace).
 
 =head1 Minimal set of supported functions
 
@@ -100,7 +99,7 @@ method C<Attribs> is not dummy.
 =head1 Additional supported functions
 
 Actually C<Term::ReadLine> can use some other package, that will
-support reacher set of commands.
+support a richer set of commands.
 
 All these commands are callable via method interface and have names
 which conform to standard conventions with the leading C<rl_> stripped.
@@ -290,7 +289,7 @@ sub Features { \%features }
 
 package Term::ReadLine;		# So late to allow the above code be defined?
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 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 5dbea5738e9..cae6ad82dc3 100644
--- a/gnu/usr.bin/perl/lib/Test/Harness.pm
+++ b/gnu/usr.bin/perl/lib/Test/Harness.pm
@@ -1,9 +1,8 @@
 # -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.9 2004/08/09 18:09:48 millert Exp $
 
 package Test::Harness;
 
-require 5.004;
+require 5.00405;
 use Test::Harness::Straps;
 use Test::Harness::Assert;
 use Exporter;
@@ -11,44 +10,49 @@ use Benchmark;
 use Config;
 use strict;
 
+
 use vars qw(
     $VERSION 
     @ISA @EXPORT @EXPORT_OK 
     $Verbose $Switches $Debug
     $verbose $switches $debug
-    $Have_Devel_Corestack
     $Curtest
     $Columns 
+    $Timer
     $ML $Last_ML_Print
     $Strap
+    $has_time_hires
 );
 
+BEGIN {
+    eval "use Time::HiRes 'time'";
+    $has_time_hires = !$@;
+}
+
 =head1 NAME
 
 Test::Harness - Run Perl standard test scripts with statistics
 
 =head1 VERSION
 
-Version 2.42
-
-    $Header: /cvs/OpenBSD/src/gnu/usr.bin/perl/lib/Test/Attic/Harness.pm,v 1.9 2004/08/09 18:09:48 millert Exp $
+Version 2.56
 
 =cut
 
-$VERSION = '2.42';
+$VERSION = "2.56";
 
 # Backwards compatibility for exportable variable names.
 *verbose  = *Verbose;
 *switches = *Switches;
 *debug    = *Debug;
 
-$Have_Devel_Corestack = 0;
-
 $ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
 
 END {
     # For VMS.
     delete $ENV{HARNESS_ACTIVE};
+    delete $ENV{HARNESS_VERSION};
 }
 
 # Some experimental versions of OS/2 build have broken $?
@@ -56,10 +60,10 @@ 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;
 
+sub strap { return $Strap };
+
 @ISA = ('Exporter');
 @EXPORT    = qw(&runtests);
 @EXPORT_OK = qw($verbose $switches);
@@ -69,6 +73,7 @@ $Debug    = $ENV{HARNESS_DEBUG} || 0;
 $Switches = "-w";
 $Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
 $Columns--;             # Some shells have trouble with a full line of text.
+$Timer    = $ENV{HARNESS_TIMER} || 0;
 
 =head1 SYNOPSIS
 
@@ -78,165 +83,21 @@ $Columns--;             # Some shells have trouble with a full line of text.
 
 =head1 DESCRIPTION
 
-B<STOP!> If all you want to do is write a test script, consider using
-Test::Simple.  Otherwise, read on.
-
-(By using the Test module, you can write test scripts without
-knowing the exact output this module expects.  However, if you need to
-know the specifics, read on!)
-
-Perl test scripts print to standard output C<"ok N"> for each single
-test, where C<N> is an increasing sequence of integers. The first line
-output by a standard test script is C<"1..M"> with C<M> being the
-number of tests that should be run within the test
-script. Test::Harness::runtests(@tests) runs all the testscripts
-named as arguments and checks standard output for the expected
-C<"ok N"> strings.
-
-After all tests have been performed, runtests() prints some
-performance statistics that are computed by the Benchmark module.
-
-=head2 The test script output
-
-The following explains how Test::Harness interprets the output of your
-test program.
-
-=over 4
-
-=item B<'1..M'>
-
-This header tells how many tests there will be.  For example, C<1..10>
-means you plan on running 10 tests.  This is a safeguard in case your
-test dies quietly in the middle of its run.
-
-It should be the first non-comment line output by your test program.
-
-In certain instances, you may not know how many tests you will
-ultimately be running.  In this case, it is permitted for the 1..M
-header to appear as the B<last> line output by your test (again, it
-can be followed by further comments).
-
-Under B<no> circumstances should 1..M appear in the middle of your
-output or more than once.
-
-
-=item B<'ok', 'not ok'.  Ok?>
-
-Any output from the testscript to standard error is ignored and
-bypassed, thus will be seen by the user. Lines written to standard
-output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
-runtests().  All other lines are discarded.
-
-C</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
-
-
-=item B<test numbers>
-
-Perl normally expects the 'ok' or 'not ok' to be followed by a test
-number.  It is tolerated if the test numbers after 'ok' are
-omitted. In this case Test::Harness maintains temporarily its own
-counter until the script supplies test numbers again. So the following
-test script
-
-    print <<END;
-    1..6
-    not ok
-    ok
-    not ok
-    ok
-    ok
-    END
-
-will generate
-
-    FAILED tests 1, 3, 6
-    Failed 3/6 tests, 50.00% okay
-
-=item B<test names>
-
-Anything after the test number but before the # is considered to be
-the name of the test.
-
-  ok 42 this is the name of the test
-
-Currently, Test::Harness does nothing with this information.
-
-=item B<Skipping tests>
-
-If the standard output line contains the substring C< # Skip> (with
-variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
-counted as a skipped test.  If the whole testscript succeeds, the
-count of skipped tests is included in the generated output.
-C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
-for skipping.
-
-  ok 23 # skip Insufficient flogiston pressure.
+B<STOP!> If all you want to do is write a test script, consider
+using Test::Simple.  Test::Harness is the module that reads the
+output from Test::Simple, Test::More and other modules based on
+Test::Builder.  You don't need to know about Test::Harness to use
+those modules.
 
-Similarly, one can include a similar explanation in a C<1..0> line
-emitted if the test script is skipped completely:
+Test::Harness runs tests and expects output from the test in a
+certain format.  That format is called TAP, the Test Anything
+Protocol.  It is defined in L<Test::Harness::TAP>.
 
-  1..0 # Skipped: no leverage found
+C<Test::Harness::runtests(@tests)> runs all the testscripts named
+as arguments and checks standard output for the expected strings
+in TAP format.
 
-=item B<Todo tests>
-
-If the standard output line contains the substring C< # TODO > after
-C<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
-afterwards is the thing that has to be done before this test will
-succeed.
-
-  not ok 13 # TODO harness the power of the atom
-
-Note that the TODO must have a space after it. 
-
-=begin _deprecated
-
-Alternatively, you can specify a list of what tests are todo as part
-of the test header.
-
-  1..23 todo 5 12 23
-
-This only works if the header appears at the beginning of the test.
-
-This style is B<deprecated>.
-
-=end _deprecated
-
-These tests represent a feature to be implemented or a bug to be fixed
-and act as something of an executable "thing to do" list.  They are
-B<not> expected to succeed.  Should a todo test begin succeeding,
-Test::Harness will report it as a bonus.  This indicates that whatever
-you were supposed to do has been done and you should promote this to a
-normal test.
-
-=item B<Bail out!>
-
-As an emergency measure, a test script can decide that further tests
-are useless (e.g. missing dependencies) and testing should stop
-immediately. In that case the test script prints the magic words
-
-  Bail out!
-
-to standard output. Any message after these words will be displayed by
-C<Test::Harness> as the reason why testing is stopped.
-
-=item B<Comments>
-
-Additional comments may be put into the testing output on their own
-lines.  Comment lines should begin with a '#', Test::Harness will
-ignore them.
-
-  ok 1
-  # Life is good, the sun is shining, RAM is cheap.
-  not ok 2
-  # got 'Bush' expected 'Gore'
-
-=item B<Anything else>
-
-Any other output Test::Harness sees it will silently ignore B<BUT WE
-PLAN TO CHANGE THIS!> If you wish to place additional output in your
-test script, please use a comment.
-
-=back
+The F<prove> utility is a thin wrapper around Test::Harness.
 
 =head2 Taint mode
 
@@ -254,26 +115,30 @@ Test::Harness.  They are exported on request.
 
 =over 4
 
-=item B<$Test::Harness::Verbose>
+=item C<$Test::Harness::Verbose>
 
-The global variable C<$Test::Harness::Verbose> is exportable and can be
+The package variable C<$Test::Harness::Verbose> is exportable and can be
 used to let C<runtests()> display the standard output of the script
 without altering the behavior otherwise.  The F<prove> utility's C<-v>
 flag will set this.
 
-=item B<$Test::Harness::switches>
+=item C<$Test::Harness::switches>
 
-The global variable C<$Test::Harness::switches> is exportable and can be
+The package variable C<$Test::Harness::switches> is exportable and can be
 used to set perl command line options used for running the test
 script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>.
 
+=item C<$Test::Harness::Timer>
+
+If set to true, and C<Time::HiRes> is available, print elapsed seconds
+after each test file.
+
 =back
 
 
 =head2 Failure
 
-It will happen: your tests will fail.  After you mop up your ego, you
-can begin examining the summary report:
+When tests fail, analyze the summary report:
 
   t/base..............ok
   t/nonumbers.........ok
@@ -288,7 +153,7 @@ can begin examining the summary report:
   t/waterloo.t    3   768    20   10  50.00%  1 3 5 7 9 11 13 15 17 19
   Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
 
-Everything passed but t/waterloo.t.  It failed 10 of 20 tests and
+Everything passed but F<t/waterloo.t>.  It failed 10 of 20 tests and
 exited with non-zero status indicating something dubious happened.
 
 The columns in the summary report mean:
@@ -338,18 +203,14 @@ Test::Harness currently only has one function, here it is.
 
   my $allok = runtests(@test_files);
 
-This runs all the given @test_files and divines whether they passed
+This runs all the given I<@test_files> and divines whether they passed
 or failed based on their output to STDOUT (details above).  It prints
 out each individual test which failed along with a summary report and
 a how long it all took.
 
-It returns true if everything was ok.  Otherwise it will die() with
+It returns true if everything was ok.  Otherwise it will C<die()> with
 one of the messages in the DIAGNOSTICS section.
 
-=for _private
-
-This is just _run_all_tests() plus _show_results()
-
 =cut
 
 sub runtests {
@@ -389,7 +250,7 @@ sub _all_ok {
   my @files = _globdir $dir;
 
 Returns all the files in a directory.  This is shorthand for backwards
-compatibility on systems where glob() doesn't work right.
+compatibility on systems where C<glob()> doesn't work right.
 
 =cut
 
@@ -442,10 +303,20 @@ B<NOTE> Currently this function is still noisy.  I'm working on it.
 
 =cut
 
-#'#
+# Turns on autoflush for the handle passed
+sub _autoflush {
+    my $flushy_fh = shift;
+    my $old_fh = select $flushy_fh;
+    $| = 1;
+    select $old_fh;
+}
+
 sub _run_all_tests {
-    my(@tests) = @_;
-    local($|) = 1;
+    my @tests = @_;
+
+    _autoflush(\*STDOUT);
+    _autoflush(\*STDERR);
+
     my(%failedtests);
 
     # Test-wide totals.
@@ -464,14 +335,10 @@ sub _run_all_tests {
                );
 
     my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
-    my $t_start = new Benchmark;
+    my $run_start_time = new Benchmark;
 
     my $width = _leader_width(@tests);
     foreach my $tfile (@tests) {
-	if ( $Test::Harness::Debug ) {
-	    print "# Running: ", $Strap->_command_line($tfile), "\n";
-	}
-
         $Last_ML_Print = 0;  # so each test prints at least once
         my($leader, $ml) = _mk_leader($tfile, $width);
         local $ML = $ml;
@@ -481,8 +348,25 @@ sub _run_all_tests {
         $tot{files}++;
 
         $Strap->{_seen_header} = 0;
+        if ( $Test::Harness::Debug ) {
+            print "# Running: ", $Strap->_command_line($tfile), "\n";
+        }
+        my $test_start_time = $Timer ? time : 0;
         my %results = $Strap->analyze_file($tfile) or
           do { warn $Strap->{error}, "\n";  next };
+        my $elapsed;
+        if ( $Timer ) {
+            $elapsed = time - $test_start_time;
+            if ( $has_time_hires ) {
+                $elapsed = sprintf( " %8.3fs", $elapsed );
+            }
+            else {
+                $elapsed = sprintf( " %8ss", $elapsed ? $elapsed : "<1" );
+            }
+        }
+        else {
+            $elapsed = "";
+        }
 
         # state of the current test.
         my @failed = grep { !$results{details}[$_-1]{ok} }
@@ -508,19 +392,23 @@ sub _run_all_tests {
         my($estatus, $wstatus) = @results{qw(exit wait)};
 
         if ($results{passing}) {
+            # XXX Combine these first two
             if ($test{max} and $test{skipped} + $test{bonus}) {
                 my @msg;
                 push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
                     if $test{skipped};
                 push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
                     if $test{bonus};
-                print "$test{ml}ok\n        ".join(', ', @msg)."\n";
-            } elsif ($test{max}) {
-                print "$test{ml}ok\n";
-            } elsif (defined $test{skip_all} and length $test{skip_all}) {
+                print "$test{ml}ok$elapsed\n        ".join(', ', @msg)."\n";
+            }
+            elsif ( $test{max} ) {
+                print "$test{ml}ok$elapsed\n";
+            }
+            elsif ( defined $test{skip_all} and length $test{skip_all} ) {
                 print "skipped\n        all skipped: $test{skip_all}\n";
                 $tot{skipped}++;
-            } else {
+            }
+            else {
                 print "skipped\n        all skipped: no reason given\n";
                 $tot{skipped}++;
             }
@@ -534,8 +422,7 @@ sub _run_all_tests {
             # List overruns as failures.
             else {
                 my $details = $results{details};
-                foreach my $overrun ($test{max}+1..@$details)
-                {
+                foreach my $overrun ($test{max}+1..@$details) {
                     next unless ref $details->[$overrun-1];
                     push @{$test{failed}}, $overrun
                 }
@@ -559,7 +446,8 @@ sub _run_all_tests {
                                              estat   => '',
                                              wstat   => '',
                                            };
-                } else {
+                }
+                else {
                     print "Don't know which tests failed: got $test{ok} ok, ".
                           "expected $test{max}\n";
                     $failedtests{$tfile} = { canon   => '??',
@@ -572,7 +460,8 @@ sub _run_all_tests {
                                            };
                 }
                 $tot{bad}++;
-            } else {
+            }
+            else {
                 print "FAILED before any test output arrived\n";
                 $tot{bad}++;
                 $failedtests{$tfile} = { canon       => '??',
@@ -597,8 +486,8 @@ sub _run_all_tests {
                 @dir_files = @new_dir_files;
             }
         }
-    }
-    $tot{bench} = timediff(new Benchmark, $t_start);
+    } # foreach test
+    $tot{bench} = timediff(new Benchmark, $run_start_time);
 
     $Strap->_restore_PERL5LIB;
 
@@ -609,7 +498,7 @@ sub _run_all_tests {
 
   my($leader, $ml) = _mk_leader($test_file, $width);
 
-Generates the 't/foo........' $leader for the given C<$test_file> as well
+Generates the 't/foo........' leader for the given C<$test_file> as well
 as a similar version which will overwrite the current line (by use of
 \r and such).  C<$ml> may be empty if Test::Harness doesn't think you're
 on TTY.
@@ -623,13 +512,15 @@ sub _mk_leader {
     chomp($te);
     $te =~ s/\.\w+$/./;
 
-    if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
-    my $blank = (' ' x 77);
+    if ($^O eq 'VMS') {
+        $te =~ s/^.*\.t\./\[.t./s;
+    }
     my $leader = "$te" . '.' x ($width - length($te));
     my $ml = "";
 
-    $ml = "\r$blank\r$leader"
-      if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
+    if ( -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose ) {
+        $ml = "\r" . (' ' x 77) . "\r$leader"
+    }
 
     return($leader, $ml);
 }
@@ -666,13 +557,16 @@ sub _show_results {
 
     if (_all_ok($tot)) {
         print "All tests successful$bonusmsg.\n";
-    } elsif (!$tot->{tests}){
+    }
+    elsif (!$tot->{tests}){
         die "FAILED--no tests were run for some reason.\n";
-    } elsif (!$tot->{max}) {
+    }
+    elsif (!$tot->{max}) {
         my $blurb = $tot->{tests}==1 ? "script" : "scripts";
         die "FAILED--$tot->{tests} test $blurb could be run, ".
             "alas--no output ever seen\n";
-    } else {
+    }
+    else {
         $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
         my $percent_ok = 100*$tot->{ok}/$tot->{max};
         my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
@@ -699,8 +593,14 @@ sub _show_results {
 }
 
 
-my %Handlers = ();
-$Strap->{callback} = sub {
+my %Handlers = (
+    header => \&header_handler,
+    test => \&test_handler,
+    bailout => \&bailout_handler,
+);
+
+$Strap->{callback} = \&strap_callback;
+sub strap_callback {
     my($self, $line, $type, $totals) = @_;
     print $line if $Verbose;
 
@@ -709,7 +609,7 @@ $Strap->{callback} = sub {
 };
 
 
-$Handlers{header} = sub {
+sub header_handler {
     my($self, $line, $type, $totals) = @_;
 
     warn "Test header seen more than once!\n" if $self->{_seen_header};
@@ -721,7 +621,7 @@ $Handlers{header} = sub {
          $totals->{max}  < $totals->{seen};
 };
 
-$Handlers{test} = sub {
+sub test_handler {
     my($self, $line, $type, $totals) = @_;
 
     my $curr = $totals->{seen};
@@ -753,7 +653,7 @@ $Handlers{test} = sub {
 
 };
 
-$Handlers{bailout} = sub {
+sub bailout_handler {
     my($self, $line, $type, $totals) = @_;
 
     die "FAILED--Further testing stopped" .
@@ -766,12 +666,12 @@ sub _print_ml {
 }
 
 
-# For slow connections, we save lots of bandwidth by printing only once
-# per second.
+# Print updates only once per second.
 sub _print_ml_less {
-    if( !$Ok_Slow || $Last_ML_Print != time ) {
+    my $now = CORE::time;
+    if ( $Last_ML_Print != $now ) {
         _print_ml(@_);
-        $Last_ML_Print = time;
+        $Last_ML_Print = $now;
     }
 }
 
@@ -811,14 +711,6 @@ sub _dubious_return {
            $wstatus,$wstatus;
     print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
 
-    if (_corestatus($wstatus)) { # until we have a wait module
-        if ($Have_Devel_Corestack) {
-            Devel::CoreStack::stack($^X);
-        } else {
-            print "\ttest program seems to have generated a core\n";
-        }
-    }
-
     $tot->{bad}++;
 
     if ($test->{max}) {
@@ -897,29 +789,6 @@ sub _create_fmts {
     return($fmt_top, $fmt);
 }
 
-{
-    my $tried_devel_corestack;
-
-    sub _corestatus {
-        my($st) = @_;
-
-        my $did_core;
-        eval { # we may not have a WCOREDUMP
-            local $^W = 0;  # *.ph files are often *very* noisy
-            require 'wait.ph';
-            $did_core = WCOREDUMP($st);
-        };
-        if( $@ ) {
-            $did_core = $st & 0200;
-        }
-
-        eval { require Devel::CoreStack; $Have_Devel_Corestack++ } 
-          unless $tried_devel_corestack++;
-
-        return $did_core;
-    }
-}
-
 sub _canonfailed ($$@) {
     my($max,$skipped,@failed) = @_;
     my %seen;
@@ -933,11 +802,7 @@ sub _canonfailed ($$@) {
     if (@failed) {
         for (@failed, $failed[-1]) { # don't forget the last one
             if ($_ > $last+1 || $_ == $last) {
-                if ($min == $last) {
-                    push @canon, $last;
-                } else {
-                    push @canon, "$min-$last";
-                }
+                push @canon, ($min == $last) ? $last : "$min-$last";
                 $min = $_;
             }
             $last = $_;
@@ -945,7 +810,8 @@ sub _canonfailed ($$@) {
         local $" = ", ";
         push @result, "FAILED tests @canon\n";
         $canon = join ' ', @canon;
-    } else {
+    }
+    else {
         push @result, "FAILED test $last\n";
         $canon = $last;
     }
@@ -953,17 +819,19 @@ sub _canonfailed ($$@) {
     push @result, "\tFailed $failed/$max tests, ";
     if ($max) {
 	push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
-    } else {
+    }
+    else {
 	push @result, "?% okay";
     }
     my $ender = 's' x ($skipped > 1);
-    my $good = $max - $failed - $skipped;
     if ($skipped) {
+        my $good = $max - $failed - $skipped;
 	my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
 	if ($max) {
 	    my $goodper = sprintf("%.2f",100*($good/$max));
 	    $skipmsg .= "$goodper%)";
-	} else {
+        }
+        else {
 	    $skipmsg .= "?%)";
 	}
 	push @result, $skipmsg;
@@ -1023,15 +891,26 @@ the script dies with this message.
 
 =back
 
-=head1 ENVIRONMENT
+=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS
+
+Test::Harness sets these before executing the individual tests.
 
 =over 4
 
 =item C<HARNESS_ACTIVE>
 
-Harness sets this before executing the individual tests.  This allows
-the tests to determine if they are being executed through the harness
-or by any other means.
+This is set to a true value.  It allows the tests to determine if they
+are being executed through the harness or by any other means.
+
+=item C<HARNESS_VERSION>
+
+This is the version of Test::Harness.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
+
+=over 4
 
 =item C<HARNESS_COLUMNS>
 
@@ -1078,12 +957,6 @@ 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 may help increase testing speed over slow
-connections, or with very large numbers of tests.
-
 =item C<HARNESS_PERL>
 
 Usually your tests will be run by C<$^X>, the currently-executing Perl.
@@ -1125,27 +998,9 @@ Here's how Test::Harness tests itself
 
 The included F<prove> utility for running test scripts from the command line,
 L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, L<Devel::CoreStack> to generate core
-dumps from failed tests and L<Devel::Cover> for test coverage
+the underlying timing routines, and L<Devel::Cover> for test coverage
 analysis.
 
-=head1 AUTHORS
-
-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, and then
-Michael G Schwern.
-
-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
 
 Provide a way of running tests quietly (ie. no printing) for automated
@@ -1162,8 +1017,6 @@ Figure a way to report test names in the failure summary.
 Rework the test summary so long test names are not truncated as badly.
 (Partially done with new skip test styles)
 
-Deal with VMS's "not \nok 4\n" mistake.
-
 Add option for coverage analysis.
 
 Trap STDERR.
@@ -1190,12 +1043,8 @@ 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
@@ -1205,16 +1054,23 @@ directory.
 
 Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
 You can also mail bugs, fixes and enhancements to 
-C<< <bug-test-harness@rt.cpan.org> >>.
+C<< <bug-test-harness >> at C<< rt.cpan.org> >>.
 
 =head1 AUTHORS
 
-Original code by Michael G Schwern, maintained by Andy Lester.
+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, and then
+Michael G Schwern.
+
+Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
 
 =head1 COPYRIGHT
 
-Copyright 2003 by Michael G Schwern C<< <schwern@pobox.com> >>,
-                  Andy Lester C<< <andy@petdance.com> >>.
+Copyright 2002-2005
+by Michael G Schwern C<< <schwern at pobox.com> >>,
+Andy Lester C<< <andy at petdance.com> >>.
 
 This program is free software; you can redistribute it and/or 
 modify it under the same terms as Perl itself.
diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply.t b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply.t
deleted file mode 100644
index 5291fb82c26..00000000000
--- a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply.t
+++ /dev/null
@@ -1,215 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        chdir 't';
-        @INC = ('../lib', 'lib');
-    }
-    else {
-        unshift @INC, 't/lib';
-    }
-}
-
-use strict;
-
-use Test::Builder;
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
-Test::Builder->new->no_header(1);
-Test::Builder->new->no_ending(1);
-
-# Can't use Test.pm, that's a 5.005 thing.
-package main;
-
-print "1..22\n";
-
-my $test_num = 1;
-# Utility testing functions.
-sub is ($$;$) {
-    my($this, $that, $name) = @_;
-    my $test = $$this eq $that;
-    my $ok = '';
-    $ok .= "not " unless $test;
-    $ok .= "ok $test_num";
-    $ok .= " - $name" if defined $name;
-    $ok .= "\n";
-    print $ok;
-
-    unless( $test ) {
-        print "# got      \n$$this";
-        print "# expected \n$that";
-    }
-    $test_num++;
-
-    $$this = '';
-
-    return $test;
-}
-
-sub like ($$;$) {
-    my($this, $regex, $name) = @_;
-
-    my $test = $$this =~ /$regex/;
-
-    my $ok = '';
-    $ok .= "not " unless $test;
-    $ok .= "ok $test_num";
-    $ok .= " - $name" if defined $name;
-    $ok .= "\n";
-    print $ok;
-
-    unless( $test ) {
-        print "# got      \n$$this";
-        print "# expected \n$regex";
-    }
-    $test_num++;
-
-    $$this = '';
-
-
-    return $test;
-}
-
-
-require Test::More;
-Test::More->import(tests => 11, import => ['is_deeply']);
-
-my $Filename = quotemeta $0;
-
-#line 68
-is_deeply('foo', 'bar', 'plain strings');
-is( $out, "not ok 1 - plain strings\n",     'plain strings' );
-is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 68)
-#          got: 'foo'
-#     expected: 'bar'
-ERR
-
-
-#line 78
-is_deeply({}, [], 'different types');
-is( $out, "not ok 2 - different types\n",   'different types' );
-like( $err, <<ERR,                          '   right diagnostic' );
-#     Failed test \\($Filename at line 78\\)
-#     Structures begin differing at:
-#          \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
-#     \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
-ERR
-
-#line 88
-is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
-is( $out, "not ok 3 - hashes with different values\n", 
-                                        'hashes with different values' );
-is( $err, <<ERR,                        '   right diagnostic' );
-#     Failed test ($0 at line 88)
-#     Structures begin differing at:
-#          \$got->{this} = '42'
-#     \$expected->{this} = '43'
-ERR
-
-#line 99
-is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
-is( $out, "not ok 4 - hashes with different keys\n",
-                                        'hashes with different keys' );
-is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 99)
-#     Structures begin differing at:
-#          \$got->{this} = Does not exist
-#     \$expected->{this} = '42'
-ERR
-
-#line 110
-is_deeply([1..9], [1..10],    'arrays of different length');
-is( $out, "not ok 5 - arrays of different length\n",
-                                        'arrays of different length' );
-is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 110)
-#     Structures begin differing at:
-#          \$got->[9] = Does not exist
-#     \$expected->[9] = '10'
-ERR
-
-#line 121
-is_deeply([undef, undef], [undef], 'arrays of undefs' );
-is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
-is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 121)
-#     Structures begin differing at:
-#          \$got->[1] = undef
-#     \$expected->[1] = Does not exist
-ERR
-
-#line 131
-is_deeply({ foo => undef }, {},    'hashes of undefs',    'hashes of undefs' );
-is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
-is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 131)
-#     Structures begin differing at:
-#          \$got->{foo} = undef
-#     \$expected->{foo} = Does not exist
-ERR
-
-#line 141
-is_deeply(\42, \23,   'scalar refs');
-is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
-is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 141)
-#     Structures begin differing at:
-#     \${     \$got} = '42'
-#     \${\$expected} = '23'
-ERR
-
-#line 151
-is_deeply([], \23,    'mixed scalar and array refs');
-is( $out, "not ok 9 - mixed scalar and array refs\n",
-                                        'mixed scalar and array refs' );
-like( $err, <<ERR,                      '    right diagnostic' );
-#     Failed test \\($Filename at line 151\\)
-#     Structures begin differing at:
-#          \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)'
-#     \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)'
-ERR
-
-
-my($a1, $a2, $a3);
-$a1 = \$a2;  $a2 = \$a3;
-$a3 = 42;
-
-my($b1, $b2, $b3);
-$b1 = \$b2;  $b2 = \$b3;
-$b3 = 23;
-
-#line 173
-is_deeply($a1, $b1, 'deep scalar refs');
-is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
-is( $err, <<ERR,                              '    right diagnostic' );
-#     Failed test ($0 at line 173)
-#     Structures begin differing at:
-#     \${\${     \$got}} = '42'
-#     \${\${\$expected}} = '23'
-ERR
-
-# I don't know how to properly display this structure.
-# $a2 = { foo => \$a3 };
-# $b2 = { foo => \$b3 };
-# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
-
-my $foo = {
-           this => [1..10],
-           that => { up => "down", left => "right" },
-          };
-
-my $bar = {
-           this => [1..10],
-           that => { up => "down", left => "right", foo => 42 },
-          };
-
-#line 198
-is_deeply( $foo, $bar, 'deep structures' );
-is( $out, "not ok 11 - deep structures\n",  'deep structures' );
-is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 198)
-#     Structures begin differing at:
-#          \$got->{that}{foo} = Does not exist
-#     \$expected->{that}{foo} = '42'
-ERR
diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
index 94e6db7bcf9..2f6812ade80 100644
--- a/gnu/usr.bin/perl/lib/Text/ParseWords.pm
+++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
@@ -1,7 +1,7 @@
 package Text::ParseWords;
 
 use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
-$VERSION = "3.23";
+$VERSION = "3.24";
 
 require 5.000;
 
@@ -12,7 +12,7 @@ use Exporter;
 
 
 sub shellwords {
-    local(@lines) = @_;
+    my(@lines) = @_;
     $lines[$#lines] =~ s/\s+$//;
     return(quotewords('\s+', 0, @lines));
 }
@@ -22,7 +22,6 @@ sub shellwords {
 sub quotewords {
     my($delim, $keep, @lines) = @_;
     my($line, @words, @allwords);
-    
 
     foreach $line (@lines) {
 	@words = parse_line($delim, $keep, $line);
@@ -37,7 +36,7 @@ sub quotewords {
 sub nested_quotewords {
     my($delim, $keep, @lines) = @_;
     my($i, @allwords);
-    
+
     for ($i = 0; $i < @lines; $i++) {
 	@{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
 	return() unless (@{$allwords[$i]} || !length($lines[$i]));
@@ -48,13 +47,11 @@ sub nested_quotewords {
 
 
 sub parse_line {
-	# We will be testing undef strings
-	no warnings;
-	use re 'taint'; # if it's tainted, leave it as such
-
     my($delimiter, $keep, $line) = @_;
     my($word, @pieces);
 
+    no warnings 'uninitialized';	# we will be testing undef strings
+
     while (length($line)) {
 	$line =~ s/^(["'])			# a $quote
         	    ((?:\\.|(?!\1)[^\\])*)	# and $quoted text
@@ -77,6 +74,7 @@ sub parse_line {
 		$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
             }
 	}
+        $word .= substr($line, 0, 0);	# leave results tainted
         $word .= defined $quote ? $quoted : $unquoted;
  
         if (length($delim)) {
@@ -100,41 +98,48 @@ sub old_shellwords {
     #	@words = old_shellwords($line);
     #	or
     #	@words = old_shellwords(@lines);
+    #	or
+    #	@words = old_shellwords();	# defaults to $_ (and clobbers it)
 
-    local($_) = join('', @_);
-    my(@words,$snippet,$field);
+    no warnings 'uninitialized';	# we will be testing undef strings
+    local *_ = \join('', @_) if @_;
+    my (@words, $snippet);
 
-    s/^\s+//;
+    s/\A\s+//;
     while ($_ ne '') {
-	$field = '';
+	my $field = substr($_, 0, 0);	# leave results tainted
 	for (;;) {
-	    if (s/^"(([^"\\]|\\.)*)"//) {
-		($snippet = $1) =~ s#\\(.)#$1#g;
+	    if (s/\A"(([^"\\]|\\.)*)"//s) {
+		($snippet = $1) =~ s#\\(.)#$1#sg;
 	    }
-	    elsif (/^"/) {
+	    elsif (/\A"/) {
+		require Carp;
+		Carp::carp("Unmatched double quote: $_");
 		return();
 	    }
-	    elsif (s/^'(([^'\\]|\\.)*)'//) {
-		($snippet = $1) =~ s#\\(.)#$1#g;
+	    elsif (s/\A'(([^'\\]|\\.)*)'//s) {
+		($snippet = $1) =~ s#\\(.)#$1#sg;
 	    }
-	    elsif (/^'/) {
+	    elsif (/\A'/) {
+		require Carp;
+		Carp::carp("Unmatched single quote: $_");
 		return();
 	    }
-	    elsif (s/^\\(.)//) {
+	    elsif (s/\A\\(.)//s) {
 		$snippet = $1;
 	    }
-	    elsif (s/^([^\s\\'"]+)//) {
+	    elsif (s/\A([^\s\\'"]+)//) {
 		$snippet = $1;
 	    }
 	    else {
-		s/^\s+//;
+		s/\A\s+//;
 		last;
 	    }
 	    $field .= $snippet;
 	}
 	push(@words, $field);
     }
-    @words;
+    return @words;
 }
 
 1;
diff --git a/gnu/usr.bin/perl/lib/Text/Tabs.pm b/gnu/usr.bin/perl/lib/Text/Tabs.pm
index b26f8f40548..36107fcfe3e 100644
--- a/gnu/usr.bin/perl/lib/Text/Tabs.pm
+++ b/gnu/usr.bin/perl/lib/Text/Tabs.pm
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT = qw(expand unexpand $tabstop);
 
 use vars qw($VERSION $tabstop $debug);
-$VERSION = 98.112801;
+$VERSION = 2005.0824;
 
 use strict;
 
@@ -16,15 +16,21 @@ BEGIN	{
 	$debug = 0;
 }
 
-sub expand
-{
-	my (@l) = @_;
-	for $_ (@l) {
-		1 while s/(^|\n)([^\t\n]*)(\t+)/
-			$1. $2 . (" " x 
-				($tabstop * length($3)
-				- (length($2) % $tabstop)))
-			/sex;
+sub expand {
+	my @l;
+	my $pad;
+	for ( @_ ) {
+		my $s = '';
+		for (split(/^/m, $_, -1)) {
+			my $offs = 0;
+			s{\t}{
+				$pad = $tabstop - (pos() + $offs) % $tabstop;
+				$offs += $pad - 1;
+				" " x $pad;
+			}eg;
+			$s .= $_;
+		}
+		push(@l, $s);
 	}
 	return @l if wantarray;
 	return $l[0];
@@ -66,6 +72,20 @@ sub unexpand
 1;
 __END__
 
+sub expand
+{
+	my (@l) = @_;
+	for $_ (@l) {
+		1 while s/(^|\n)([^\t\n]*)(\t+)/
+			$1. $2 . (" " x 
+				($tabstop * length($3)
+				- (length($2) % $tabstop)))
+			/sex;
+	}
+	return @l if wantarray;
+	return $l[0];
+}
+
 
 =head1 NAME
 
@@ -92,6 +112,10 @@ compression with plain ascii!
 expand doesn't handle newlines very quickly -- do not feed it an
 entire document in one string.  Instead feed it an array of lines.
 
-=head1 AUTHOR
+=head1 LICENSE
+
+Copyright (C) 1996-2002,2005 David Muir Sharnoff.  
+Copyright (C) 2005 Aristotle Pagaltzis 
+This module may be modified, used, copied, and redistributed at your own risk.
+Publicly redistributed modified versions must use a different name.
 
-David Muir Sharnoff <muir@idiom.com>
diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm
index 00677f900b2..d364cfc1195 100644
--- a/gnu/usr.bin/perl/lib/Text/Wrap.pm
+++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm
@@ -6,10 +6,10 @@ require Exporter;
 @EXPORT = qw(wrap fill);
 @EXPORT_OK = qw($columns $break $huge);
 
-$VERSION = 2001.09292;
+$VERSION = 2005.0824_01;
 
 use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
-	$separator);
+	$separator $separator2);
 use strict;
 
 BEGIN	{
@@ -20,6 +20,7 @@ BEGIN	{
 	$unexpand = 1;
 	$tabstop = 8;
 	$separator = "\n";
+	$separator2 = undef;
 }
 
 use Text::Tabs qw(expand unexpand);
@@ -43,7 +44,7 @@ sub wrap
 
 	pos($t) = 0;
 	while ($t !~ /\G\s*\Z/gc) {
-		if ($t =~ /\G([^\n]{0,$ll})($break|\z)/xmgc) {
+		if ($t =~ /\G([^\n]{0,$ll})($break|\n*\z)/xmgc) {
 			$r .= $unexpand 
 				? unexpand($nl . $lead . $1)
 				: $nl . $lead . $1;
@@ -52,7 +53,7 @@ sub wrap
 			$r .= $unexpand 
 				? unexpand($nl . $lead . $1)
 				: $nl . $lead . $1;
-			$remainder = $separator;
+			$remainder = defined($separator2) ? $separator2 : $separator;
 		} elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\z)/xmgc) {
 			$r .= $unexpand 
 				? unexpand($nl . $lead . $1)
@@ -66,7 +67,11 @@ sub wrap
 			
 		$lead = $xp;
 		$ll = $nll;
-		$nl = $separator;
+		$nl = defined($separator2)
+			? ($remainder eq "\n"
+				? "\n"
+				: $separator2)
+			: $separator;
 	}
 	$r .= $remainder;
 
@@ -151,7 +156,7 @@ be used: it is unlikley you would want to pass in a number.
 
 Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
 each paragraph separately and then joins them together when it's done.  It
-will destory any whitespace in the original text.  It breaks text into
+will destroy any whitespace in the original text.  It breaks text into
 paragraphs by looking for whitespace after a newline.  In other respects
 it acts like wrap().
 
@@ -183,12 +188,15 @@ C<$Text::Wrap::columns> is set in its own namespace without importing it.
 C<Text::Wrap::wrap()> starts its work by expanding all the tabs in its
 input into spaces.  The last thing it does it to turn spaces back
 into tabs.  If you do not want tabs in your results, set 
-C<$Text::Wrap::unexapand> to a false value.  Likewise if you do not
+C<$Text::Wrap::unexpand> to a false value.  Likewise if you do not
 want to use 8-character tabstops, set C<$Text::Wrap::tabstop> to
 the number of characters you do want for your tabstops.
 
 If you want to separate your lines with something other than C<\n>
-then set C<$Text::Wrap::seporator> to your preference.
+then set C<$Text::Wrap::separator> to your preference.  This replaces
+all newlines with C<$Text::Wrap::separator>.  If you just to preserve
+existing newlines but add new breaks with something else, set 
+C<$Text::Wrap::separator2> instead.
 
 When words that are longer than C<$columns> are encountered, they
 are broken up.  C<wrap()> adds a C<"\n"> at column C<$columns>.
@@ -205,8 +213,11 @@ C<$huge>.  Now, 'wrap' is the default value.
 	print wrap("\t","","This is a bit of text that forms 
 		a normal book-style paragraph");
 
-=head1 AUTHOR
+=head1 LICENSE
 
 David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
-many many others.  
+many many others.  Copyright (C) 1996-2002 David Muir Sharnoff.  
+This module may be modified, used, copied, and redistributed at
+your own risk.  Publicly redistributed modified versions must use 
+a different name.
 
diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm
index 98e0d50e7de..a838915482b 100644
--- a/gnu/usr.bin/perl/lib/Tie/Hash.pm
+++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm
@@ -1,6 +1,6 @@
 package Tie::Hash;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 =head1 NAME
 
@@ -167,7 +167,7 @@ method.
 
 The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>,
 B<Tie::StdHash>, or B<Tie::ExtraHash>.  Tied hashes do not require
-presense of these methods, but if defined, the methods will be called in
+presence of these methods, but if defined, the methods will be called in
 proper time, see L<perltie>.
 
 C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>.
diff --git a/gnu/usr.bin/perl/lib/Tie/RefHash.pm b/gnu/usr.bin/perl/lib/Tie/RefHash.pm
index 3f3fc6b2e52..cfcdd5b5a10 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.31;
+our $VERSION = 1.32;
 
 =head1 NAME
 
@@ -61,7 +61,7 @@ Gurusamy Sarathy        gsar@activestate.com
 
 =head1 VERSION
 
-Version 1.30
+Version 1.32
 
 =head1 SEE ALSO
 
@@ -115,7 +115,9 @@ sub STORE {
 
 sub DELETE {
   my($s, $k) = @_;
-  (ref $k) ? delete($s->[0]{overload::StrVal($k)}) : delete($s->[1]{$k});
+  (ref $k)
+    ? (delete($s->[0]{overload::StrVal($k)}) || [])->[1]
+    : delete($s->[1]{$k});
 }
 
 sub EXISTS {
diff --git a/gnu/usr.bin/perl/lib/Time/Local.pm b/gnu/usr.bin/perl/lib/Time/Local.pm
index 73407c7c133..912f17d0310 100644
--- a/gnu/usr.bin/perl/lib/Time/Local.pm
+++ b/gnu/usr.bin/perl/lib/Time/Local.pm
@@ -7,7 +7,7 @@ use strict;
 use integer;
 
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION    = '1.10';
+$VERSION    = '1.11';
 $VERSION    = eval $VERSION;
 @ISA	= qw( Exporter );
 @EXPORT	= qw( timegm timelocal );
@@ -33,13 +33,18 @@ if ($^O eq 'MacOS') {
 } else {
     $MaxInt = ((1 << (8 * $Config{intsize} - 2))-1)*2 + 1;
     $MinInt = -$MaxInt - 1;
+
+    # On Win32 (and others?) time_t appears to be signed, but negative
+    # epochs still don't work. - XXX - this is experimental
+    $MinInt = 0
+        unless defined ((localtime(-1))[0]);
 }
 
 $Max{Day} = ($MaxInt >> 1) / 43200;
-$Min{Day} = ($MinInt)? -($Max{Day}+1) : 0;
+$Min{Day} = $MinInt ? -($Max{Day} + 1) : 0;
 
-$Max{Sec} =  $MaxInt - 86400 * $Max{Day};
-$Min{Sec} =  $MinInt - 86400 * $Min{Day};
+$Max{Sec} = $MaxInt - 86400 * $Max{Day};
+$Min{Sec} = $MinInt - 86400 * $Min{Day};
 
 # Determine the EPOC day for this machine
 my $Epoc = 0;
@@ -111,6 +116,8 @@ sub timegm {
 	croak "Month '$month' out of range 0..11" if $month > 11 or $month < 0;
 
 	my $md = $MonthDays[$month];
+#        ++$md if $month == 1 and $year % 4 == 0 and
+#            ($year % 100 != 0 or ($year + 1900) % 400 == 0);
 	++$md unless $month != 1 or $year % 4 or !($year % 400);
 
 	croak "Day '$mday' out of range 1..$md"   if $mday  > $md  or $mday  < 1;
@@ -252,8 +259,8 @@ values, the following conventions are followed:
 =item *
 
 Years greater than 999 are interpreted as being the actual year,
-rather than the offset from 1900.  Thus, 1963 would indicate the year
-Martin Luther King won the Nobel prize, not the year 3863.
+rather than the offset from 1900.  Thus, 1964 would indicate the year
+Martin Luther King won the Nobel prize, not the year 3864.
 
 =item *
 
diff --git a/gnu/usr.bin/perl/lib/User/grent.pm b/gnu/usr.bin/perl/lib/User/grent.pm
index d9581d8aa84..ce6ee5ea447 100644
--- a/gnu/usr.bin/perl/lib/User/grent.pm
+++ b/gnu/usr.bin/perl/lib/User/grent.pm
@@ -2,7 +2,7 @@ package User::grent;
 use strict;
 
 use 5.006_001;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
@@ -51,7 +51,7 @@ User::grent - by-name interface to Perl's built-in getgr*() functions
      print "gid zero name wheel, with other members";
  } 
 
- use User::grent qw(:FIELDS;
+ use User::grent qw(:FIELDS);
  getgrgid(0) or die "No group zero";
  if ( $gr_name eq 'wheel' && @gr_members > 1 ) {
      print "gid zero name wheel, with other members";
diff --git a/gnu/usr.bin/perl/lib/autouse.pm b/gnu/usr.bin/perl/lib/autouse.pm
index f463fa3060f..fafc74a1d2c 100644
--- a/gnu/usr.bin/perl/lib/autouse.pm
+++ b/gnu/usr.bin/perl/lib/autouse.pm
@@ -3,7 +3,7 @@ package autouse;
 #use strict;		# debugging only
 use 5.003_90;		# ->can, for my $var
 
-$autouse::VERSION = '1.04';
+$autouse::VERSION = '1.05';
 
 $autouse::DEBUG ||= 0;
 
@@ -50,8 +50,7 @@ sub import {
 
 	my $load_sub = sub {
 	    unless ($INC{$pm}) {
-		eval {require $pm};
-		die if $@;
+		require $pm;
 		vet_import $module;
 	    }
             no warnings 'redefine';
@@ -63,7 +62,8 @@ sub import {
 	};
 
 	if (defined $proto) {
-	    *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
+	    *$closure_import_func = eval "sub ($proto) { goto &\$load_sub }"
+	        || die;
 	} else {
 	    *$closure_import_func = $load_sub;
 	}
diff --git a/gnu/usr.bin/perl/lib/base.pm b/gnu/usr.bin/perl/lib/base.pm
index 832b6a4a9a1..001914be4d3 100644
--- a/gnu/usr.bin/perl/lib/base.pm
+++ b/gnu/usr.bin/perl/lib/base.pm
@@ -2,7 +2,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.06';
+$VERSION = '2.07';
 
 # constant.pm is slow
 sub SUCCESS () { 1 }
@@ -78,7 +78,7 @@ sub import {
 	      unless defined ${$base.'::VERSION'};
         }
         else {
-            local $SIG{__DIE__} = 'IGNORE';
+            local $SIG{__DIE__};
             eval "require $base";
             # Only ignore "Can't locate" errors from our eval require.
             # Other fatal errors (syntax etc) must be reported.
diff --git a/gnu/usr.bin/perl/lib/blib.pm b/gnu/usr.bin/perl/lib/blib.pm
index df20add94c1..45ccd9b5184 100644
--- a/gnu/usr.bin/perl/lib/blib.pm
+++ b/gnu/usr.bin/perl/lib/blib.pm
@@ -16,7 +16,7 @@ Looks for MakeMaker-like I<'blib'> directory structure starting in
 I<dir> (or current directory) and working back up to five levels of '..'.
 
 Intended for use on command line with B<-M> option as a way of testing
-arbitary scripts against an uninstalled version of a package.
+arbitrary scripts against an uninstalled version of a package.
 
 However it is possible to : 
 
@@ -40,7 +40,7 @@ use Cwd;
 use File::Spec;
 
 use vars qw($VERSION $Verbose);
-$VERSION = '1.02';
+$VERSION = '1.03';
 $Verbose = 0;
 
 sub import
diff --git a/gnu/usr.bin/perl/lib/constant.pm b/gnu/usr.bin/perl/lib/constant.pm
index 93086d53985..159c29978a5 100644
--- a/gnu/usr.bin/perl/lib/constant.pm
+++ b/gnu/usr.bin/perl/lib/constant.pm
@@ -5,7 +5,7 @@ use 5.006_00;
 use warnings::register;
 
 our($VERSION, %declared);
-$VERSION = '1.04';
+$VERSION = '1.05';
 
 #=======================================================================
 
@@ -71,11 +71,6 @@ sub import {
 		} elsif ($forced_into_main{$name}) {
 		    warnings::warn("Constant name '$name' is " .
 			"forced into package main::");
-		} else {
-		    # Catch-all - what did I miss? If you get this error,
-		    # please let me know what your constant's name was.
-		    # Write to <rootbeer@redcat.com>. Thanks!
-		    warnings::warn("Constant name '$name' has unknown problems");
 		}
 	    }
 
diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm
index a1910359b41..213638f1d85 100644
--- a/gnu/usr.bin/perl/lib/diagnostics.pm
+++ b/gnu/usr.bin/perl/lib/diagnostics.pm
@@ -60,7 +60,7 @@ allowing duplicate user messages to be displayed.
 
 This module also adds a stack trace to the error message when perl dies.
 This is useful for pinpointing what caused the death. The B<-traceonly> (or
-just B<-t>) flag turns off the explantions of warning messages leaving just
+just B<-t>) flag turns off the explanations of warning messages leaving just
 the stack traces. So if your script is dieing, run it again with
 
   perl -Mdiagnostics=-traceonly my_bad_script
@@ -185,7 +185,7 @@ use 5.006;
 use Carp;
 $Carp::Internal{__PACKAGE__.""}++;
 
-our $VERSION = 1.14;
+our $VERSION = 1.15;
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
diff --git a/gnu/usr.bin/perl/lib/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
index 474818a6571..43e107ff5f6 100644
--- a/gnu/usr.bin/perl/lib/dumpvar.pl
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -80,7 +80,7 @@ sub stringify {
 	} elsif ($unctrl eq 'quote') {
 	  s/([\"\\\$\@])/\\$1/g if $tick eq '"';
 	  s/\033/\\e/g;
-	  s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
+	  s/([\000-\037\177])/'\\c'._escaped_ord($1)/eg;
 	}
 	$_ = uniescape($_);
 	s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $quoteHighBit;
@@ -89,6 +89,14 @@ sub stringify {
 	  : $tick . $_ . $tick;
 }
 
+# Ensure a resulting \ is escaped to be \\
+sub _escaped_ord {
+    my $chr = shift;
+    $chr = chr(ord($chr)^64);
+    $chr =~ s{\\}{\\\\}g;
+    return $chr;
+}
+
 sub ShortArray {
   my $tArrayDepth = $#{$_[0]} ; 
   $tArrayDepth = $#{$_[0]} < $arrayDepth-1 ? $#{$_[0]} : $arrayDepth-1 
diff --git a/gnu/usr.bin/perl/lib/getopts.pl b/gnu/usr.bin/perl/lib/getopts.pl
index 4a50b8f6c22..e30820a3189 100644
--- a/gnu/usr.bin/perl/lib/getopts.pl
+++ b/gnu/usr.bin/perl/lib/getopts.pl
@@ -31,7 +31,7 @@ sub Getopts {
 				}
 				eval "
 				push(\@opt_$first, \$rest);
-				if(\$opt_$first eq '') {
+				if (!defined \$opt_$first or \$opt_$first eq '') {
 					\$opt_$first = \$rest;
 				}
 				else {
diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm
index 577c3878ecc..15b7e775e74 100644
--- a/gnu/usr.bin/perl/lib/overload.pm
+++ b/gnu/usr.bin/perl/lib/overload.pm
@@ -1,6 +1,6 @@
 package overload;
 
-our $VERSION = '1.02';
+our $VERSION = '1.04';
 
 $overload::hint_bits = 0x20000; # HINT_LOCALIZE_HH
 
@@ -93,11 +93,7 @@ sub AddrRef {
 	return sprintf("$class_prefix$type(0x%x)", $addr);
 }
 
-sub StrVal {
-  (ref $_[0] && OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
-    (AddrRef(shift)) :
-    "$_[0]";
-}
+*StrVal = *AddrRef;
 
 sub mycan {				# Real can would leave stubs.
   my ($package, $meth) = @_;
@@ -174,7 +170,7 @@ __END__
 
 =head1 NAME
 
-overload - Package for overloading perl operations
+overload - Package for overloading Perl operations
 
 =head1 SYNOPSIS
 
@@ -721,12 +717,12 @@ Returns C<undef> or a reference to the method that implements C<op>.
 
 =head1 Overloading constants
 
-For some application Perl parser mangles constants too much.  It is possible
-to hook into this process via overload::constant() and overload::remove_constant()
-functions.
+For some applications, the Perl parser mangles constants too much.
+It is possible to hook into this process via C<overload::constant()>
+and C<overload::remove_constant()> functions.
 
 These functions take a hash as an argument.  The recognized keys of this hash
-are
+are:
 
 =over 8
 
diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl
index a45a5720c20..53f84b9bf7a 100644
--- a/gnu/usr.bin/perl/lib/perl5db.pl
+++ b/gnu/usr.bin/perl/lib/perl5db.pl
@@ -215,7 +215,7 @@ 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 F</tmp/perldbtty$$> to find TTY using
+uses the value of noTTY or F<$HOME/.perldbtty$$> to find TTY using
 Term::Rendezvous.  Current variant is to have the name of TTY in this
 file.
 
@@ -689,6 +689,9 @@ sub eval {
 # true if $deep is not defined.
 #
 # $Log: perl5db.pl,v $
+# Revision 1.10  2005/01/15 21:30:31  millert
+# sync in-tree perl with 5.8.6
+#
 # Revision 1.9  2004/08/09 18:09:28  millert
 # merge 5.8.5 into HEAD
 # remove now-unused files
@@ -926,7 +929,7 @@ sub eval {
 #   + Fix a side-effect of bug #24674 in the perl debugger ("odd taint bug")
 # Changes: 1.24: Mar 03, 2004 Richard Foley <richard.foley@rfi.net>
 #   + Added command to save all debugger commands for sourcing later.
-#   + Added command to display parent inheritence tree of given class.
+#   + Added command to display parent inheritance tree of given class.
 #   + Fixed minor newline in history bug.
 # Changes: 1.25: Apr 17, 2004 Richard Foley <richard.foley@rfi.net>
 #   + Fixed option bug (setting invalid options + not recognising valid short forms)
@@ -2049,8 +2052,8 @@ to enter commands and have a valid context to be in.
             $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.  
+  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
 
             # Set the DB::eval context appropriately.
@@ -2758,7 +2761,7 @@ in this and all call levels above this one.
                     # 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
+                    # preceding 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.
@@ -6019,8 +6022,8 @@ sub setterm {
             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$$";
+            # Use $HOME/.perldbtty$$ if not.
+            my $rv = $ENV{PERLDB_NOTTY} || "$ENV{HOME}/.perldbtty$$";
 
             # Rendezvous and get the filehandles.
             my $term_rv = new Term::Rendezvous $rv;
@@ -6649,7 +6652,7 @@ sub get_list {
 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, particularily under I<unsafe signals>.
+get all confused if we do, particularly under I<unsafe signals>.
 
 =cut
 
@@ -8327,7 +8330,7 @@ Find all the subroutines that might match in this package
 
 =item *
 
-Add C<postpone>, C<load>, and C<compile> as possibles (we may be completing the keyword itself
+Add C<postpone>, C<load>, and C<compile> as possibles (we may be completing the keyword itself)
 
 =item *
 
diff --git a/gnu/usr.bin/perl/lib/utf8.t b/gnu/usr.bin/perl/lib/utf8.t
index 576d90e5a81..81ebc221614 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 => 145;
+plan tests => 150;
 
 {
     # bug id 20001009.001
@@ -425,3 +425,17 @@ SKIP: {
     utf8::upgrade($b);
     is($b, $a, "utf8::upgrade OffsetOK");
 }
+
+{
+    fresh_perl_like ('use utf8; utf8::moo()',
+		     qr/Undefined subroutine utf8::moo/, {stderr=>1},
+		    "Check Carp is loaded for AUTOLOADing errors")
+}
+
+{
+    # failure of is_utf8_char() without NATIVE_TO_UTF on EBCDIC (0260..027F)
+    ok(utf8::valid(chr(0x250)), "0x250");
+    ok(utf8::valid(chr(0x260)), "0x260");
+    ok(utf8::valid(chr(0x270)), "0x270");
+    ok(utf8::valid(chr(0x280)), "0x280");
+}