Import of Perl 5.003 into the tree. Makefile.bsd-wrapper and

config.sh.OpenBSD are the only local changes.

106 files changed, 27774 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/lib/AnyDBM_File.pm b/gnu/usr.bin/perl/lib/AnyDBM_File.pm
new file mode 100644
index 00000000000..50acce412a4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AnyDBM_File.pm
@@ -0,0 +1,92 @@
+package AnyDBM_File;
+
+@ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
+
+eval { require NDBM_File } ||
+eval { require DB_File } ||
+eval { require GDBM_File } ||
+eval { require SDBM_File } ||
+eval { require ODBM_File };
+
+=head1 NAME
+
+AnyDBM_File - provide framework for multiple DBMs
+
+NDBM_File, ODBM_File, SDBM_File, GDBM_File - various DBM implementations
+
+=head1 SYNOPSIS
+
+    use AnyDBM_File;
+
+=head1 DESCRIPTION
+
+This module is a "pure virtual base class"--it has nothing of its own.
+It's just there to inherit from one of the various DBM packages.  It
+prefers ndbm for compatibility reasons with Perl 4, then Berkeley DB (See
+L<DB_File>), GDBM, SDBM (which is always there--it comes with Perl), and
+finally ODBM.   This way old programs that used to use NDBM via dbmopen()
+can still do so, but new ones can reorder @ISA:
+
+    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
+
+Note, however, that an explicit use overrides the specified order:
+
+    use GDBM_File;
+    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
+
+will only find GDBM_File.
+
+Having multiple DBM implementations makes it trivial to copy database formats:
+
+    use POSIX; use NDBM_File; use DB_File;
+    tie %newhash,  DB_File, $new_filename, O_CREAT|O_RDWR;
+    tie %oldhash,  NDBM_File, $old_filename, 1, 0;
+    %newhash = %oldhash;
+
+=head2 DBM Comparisons
+
+Here's a partial table of features the different packages offer:
+
+                         odbm    ndbm    sdbm    gdbm    bsd-db
+			 ----	 ----    ----    ----    ------
+ Linkage comes w/ perl   yes     yes     yes     yes     yes
+ Src comes w/ perl       no      no      yes     no      no
+ Comes w/ many unix os   yes     yes[0]  no      no      no
+ Builds ok on !unix      ?       ?       yes     yes     ?
+ Code Size               ?       ?       small   big     big
+ Database Size           ?       ?       small   big?    ok[1]
+ Speed                   ?       ?       slow    ok      fast
+ FTPable                 no      no      yes     yes     yes
+ Easy to build          N/A     N/A      yes     yes     ok[2]
+ Size limits             1k      4k      1k[3]   none    none
+ Byte-order independent  no      no      no      no      yes
+ Licensing restrictions  ?       ?       no      yes     no
+
+
+=over 4
+
+=item [0] 
+
+on mixed universe machines, may be in the bsd compat library,
+which is often shunned.
+
+=item [1] 
+
+Can be trimmed if you compile for one access method.
+
+=item [2] 
+
+See L<DB_File>. 
+Requires symbolic links.  
+
+=item [3] 
+
+By default, but can be redefined.
+
+=back
+
+=head1 SEE ALSO
+
+dbm(3), ndbm(3), DB_File(3)
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/AutoLoader.pm b/gnu/usr.bin/perl/lib/AutoLoader.pm
new file mode 100644
index 00000000000..566ca8688e9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AutoLoader.pm
@@ -0,0 +1,75 @@
+package AutoLoader;
+use Carp;
+$DB::sub = $DB::sub;	# Avoid warning
+
+=head1 NAME
+
+AutoLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+    package FOOBAR;
+    use Exporter;
+    use AutoLoader;
+    @ISA = (Exporter, AutoLoader);
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from F<auto/$AUTOLOAD.al>.  See L<perlsub/"Autoloading">.
+
+=cut
+
+AUTOLOAD {
+    my $name = "auto/$AUTOLOAD.al";
+    $name =~ s#::#/#g;
+    eval {require $name};
+    if ($@) {
+	# The load might just have failed because the filename was too
+	# long for some old SVR3 systems which treat long names as errors.
+	# If we can succesfully truncate a long name then it's worth a go.
+	# There is a slight risk that we could pick up the wrong file here
+	# but autosplit should have warned about that when splitting.
+	if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+	    eval {require $name};
+	}
+	elsif ($AUTOLOAD =~ /::DESTROY$/) {
+	    # eval "sub $AUTOLOAD {}";
+	    *$AUTOLOAD = sub {};
+	}
+	if ($@){
+	    $@ =~ s/ at .*\n//;
+	    croak $@;
+	}
+    }
+    $DB::sub = $AUTOLOAD;	# Now debugger know where we are.
+    goto &$AUTOLOAD;
+}
+                            
+sub import {
+    my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
+    ($callpack = $callclass) =~ s#::#/#;
+    # Try to find the autosplit index file.  Eg., if the call package
+    # is POSIX, then $INC{POSIX.pm} is something like
+    # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
+    # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
+    #
+    # However, if @INC is a relative path, this might not work.  If,
+    # for example, @INC = ('lib'), then
+    # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
+    # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
+    #
+    if (defined($path = $INC{$callpack . '.pm'})) {
+	# Try absolute path name.
+	$path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#;
+	eval { require $path; };
+	# If that failed, try relative path with normal @INC searching.
+	if ($@) {
+	    $path ="auto/$callpack/autosplit.ix";
+	    eval { require $path; };
+	}
+	carp $@ if ($@);  
+    } 
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/AutoSplit.pm b/gnu/usr.bin/perl/lib/AutoSplit.pm
new file mode 100644
index 00000000000..f9e3ad6dc4c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AutoSplit.pm
@@ -0,0 +1,277 @@
+package AutoSplit;
+
+require 5.000;
+require Exporter;
+
+use Config;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&autosplit &autosplit_lib_modules);
+@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
+
+=head1 NAME
+
+AutoSplit - split a package for autoloading
+
+=head1 SYNOPSIS
+
+ perl -e 'use AutoSplit; autosplit_modules(@ARGV)'  ...
+
+=head1 DESCRIPTION
+
+This function will split up your program into files that the AutoLoader
+module can handle.  Normally only used to build autoloading Perl library
+modules, especially extensions (like POSIX).  You should look at how
+they're built out for details.
+
+=cut
+
+# for portability warn about names longer than $maxlen
+$Maxlen  = 8;	# 8 for dos, 11 (14-".al") for SYSVR3
+$Verbose = 1;	# 0=none, 1=minimal, 2=list .al files
+$Keep    = 0;
+$CheckForAutoloader = 1;
+$CheckModTime = 1;
+
+$IndexFile = "autosplit.ix";	# file also serves as timestamp
+$maxflen = 255;
+$maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
+$Is_VMS = ($^O eq 'VMS');
+
+
+sub autosplit{
+    my($file, $autodir,  $k, $ckal, $ckmt) = @_;
+    # $file    - the perl source file to be split (after __END__)
+    # $autodir - the ".../auto" dir below which to write split subs
+    # Handle optional flags:
+    $keep = $Keep unless defined $k;
+    $ckal = $CheckForAutoloader unless defined $ckal;
+    $ckmt = $CheckModTime unless defined $ckmt;
+    autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
+}
+
+
+# This function is used during perl building/installation
+# ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
+
+sub autosplit_lib_modules{
+    my(@modules) = @_; # list of Module names
+
+    foreach(@modules){
+	s#::#/#g;	# incase specified as ABC::XYZ
+	s|\\|/|g;		# bug in ksh OS/2
+	s#^lib/##; # incase specified as lib/*.pm
+	if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs
+	    my ($dir,$name) = (/(.*])(.*)/);
+	    $dir =~ s/.*lib[\.\]]//;
+	    $dir =~ s#[\.\]]#/#g;
+	    $_ = $dir . $name;
+	}
+	autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
+    }
+    0;
+}
+
+
+# private functions
+
+sub autosplit_file{
+    my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
+    my(@names);
+
+    # where to write output files
+    $autodir = "lib/auto" unless $autodir;
+    ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS;
+    unless (-d $autodir){
+	local($", @p)="/";
+	foreach(split(/\//,$autodir)){
+	    push(@p, $_);
+	    next if -d "@p/";
+	    mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
+	}
+	# We should never need to create the auto dir here. installperl
+	# (or similar) should have done it. Expecting it to exist is a valuable
+	# sanity check against autosplitting into some random directory by mistake.
+	print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
+    }
+
+    # allow just a package name to be used
+    $filename .= ".pm" unless ($filename =~ m/\.pm$/);
+
+    open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
+    my($pm_mod_time) = (stat($filename))[9];
+    my($autoloader_seen) = 0;
+    my($in_pod) = 0;
+    while (<IN>) {
+	# Skip pod text.
+	$in_pod = 1 if /^=/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+
+	# record last package name seen
+	$package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
+	++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
+	++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
+	last if /^__END__/;
+    }
+    if ($check_for_autoloader && !$autoloader_seen){
+	print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
+	return 0
+    }
+    $_ or die "Can't find __END__ in $filename\n";
+
+    $package or die "Can't find 'package Name;' in $filename\n";
+
+    my($modpname) = $package; $modpname =~ s#::#/#g;
+    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+
+    die "Package $package does not match filename $filename"
+	    unless ($filename =~ m/$modpname.pm$/ or
+	            $Is_VMS && $filename =~ m/$modpname.pm/i);
+
+    if ($check_mod_time){
+	my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
+	if ($al_ts_time >= $pm_mod_time){
+	    print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
+		if ($Verbose >= 2);
+	    return undef;	# one undef, not a list
+	}
+    }
+
+    my($from) = ($Verbose>=2) ? "$filename => " : "";
+    print "AutoSplitting $package ($from$autodir/$modpname)\n"
+	if $Verbose;
+
+    unless (-d "$autodir/$modpname"){
+	local($", @p)="/";
+	foreach(split(/\//,"$autodir/$modpname")){
+	    push(@p, $_);
+	    next if -d "@p/";
+	    mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
+	}
+    }
+
+    # We must try to deal with some SVR3 systems with a limit of 14
+    # characters for file names. Sadly we *cannot* simply truncate all
+    # file names to 14 characters on these systems because we *must*
+    # create filenames which exactly match the names used by AutoLoader.pm.
+    # This is a problem because some systems silently truncate the file
+    # names while others treat long file names as an error.
+
+    # We do not yet deal with multiple packages within one file.
+    # Ideally both of these styles should work.
+    #
+    #   package NAME;
+    #   __END__
+    #   sub AAA { ... }
+    #   package NAME::option1;
+    #   sub BBB { ... }
+    #   package NAME::option2;
+    #   sub BBB { ... }
+    #
+    #   package NAME;
+    #   __END__
+    #   sub AAA { ... }
+    #   sub NAME::option1::BBB { ... }
+    #   sub NAME::option2::BBB { ... }
+    #
+    # For now both of these produce warnings.
+
+    open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
+    my(@subnames, %proto);
+    while (<IN>) {
+	if (/^package ([\w:]+)\s*;/) {
+	    warn "package $1; in AutoSplit section ignored. Not currently supported.";
+	}
+	if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
+	    print OUT "1;\n";
+	    my $subname = $1;
+	    $proto{$1} = $2 or '';
+	    if ($subname =~ m/::/){
+		warn "subs with package names not currently supported in AutoSplit section";
+	    }
+	    push(@subnames, $subname);
+	    my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
+	    my($lpath) = "$autodir/$modpname/$lname.al";
+	    my($spath) = "$autodir/$modpname/$sname.al";
+	    unless(open(OUT, ">$lpath")){
+		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+		push(@names, $sname);
+		print "  writing $spath (with truncated name)\n"
+			if ($Verbose>=1);
+	    }else{
+		push(@names, $lname);
+		print "  writing $lpath\n" if ($Verbose>=2);
+	    }
+	    print OUT "# NOTE: Derived from $filename.  ",
+			"Changes made here will be lost.\n";
+	    print OUT "package $package;\n\n";
+	}
+	print OUT $_;
+    }
+    print OUT "1;\n";
+    close(OUT);
+    close(IN);
+
+    if (!$keep){  # don't keep any obsolete *.al files in the directory
+	my(%names);
+	@names{@names} = @names;
+	opendir(OUTDIR,"$autodir/$modpname");
+	foreach(sort readdir(OUTDIR)){
+	    next unless /\.al$/;
+	    my($subname) = m/(.*)\.al$/;
+	    next if $names{substr($subname,0,$maxflen-3)};
+	    my($file) = "$autodir/$modpname/$_";
+	    print "  deleting $file\n" if ($Verbose>=2);
+	    my($deleted,$thistime);  # catch all versions on VMS
+	    do { $deleted += ($thistime = unlink $file) } while ($thistime);
+	    carp "Unable to delete $file: $!" unless $deleted;
+	}
+	closedir(OUTDIR);
+    }
+
+    open(TS,">$al_idx_file") or
+	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
+    print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
+    print TS "package $package;\n";
+    print TS map("sub $_$proto{$_} ;\n", @subnames);
+    print TS "1;\n";
+    close(TS);
+
+    check_unique($package, $Maxlen, 1, @names);
+
+    @names;
+}
+
+
+sub check_unique{
+    my($module, $maxlen, $warn, @names) = @_;
+    my(%notuniq) = ();
+    my(%shorts)  = ();
+    my(@toolong) = grep(length > $maxlen, @names);
+
+    foreach(@toolong){
+	my($trunc) = substr($_,0,$maxlen);
+	$notuniq{$trunc}=1 if $shorts{$trunc};
+	$shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
+    }
+    if (%notuniq && $warn){
+	print "$module: some names are not unique when truncated to $maxlen characters:\n";
+	foreach(keys %notuniq){
+	    print " $shorts{$_} truncate to $_\n";
+	}
+    }
+    %notuniq;
+}
+
+1;
+__END__
+
+# test functions so AutoSplit.pm can be applied to itself:
+sub test1{ "test 1\n"; }
+sub test2{ "test 2\n"; }
+sub test3{ "test 3\n"; }
+sub test4{ "test 4\n"; }
+
+
diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm
new file mode 100644
index 00000000000..9929e6e0be6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Benchmark.pm
@@ -0,0 +1,411 @@
+package Benchmark;
+
+=head1 NAME
+
+Benchmark - benchmark running times of code
+
+timethis - run a chunk of code several times
+
+timethese - run several chunks of code several times
+
+timeit - run a chunk of code and see how long it goes
+
+=head1 SYNOPSIS
+
+    timethis ($count, "code");
+
+    timethese($count, {
+	'Name1' => '...code1...',
+	'Name2' => '...code2...',
+    });
+
+    $t = timeit($count, '...other code...')
+    print "$count loops of other code took:",timestr($t),"\n";
+
+=head1 DESCRIPTION
+
+The Benchmark module encapsulates a number of routines to help you
+figure out how long it takes to execute some code.
+
+=head2 Methods
+
+=over 10
+
+=item new
+
+Returns the current time.   Example:
+
+    use Benchmark;
+    $t0 = new Benchmark;
+    # ... your code here ...
+    $t1 = new Benchmark;
+    $td = timediff($t1, $t0);
+    print "the code took:",timestr($dt),"\n";
+
+=item debug
+
+Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
+
+    debug Benchmark 1; 
+    $t = timeit(10, ' 5 ** $Global ');
+    debug Benchmark 0; 
+
+=back
+
+=head2 Standard Exports
+
+The following routines will be exported into your namespace 
+if you use the Benchmark module:
+
+=over 10
+
+=item timeit(COUNT, CODE)
+
+Arguments: COUNT is the number of time to run the loop, and 
+the second is the code to run.  CODE may be a string containing the code,
+a reference to the function to run, or a reference to a hash containing 
+keys which are names and values which are more CODE specs.
+
+Side-effects: prints out noise to standard out.
+
+Returns: a Benchmark object.  
+
+=item timethis
+
+=item timethese
+
+=item timediff
+
+=item timestr
+
+=back
+
+=head2 Optional Exports
+
+The following routines will be exported into your namespace
+if you specifically ask that they be imported:
+
+=over 10
+
+clearcache
+
+clearallcache
+
+disablecache
+
+enablecache
+
+=back
+
+=head1 NOTES
+
+The data is stored as a list of values from the time and times
+functions: 
+
+      ($real, $user, $system, $children_user, $children_system)
+
+in seconds for the whole loop (not divided by the number of rounds).
+
+The timing is done using time(3) and times(3).
+
+Code is executed in the caller's package.
+
+Enable debugging by:  
+
+    $Benchmark::debug = 1;
+
+The time of the null loop (a loop with the same
+number of rounds but empty loop body) is subtracted
+from the time of the real loop.
+
+The null loop times are cached, the key being the
+number of rounds. The caching can be controlled using
+calls like these:
+
+    clearcache($key); 
+    clearallcache();
+
+    disablecache(); 
+    enablecache();
+
+=head1 INHERITANCE
+
+Benchmark inherits from no other class, except of course
+for Exporter.
+
+=head1 CAVEATS
+
+The real time timing is done using time(2) and
+the granularity is therefore only one second.
+
+Short tests may produce negative figures because perl
+can appear to take longer to execute the empty loop 
+than a short test; try: 
+
+    timethis(100,'1');
+
+The system time of the null loop might be slightly
+more than the system time of the loop with the actual
+code and therefore the difference might end up being < 0.
+
+More documentation is needed :-( especially for styles and formats.
+
+=head1 AUTHORS
+
+Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>,
+Tim Bunce <Tim.Bunce@ig.co.uk>
+
+=head1 MODIFICATION HISTORY
+
+September 8th, 1994; by Tim Bunce.
+
+=cut
+
+# Purpose: benchmark running times of code.
+#
+#
+# Usage - to time code snippets and print results:
+#
+#	timethis($count, '...code...');
+#		
+# prints:
+#	timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
+#
+#
+#	timethese($count, {
+#		Name1 => '...code1...',
+#		Name2 => '...code2...',
+#		... });
+# prints:
+#	Benchmark: timing 100 iterations of Name1, Name2...
+#	     Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
+#	     Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
+#
+# The default display style will automatically add child process
+# values if non-zero.
+#
+#
+# Usage - to time sections of your own code:
+#
+#	use Benchmark;
+#	$t0 = new Benchmark;
+#	... your code here ...
+#	$t1 = new Benchmark;
+#	$td = &timediff($t1, $t0);
+#	print "the code took:",timestr($td),"\n";
+#
+#	$t = &timeit($count, '...other code...')
+#	print "$count loops of other code took:",timestr($t),"\n";
+# 
+#
+# Data format:
+#       The data is stored as a list of values from the time and times
+#       functions: ($real, $user, $system, $children_user, $children_system)
+#	in seconds for the whole loop (not divided by the number of rounds).
+#		
+# Internals:
+#	The timing is done using time(3) and times(3).
+#		
+#	Code is executed in the callers package
+#
+#	Enable debugging by:  $Benchmark::debug = 1;
+#
+#	The time of the null loop (a loop with the same
+#	number of rounds but empty loop body) is substracted
+#	from the time of the real loop.
+#
+#	The null loop times are cached, the key being the
+#	number of rounds. The caching can be controlled using
+#	&clearcache($key); &clearallcache;
+#	&disablecache; &enablecache;
+#
+# Caveats:
+#
+#	The real time timing is done using time(2) and
+#	the granularity is therefore only one second.
+#
+#	Short tests may produce negative figures because perl
+#	can appear to take longer to execute the empty loop 
+#	than a short test: try timethis(100,'1');
+#
+#	The system time of the null loop might be slightly
+#	more than the system time of the loop with the actual
+#	code and therefore the difference might end up being < 0
+#
+#	More documentation is needed :-(
+#	Especially for styles and formats.
+#
+# Authors:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
+# 		Tim Bunce <Tim.Bunce@ig.co.uk>
+#
+#
+# Last updated:	Sept 8th 94 by Tim Bunce
+#
+
+use Carp;
+use Exporter;
+@ISA=(Exporter);
+@EXPORT=qw(timeit timethis timethese timediff timestr);
+@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
+
+&init;
+
+sub init {
+    $debug = 0;
+    $min_count = 4;
+    $min_cpu   = 0.4;
+    $defaultfmt = '5.2f';
+    $defaultstyle = 'auto';
+    # The cache can cause a slight loss of sys time accuracy. If a
+    # user does many tests (>10) with *very* large counts (>10000)
+    # or works on a very slow machine the cache may be useful.
+    &disablecache;
+    &clearallcache;
+}
+
+sub clearcache    { delete $cache{$_[0]}; }
+sub clearallcache { %cache = (); }
+sub enablecache   { $cache = 1; }
+sub disablecache  { $cache = 0; }
+
+
+# --- Functions to process the 'time' data type
+
+sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
+
+sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
+sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
+sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
+sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
+
+sub timediff{
+    my($a, $b) = @_;
+    my(@r);
+    for($i=0; $i < @$a; ++$i){
+	push(@r, $a->[$i] - $b->[$i]);
+    }
+    bless \@r;
+}
+
+sub timestr{
+    my($tr, $style, $f) = @_;
+    my(@t) = @$tr;
+    warn "bad time value" unless @t==5;
+    my($r, $pu, $ps, $cu, $cs) = @t;
+    my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
+    $f = $defaultfmt unless $f;
+    # format a time in the required style, other formats may be added here
+    $style = $defaultstyle unless $style;
+    $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
+    my($s) = "@t $style"; # default for unknown style
+    $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
+			    @t,$t) if $style =~ /^all$/;
+    $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
+			    $r,$pu,$ps,$pt) if $style =~ /^noc$/;
+    $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
+			    $r,$cu,$cs,$ct) if $style =~ /^nop$/;
+    $s;
+}
+sub timedebug{
+    my($msg, $t) = @_;
+    print STDERR "$msg",timestr($t),"\n" if ($debug);
+}
+
+
+# --- Functions implementing low-level support for timing loops
+
+sub runloop {
+    my($n, $c) = @_;
+
+    $n+=0; # force numeric now, so garbage won't creep into the eval
+    croak "negativ loopcount $n" if $n<0;
+    confess "Usage: runloop(number, string)" unless defined $c;
+    my($t0, $t1, $td); # before, after, difference
+
+    # find package of caller so we can execute code there
+    my ($curpack) = caller(0);
+    my ($i, $pack)= 0;
+    while (($pack) = caller(++$i)) {
+	last if $pack ne $curpack;
+    }
+
+    my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
+    my $subref  = eval $subcode;
+    croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
+    print STDERR "runloop $n '$subcode'\n" if ($debug);
+
+    $t0 = &new;
+    &$subref;
+    $t1 = &new;
+    $td = &timediff($t1, $t0);
+
+    timedebug("runloop:",$td);
+    $td;
+}
+
+
+sub timeit {
+    my($n, $code) = @_;
+    my($wn, $wc, $wd);
+
+    printf STDERR "timeit $n $code\n" if $debug;
+
+    if ($cache && exists $cache{$n}){
+	$wn = $cache{$n};
+    }else{
+	$wn = &runloop($n, '');
+	$cache{$n} = $wn;
+    }
+
+    $wc = &runloop($n, $code);
+
+    $wd = timediff($wc, $wn);
+
+    timedebug("timeit: ",$wc);
+    timedebug("      - ",$wn);
+    timedebug("      = ",$wd);
+
+    $wd;
+}
+
+
+# --- Functions implementing high-level time-then-print utilities
+
+sub timethis{
+    my($n, $code, $title, $style) = @_;
+    my($t) = timeit($n, $code);
+    local($|) = 1;
+    $title = "timethis $n" unless $title;
+    $style = "" unless $style;
+    printf("%10s: ", $title);
+    print timestr($t, $style),"\n";
+    # A conservative warning to spot very silly tests.
+    # Don't assume that your benchmark is ok simply because
+    # you don't get this warning!
+    print "            (warning: too few iterations for a reliable count)\n"
+	if (   $n < $min_count
+	    || ($t->real < 1 && $n < 1000)
+	    || $t->cpu_a < $min_cpu);
+    $t;
+}
+
+
+sub timethese{
+    my($n, $alt, $style) = @_;
+    die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
+		unless ref $alt eq HASH;
+    my(@all);
+    my(@names) = sort keys %$alt;
+    $style = "" unless $style;
+    print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
+    foreach(@names){
+	$t = timethis($n, $alt->{$_}, $_, $style);
+	push(@all, $t);
+    }
+    # we could produce a summary from @all here
+    # sum, min, max, avg etc etc
+    @all;
+}
+
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Carp.pm b/gnu/usr.bin/perl/lib/Carp.pm
new file mode 100644
index 00000000000..f30bd24135c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Carp.pm
@@ -0,0 +1,90 @@
+package Carp;
+
+=head1 NAME
+
+carp - warn of errors (from perspective of caller)
+
+croak - die of errors (from perspective of caller)
+
+confess - die of errors with stack backtrace
+
+=head1 SYNOPSIS
+
+    use Carp;
+    croak "We're outta here!";
+
+=head1 DESCRIPTION
+
+The Carp routines are useful in your own modules because
+they act like die() or warn(), but report where the error
+was in the code they were called from.  Thus if you have a 
+routine Foo() that has a carp() in it, then the carp() 
+will report the error as occurring where Foo() was called, 
+not where carp() was called.
+
+=cut
+
+# This package implements handy routines for modules that wish to throw
+# exceptions outside of the current package.
+
+$CarpLevel = 0;		# How many extra package levels to skip on carp.
+$MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
+
+require Exporter;
+@ISA = Exporter;
+@EXPORT = qw(confess croak carp);
+
+sub longmess {
+    my $error = shift;
+    my $mess = "";
+    my $i = 1 + $CarpLevel;
+    my ($pack,$file,$line,$sub,$eval,$require);
+    while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
+	if ($error =~ m/\n$/) {
+	    $mess .= $error;
+	} else {
+	    if (defined $eval) {
+	        if ($require) {
+		    $sub = "require $eval";
+		} else {
+		    $eval =~ s/[\\\']/\\$&/g;
+		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+			substr($eval,$MaxEvalLen) = '...';
+		    }
+		    $sub = "eval '$eval'";
+		}
+	    } elsif ($sub eq '(eval)') {
+		$sub = 'eval {...}';
+	    }
+	    $mess .= "\t$sub " if $error eq "called";
+	    $mess .= "$error at $file line $line\n";
+	}
+	$error = "called";
+    }
+    $mess || $error;
+}
+
+sub shortmess {	# Short-circuit &longmess if called via multiple packages
+    my $error = $_[0];	# Instead of "shift"
+    my ($curpack) = caller(1);
+    my $extra = $CarpLevel;
+    my $i = 2;
+    my ($pack,$file,$line);
+    while (($pack,$file,$line) = caller($i++)) {
+	if ($pack ne $curpack) {
+	    if ($extra-- > 0) {
+		$curpack = $pack;
+	    }
+	    else {
+		return "$error at $file line $line\n";
+	    }
+	}
+    }
+    goto &longmess;
+}
+
+sub confess { die longmess @_; }
+sub croak { die shortmess @_; }
+sub carp { warn shortmess @_; }
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm
new file mode 100644
index 00000000000..bee2e179aef
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Cwd.pm
@@ -0,0 +1,271 @@
+package Cwd;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+getcwd - get pathname of current working directory
+
+=head1 SYNOPSIS
+
+    use Cwd;
+    $dir = cwd;
+
+    use Cwd;
+    $dir = getcwd;
+
+    use Cwd;
+    $dir = fastgetcwd;
+
+    use Cwd 'chdir';
+    chdir "/tmp";
+    print $ENV{'PWD'};
+
+=head1 DESCRIPTION
+
+The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
+in Perl.
+
+The fastcwd() function looks the same as getcwd(), but runs faster.
+It's also more dangerous because you might conceivably chdir() out of a
+directory that you can't chdir() back into.
+
+The cwd() function looks the same as getcwd and fastgetcwd but is
+implemented using the most natural and safe form for the current
+architecture. For most systems it is identical to `pwd` (but without
+the trailing line terminator). It is recommended that cwd (or another
+*cwd() function) is used in I<all> code to ensure portability.
+
+If you ask to override your chdir() built-in function, then your PWD
+environment variable will be kept up to date.  (See
+L<perlsub/Overriding builtin functions>.) Note that it will only be
+kept up to date it all packages which use chdir import it from Cwd.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir);
+
+# use strict;
+
+sub _backtick_pwd {  # The 'natural and safe form' for UNIX (pwd may be setuid root)
+    my $cwd;
+    chop($cwd = `pwd`);
+    $cwd;
+} 
+
+# Since some ports may predefine cwd internally (e.g., NT)
+# we take care not to override an existing definition for cwd().
+
+*cwd = \&_backtick_pwd unless defined &cwd;
+
+
+# By Brandon S. Allbery
+#
+# Usage: $cwd = getcwd();
+
+sub getcwd
+{
+    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat('.'))
+    {
+	warn "stat(.): $!";
+	return '';
+    }
+    $cwd = '';
+    $dotdots = '';
+    do
+    {
+	$dotdots .= '/' if $dotdots;
+	$dotdots .= '..';
+	@pst = @cst;
+	unless (opendir(PARENT, $dotdots))
+	{
+	    warn "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    warn "stat($dotdots): $!";
+	    closedir(PARENT);
+	    return '';
+	}
+	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+	{
+	    $dir = '';
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(PARENT)))
+	        {
+		    warn "readdir($dotdots): $!";
+		    closedir(PARENT);
+		    return '';
+		}
+		unless (@tst = lstat("$dotdots/$dir"))
+		{
+		    warn "lstat($dotdots/$dir): $!";
+		    # Just because you can't lstat this directory
+		    # doesn't mean you'll never find the right one.
+		    # closedir(PARENT);
+		    # return '';
+		}
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+		   $tst[1] != $pst[1]);
+	}
+	$cwd = "$dir/$cwd";
+	closedir(PARENT);
+    } while ($dir);
+    chop($cwd); # drop the trailing /
+    $cwd;
+}
+
+
+
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# 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 {
+    my($odev, $oino, $cdev, $cino, $tdev, $tino);
+    my(@path, $path);
+    local(*DIR);
+
+    ($cdev, $cino) = stat('.');
+    for (;;) {
+	my $direntry;
+	($odev, $oino) = ($cdev, $cino);
+	chdir('..');
+	($cdev, $cino) = stat('.');
+	last if $odev == $cdev && $oino == $cino;
+	opendir(DIR, '.');
+	for (;;) {
+	    $direntry = readdir(DIR);
+	    next if $direntry eq '.';
+	    next if $direntry eq '..';
+
+	    last unless defined $direntry;
+	    ($tdev, $tino) = lstat($direntry);
+	    last unless $tdev != $odev || $tino != $oino;
+	}
+	closedir(DIR);
+	unshift(@path, $direntry);
+    }
+    chdir($path = '/' . join('/', @path));
+    $path;
+}
+
+
+# Keeps track of current working directory in PWD environment var
+# Usage:
+#	use Cwd 'chdir';
+#	chdir $newdir;
+
+my $chdir_init = 0;
+
+sub chdir_init {
+    if ($ENV{'PWD'} and $^O ne 'os2') {
+	my($dd,$di) = stat('.');
+	my($pd,$pi) = stat($ENV{'PWD'});
+	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
+	    $ENV{'PWD'} = cwd();
+	}
+    }
+    else {
+	$ENV{'PWD'} = cwd();
+    }
+    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
+    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+	my($pd,$pi) = stat($2);
+	my($dd,$di) = stat($1);
+	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
+	    $ENV{'PWD'}="$2$3";
+	}
+    }
+    $chdir_init = 1;
+}
+
+sub chdir {
+    my $newdir = shift || '';	# allow for no arg (chdir to HOME dir)
+    $newdir =~ s|///*|/|g;
+    chdir_init() unless $chdir_init;
+    return 0 unless CORE::chdir $newdir;
+    if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
+
+    if ($newdir =~ m#^/#) {
+	$ENV{'PWD'} = $newdir;
+    } else {
+	my @curdir = split(m#/#,$ENV{'PWD'});
+	@curdir = ('') unless @curdir;
+	my $component;
+	foreach $component (split(m#/#, $newdir)) {
+	    next if $component eq '.';
+	    pop(@curdir),next if $component eq '..';
+	    push(@curdir,$component);
+	}
+	$ENV{'PWD'} = join('/',@curdir) || '/';
+    }
+    1;
+}
+
+
+# --- PORTING SECTION ---
+
+# VMS: $ENV{'DEFAULT'} points to default directory at all times
+# 06-Mar-1996  Charles Bailey  bailey@genetics.upenn.edu
+# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
+#   in the process logical name table as the default device and directory 
+#   seen by Perl. This may not be the same as the default device 
+#   and directory seen by DCL after Perl exits, since the effects
+#   the CRTL chdir() function persist only until Perl exits.
+
+sub _vms_cwd {
+    return $ENV{'DEFAULT'}
+}
+sub _os2_cwd {
+    $ENV{'PWD'} = `cmd /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+my($oldw) = $^W;
+$^W = 0;  # assignments trigger 'subroutine redefined' warning
+if ($^O eq 'VMS') {
+
+    *cwd        = \&_vms_cwd;
+    *getcwd     = \&_vms_cwd;
+    *fastcwd    = \&_vms_cwd;
+    *fastgetcwd = \&_vms_cwd;
+}
+elsif ($^O eq 'NT') {
+
+    *getcwd     = \&cwd;
+    *fastgetcwd = \&cwd;
+}
+elsif ($^O eq 'os2') {
+    *cwd     = \&_os2_cwd;
+    *getcwd     = \&_os2_cwd;
+    *fastgetcwd = \&_os2_cwd;
+    *fastcwd = \&_os2_cwd;
+}
+$^W = $oldw;
+
+# package main; eval join('',<DATA>) || die $@;	# quick test
+
+1;
+
+__END__
+BEGIN { import Cwd qw(:DEFAULT chdir); }
+print join("\n", cwd, getcwd, fastcwd, "");
+chdir('..');
+print join("\n", cwd, getcwd, fastcwd, "");
+print "$ENV{PWD}\n";
diff --git a/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm b/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm
new file mode 100644
index 00000000000..fc7ee4b5110
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm
@@ -0,0 +1,139 @@
+package Devel::SelfStubber;
+require SelfLoader;
+@ISA = qw(SelfLoader);
+@EXPORT = 'AUTOLOAD';
+$JUST_STUBS = 1;
+$VERSION = 1.01; sub Version {$VERSION}
+
+# Use as
+# perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)'
+# (LIB defaults to '.') e.g.
+# perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub('Math::BigInt')'
+# would print out stubs needed if you added a __DATA__ before the subs.
+# Setting $Devel::SelfStubber::JUST_STUBS to 0 will print out the whole
+# module with the stubs entered just before the __DATA__
+
+sub _add_to_cache {
+    my($self,$fullname,$pack,$lines, $prototype) = @_;
+    push(@DATA,@{$lines});
+    if($fullname){push(@STUBS,"sub $fullname $prototype;\n")}; # stubs
+    '1;';
+}
+
+sub _package_defined {
+    my($self,$line) = @_;
+    push(@DATA,$line);
+}
+
+sub stub {
+    my($self,$module,$lib) = @_;
+    my($line,$end,$fh,$mod_file,$found_selfloader);
+    $lib ||= '.';
+    ($mod_file = $module) =~ s,::,/,g;
+    
+    $mod_file = "$lib/$mod_file.pm";
+    $fh = "${module}::DATA";
+
+    open($fh,$mod_file) || die "Unable to open $mod_file";
+    while($line = <$fh> and $line !~ m/^__DATA__/) {
+	push(@BEFORE_DATA,$line);
+	$line =~ /use\s+SelfLoader/ && $found_selfloader++;
+    }
+    $line =~ m/^__DATA__/ || die "$mod_file doesn't contain a __DATA__ token";
+    $found_selfloader || 
+	print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n";
+    $self->_load_stubs($module);
+    if ( fileno($fh) ) {
+	$end = 1;
+	while($line = <$fh>) {
+	    push(@AFTER_DATA,$line);
+	}
+    }
+    unless ($JUST_STUBS) {
+    	print @BEFORE_DATA;
+    }
+    print @STUBS;
+    unless ($JUST_STUBS) {
+    	print "1;\n__DATA__\n",@DATA;
+    	if($end) { print "__END__\n",@AFTER_DATA; }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Devel::SelfStubber - generate stubs for a SelfLoading module
+
+=head1 SYNOPSIS
+
+To generate just the stubs:
+
+    use Devel::SelfStubber;
+    Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
+
+or to generate the whole module with stubs inserted correctly
+
+    use Devel::SelfStubber;
+    $Devel::SelfStubber::JUST_STUBS=0;
+    Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
+
+MODULENAME is the Perl module name, e.g. Devel::SelfStubber,
+NOT 'Devel/SelfStubber' or 'Devel/SelfStubber.pm'.
+
+MY_LIB_DIR defaults to '.' if not present.
+
+=head1 DESCRIPTION
+
+Devel::SelfStubber prints the stubs you need to put in the module
+before the __DATA__ token (or you can get it to print the entire
+module with stubs correctly placed). The stubs ensure that if
+a method is called, it will get loaded. They are needed specifically
+for inherited autoloaded methods.
+
+This is best explained using the following example:
+
+Assume four classes, A,B,C & D.
+
+A is the root class, B is a subclass of A, C is a subclass of B,
+and D is another subclass of A.
+
+                        A
+                       / \
+                      B   D
+                     /
+                    C
+
+If D calls an autoloaded method 'foo' which is defined in class A,
+then the method is loaded into class A, then executed. If C then
+calls method 'foo', and that method was reimplemented in class
+B, but set to be autoloaded, then the lookup mechanism never gets to
+the AUTOLOAD mechanism in B because it first finds the method
+already loaded in A, and so erroneously uses that. If the method
+foo had been stubbed in B, then the lookup mechanism would have
+found the stub, and correctly loaded and used the sub from B.
+
+So, for classes and subclasses to have inheritance correctly
+work with autoloading, you need to ensure stubs are loaded.
+
+The SelfLoader can load stubs automatically at module initialization
+with the statement 'SelfLoader->load_stubs()';, but you may wish to
+avoid having the stub loading overhead associated with your
+initialization (though note that the SelfLoader::load_stubs method
+will be called sooner or later - at latest when the first sub
+is being autoloaded). In this case, you can put the sub stubs
+before the __DATA__ token. This can be done manually, but this
+module allows automatic generation of the stubs.
+
+By default it just prints the stubs, but you can set the
+global $Devel::SelfStubber::JUST_STUBS to 0 and it will
+print out the entire module with the stubs positioned correctly.
+
+At the very least, this is useful to see what the SelfLoader
+thinks are stubs - in order to ensure future versions of the
+SelfStubber remain in step with the SelfLoader, the
+SelfStubber actually uses the SelfLoader to determine which
+stubs are needed.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/DirHandle.pm b/gnu/usr.bin/perl/lib/DirHandle.pm
new file mode 100644
index 00000000000..047755dc17d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/DirHandle.pm
@@ -0,0 +1,72 @@
+package DirHandle;
+
+=head1 NAME 
+
+DirHandle - supply object methods for directory handles
+
+=head1 SYNOPSIS
+
+    use DirHandle;
+    $d = new DirHandle ".";
+    if (defined $d) {
+        while (defined($_ = $d->read)) { something($_); }
+        $d->rewind;
+        while (defined($_ = $d->read)) { something_else($_); }
+        undef $d;
+    }
+
+=head1 DESCRIPTION
+
+The C<DirHandle> method provide an alternative interface to the
+opendir(), closedir(), readdir(), and rewinddir() functions.
+
+The only objective benefit to using C<DirHandle> is that it avoids
+namespace pollution by creating globs to hold directory handles.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new DirHandle [DIRNAME]';
+    my $class = shift;
+    my $dh = gensym;
+    if (@_) {
+	DirHandle::open($dh, $_[0])
+	    or return undef;
+    }
+    bless $dh, $class;
+}
+
+sub DESTROY {
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub open {
+    @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
+    my ($dh, $dirname) = @_;
+    opendir($dh, $dirname);
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $dh->close()';
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub read {
+    @_ == 1 or croak 'usage: $dh->read()';
+    my ($dh) = @_;
+    readdir($dh);
+}
+
+sub rewind {
+    @_ == 1 or croak 'usage: $dh->rewind()';
+    my ($dh) = @_;
+    rewinddir($dh);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/English.pm b/gnu/usr.bin/perl/lib/English.pm
new file mode 100644
index 00000000000..ce4520a8911
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/English.pm
@@ -0,0 +1,178 @@
+package English;
+
+require Exporter;
+@ISA = (Exporter);
+
+=head1 NAME
+
+English - use nice English (or awk) names for ugly punctuation variables
+
+=head1 SYNOPSIS
+
+    use English;
+    ...
+    if ($ERRNO =~ /denied/) { ... }
+
+=head1 DESCRIPTION
+
+This module provides aliases for the built-in variables whose
+names no one seems to like to read.  Variables with side-effects
+which get triggered just by accessing them (like $0) will still 
+be affected.
+
+For those variables that have an B<awk> version, both long
+and short English alternatives are provided.  For example, 
+the C<$/> variable can be referred to either $RS or 
+$INPUT_RECORD_SEPARATOR if you are using the English module.
+
+See L<perlvar> for a complete list of these.
+
+=cut
+
+local $^W = 0;
+
+# Grandfather $NAME import
+sub import {
+    my $this = shift;
+    my @list = @_;
+    local $Exporter::ExportLevel = 1;
+    Exporter::import($this,grep {s/^\$/*/} @list);
+}
+
+@EXPORT = qw(
+	*ARG
+	*MATCH
+	*PREMATCH
+	*POSTMATCH
+	*LAST_PAREN_MATCH
+	*INPUT_LINE_NUMBER
+	*NR
+	*INPUT_RECORD_SEPARATOR
+	*RS
+	*OUTPUT_AUTOFLUSH
+	*OUTPUT_FIELD_SEPARATOR
+	*OFS
+	*OUTPUT_RECORD_SEPARATOR
+	*ORS
+	*LIST_SEPARATOR
+	*SUBSCRIPT_SEPARATOR
+	*SUBSEP
+	*FORMAT_PAGE_NUMBER
+	*FORMAT_LINES_PER_PAGE
+	*FORMAT_LINES_LEFT
+	*FORMAT_NAME
+	*FORMAT_TOP_NAME
+	*FORMAT_LINE_BREAK_CHARACTERS
+	*FORMAT_FORMFEED
+	*CHILD_ERROR
+	*OS_ERROR
+	*ERRNO
+	*EXTENDED_OS_ERROR
+	*EVAL_ERROR
+	*PROCESS_ID
+	*PID
+	*REAL_USER_ID
+	*UID
+	*EFFECTIVE_USER_ID
+	*EUID
+	*REAL_GROUP_ID
+	*GID
+	*EFFECTIVE_GROUP_ID
+	*EGID
+	*PROGRAM_NAME
+	*PERL_VERSION
+	*ACCUMULATOR
+	*DEBUGGING
+	*SYSTEM_FD_MAX
+	*INPLACE_EDIT
+	*PERLDB
+	*BASETIME
+	*WARNING
+	*EXECUTABLE_NAME
+	*OSNAME
+);
+
+# The ground of all being.
+
+	*ARG					= *_	;
+
+# Matching.
+
+	*MATCH					= *&	;
+	*PREMATCH				= *`	;
+	*POSTMATCH				= *'	;
+	*LAST_PAREN_MATCH			= *+	;
+
+# Input.
+
+	*INPUT_LINE_NUMBER			= *.	;
+	    *NR					= *.	;
+	*INPUT_RECORD_SEPARATOR			= */	;
+	    *RS					= */	;
+
+# Output.
+
+	*OUTPUT_AUTOFLUSH			= *|	;
+	*OUTPUT_FIELD_SEPARATOR			= *,	;
+	    *OFS				= *,	;
+	*OUTPUT_RECORD_SEPARATOR		= *\	;
+	    *ORS				= *\	;
+
+# Interpolation "constants".
+
+	*LIST_SEPARATOR				= *"	;
+	*SUBSCRIPT_SEPARATOR			= *;	;
+	    *SUBSEP				= *;	;
+
+# Formats
+
+	*FORMAT_PAGE_NUMBER			= *%	;
+	*FORMAT_LINES_PER_PAGE			= *=	;
+	*FORMAT_LINES_LEFT			= *-	;
+	*FORMAT_NAME				= *~	;
+	*FORMAT_TOP_NAME			= *^	;
+	*FORMAT_LINE_BREAK_CHARACTERS		= *:	;
+	*FORMAT_FORMFEED			= *^L	;
+
+# Error status.
+
+	*CHILD_ERROR				= *?	;
+	*OS_ERROR				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
+	    *ERRNO				= *!	;
+	*EVAL_ERROR				= *@	;
+
+# Process info.
+
+	*PROCESS_ID				= *$	;
+	    *PID				= *$	;
+	*REAL_USER_ID				= *<	;
+	    *UID				= *<	;
+	*EFFECTIVE_USER_ID			= *>	;
+	    *EUID				= *>	;
+	*REAL_GROUP_ID				= *(	;
+	    *GID				= *(	;
+	*EFFECTIVE_GROUP_ID			= *)	;
+	    *EGID				= *)	;
+	*PROGRAM_NAME				= *0	;
+
+# Internals.
+
+	*PERL_VERSION				= *]	;
+	*ACCUMULATOR				= *^A	;
+	*DEBUGGING				= *^D	;
+	*SYSTEM_FD_MAX				= *^F	;
+	*INPLACE_EDIT				= *^I	;
+	*PERLDB					= *^P	;
+	*BASETIME				= *^T	;
+	*WARNING				= *^W	;
+	*EXECUTABLE_NAME			= *^X	;
+	*OSNAME					= *^O	;
+
+# Deprecated.
+
+#	*ARRAY_BASE				= *[	;
+#	*OFMT					= *#	;
+#	*MULTILINE_MATCHING			= **	;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Env.pm b/gnu/usr.bin/perl/lib/Env.pm
new file mode 100644
index 00000000000..0e790754a82
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Env.pm
@@ -0,0 +1,74 @@
+package Env;
+
+=head1 NAME
+
+Env - perl module that imports environment variables
+
+=head1 SYNOPSIS
+
+    use Env;
+    use Env qw(PATH HOME TERM);
+
+=head1 DESCRIPTION
+
+Perl maintains environment variables in a pseudo-associative-array
+named %ENV.  For when this access method is inconvenient, the Perl
+module C<Env> allows environment variables to be treated as simple
+variables.
+
+The Env::import() function ties environment variables with suitable
+names to global Perl variables with the same names.  By default it
+does so with all existing environment variables (C<keys %ENV>).  If
+the import function receives arguments, it takes them to be a list of
+environment variables to tie; it's okay if they don't yet exist.
+
+After an environment variable is tied, merely use it like a normal variable.
+You may access its value 
+
+    @path = split(/:/, $PATH);
+
+or modify it
+
+    $PATH .= ":.";
+
+however you'd like.
+To remove a tied environment variable from
+the environment, assign it the undefined value
+
+    undef $PATH;
+
+=head1 AUTHOR
+
+Chip Salzenberg <chip@fin.uucp>
+
+=cut
+
+sub import {
+    my ($callpack) = caller(0);
+    my $pack = shift;
+    my @vars = @_ ? @_ : keys(%ENV);
+
+    foreach (@vars) {
+	tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/;
+    }
+}
+
+sub TIESCALAR {
+    bless \($_[1]);
+}
+
+sub FETCH {
+    my ($self) = @_;
+    $ENV{$$self};
+}
+
+sub STORE {
+    my ($self, $value) = @_;
+    if (defined($value)) {
+	$ENV{$$self} = $value;
+    } else {
+	delete $ENV{$$self};
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Exporter.pm b/gnu/usr.bin/perl/lib/Exporter.pm
new file mode 100644
index 00000000000..343b9fbd174
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Exporter.pm
@@ -0,0 +1,377 @@
+package Exporter;
+
+require 5.001;
+
+$ExportLevel = 0;
+$Verbose = 0 unless $Verbose;
+
+require Carp;
+
+sub export {
+
+    # First make import warnings look like they're coming from the "use".
+    local $SIG{__WARN__} = sub {
+	my $text = shift;
+	$text =~ s/ at \S*Exporter.pm line \d+.*\n//;
+	local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	Carp::carp($text);
+    };
+    local $SIG{__DIE__} = sub {
+	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
+	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
+    };
+
+    my($pkg, $callpkg, @imports) = @_;
+    my($type, $sym, $oops);
+    *exports = *{"${pkg}::EXPORT"};
+
+    if (@imports) {
+	if (!%exports) {
+	    grep(s/^&//, @exports);
+	    @exports{@exports} = (1) x @exports;
+	    my $ok = \@{"${pkg}::EXPORT_OK"};
+	    if (@$ok) {
+		grep(s/^&//, @$ok);
+		@exports{@$ok} = (1) x @$ok;
+	    }
+	}
+
+	if ($imports[0] =~ m#^[/!:]#){
+	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
+	    my $tagdata;
+	    my %imports;
+	    my($remove, $spec, @names, @allexports);
+	    # negated first item implies starting with default set:
+	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
+	    foreach $spec (@imports){
+		$remove = $spec =~ s/^!//;
+
+		if ($spec =~ s/^://){
+		    if ($spec eq 'DEFAULT'){
+			@names = @exports;
+		    }
+		    elsif ($tagdata = $tagsref->{$spec}) {
+			@names = @$tagdata;
+		    }
+		    else {
+			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
+			++$oops;
+			next;
+		    }
+		}
+		elsif ($spec =~ m:^/(.*)/$:){
+		    my $patn = $1;
+		    @allexports = keys %exports unless @allexports; # only do keys once
+		    @names = grep(/$patn/, @allexports); # not anchored by default
+		}
+		else {
+		    @names = ($spec); # is a normal symbol name
+		}
+
+		warn "Import ".($remove ? "del":"add").": @names "
+		    if $Verbose;
+
+		if ($remove) {
+		   foreach $sym (@names) { delete $imports{$sym} } 
+		}
+		else {
+		    @imports{@names} = (1) x @names;
+		}
+	    }
+	    @imports = keys %imports;
+	}
+
+	foreach $sym (@imports) {
+	    if (!$exports{$sym}) {
+		if ($sym =~ m/^\d/) {
+		    $pkg->require_version($sym);
+		    # If the version number was the only thing specified
+		    # then we should act as if nothing was specified:
+		    if (@imports == 1) {
+			@imports = @exports;
+			last;
+		    }
+		} elsif ($sym !~ s/^&// || !$exports{$sym}) {
+		    warn qq["$sym" is not exported by the $pkg module];
+		    $oops++;
+		}
+	    }
+	}
+	Carp::croak("Can't continue after import errors") if $oops;
+    }
+    else {
+	@imports = @exports;
+    }
+
+    *fail = *{"${pkg}::EXPORT_FAIL"};
+    if (@fail) {
+	if (!%fail) {
+	    # Build cache of symbols. Optimise the lookup by adding
+	    # barewords twice... both with and without a leading &.
+	    # (Technique could be applied to %exports cache at cost of memory)
+	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
+	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
+	    @fail{@expanded} = (1) x @expanded;
+	}
+	my @failed;
+	foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+	if (@failed) {
+	    @failed = $pkg->export_fail(@failed);
+	    foreach $sym (@failed) {
+		warn qq["$sym" is not implemented by the $pkg module ],
+			"on this architecture";
+	    }
+	    Carp::croak("Can't continue after import errors") if @failed;
+	}
+    }
+
+    warn "Importing into $callpkg from $pkg: ",
+		join(", ",sort @imports) if $Verbose;
+
+    foreach $sym (@imports) {
+	# shortcut for the common case of no type character
+	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
+	    unless $sym =~ s/^(\W)//;
+	$type = $1;
+	*{"${callpkg}::$sym"} =
+	    $type eq '&' ? \&{"${pkg}::$sym"} :
+	    $type eq '$' ? \${"${pkg}::$sym"} :
+	    $type eq '@' ? \@{"${pkg}::$sym"} :
+	    $type eq '%' ? \%{"${pkg}::$sym"} :
+	    $type eq '*' ?  *{"${pkg}::$sym"} :
+		Carp::croak("Can't export symbol: $type$sym");
+    }
+}
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller($ExportLevel);
+    export $pkg, $callpkg, @_;
+}
+
+
+# Utility functions
+
+sub _push_tags {
+    my($pkg, $var, $syms) = @_;
+    my $nontag;
+    *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+    push(@{"${pkg}::$var"},
+	map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
+		(@$syms) ? @$syms : keys %export_tags);
+    # This may change to a die one day
+    Carp::carp("Some names are not tags") if $nontag and $^W;
+}
+
+sub export_tags    { _push_tags((caller)[0], "EXPORT",    \@_) }
+sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
+
+
+# Default methods
+
+sub export_fail {
+    @_;
+}
+
+sub require_version {
+    my($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = ${"${pkg}::VERSION"} || "(undef)";
+    Carp::croak("$pkg $wanted required--this is only version $version")
+		if $version < $wanted;
+    $version;
+}
+
+1;
+
+# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
+# package main; eval(join('',<DATA>)) or die $@ unless caller;
+__END__
+package Test;
+$INC{'Exporter.pm'} = 1;
+@ISA = qw(Exporter);
+@EXPORT      = qw(A1 A2 A3 A4 A5);
+@EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
+@EXPORT_FAIL = qw(B4);
+Exporter::export_ok_tags('T3', 'unknown_tag');
+sub export_fail {
+    map { "Test::$_" } @_	# edit symbols just as an example
+}
+
+package main;
+$Exporter::Verbose = 1;
+#import Test;
+#import Test qw(X3);		# export ok via export_ok_tags()
+#import Test qw(:T1 !A2 /5/ !/3/ B5);
+import Test qw(:T2 !B4);
+import Test qw(:T2);		# should fail
+1;
+
+=head1 NAME
+
+Exporter - Implements default import method for modules
+
+=head1 SYNOPSIS
+
+In module ModuleName.pm:
+
+  package ModuleName;
+  require Exporter;
+  @ISA = qw(Exporter);
+
+  @EXPORT = qw(...);            # symbols to export by default
+  @EXPORT_OK = qw(...);         # symbols to export on request
+  %EXPORT_TAGS = tag => [...];  # define names for sets of symbols
+
+In other files which wish to use ModuleName:
+
+  use ModuleName;               # import default symbols into my package
+
+  use ModuleName qw(...);       # import listed symbols into my package
+
+  use ModuleName ();            # do not import any symbols
+
+=head1 DESCRIPTION
+
+The Exporter module implements a default C<import> method which
+many modules choose inherit rather than implement their own.
+
+Perl automatically calls the C<import> method when processing a
+C<use> statement for a module. Modules and C<use> are documented
+in L<perlfunc> and L<perlmod>. Understanding the concept of
+modules and how the C<use> statement operates is important to
+understanding the Exporter.
+
+=head2 Selecting What To Export
+
+Do B<not> export method names!
+
+Do B<not> export anything else by default without a good reason!
+
+Exports pollute the namespace of the module user.  If you must export
+try to use @EXPORT_OK in preference to @EXPORT and avoid short or
+common symbol names to reduce the risk of name clashes.
+
+Generally anything not exported is still accessible from outside the
+module using the ModuleName::item_name (or $blessed_ref->method)
+syntax.  By convention you can use a leading underscore on names to
+informally indicate that they are 'internal' and not for public use.
+
+(It is actually possible to get private functions by saying:
+
+  my $subref = sub { ... };
+  &$subref;
+
+But there's no way to call that directly as a method, since a method
+must have a name in the symbol table.)
+
+As a general rule, if the module is trying to be object oriented
+then export nothing. If it's just a collection of functions then
+@EXPORT_OK anything but use @EXPORT with caution.
+
+Other module design guidelines can be found in L<perlmod>.
+
+=head2 Specialised Import Lists
+
+If the first entry in an import list begins with !, : or / then the
+list is treated as a series of specifications which either add to or
+delete from the list of names to import. They are processed left to
+right. Specifications are in the form:
+
+    [!]name         This name only
+    [!]:DEFAULT     All names in @EXPORT
+    [!]:tag         All names in $EXPORT_TAGS{tag} anonymous list
+    [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
+
+A leading ! indicates that matching names should be deleted from the
+list of names to import.  If the first specification is a deletion it
+is treated as though preceded by :DEFAULT. If you just want to import
+extra names in addition to the default set you will still need to
+include :DEFAULT explicitly.
+
+e.g., Module.pm defines:
+
+    @EXPORT      = qw(A1 A2 A3 A4 A5);
+    @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+    %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
+
+    Note that you cannot use tags in @EXPORT or @EXPORT_OK.
+    Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
+
+An application using Module can say something like:
+
+    use Module qw(:DEFAULT :T2 !B3 A3);
+
+Other examples include:
+
+    use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
+    use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
+
+Remember that most patterns (using //) will need to be anchored
+with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
+
+You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
+specifications are being processed and what is actually being imported
+into modules.
+
+=head2 Module Version Checking
+
+The Exporter module will convert an attempt to import a number from a
+module into a call to $module_name->require_version($value). This can
+be used to validate that the version of the module being used is
+greater than or equal to the required version.
+
+The Exporter module supplies a default require_version method which
+checks the value of $VERSION in the exporting module.
+
+Since the default require_version method treats the $VERSION number as
+a simple numeric value it will regard version 1.10 as lower than
+1.9. For this reason it is strongly recommended that you use numbers
+with at least two decimal places, e.g., 1.09.
+
+=head2 Managing Unknown Symbols
+
+In some situations you may want to prevent certain symbols from being
+exported. Typically this applies to extensions which have functions
+or constants that may not exist on some systems.
+
+The names of any symbols that cannot be exported should be listed
+in the C<@EXPORT_FAIL> array.
+
+If a module attempts to import any of these symbols the Exporter will
+will give the module an opportunity to handle the situation before
+generating an error. The Exporter will call an export_fail method
+with a list of the failed symbols:
+
+  @failed_symbols = $module_name->export_fail(@failed_symbols);
+
+If the export_fail method returns an empty list then no error is
+recorded and all the requested symbols are exported. If the returned
+list is not empty then an error is generated for each symbol and the
+export fails. The Exporter provides a default export_fail method which
+simply returns the list unchanged.
+
+Uses for the export_fail method include giving better error messages
+for some symbols and performing lazy architectural checks (put more
+symbols into @EXPORT_FAIL by default and then take them out if someone
+actually tries to use them and an expensive check shows that they are
+usable on that platform).
+
+=head2 Tag Handling Utility Functions
+
+Since the symbols listed within %EXPORT_TAGS must also appear in either
+@EXPORT or @EXPORT_OK, two utility functions are provided which allow
+you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
+
+  %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
+
+  Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
+  Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
+
+Any names which are not tags are added to @EXPORT or @EXPORT_OK
+unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
+names being silently added to @EXPORT or @EXPORT_OK. Future versions
+may make this a fatal error.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
new file mode 100644
index 00000000000..441448eeade
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
@@ -0,0 +1,337 @@
+package ExtUtils::Install;
+
+$VERSION = substr q$Revision: 1.1 $, 10;
+# $Id: Install.pm,v 1.1 1996/08/19 10:12:39 downsj Exp $
+
+use Exporter;
+use Carp ();
+use Config ();
+use vars qw(@ISA @EXPORT $VERSION);
+@ISA = ('Exporter');
+@EXPORT = ('install','uninstall','pm_to_blib');
+$Is_VMS = $^O eq 'VMS';
+
+my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
+my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'};
+my $Inc_uninstall_warn_handler;
+
+#use vars qw( @EXPORT @ISA $Is_VMS );
+#use strict;
+
+sub forceunlink {
+    chmod 0666, $_[0];
+    unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
+}
+
+sub install {
+    my($hash,$verbose,$nonono,$inc_uninstall) = @_;
+    $verbose ||= 0;
+    $nonono  ||= 0;
+
+    use Cwd qw(cwd);
+    use ExtUtils::MakeMaker; # to implement a MY class
+    use File::Basename qw(dirname);
+    use File::Copy qw(copy);
+    use File::Find qw(find);
+    use File::Path qw(mkpath);
+    # The following lines were needed with AutoLoader (left for the record)
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install my_cmp.al));
+    # require $my_req;
+    # $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+    # time use we are in a different directory when autoload happens, so
+    # the relativ path to ./blib is ill.
+
+    my(%hash) = %$hash;
+    my(%pack, %write, $dir);
+    local(*DIR, *P);
+    for (qw/read write/) {
+	$pack{$_}=$hash{$_};
+	delete $hash{$_};
+    }
+    my($source_dir_or_file);
+    foreach $source_dir_or_file (sort keys %hash) {
+	#Check if there are files, and if yes, look if the corresponding
+	#target directory is writable for us
+	opendir DIR, $source_dir_or_file or next;
+	for (readdir DIR) {
+	    next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
+	    if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
+		last;
+	    } else {
+		Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
+	    }
+	}
+	closedir DIR;
+    }
+    if (-f $pack{"read"}) {
+	open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
+	# Remember what you found
+	while (<P>) {
+	    chomp;
+	    $write{$_}++;
+	}
+	close P;
+    }
+    my $cwd = cwd();
+    my $umask = umask 0 unless $Is_VMS;
+
+    # This silly reference is just here to be able to call MY->catdir
+    # without a warning (Waiting for a proper path/directory module,
+    # Charles!)
+    my $MY = {};
+    bless $MY, 'MY';
+    my($source);
+    MOD_INSTALL: foreach $source (sort keys %hash) {
+	#copy the tree to the target directory without altering
+	#timestamp and permission and remember for the .packlist
+	#file. The packlist file contains the absolute paths of the
+	#install locations. AFS users may call this a bug. We'll have
+	#to reconsider how to add the means to satisfy AFS users also.
+	chdir($source) or next;
+	find(sub {
+	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+                         $atime,$mtime,$ctime,$blksize,$blocks) = stat;
+	    return unless -f _;
+	    return if $_ eq ".exists";
+	    my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
+	    my $targetfile = $MY->catfile($targetdir,$_);
+
+	    my $diff = 0;
+	    if ( -f $targetfile && -s _ == $size) {
+		# We have a good chance, we can skip this one
+		$diff = my_cmp($_,$targetfile);
+	    } else {
+		print "$_ differs\n" if $verbose>1;
+		$diff++;
+	    }
+
+	    if ($diff){
+		if (-f $targetfile){
+		    forceunlink($targetfile) unless $nonono;
+		} else {
+		    mkpath($targetdir,0,0755) unless $nonono;
+		    print "mkpath($targetdir,0,0755)\n" if $verbose>1;
+		}
+		copy($_,$targetfile) unless $nonono;
+		print "Installing $targetfile\n";
+		utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
+		print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
+		$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+		chmod $mode, $targetfile;
+		print "chmod($mode, $targetfile)\n" if $verbose>1;
+	    } else {
+		print "Skipping $targetfile (unchanged)\n" if $verbose;
+	    }
+	    
+	    if (! defined $inc_uninstall) { # it's called 
+	    } elsif ($inc_uninstall == 0){
+		inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
+	    } else {
+		inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
+	    }
+	    $write{$targetfile}++;
+
+	}, ".");
+	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
+    }
+    umask $umask unless $Is_VMS;
+    if ($pack{'write'}) {
+	$dir = dirname($pack{'write'});
+	mkpath($dir,0,0755);
+	print "Writing $pack{'write'}\n";
+	open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
+	for (sort keys %write) {
+	    print P "$_\n";
+	}
+	close P;
+    }
+}
+
+sub my_cmp {
+    my($one,$two) = @_;
+    local(*F,*T);
+    my $diff = 0;
+    open T, $two or return 1;
+    open F, $one or Carp::croak("Couldn't open $one: $!");
+    my($fr, $tr, $fbuf, $tbuf, $size);
+    $size = 1024;
+    # print "Reading $one\n";
+    while ( $fr = read(F,$fbuf,$size)) {
+	unless (
+		$tr = read(T,$tbuf,$size) and 
+		$tbuf eq $fbuf
+	       ){
+	    # print "diff ";
+	    $diff++;
+	    last;
+	}
+	# print "$fr/$tr ";
+    }
+    # print "\n";
+    close F;
+    close T;
+    $diff;
+}
+
+sub uninstall {
+    my($fil,$verbose,$nonono) = @_;
+    die "no packlist file found: $fil" unless -f $fil;
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+    local *P;
+    open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
+    while (<P>) {
+	chomp;
+	print "unlink $_\n" if $verbose;
+	forceunlink($_) unless $nonono;
+    }
+    print "unlink $fil\n" if $verbose;
+    forceunlink($fil) unless $nonono;
+}
+
+sub inc_uninstall {
+    my($file,$libdir,$verbose,$nonono) = @_;
+    my($dir);
+    my $MY = {};
+    bless $MY, 'MY';
+    my %seen_dir = ();
+    foreach $dir (@INC, @PERL_ENV_LIB, @Config::Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
+	next if $dir eq ".";
+	next if $seen_dir{$dir}++;
+	my($targetfile) = $MY->catfile($dir,$libdir,$file);
+	next unless -f $targetfile;
+
+	# The reason why we compare file's contents is, that we cannot
+	# know, which is the file we just installed (AFS). So we leave
+	# an identical file in place
+	my $diff = 0;
+	if ( -f $targetfile && -s _ == -s $file) {
+	    # We have a good chance, we can skip this one
+	    $diff = my_cmp($file,$targetfile);
+	} else {
+	    print "#$file and $targetfile differ\n" if $verbose>1;
+	    $diff++;
+	}
+
+	next unless $diff;
+	if ($nonono) {
+	    if ($verbose) {
+		$Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
+		$libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
+		$Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
+	    }
+	    # if not verbose, we just say nothing
+	} else {
+	    print "Unlinking $targetfile (shadowing?)\n";
+	    forceunlink($targetfile);
+	}
+    }
+}
+
+sub pm_to_blib {
+    my($fromto,$autodir) = @_;
+
+    use File::Basename qw(dirname);
+    use File::Copy qw(copy);
+    use File::Path qw(mkpath);
+    use AutoSplit;
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+
+    my $umask = umask 0022 unless $Is_VMS;
+    mkpath($autodir,0,0755);
+    foreach (keys %$fromto) {
+	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
+	unless (my_cmp($_,$fromto->{$_})){
+	    print "Skip $fromto->{$_} (unchanged)\n";
+	    next;
+	}
+	if (-f $fromto->{$_}){
+	    forceunlink($fromto->{$_});
+	} else {
+	    mkpath(dirname($fromto->{$_}),0,0755);
+	}
+	copy($_,$fromto->{$_});
+	chmod(0444 | ( (stat)[2] & 0111 ? 0111 : 0 ),$fromto->{$_});
+	print "cp $_ $fromto->{$_}\n";
+	next unless /\.pm$/;
+	autosplit($fromto->{$_},$autodir);
+    }
+    umask $umask unless $Is_VMS;
+}
+
+package ExtUtils::Install::Warn;
+
+sub new { bless {}, shift }
+
+sub add {
+    my($self,$file,$targetfile) = @_;
+    push @{$self->{$file}}, $targetfile;
+}
+
+sub DESTROY {
+    my $self = shift;
+    my($file,$i,$plural);
+    foreach $file (sort keys %$self) {
+	$plural = @{$self->{$file}} > 1 ? "s" : "";
+	print "## Differing version$plural of $file found. You might like to\n";
+	for (0..$#{$self->{$file}}) {
+	    print "rm ", $self->{$file}[$_], "\n";
+	    $i++;
+	}
+    }
+    $plural = $i>1 ? "all those files" : "this file";
+    print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Install - install files from here to there
+
+=head1 SYNOPSIS
+
+B<use ExtUtils::Install;>
+
+B<install($hashref,$verbose,$nonono);>
+
+B<uninstall($packlistfile,$verbose,$nonono);>
+
+B<pm_to_blib($hashref);>
+
+=head1 DESCRIPTION
+
+Both install() and uninstall() are specific to the way
+ExtUtils::MakeMaker handles the installation and deinstallation of
+perl modules. They are not designed as general purpose tools.
+
+install() takes three arguments. A reference to a hash, a verbose
+switch and a don't-really-do-it switch. The hash ref contains a
+mapping of directories: each key/value pair is a combination of
+directories to be copied. Key is a directory to copy from, value is a
+directory to copy to. The whole tree below the "from" directory will
+be copied preserving timestamps and permissions.
+
+There are two keys with a special meaning in the hash: "read" and
+"write". After the copying is done, install will write the list of
+target files to the file named by $hashref->{write}. If there is
+another file named by $hashref->{read}, the contents of this file will
+be merged into the written file. The read and the written file may be
+identical, but on AFS it is quite likely, people are installing to a
+different directory than the one where the files later appear.
+
+uninstall() takes as first argument a file containing filenames to be
+unlinked. The second argument is a verbose switch, the third is a
+no-don't-really-do-it-now switch.
+
+pm_to_blib() takes a hashref as the first argument and copies all keys
+of the hash to the corresponding values efficiently. Filenames with
+the extension pm are autosplit. Second argument is the autosplit
+directory.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
new file mode 100644
index 00000000000..b67f86bbce0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
@@ -0,0 +1,254 @@
+package ExtUtils::Liblist;
+
+# Broken out of MakeMaker from version 4.11
+
+$ExtUtils::Liblist::VERSION = substr q$Revision: 1.1 $, 10;
+
+use Config;
+use Cwd 'cwd';
+use File::Basename;
+
+my $Config_libext = $Config{lib_ext} || ".a";
+
+sub ext {
+    my($self,$potential_libs, $Verbose) = @_;
+    if ($^O =~ 'os2' and $Config{libs}) { 
+	# Dynamic libraries are not transitive, so we may need including
+	# the libraries linked against perl.dll again.
+
+	$potential_libs .= " " if $potential_libs;
+	$potential_libs .= $Config{libs};
+    }
+    return ("", "", "", "") unless $potential_libs;
+    print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose;
+
+    my($so)   = $Config{'so'};
+    my($libs) = $Config{'libs'};
+
+    # compute $extralibs, $bsloadlibs and $ldloadlibs from
+    # $potential_libs
+    # this is a rewrite of Andy Dougherty's extliblist in perl
+    # its home is in <distribution>/ext/util
+
+    my(@searchpath); # from "-L/path" entries in $potential_libs
+    my(@libpath) = split " ", $Config{'libpth'};
+    my(@ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen);
+    my($fullname, $thislib, $thispth, @fullname);
+    my($pwd) = cwd(); # from Cwd.pm
+    my($found) = 0;
+
+    foreach $thislib (split ' ', $potential_libs){
+
+	# Handle possible linker path arguments.
+	if ($thislib =~ s/^(-[LR])//){	# save path flag type
+	    my($ptype) = $1;
+	    unless (-d $thislib){
+		print STDOUT "$ptype$thislib ignored, directory does not exist\n"
+			if $Verbose;
+		next;
+	    }
+	    unless ($self->file_name_is_absolute($thislib)) {
+	      print STDOUT "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
+	      $thislib = $self->catdir($pwd,$thislib);
+	    }
+	    push(@searchpath, $thislib);
+	    push(@extralibs,  "$ptype$thislib");
+	    push(@ldloadlibs, "$ptype$thislib");
+	    next;
+	}
+
+	# Handle possible library arguments.
+	unless ($thislib =~ s/^-l//){
+	  print STDOUT "Unrecognized argument in LIBS ignored: '$thislib'\n";
+	  next;
+	}
+
+	my($found_lib)=0;
+	foreach $thispth (@searchpath, @libpath){
+
+		# Try to find the full name of the library.  We need this to
+		# determine whether it's a dynamically-loadable library or not.
+		# This tends to be subject to various os-specific quirks.
+		# For gcc-2.6.2 on linux (March 1995), DLD can not load
+		# .sa libraries, with the exception of libm.sa, so we
+		# deliberately skip them.
+	    if (@fullname = $self->lsdir($thispth,"^lib$thislib\.$so\.[0-9]+")){
+		# Take care that libfoo.so.10 wins against libfoo.so.9.
+		# Compare two libraries to find the most recent version
+		# number.  E.g.  if you have libfoo.so.9.0.7 and
+		# libfoo.so.10.1, first convert all digits into two
+		# decimal places.  Then we'll add ".00" to the shorter
+		# strings so that we're comparing strings of equal length
+		# Thus we'll compare libfoo.so.09.07.00 with
+		# libfoo.so.10.01.00.  Some libraries might have letters
+		# in the version.  We don't know what they mean, but will
+		# try to skip them gracefully -- we'll set any letter to
+		# '0'.  Finally, sort in reverse so we can take the
+		# first element.
+
+		#TODO: iterate through the directory instead of sorting
+
+		$fullname = "$thispth/" .
+		(sort { my($ma) = $a;
+			my($mb) = $b;
+			$ma =~ tr/A-Za-z/0/s;
+			$ma =~ s/\b(\d)\b/0$1/g;
+			$mb =~ tr/A-Za-z/0/s;
+			$mb =~ s/\b(\d)\b/0$1/g;
+			while (length($ma) < length($mb)) { $ma .= ".00"; }
+			while (length($mb) < length($ma)) { $mb .= ".00"; }
+			# Comparison deliberately backwards
+			$mb cmp $ma;} @fullname)[0];
+	    } elsif (-f ($fullname="$thispth/lib$thislib.$so")
+		 && (($Config{'dlsrc'} ne "dl_dld.xs") || ($thislib eq "m"))){
+	    } elsif (-f ($fullname="$thispth/lib${thislib}_s$Config_libext")
+		 && ($thislib .= "_s") ){ # we must explicitly use _s version
+	    } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){
+	    } elsif (-f ($fullname="$thispth/$thislib$Config_libext")){
+	    } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){
+	    } elsif ($^O eq 'dgux'
+		 && -l ($fullname="$thispth/lib$thislib$Config_libext")
+		 && readlink($fullname) =~ /^elink:/) {
+		 # Some of DG's libraries look like misconnected symbolic
+		 # links, but development tools can follow them.  (They
+		 # look like this:
+		 #
+		 #    libm.a -> elink:${SDE_PATH:-/usr}/sde/\
+		 #    ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a
+		 #
+		 # , the compilation tools expand the environment variables.)
+	    } else {
+		print STDOUT "$thislib not found in $thispth\n" if $Verbose;
+		next;
+	    }
+	    print STDOUT "'-l$thislib' found at $fullname\n" if $Verbose;
+	    my($fullnamedir) = dirname($fullname);
+	    push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++;
+	    $found++;
+	    $found_lib++;
+
+	    # Now update library lists
+
+	    # what do we know about this library...
+	    my $is_dyna = ($fullname !~ /\Q$Config_libext\E$/);
+	    my $in_perl = ($libs =~ /\B-l\Q$ {thislib}\E\b/s);
+
+	    # Do not add it into the list if it is already linked in
+	    # with the main perl executable.
+	    # We have to special-case the NeXT, because all the math 
+	    # is also in libsys_s
+	    unless ($in_perl || 
+		    ($^O eq 'next' && $thislib eq 'm') ){
+		push(@extralibs, "-l$thislib");
+	    }
+
+	    # We might be able to load this archive file dynamically
+	    if ( $Config{'dlsrc'} =~ /dl_next|dl_dld/){
+		# We push -l$thislib instead of $fullname because
+		# it avoids hardwiring a fixed path into the .bs file.
+		# Mkbootstrap will automatically add dl_findfile() to
+		# the .bs file if it sees a name in the -l format.
+		# USE THIS, when dl_findfile() is fixed: 
+		# push(@bsloadlibs, "-l$thislib");
+		# OLD USE WAS while checking results against old_extliblist
+		push(@bsloadlibs, "$fullname");
+	    } else {
+		if ($is_dyna){
+                    # For SunOS4, do not add in this shared library if
+                    # it is already linked in the main perl executable
+		    push(@ldloadlibs, "-l$thislib")
+			unless ($in_perl and $^O eq 'sunos');
+		} else {
+		    push(@ldloadlibs, "-l$thislib");
+		}
+	    }
+	    last;	# found one here so don't bother looking further
+	}
+	print STDOUT "Warning (will try anyway): No library found for -l$thislib\n"
+	    unless $found_lib>0;
+    }
+    return ('','','','') unless $found;
+    ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Liblist - determine libraries to use and how to use them
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::Liblist;>
+
+C<ExtUtils::Liblist::ext($potential_libs, $Verbose);>
+
+=head1 DESCRIPTION
+
+This utility takes a list of libraries in the form C<-llib1 -llib2
+-llib3> and prints out lines suitable for inclusion in an extension
+Makefile.  Extra library paths may be included with the form
+C<-L/another/path> this will affect the searches for all subsequent
+libraries.
+
+It returns an array of four scalar values: EXTRALIBS, BSLOADLIBS,
+LDLOADLIBS, and LD_RUN_PATH.
+
+Dependent libraries can be linked in one of three ways:
+
+=over 2
+
+=item * For static extensions
+
+by the ld command when the perl binary is linked with the extension
+library. See EXTRALIBS below.
+
+=item * For dynamic extensions
+
+by the ld command when the shared object is built/linked. See
+LDLOADLIBS below.
+
+=item * For dynamic extensions
+
+by the DynaLoader when the shared object is loaded. See BSLOADLIBS
+below.
+
+=back
+
+=head2 EXTRALIBS
+
+List of libraries that need to be linked with when linking a perl
+binary which includes this extension Only those libraries that
+actually exist are included.  These are written to a file and used
+when linking perl.
+
+=head2 LDLOADLIBS and LD_RUN_PATH
+
+List of those libraries which can or must be linked into the shared
+library when created using ld. These may be static or dynamic
+libraries.  LD_RUN_PATH is a colon separated list of the directories
+in LDLOADLIBS. It is passed as an environment variable to the process
+that links the shared library.
+
+=head2 BSLOADLIBS
+
+List of those libraries that are needed but can be linked in
+dynamically at run time on this platform.  SunOS/Solaris does not need
+this because ld records the information (from LDLOADLIBS) into the
+object file.  This list is used to create a .bs (bootstrap) file.
+
+=head1 PORTABILITY
+
+This module deals with a lot of system dependencies and has quite a
+few architecture specific B<if>s in the code.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
new file mode 100644
index 00000000000..1a1f8b16a04
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
@@ -0,0 +1,73 @@
+package ExtUtils::MM_OS2;
+
+#use Config;
+#use Cwd;
+#use File::Basename;
+require Exporter;
+
+Exporter::import('ExtUtils::MakeMaker',
+       qw( $Verbose &neatvalue));
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+unshift @MM::ISA, 'ExtUtils::MM_OS2';
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
+    my(@m);
+    (my $boot = $self->{NAME}) =~ s/:/_/g;
+
+    if (not $self->{SKIPHASH}{'dynamic'}) {
+	push(@m,"
+$self->{BASEEXT}.def: Makefile.PL
+",
+     '	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
+     Mksymlists("NAME" => "', $self->{NAME},
+     '", "DLBASE" => "',$self->{DLBASE},
+     '", "DL_FUNCS" => ',neatvalue($funcs),
+     ', "IMPORTS" => ',neatvalue($imports),
+     ', "DL_VARS" => ', neatvalue($vars), ');\'
+');
+    }
+    join('',@m);
+}
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,.,g;
+    $man;
+}
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d _;
+    return "$file.exe" if -x "$file.exe" && ! -d _;
+    return "$file.cmd" if -x "$file.cmd" && ! -d _;
+    return;
+}
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed
+
+=head1 DESCRIPTION
+
+See ExtUtils::MM_Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
new file mode 100644
index 00000000000..8afae260385
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
@@ -0,0 +1,3118 @@
+package ExtUtils::MM_Unix;
+
+$VERSION = substr q$Revision: 1.1 $, 10;
+# $Id: MM_Unix.pm,v 1.1 1996/08/19 10:12:39 downsj Exp $
+
+require Exporter;
+use Config;
+use File::Basename qw(basename dirname fileparse);
+use DirHandle;
+
+Exporter::import('ExtUtils::MakeMaker',
+	qw( $Verbose &neatvalue));
+
+$Is_OS2 = $^O =~ m|^os/?2$|i;
+$Is_Mac = $^O eq "MacOS";
+
+if ($Is_VMS = $^O eq 'VMS') {
+    require VMS::Filespec;
+    import VMS::Filespec qw( &vmsify );
+}
+
+=head1 NAME
+
+ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::MM_Unix;>
+
+=head1 DESCRIPTION
+
+The methods provided by this package are designed to be used in
+conjunction with ExtUtils::MakeMaker. When MakeMaker writes a
+Makefile, it creates one or more objects that inherit their methods
+from a package C<MM>. MM itself doesn't provide any methods, but it
+ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
+specific packages take the responsibility for all the methods provided
+by MM_Unix. We are trying to reduce the number of the necessary
+overrides by defining rather primitive operations within
+ExtUtils::MM_Unix.
+
+If you are going to write a platform specific MM package, please try
+to limit the necessary overrides to primitiv methods, and if it is not
+possible to do so, let's work it out how to achieve that gain.
+
+If you are overriding any of these methods in your Makefile.PL (in the
+MY class), please report that to the makemaker mailing list. We are
+trying to minimize the necessary method overrides and switch to data
+driven Makefile.PLs wherever possible. In the long run less methods
+will be overridable via the MY class.
+
+=head1 METHODS
+
+The following description of methods is still under
+development. Please refer to the code for not suitably documented
+sections and complain loudly to the makemaker mailing list.
+
+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>).
+
+=head2 Preloaded methods
+
+=over 2
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+    $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
+    $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
+    $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending
+with a directory. But remove the trailing slash from the resulting
+string, because it doesn't look good, isn't necessary and confuses
+OS2. Of course, if this is the root directory, don't cut off the
+trailing slash :-)
+
+=cut
+
+# ';
+
+sub catdir {
+    shift;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+    }
+    my $result = join('', @args);
+    # remove a trailing slash unless we are root
+    substr($result,length($result)-1,1) = ""
+	if length($result) > 1 && substr($result,length($result)-1,1) eq "/";
+    $result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    my $self = shift @_;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    for ($dir) {
+	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+    }
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representing of the current directory.  "." on UNIX.
+
+=cut
+
+sub curdir {
+    return "." ;
+}
+
+=item rootdir
+
+Returns a string representing of the root directory.  "/" on UNIX.
+
+=cut
+
+sub rootdir {
+    return "/";
+}
+
+=item updir
+
+Returns a string representing of the parent directory.  ".." on UNIX.
+
+=cut
+
+sub updir {
+    return "..";
+}
+
+sub ExtUtils::MM_Unix::c_o ;
+sub ExtUtils::MM_Unix::clean ;
+sub ExtUtils::MM_Unix::const_cccmd ;
+sub ExtUtils::MM_Unix::const_config ;
+sub ExtUtils::MM_Unix::const_loadlibs ;
+sub ExtUtils::MM_Unix::constants ;
+sub ExtUtils::MM_Unix::depend ;
+sub ExtUtils::MM_Unix::dir_target ;
+sub ExtUtils::MM_Unix::dist ;
+sub ExtUtils::MM_Unix::dist_basics ;
+sub ExtUtils::MM_Unix::dist_ci ;
+sub ExtUtils::MM_Unix::dist_core ;
+sub ExtUtils::MM_Unix::dist_dir ;
+sub ExtUtils::MM_Unix::dist_test ;
+sub ExtUtils::MM_Unix::dlsyms ;
+sub ExtUtils::MM_Unix::dynamic ;
+sub ExtUtils::MM_Unix::dynamic_bs ;
+sub ExtUtils::MM_Unix::dynamic_lib ;
+sub ExtUtils::MM_Unix::exescan ;
+sub ExtUtils::MM_Unix::extliblist ;
+sub ExtUtils::MM_Unix::file_name_is_absolute ;
+sub ExtUtils::MM_Unix::find_perl ;
+sub ExtUtils::MM_Unix::force ;
+sub ExtUtils::MM_Unix::guess_name ;
+sub ExtUtils::MM_Unix::has_link_code ;
+sub ExtUtils::MM_Unix::init_dirscan ;
+sub ExtUtils::MM_Unix::init_main ;
+sub ExtUtils::MM_Unix::init_others ;
+sub ExtUtils::MM_Unix::install ;
+sub ExtUtils::MM_Unix::installbin ;
+sub ExtUtils::MM_Unix::libscan ;
+sub ExtUtils::MM_Unix::linkext ;
+sub ExtUtils::MM_Unix::lsdir ;
+sub ExtUtils::MM_Unix::macro ;
+sub ExtUtils::MM_Unix::makeaperl ;
+sub ExtUtils::MM_Unix::makefile ;
+sub ExtUtils::MM_Unix::manifypods ;
+sub ExtUtils::MM_Unix::maybe_command ;
+sub ExtUtils::MM_Unix::maybe_command_in_dirs ;
+sub ExtUtils::MM_Unix::needs_linking ;
+sub ExtUtils::MM_Unix::nicetext ;
+sub ExtUtils::MM_Unix::parse_version ;
+sub ExtUtils::MM_Unix::pasthru ;
+sub ExtUtils::MM_Unix::path ;
+sub ExtUtils::MM_Unix::perl_script ;
+sub ExtUtils::MM_Unix::perldepend ;
+sub ExtUtils::MM_Unix::pm_to_blib ;
+sub ExtUtils::MM_Unix::post_constants ;
+sub ExtUtils::MM_Unix::post_initialize ;
+sub ExtUtils::MM_Unix::postamble ;
+sub ExtUtils::MM_Unix::prefixify ;
+sub ExtUtils::MM_Unix::processPL ;
+sub ExtUtils::MM_Unix::realclean ;
+sub ExtUtils::MM_Unix::replace_manpage_separator ;
+sub ExtUtils::MM_Unix::static ;
+sub ExtUtils::MM_Unix::static_lib ;
+sub ExtUtils::MM_Unix::staticmake ;
+sub ExtUtils::MM_Unix::subdir_x ;
+sub ExtUtils::MM_Unix::subdirs ;
+sub ExtUtils::MM_Unix::test ;
+sub ExtUtils::MM_Unix::test_via_harness ;
+sub ExtUtils::MM_Unix::test_via_script ;
+sub ExtUtils::MM_Unix::tool_autosplit ;
+sub ExtUtils::MM_Unix::tool_xsubpp ;
+sub ExtUtils::MM_Unix::tools_other ;
+sub ExtUtils::MM_Unix::top_targets ;
+sub ExtUtils::MM_Unix::writedoc ;
+sub ExtUtils::MM_Unix::xs_c ;
+sub ExtUtils::MM_Unix::xs_o ;
+sub ExtUtils::MM_Unix::xsubpp_version ;
+
+package ExtUtils::MM_Unix;
+
+#use SelfLoader;
+
+1;
+#__DATA__
+
+=head2 SelfLoaded methods
+
+=item c_o (o)
+
+Defines the suffix rules to compile different flavors of C files to
+object files.
+
+=cut
+
+sub c_o {
+# --- Translation Sections ---
+
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    my(@m);
+    push @m, '
+.c$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+.C$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+
+.cpp$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
+
+.cxx$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx
+
+.cc$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc
+';
+    join "", @m;
+}
+
+=item cflags (o)
+
+Does very much the same as the cflags script in the perl
+distribution. It doesn't return the whole compiler command line, but
+initializes all of its parts. The const_cccmd method then actually
+returns the definition of the CCCMD macro which uses these parts.
+
+=cut
+
+#'
+
+sub cflags {
+    my($self,$libperl)=@_;
+    return $self->{CFLAGS} if $self->{CFLAGS};
+    return '' unless $self->needs_linking();
+
+    my($prog, $uc, $perltype, %cflags);
+    $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
+    $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
+
+    @cflags{qw(cc ccflags optimize large split shellflags)}
+	= @Config{qw(cc ccflags optimize large split shellflags)};
+    my($optdebug) = "";
+
+    $cflags{shellflags} ||= '';
+
+    my(%map) =  (
+		D =>   '-DDEBUGGING',
+		E =>   '-DEMBED',
+		DE =>  '-DDEBUGGING -DEMBED',
+		M =>   '-DEMBED -DMULTIPLICITY',
+		DM =>  '-DDEBUGGING -DEMBED -DMULTIPLICITY',
+		);
+
+    if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){
+	$uc = uc($1);
+    } else {
+	$uc = ""; # avoid warning
+    }
+    $perltype = $map{$uc} ? $map{$uc} : "";
+
+    if ($uc =~ /^D/) {
+	$optdebug = "-g";
+    }
+
+
+    my($name);
+    ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
+    if ($prog = $Config::Config{$name}) {
+	# Expand hints for this extension via the shell
+	print STDOUT "Processing $name hint:\n" if $Verbose;
+	my(@o)=`cc=\"$cflags{cc}\"
+	  ccflags=\"$cflags{ccflags}\"
+	  optimize=\"$cflags{optimize}\"
+	  perltype=\"$cflags{perltype}\"
+	  optdebug=\"$cflags{optdebug}\"
+	  large=\"$cflags{large}\"
+	  split=\"$cflags{'split'}\"
+	  eval '$prog'
+	  echo cc=\$cc
+	  echo ccflags=\$ccflags
+	  echo optimize=\$optimize
+	  echo perltype=\$perltype
+	  echo optdebug=\$optdebug
+	  echo large=\$large
+	  echo split=\$split
+	  `;
+	my($line);
+	foreach $line (@o){
+	    chomp $line;
+	    if ($line =~ /(.*?)=\s*(.*)\s*$/){
+		$cflags{$1} = $2;
+		print STDOUT "	$1 = $2\n" if $Verbose;
+	    } else {
+		print STDOUT "Unrecognised result from hint: '$line'\n";
+	    }
+	}
+    }
+
+    if ($optdebug) {
+	$cflags{optimize} = $optdebug;
+    }
+
+    for (qw(ccflags optimize perltype large split)) {
+	$cflags{$_} =~ s/^\s+//;
+	$cflags{$_} =~ s/\s+/ /g;
+	$cflags{$_} =~ s/\s+$//;
+	$self->{uc $_} ||= $cflags{$_}
+    }
+
+    return $self->{CFLAGS} = qq{
+CCFLAGS = $self->{CCFLAGS}
+OPTIMIZE = $self->{OPTIMIZE}
+PERLTYPE = $self->{PERLTYPE}
+LARGE = $self->{LARGE}
+SPLIT = $self->{SPLIT}
+};
+
+}
+
+=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 subdirectories first
+    for $dir (@{$self->{DIR}}) {
+	push @m, "\t-cd $dir && test -f $self->{MAKEFILE} && \$(MAKE) clean\n";
+    }
+
+    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all
+			 perlmain.c mon.out core so_locations pm_to_blib
+			 *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe
+			 $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def
+			 $(BASEEXT).exp
+			]);
+    push @m, "\t-$self->{RM_RF} @otherfiles\n";
+    # See realclean and ext/utils/make_ext for usage of Makefile.old
+    push(@m,
+	 "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old 2>/dev/null\n");
+    push(@m,
+	 "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
+    join("", @m);
+}
+
+=item const_cccmd (o)
+
+Returns the full compiler call for C programs and stores the
+definition in CONST_CCCMD.
+
+=cut
+
+sub const_cccmd {
+    my($self,$libperl)=@_;
+    return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
+    return '' unless $self->needs_linking();
+    return $self->{CONST_CCCMD} =
+	q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\
+	$(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \\
+	$(XS_DEFINE_VERSION)};
+}
+
+=item const_config (o)
+
+Defines a couple of constants in the Makefile that are imported from
+%Config.
+
+=cut
+
+sub const_config {
+# --- Constants Sections ---
+
+    my($self) = shift;
+    my(@m,$m);
+    push(@m,"\n# These definitions are from config.sh (via $INC{'Config.pm'})\n");
+    push(@m,"\n# They may have been overridden via Makefile.PL or on the command line\n");
+    my(%once_only);
+    foreach $m (@{$self->{CONFIG}}){
+	# SITE*EXP macros are defined in &constants; avoid duplicates here
+	next if $once_only{$m} or $m eq 'sitelibexp' or $m eq 'sitearchexp';
+	push @m, "\U$m\E = ".$self->{uc $m}."\n";
+	$once_only{$m} = 1;
+    }
+    join('', @m);
+}
+
+=item const_loadlibs (o)
+
+Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See
+L<ExtUtils::Liblist> for details.
+
+=cut
+
+sub const_loadlibs {
+    my($self) = shift;
+    return "" unless $self->needs_linking;
+    my @m;
+    push @m, qq{
+# $self->{NAME} might depend on some other libraries:
+# See ExtUtils::Liblist for details
+#
+};
+    my($tmp);
+    for $tmp (qw/
+	 EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH
+	 /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+    return join "", @m;
+}
+
+=item constants (o)
+
+Initializes lots of constants and .SUFFIXES and .PHONY
+
+=cut
+
+sub constants {
+    my($self) = @_;
+    my(@m,$tmp);
+
+    for $tmp (qw/
+
+	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
+	      VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB
+	      INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS
+	      INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB
+	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
+	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
+	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC
+	      PERL_INC PERL FULLPERL
+
+	      / ) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, qq{
+VERSION_MACRO = VERSION
+DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
+};
+
+    push @m, qq{
+MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'}
+MM_VERSION = $ExtUtils::MakeMaker::VERSION
+};
+
+    push @m, q{
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD)  !!! Deprecated from MM 5.32  !!!
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+};
+
+    for $tmp (qw/
+	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
+	      LDFROM LINKTYPE
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, "
+# Handy lists of source code files:
+XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})."
+C_FILES = ".join(" \\\n\t", @{$self->{C}})."
+O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})."
+H_FILES = ".join(" \\\n\t", @{$self->{H}})."
+MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})."
+MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
+";
+
+    for $tmp (qw/
+	      INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+	      /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, q{
+.NO_CONFIG_REC: Makefile
+} if $ENV{CLEARCASE_ROOT};
+
+    # why not q{} ? -- emacs
+    push @m, qq{
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
+
+.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT)
+
+# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
+# some make implementations will delete the Makefile when we rebuild it. Because
+# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
+# does so. Our milage may vary.
+# .PRECIOUS: Makefile    # seems to be not necessary anymore
+
+.PHONY: all config static dynamic test linkext manifest
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = \$(PERL_ARCHLIB)/Config.pm \$(PERL_INC)/config.h
+};
+
+    my @parentdir = split(/::/, $self->{PARENT_NAME});
+    push @m, q{
+# Where to put things:
+INST_LIBDIR      = }. $self->catdir('$(INST_LIB)',@parentdir)        .q{
+INST_ARCHLIBDIR  = }. $self->catdir('$(INST_ARCHLIB)',@parentdir)    .q{
+
+INST_AUTODIR     = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)')       .q{
+INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)')   .q{
+};
+
+    if ($self->has_link_code()) {
+	push @m, '
+INST_STATIC  = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
+INST_BOOT    = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
+';
+    } else {
+	push @m, '
+INST_STATIC  =
+INST_DYNAMIC =
+INST_BOOT    =
+';
+    }
+
+    if ($Is_OS2) {
+	$tmp = "$self->{BASEEXT}.def";
+    } else {
+	$tmp = "";
+    }
+    push @m, "
+EXPORT_LIST = $tmp
+";
+
+    if ($Is_OS2) {
+	$tmp = "\$(PERL_INC)/libperl\$(LIB_EXT)";
+    } else {
+	$tmp = "";
+    }
+    push @m, "
+PERL_ARCHIVE = $tmp
+";
+
+#    push @m, q{
+#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{
+#
+#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
+#};
+
+    push @m, q{
+TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{
+
+PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
+};
+
+    join('',@m);
+}
+
+=item depend (o)
+
+Same as macro for the depend attribute.
+
+=cut
+
+sub depend {
+    my($self,%attribs) = @_;
+    my(@m,$key,$val);
+    while (($key,$val) = each %attribs){
+	last unless defined $key;
+	push @m, "$key: $val\n";
+    }
+    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);
+    foreach $dir (@dirs) {
+	my($src) = $self->catfile($self->{PERL_INC},'perl.h');
+	my($targ) = $self->catfile($dir,'.exists');
+	my($targdir) = $targ;       # Necessary because catfile may have
+	$targdir =~ s:/?.exists$::; # adapted syntax of $dir to target OS
+	next if $self->{DIR_TARGET}{$self}{$targdir}++;
+	push @m, qq{
+$targ :: $src
+	$self->{NOECHO}\$(MKPATH) $targdir
+	$self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ
+};
+	push(@m,qq{
+	-$self->{NOECHO}\$(CHMOD) 755 $targdir
+}) unless $Is_VMS;
+    }
+    join "", @m;
+}
+
+=item dist (o)
+
+Defines a lot of macros for distribution support.
+
+=cut
+
+sub dist {
+    my($self, %attribs) = @_;
+
+    my(@m);
+    # VERSION should be sanitised before use as a file name
+    my($version)  = $attribs{VERSION}  || '$(VERSION)';
+    my($name)     = $attribs{NAME}     || '$(DISTNAME)';
+    my($tar)      = $attribs{TAR}      || 'tar';        # eg /usr/bin/gnutar
+    my($tarflags) = $attribs{TARFLAGS} || 'cvf';
+    my($zip)      = $attribs{ZIP}      || 'zip';        # eg pkzip Yuck!
+    my($zipflags) = $attribs{ZIPFLAGS} || '-r';
+    my($compress) = $attribs{COMPRESS} || 'compress';   # eg gzip
+    my($suffix)   = $attribs{SUFFIX}   || '.Z';          # eg .gz
+    my($shar)     = $attribs{SHAR}     || 'shar';       # eg "shar --gzip"
+    my($preop)    = $attribs{PREOP}    || "$self->{NOECHO}\$(NOOP)"; # eg update MANIFEST
+    my($postop)   = $attribs{POSTOP}   || "$self->{NOECHO}\$(NOOP)"; # eg remove the distdir
+
+    my($to_unix)  = $attribs{TO_UNIX} || ($Is_OS2
+					  ? "$self->{NOECHO}"
+					  . 'test -f tmp.zip && $(RM) tmp.zip;'
+					  . ' $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip'
+					  : "$self->{NOECHO}\$(NOOP)");
+
+    my($ci)       = $attribs{CI}       || 'ci -u';
+    my($rcs_label)= $attribs{RCS_LABEL}|| 'rcs -Nv$(VERSION_SYM): -q';
+    my($dist_cp)  = $attribs{DIST_CP}  || 'best';
+    my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist';
+
+    push @m, "
+DISTVNAME = ${name}-$version
+TAR  = $tar
+TARFLAGS = $tarflags
+ZIP  = $zip
+ZIPFLAGS = $zipflags
+COMPRESS = $compress
+SUFFIX = $suffix
+SHAR = $shar
+PREOP = $preop
+POSTOP = $postop
+TO_UNIX = $to_unix
+CI = $ci
+RCS_LABEL = $rcs_label
+DIST_CP = $dist_cp
+DIST_DEFAULT = $dist_default
+";
+    join "", @m;
+}
+
+=item dist_basics (o)
+
+Defines the targets distclean, distcheck, skipcheck, manifest.
+
+=cut
+
+sub dist_basics {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+distclean :: realclean distcheck
+};
+
+    push @m, q{
+distcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\
+		-e 'fullcheck();'
+};
+
+    push @m, q{
+skipcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&skipcheck";' \\
+		-e 'skipcheck();'
+};
+
+    push @m, q{
+manifest :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\
+		-e 'mkmanifest();'
+};
+    join "", @m;
+}
+
+=item dist_ci (o)
+
+Defines a check in target for RCS.
+
+=cut
+
+sub dist_ci {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+ci :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\
+		-e '@all = keys %{ maniread() };' \\
+		-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\
+		-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+};
+    join "", @m;
+}
+
+=item dist_core (o)
+
+Defeines the targets dist, tardist, zipdist, uutardist, shdist
+
+=cut
+
+sub dist_core {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+dist : $(DIST_DEFAULT)
+	}.$self->{NOECHO}.q{$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
+	    -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "}.$self->{MAKEFILE}.q{";'
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+
+zipdist : $(DISTVNAME).zip
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+	uuencode $(DISTVNAME).tar$(SUFFIX) \\
+		$(DISTVNAME).tar$(SUFFIX) > \\
+		$(DISTVNAME).tar$(SUFFIX)_uu
+
+shdist : distdir
+	$(PREOP)
+	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+};
+    join "", @m;
+}
+
+=item dist_dir (o)
+
+Defines the scratch directory target that will hold the distribution
+before tar-ing (or shar-ing).
+
+=cut
+
+sub dist_dir {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+distdir :
+	$(RM_RF) $(DISTVNAME)
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\
+		-e 'manicopy(maniread(),"$(DISTVNAME)", "$(DIST_CP)");'
+};
+    join "", @m;
+}
+
+=item dist_test (o)
+
+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) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
+	cd $(DISTVNAME) && $(MAKE)
+	cd $(DISTVNAME) && $(MAKE) test
+};
+    join "", @m;
+}
+
+=item dlsyms (o)
+
+Used by AIX and VMS to define DL_FUNCS and DL_VARS and write the *.exp
+files.
+
+=cut
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    return '' unless ($^O eq 'aix' && $self->needs_linking() );
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    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
+",'	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
+	Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
+	neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\'
+');
+
+    join('',@m);
+}
+
+=item dynamic (o)
+
+Defines the dynamic target.
+
+=cut
+
+sub dynamic {
+# --- Dynamic Loading Sections ---
+
+    my($self) = shift;
+    '
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make dynamic"
+#dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
+dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT)
+	'.$self->{NOECHO}.'$(NOOP)
+';
+}
+
+=item dynamic_bs (o)
+
+Defines targets for bootstrap files.
+
+=cut
+
+sub dynamic_bs {
+    my($self, %attribs) = @_;
+    return '
+BOOTSTRAP =
+' unless $self->has_link_code();
+
+    return '
+BOOTSTRAP = '."$self->{BASEEXT}.bs".'
+
+# As Mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists
+	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+		-e \'use ExtUtils::Mkbootstrap;\' \
+		-e \'Mkbootstrap("$(BASEEXT)","$(BSLOADLIBS)");\'
+	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
+	$(CHMOD) 644 $@
+
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
+	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
+	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
+	$(CHMOD) 644 $@
+';
+}
+
+=item dynamic_lib (o)
+
+Defines how to produce the *.so (or equivalent) files.
+
+=cut
+
+sub dynamic_lib {
+    my($self, %attribs) = @_;
+    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":";
+    my($ldfrom) = '$(LDFROM)';
+    $armaybe = 'ar' if ($^O eq 'dec_osf' and $armaybe eq ':');
+    my(@m);
+    push(@m,'
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+ARMAYBE = '.$armaybe.'
+OTHERLDFLAGS = '.$otherldflags.'
+INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+');
+    if ($armaybe ne ':'){
+	$ldfrom = 'tmp$(LIB_EXT)';
+	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
+	push(@m,'	$(RANLIB) '."$ldfrom\n");
+    }
+    $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
+    push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) '.$ldfrom.
+		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
+    push @m, '
+	$(CHMOD) 755 $@
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+=item exescan
+
+Deprecated method. Use libscan instead.
+
+=cut
+
+sub exescan {
+    my($self,$path) = @_;
+    $path;
+}
+
+=item extliblist
+
+Called by init_others, and calls ext ExtUtils::Liblist. See
+L<ExtUtils::Liblist> for details.
+
+=cut
+
+sub extliblist {
+    my($self,$libs) = @_;
+    require ExtUtils::Liblist;
+    $self->ext($libs, $Verbose);
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, it it is an absolute path.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m:^/: ;
+}
+
+=item find_perl
+
+Finds the executables PERL and FULLPERL
+
+=cut
+
+sub find_perl {
+    my($self, $ver, $names, $dirs, $trace) = @_;
+    my($name, $dir);
+    if ($trace >= 2){
+	print "Looking for perl $ver by these names:
+@$names
+in these dirs:
+@$dirs
+";
+    }
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my $abs;
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->canonpath($self->catfile($self->curdir, $name));
+	    }
+	    print "Checking $abs\n" if ($trace >= 2);
+	    next unless $self->maybe_command($abs);
+	    print "Executing $abs\n" if ($trace >= 2);
+	    if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+	        print "Using PERL=$abs\n" if $trace;
+	        return $abs;
+	    }
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+=head2 Methods to actually produce chunks of text for the Makefile
+
+The methods here are called in the order specified by
+@ExtUtils::MakeMaker::MM_Sections. This manpage reflects the order as
+well as possible. Some methods call each other, so in doubt refer to
+the code.
+
+=item force (o)
+
+Just writes FORCE:
+
+=cut
+
+sub force {
+    my($self) = shift;
+    '# Phony target to force checking subdirectories.
+FORCE:
+';
+}
+
+=item guess_name
+
+Guess the name of this package by examining the working directory's
+name. MakeMaker calls this only if the developer has not supplied a
+NAME attribute.
+
+=cut
+
+# ';
+
+sub guess_name {
+    my($self) = @_;
+    use Cwd 'cwd';
+    my $name = basename(cwd());
+    $name =~ s|[\-_][\d\.\-]+$||;   # this is new with MM 5.00, we
+                                    # strip minus or underline
+                                    # followed by a float or some such
+    print "Warning: Guessing NAME [$name] from current directory name.\n";
+    $name;
+}
+
+=item has_link_code
+
+Returns true if C, XS, MYEXTLIB or similar objects exist within this
+object that need a compiler. Does not descend into subdirectories as
+needs_linking() does.
+
+=cut
+
+sub has_link_code {
+    my($self) = shift;
+    return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE};
+    if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){
+	$self->{HAS_LINK_CODE} = 1;
+	return 1;
+    }
+    return $self->{HAS_LINK_CODE} = 0;
+}
+
+=item init_dirscan
+
+Initializes DIR, XS, PM, C, O_FILES, H, PL_FILES, MAN*PODS, EXE_FILES.
+
+=cut
+
+sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
+    my($self) = @_;
+    my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
+    local(%pm); #the sub in find() has to see this hash
+    $ignore{'test.pl'} = 1;
+    $ignore{'makefile.pl'} = 1 if $Is_VMS;
+    foreach $name ($self->lsdir($self->curdir)){
+	next if $name eq $self->curdir or $name eq $self->updir or $ignore{$name};
+	next unless $self->libscan($name);
+	if (-d $name){
+	    next if -l $name; # We do not support symlinks at all
+	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
+	} elsif ($name =~ /\.xs$/){
+	    my($c); ($c = $name) =~ s/\.xs$/.c/;
+	    $xs{$name} = $c;
+	    $c{$c} = 1;
+	} elsif ($name =~ /\.c(pp|xx|c)?$/i){  # .c .C .cpp .cxx .cc
+	    $c{$name} = 1
+		unless $name =~ m/perlmain\.c/; # See MAP_TARGET
+	} elsif ($name =~ /\.h$/i){
+	    $h{$name} = 1;
+	} elsif ($name =~ /\.(p[ml]|pod)$/){
+	    $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name);
+	} elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") {
+	    ($pl_files{$name} = $name) =~ s/\.PL$// ;
+	} elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' &&
+	         $name ne 'test.pl') {  # case-insensitive filesystem
+	    ($pl_files{$name} = $name) =~ s/\.pl$// ;
+	}
+    }
+
+    # Some larger extensions often wish to install a number of *.pm/pl
+    # files into the library in various locations.
+
+    # The attribute PMLIBDIRS holds an array reference which lists
+    # subdirectories which we should search for library files to
+    # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ].  We
+    # recursively search through the named directories (skipping any
+    # which don't exist or contain Makefile.PL files).
+
+    # For each *.pm or *.pl file found $self->libscan() is called with
+    # the default installation path in $_[1]. The return value of
+    # libscan defines the actual installation location.  The default
+    # libscan function simply returns the path.  The file is skipped
+    # if libscan returns false.
+
+    # The default installation location passed to libscan in $_[1] is:
+    #
+    #  ./*.pm		=> $(INST_LIBDIR)/*.pm
+    #  ./xyz/...	=> $(INST_LIBDIR)/xyz/...
+    #  ./lib/...	=> $(INST_LIB)/...
+    #
+    # In this way the 'lib' directory is seen as the root of the actual
+    # perl library whereas the others are relative to INST_LIBDIR
+    # (which includes PARENT_NAME). This is a subtle distinction but one
+    # that's important for nested modules.
+
+    $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}]
+	unless $self->{PMLIBDIRS};
+
+    #only existing directories that aren't in $dir are allowed
+
+    # Avoid $_ wherever possible:
+    # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}};
+    my (@pmlibdirs) = @{$self->{PMLIBDIRS}};
+    my ($pmlibdir);
+    @{$self->{PMLIBDIRS}} = ();
+    foreach $pmlibdir (@pmlibdirs) {
+	-d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir;
+    }
+
+    if (@{$self->{PMLIBDIRS}}){
+	print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n"
+	    if ($Verbose >= 2);
+	require File::Find;
+	File::Find::find(sub {
+	    if (-d $_){
+		if ($_ eq "CVS" || $_ eq "RCS"){
+		    $File::Find::prune = 1;
+		}
+		return;
+	    }
+	    my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)');
+	    my($striplibpath,$striplibname);
+	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:);
+	    ($striplibname,$striplibpath) = fileparse($striplibpath);
+	    my($inst) = $self->catfile($prefix,$striplibpath,$striplibname);
+	    local($_) = $inst; # for backwards compatibility
+	    $inst = $self->libscan($inst);
+	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
+	    return unless $inst;
+	    $pm{$path} = $inst;
+	}, @{$self->{PMLIBDIRS}});
+    }
+
+    $self->{DIR} = [sort keys %dir] unless $self->{DIR};
+    $self->{XS}  = \%xs             unless $self->{XS};
+    $self->{PM}  = \%pm             unless $self->{PM};
+    $self->{C}   = [sort keys %c]   unless $self->{C};
+    my(@o_files) = @{$self->{C}};
+    $self->{O_FILES} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ;
+    $self->{H}   = [sort keys %h]   unless $self->{H};
+    $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES};
+
+    # Set up names of manual pages to generate from pods
+    if ($self->{MAN1PODS}) {
+    } elsif ( $self->{INST_MAN1DIR} =~ /^(none|\s*)$/ ) {
+    	$self->{MAN1PODS} = {};
+    } else {
+	my %manifypods = ();
+	if ( exists $self->{EXE_FILES} ) {
+	    foreach $name (@{$self->{EXE_FILES}}) {
+#		use FileHandle ();
+#		my $fh = new FileHandle;
+		local *FH;
+		my($ispod)=0;
+		# one day test, if $/ can be set to '' safely (is the bug fixed that was in 5.001m?)
+#		if ($fh->open("<$name")) {
+		if (open(FH,"<$name")) {
+#		    while (<$fh>) {
+		    while (<FH>) {
+			if (/^=head1\s+\w+/) {
+			    $ispod=1;
+			    last;
+			}
+		    }
+#		    $fh->close;
+		    close FH;
+		} else {
+		    # If it doesn't exist yet, we assume, it has pods in it
+		    $ispod = 1;
+		}
+		if( $ispod ) {
+		    $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)');
+		}
+	    }
+	}
+	$self->{MAN1PODS} = \%manifypods;
+    }
+    if ($self->{MAN3PODS}) {
+    } elsif ( $self->{INST_MAN3DIR} =~ /^(none|\s*)$/ ) {
+    	$self->{MAN3PODS} = {};
+    } else {
+	my %manifypods = (); # we collect the keys first, i.e. the files
+			     # we have to convert to pod
+	foreach $name (keys %{$self->{PM}}) {
+	    if ($name =~ /\.pod$/ ) {
+		$manifypods{$name} = $self->{PM}{$name};
+	    } elsif ($name =~ /\.p[ml]$/ ) {
+#		use FileHandle ();
+#		my $fh = new FileHandle;
+		local *FH;
+		my($ispod)=0;
+#		$fh->open("<$name");
+		if (open(FH,"<$name")) {
+		    #		while (<$fh>) {
+		    while (<FH>) {
+			if (/^=head1\s+\w+/) {
+			    $ispod=1;
+			    last;
+			}
+		    }
+		    #		$fh->close;
+		    close FH;
+		} else {
+		    $ispod = 1;
+		}
+		if( $ispod ) {
+		    $manifypods{$name} = $self->{PM}{$name};
+		}
+	    }
+	}
+
+	# Remove "Configure.pm" and similar, if it's not the only pod listed
+	# To force inclusion, just name it "Configure.pod", or override MAN3PODS
+	foreach $name (keys %manifypods) {
+	    if ($name =~ /(config|setup).*\.pm/i) {
+		delete $manifypods{$name};
+		next;
+	    }
+	    my($manpagename) = $name;
+	    unless ($manpagename =~ s!^\W*lib\W+!!) { # everything below lib is ok
+		$manpagename = $self->catfile(split(/::/,$self->{PARENT_NAME}),$manpagename);
+	    }
+	    $manpagename =~ s/\.p(od|m|l)$//;
+	    $manpagename = $self->replace_manpage_separator($manpagename);
+	    $manifypods{$name} = $self->catfile("\$(INST_MAN3DIR)","$manpagename.\$(MAN3EXT)");
+	}
+	$self->{MAN3PODS} = \%manifypods;
+    }
+}
+
+=item init_main
+
+Initializes NAME, FULLEXT, BASEEXT, PARENT_NAME, DLBASE, PERL_SRC,
+PERL_LIB, PERL_ARCHLIB, PERL_INC, INSTALLDIRS, INST_*, INSTALL*,
+PREFIX, CONFIG, AR, AR_STATIC_ARGS, LD, OBJ_EXT, LIB_EXT, MAP_TARGET,
+LIBPERL_A, VERSION_FROM, VERSION, DISTNAME, VERSION_SYM.
+
+=cut
+
+sub init_main {
+    my($self) = @_;
+
+    # --- Initialize Module Name and Paths
+
+    # NAME    = Foo::Bar::Oracle
+    # FULLEXT = Foo/Bar/Oracle
+    # BASEEXT = Oracle
+    # ROOTEXT = Directory part of FULLEXT with leading /. !!! Deprecated from MM 5.32 !!!
+    # PARENT_NAME = Foo::Bar
+### Only UNIX:
+###    ($self->{FULLEXT} =
+###     $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket
+    $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME});
+
+
+    # Copied from DynaLoader:
+
+    my(@modparts) = split(/::/,$self->{NAME});
+    my($modfname) = $modparts[-1];
+
+    # Some systems have restrictions on files names for DLL's etc.
+    # mod2fname returns appropriate file base name (typically truncated)
+    # It may also edit @modparts if required.
+    if (defined &DynaLoader::mod2fname) {
+        $modfname = &DynaLoader::mod2fname(\@modparts);
+    } elsif ($Is_OS2) {                # Need manual correction if run with miniperl:-(
+        $modfname = substr($modfname, 0, 7) . '_';
+    }
+
+
+    ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
+
+    if (defined &DynaLoader::mod2fname or $Is_OS2) {
+	# As of 5.001m, dl_os2 appends '_'
+	$self->{DLBASE} = $modfname;
+    } else {
+	$self->{DLBASE} = '$(BASEEXT)';
+    }
+
+
+    ### ROOTEXT deprecated from MM 5.32
+###    ($self->{ROOTEXT} =
+###     $self->{FULLEXT}) =~ s#/?\Q$self->{BASEEXT}\E$## ;      #eg. /BSD/Foo
+###    $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT};
+
+
+    # --- Initialize PERL_LIB, INST_LIB, PERL_SRC
+
+    # *Real* information: where did we get these two from? ...
+    my $inc_config_dir = dirname($INC{'Config.pm'});
+    my $inc_carp_dir   = dirname($INC{'Carp.pm'});
+
+    unless ($self->{PERL_SRC}){
+	my($dir);
+	foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir())){
+	    if (
+		-f $self->catfile($dir,"config.sh")
+		&&
+		-f $self->catfile($dir,"perl.h")
+		&&
+		-f $self->catfile($dir,"lib","Exporter.pm")
+	       ) {
+		$self->{PERL_SRC}=$dir ;
+		last;
+	    }
+	}
+    }
+    if ($self->{PERL_SRC}){
+	$self->{PERL_LIB}     ||= $self->catdir("$self->{PERL_SRC}","lib");
+	$self->{PERL_ARCHLIB} = $self->{PERL_LIB};
+	$self->{PERL_INC}     = $self->{PERL_SRC};
+	# catch a situation that has occurred a few times in the past:
+
+	warn <<EOM unless (-s $self->catfile($self->{PERL_SRC},'cflags') or $Is_VMS && -s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt') or $Is_Mac);
+You cannot build extensions below the perl source tree after executing
+a 'make clean' in the perl source tree.
+
+To rebuild extensions distributed with the perl source you should
+simply Configure (to include those extensions) and then build perl as
+normal. After installing perl the source tree can be deleted. It is
+not needed for building extensions by running 'perl Makefile.PL'
+usually without extra arguments.
+
+It is recommended that you unpack and build additional extensions away
+from the perl source tree.
+EOM
+    } else {
+	# we should also consider $ENV{PERL5LIB} here
+	$self->{PERL_LIB}     ||= $Config::Config{privlibexp};
+	$self->{PERL_ARCHLIB} ||= $Config::Config{archlibexp};
+	$self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
+	my $perl_h;
+	die <<EOM unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")));
+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. You can say:
+
+    $^X Makefile.PL PERL_SRC=/path/to/perl/source/directory
+
+if you have not yet installed perl but still want to build this
+extension now.
+(You get this message, because MakeMaker could not find "$perl_h")
+EOM
+
+#	 print STDOUT "Using header files found in $self->{PERL_INC}\n"
+#	     if $Verbose && $self->needs_linking();
+
+    }
+
+    # We get SITELIBEXP and SITEARCHEXP directly via
+    # Get_from_Config. When we are running standard modules, these
+    # won't matter, we will set INSTALLDIRS to "perl". Otherwise we
+    # set it to "site". I prefer that INSTALLDIRS be set from outside
+    # MakeMaker.
+    $self->{INSTALLDIRS} ||= "site";
+
+    # 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::Config{privlibexp}.
+    unless ($self->{INST_LIB}){
+
+
+	##### XXXXX We have to change this nonsense
+
+	if (defined $self->{PERL_SRC} and $self->{INSTALLDIRS} eq "perl") {
+	    $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
+	} else {
+	    $self->{INST_LIB} = $self->catdir($self->curdir,"blib","lib");
+	}
+    }
+    $self->{INST_ARCHLIB} ||= $self->catdir($self->curdir,"blib","arch");
+    $self->{INST_BIN} ||= $self->catdir($self->curdir,'blib','bin');
+
+    # INST_EXE is deprecated, should go away March '97
+    $self->{INST_EXE} ||= $self->catdir($self->curdir,'blib','script');
+    $self->{INST_SCRIPT} ||= $self->catdir($self->curdir,'blib','script');
+
+    # The user who requests an installation directory explicitly
+    # should not have to tell us a architecture installation directory
+    # as well We look if a directory exists that is named after the
+    # architecture. If not we take it as a sign that it should be the
+    # same as the requested installation directory. Otherwise we take
+    # the found one.
+    # We do the same thing twice: for privlib/archlib and for sitelib/sitearch
+    my($libpair);
+    for $libpair ({l=>"privlib", a=>"archlib"}, {l=>"sitelib", a=>"sitearch"}) {
+	my $lib = "install$libpair->{l}";
+	my $Lib = uc $lib;
+	my $Arch = uc "install$libpair->{a}";
+	if( $self->{$Lib} && ! $self->{$Arch} ){
+	    my($ilib) = $Config{$lib};
+	    $ilib = VMS::Filespec::unixify($ilib) if $Is_VMS;
+
+	    $self->prefixify($Arch,$ilib,$self->{$Lib});
+
+	    unless (-d $self->{$Arch}) {
+		print STDOUT "Directory $self->{$Arch} not found, thusly\n" if $Verbose;
+		$self->{$Arch} = $self->{$Lib};
+	    }
+	    print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose;
+	}
+    }
+
+    # we have to look at the relation between $Config{prefix} and the
+    # requested values. We're going to set the $Config{prefix} part of
+    # all the installation path variables to literally $(PREFIX), so
+    # the user can still say make PREFIX=foo
+    my($prefix) = $Config{'prefix'};
+    $prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
+    unless ($self->{PREFIX}){
+	$self->{PREFIX} = $prefix;
+    }
+    my($install_variable);
+    for $install_variable (qw/
+
+			   INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN
+			   INSTALLMAN1DIR INSTALLMAN3DIR INSTALLSCRIPT
+			   INSTALLSITELIB INSTALLSITEARCH
+
+			   /) {
+	$self->prefixify($install_variable,$prefix,q[$(PREFIX)]);
+    }
+
+
+    # Now we head at the manpages. Maybe they DO NOT want manpages
+    # installed
+    $self->{INSTALLMAN1DIR} = $Config::Config{installman1dir}
+	unless defined $self->{INSTALLMAN1DIR};
+    unless (defined $self->{INST_MAN1DIR}){
+	if ($self->{INSTALLMAN1DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN1DIR} = $self->{INSTALLMAN1DIR};
+	} else {
+	    $self->{INST_MAN1DIR} = $self->catdir($self->curdir,'blib','man1');
+	}
+    }
+    $self->{MAN1EXT} ||= $Config::Config{man1ext};
+
+    $self->{INSTALLMAN3DIR} = $Config::Config{installman3dir}
+	unless defined $self->{INSTALLMAN3DIR};
+    unless (defined $self->{INST_MAN3DIR}){
+	if ($self->{INSTALLMAN3DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN3DIR} = $self->{INSTALLMAN3DIR};
+	} else {
+	    $self->{INST_MAN3DIR} = $self->catdir($self->curdir,'blib','man3');
+	}
+    }
+    $self->{MAN3EXT} ||= $Config::Config{man3ext};
+
+
+    # Get some stuff out of %Config if we haven't yet done so
+    print STDOUT "CONFIG must be an array ref\n"
+	if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY');
+    $self->{CONFIG} = [] unless (ref $self->{CONFIG});
+    push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config);
+    push(@{$self->{CONFIG}}, 'shellflags') if $Config::Config{shellflags};
+    my(%once_only,$m);
+    foreach $m (@{$self->{CONFIG}}){
+	next if $once_only{$m};
+	print STDOUT "CONFIG key '$m' does not exist in Config.pm\n"
+		unless exists $Config::Config{$m};
+	$self->{uc $m} ||= $Config::Config{$m};
+	$once_only{$m} = 1;
+    }
+
+# This is too dangerous:
+#    if ($^O eq "next") {
+#	$self->{AR} = "libtool";
+#	$self->{AR_STATIC_ARGS} = "-o";
+#    }
+# But I leave it as a placeholder
+
+    $self->{AR_STATIC_ARGS} ||= "cr";
+
+    # These should never be needed
+    $self->{LD} ||= 'ld';
+    $self->{OBJ_EXT} ||= '.o';
+    $self->{LIB_EXT} ||= '.a';
+
+    $self->{MAP_TARGET} ||= "perl";
+
+    $self->{LIBPERL_A} ||= "libperl$self->{LIB_EXT}";
+
+    # make a simple check if we find Exporter
+    warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory
+        (Exporter.pm not found)"
+	unless -f $self->catfile("$self->{PERL_LIB}","Exporter.pm") ||
+        $self->{NAME} eq "ExtUtils::MakeMaker";
+
+    # Determine VERSION and VERSION_FROM
+    ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME};
+    if ($self->{VERSION_FROM}){
+	$self->{VERSION} = $self->parse_version($self->{VERSION_FROM}) or
+	    Carp::carp "WARNING: Setting VERSION via file '$self->{VERSION_FROM}' failed\n"
+    }
+
+    # strip blanks
+    if ($self->{VERSION}) {
+	$self->{VERSION} =~ s/^\s+//;
+	$self->{VERSION} =~ s/\s+$//;
+    }
+
+    $self->{VERSION} ||= "0.10";
+    ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
+
+
+    # Graham Barr and Paul Marquess had some ideas how to ensure
+    # version compatibility between the *.pm file and the
+    # corresponding *.xs file. The bottomline was, that we need an
+    # XS_VERSION macro that defaults to VERSION:
+    $self->{XS_VERSION} ||= $self->{VERSION};
+
+    # --- Initialize Perl Binary Locations
+
+    # Find Perl 5. The only contract here is that both 'PERL' and 'FULLPERL'
+    # will be working versions of perl 5. miniperl has priority over perl
+    # for PERL to ensure that $(PERL) is usable while building ./ext/*
+    my ($component,@defpath);
+    foreach $component ($self->{PERL_SRC}, $self->path(), $Config::Config{binexp}) {
+	push @defpath, $component if defined $component;
+    }
+    $self->{PERL} =
+        $self->find_perl(5.0, [ $^X, 'miniperl','perl','perl5',"perl$]" ],
+	    \@defpath, $Verbose ) unless ($self->{PERL});
+    # don't check if perl is executable, maybe they have decided to
+    # supply switches with perl
+
+    # Define 'FULLPERL' to be a non-miniperl (used in test: target)
+    ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i
+	unless ($self->{FULLPERL});
+}
+
+=item init_others
+
+Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH,
+OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE,
+MAKEFILE, NOECHO, RM_F, RM_RF, TOUCH, CP, MV, CHMOD, UMASK_NULL
+
+=cut
+
+sub init_others {	# --- Initialize Other Attributes
+    my($self) = shift;
+
+    # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS}
+    # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or
+    # undefined. In any case we turn it into an anon array:
+
+    # May check $Config{libs} too, thus not empty.
+    $self->{LIBS}=[''] unless $self->{LIBS};
+
+    $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq SCALAR;
+    $self->{LD_RUN_PATH} = "";
+    my($libs);
+    foreach $libs ( @{$self->{LIBS}} ){
+	$libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace
+	my(@libs) = $self->extliblist($libs);
+	if ($libs[0] or $libs[1] or $libs[2]){
+	    # LD_RUN_PATH now computed by ExtUtils::Liblist
+	    ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs;
+	    last;
+	}
+    }
+
+    if ( $self->{OBJECT} ) {
+	$self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
+    } else {
+	# init_dirscan should have found out, if we have C files
+	$self->{OBJECT} = "";
+	$self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]};
+    }
+    $self->{OBJECT} =~ s/\n+/ \\\n\t/g;
+    $self->{BOOTDEP}  = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : "";
+    $self->{PERLMAINCC} ||= '$(CC)';
+    $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM};
+
+    # Sanity check: don't define LINKTYPE = dynamic if we're skipping
+    # the 'dynamic' section of MM.  We don't have this problem with
+    # 'static', since we either must use it (%Config says we can't
+    # use dynamic loading) or the caller asked for it explicitly.
+    if (!$self->{LINKTYPE}) {
+       $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'}
+                        ? 'static'
+                        : ($Config::Config{usedl} ? 'dynamic' : 'static');
+    };
+
+    # These get overridden for VMS and maybe some other systems
+    $self->{NOOP}  ||= "sh -c true";
+    $self->{FIRST_MAKEFILE} ||= "Makefile";
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
+    $self->{NOECHO} = '@' unless defined $self->{NOECHO};
+    $self->{RM_F}  ||= "rm -f";
+    $self->{RM_RF} ||= "rm -rf";
+    $self->{TOUCH} ||= "touch";
+    $self->{CP} ||= "cp";
+    $self->{MV} ||= "mv";
+    $self->{CHMOD} ||= "chmod";
+    $self->{UMASK_NULL} ||= "umask 0";
+}
+
+=item install (o)
+
+Defines the install target.
+
+=cut
+
+sub install {
+    my($self, %attribs) = @_;
+    my(@m);
+
+    push @m, q{
+install :: all pure_install doc_install
+
+install_perl :: all pure_perl_install doc_perl_install
+
+install_site :: all pure_site_install doc_site_install
+
+install_ :: install_site
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_install :: pure_$(INSTALLDIRS)_install
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+
+pure__install : pure_site_install
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
+		read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(INSTALLPRIVLIB) \
+		$(INST_ARCHLIB) $(INSTALLARCHLIB) \
+		$(INST_BIN) $(INSTALLBIN) \
+		$(INST_SCRIPT) $(INSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(INSTALLMAN3DIR)
+	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{
+
+
+pure_site_install ::
+	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
+		read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(INSTALLSITELIB) \
+		$(INST_ARCHLIB) $(INSTALLSITEARCH) \
+		$(INST_BIN) $(INSTALLBIN) \
+		$(INST_SCRIPT) $(INSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(INSTALLMAN3DIR)
+	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{
+
+doc_perl_install ::
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"$(NAME)" \
+		"installed into" "$(INSTALLPRIVLIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+doc_site_install ::
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"Module $(NAME)" \
+		"installed into" "$(INSTALLSITELIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+};
+
+    push @m, q{
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+
+uninstall_from_perldirs ::
+	}.$self->{NOECHO}.
+	q{$(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
+
+uninstall_from_sitedirs ::
+	}.$self->{NOECHO}.
+	q{$(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{
+};
+
+    join("",@m);
+}
+
+=item installbin (o)
+
+Defines targets to install EXE_FILES.
+
+=cut
+
+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($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
+	local($_) = $path; # for backwards compatibility
+	$to = $self->libscan($path);
+	print "libscan($from) => '$to'\n" if ($Verbose >=2);
+	$fromto{$from}=$to;
+    }
+    @to   = values %fromto;
+    push(@m, "
+EXE_FILES = @{$self->{EXE_FILES}}
+
+all :: @to
+
+realclean ::
+	$self->{RM_F} @to
+");
+
+    while (($from,$to) = each %fromto) {
+	last unless defined $from;
+	my $todir = dirname($to);
+	push @m, "
+$to: $from $self->{MAKEFILE} $todir/.exists
+	$self->{NOECHO}$self->{RM_F} $to
+	$self->{CP} $from $to
+";
+    }
+    join "", @m;
+}
+
+=item libscan (o)
+
+Takes a path to a file that is found by init_dirscan and returns false
+if we don't want to include this file in the library. Mainly used to
+exclude RCS, CVS, and SCCS directories from installation.
+
+=cut
+
+# ';
+
+sub libscan {
+    my($self,$path) = @_;
+    return '' if $path =~ m:\b(RCS|CVS|SCCS)\b: ;
+    $path;
+}
+
+=item linkext (o)
+
+Defines the linkext target which in turn defines the LINKTYPE.
+
+=cut
+
+sub linkext {
+    my($self, %attribs) = @_;
+    # LINKTYPE => static or dynamic or ''
+    my($linktype) = defined $attribs{LINKTYPE} ?
+      $attribs{LINKTYPE} : '$(LINKTYPE)';
+    "
+linkext :: $linktype
+	$self->{NOECHO}\$(NOOP)
+";
+}
+
+=item lsdir
+
+Takes as arguments a directory name and a regular expression. Returns
+all entries in the directory that match the regular expression.
+
+=cut
+
+sub lsdir {
+    my($self) = shift;
+    my($dir, $regex) = @_;
+    my(@ls);
+    my $dh = new DirHandle;
+    $dh->open($dir || ".") or return ();
+    @ls = $dh->read;
+    $dh->close;
+    @ls = grep(/$regex/, @ls) if $regex;
+    @ls;
+}
+
+=item macro (o)
+
+Simple subroutine to insert the macros defined by the macro attribute
+into the Makefile.
+
+=cut
+
+sub macro {
+    my($self,%attribs) = @_;
+    my(@m,$key,$val);
+    while (($key,$val) = each %attribs){
+	last unless defined $key;
+	push @m, "$key = $val\n";
+    }
+    join "", @m;
+}
+
+=item makeaperl (o)
+
+Called by staticmake. Defines how to write the Makefile to produce a
+static new perl.
+
+=cut
+
+sub makeaperl {
+    my($self, %attribs) = @_;
+    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
+	@attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
+    my(@m);
+    push @m, "
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = $target
+FULLPERL      = $self->{FULLPERL}
+";
+    return join '', @m if $self->{PARENT};
+
+    my($dir) = join ":", @{$self->{DIR}};
+
+    unless ($self->{MAKEAPERL}) {
+	push @m, q{
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+	$(MAKE) -f $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+	}.$self->{NOECHO}.q{echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+	}.$self->{NOECHO}.q{$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+		Makefile.PL DIR=}, $dir, q{ \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=};
+
+	foreach (@ARGV){
+		if( /\s/ ){
+			s/=(.*)/='$1'/;
+		}
+		push @m, " \\\n\t\t$_";
+	}
+#	push @m, map( " \\\n\t\t$_", @ARGV );
+	push @m, "\n";
+
+	return join '', @m;
+    }
+
+
+
+    my($cccmd, $linkcmd, $lperl);
+
+
+    $cccmd = $self->const_cccmd($libperl);
+    $cccmd =~ s/^CCCMD\s*=\s*//;
+    $cccmd =~ s/\$\(INC\)/ -I$self->{PERL_INC} /;
+    $cccmd .= " $Config::Config{cccdlflags}" if ($Config::Config{d_shrplib});
+    $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
+
+    # The front matter of the linkcommand...
+    $linkcmd = join ' ', "\$(CC)",
+	    grep($_, @Config{qw(large split ldflags ccdlflags)});
+    $linkcmd =~ s/\s+/ /g;
+
+    # Which *.a files could we make use of...
+    local(%static);
+    require File::Find;
+    File::Find::find(sub {
+	return unless m/\Q$self->{LIB_EXT}\E$/;
+	return if m/^libperl/;
+
+	if( exists $self->{INCLUDE_EXT} ){
+		my $found = 0;
+		my $incl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything not explicitly marked for inclusion.
+		# DynaLoader is implied.
+		foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
+			if( $xx eq $incl ){
+				$found++;
+				last;
+			}
+		}
+		return unless $found;
+	}
+	elsif( exists $self->{EXCLUDE_EXT} ){
+		my $excl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything explicitly marked for exclusion
+		foreach $excl (@{$self->{EXCLUDE_EXT}}){
+			return if( $xx eq $excl );
+		}
+	}
+
+	# don't include the installed version of this extension. I
+	# leave this line here, although it is not necessary anymore:
+	# I patched minimod.PL instead, so that Miniperl.pm won't
+	# enclude duplicates
+
+	# Once the patch to minimod.PL is in the distribution, I can
+	# drop it
+	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}$:;
+	use Cwd 'cwd';
+	$static{cwd() . "/" . $_}++;
+    }, grep( -d $_, @{$searchdirs || []}) );
+
+    # We trust that what has been handed in as argument, will be buildable
+    $static = [] unless $static;
+    @static{@{$static}} = (1) x @{$static};
+
+    $extra = [] unless $extra && ref $extra eq 'ARRAY';
+    for (sort keys %static) {
+	next unless /\Q$self->{LIB_EXT}\E$/;
+	$_ = dirname($_) . "/extralibs.ld";
+	push @$extra, $_;
+    }
+
+    grep(s/^/-I/, @{$perlinc || []});
+
+    $target = "perl" unless $target;
+    $tmp = "." unless $tmp;
+
+# MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we
+# regenerate the Makefiles, MAP_STATIC and the dependencies for
+# extralibs.all are computed correctly
+    push @m, "
+MAP_LINKCMD   = $linkcmd
+MAP_PERLINC   = @{$perlinc || []}
+MAP_STATIC    = ",
+join(" \\\n\t", reverse sort keys %static), "
+
+MAP_PRELIBS   = $Config::Config{libs} $Config::Config{cryptlib}
+";
+
+    if (defined $libperl) {
+	($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/;
+    }
+    unless ($libperl && -f $lperl) { # Ilya's code...
+	my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
+	$libperl ||= "libperl$self->{LIB_EXT}";
+	$libperl   = "$dir/$libperl";
+	$lperl   ||= "libperl$self->{LIB_EXT}";
+	$lperl     = "$dir/$lperl";
+	print STDOUT "Warning: $libperl not found
+    If you're going to build a static perl binary, make sure perl is installed
+    otherwise ignore this warning\n"
+		unless (-f $lperl || defined($self->{PERL_SRC}));
+    }
+
+    push @m, "
+MAP_LIBPERL = $libperl
+";
+
+    push @m, "
+\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)/.exists ".join(" \\\n\t", @$extra)."
+	$self->{NOECHO}$self->{RM_F} \$\@
+	$self->{NOECHO}\$(TOUCH) \$\@
+";
+
+    my $catfile;
+    foreach $catfile (@$extra){
+	push @m, "\tcat $catfile >> \$\@\n";
+    }
+
+    push @m, "
+\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
+	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
+	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
+	$self->{NOECHO}echo 'To remove the intermediate files say'
+	$self->{NOECHO}echo '    make -f $makefilename map_clean'
+
+$tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
+";
+    push @m, "\tcd $tmp && $cccmd -I\$(PERL_INC) perlmain.c\n";
+
+    push @m, qq{
+$tmp/perlmain.c: $makefilename}, q{
+	}.$self->{NOECHO}.q{echo Writing $@
+	}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
+		writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@.tmp && mv $@.tmp $@
+
+};
+
+    push @m, q{
+doc_inst_perl:
+	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"Perl binary $(MAP_TARGET)" \
+		MAP_STATIC "$(MAP_STATIC)" \
+		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
+		MAP_LIBPERL "$(MAP_LIBPERL)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+};
+
+    push @m, q{
+inst_perl: pure_inst_perl doc_inst_perl
+
+pure_inst_perl: $(MAP_TARGET)
+	}.$self->{CP}.q{ $(MAP_TARGET) }.$self->catfile('$(INSTALLBIN)','$(MAP_TARGET)').q{
+
+clean :: map_clean
+
+map_clean :
+	}.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
+};
+
+    join '', @m;
+}
+
+=item makefile (o)
+
+Defines how to rewrite the Makefile.
+
+=cut
+
+sub makefile {
+    my($self) = shift;
+    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, '
+$(OBJECT) : $(FIRST_MAKEFILE)
+' if $self->{OBJECT};
+
+    push @m, q{
+# We take a very conservative approach here, but it\'s worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+}.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP)
+	}.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?"
+	}.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..."
+	-}.$self->{NOECHO}.q{mv }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
+	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean >/dev/null 2>&1 || true
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{
+	}.$self->{NOECHO}.q{echo ">>> Your Makefile has been rebuilt. <<<"
+	}.$self->{NOECHO}.q{echo ">>> Please rerun the make command.  <<<"; false
+
+# To change behavior to :: would be nice, but would break Tk b9.02
+# so you find such a warning below the dist target.
+#}.$self->{MAKEFILE}.q{ :: $(VERSION_FROM)
+#	}.$self->{NOECHO}.q{echo "Warning: Makefile possibly out of date with $(VERSION_FROM)"
+};
+
+    join "", @m;
+}
+
+=item manifypods (o)
+
+Defines targets and routines to translate the pods into manpages and
+put them into the INST_* directories.
+
+=cut
+
+sub manifypods {
+    my($self, %attribs) = @_;
+    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
+    } else {
+	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
+    }
+    unless ($self->perl_script($pod2man_exe)) {
+	# No pod2man but some MAN3PODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program. Please make sure,
+         your pod2man program is in your PATH before you execute 'make'
+
+END
+        $pod2man_exe = "-S pod2man";
+    }
+    my(@m);
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
+q[POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \\
+-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "].$self->{MAKEFILE}.q[";' \\
+-e 'print "Manifying $$m{$$_}\n";' \\
+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
+-e 'chmod 0644, $$m{$$_} or warn "chmod 644 $$m{$$_}: $$!\n";}'
+];
+    push @m, "\nmanifypods : ";
+    push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
+
+    push(@m,"\n");
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t";
+	push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}};
+    }
+    join('', @m);
+}
+
+=item maybe_command
+
+Returns true, if the argument is likely to be a command.
+
+=cut
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d $file;
+    return;
+}
+
+=item maybe_command_in_dirs
+
+method under development. Not yet used. Ask Ilya :-)
+
+=cut
+
+sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
+# Ilya's suggestion. Not yet used, want to understand it first, but at least the code is here
+    my($self, $names, $dirs, $trace, $ver) = @_;
+    my($name, $dir);
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my($abs,$tryabs);
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # bar
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->catfile($self->curdir, $name);
+	    }
+	    print "Checking $abs for $name\n" if ($trace >= 2);
+	    next unless $tryabs = $self->maybe_command($abs);
+	    print "Substituting $tryabs instead of $abs\n"
+		if ($trace >= 2 and $tryabs ne $abs);
+	    $abs = $tryabs;
+	    if (defined $ver) {
+		print "Executing $abs\n" if ($trace >= 2);
+		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+		    print "Using PERL=$abs\n" if $trace;
+		    return $abs;
+		}
+	    } else { # Do not look for perl
+		return $abs;
+	    }
+	}
+    }
+}
+
+=item needs_linking (o)
+
+Does this module need linking? Looks into subdirectory objects (see
+also has_link_code())
+
+=cut
+
+sub needs_linking {
+    my($self) = shift;
+    my($child,$caller);
+    $caller = (caller(0))[3];
+    Carp::confess("Needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/;
+    return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING};
+    if ($self->has_link_code or $self->{MAKEAPERL}){
+	$self->{NEEDS_LINKING} = 1;
+	return 1;
+    }
+    foreach $child (keys %{$self->{CHILDREN}}) {
+	if ($self->{CHILDREN}->{$child}->needs_linking) {
+	    $self->{NEEDS_LINKING} = 1;
+	    return 1;
+	}
+    }
+    return $self->{NEEDS_LINKING} = 0;
+}
+
+=item nicetext
+
+misnamed method (will have to be changed). The MM_Unix method just
+returns the argument without further processing.
+
+On VMS used to insure that colons marking targets are preceded by
+space - most Unix Makes don't need this, but it's necessary under VMS
+to distinguish the target delimiter from a colon appearing as part of
+a filespec.
+
+=cut
+
+sub nicetext {
+    my($self,$text) = @_;
+    $text;
+}
+
+=item parse_version
+
+parse a file and return what you think is $VERSION in this file set to
+
+=cut
+
+sub parse_version {
+    my($self,$parsefile) = @_;
+    my $result;
+    local *FH;
+    local $/ = "\n";
+    open(FH,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    while (<FH>) {
+	$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+	next if $inpod;
+	chop;
+	next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
+	local $ExtUtils::MakeMaker::module_version_variable = $1;
+	my($thispackage) = $2 || $current_package;
+	$thispackage =~ s/:+$//;
+	my($eval) = "$_;";
+	eval $eval;
+	die "Could not eval '$eval' in $parsefile: $@" if $@;
+	$result = $ {$ExtUtils::MakeMaker::module_version_variable} || 0;
+	last;
+    }
+    close FH;
+    return $result;
+}
+
+
+=item pasthru (o)
+
+Defines the string that is passed to recursive make calls in
+subdirectories.
+
+=cut
+
+sub pasthru {
+    my($self) = shift;
+    my(@m,$key);
+
+    my(@pasthru);
+
+    foreach $key (qw(LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){
+	push @pasthru, "$key=\"\$($key)\"";
+    }
+
+    push @m, "\nPASTHRU = ", join ("\\\n\t", @pasthru), "\n";
+    join "", @m;
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+    my($self) = @_;
+    my $path_sep = $Is_OS2 ? ";" : ":";
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g if $Is_OS2;
+    my @path = split $path_sep, $path;
+}
+
+=item perl_script
+
+Takes one argument, a file name, and returns the file name, if the
+argument is likely to be a perl script. On MM_Unix this is true for
+any ordinary, readable file.
+
+=cut
+
+sub perl_script {
+    my($self,$file) = @_;
+    return $file if -r $file && -f _;
+    return;
+}
+
+=item perldepend (o)
+
+Defines the dependency from all *.h files that come with the perl
+distribution.
+
+=cut
+
+sub perldepend {
+    my($self) = shift;
+    my(@m);
+    push @m, q{
+# 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!
+$(PERL_INC)/config.h: $(PERL_SRC)/config.sh
+	-}.$self->{NOECHO}.q{echo "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; false
+
+$(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh
+	}.$self->{NOECHO}.q{echo "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh"
+	cd $(PERL_SRC) && $(MAKE) lib/Config.pm
+} if $self->{PERL_SRC};
+
+    return join "", @m unless $self->needs_linking;
+
+    push @m, q{
+PERL_HDRS = \
+$(PERL_INC)/EXTERN.h       $(PERL_INC)/gv.h           $(PERL_INC)/pp.h       \
+$(PERL_INC)/INTERN.h       $(PERL_INC)/handy.h        $(PERL_INC)/proto.h    \
+$(PERL_INC)/XSUB.h         $(PERL_INC)/hv.h           $(PERL_INC)/regcomp.h  \
+$(PERL_INC)/av.h           $(PERL_INC)/keywords.h     $(PERL_INC)/regexp.h   \
+$(PERL_INC)/config.h       $(PERL_INC)/mg.h           $(PERL_INC)/scope.h    \
+$(PERL_INC)/cop.h          $(PERL_INC)/op.h           $(PERL_INC)/sv.h	     \
+$(PERL_INC)/cv.h           $(PERL_INC)/opcode.h       $(PERL_INC)/unixish.h  \
+$(PERL_INC)/dosish.h       $(PERL_INC)/patchlevel.h   $(PERL_INC)/util.h     \
+$(PERL_INC)/embed.h        $(PERL_INC)/perl.h				     \
+$(PERL_INC)/form.h         $(PERL_INC)/perly.h
+
+$(OBJECT) : $(PERL_HDRS)
+} if $self->{OBJECT};
+
+    push @m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n"  if %{$self->{XS}};
+
+    join "\n", @m;
+}
+
+=item pm_to_blib
+
+Defines target that copies all files in the hash PM to their
+destination and autosplits them. See L<ExtUtils::Install/pm_to_blib>
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
+    return q{
+pm_to_blib: $(TO_INST_PM)
+	}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
+	"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
+        -e 'pm_to_blib({qw{$(PM_TO_BLIB)}},"}.$autodir.q{")'
+	}.$self->{NOECHO}.q{$(TOUCH) $@
+};
+}
+
+=item post_constants (o)
+
+Returns an empty string per default. Dedicated to overrides from
+within Makefile.PL after all constants have been defined.
+
+=cut
+
+sub post_constants{
+    my($self) = shift;
+    "";
+}
+
+=item post_initialize (o)
+
+Returns an ampty string per default. Used in Makefile.PLs to add some
+chunk of text to the Makefile after the object is initialized.
+
+=cut
+
+sub post_initialize {
+    my($self) = shift;
+    "";
+}
+
+=item postamble (o)
+
+Returns an empty string. Can be used in Makefile.PLs to write some
+text to the Makefile at the end.
+
+=cut
+
+sub postamble {
+    my($self) = shift;
+    "";
+}
+
+=item prefixify
+
+Check a path variable in $self from %Config, if it contains a prefix,
+and replace it with another one.
+
+Takes as arguments an attribute name, a search prefix and a
+replacement prefix. Changes the attribute in the object.
+
+=cut
+
+sub prefixify {
+    my($self,$var,$sprefix,$rprefix) = @_;
+    $self->{uc $var} ||= $Config{lc $var};
+    $self->{uc $var} = VMS::Filespec::unixpath($self->{uc $var}) if $Is_VMS;
+    $self->{uc $var} =~ s/\Q$sprefix\E/$rprefix/;
+}
+
+=item processPL (o)
+
+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}}) {
+	push @m, "
+all :: $self->{PL_FILES}->{$plfile}
+
+$self->{PL_FILES}->{$plfile} :: $plfile
+	\$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
+";
+    }
+    join "", @m;
+}
+
+=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 subdirectories first (already cleaned)
+    my $sub = "\t-cd %s && test -f %s && \$(MAKE) %s realclean\n";
+    foreach(@{$self->{DIR}}){
+	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old"));
+	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",''));
+    }
+    push(@m, "	$self->{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n");
+    if( $self->has_link_code ){
+        push(@m, "	$self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n");
+        push(@m, "	$self->{RM_F} \$(INST_STATIC)\n");
+    }
+    push(@m, "	$self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n");
+    my(@otherfiles) = ($self->{MAKEFILE},
+		       "$self->{MAKEFILE}.old"); # Makefiles last
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@m, "	$self->{RM_RF} @otherfiles\n") if @otherfiles;
+    push(@m, "	$attribs{POSTOP}\n")       if $attribs{POSTOP};
+    join("", @m);
+}
+
+=item replace_manpage_separator
+
+Takes the name of a package, which may be a nested package, in the
+form Foo/Bar and replaces the slash with C<::>. Returns the replacement.
+
+=cut
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,::,g;
+    $man;
+}
+
+=item static (o)
+
+Defines the static target.
+
+=cut
+
+sub static {
+# --- Static Loading Sections ---
+
+    my($self) = shift;
+    '
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+#static :: '.$self->{MAKEFILE}.' $(INST_STATIC) $(INST_PM)
+static :: '.$self->{MAKEFILE}.' $(INST_STATIC)
+	'.$self->{NOECHO}.'$(NOOP)
+';
+}
+
+=item static_lib (o)
+
+Defines how to produce the *.a (or equivalent) files.
+
+=cut
+
+sub static_lib {
+    my($self) = @_;
+# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
+#    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my(@m);
+    push(@m, <<'END');
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+	$(RM_RF) $@
+END
+    # If this extension has it's own library (eg SDBM_File)
+    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
+    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
+
+    push @m,
+q{	$(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+	$(CHMOD) 755 $@
+};
+
+# Old mechanism - still available:
+
+    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n"
+	if $self->{PERL_SRC};
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('', "\n",@m);
+}
+
+=item staticmake (o)
+
+Calls makeaperl.
+
+=cut
+
+sub staticmake {
+    my($self, %attribs) = @_;
+    my(@static);
+
+    my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP},  $self->{INST_ARCHLIB});
+
+    # And as it's not yet built, we add the current extension
+    # but only if it has some C code (or XS code, which implies C code)
+    if (@{$self->{C}}) {
+	@static = $self->catfile($self->{INST_ARCHLIB},
+				 "auto",
+				 $self->{FULLEXT},
+				 "$self->{BASEEXT}$self->{LIB_EXT}"
+				);
+    }
+
+    # Either we determine now, which libraries we will produce in the
+    # subdirectories or we do it at runtime of the make.
+
+    # We could ask all subdir objects, but I cannot imagine, why it
+    # would be necessary.
+
+    # Instead we determine all libraries for the new perl at
+    # runtime.
+    my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB});
+
+    $self->makeaperl(MAKE	=> $self->{MAKEFILE},
+		     DIRS	=> \@searchdirs,
+		     STAT	=> \@static,
+		     INCL	=> \@perlinc,
+		     TARGET	=> $self->{MAP_TARGET},
+		     TMP	=> "",
+		     LIBPERL	=> $self->{LIBPERL_A}
+		    );
+}
+
+=item subdir_x (o)
+
+Helper subroutine for subdirs
+
+=cut
+
+sub subdir_x {
+    my($self, $subdir) = @_;
+    my(@m);
+    qq{
+
+subdirs ::
+	$self->{NOECHO}cd $subdir && \$(MAKE) all \$(PASTHRU)
+
+};
+}
+
+=item subdirs (o)
+
+Defines targets to process subdirectories.
+
+=cut
+
+sub subdirs {
+# --- Sub-directory Sections ---
+    my($self) = shift;
+    my(@m,$dir);
+    # This method provides a mechanism to automatically deal with
+    # subdirectories containing further Makefile.PL scripts.
+    # It calls the subdir_x() method for each subdirectory.
+    foreach $dir (@{$self->{DIR}}){
+	push(@m, $self->subdir_x($dir));
+####	print "Including $dir subdirectory\n";
+    }
+    if (@m){
+	unshift(@m, "
+# The default clean, realclean and test targets in this Makefile
+# have automatically been given entries for each subdir.
+
+");
+    } else {
+	push(@m, "\n# none")
+    }
+    join('',@m);
+}
+
+=item test (o)
+
+Defines the test targets.
+
+=cut
+
+sub test {
+# --- Test and Installation Sections ---
+
+    my($self, %attribs) = @_;
+    my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : "");
+    my(@m);
+    push(@m,"
+TEST_VERBOSE=0
+TEST_TYPE=test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TESTDB_SW = -d
+
+testdb :: testdb_\$(LINKTYPE)
+
+test :: \$(TEST_TYPE)
+");
+    push(@m, map("\t$self->{NOECHO}cd $_ && test -f $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n",
+		 @{$self->{DIR}}));
+    push(@m, "\t$self->{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('$(FULLPERL)', $tests)) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "\n");
+
+    push(@m, "testdb_dynamic :: pure_all\n");
+    push(@m, $self->test_via_script('$(FULLPERL) $(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";
+	push @m, "testdb_static :: testdb_dynamic\n";
+    }
+    join("", @m);
+}
+
+=item test_via_harness (o)
+
+Helper method to write the test targets
+
+=cut
+
+sub test_via_harness {
+    my($self, $perl, $tests) = @_;
+    "\tPERL_DL_NONLAZY=1 $perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n";
+}
+
+=item test_via_script (o)
+
+Other helper method for test.
+
+=cut
+
+sub test_via_script {
+    my($self, $perl, $script) = @_;
+    qq{\tPERL_DL_NONLAZY=1 $perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script
+};
+}
+
+=item tool_autosplit (o)
+
+Defines a simple perl call that runs autosplit. May be deprecated by
+pm_to_blib soon.
+
+=cut
+
+sub tool_autosplit {
+# --- Tool Sections ---
+
+    my($self, %attribs) = @_;
+    my($asl) = "";
+    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
+    q{
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;}.$asl.q{autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
+};
+}
+
+=item tools_other (o)
+
+Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
+the Makefile. Also defines the perl programs MKPATH,
+WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
+
+=cut
+
+sub tools_other {
+    my($self) = shift;
+    my @m;
+    my $bin_sh = $Config{sh} || '/bin/sh';
+    push @m, qq{
+SHELL = $bin_sh
+};
+
+    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TOUCH UMASK_NULL / ) {
+	push @m, "$_ = $self->{$_}\n";
+    }
+
+
+    push @m, q{
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\
+-e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\
+-e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\
+-e 'mkdir("@p",0777)||die $$! } } exit 0;'
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -we 'open F, ">$$ARGV[1]"; close F;' \\
+-e 'utime ((stat("$$ARGV[0]"))[8,9], $$ARGV[1])'
+};
+
+    return join "", @m if $self->{PARENT};
+
+    push @m, q{
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\
+-e 'print "WARNING: I have found an old package in\n";' \\
+-e 'print "\t$$ARGV[0].\n";' \\
+-e 'print "Please make sure the two installations are not conflicting\n";'
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e 'install({@ARGV},"$(VERBINST)",0,"$(UNINST)");'
+
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";print "=head3 ", scalar(localtime), ": C<", shift, ">";' \
+-e 'print "=over 4";' \
+-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
+-e 'print "=back";'
+
+UNINSTALL =   $(PERL) -MExtUtils::Install \
+-e 'uninstall($$ARGV[0],1);'
+
+};
+
+    return join "", @m;
+}
+
+=item tool_xsubpp (o)
+
+Determines typemaps, xsubpp version, prototype behaviour.
+
+=cut
+
+sub tool_xsubpp {
+    my($self) = shift;
+    return "" unless $self->needs_linking;
+    my($xsdir)  = $self->catdir($self->{PERL_LIB},"ExtUtils");
+    my(@tmdeps) = $self->catdir('$(XSUBPPDIR)','typemap');
+    if( $self->{TYPEMAPS} ){
+	my $typemap;
+	foreach $typemap (@{$self->{TYPEMAPS}}){
+		if( ! -f  $typemap ){
+			warn "Typemap $typemap not found.\n";
+		}
+		else{
+			push(@tmdeps,  $typemap);
+		}
+	}
+    }
+    push(@tmdeps, "typemap") if -f "typemap";
+    my(@tmargs) = map("-typemap $_", @tmdeps);
+    if( exists $self->{XSOPT} ){
+ 	unshift( @tmargs, $self->{XSOPT} );
+    }
+
+
+    my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,"xsubpp"));
+
+    # What are the correct thresholds for version 1 && 2 Paul?
+    if ( $xsubpp_version > 1.923 ){
+	$self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
+    } else {
+	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
+	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
+	Your version of xsubpp is $xsubpp_version and cannot handle this.
+	Please upgrade to a more recent version of xsubpp.
+};
+	} else {
+	    $self->{XSPROTOARG} = "";
+	}
+    }
+
+    return qq{
+XSUBPPDIR = $xsdir
+XSUBPP = \$(XSUBPPDIR)/xsubpp
+XSPROTOARG = $self->{XSPROTOARG}
+XSUBPPDEPS = @tmdeps
+XSUBPPARGS = @tmargs
+};
+};
+
+sub xsubpp_version
+{
+    my($self,$xsubpp) = @_;
+    return $Xsubpp_Version if defined $Xsubpp_Version; # global variable
+
+    my ($version) ;
+
+    # try to figure out the version number of the xsubpp on the system
+
+    # first try the -v flag, introduced in 1.921 & 2.000a2
+
+    return "" unless $self->needs_linking;
+
+    my $command = "$self->{PERL} -I$self->{PERL_LIB} $xsubpp -v 2>&1";
+    print "Running $command\n" if $Verbose >= 2;
+    $version = `$command` ;
+    warn "Running '$command' exits with status " . ($?>>8) if $?;
+    chop $version ;
+
+    return $Xsubpp_Version = $1 if $version =~ /^xsubpp version (.*)/ ;
+
+    # nope, then try something else
+
+    my $counter = '000';
+    my ($file) = 'temp' ;
+    $counter++ while -e "$file$counter"; # don't overwrite anything
+    $file .= $counter;
+
+    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
+    print F <<EOM ;
+MODULE = fred PACKAGE = fred
+
+int
+fred(a)
+        int     a;
+EOM
+
+    close F ;
+
+    $command = "$self->{PERL} $xsubpp $file 2>&1";
+    print "Running $command\n" if $Verbose >= 2;
+    my $text = `$command` ;
+    warn "Running '$command' exits with status " . ($?>>8) if $?;
+    unlink $file ;
+
+    # gets 1.2 -> 1.92 and 2.000a1
+    return $Xsubpp_Version = $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+
+    # it is either 1.0 or 1.1
+    return $Xsubpp_Version = 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+
+    # none of the above, so 1.0
+    return $Xsubpp_Version = "1.0" ;
+}
+
+=item top_targets (o)
+
+Defines the targets all, subdirs, config, and O_FILES
+
+=cut
+
+sub top_targets {
+# --- Target Sections ---
+
+    my($self) = shift;
+    my(@m);
+    push @m, '
+#all ::	config $(INST_PM) subdirs linkext manifypods
+
+all :: pure_all manifypods
+	'.$self->{NOECHO}.'$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+	'.$self->{NOECHO}.'$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: $(INST_ARCHAUTODIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: $(INST_AUTODIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+';
+
+    push @m, qq{
+config :: Version_check
+	$self->{NOECHO}\$(NOOP)
+
+} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
+
+    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
+
+    if (%{$self->{MAN1PODS}}) {
+	push @m, qq[
+config :: \$(INST_MAN1DIR)/.exists
+	$self->{NOECHO}\$(NOOP)
+
+];
+	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    }
+    if (%{$self->{MAN3PODS}}) {
+	push @m, qq[
+config :: \$(INST_MAN3DIR)/.exists
+	$self->{NOECHO}\$(NOOP)
+
+];
+	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
+    }
+
+    push @m, '
+$(O_FILES): $(H_FILES)
+' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
+
+    push @m, q{
+help:
+	perldoc ExtUtils::MakeMaker
+};
+
+    push @m, q{
+Version_check:
+	}.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+		-MExtUtils::MakeMaker=Version_check \
+		-e 'Version_check("$(MM_VERSION)")'
+};
+
+    join('',@m);
+}
+
+=item writedoc
+
+Obsolete, depecated method. Not used since Version 5.21.
+
+=cut
+
+sub writedoc {
+# --- perllocal.pod section ---
+    my($self,$what,$name,@attribs)=@_;
+    my $time = localtime;
+    print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n";
+    print join "\n\n=item *\n\n", map("C<$_>",@attribs);
+    print "\n\n=back\n\n";
+}
+
+=item xs_c (o)
+
+Defines the suffix rules to compile XS files to C.
+
+=cut
+
+sub xs_c {
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    '
+.xs.c:
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && mv $*.tc $@
+';
+}
+
+=item xs_o (o)
+
+Defines suffix rules to go from XS to object files directly. This is
+only intended for broken make implementations.
+
+=cut
+
+sub xs_o {	# many makes are too dumb to use xs_c then c_o
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    '
+.xs$(OBJ_EXT):
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+';
+}
+
+1;
+
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+__END__
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
new file mode 100644
index 00000000000..9a382284d11
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
@@ -0,0 +1,2254 @@
+#   MM_VMS.pm
+#   MakeMaker default methods for VMS
+#   This package is inserted into @ISA of MakeMaker's MM before the
+#   built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
+#
+#   Author:  Charles Bailey  bailey@genetics.upenn.edu
+
+package ExtUtils::MM_VMS;
+$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.35 (23-Jun-1996)';
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
+use Config;
+require Exporter;
+use VMS::Filespec;
+use File::Basename;
+
+Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
+
+=head1 NAME
+
+ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_VMS; # Done internally by ExtUtils::MakeMaker if needed
+
+=head1 DESCRIPTION
+
+See ExtUtils::MM_Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=head2 Methods always loaded
+
+=item eliminate_macros
+
+Expands MM[KS]/Make macros in a text string, using the contents of
+identically named elements of C<%$self>, and returns the result
+as a file specification in Unix syntax.
+
+=cut
+
+sub eliminate_macros {
+    my($self,$path) = @_;
+    unless ($path) {
+	print "eliminate_macros('') = ||\n" if $Verbose >= 3;
+	return '';
+    }
+    my($npath) = unixify($path);
+    my($head,$macro,$tail);
+
+    # perform m##g in scalar context so it acts as an iterator
+    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { 
+        if ($self->{$2}) {
+            ($head,$macro,$tail) = ($1,$2,$3);
+            ($macro = unixify($self->{$macro})) =~ s#/$##;
+            $npath = "$head$macro$tail";
+        }
+    }
+    print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
+    $npath;
+}
+
+=item fixpath
+
+Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
+in any directory specification, in order to avoid juxtaposing two
+VMS-syntax directories when MM[SK] is run.  Also expands expressions which
+are all macro, so that we can tell how long the expansion is, and avoid
+overrunning DCL's command buffer when MM[KS] is running.
+
+If optional second argument has a TRUE value, then the return string is
+a VMS-syntax directory specification, otherwise it is a VMS-syntax file
+specification.
+
+=cut
+
+sub fixpath {
+    my($self,$path,$force_path) = @_;
+    unless ($path) {
+	print "eliminate_macros('') = ||\n" if $Verbose >= 3;
+	return '';
+    }
+    my($fixedpath,$prefix,$name);
+
+    if ($path =~ m#^\$\(.+\)$# || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])$/) {
+            $fixedpath = vmspath($self->eliminate_macros($path));
+        }
+        else {
+            $fixedpath = vmsify($self->eliminate_macros($path));
+        }
+    }
+    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
+        my($vmspre) = vmspath($self->{$prefix}) || ''; # is it a dir or just a name?
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # Convert names without directory or type to paths
+    if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
+    print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
+    $fixedpath;
+}
+
+=item catdir
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax directory specification.
+
+=cut
+
+sub catdir {
+    my($self,@dirs) = @_;
+    my($dir) = pop @dirs;
+    @dirs = grep($_,@dirs);
+    my($rslt);
+    if (@dirs) {
+      my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+      my($spath,$sdir) = ($path,$dir);
+      $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
+      $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
+      $rslt = vmspath($self->eliminate_macros($spath)."/$sdir");
+    }
+    else { $rslt = vmspath($dir); }
+    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
+    $rslt;
+}
+
+=item catfile
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax directory specification.
+
+=cut
+
+sub catfile {
+    my($self,@files) = @_;
+    my($file) = pop @files;
+    @files = grep($_,@files);
+    my($rslt);
+    if (@files) {
+      my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
+      my($spath) = $path;
+      $spath =~ s/.dir$//;
+      if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
+      else {
+          $rslt = $self->eliminate_macros($spath);
+          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+      }
+    }
+    else { $rslt = vmsify($file); }
+    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
+    $rslt;
+}
+
+=item curdir (override)
+
+Returns a string representing of the current directory.
+
+=cut
+
+sub curdir {
+    return '[]';
+}
+
+=item rootdir (override)
+
+Returns a string representing of the root directory.
+
+=cut
+
+sub rootdir {
+    return '';
+}
+
+=item updir (override)
+
+Returns a string representing of the parent directory.
+
+=cut
+
+sub updir {
+    return '[-]';
+}
+
+package ExtUtils::MM_VMS;
+
+sub ExtUtils::MM_VMS::guess_name;
+sub ExtUtils::MM_VMS::find_perl;
+sub ExtUtils::MM_VMS::path;
+sub ExtUtils::MM_VMS::maybe_command;
+sub ExtUtils::MM_VMS::maybe_command_in_dirs;
+sub ExtUtils::MM_VMS::perl_script;
+sub ExtUtils::MM_VMS::file_name_is_absolute;
+sub ExtUtils::MM_VMS::replace_manpage_separator;
+sub ExtUtils::MM_VMS::init_others;
+sub ExtUtils::MM_VMS::constants;
+sub ExtUtils::MM_VMS::const_loadlibs;
+sub ExtUtils::MM_VMS::cflags;
+sub ExtUtils::MM_VMS::const_cccmd;
+sub ExtUtils::MM_VMS::pm_to_blib;
+sub ExtUtils::MM_VMS::tool_autosplit;
+sub ExtUtils::MM_VMS::tool_xsubpp;
+sub ExtUtils::MM_VMS::xsubpp_version;
+sub ExtUtils::MM_VMS::tools_other;
+sub ExtUtils::MM_VMS::dist;
+sub ExtUtils::MM_VMS::c_o;
+sub ExtUtils::MM_VMS::xs_c;
+sub ExtUtils::MM_VMS::xs_o;
+sub ExtUtils::MM_VMS::top_targets;
+sub ExtUtils::MM_VMS::dlsyms;
+sub ExtUtils::MM_VMS::dynamic_lib;
+sub ExtUtils::MM_VMS::dynamic_bs;
+sub ExtUtils::MM_VMS::static_lib;
+sub ExtUtils::MM_VMS::manifypods;
+sub ExtUtils::MM_VMS::processPL;
+sub ExtUtils::MM_VMS::installbin;
+sub ExtUtils::MM_VMS::subdir_x;
+sub ExtUtils::MM_VMS::clean;
+sub ExtUtils::MM_VMS::realclean;
+sub ExtUtils::MM_VMS::dist_basics;
+sub ExtUtils::MM_VMS::dist_core;
+sub ExtUtils::MM_VMS::dist_dir;
+sub ExtUtils::MM_VMS::dist_test;
+sub ExtUtils::MM_VMS::install;
+sub ExtUtils::MM_VMS::perldepend;
+sub ExtUtils::MM_VMS::makefile;
+sub ExtUtils::MM_VMS::test;
+sub ExtUtils::MM_VMS::test_via_harness;
+sub ExtUtils::MM_VMS::test_via_script;
+sub ExtUtils::MM_VMS::makeaperl;
+sub ExtUtils::MM_VMS::ext;
+sub ExtUtils::MM_VMS::nicetext;
+
+#use SelfLoader;
+sub AUTOLOAD {
+    my $code;
+    if (defined fileno(DATA)) {
+	my $fh = select DATA;
+	my $o = $/;			# For future reads from the file.
+	$/ = "\n__END__\n";
+	$code = <DATA>;
+	$/ = $o;
+	select $fh;
+	close DATA;
+	eval $code;
+	if ($@) {
+	    $@ =~ s/ at .*\n//;
+	    Carp::croak $@;
+	}
+    } else {
+	warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; 
+    }
+    defined(&$AUTOLOAD) or die "Myloader inconsistency error";
+    goto &$AUTOLOAD;
+}
+
+1;
+
+#__DATA__
+
+=head2 SelfLoaded methods
+
+Those methods which override default MM_Unix methods are marked
+"(override)", while methods unique to MM_VMS are marked "(specific)".
+For overridden methods, documentation is limited to an explanation
+of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
+documentation for more details.
+
+=item guess_name (override)
+
+Try to determine name of extension being built.  We begin with the name
+of the current directory.  Since VMS filenames are case-insensitive,
+however, we look for a F<.pm> file whose name matches that of the current
+directory (presumably the 'main' F<.pm> file for this extension), and try
+to find a C<package> statement from which to obtain the Mixed::Case
+package name.
+
+=cut
+
+sub guess_name {
+    my($self) = @_;
+    my($defname,$defpm);
+    local *PM;
+
+    $defname = basename(fileify($ENV{'DEFAULT'}));
+    $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
+    $defpm = $defname;
+    if (open(PM,"${defpm}.pm")){
+        while (<PM>) {
+            if (/^\s*package\s+([^;]+)/i) {
+                $defname = $1;
+                last;
+            }
+        }
+        print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
+                     "defaulting package name to $defname\n"
+            if eof(PM);
+        close PM;
+    }
+    else {
+        print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
+                     "defaulting package name to $defname\n";
+    }
+    $defname =~ s#[\d.\-_]+$##;
+    $defname;
+}
+
+=item find_perl (override)
+
+Use VMS file specification syntax and CLI commands to find and
+invoke Perl images.
+
+=cut
+
+sub find_perl{
+    my($self, $ver, $names, $dirs, $trace) = @_;
+    my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
+    # Check in relative directories first, so we pick up the current
+    # version of Perl if we're running MakeMaker as part of the main build.
+    @sdirs = sort { my($absb) = file_name_is_absolute($a);
+                    my($absb) = file_name_is_absolute($b);
+                    if ($absa && $absb) { return $a cmp $b }
+                    else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
+                  } @$dirs;
+    # Check miniperl before perl, and check names likely to contain
+    # version numbers before "generic" names, so we pick up an
+    # executable that's less likely to be from an old installation.
+    @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
+                     my($bb) = $b =~ m!([^:>\]/]+)$!;
+                     substr($ba,0,1) cmp substr($bb,0,1)
+                     or -1*(length($ba) <=> length($bb)) } @$names;
+    if ($trace){
+	print "Looking for perl $ver by these names:\n";
+	print "\t@snames,\n";
+	print "in these dirs:\n";
+	print "\t@sdirs\n";
+    }
+    foreach $dir (@sdirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@snames){
+	    if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
+	    else                     { push(@cand,$self->fixpath($name));      }
+	}
+    }
+    foreach $name (@cand) {
+	print "Checking $name\n" if ($trace >= 2);
+	next unless $vmsfile = $self->maybe_command($name);
+	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
+	print "Executing $vmsfile\n" if ($trace >= 2);
+	if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+	    print "Using PERL=MCR $vmsfile\n" if $trace;
+	    return "MCR $vmsfile"
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+=item path (override)
+
+Translate logical name DCL$PATH as a searchlist, rather than trying
+to C<split> string value of C<$ENV{'PATH'}>.
+
+=cut
+
+sub path {
+    my(@dirs,$dir,$i);
+    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
+    @dirs;
+}
+
+=item maybe_command (override)
+
+Follows VMS naming conventions for executable files.
+If the name passed in doesn't exactly match an executable file,
+appends F<.Exe> to check for executable image, and F<.Com> to check
+for DCL procedure.  If this fails, checks F<Sys$Share:> for an
+executable file having the name specified.  Finally, appends F<.Exe>
+and checks again.
+
+=cut
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d _;
+    return "$file.exe" if -x "$file.exe";
+    return "$file.com" if -x "$file.com";
+    if ($file !~ m![/:>\]]!) {
+	my($shrfile) = 'Sys$Share:' . $file;
+	return $file if -x $shrfile && ! -d _;
+	return "$file.exe" if -x "$shrfile.exe";
+    }
+    return 0;
+}
+
+=item maybe_command_in_dirs (override)
+
+Uses DCL argument quoting on test command line.
+
+=cut
+
+sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
+    my($self, $names, $dirs, $trace, $ver) = @_;
+    my($name, $dir);
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my($abs,$tryabs);
+	    if ($self->file_name_is_absolute($name)) {
+		$abs = $name;
+	    } else {
+		$abs = $self->catfile($dir, $name);
+	    }
+	    print "Checking $abs for $name\n" if ($trace >= 2);
+	    next unless $tryabs = $self->maybe_command($abs);
+	    print "Substituting $tryabs instead of $abs\n" 
+		if ($trace >= 2 and $tryabs ne $abs);
+	    $abs = $tryabs;
+	    if (defined $ver) {
+		print "Executing $abs\n" if ($trace >= 2);
+		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+		    print "Using PERL=$abs\n" if $trace;
+		    return $abs;
+		}
+	    } else { # Do not look for perl
+		return $abs;
+	    }
+	}
+    }
+}
+
+=item perl_script (override)
+
+If name passed in doesn't specify a readable file, appends F<.pl> and
+tries again, since it's customary to have file types on all files
+under VMS.
+
+=cut
+
+sub perl_script {
+    my($self,$file) = @_;
+    return $file if -r $file && ! -d _;
+    return "$file.pl" if -r "$file.pl" && ! -d _;
+    return '';
+}
+
+=item file_name_is_absolute (override)
+
+Checks for VMS directory spec as well as Unix separators.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file);
+    $file =~ m!^/! or $file =~ m![:<\[][^.\-]!;
+}
+
+=item replace_manpage_separator
+
+Use as separator a character which is legal in a VMS-syntax file name.
+
+=cut
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man = unixify($man);
+    $man =~ s#/+#__#g;
+    $man;
+}
+
+=item init_others (override)
+
+Provide VMS-specific forms of various utility commands, then hand
+off to the default MM_Unix method.
+
+=cut
+
+sub init_others {
+    my($self) = @_;
+
+    $self->{NOOP} = "\t@ Continue";
+    $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS';
+    $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{NOECHO} ||= '@ ';
+    $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"';
+    $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
+    $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"';
+    $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
+    $self->{CP} = 'Copy/NoConfirm';
+    $self->{MV} = 'Rename/NoConfirm';
+    $self->{UMASK_NULL} = "\t!";  
+    &ExtUtils::MM_Unix::init_others;
+}
+
+=item constants (override)
+
+Fixes up numerous file and directory macros to insure VMS syntax
+regardless of input syntax.  Also adds a few VMS-specific macros
+and makes lists of files comma-separated.
+
+=cut
+
+sub constants {
+    my($self) = @_;
+    my(@m,$def,$macro);
+
+    if ($self->{DEFINE} ne '') {
+	my(@defs) = split(/\s+/,$self->{DEFINE});
+	foreach $def (@defs) {
+	    next unless $def;
+	    $def =~ s/^-D//;
+	    $def = "\"$def\"" if $def =~ /=/;
+	}
+	$self->{DEFINE} = join ',',@defs;
+    }
+
+    if ($self->{OBJECT} =~ /\s/) {
+	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
+	$self->{OBJECT} = map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}));
+    }
+    $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
+
+    if ($self->{'INC'} && $self->{INC} !~ m!/Include=!i) {
+	my(@val) = ( '/Include=(' );
+	my(@includes) = split(/\s+/,$self->{INC});
+	my($plural);
+	foreach (@includes) {
+	    s/^-I//;
+	    push @val,', ' if $plural++;
+	    push @val,$self->fixpath($_,1);
+	}
+	$self->{INC} = join('',@val,')');
+    }
+
+    # Fix up directory specs
+    $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1)
+                                        : '[]';
+    foreach $macro ( qw [
+            INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB
+            INSTALLARCHLIB INSTALLSCRIPT INSTALLBIN PERL_LIB PERL_ARCHLIB
+            PERL_INC PERL_SRC FULLEXT INST_MAN1DIR INSTALLMAN1DIR
+            INST_MAN3DIR INSTALLMAN3DIR INSTALLSITELIB INSTALLSITEARCH
+            SITELIBEXP SITEARCHEXP ] ) {
+	next unless defined $self->{$macro};
+	$self->{$macro} = $self->fixpath($self->{$macro},1);
+    }
+    $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC},q(VMS))
+	if ($self->{PERL_SRC});
+                        
+
+
+    # Fix up file specs
+    foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
+	next unless defined $self->{$macro};
+	$self->{$macro} = $self->fixpath($self->{$macro});
+    }
+
+    foreach $macro (qw/
+	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION
+	      INST_BIN INST_EXE INST_LIB INST_ARCHLIB INST_SCRIPT PREFIX
+	      INSTALLDIRS INSTALLPRIVLIB  INSTALLARCHLIB INSTALLSITELIB
+	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
+	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
+	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS
+	      PERL_INC PERL FULLPERL
+	      / ) {
+	next unless defined $self->{$macro};
+	push @m, "$macro = $self->{$macro}\n";
+    }
+
+
+    push @m, q[
+VERSION_MACRO = VERSION
+DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)"""
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)"""
+
+MAKEMAKER = ],$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[
+MM_VERSION = $ExtUtils::MakeMaker::VERSION
+MM_REVISION = $ExtUtils::MakeMaker::Revision
+MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
+
+# FULLEXT = Pathname for extension directory (eg DBD/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT.
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+];
+
+    for $tmp (qw/
+	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
+	      LDFROM LINKTYPE
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    for $tmp (qw/ XS MAN1PODS MAN3PODS PM /) {
+	next unless defined $self->{$tmp};
+	my(%tmp,$key);
+	for $key (keys %{$self->{$tmp}}) {
+	    $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key});
+	}
+	$self->{$tmp} = \%tmp;
+    }
+
+    for $tmp (qw/ C O_FILES H /) {
+	next unless defined $self->{$tmp};
+	my(@tmp,$val);
+	for $val (@{$self->{$tmp}}) {
+	    push(@tmp,$self->fixpath($val));
+	}
+	$self->{$tmp} = \@tmp;
+    }
+
+    push @m,'
+
+# Handy lists of source code files:
+XS_FILES = ',join(', ', sort keys %{$self->{XS}}),'
+C_FILES  = ',join(', ', @{$self->{C}}),'
+O_FILES  = ',join(', ', @{$self->{O_FILES}} ),'
+H_FILES  = ',join(', ', @{$self->{H}}),'
+MAN1PODS = ',join(', ', sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',join(', ', sort keys %{$self->{MAN3PODS}}),'
+
+';
+
+    for $tmp (qw/
+	      INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+	      /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+push @m,"
+.SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
+
+# Here is the Config.pm that we are using/depend on
+CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
+
+# Where to put things:
+INST_LIBDIR = ",($self->{'INST_LIBDIR'} = $self->catdir($self->{INST_LIB},$self->{ROOTEXT})),"
+INST_ARCHLIBDIR = ",($self->{'INST_ARCHLIBDIR'} = $self->catdir($self->{INST_ARCHLIB},$self->{ROOTEXT})),"
+
+INST_AUTODIR = ",($self->{'INST_AUTODIR'} = $self->catdir($self->{INST_LIB},'auto',$self->{FULLEXT})),'
+INST_ARCHAUTODIR = ',($self->{'INST_ARCHAUTODIR'} = $self->catdir($self->{INST_ARCHLIB},'auto',$self->{FULLEXT})),'
+';
+
+    if ($self->has_link_code()) {
+	push @m,'
+INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT)
+INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
+';
+    } else {
+	push @m,'
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+EXPORT_LIST = $(BASEEXT).opt
+PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : 'Sys$Share:PerlShr.Exe'),'
+';
+    }
+
+    $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
+    $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
+    push @m,'
+TO_INST_PM = ',join(', ',@{$self->{TO_INST_PM}}),'
+
+PM_TO_BLIB = ',join(', ',@{$self->{PM_TO_BLIB}}),'
+';
+
+    join('',@m);
+}
+
+=item const_loadlibs (override)
+
+Basically a stub which passes through library specfications provided
+by the caller.  Will be updated or removed when VMS support is added
+to ExtUtils::Liblist.
+
+=cut
+
+sub const_loadlibs{
+    my($self) = @_;
+    my (@m);
+    push @m, "
+# $self->{NAME} might depend on some other libraries.
+# (These comments may need revising:)
+#
+# Dependent libraries can be linked in one of three ways:
+#
+#  1.  (For static extensions) by the ld command when the perl binary
+#      is linked with the extension library. See EXTRALIBS below.
+#
+#  2.  (For dynamic extensions) by the ld command when the shared
+#      object is built/linked. See LDLOADLIBS below.
+#
+#  3.  (For dynamic extensions) by the DynaLoader when the shared
+#      object is loaded. See BSLOADLIBS below.
+#
+# EXTRALIBS =	List of libraries that need to be linked with when
+#		linking a perl binary which includes this extension
+#		Only those libraries that actually exist are included.
+#		These are written to a file and used when linking perl.
+#
+# LDLOADLIBS =	List of those libraries which can or must be linked into
+#		the shared library when created using ld. These may be
+#		static or dynamic libraries.
+#		LD_RUN_PATH is a colon separated list of the directories
+#		in LDLOADLIBS. It is passed as an environment variable to
+#		the process that links the shared library.
+#
+# BSLOADLIBS =	List of those libraries that are needed but can be
+#		linked in dynamically at run time on this platform.
+#		SunOS/Solaris does not need this because ld records
+#		the information (from LDLOADLIBS) into the object file.
+#		This list is used to create a .bs (bootstrap) file.
+#
+EXTRALIBS  = ",map($self->fixpath($_) . ' ',$self->{'EXTRALIBS'}),"
+BSLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'BSLOADLIBS'}),"
+LDLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'LDLOADLIBS'}),"\n";
+
+    join('',@m);
+}
+
+=item cflags (override)
+
+Bypass shell script and produce qualifiers for CC directly (but warn
+user if a shell script for this extension exists).  Fold multiple
+/Defines into one, and do the same with /Includes, since some C
+compilers pay attention to only one instance of these qualifiers
+on the command line.
+
+=cut
+
+sub cflags {
+    my($self,$libperl) = @_;
+    my($quals) = $Config{'ccflags'};
+    my($name,$sys,@m);
+    my($optimize) = '/Optimize';
+
+    ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
+    print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
+         " required to modify CC command for $self->{'BASEEXT'}\n"
+    if ($Config{$name});
+
+    # Deal with $self->{DEFINE} here since some C compilers pay attention
+    # to only one /Define clause on command line, so we have to
+    # conflate the ones from $Config{'cc'} and $self->{DEFINE}
+    if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
+	$quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
+	         "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
+    }
+    else {
+	$quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
+	          '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))';
+    }
+
+    $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
+    if ($libperl =~ /libperl(\w+)\./i) {
+        my($type) = uc $1;
+        my(%map) = ( 'D'  => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
+                     'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
+                     'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
+        $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$map{$type}):i
+    }
+
+    # Likewise with $self->{INC} and /Include
+    my($incstr) = '/Include=($(PERL_INC)';
+    if ($self->{'INC'}) {
+	my(@includes) = split(/\s+/,$self->{INC});
+	foreach (@includes) {
+	    s/^-I//;
+	    $incstr .= ', '.$self->fixpath($_,1);
+	}
+    }
+    if ($quals =~ m:(.*)/include=\(?([^\(\/\)\s]+)\)?(.*):i) {
+	$quals = "$1$incstr,$2)$3";
+    }
+    else { $quals .= "$incstr)"; }
+
+    $optimize = '/Debug/NoOptimize'
+	if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i);
+
+    return $self->{CFLAGS} = qq{
+CCFLAGS = $quals
+OPTIMIZE = $optimize
+PERLTYPE =
+SPLIT =
+LARGE =
+};
+}
+
+=item const_cccmd (override)
+
+Adds directives to point C preprocessor to the right place when
+handling #include <sys/foo.h> directives.  Also constructs CC
+command line a bit differently than MM_Unix method.
+
+=cut
+
+sub const_cccmd {
+    my($self,$libperl) = @_;
+    my(@m);
+
+    return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
+    return '' unless $self->needs_linking();
+    if ($Config{'vms_cc_type'} eq 'gcc') {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
+    }
+    elsif ($Config{'vms_cc_type'} eq 'vaxc') {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
+    }
+    else {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
+		($Config{'arch'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
+    }
+
+    push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
+
+    $self->{CONST_CCCMD} = join('',@m);
+}
+
+=item pm_to_blib (override)
+
+DCL I<still> accepts a maximum of 255 characters on a command
+line, so we write the (potentially) long list of file names
+to a temp file, then persuade Perl to read it instead of the
+command line to find args.
+
+=cut
+
+sub pm_to_blib {
+    my($self) = @_;
+    my($line,$from,$to,@m);
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
+    my(@files) = @{$self->{PM_TO_BLIB}};
+
+    push @m, q{
+# As always, keep under DCL's 255-char limit
+pm_to_blib : $(TO_INST_PM)
+	},$self->{NOECHO},q{$(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
+};
+
+    $line = '';  # avoid uninitialized var warning
+    while ($from = shift(@files),$to = shift(@files)) {
+	$line .= " $from $to";
+	if (length($line) > 128) {
+	    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
+	    $line = '';
+	}
+    }
+    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
+
+    push(@m,q[	$(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]);
+    push(@m,qq[
+	$self->{NOECHO}Delete/NoLog/NoConfirm .MM_tmp;
+	$self->{NOECHO}\$(TOUCH) pm_to_blib.ts
+]);
+
+    join('',@m);
+}
+
+=item tool_autosplit (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub tool_autosplit{
+    my($self, %attribs) = @_;
+    my($asl) = "";
+    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
+    q{
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use AutoSplit;}.$asl.q{ AutoSplit::autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
+};
+}
+
+=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) = $self->catdir($self->{PERL_LIB},'ExtUtils');
+    # drop back to old location if xsubpp is not in new location yet
+    $xsdir = $self->catdir($self->{PERL_SRC},'ext') unless (-f $self->catfile($xsdir,'xsubpp'));
+    my(@tmdeps) = '$(XSUBPPDIR)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));
+		}
+	}
+    }
+    push(@tmdeps, "typemap") if -f "typemap";
+    my(@tmargs) = map("-typemap $_", @tmdeps);
+    if( exists $self->{XSOPT} ){
+	unshift( @tmargs, $self->{XSOPT} );
+    }
+
+    my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp'));
+
+    # What are the correct thresholds for version 1 && 2 Paul?
+    if ( $xsubpp_version > 1.923 ){
+	$self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
+    } else {
+	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
+	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
+	Your version of xsubpp is $xsubpp_version and cannot handle this.
+	Please upgrade to a more recent version of xsubpp.
+};
+	} else {
+	    $self->{XSPROTOARG} = "";
+	}
+    }
+
+    "
+XSUBPPDIR = $xsdir
+XSUBPP = \$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" \$(XSUBPPDIR)xsubpp
+XSPROTOARG = $self->{XSPROTOARG}
+XSUBPPDEPS = @tmdeps
+XSUBPPARGS = @tmargs
+";
+}
+
+=item xsubpp_version (override)
+
+Test xsubpp exit status according to VMS rules ($sts & 1 ==> good)
+rather than Unix rules ($sts == 0 ==> good).
+
+=cut
+
+sub xsubpp_version
+{
+    my($self,$xsubpp) = @_;
+    my ($version) ;
+    return '' unless $self->needs_linking;
+
+    # try to figure out the version number of the xsubpp on the system
+
+    # first try the -v flag, introduced in 1.921 & 2.000a2
+
+    my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
+    print "Running: $command\n" if $Verbose;
+    $version = `$command` ;
+    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    chop $version ;
+
+    return $1 if $version =~ /^xsubpp version (.*)/ ;
+
+    # nope, then try something else
+
+    my $counter = '000';
+    my ($file) = 'temp' ;
+    $counter++ while -e "$file$counter"; # don't overwrite anything
+    $file .= $counter;
+
+    local(*F);
+    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
+    print F <<EOM ;
+MODULE = fred PACKAGE = fred
+
+int
+fred(a)
+	int	a;
+EOM
+
+    close F ;
+
+    $command = "$self->{PERL} $xsubpp $file";
+    print "Running: $command\n" if $Verbose;
+    my $text = `$command` ;
+    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    unlink $file ;
+
+    # gets 1.2 -> 1.92 and 2.000a1
+    return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+
+    # it is either 1.0 or 1.1
+    return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+
+    # none of the above, so 1.0
+    return "1.0" ;
+}
+
+=item tools_other (override)
+
+Adds a few MM[SK] macros, and shortens some the installatin commands,
+in order to stay under DCL's 255-character limit.  Also changes
+EQUALIZE_TIMESTAMP to set revision date of target file to one second
+later than source file, since MMK interprets precisely equal revision
+dates for a source and target file as a sign that the target needs
+to be updated.
+
+=cut
+
+sub tools_other {
+    my($self) = @_;
+    qq!
+# Assumes \$(MMS) invokes MMS or MMK
+# (It is assumed in some cases later that the default makefile name
+# (Descrip.MMS for MM[SK]) is used.)
+USEMAKEFILE = /Descrip=
+USEMACROS = /Macro=(
+MACROEND = )
+MAKEFILE = Descrip.MMS
+SHELL = Posix
+TOUCH = $self->{TOUCH}
+CHMOD = $self->{CHMOD}
+CP = $self->{CP}
+MV = $self->{MV}
+RM_F  = $self->{RM_F}
+RM_RF = $self->{RM_RF}
+UMASK_NULL = $self->{UMASK_NULL}
+NOOP = $self->{NOOP}
+MKPATH = Create/Directory
+EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
+!. ($self->{PARENT} ? '' : 
+qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
+MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
+DOC_INSTALL = \$(PERL) -e "\@ARGV=split('|',<STDIN>);print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
+UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1);"
+!);
+}
+
+=item dist (override)
+
+Provide VMSish defaults for some values, then hand off to
+default MM_Unix method.
+
+=cut
+
+sub dist {
+    my($self, %attribs) = @_;
+    $attribs{VERSION}      ||= $self->{VERSION_SYM};
+    $attribs{ZIPFLAGS}     ||= '-Vu';
+    $attribs{COMPRESS}     ||= 'gzip';
+    $attribs{SUFFIX}       ||= '-gz';
+    $attribs{SHAR}         ||= 'vms_share';
+    $attribs{DIST_DEFAULT} ||= 'zipdist';
+
+    return ExtUtils::MM_Unix::dist($self,%attribs);
+}
+
+=item c_o (override)
+
+Use VMS syntax on command line.  In particular, $(DEFINE) and
+$(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
+
+=cut
+
+sub c_o {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.c$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
+
+.cpp$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
+
+.cxx$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
+
+';
+}
+
+=item xs_c (override)
+
+Use MM[SK] macros.
+
+=cut
+
+sub xs_c {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.xs.c :
+	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
+';
+}
+
+=item xs_o (override)
+
+Use MM[SK] macros, and VMS command line for C compiler.
+
+=cut
+
+sub xs_o {	# many makes are too dumb to use xs_c then c_o
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.xs$(OBJ_EXT) :
+	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
+';
+}
+
+=item top_targets (override)
+
+Use VMS quoting on command line for Version_check.
+
+=cut
+
+sub top_targets {
+    my($self) = shift;
+    my(@m);
+    push @m, '
+all :: pure_all manifypods
+	$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+	$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	$(NOOP)
+
+config :: $(MAKEFILE) $(INST_LIBDIR).exists
+	$(NOOP)
+
+config :: $(INST_ARCHAUTODIR).exists
+	$(NOOP)
+
+config :: $(INST_AUTODIR).exists
+	$(NOOP)
+';
+
+    push @m, q{
+config :: Version_check
+	$(NOOP)
+
+} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
+
+
+    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
+    if (%{$self->{MAN1PODS}}) {
+	push @m, q[
+config :: $(INST_MAN1DIR).exists
+	$(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    }
+    if (%{$self->{MAN3PODS}}) {
+	push @m, q[
+config :: $(INST_MAN3DIR).exists
+	$(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
+    }
+
+    push @m, '
+$(O_FILES) : $(H_FILES)
+' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
+
+    push @m, q{
+help :
+	perldoc ExtUtils::MakeMaker
+};
+
+    push @m, q{
+Version_check :
+	},$self->{NOECHO},q{$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	"-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
+};
+
+    join('',@m);
+}
+
+=item dlsyms (override)
+
+Create VMS linker options files specifying universal symbols for this
+extension's shareable image, and listing other shareable images or 
+libraries to which it should be linked.
+
+=cut
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    return '' unless $self->needs_linking();
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
+    my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
+    my(@m);
+
+    unless ($self->{SKIPHASH}{'dynamic'}) {
+	push(@m,'
+dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOOP)
+');
+	if ($srcdir) {
+	   my($popt) = $self->catfile($srcdir,'perlshr.opt');
+	   my($lopt) = $self->catfile($srcdir,'crtl.opt');
+	   push(@m,"# Depend on $(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
+rtls.opt : $popt $lopt \$(BASEEXT).opt
+	Copy/Log $popt Sys\$Disk:[]rtls.opt
+	Append/Log $lopt Sys\$Disk:[]rtls.opt
+");
+	}
+	else {
+	    push(@m,'
+# rtls.opt is built in the same step as $(BASEEXT).opt
+rtls.opt : $(BASEEXT).opt
+	$(TOUCH) $(MMS$TARGET)
+');
+	}
+    }
+
+    push(@m,'
+static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOOP)
+') unless $self->{SKIPHASH}{'static'};
+
+    push(@m,'
+$(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
+	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
+
+$(BASEEXT).opt : Makefile.PL
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
+	',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
+	neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
+	$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
+');
+
+    join('',@m);
+}
+
+=item dynamic_lib (override)
+
+Use VMS Link command.
+
+=cut
+
+sub dynamic_lib {
+    my($self, %attribs) = @_;
+    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code();
+
+    my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my(@m);
+    push @m,"
+
+OTHERLDFLAGS = $otherldflags
+INST_DYNAMIC_DEP = $inst_dynamic_dep
+
+";
+    push @m, '
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+	',$self->{NOECHO},'$(MKPATH) $(INST_ARCHAUTODIR)
+	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.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) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
+	'.$self->{NOECHO}.'Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
+	'.$self->{NOECHO}.' $(TOUCH) $(MMS$TARGET)
+
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
+	'.$self->{NOECHO}.'$(RM_RF) $(INST_BOOT)
+	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
+';
+}
+
+=item static_lib (override)
+
+Use VMS commands to manipulate object library.
+
+=cut
+
+sub static_lib {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+
+    return '
+$(INST_STATIC) :
+	$(NOOP)
+' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
+
+    my(@m);
+    push @m,'
+# Rely on suffix rule for update action
+$(OBJECT) : $(INST_ARCHAUTODIR).exists
+
+$(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
+';
+    # If this extension has it's own library (eg SDBM_File)
+    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
+    push(@m, '	$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+
+    push(@m,'
+	If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
+	Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
+	',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
+');
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+
+# sub installpm_x { # called by installpm perl file
+#     my($self, $dist, $inst, $splitlib) = @_;
+#     if ($inst =~ m!#!) {
+# 	warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
+# 	return '';
+#     }
+#     $inst = $self->fixpath($inst);
+#     $dist = $self->fixpath($dist);
+#     my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
+#     my(@m);
+# 
+#     push(@m, "
+# $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
+# ",'	',$self->{NOECHO},'$(RM_F) $(MMS$TARGET)
+# 	',$self->{NOECHO},'$(CP) ',"$dist $inst",'
+# 	$(CHMOD) 644 $(MMS$TARGET)
+# ');
+#     push(@m, '	$(AUTOSPLITFILE) $(MMS$TARGET) ',
+#               $self->catdir($splitlib,'auto')."\n\n")
+#         if ($splitlib and $inst =~ /\.pm$/);
+#     push(@m,$self->dir_target($instdir));
+# 
+#     join('',@m);
+# }
+
+=item manifypods (override)
+
+Use VMS-style quoting on command line, and VMS logical name
+to specify fallback location at build time if we can't find pod2man.
+
+=cut
+
+
+sub manifypods {
+    my($self, %attribs) = @_;
+    return "\nmanifypods :\n\t\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
+    } else {
+	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
+    }
+    if ($pod2man_exe = $self->perl_script($pod2man_exe)) { $found_pod2man = 1; }
+    else {
+	# No pod2man but some MAN3PODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program.  As a last choice,
+         I will look for the file to which the logical name POD2MAN
+         points when MMK is invoked.
+
+END
+        $pod2man_exe = "pod2man";
+    }
+    my(@m);
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
+q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
+-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
+];
+    push @m, "\nmanifypods : ";
+    push @m, join " ", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
+    push(@m,"\n");
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	my($pod);
+	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN1PODS}{$pod}\n";
+	}
+	foreach $pod (sort keys %{$self->{MAN3PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN3PODS}{$pod}\n";
+	}
+    }
+    join('', @m);
+}
+
+=item processPL (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub processPL {
+    my($self) = @_;
+    return "" unless $self->{PL_FILES};
+    my(@m, $plfile);
+    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+	push @m, "
+all :: $self->{PL_FILES}->{$plfile}
+	\$(NOOP)
+
+$self->{PL_FILES}->{$plfile} :: $plfile
+",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $plfile
+";
+    }
+    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, $line);
+    for $from (@{$self->{EXE_FILES}}) {
+	my($path) = '$(INST_SCRIPT)' . basename($from);
+	local($_) = $path;  # backward compatibility
+	$to = $self->libscan($path);
+	print "libscan($from) => '$to'\n" if ($Verbose >=2);
+	$fromto{$from}=$to;
+    }
+    @to   = values %fromto;
+    push @m, "
+EXE_FILES = @{$self->{EXE_FILES}}
+
+all :: @to
+	\$(NOOP)
+
+realclean ::
+";
+    $line = '';  #avoid unitialized var warning
+    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 \$(MAKEFILE) ${todir}.exists
+	\$(CP) $from $to
+
+", $self->dir_target($todir);
+    }
+    join "", @m;
+}
+
+=item subdir_x (override)
+
+Use VMS commands to change default directory.
+
+=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) all $(USEMACROS)$(PASTHRU)$(MACROEND)
+	Set Default \'olddef\'
+';
+    join('',@m);
+}
+
+=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.
+
+=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 ::
+';
+    foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
+	my($vmsdir) = $self->fixpath($dir,1);
+	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)") Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n");
+    }
+    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso
+';
+
+    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
+    push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
+    my($file,$line);
+    $line = '';  #avoid unitialized var warning
+    foreach $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 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".'$(MAKEFILE)").nes."" Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n");
+    }
+    push @m,'	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
+';
+    # 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,$line,$fcnt);
+    my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
+    if ($self->has_link_code) {
+	push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
+    }
+    push(@files, values %{$self->{PM}});
+    $line = '';  #avoid unitialized var warning
+    foreach $file (@files) {
+	$file = $self->fixpath($file);
+	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} && ref $attribs{FILES} eq 'ARRAY') {
+	$line = '';
+	foreach $file (@{$attribs{'FILES'}}) {
+	    $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 dist_basics (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub dist_basics {
+    my($self) = @_;
+'
+distclean :: realclean distcheck
+	$(NOOP)
+
+distcheck :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
+
+skipcheck :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; skipcheck()"
+
+manifest :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
+';
+}
+
+=item dist_core (override)
+
+Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
+so C<shdist> target actions are VMS-specific.
+
+=cut
+
+sub dist_core {
+    my($self) = @_;
+q[
+dist : $(DIST_DEFAULT)
+	].$self->{NOECHO}.q[$(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)'"
+
+zipdist : $(DISTVNAME).zip
+	$(NOOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) $(SRC)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar $(SRC)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+shdist : distdir
+	$(PREOP)
+	$(SHARE) $(SRC) $(DISTVNAME).share
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+];
+}
+
+=item dist_dir (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub dist_dir {
+    my($self) = @_;
+q{
+distdir :
+	$(RM_RF) $(DISTVNAME)
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
+	-e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
+};
+}
+
+=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)]
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
+	$(MMS)
+	$(MMS) test
+	Set Default 'startdir'
+};
+}
+
+# --- Test and Installation Sections ---
+
+=item install (override)
+
+Work around DCL's 255 character limit several times,and use
+VMS-style command line quoting in a few cases.
+
+=cut
+
+sub install {
+    my($self, %attribs) = @_;
+    my(@m,@docfiles);
+
+    if ($self->{EXE_FILES}) {
+	my($line,$file) = ('','');
+	foreach $file (@{$self->{EXE_FILES}}) {
+	    $line .= "$file ";
+	    if (length($line) > 128) {
+		push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]);
+		$line = '';
+	    }
+	}
+	push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]) if $line;
+    }
+
+    push @m, q[
+install :: all pure_install doc_install
+	$(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+	$(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+	$(NOOP)
+
+install_ :: install_site
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+pure_install :: pure_$(INSTALLDIRS)_install
+	$(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	],$self->{NOECHO},q[Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod"
+
+pure__install : pure_site_install
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+doc__install : doc_site_install
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+# This hack brought to you by DCL's 255-character command line limit
+pure_perl_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
+
+# Likewise
+pure_site_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+# Ditto
+doc_perl_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
+# And again
+doc_site_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
+];
+
+    push @m, q[
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+	$(NOOP)
+
+uninstall_from_perldirs ::
+	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+uninstall_from_sitedirs ::
+	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist')."\n";
+
+    join('',@m);
+}
+
+=item perldepend (override)
+
+Use VMS-style syntax for files; it's cheaper to just do it directly here
+than to have the MM_Unix method call C<catfile> repeatedly.  Also use
+config.vms as source of original config data if the Perl distribution
+is available; config.sh is an ancillary file under VMS.  Finally, if
+we have to rebuild Config.pm, use MM[SK] to do it.
+
+=cut
+
+sub perldepend {
+    my($self) = @_;
+    my(@m);
+
+    push @m, '
+$(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
+$(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
+$(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
+$(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
+$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
+$(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
+$(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
+
+' if $self->{OBJECT}; 
+
+    if ($self->{PERL_SRC}) {
+	my(@macros);
+	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
+	push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
+	push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
+	push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
+	push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
+	push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
+	$mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
+	push(@m,q[
+# Check for unpropagated 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!
+#$(PERL_INC)config.h : $(PERL_SRC)config.sh
+$(PERL_INC)config.h : $(PERL_VMS)config.vms
+	],$self->{NOECHO},q[Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
+
+#$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
+$(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
+	],$self->{NOECHO},q[Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
+	olddef = F$Environment("Default")
+	Set Default $(PERL_SRC)
+	$(MMS)],$mmsquals,q[ $(MMS$TARGET)
+	Set Default 'olddef'
+]);
+    }
+
+    push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
+      if %{$self->{XS}};
+
+    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 $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
+$(MAKEFILE) : Makefile.PL $(CONFIGDEP)
+	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
+	],$self->{NOECHO},q[Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..."
+	- $(MV) $(MAKEFILE) $(MAKEFILE)_old
+	- $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
+	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) has been rebuilt."
+	],$self->{NOECHO},q[Write Sys$Output "Please run $(MMS) to build the extension."
+];
+
+    join('',@m);
+}
+
+=item test (override)
+
+Use VMS commands for handling subdirectories.
+
+=cut
+
+sub test {
+    my($self, %attribs) = @_;
+    my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
+    my(@m);
+    push @m,"
+TEST_VERBOSE = 0
+TEST_TYPE = test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TESTDB_SW = -d
+
+test :: \$(TEST_TYPE)
+	\$(NOOP)
+
+testdb :: testdb_\$(LINKTYPE)
+	\$(NOOP)
+
+";
+    foreach(@{$self->{DIR}}){
+      my($vmsdir) = $self->fixpath($_,1);
+      push(@m, '	If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
+           '; print `$(MMS) $(PASTHRU2) test`'."\n");
+    }
+    push(@m, "\t$self->{NOECHO}Write Sys\$Output \"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('$(FULLPERL)', $tests)) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "    \$(NOOP)\n") if (!$tests && ! -f "test.pl");
+    push(@m, "\n");
+
+    push(@m, "testdb_dynamic :: pure_all\n");
+    push(@m, $self->test_via_script('$(FULLPERL) "$(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$self->{NOECHO}\$(NOOP)\n\n";
+	push @m, "testdb_static :: testdb_dynamic\n\t$self->{NOECHO}\$(NOOP)\n";
+    }
+
+    join('',@m);
+}
+
+=item test_via_harness (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub test_via_harness {
+    my($self,$perl,$tests) = @_;
+    "	$perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
+    '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
+}
+
+=item test_via_script (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub test_via_script {
+    my($self,$perl,$script) = @_;
+    "	$perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
+';
+}
+
+=item makeaperl (override)
+
+Undertake to build a new set of Perl images using VMS commands.  Since
+VMS does dynamic loading, it's not necessary to statically link each
+extension into the Perl image, so this isn't the normal build path.
+Consequently, it hasn't really been tested, and may well be incomplete.
+
+=cut
+
+sub makeaperl {
+    my($self, %attribs) = @_;
+    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = 
+      @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
+    my(@m);
+    push @m, "
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = $target
+";
+    return join '', @m if $self->{PARENT};
+
+    my($dir) = join ":", @{$self->{DIR}};
+
+    unless ($self->{MAKEAPERL}) {
+	push @m, q{
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+	},$self->{NOECHO},q{Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
+	},$self->{NOECHO},q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+		Makefile.PL DIR=}, $dir, q{ \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1
+
+$(MAP_TARGET) :: $(MAKE_APERL_FILE)
+	$(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+};
+	push @m, map( " \\\n\t\t$_", @ARGV );
+	push @m, "\n";
+
+	return join '', @m;
+    }
+
+
+    my($linkcmd,@staticopts,@staticpkgs,$extralist,$target,$targdir,$libperldir);
+
+    # The front matter of the linkcommand...
+    $linkcmd = join ' ', $Config{'ld'},
+	    grep($_, @Config{qw(large split ldflags ccdlflags)});
+    $linkcmd =~ s/\s+/ /g;
+
+    # Which *.olb files could we make use of...
+    local(%olbs);
+    $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
+    require File::Find;
+    File::Find::find(sub {
+	return unless m/\Q$self->{LIB_EXT}\E$/;
+	return if m/^libperl/;
+
+	if( exists $self->{INCLUDE_EXT} ){
+		my $found = 0;
+		my $incl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything not explicitly marked for inclusion.
+		# DynaLoader is implied.
+		foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
+			if( $xx eq $incl ){
+				$found++;
+				last;
+			}
+		}
+		return unless $found;
+	}
+	elsif( exists $self->{EXCLUDE_EXT} ){
+		my $excl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything explicitly marked for exclusion
+		foreach $excl (@{$self->{EXCLUDE_EXT}}){
+			return if( $xx eq $excl );
+		}
+	}
+
+	$olbs{$ENV{DEFAULT}} = $_;
+    }, grep( -d $_, @{$searchdirs || []}));
+
+    # We trust that what has been handed in as argument will be buildable
+    $static = [] unless $static;
+    @olbs{@{$static}} = (1) x @{$static};
+ 
+    $extra = [] unless $extra && ref $extra eq 'ARRAY';
+    # Sort the object libraries in inverse order of
+    # filespec length to try to insure that dependent extensions
+    # will appear before their parents, so the linker will
+    # search the parent library to resolve references.
+    # (e.g. Intuit::DWIM will precede Intuit, so unresolved
+    # references from [.intuit.dwim]dwim.obj can be found
+    # in [.intuit]intuit.olb).
+    for (sort keys %olbs) {
+	next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
+	my($dir) = $self->fixpath($_,1);
+	my($extralibs) = $dir . "extralibs.ld";
+	my($extopt) = $dir . $olbs{$_};
+	$extopt =~ s/$self->{LIB_EXT}$/.opt/;
+	if (-f $extralibs ) {
+	    open LIST,$extralibs or warn $!,next;
+	    push @$extra, <LIST>;
+	    close LIST;
+	}
+	if (-f $extopt) {
+	    open OPT,$extopt or die $!;
+	    while (<OPT>) {
+		next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
+		# ExtUtils::Miniperl expects Unix paths
+		(my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
+		push @staticpkgs,$pkg;
+	    }
+	    push @staticopts, $extopt;
+	}
+    }
+
+    $target = "Perl.Exe" unless $target;
+    ($shrtarget,$targdir) = fileparse($target);
+    $shrtarget =~ s/^([^.]*)/$1Shr/;
+    $shrtarget = $targdir . $shrtarget;
+    $target = "Perlshr.$Config{'dlext'}" unless $target;
+    $tmp = "[]" unless $tmp;
+    $tmp = $self->fixpath($tmp,1);
+    if (@$extra) {
+	$extralist = join(' ',@$extra);
+	$extralist =~ s/[,\s\n]+/, /g;
+    }
+    else { $extralist = ''; }
+    if ($libperl) {
+	unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
+	    print STDOUT "Warning: $libperl not found\n";
+	    undef $libperl;
+	}
+    }
+    unless ($libperl) {
+	if (defined $self->{PERL_SRC}) {
+	    $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
+	} elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
+	} else {
+	    print STDOUT "Warning: $libperl not found
+    If you're going to build a static perl binary, make sure perl is installed
+    otherwise ignore this warning\n";
+	}
+    }
+    $libperldir = $self->fixpath((fileparse($libperl))[1],1);
+
+    push @m, '
+# Fill in the target you want to produce if it\'s not perl
+MAP_TARGET    = ',$self->fixpath($target),'
+MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
+MAP_LINKCMD   = $linkcmd
+MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
+# We use the linker options files created with each extension, rather than
+#specifying the object files directly on the command line.
+MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
+MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
+MAP_EXTRA     = $extralist
+MAP_LIBPERL = ",$self->fixpath($libperl),'
+';
+
+
+    push @m,'
+$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
+	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
+$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
+	$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
+	',$self->{NOECHO},'Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say"
+	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+	',$self->{NOECHO},'Write Sys$Output "To remove the intermediate files, say
+	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+';
+    push @m,'
+',"${tmp}perlmain.c",' : $(MAKEFILE)
+	',$self->{NOECHO},'$(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
+';
+
+    push @m, q[
+# More from the 255-char line length limit
+doc_inst_perl :
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
+	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+];
+
+    push @m, "
+inst_perl : pure_inst_perl doc_inst_perl
+	\$(NOOP)
+
+pure_inst_perl : \$(MAP_TARGET)
+	$self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
+	$self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
+
+clean :: map_clean
+	\$(NOOP)
+
+map_clean :
+	\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
+	\$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
+";
+
+    join '', @m;
+}
+  
+=item ext (specific)
+
+Stub routine standing in for C<ExtUtils::LibList::ext> until VMS
+support is added to that package.
+
+=cut
+
+sub ext {
+    my($self) = @_;
+    '','','';
+}
+
+# --- Output postprocessing section ---
+
+=item nicetext (override)
+
+Insure that colons marking targets are preceded by space, in order
+to distinguish the target delimiter from a colon appearing as
+part of a filespec.
+
+=cut
+
+sub nicetext {
+
+    my($self,$text) = @_;
+    $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
+    $text;
+}
+
+1;
+
+__END__
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
new file mode 100644
index 00000000000..3ee3ac6ab3b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
@@ -0,0 +1,1808 @@
+BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatible with perl5.001m
+
+package ExtUtils::MakeMaker;
+
+$Version = $VERSION = "5.34";
+$Version_OK = "5.17";	# Makefiles older than $Version_OK will die
+			# (Will be checked from MakeMaker version 4.13 onwards)
+($Revision = substr(q$Revision: 1.1 $, 10)) =~ s/\s+$//;
+
+
+
+require Exporter;
+use Config;
+use Carp ();
+#use FileHandle ();
+
+use vars qw(
+
+	    @ISA @EXPORT @EXPORT_OK $AUTOLOAD
+	    $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision $Setup_done
+	    $VERSION $Verbose $Version_OK %Config %Keep_after_flush
+	    %MM_Sections %Prepend_dot_dot %Recognized_Att_Keys
+	    @Get_from_Config @MM_Sections @Overridable @Parent
+
+	   );
+# use strict;
+
+eval {require DynaLoader;};	# Get mod2fname, if defined. Will fail
+                                # with miniperl.
+
+#
+# Set up the inheritance before we pull in the MM_* packages, because they
+# import variables and functions from here
+#
+@ISA = qw(Exporter);
+@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
+@EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists
+		$Version);
+		# $Version in mixed case will go away!
+
+#
+# Dummy package MM inherits actual methods from OS-specific
+# default packages.  We use this intermediate package so
+# MY::XYZ->func() can call MM->func() and get the proper
+# default routine without having to know under what OS
+# it's running.
+#
+@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist ExtUtils::MakeMaker];
+
+#
+# Setup dummy package:
+# MY exists for overriding methods to be defined within
+#
+{
+    package MY;
+    @MY::ISA = qw(MM);
+###    sub AUTOLOAD { use Devel::Symdump; print Devel::Symdump->rnew->as_string; Carp::confess "hey why? $AUTOLOAD" }
+    package MM;
+    sub DESTROY {}
+}
+
+# "predeclare the package: we only load it via AUTOLOAD
+# but we have already mentioned it in @ISA
+package ExtUtils::Liblist;
+
+package ExtUtils::MakeMaker;
+#
+# Now we can can pull in the friends
+#
+$Is_VMS = $^O eq 'VMS';
+$Is_OS2 = $^O =~ m|^os/?2$|i;
+$Is_Mac = $^O eq 'MacOS';
+
+require ExtUtils::MM_Unix;
+
+if ($Is_VMS) {
+    require ExtUtils::MM_VMS;
+    require VMS::Filespec; # is a noop as long as we require it within MM_VMS
+}
+if ($Is_OS2) {
+    require ExtUtils::MM_OS2;
+}
+if ($Is_Mac) {
+    require ExtUtils::MM_Mac;
+}
+
+# The SelfLoader would bring a lot of overhead for MakeMaker, because
+# we know for sure we will use most of the autoloaded functions once
+# we have to use one of them. So we write our own loader
+
+sub AUTOLOAD {
+    my $code;
+    if (defined fileno(DATA)) {
+	my $fh = select DATA;
+	my $o = $/;			# For future reads from the file.
+	$/ = "\n__END__\n";
+	$code = <DATA>;
+	$/ = $o;
+	select $fh;
+	close DATA;
+	eval $code;
+	if ($@) {
+	    $@ =~ s/ at .*\n//;
+	    Carp::croak $@;
+	}
+    } else {
+	warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; 
+    }
+    defined(&$AUTOLOAD) or die "Myloader inconsistency error";
+    goto &$AUTOLOAD;
+}
+
+# The only subroutine we do not SelfLoad is Version_Check because it's
+# called so often. Loading this minimum still requires 1.2 secs on my
+# Indy :-(
+
+sub Version_check {
+    my($checkversion) = @_;
+    die "Your Makefile was built with ExtUtils::MakeMaker v $checkversion.
+Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable
+changes in the meantime.
+Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n"
+    if $checkversion < $Version_OK;
+    printf STDOUT "%s %s %s %s.\n", "Makefile built with ExtUtils::MakeMaker v",
+    $checkversion, "Current Version is", $VERSION
+	unless $checkversion == $VERSION;
+}
+
+sub warnhandler {
+    $_[0] =~ /^Use of uninitialized value/ && return;
+    $_[0] =~ /used only once/ && return;
+    $_[0] =~ /^Subroutine\s+[\w:]+\s+redefined/ && return;
+    warn @_;
+}
+
+sub ExtUtils::MakeMaker::eval_in_subdirs ;
+sub ExtUtils::MakeMaker::eval_in_x ;
+sub ExtUtils::MakeMaker::full_setup ;
+sub ExtUtils::MakeMaker::writeMakefile ;
+sub ExtUtils::MakeMaker::new ;
+sub ExtUtils::MakeMaker::check_manifest ;
+sub ExtUtils::MakeMaker::parse_args ;
+sub ExtUtils::MakeMaker::check_hints ;
+sub ExtUtils::MakeMaker::mv_all_methods ;
+sub ExtUtils::MakeMaker::skipcheck ;
+sub ExtUtils::MakeMaker::flush ;
+sub ExtUtils::MakeMaker::mkbootstrap ;
+sub ExtUtils::MakeMaker::mksymlists ;
+sub ExtUtils::MakeMaker::neatvalue ;
+sub ExtUtils::MakeMaker::selfdocument ;
+sub ExtUtils::MakeMaker::WriteMakefile ;
+sub ExtUtils::MakeMaker::prompt ;
+
+1;
+#__DATA__
+package ExtUtils::MakeMaker;
+
+sub WriteMakefile {
+    Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+    local $SIG{__WARN__} = \&warnhandler;
+
+    unless ($Setup_done++){
+	full_setup();
+	undef &ExtUtils::MakeMaker::full_setup; #safe memory
+    }
+    my %att = @_;
+    MM->new(\%att)->flush;
+}
+
+sub prompt ($;$) {
+    my($mess,$def)=@_;
+    $ISA_TTY = -t STDIN && -t STDOUT ;
+    Carp::confess("prompt function called without an argument") unless defined $mess;
+    my $dispdef = defined $def ? "[$def] " : " ";
+    $def = defined $def ? $def : "";
+    my $ans;
+    if ($ISA_TTY) {
+	local $|=1;
+	print "$mess $dispdef";
+	chomp($ans = <STDIN>);
+    }
+    return $ans || $def;
+}
+
+sub eval_in_subdirs {
+    my($self) = @_;
+    my($dir);
+    use Cwd 'cwd';
+    my $pwd = cwd();
+
+    foreach $dir (@{$self->{DIR}}){
+	my($abs) = $self->catdir($pwd,$dir);
+	$self->eval_in_x($abs);
+    }
+    chdir $pwd;
+}
+
+sub eval_in_x {
+    my($self,$dir) = @_;
+    package main;
+    chdir $dir or Carp::carp("Couldn't change to directory $dir: $!");
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+#    $fh->open("Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir");
+    local *FH;
+    open(FH,"Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir");
+#    my $eval = join "", <$fh>;
+    my $eval = join "", <FH>;
+#    $fh->close;
+    close FH;
+    eval $eval;
+    if ($@) {
+# 	  if ($@ =~ /prerequisites/) {
+# 	      die "MakeMaker WARNING: $@";
+# 	  } else {
+# 	      warn "WARNING from evaluation of $dir/Makefile.PL: $@";
+# 	  }
+	warn "WARNING from evaluation of $dir/Makefile.PL: $@";
+    }
+}
+
+sub full_setup {
+    $Verbose ||= 0;
+    $^W=1;
+
+    # package name for the classes into which the first object will be blessed
+    $PACKNAME = "PACK000";
+
+    @Attrib_help = qw/
+
+    C CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS EXE_FILES
+    EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H INC
+    INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
+    INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
+    INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
+    INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIBS
+    LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
+    NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
+    PERL_ARCHLIB PERL_LIB PERL_SRC PL_FILES PM PMLIBDIRS PREFIX
+    PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
+    XS_VERSION clean depend dist dynamic_lib linkext macro realclean
+    tool_autosplit
+
+    installpm
+
+	/;
+
+    # ^^^ installpm is deprecated, will go about Summer 96
+
+    # @Overridable is close to @MM_Sections but not identical.  The
+    # order is important. Many subroutines declare macros. These
+    # depend on each other. Let's try to collect the macros up front,
+    # then pasthru, then the rules.
+
+    # MM_Sections are the sections we have to call explicitly
+    # in Overridable we have subroutines that are used indirectly
+
+
+    @MM_Sections = 
+	qw(
+
+ post_initialize const_config constants tool_autosplit tool_xsubpp
+ tools_other dist macro depend cflags const_loadlibs const_cccmd
+ post_constants
+
+ pasthru
+
+ c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs
+ dynamic_lib static static_lib manifypods processPL installbin subdirs
+ clean realclean dist_basics dist_core dist_dir dist_test dist_ci
+ install force perldepend makefile staticmake test
+
+	  ); # loses section ordering
+
+    @Overridable = @MM_Sections;
+    push @Overridable, qw[
+
+ dir_target libscan makeaperl needs_linking subdir_x test_via_harness
+ test_via_script
+
+			 ];
+
+    push @MM_Sections, qw[
+
+ pm_to_blib selfdocument
+
+			 ];
+
+    # Postamble needs to be the last that was always the case
+    push @MM_Sections, "postamble";
+    push @Overridable, "postamble";
+
+    # All sections are valid keys.
+    @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections;
+
+    # we will use all these variables in the Makefile
+    @Get_from_Config = 
+	qw(
+	   ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc
+	   lib_ext obj_ext ranlib sitelibexp sitearchexp so
+	  );
+
+    my $item;
+    foreach $item (@Attrib_help){
+	$Recognized_Att_Keys{$item} = 1;
+    }
+    foreach $item (@Get_from_Config) {
+	$Recognized_Att_Keys{uc $item} = $Config{$item};
+	print "Attribute '\U$item\E' => '$Config{$item}'\n"
+	    if ($Verbose >= 2);
+    }
+
+    #
+    # When we eval a Makefile.PL in a subdirectory, that one will ask
+    # us (the parent) for the values and will prepend "..", so that
+    # all files to be installed end up below OUR ./blib
+    #
+    %Prepend_dot_dot = 
+	qw(
+
+	   INST_BIN 1 INST_EXE 1 INST_LIB 1 INST_ARCHLIB 1 INST_SCRIPT
+	   1 MAP_TARGET 1 INST_MAN1DIR 1 INST_MAN3DIR 1 PERL_SRC 1
+	   PERL 1 FULLPERL 1
+
+	  );
+
+    my @keep = qw/
+	NEEDS_LINKING HAS_LINK_CODE
+	/;
+    @Keep_after_flush{@keep} = (1) x @keep;
+}
+
+sub writeMakefile {
+    die <<END;
+
+The extension you are trying to build apparently is rather old and
+most probably outdated. We detect that from the fact, that a
+subroutine "writeMakefile" is called, and this subroutine is not
+supported anymore since about October 1994.
+
+Please contact the author or look into CPAN (details about CPAN can be
+found in the FAQ and at http:/www.perl.com) for a more recent version
+of the extension. If you're really desperate, you can try to change
+the subroutine name from writeMakefile to WriteMakefile and rerun
+'perl Makefile.PL', but you're most probably left alone, when you do
+so.
+
+The MakeMaker team
+
+END
+}
+
+sub ExtUtils::MakeMaker::new {
+    my($class,$self) = @_;
+    my($key);
+
+    print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
+    if (-f "MANIFEST" && ! -f "Makefile"){
+	check_manifest();
+    }
+
+    $self = {} unless (defined $self);
+
+    check_hints($self);
+
+    my(%initial_att) = %$self; # record initial attributes
+
+    my($prereq);
+    foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
+	my $eval = "use $prereq $self->{PREREQ_PM}->{$prereq}";
+	eval $eval;
+	if ($@){
+	    warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found";
+	} else {
+	    delete $self->{PREREQ_PM}{$prereq};
+	}
+    }
+#    if (@unsatisfied){
+# 	  unless (defined $ExtUtils::MakeMaker::useCPAN) {
+# 	      print qq{MakeMaker WARNING: prerequisites not found (@unsatisfied)
+# Please install these modules first and rerun 'perl Makefile.PL'.\n};
+# 	      if ($ExtUtils::MakeMaker::hasCPAN) {
+# 		  $ExtUtils::MakeMaker::useCPAN = prompt(qq{Should I try to use the CPAN module to fetch them for you?},"yes");
+# 	      } else {
+# 		  print qq{Hint: You may want to install the CPAN module to autofetch the needed modules\n};
+# 		  $ExtUtils::MakeMaker::useCPAN=0;
+# 	      }
+# 	  }
+# 	  if ($ExtUtils::MakeMaker::useCPAN) {
+# 	      require CPAN;
+# 	      CPAN->import(@unsatisfied);
+# 	  } else {
+# 	      die qq{prerequisites not found (@unsatisfied)};
+# 	  }
+#	warn qq{WARNING: prerequisites not found (@unsatisfied)};
+#    }
+
+    if (defined $self->{CONFIGURE}) {
+	if (ref $self->{CONFIGURE} eq 'CODE') {
+	    $self = { %$self, %{&{$self->{CONFIGURE}}}};
+	} else {
+	    Carp::croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n";
+	}
+    }
+
+    # This is for old Makefiles written pre 5.00, will go away
+    if ( Carp::longmess("") =~ /runsubdirpl/s ){
+	#$self->{Correct_relativ_directories}++;
+	Carp::carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
+    } else {
+	$self->{Correct_relativ_directories}=0;
+    }
+
+    my $class = ++$PACKNAME;
+    {
+#	no strict;
+	print "Blessing Object into class [$class]\n" if $Verbose>=2;
+	mv_all_methods("MY",$class);
+	bless $self, $class;
+	push @Parent, $self;
+	@{"$class\:\:ISA"} = 'MM';
+    }
+
+    if (defined $Parent[-2]){
+	$self->{PARENT} = $Parent[-2];
+	my $key;
+	for $key (keys %Prepend_dot_dot) {
+	    next unless defined $self->{PARENT}{$key};
+	    $self->{$key} = $self->{PARENT}{$key};
+	    $self->{$key} = $self->catdir("..",$self->{$key})
+		unless $self->file_name_is_absolute($self->{$key});
+	}
+	$self->{PARENT}->{CHILDREN}->{$class} = $self if $self->{PARENT};
+    } else {
+	parse_args($self,@ARGV);
+    }
+
+    $self->{NAME} ||= $self->guess_name;
+
+    ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
+
+    $self->init_main();
+
+    if (! $self->{PERL_SRC} ) {
+	my($pthinks) = $INC{'Config.pm'};
+	$pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS;
+	if ($pthinks ne $self->catfile($Config{archlibexp},'Config.pm')){
+	    $pthinks =~ s!/Config\.pm$!!;
+	    $pthinks =~ s!.*/!!;
+	    print STDOUT <<END;
+Your perl and your Config.pm seem to have different ideas about the architecture
+they are running on.
+Perl thinks: [$pthinks]
+Config says: [$Config{archname}]
+This may or may not cause problems. Please check your installation of perl if you
+have problems building this extension.
+END
+	}
+    }
+
+    $self->init_dirscan();
+    $self->init_others();
+
+    push @{$self->{RESULT}}, <<END;
+# This Makefile is for the $self->{NAME} extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# $VERSION (Revision: $Revision) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+#	ANY CHANGES MADE HERE WILL BE LOST!
+#
+#   MakeMaker Parameters:
+END
+
+    foreach $key (sort keys %initial_att){
+	my($v) = neatvalue($initial_att{$key});
+	$v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
+	$v =~ tr/\n/ /s;
+	push @{$self->{RESULT}}, "#	$key => $v";
+    }
+
+    # turn the SKIP array into a SKIPHASH hash
+    my (%skip,$skip);
+    for $skip (@{$self->{SKIP} || []}) {
+	$self->{SKIPHASH}{$skip} = 1;
+    }
+    delete $self->{SKIP}; # free memory
+
+    if ($self->{PARENT}) {
+	for (qw/install dist dist_basics dist_core dist_dir dist_test dist_ci/) {
+	    $self->{SKIPHASH}{$_} = 1;
+	}
+    }
+
+    # We run all the subdirectories now. They don't have much to query
+    # from the parent, but the parent has to query them: if they need linking!
+    unless ($self->{NORECURS}) {
+	$self->eval_in_subdirs if @{$self->{DIR}};
+    }
+
+    my $section;
+    foreach $section ( @MM_Sections ){
+	print "Processing Makefile '$section' section\n" if ($Verbose >= 2);
+	my($skipit) = $self->skipcheck($section);
+	if ($skipit){
+	    push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit.";
+	} else {
+	    my(%a) = %{$self->{$section} || {}};
+	    push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:";
+	    push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a;
+	    push @{$self->{RESULT}}, $self->nicetext($self->$section( %a ));
+	}
+    }
+
+    push @{$self->{RESULT}}, "\n# End.";
+    pop @Parent;
+
+    $self;
+}
+
+sub check_manifest {
+    print STDOUT "Checking if your kit is complete...\n";
+    require ExtUtils::Manifest;
+    $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning
+    my(@missed)=ExtUtils::Manifest::manicheck();
+    if (@missed){
+	print STDOUT "Warning: the following files are missing in your kit:\n";
+	print "\t", join "\n\t", @missed;
+	print STDOUT "\n";
+	print STDOUT "Please inform the author.\n";
+    } else {
+	print STDOUT "Looks good\n";
+    }
+}
+
+sub parse_args{
+    my($self, @args) = @_;
+    foreach (@args){
+	unless (m/(.*?)=(.*)/){
+	    help(),exit 1 if m/^help$/;
+	    ++$Verbose if m/^verb/;
+	    next;
+	}
+	my($name, $value) = ($1, $2);
+	if ($value =~ m/^~(\w+)?/){ # tilde with optional username
+	    $value =~ s [^~(\w*)]
+		[$1 ?
+		 ((getpwnam($1))[7] || "~$1") :
+		 (getpwuid($>))[7]
+		 ]ex;
+	}
+	# This may go away, in mid 1996
+	if ($self->{Correct_relativ_directories}){
+	    $value = $self->catdir("..",$value)
+		if $Prepend_dot_dot{$name} && ! $self->file_name_is_absolute($value);
+	}
+	$self->{uc($name)} = $value;
+    }
+    # This may go away, in mid 1996
+    delete $self->{Correct_relativ_directories};
+
+    # catch old-style 'potential_libs' and inform user how to 'upgrade'
+    if (defined $self->{potential_libs}){
+	my($msg)="'potential_libs' => '$self->{potential_libs}' should be";
+	if ($self->{potential_libs}){
+	    print STDOUT "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n";
+	} else {
+	    print STDOUT "$msg deleted.\n";
+	}
+	$self->{LIBS} = [$self->{potential_libs}];
+	delete $self->{potential_libs};
+    }
+    # catch old-style 'ARMAYBE' and inform user how to 'upgrade'
+    if (defined $self->{ARMAYBE}){
+	my($armaybe) = $self->{ARMAYBE};
+	print STDOUT "ARMAYBE => '$armaybe' should be changed to:\n",
+			"\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n";
+	my(%dl) = %{$self->{dynamic_lib} || {}};
+	$self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe};
+	delete $self->{ARMAYBE};
+    }
+    if (defined $self->{LDTARGET}){
+	print STDOUT "LDTARGET should be changed to LDFROM\n";
+	$self->{LDFROM} = $self->{LDTARGET};
+	delete $self->{LDTARGET};
+    }
+    # Turn a DIR argument on the command line into an array
+    if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') {
+	# So they can choose from the command line, which extensions they want
+	# the grep enables them to have some colons too much in case they
+	# have to build a list with the shell
+	$self->{DIR} = [grep $_, split ":", $self->{DIR}];
+    }
+    # Turn a INCLUDE_EXT argument on the command line into an array
+    if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') {
+	$self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}];
+    }
+    # Turn a EXCLUDE_EXT argument on the command line into an array
+    if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') {
+	$self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}];
+    }
+    my $mmkey;
+    foreach $mmkey (sort keys %$self){
+	print STDOUT "	$mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose;
+	print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n"
+	    unless exists $Recognized_Att_Keys{$mmkey};
+    }
+    $| = 1 if $Verbose;
+}
+
+sub check_hints {
+    my($self) = @_;
+    # We allow extension-specific hints files.
+
+    return unless -d "hints";
+
+    # First we look for the best hintsfile we have
+    my(@goodhints);
+    my($hint)="${^O}_$Config{osvers}";
+    $hint =~ s/\./_/g;
+    $hint =~ s/_$//;
+    return unless $hint;
+
+    # Also try without trailing minor version numbers.
+    while (1) {
+	last if -f "hints/$hint.pl";      # found
+    } continue {
+	last unless $hint =~ s/_[^_]*$//; # nothing to cut off
+    }
+    return unless -f "hints/$hint.pl";    # really there
+
+    # execute the hintsfile:
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+#    $fh->open("hints/$hint.pl");
+    local *FH;
+    open(FH,"hints/$hint.pl");
+#    @goodhints = <$fh>;
+    @goodhints = <FH>;
+#    $fh->close;
+    close FH;
+    print STDOUT "Processing hints file hints/$hint.pl\n";
+    eval join('',@goodhints);
+    print STDOUT $@ if $@;
+}
+
+sub mv_all_methods {
+    my($from,$to) = @_;
+    my($method);
+    my($symtab) = \%{"${from}::"};
+#    no strict;
+
+    # Here you see the *current* list of methods that are overridable
+    # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm
+    # still trying to reduce the list to some reasonable minimum --
+    # because I want to make it easier for the user. A.K.
+
+    foreach $method (@Overridable) {
+
+	# We cannot say "next" here. Nick might call MY->makeaperl
+	# which isn't defined right now
+
+	# Above statement was written at 4.23 time when Tk-b8 was
+	# around. As Tk-b9 only builds with 5.002something and MM 5 is
+	# standard, we try to enable the next line again. It was
+	# commented out until MM 5.23
+
+	next unless defined &{"${from}::$method"};
+
+	*{"${to}::$method"} = \&{"${from}::$method"};
+
+	# delete would do, if we were sure, nobody ever called
+	# MY->makeaperl directly
+	
+	# delete $symtab->{$method};
+	
+	# If we delete a method, then it will be undefined and cannot
+	# be called.  But as long as we have Makefile.PLs that rely on
+	# %MY:: being intact, we have to fill the hole with an
+	# inheriting method:
+
+	eval "package MY; sub $method { shift->SUPER::$method(\@_); }";
+    }
+
+    # We have to clean out %INC also, because the current directory is
+    # changed frequently and Graham Barr prefers to get his version
+    # out of a History.pl file which is "required" so woudn't get
+    # loaded again in another extension requiring a History.pl
+
+    # With perl5.002_01 the deletion of entries in %INC caused Tk-b11
+    # to core dump in the middle of a require statement. The required
+    # file was Tk/MMutil.pm.  The consequence is, we have to be
+    # extremely careful when we try to give perl a reason to reload a
+    # library with same name.  The workaround prefers to drop nothing
+    # from %INC and teach the writers not to use such libraries.
+
+#    my $inc;
+#    foreach $inc (keys %INC) {
+#	#warn "***$inc*** deleted";
+#	delete $INC{$inc};
+#    }
+}
+
+sub skipcheck {
+    my($self) = shift;
+    my($section) = @_;
+    if ($section eq 'dynamic') {
+	print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ",
+	"in skipped section 'dynamic_bs'\n"
+            if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
+        print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ",
+	"in skipped section 'dynamic_lib'\n"
+            if $self->{SKIPHASH}{dynamic_lib} && $Verbose;
+    }
+    if ($section eq 'dynamic_lib') {
+        print STDOUT "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ",
+	"targets in skipped section 'dynamic_bs'\n"
+            if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
+    }
+    if ($section eq 'static') {
+        print STDOUT "Warning (non-fatal): Target 'static' depends on targets ",
+	"in skipped section 'static_lib'\n"
+            if $self->{SKIPHASH}{static_lib} && $Verbose;
+    }
+    return 'skipped' if $self->{SKIPHASH}{$section};
+    return '';
+}
+
+sub flush {
+    my $self = shift;
+    my($chunk);
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+    local *FH;
+    print STDOUT "Writing $self->{MAKEFILE} for $self->{NAME}\n";
+
+    unlink($self->{MAKEFILE}, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : '');
+#    $fh->open(">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!";
+    open(FH,">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!";
+
+    for $chunk (@{$self->{RESULT}}) {
+#	print $fh "$chunk\n";
+	print FH "$chunk\n";
+    }
+
+#    $fh->close;
+    close FH;
+    my($finalname) = $self->{MAKEFILE};
+    rename("MakeMaker.tmp", $finalname);
+    chmod 0644, $finalname unless $Is_VMS;
+
+    if ($self->{PARENT}) {
+	foreach (keys %$self) { # safe memory
+	    delete $self->{$_} unless $Keep_after_flush{$_};
+	}
+    }
+
+    system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":";
+}
+
+# The following mkbootstrap() is only for installations that are calling
+# the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker
+# writes Makefiles, that use ExtUtils::Mkbootstrap directly.
+sub mkbootstrap {
+    die <<END;
+!!! Your Makefile has been built such a long time ago, !!!
+!!! that is unlikely to work with current MakeMaker.   !!!
+!!! Please rebuild your Makefile                       !!!
+END
+}
+
+# Ditto for mksymlists() as of MakeMaker 5.17
+sub mksymlists {
+    die <<END;
+!!! Your Makefile has been built such a long time ago, !!!
+!!! that is unlikely to work with current MakeMaker.   !!!
+!!! Please rebuild your Makefile                       !!!
+END
+}
+
+sub neatvalue {
+    my($v) = @_;
+    return "undef" unless defined $v;
+    my($t) = ref $v;
+    return "q[$v]" unless $t;
+    if ($t eq 'ARRAY') {
+	my(@m, $elem, @neat);
+	push @m, "[";
+	foreach $elem (@$v) {
+	    push @neat, "q[$elem]";
+	}
+	push @m, join ", ", @neat;
+	push @m, "]";
+	return join "", @m;
+    }
+    return "$v" unless $t eq 'HASH';
+    my(@m, $key, $val);
+    while (($key,$val) = each %$v){
+	last unless defined $key; # cautious programming in case (undef,undef) is true
+	push(@m,"$key=>".neatvalue($val)) ;
+    }
+    return "{ ".join(', ',@m)." }";
+}
+
+sub selfdocument {
+    my($self) = @_;
+    my(@m);
+    if ($Verbose){
+	push @m, "\n# Full list of MakeMaker attribute values:";
+	foreach $key (sort keys %$self){
+	    next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/;
+	    my($v) = neatvalue($self->{$key});
+	    $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
+	    $v =~ tr/\n/ /s;
+	    push @m, "#	$key => $v";
+	}
+    }
+    join "\n", @m;
+}
+
+package ExtUtils::MakeMaker;
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::MakeMaker - create an extension Makefile
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::MakeMaker;>
+
+C<WriteMakefile( ATTRIBUTE =E<gt> VALUE [, ...] );>
+
+which is really
+
+C<MM-E<gt>new(\%att)-E<gt>flush;>
+
+=head1 DESCRIPTION
+
+This utility is designed to write a Makefile for an extension module
+from a Makefile.PL. It is based on the Makefile.SH model provided by
+Andy Dougherty and the perl5-porters.
+
+It splits the task of generating the Makefile into several subroutines
+that can be individually overridden.  Each subroutine returns the text
+it wishes to have written to the Makefile.
+
+MakeMaker is object oriented. Each directory below the current
+directory that contains a Makefile.PL. Is treated as a separate
+object. This makes it possible to write an unlimited number of
+Makefiles with a single invocation of WriteMakefile().
+
+=head2 How To Write A Makefile.PL
+
+The short answer is: Don't. Run h2xs(1) before you start thinking
+about writing a module. For so called pm-only modules that consist of
+C<*.pm> files only, h2xs has the very useful C<-X> switch. This will
+generate dummy files of all kinds that are useful for the module
+developer.
+
+The medium answer is:
+
+    use ExtUtils::MakeMaker;
+    WriteMakefile( NAME => "Foo::Bar" );
+
+The long answer is below.
+
+=head2 Default Makefile Behaviour
+
+The generated Makefile enables the user of the extension to invoke
+
+  perl Makefile.PL # optionally "perl Makefile.PL verbose"
+  make
+  make test        # optionally set TEST_VERBOSE=1
+  make install     # See below
+
+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
+
+Other interesting targets in the generated Makefile are
+
+  make config     # to check if the Makefile is up-to-date
+  make clean      # delete local temp files (Makefile gets renamed)
+  make realclean  # delete derived files (including ./blib)
+  make ci         # check in all the files in the MANIFEST file
+  make dist       # see below the Distribution Support section
+
+=head2 make test
+
+MakeMaker checks for the existence of a file named "test.pl" in the
+current directory and if it exists it adds commands to the test target
+of the generated Makefile that will execute the script with the proper
+set of perl C<-I> options.
+
+MakeMaker also checks for any files matching glob("t/*.t"). It will
+add commands to the test target of the generated Makefile that execute
+all matching files via the L<Test::Harness> module with the C<-I>
+switches set correctly.
+
+=head2 make install
+
+make alone puts all relevant files into directories that are named by
+the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR, and
+INST_MAN3DIR. All these default to something below ./blib if you are
+I<not> building below the perl source directory. If you I<are>
+building below the perl source, INST_LIB and INST_ARCHLIB default to
+../../lib, and INST_SCRIPT is not defined.
+
+The I<install> target of the generated Makefile copies the files found
+below each of the INST_* directories to their INSTALL*
+counterparts. Which counterparts are chosen depends on the setting of
+INSTALLDIRS according to the following table:
+
+		       	   INSTALLDIRS set to
+       	       	        perl   	          site
+
+    INST_ARCHLIB    INSTALLARCHLIB    INSTALLSITEARCH
+    INST_LIB        INSTALLPRIVLIB    INSTALLSITELIB
+    INST_BIN                  INSTALLBIN
+    INST_SCRIPT              INSTALLSCRIPT
+    INST_MAN1DIR             INSTALLMAN1DIR
+    INST_MAN3DIR             INSTALLMAN3DIR
+
+The INSTALL... macros in turn default to their %Config
+($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts.
+
+You can check the values of these variables on your system with
+
+    perl -MConfig -le 'print join $/, map 
+        sprintf("%20s: %s", $_, $Config{$_}),
+        grep /^install/, keys %Config'
+
+And to check the sequence in which the library directories are
+searched by perl, run
+
+    perl -le 'print join $/, @INC'
+
+
+=head2 PREFIX attribute
+
+The PREFIX attribute can be used to set the INSTALL* attributes in one
+go. The quickest way to install a module in a non-standard place
+
+    perl Makefile.PL PREFIX=~
+
+This will replace the string specified by $Config{prefix} in all
+$Config{install*} values.
+
+Note, that the tilde expansion is done by MakeMaker, not by perl by
+default, nor by make.
+
+If the user has superuser privileges, and is not working on AFS
+(Andrew File System) or relatives, then the defaults for
+INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate,
+and this incantation will be the best:
+
+    perl Makefile.PL; make; make test
+    make install
+
+make install per default writes some documentation of what has been
+done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This feature
+can be bypassed by calling make pure_install.
+
+=head2 AFS users
+
+will have to specify the installation directories as these most
+probably have changed since perl itself has been installed. They will
+have to do this by calling
+
+    perl Makefile.PL INSTALLSITELIB=/afs/here/today \
+	INSTALLSCRIPT=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages
+    make
+
+Be careful to repeat this procedure every time you recompile an
+extension, unless you are sure the AFS installation directories are
+still valid.
+
+=head2 Static Linking of a new Perl Binary
+
+An extension that is built with the above steps is ready to use on
+systems supporting dynamic loading. On systems that do not support
+dynamic loading, any newly created extension has to be linked together
+with the available resources. MakeMaker supports the linking process
+by creating appropriate targets in the Makefile whenever an extension
+is built. You can invoke the corresponding section of the makefile with
+
+    make perl
+
+That produces a new perl binary in the current directory with all
+extensions linked in that can be found in INST_ARCHLIB , SITELIBEXP,
+and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on
+UNIX, this is called Makefile.aperl (may be system dependent). If you
+want to force the creation of a new perl, it is recommended, that you
+delete this Makefile.aperl, so the directories are searched-through
+for linkable libraries again.
+
+The binary can be installed into the directory where perl normally
+resides on your machine with
+
+    make inst_perl
+
+To produce a perl binary with a different name than C<perl>, either say
+
+    perl Makefile.PL MAP_TARGET=myperl
+    make myperl
+    make inst_perl
+
+or say
+
+    perl Makefile.PL
+    make myperl MAP_TARGET=myperl
+    make inst_perl MAP_TARGET=myperl
+
+In any case you will be prompted with the correct invocation of the
+C<inst_perl> target that installs the new binary into INSTALLBIN.
+
+make inst_perl per default writes some documentation of what has been
+done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This
+can be bypassed by calling make pure_inst_perl.
+
+Warning: the inst_perl: target will most probably overwrite your
+existing perl binary. Use with care!
+
+Sometimes you might want to build a statically linked perl although
+your system supports dynamic loading. In this case you may explicitly
+set the linktype with the invocation of the Makefile.PL or make:
+
+    perl Makefile.PL LINKTYPE=static    # recommended
+
+or
+
+    make LINKTYPE=static                # works on most systems
+
+=head2 Determination of Perl Library and Installation Locations
+
+MakeMaker needs to know, or to guess, where certain things are
+located.  Especially INST_LIB and INST_ARCHLIB (where to put the files
+during the make(1) run), PERL_LIB and PERL_ARCHLIB (where to read
+existing modules from), and PERL_INC (header files and C<libperl*.*>).
+
+Extensions may be built either using the contents of the perl source
+directory tree or from the installed perl library. The recommended way
+is to build extensions after you have run 'make install' on perl
+itself. You can do that in any directory on your hard disk that is not
+below the perl source tree. The support for extensions below the ext
+directory of the perl distribution is only good for the standard
+extensions that come with perl.
+
+If an extension is being built below the C<ext/> directory of the perl
+source then MakeMaker will set PERL_SRC automatically (e.g.,
+C<../..>).  If PERL_SRC is defined and the extension is recognized as
+a standard extension, then other variables default to the following:
+
+  PERL_INC     = PERL_SRC
+  PERL_LIB     = PERL_SRC/lib
+  PERL_ARCHLIB = PERL_SRC/lib
+  INST_LIB     = PERL_LIB
+  INST_ARCHLIB = PERL_ARCHLIB
+
+If an extension is being built away from the perl source then MakeMaker
+will leave PERL_SRC undefined and default to using the installed copy
+of the perl library. The other variables default to the following:
+
+  PERL_INC     = $archlibexp/CORE
+  PERL_LIB     = $privlibexp
+  PERL_ARCHLIB = $archlibexp
+  INST_LIB     = ./blib/lib
+  INST_ARCHLIB = ./blib/arch
+
+If perl has not yet been installed then PERL_SRC can be defined on the
+command line as shown in the previous section.
+
+
+=head2 Which architecture dependent directory?
+
+If you don't want to keep the defaults for the INSTALL* macros,
+MakeMaker helps you to minimize the typing needed: the usual
+relationship between INSTALLPRIVLIB and INSTALLARCHLIB is determined
+by Configure at perl compilation time. MakeMaker supports the user who
+sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not,
+then MakeMaker defaults the latter to be the same subdirectory of
+INSTALLPRIVLIB as Configure decided for the counterparts in %Config ,
+otherwise it defaults to INSTALLPRIVLIB. The same relationship holds
+for INSTALLSITELIB and INSTALLSITEARCH.
+
+MakeMaker gives you much more freedom than needed to configure
+internal variables and get different results. It is worth to mention,
+that make(1) also lets you configure most of the variables that are
+used in the Makefile. But in the majority of situations this will not
+be necessary, and should only be done, if the author of a package
+recommends it (or you know what you're doing).
+
+=head2 Using Attributes and Parameters
+
+The following attributes can be specified as arguments to WriteMakefile()
+or as NAME=VALUE pairs on the command line:
+
+=cut
+
+# The following "=item C" is used by the attrib_help routine
+# likewise the "=back" below. So be careful when changing it!
+
+=over 2
+
+=item C
+
+Ref to array of *.c file names. Initialised from a directory scan
+and the values portion of the XS attribute hash. This is not
+currently used by MakeMaker but may be handy in Makefile.PLs.
+
+=item CONFIG
+
+Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from
+config.sh. MakeMaker will add to CONFIG the following values anyway:
+ar
+cc
+cccdlflags
+ccdlflags
+dlext
+dlsrc
+ld
+lddlflags
+ldflags
+libc
+lib_ext
+obj_ext
+ranlib
+sitelibexp
+sitearchexp
+so
+
+=item CONFIGURE
+
+CODE reference. The subroutine should return a hash reference. The
+hash may contain further attributes, e.g. {LIBS => ...}, that have to
+be determined by some evaluation method.
+
+=item DEFINE
+
+Something like C<"-DHAVE_UNISTD_H">
+
+=item DIR
+
+Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm'
+] in ext/SDBM_File
+
+=item DISTNAME
+
+Your name for distributing the package (by tar file). This defaults to
+NAME above.
+
+=item DL_FUNCS
+
+Hashref of symbol names for routines to be made available as
+universal symbols.  Each key/value pair consists of the package name
+and an array of routine names in that package.  Used only under AIX
+(export lists) and VMS (linker options) at present.  The routine
+names supplied will be expanded in the same way as XSUB names are
+expanded by the XS() macro.  Defaults to
+
+  {"$(NAME)" => ["boot_$(NAME)" ] }
+
+e.g.
+
+  {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
+   "NetconfigPtr" => [ 'DESTROY'] }
+
+=item DL_VARS
+
+Array of symbol names for variables to be made available as
+universal symbols.  Used only under AIX (export lists) and VMS
+(linker options) at present.  Defaults to [].  (e.g. [ qw(
+Foo_version Foo_numstreams Foo_tree ) ])
+
+=item EXCLUDE_EXT
+
+Array of extension names to exclude when doing a static build.  This
+is ignored if INCLUDE_EXT is present.  Consult INCLUDE_EXT for more
+details.  (e.g.  [ qw( Socket POSIX ) ] )
+
+This attribute may be most useful when specified as a string on the
+commandline:  perl Makefile.PL EXCLUDE_EXT='Socket Safe'
+
+=item EXE_FILES
+
+Ref to array of executable files. The files will be copied to the
+INST_SCRIPT directory. Make realclean will delete them from there
+again.
+
+=item NO_VC
+
+In general any generated Makefile checks for the current version of
+MakeMaker and the version the Makefile was built under. If NO_VC is
+set, the version check is neglected. Do not write this into your
+Makefile.PL, use it interactively instead.
+
+=item FIRST_MAKEFILE
+
+The name of the Makefile to be produced. Defaults to the contents of
+MAKEFILE, but can be overridden. This is used for the second Makefile
+that will be produced for the MAP_TARGET.
+
+=item FULLPERL
+
+Perl binary able to run this extension.
+
+=item H
+
+Ref to array of *.h file names. Similar to C.
+
+=item INC
+
+Include file dirs eg: C<"-I/usr/5include -I/path/to/inc">
+
+=item INCLUDE_EXT
+
+Array of extension names to be included when doing a static build.
+MakeMaker will normally build with all of the installed extensions when
+doing a static build, and that is usually the desired behavior.  If
+INCLUDE_EXT is present then MakeMaker will build only with those extensions
+which are explicitly mentioned. (e.g.  [ qw( Socket POSIX ) ])
+
+It is not necessary to mention DynaLoader or the current extension when
+filling in INCLUDE_EXT.  If the INCLUDE_EXT is mentioned but is empty then
+only DynaLoader and the current extension will be included in the build.
+
+This attribute may be most useful when specified as a string on the
+commandline:  perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
+
+=item INSTALLARCHLIB
+
+Used by 'make install', which copies files from INST_ARCHLIB to this
+directory if INSTALLDIRS is set to perl.
+
+=item INSTALLBIN
+
+Directory to install binary files (e.g. tkperl) into.
+
+=item INSTALLDIRS
+
+Determines which of the two sets of installation directories to
+choose: installprivlib and installarchlib versus installsitelib and
+installsitearch. The first pair is chosen with INSTALLDIRS=perl, the
+second with INSTALLDIRS=site. Default is site.
+
+=item INSTALLMAN1DIR
+
+This directory gets the man pages at 'make install' time. Defaults to
+$Config{installman1dir}.
+
+=item INSTALLMAN3DIR
+
+This directory gets the man pages at 'make install' time. Defaults to
+$Config{installman3dir}.
+
+=item INSTALLPRIVLIB
+
+Used by 'make install', which copies files from INST_LIB to this
+directory if INSTALLDIRS is set to perl.
+
+=item INSTALLSCRIPT
+
+Used by 'make install' which copies files from INST_SCRIPT to this
+directory.
+
+=item INSTALLSITELIB
+
+Used by 'make install', which copies files from INST_LIB to this
+directory if INSTALLDIRS is set to site (default).
+
+=item INSTALLSITEARCH
+
+Used by 'make install', which copies files from INST_ARCHLIB to this
+directory if INSTALLDIRS is set to site (default).
+
+=item INST_ARCHLIB
+
+Same as INST_LIB for architecture dependent files.
+
+=item INST_BIN
+
+Directory to put real binary files during 'make'. These will be copied
+to INSTALLBIN during 'make install'
+
+=item INST_EXE
+
+Old name for INST_SCRIPT. Deprecated. Please use INST_SCRIPT if you
+need to use it.
+
+=item INST_LIB
+
+Directory where we put library files of this extension while building
+it.
+
+=item INST_MAN1DIR
+
+Directory to hold the man pages at 'make' time
+
+=item INST_MAN3DIR
+
+Directory to hold the man pages at 'make' time
+
+=item INST_SCRIPT
+
+Directory, where executable files should be installed during
+'make'. Defaults to "./blib/bin", just to have a dummy location during
+testing. make install will copy the files in INST_SCRIPT to
+INSTALLSCRIPT.
+
+=item LDFROM
+
+defaults to "$(OBJECT)" and is used in the ld command to specify
+what files to link/load from (also see dynamic_lib below for how to
+specify ld flags)
+
+=item LIBPERL_A
+
+The filename of the perllibrary that will be used together with this
+extension. Defaults to libperl.a.
+
+=item LIBS
+
+An anonymous array of alternative library
+specifications to be searched for (in order) until
+at least one library is found. E.g.
+
+  'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"]
+
+Mind, that any element of the array
+contains a complete set of arguments for the ld
+command. So do not specify
+
+  'LIBS' => ["-ltcl", "-ltk", "-lX11"]
+
+See ODBM_File/Makefile.PL for an example, where an array is needed. If
+you specify a scalar as in
+
+  'LIBS' => "-ltcl -ltk -lX11"
+
+MakeMaker will turn it into an array with one element.
+
+=item LINKTYPE
+
+'static' or 'dynamic' (default unless usedl=undef in
+config.sh). Should only be used to force static linking (also see
+linkext below).
+
+=item MAKEAPERL
+
+Boolean which tells MakeMaker, that it should include the rules to
+make a perl. This is handled automatically as a switch by
+MakeMaker. The user normally does not need it.
+
+=item MAKEFILE
+
+The name of the Makefile to be produced.
+
+=item MAN1PODS
+
+Hashref of pod-containing files. MakeMaker will default this to all
+EXE_FILES files that include POD directives. The files listed
+here will be converted to man pages and installed as was requested
+at Configure time.
+
+=item MAN3PODS
+
+Hashref of .pm and .pod files. MakeMaker will default this to all
+ .pod and any .pm files that include POD directives. The files listed
+here will be converted to man pages and installed as was requested
+at Configure time.
+
+=item MAP_TARGET
+
+If it is intended, that a new perl binary be produced, this variable
+may hold a name for that binary. Defaults to perl
+
+=item MYEXTLIB
+
+If the extension links to a library that it builds set this to the
+name of the library (see SDBM_File)
+
+=item NAME
+
+Perl module name for this extension (DBD::Oracle). This will default
+to the directory name but should be explicitly defined in the
+Makefile.PL.
+
+=item NEEDS_LINKING
+
+MakeMaker will figure out, if an extension contains linkable code
+anywhere down the directory tree, and will set this variable
+accordingly, but you can speed it up a very little bit, if you define
+this boolean variable yourself.
+
+=item NOECHO
+
+Defaults to C<@>. By setting it to an empty string you can generate a
+Makefile that echos all commands. Mainly used in debugging MakeMaker
+itself.
+
+=item NORECURS
+
+Boolean.  Attribute to inhibit descending into subdirectories.
+
+=item OBJECT
+
+List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
+string containing all object files, e.g. "tkpBind.o
+tkpButton.o tkpCanvas.o"
+
+=item OPTIMIZE
+
+Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is
+passed to subdirectory makes.
+
+=item PERL
+
+Perl binary for tasks that can be done by miniperl
+
+=item PERLMAINCC
+
+The call to the program that is able to compile perlmain.c. Defaults
+to $(CC).
+
+=item PERL_ARCHLIB
+
+Same as above for architecture dependent files
+
+=item PERL_LIB
+
+Directory containing the Perl library to use.
+
+=item PERL_SRC
+
+Directory containing the Perl source code (use of this should be
+avoided, it may be undefined)
+
+=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.
+
+  {'foobar.PL' => 'foobar'}
+
+The *.PL files are expected to produce output to the target files
+themselves.
+
+=item PM
+
+Hashref of .pm files and *.pl files to be installed.  e.g.
+
+  {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'}
+
+By default this will include *.pm and *.pl. If a lib directory
+exists and is not listed in DIR (above) then any *.pm and *.pl files
+it contains will also be included by default.  Defining PM in the
+Makefile.PL will override PMLIBDIRS.
+
+=item PMLIBDIRS
+
+Ref to array of subdirectories containing library files.  Defaults to
+[ 'lib', $(BASEEXT) ]. The directories will be scanned and any files
+they contain will be installed in the corresponding location in the
+library.  A libscan() method can be used to alter the behaviour.
+Defining PM in the Makefile.PL will override PMLIBDIRS.
+
+=item PREFIX
+
+Can be used to set the three INSTALL* attributes in one go (except for
+probably INSTALLMAN1DIR, if it is not below PREFIX according to
+%Config).  They will have PREFIX as a common directory node and will
+branch from that node into lib/, lib/ARCHNAME or whatever Configure
+decided at the build time of your perl (unless you override one of
+them, of course).
+
+=item PREREQ_PM
+
+Hashref: Names of modules that need to be available to run this
+extension (e.g. Fcntl for SDBM_File) are the keys of the hash and the
+desired version is the value. If the required version number is 0, we
+only check if any version is installed already.
+
+=item SKIP
+
+Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the
+Makefile. Caution! Do not use the SKIP attribute for the neglectible
+speedup. It may seriously damage the resulting Makefile. Only use it,
+if you really need it.
+
+=item TYPEMAPS
+
+Ref to array of typemap file names.  Use this when the typemaps are
+in some directory other than the current directory or when they are
+not named B<typemap>.  The last typemap in the list takes
+precedence.  A typemap in the current directory has highest
+precedence, even if it isn't listed in TYPEMAPS.  The default system
+typemap has lowest precedence.
+
+=item VERSION
+
+Your version number for distributing the package.  This defaults to
+0.1.
+
+=item VERSION_FROM
+
+Instead of specifying the VERSION in the Makefile.PL you can let
+MakeMaker parse a file to determine the version number. The parsing
+routine requires that the file named by VERSION_FROM contains one
+single line to compute the version number. The first line in the file
+that contains the regular expression
+
+    /(\$[\w:]*\bVERSION)\b.*=/
+
+will be evaluated with eval() and the value of the named variable
+B<after> the eval() will be assigned to the VERSION attribute of the
+MakeMaker object. The following lines will be parsed o.k.:
+
+    $VERSION = '1.00';
+    ( $VERSION ) = '$Revision: 1.1 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    $FOO::VERSION = '1.10';
+
+but these will fail:
+
+    my $VERSION = '1.01';
+    local $VERSION = '1.02';
+    local $FOO::VERSION = '1.30';
+
+The file named in VERSION_FROM is added as a dependency to Makefile to
+guarantee, that the Makefile contains the correct VERSION macro after
+a change of the file.
+
+=item XS
+
+Hashref of .xs files. MakeMaker will default this.  e.g.
+
+  {'name_of_file.xs' => 'name_of_file.c'}
+
+The .c files will automatically be included in the list of files
+deleted by a make clean.
+
+=item XSOPT
+
+String of options to pass to xsubpp.  This might include C<-C++> or
+C<-extern>.  Do not include typemaps here; the TYPEMAP parameter exists for
+that purpose.
+
+=item XSPROTOARG
+
+May be set to an empty string, which is identical to C<-prototypes>, or
+C<-noprototypes>. See the xsubpp documentation for details. MakeMaker
+defaults to the empty string.
+
+=item XS_VERSION
+
+Your version number for the .xs file of this package.  This defaults
+to the value of the VERSION attribute.
+
+=back
+
+=head2 Additional lowercase attributes
+
+can be used to pass parameters to the methods which implement that
+part of the Makefile.
+
+=over 2
+
+=item clean
+
+  {FILES => "*.xyz foo"}
+
+=item depend
+
+  {ANY_TARGET => ANY_DEPENDECY, ...}
+
+=item dist
+
+  {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz',
+  SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip',
+  ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' }
+
+If you specify COMPRESS, then SUFFIX should also be altered, as it is
+needed to tell make the target file of the compression. Setting
+DIST_CP to ln can be useful, if you need to preserve the timestamps on
+your files. DIST_CP can take the values 'cp', which copies the file,
+'ln', which links the file, and 'best' which copies symbolic links and
+links the rest. Default is 'best'.
+
+=item dynamic_lib
+
+  {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'}
+
+=item installpm
+
+Deprecated as of MakeMaker 5.23. See L<ExtUtils::MM_Unix/pm_to_blib>.
+
+=item linkext
+
+  {LINKTYPE => 'static', 'dynamic' or ''}
+
+NB: Extensions that have nothing but *.pm files had to say
+
+  {LINKTYPE => ''}
+
+with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line
+can be deleted safely. MakeMaker recognizes, when there's nothing to
+be linked.
+
+=item macro
+
+  {ANY_MACRO => ANY_VALUE, ...}
+
+=item realclean
+
+  {FILES => '$(INST_ARCHAUTODIR)/*.xyz'}
+
+=item tool_autosplit
+
+  {MAXLEN =E<gt> 8}
+
+=back
+
+=cut
+
+# bug in pod2html, so leave the =back
+
+# Don't delete this cut, MM depends on it!
+
+=head2 Overriding MakeMaker Methods
+
+If you cannot achieve the desired Makefile behaviour by specifying
+attributes you may define private subroutines in the Makefile.PL.
+Each subroutines returns the text it wishes to have written to
+the Makefile. To override a section of the Makefile you can
+either say:
+
+	sub MY::c_o { "new literal text" }
+
+or you can edit the default by saying something like:
+
+	sub MY::c_o {
+            my($inherited) = shift->SUPER::c_o(@_);
+	    $inherited =~ s/old text/new text/;
+	    $inherited;
+	}
+
+If you running experiments with embedding perl as a library into other
+applications, you might find MakeMaker not sufficient. You'd better
+have a look at ExtUtils::embed which is a collection of utilities for
+embedding.
+
+If you still need a different solution, try to develop another
+subroutine, that fits your needs and submit the diffs to
+F<perl5-porters@nicoh.com> or F<comp.lang.perl.misc> as appropriate.
+
+For a complete description of all MakeMaker methods see L<ExtUtils::MM_Unix>.
+
+Here is a simple example of how to add a new target to the generated
+Makefile:
+
+    sub MY::postamble {
+	'
+    $(MYEXTLIB): sdbm/Makefile
+	    cd sdbm && $(MAKE) all
+    ';
+    }
+
+
+=head2 Hintsfile support
+
+MakeMaker.pm uses the architecture specific information from
+Config.pm. In addition it evaluates architecture specific hints files
+in a C<hints/> directory. The hints files are expected to be named
+like their counterparts in C<PERL_SRC/hints>, but with an C<.pl> file
+name extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by
+MakeMaker within the WriteMakefile() subroutine, and can be used to
+execute commands as well as to include special variables. The rules
+which hintsfile is chosen are the same as in Configure.
+
+The hintsfile is eval()ed immediately after the arguments given to
+WriteMakefile are stuffed into a hash reference $self but before this
+reference becomes blessed. So if you want to do the equivalent to
+override or create an attribute you would say something like
+
+    $self->{LIBS} = ['-ldbm -lucb -lc'];
+
+=head2 Distribution Support
+
+For authors of extensions MakeMaker provides several Makefile
+targets. Most of the support comes from the ExtUtils::Manifest module,
+where additional documentation can be found.
+
+=over 4
+
+=item    make distcheck
+
+reports which files are below the build directory but not in the
+MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for
+details)
+
+=item    make skipcheck
+
+reports which files are skipped due to the entries in the
+C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for
+details)
+
+=item    make distclean
+
+does a realclean first and then the distcheck. Note that this is not
+needed to build a new distribution as long as you are sure, that the
+MANIFEST file is ok.
+
+=item    make manifest
+
+rewrites the MANIFEST file, adding all remaining files found (See
+ExtUtils::Manifest::mkmanifest() for details)
+
+=item    make distdir
+
+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.
+
+=item	make disttest
+
+Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
+a make test in that directory.
+
+=item    make tardist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command, followed by $(TOUNIX), which defaults to a null command under
+UNIX, and will convert files in distribution directory to UNIX format
+otherwise. Next it runs C<tar> on that directory into a tarfile and
+deletes the directory. Finishes with a command $(POSTOP) which
+defaults to a null command.
+
+=item    make dist
+
+Defaults to $(DIST_DEFAULT) which in turn defaults to tardist.
+
+=item    make uutardist
+
+Runs a tardist first and uuencodes the tarfile.
+
+=item    make shdist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command. Next it runs C<shar> on that directory into a sharfile and
+deletes the intermediate directory again. Finishes with a command
+$(POSTOP) which defaults to a null command.  Note: For shdist to work
+properly a C<shar> program that can handle directories is mandatory.
+
+=item    make zipdist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a
+zipfile. Then deletes that directory. Finishes with a command
+$(POSTOP) which defaults to a null command.
+
+=item    make ci
+
+Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file.
+
+=back
+
+Customization of the dist targets can be done by specifying a hash
+reference to the dist attribute of the WriteMakefile call. The
+following parameters are recognized:
+
+    CI           ('ci -u')
+    COMPRESS     ('compress')
+    POSTOP       ('@ :')
+    PREOP        ('@ :')
+    TO_UNIX      (depends on the system)
+    RCS_LABEL    ('rcs -q -Nv$(VERSION_SYM):')
+    SHAR         ('shar')
+    SUFFIX       ('Z')
+    TAR          ('tar')
+    TARFLAGS     ('cvf')
+    ZIP          ('zip')
+    ZIPFLAGS     ('-r')
+
+An example:
+
+    WriteMakefile( 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" })
+
+=head1 SEE ALSO
+
+ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
+ExtUtils::Install, ExtUtils::embed
+
+=head1 AUTHORS
+
+Andy Dougherty F<E<lt>doughera@lafcol.lafayette.eduE<gt>>, Andreas
+KE<ouml>nig F<E<lt>A.Koenig@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce
+F<E<lt>Tim.Bunce@ig.co.ukE<gt>>.  VMS support by Charles Bailey
+F<E<lt>bailey@genetics.upenn.eduE<gt>>. OS/2 support by Ilya
+Zakharevich F<E<lt>ilya@math.ohio-state.eduE<gt>>. Contact the
+makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
+you have any questions.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
new file mode 100644
index 00000000000..9511dc24bd2
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
@@ -0,0 +1,392 @@
+package ExtUtils::Manifest;
+
+
+require Exporter;
+@ISA=('Exporter');
+@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
+	      'skipcheck', 'maniread', 'manicopy');
+
+use Config;
+use File::Find;
+use File::Copy 'copy';
+use Carp;
+
+$Debug = 0;
+$Verbose = 1;
+$Is_VMS = $^O eq 'VMS';
+
+$VERSION = $VERSION = substr(q$Revision: 1.1 $,10,4);
+
+$Quiet = 0;
+
+$MANIFEST = 'MANIFEST';
+
+# Really cool fix from Ilya :)
+unless (defined $Config{d_link}) {
+    *ln = \&cp;
+}
+
+sub mkmanifest {
+    my $manimiss = 0;
+    my $read = maniread() or $manimiss++;
+    $read = {} if $manimiss;
+    local *M;
+    rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
+    open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
+    my $matches = _maniskip();
+    my $found = manifind();
+    my($key,$val,$file,%all);
+    %all = (%$found, %$read);
+    $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
+        if $manimiss; # add new MANIFEST to known file list
+    foreach $file (sort keys %all) {
+	next if &$matches($file);
+	if ($Verbose){
+	    warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
+	}
+	my $text = $all{$file};
+	($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
+	my $tabs = (5 - (length($file)+1)/8);
+	$tabs = 1 if $tabs < 1;
+	$tabs = 0 unless $text;
+	print M $file, "\t" x $tabs, $text, "\n";
+    }
+    close M;
+}
+
+sub manifind {
+    local $found = {};
+    find(sub {return if -d $_;
+	      (my $name = $File::Find::name) =~ s|./||;
+	      warn "Debug: diskfile $name\n" if $Debug;
+	      $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
+	      $found->{$name} = "";}, ".");
+    $found;
+}
+
+sub fullcheck {
+    _manicheck(3);
+}
+
+sub manicheck {
+    return @{(_manicheck(1))[0]};
+}
+
+sub filecheck {
+    return @{(_manicheck(2))[1]};
+}
+
+sub skipcheck {
+    _manicheck(6);
+}
+
+sub _manicheck {
+    my($arg) = @_;
+    my $read = maniread();
+    my $file;
+    my(@missfile,@missentry);
+    if ($arg & 1){
+	my $found = manifind();
+	foreach $file (sort keys %$read){
+	    warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+	    unless ( exists $found->{$file} ) {
+		warn "No such file: $file\n" unless $Quiet;
+		push @missfile, $file;
+	    }
+	}
+    }
+    if ($arg & 2){
+	$read ||= {};
+	my $matches = _maniskip();
+	my $found = manifind();
+	my $skipwarn = $arg & 4;
+	foreach $file (sort keys %$found){
+	    if (&$matches($file)){
+		warn "Skipping $file\n" if $skipwarn;
+		next;
+	    }
+	    warn "Debug: manicheck checking from disk $file\n" if $Debug;
+	    unless ( exists $read->{$file} ) {
+		warn "Not in $MANIFEST: $file\n" unless $Quiet;
+		push @missentry, $file;
+	    }
+	}
+    }
+    (\@missfile,\@missentry);
+}
+
+sub maniread {
+    my ($mfile) = @_;
+    $mfile = $MANIFEST unless defined $mfile;
+    my $read = {};
+    local *M;
+    unless (open M, $mfile){
+	warn "$mfile: $!";
+	return $read;
+    }
+    while (<M>){
+	chomp;
+	if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
+	else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+    }
+    close M;
+    $read;
+}
+
+# returns an anonymous sub that decides if an argument matches
+sub _maniskip {
+    my ($mfile) = @_;
+    my $matches = sub {0};
+    my @skip ;
+    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
+    local *M;
+    return $matches unless -f $mfile;
+    open M, $mfile or return $matches;
+    while (<M>){
+	chomp;
+	next if /^\s*$/;
+	push @skip, $_;
+    }
+    close M;
+    my $opts = $Is_VMS ? 'oi ' : 'o ';
+    my $sub = "\$matches = "
+	. "sub { my(\$arg)=\@_; return 1 if "
+	. join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
+	. " }";
+    eval $sub;
+    print "Debug: $sub\n" if $Debug;
+    $matches;
+}
+
+sub manicopy {
+    my($read,$target,$how)=@_;
+    croak "manicopy() called without target argument" unless defined $target;
+    $how = 'cp' unless defined $how && $how;
+    require File::Path;
+    require File::Basename;
+    my(%dirs,$file);
+    $target = VMS::Filespec::unixify($target) if $Is_VMS;
+    umask 0 unless $Is_VMS;
+    File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
+    foreach $file (keys %$read){
+	$file = VMS::Filespec::unixify($file) if $Is_VMS;
+	if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
+	    my $dir = File::Basename::dirname($file);
+	    $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+	    File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
+	}
+	if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
+	else         { cp_if_diff($file, "$target/$file", $how); }
+    }
+}
+
+sub cp_if_diff {
+    my($from,$to, $how)=@_;
+    -f $from || carp "$0: $from not found";
+    my($diff) = 0;
+    local(*F,*T);
+    open(F,$from) or croak "Can't read $from: $!\n";
+    if (open(T,$to)) {
+	while (<F>) { $diff++,last if $_ ne <T>; }
+	$diff++ unless eof(T);
+	close T;
+    }
+    else { $diff++; }
+    close F;
+    if ($diff) {
+	if (-e $to) {
+	    unlink($to) or confess "unlink $to: $!";
+	}
+	&$how($from, $to);
+    }
+}
+
+# Do the comparisons here rather than spawning off another process
+sub vms_cp_if_diff {
+    my($from,$to) = @_;
+    my($diff) = 0;
+    local(*F,*T);
+    open(F,$from) or croak "Can't read $from: $!\n";
+    if (open(T,$to)) {
+	while (<F>) { $diff++,last if $_ ne <T>; }
+	$diff++ unless eof(T);
+	close T;
+    }
+    else { $diff++; }
+    close F;
+    if ($diff) {
+	system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
+	    or confess "Copy failed: $!";
+    }
+}
+
+sub cp {
+    my ($srcFile, $dstFile) = @_;
+    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+    copy($srcFile,$dstFile);
+    utime $access, $mod, $dstFile;
+    # chmod a+rX-w,go-w
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
+}
+
+sub ln {
+    my ($srcFile, $dstFile) = @_;
+    link($srcFile, $dstFile);
+    local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
+    my $mode= 0444 | (stat)[2] & 0700;
+    chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
+}
+
+sub best {
+    my ($srcFile, $dstFile) = @_;
+    if (-l $srcFile) {
+	cp($srcFile, $dstFile);
+    } else {
+	ln($srcFile, $dstFile);
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::Manifest;>
+
+C<ExtUtils::Manifest::mkmanifest;>
+
+C<ExtUtils::Manifest::manicheck;>
+
+C<ExtUtils::Manifest::filecheck;>
+
+C<ExtUtils::Manifest::fullcheck;>
+
+C<ExtUtils::Manifest::skipcheck;>
+
+C<ExtUtild::Manifest::manifind();>
+
+C<ExtUtils::Manifest::maniread($file);>
+
+C<ExtUtils::Manifest::manicopy($read,$target,$how);>
+
+=head1 DESCRIPTION
+
+Mkmanifest() writes all files in and below the current directory to a
+file named in the global variable $ExtUtils::Manifest::MANIFEST (which
+defaults to C<MANIFEST>) in the current directory. It works similar to
+
+    find . -print
+
+but in doing so checks each line in an existing C<MANIFEST> file and
+includes any comments that are found in the existing C<MANIFEST> file
+in the new one. Anything between white space and an end of line within
+a C<MANIFEST> file is considered to be a comment. Filenames and
+comments are seperated by one or more TAB characters in the
+output. All files that match any regular expression in a file
+C<MANIFEST.SKIP> (if such a file exists) are ignored.
+
+Manicheck() checks if all the files within a C<MANIFEST> in the
+current directory really do exist. It only reports discrepancies and
+exits silently if MANIFEST and the tree below the current directory
+are in sync.
+
+Filecheck() finds files below the current directory that are not
+mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
+will be consulted. Any file matching a regular expression in such a
+file will not be reported as missing in the C<MANIFEST> file.
+
+Fullcheck() does both a manicheck() and a filecheck().
+
+Skipcheck() lists all the files that are skipped due to your
+C<MANIFEST.SKIP> file.
+
+Manifind() retruns a hash reference. The keys of the hash are the
+files found below the current directory.
+
+Maniread($file) reads a named C<MANIFEST> file (defaults to
+C<MANIFEST> in the current directory) and returns a HASH reference
+with files being the keys and comments being the values of the HASH.
+
+I<Manicopy($read,$target,$how)> copies the files that are the keys in
+the HASH I<%$read> to the named target directory. The HASH reference
+I<$read> is typically returned by the maniread() function. This
+function is useful for producing a directory tree identical to the
+intended distribution tree. The third parameter $how can be used to
+specify a different methods of "copying". Valid values are C<cp>,
+which actually copies the files, C<ln> which creates hard links, and
+C<best> which mostly links the files but copies any symbolic link to
+make a tree without any symbolic link. Best is the default.
+
+=head1 MANIFEST.SKIP
+
+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. A typical example:
+
+    \bRCS\b
+    ^MANIFEST\.
+    ^Makefile$
+    ~$
+    \.html$
+    \.old$
+    ^blib/
+    ^MakeMaker-\d
+
+=head1 EXPORT_OK
+
+C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
+C<&maniread>, and C<&manicopy> are exportable.
+
+=head1 GLOBAL VARIABLES
+
+C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
+results in both a different C<MANIFEST> and a different
+C<MANIFEST.SKIP> file. This is useful if you want to maintain
+different distributions for different audiences (say a user version
+and a developer version including RCS).
+
+<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+all functions act silently.
+
+=head1 DIAGNOSTICS
+
+All diagnostic output is sent to C<STDERR>.
+
+=over
+
+=item C<Not in MANIFEST:> I<file>
+
+is reported if a file is found, that is missing in the C<MANIFEST>
+file which is excluded by a regular expression in the file
+C<MANIFEST.SKIP>.
+
+=item C<No such file:> I<file>
+
+is reported if a file mentioned in a C<MANIFEST> file does not
+exist.
+
+=item C<MANIFEST:> I<$!>
+
+is reported if C<MANIFEST> could not be opened.
+
+=item C<Added to MANIFEST:> I<file>
+
+is reported by mkmanifest() if $Verbose is set and a file is added
+to MANIFEST. $Verbose is set to 1 by default.
+
+=back
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
+
+=head1 AUTHOR
+
+Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
new file mode 100644
index 00000000000..06c001553bf
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
@@ -0,0 +1,97 @@
+package ExtUtils::Mkbootstrap;
+use Config;
+use Exporter;
+@ISA=('Exporter');
+@EXPORT='&Mkbootstrap';
+$Version=2.0; # just to start somewhere
+
+sub Mkbootstrap {
+
+=head1 NAME
+
+ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
+
+=head1 SYNOPSIS
+
+C<mkbootstrap>
+
+=head1 DESCRIPTION
+
+Mkbootstrap typically gets called from an extension Makefile.
+
+There is no C<*.bs> file supplied with the extension. Instead a
+C<*_BS> file which has code for the special cases, like posix for
+berkeley db on the NeXT.
+
+This file will get parsed, and produce a maybe empty
+C<@DynaLoader::dl_resolve_using> array for the current architecture.
+That will be extended by $BSLOADLIBS, which was computed by
+ExtUtils::Liblist::ext(). If this array still is empty, we do nothing,
+else we write a .bs file with an C<@DynaLoader::dl_resolve_using>
+array.
+
+The C<*_BS> file can put some code into the generated C<*.bs> file by
+placing it in C<$bscode>. This is a handy 'escape' mechanism that may
+prove useful in complex situations.
+
+If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then
+Mkbootstrap will automatically add a dl_findfile() call to the
+generated C<*.bs> file.
+
+=cut
+
+    my($baseext, @bsloadlibs)=@_;
+
+    @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs
+
+    print STDOUT "	bsloadlibs=@bsloadlibs\n" if $Verbose;
+
+    # We need DynaLoader here because we and/or the *_BS file may
+    # call dl_findfile(). We don't say `use' here because when
+    # first building perl extensions the DynaLoader will not have
+    # been built when MakeMaker gets first used.
+    require DynaLoader;
+
+    rename "$baseext.bs", "$baseext.bso"
+      if -s "$baseext.bs";
+
+    if (-f "${baseext}_BS"){
+	$_ = "${baseext}_BS";
+	package DynaLoader; # execute code as if in DynaLoader
+	$bscode = "";
+	unshift @INC, ".";
+	require $_;
+	shift @INC;
+    }
+
+    if ($Config{'dlsrc'} =~ /^dl_dld/){
+	package DynaLoader;
+	push(@dl_resolve_using, dl_findfile('-lc'));
+    }
+
+    my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using);
+    my($method) = '';
+    if (@all){
+	open BS, ">$baseext.bs"
+		or die "Unable to open $baseext.bs: $!";
+	print STDOUT "Writing $baseext.bs\n";
+	print STDOUT "	containing: @all" if $Verbose;
+	print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
+	print BS "# Do not edit this file, changes will be lost.\n";
+	print BS "# This file was automatically generated by the\n";
+	print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$Version).\n";
+	print BS "\@DynaLoader::dl_resolve_using = ";
+	# If @all contains names in the form -lxxx or -Lxxx then it's asking for
+	# runtime library location so we automatically add a call to dl_findfile()
+	if (" @all" =~ m/ -[lLR]/){
+	    print BS "  dl_findfile(qw(\n  @all\n  ));\n";
+	}else{
+	    print BS "  qw(@all);\n";
+	}
+	# write extra code if *_BS says so
+	print BS $DynaLoader::bscode if $DynaLoader::bscode;
+	print BS "\n1;\n";
+	close BS;
+    }
+}
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
new file mode 100644
index 00000000000..5c0173a5085
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
@@ -0,0 +1,226 @@
+package ExtUtils::Mksymlists;
+use strict qw[ subs refs ];
+# no strict 'vars';  # until filehandles are exempted
+
+use Carp;
+use Exporter;
+use vars qw( @ISA @EXPORT $VERSION );
+@ISA = 'Exporter';
+@EXPORT = '&Mksymlists';
+$VERSION = '1.03';
+
+sub Mksymlists {
+    my(%spec) = @_;
+    my($osname) = $^O;
+
+    croak("Insufficient information specified to Mksymlists")
+        unless ( $spec{NAME} or
+                 ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
+
+    $spec{DL_VARS} = [] unless $spec{DL_VARS};
+    ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
+    $spec{DL_FUNCS} = { $spec{NAME} => [] }
+        unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
+                 $spec{FUNCLIST});
+    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
+    if (defined $spec{DL_FUNCS}) {
+        my($package);
+        foreach $package (keys %{$spec{DL_FUNCS}}) {
+            my($packprefix,$sym,$bootseen);
+            ($packprefix = $package) =~ s/\W/_/g;
+            foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
+                if ($sym =~ /^boot_/) {
+                    push(@{$spec{FUNCLIST}},$sym);
+                    $bootseen++;
+                }
+                else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
+            }
+            push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
+        }
+    }
+
+#    We'll need this if we ever add any OS which uses mod2fname
+#    require DynaLoader;
+    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
+        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
+    }
+
+    if    ($osname eq 'aix') { _write_aix(\%spec); }
+    elsif ($osname eq 'VMS') { _write_vms(\%spec) }
+    elsif ($osname =~ m|^os/?2$|i) { _write_os2(\%spec) }
+    else { croak("Don't know how to create linker option file for $osname\n"); }
+}
+
+
+sub _write_aix {
+    my($data) = @_;
+
+    rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
+
+    open(EXP,">$data->{FILE}.exp")
+        or croak("Can't create $data->{FILE}.exp: $!\n");
+    print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    close EXP;
+}
+
+
+sub _write_os2 {
+    my($data) = @_;
+
+    if (not $data->{DLBASE}) {
+        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
+        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
+    }
+    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
+
+    open(DEF,">$data->{FILE}.def")
+        or croak("Can't create $data->{FILE}.def: $!\n");
+    print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+    print DEF "CODE LOADONCALL\n";
+    print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
+    print DEF "EXPORTS\n  ";
+    print DEF join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print DEF join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    if (%{$data->{IMPORTS}}) {
+        print DEF "IMPORTS\n";
+my ($name, $exp);
+while (($name, $exp)= each %{$data->{IMPORTS}}) {
+  print DEF "  $name=$exp\n";
+}
+    }
+    close DEF;
+}
+
+
+sub _write_vms {
+    my($data) = @_;
+
+    require Config; # a reminder for once we do $^O
+
+    my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
+    my($sym);
+
+    rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
+
+    open(OPT,">$data->{FILE}.opt")
+        or croak("Can't create $data->{FILE}.opt: $!\n");
+
+    # Options file declaring universal symbols
+    # Used when linking shareable image for dynamic extension,
+    # or when linking PerlShr into which we've added this package
+    # as a static extension
+    # We don't do anything to preserve order, so we won't relax
+    # the GSMATCH criteria for a dynamic extension
+
+    foreach $sym (@{$data->{FUNCLIST}}) {
+        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
+        else        { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; }
+    }
+    foreach $sym (@{$data->{DL_VARS}}) {
+        print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
+        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
+        else        { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; }
+    }
+    close OPT;
+
+    # Options file specifying RTLs to which this extension must be linked.
+    # Eventually, the list of libraries will be supplied by a working
+    # extliblist routine.
+    open OPT,'>rtls.opt';
+    print OPT "PerlShr/Share\n";
+    foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
+    close OPT;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Mksymlists - write linker options files for dynamic extension
+
+=head1 SYNOPSIS
+
+    use ExtUtils::Mksymlists;
+    Mksymlists({ NAME     => $name ,
+                 DL_VARS  => [ $var1, $var2, $var3 ],
+                 DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
+                               $pkg2 => [ $func3 ] });
+
+=head1 DESCRIPTION
+
+C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
+during the creation of shared libraries for synamic extensions.  It is
+normally called from a MakeMaker-generated Makefile when the extension
+is built.  The linker option file is generated by calling the function
+C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
+It takes one argument, a list of key-value pairs, in which the following
+keys are recognized:
+
+=item NAME
+
+This gives the name of the extension (I<e.g.> Tk::Canvas) for which
+the linker option file will be produced.
+
+=item DL_FUNCS
+
+This is identical to the DL_FUNCS attribute available via MakeMaker,
+from which it is usually taken.  Its value is a reference to an
+associative array, in which each key is the name of a package, and
+each value is an a reference to an array of function names which
+should be exported by the extension.  For instance, one might say
+C<DL_FUNCS =E<gt> { Homer::Iliad   =E<gt> [ qw(trojans greeks) ],
+Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
+function names should be identical to those in the XSUB code;
+C<Mksymlists> will alter the names written to the linker option
+file to match the changes made by F<xsubpp>.  In addition, if
+none of the functions in a list begin with the string B<boot_>,
+C<Mksymlists> will add a bootstrap function for that package,
+just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
+present in the list, it is passed through unchanged.)  If
+DL_FUNCS is not specified, it defaults to the bootstrap
+function for the extension specified in NAME.
+
+=item DL_VARS
+
+This is identical to the DL_VARS attribute available via MakeMaker,
+and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
+value is a reference to an array of variable names which should
+be exported by the extension.
+
+=item FILE
+
+This key can be used to specify the name of the linker option file
+(minus the OS-specific extension), if for some reason you do not
+want to use the default value, which is the last word of the NAME
+attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
+
+=item FUNCLIST
+
+This provides an alternate means to specify function names to be
+exported from the extension.  Its value is a reference to an
+array of function names to be exported by the extension.  These
+names are passed through unaltered to the linker options file.
+
+=item DLBASE
+
+This item specifies the name by which the linker knows the
+extension, which may be different from the name of the
+extension itself (for instance, some linkers add an '_' to the
+name of the extension).  If it is not specified, it is derived
+from the NAME attribute.  It is presently used only by OS2.
+
+When calling C<Mksymlists>, one should always specify the NAME
+attribute.  In most cases, this is all that's necessary.  In
+the case of unusual extensions, however, the other attributes
+can be used to provide additional information to the linker.
+
+=head1 AUTHOR
+
+Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
+
+=head1 REVISION
+
+Last revised 14-Feb-1996, for Perl 5.002.
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
new file mode 100644
index 00000000000..d5596047fb7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
@@ -0,0 +1,23 @@
+package ExtUtils::testlib;
+use lib qw(blib/arch blib/lib);
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::testlib - add blib/* directories to @INC
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::testlib;>
+
+=head1 DESCRIPTION
+
+After an extension has been built and before it is installed it may be
+desirable to test it bypassing C<make test>. By adding
+
+    use ExtUtils::testlib;
+
+to a test program the intermediate directories used by C<make> are
+added to @INC.
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/typemap b/gnu/usr.bin/perl/lib/ExtUtils/typemap
new file mode 100644
index 00000000000..a9733d0f491
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/typemap
@@ -0,0 +1,284 @@
+# $Header$ 
+# basic C types
+int			T_IV
+unsigned		T_IV
+unsigned int		T_IV
+long			T_IV
+unsigned long		T_IV
+short			T_IV
+unsigned short		T_IV
+char			T_CHAR
+unsigned char		T_U_CHAR
+char *			T_PV
+unsigned char *		T_PV
+caddr_t			T_PV
+wchar_t *		T_PV
+wchar_t			T_IV
+bool_t			T_IV
+size_t			T_IV
+ssize_t			T_IV
+time_t			T_NV
+unsigned long *		T_OPAQUEPTR
+char **			T_PACKED
+void *			T_PTR
+Time_t *		T_PV
+SV *			T_SV
+SVREF			T_SVREF
+AV *			T_AVREF
+HV *			T_HVREF
+CV *			T_CVREF
+
+IV			T_IV
+I32			T_IV
+I16			T_IV
+I8			T_IV
+U32			T_U_LONG
+U16			T_U_SHORT
+U8			T_IV
+Result			T_U_CHAR
+Boolean			T_IV
+double			T_DOUBLE
+SysRet			T_SYSRET
+SysRetLong		T_SYSRET
+FILE *			T_IN
+FileHandle		T_PTROBJ
+InputStream		T_IN
+InOutStream		T_INOUT
+OutputStream		T_OUT
+
+#############################################################################
+INPUT
+T_SV
+	$var = $arg
+T_SVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (SV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_AVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (AV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_HVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (HV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_CVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (CV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_SYSRET
+	$var NOT IMPLEMENTED
+T_IV
+	$var = ($type)SvIV($arg)
+T_INT
+	$var = (int)SvIV($arg)
+T_ENUM
+	$var = ($type)SvIV($arg)
+T_U_INT
+	$var = (unsigned int)SvIV($arg)
+T_SHORT
+	$var = (short)SvIV($arg)
+T_U_SHORT
+	$var = (unsigned short)SvIV($arg)
+T_LONG
+	$var = (long)SvIV($arg)
+T_U_LONG
+	$var = (unsigned long)SvIV($arg)
+T_CHAR
+	$var = (char)*SvPV($arg,na)
+T_U_CHAR
+	$var = (unsigned char)SvIV($arg)
+T_FLOAT
+	$var = (float)SvNV($arg)
+T_NV
+	$var = ($type)SvNV($arg)
+T_DOUBLE
+	$var = (double)SvNV($arg)
+T_PV
+	$var = ($type)SvPV($arg,na)
+T_PTR
+	$var = ($type)SvIV($arg)
+T_PTRREF
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+T_REF_IV_REF
+	if (sv_isa($arg, \"${type}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type *) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_REF_IV_PTR
+	if (sv_isa($arg, \"${type}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_PTROBJ
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_PTRDESC
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    ${type}_desc = (\U${type}_DESC\E*) tmp; 
+	    $var = ${type}_desc->ptr;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_REFREF
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+T_REFOBJ
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_OPAQUE
+	$var NOT IMPLEMENTED
+T_OPAQUEPTR
+	$var = ($type)SvPV($arg,na)
+T_PACKED
+	$var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+	$var = XS_unpack_$ntype($arg)
+T_CALLBACK
+	$var = make_perl_cb_$type($arg)
+T_ARRAY
+	$var = $ntype(items -= $argoff);
+	U32 ix_$var = $argoff;
+	while (items--) {
+	    DO_ARRAY_ELEM;
+	}
+T_IN
+	$var = IoIFP(sv_2io($arg))
+T_INOUT
+	$var = IoIFP(sv_2io($arg))
+T_OUT
+	$var = IoOFP(sv_2io($arg))
+#############################################################################
+OUTPUT
+T_SV
+	$arg = $var;
+T_SVREF
+	$arg = newRV((SV*)$var);
+T_AVREF
+	$arg = newRV((SV*)$var);
+T_HVREF
+	$arg = newRV((SV*)$var);
+T_CVREF
+	$arg = newRV((SV*)$var);
+T_IV
+	sv_setiv($arg, (IV)$var);
+T_INT
+	sv_setiv($arg, (IV)$var);
+T_SYSRET
+	if ($var != -1) {
+	    if ($var == 0)
+		sv_setpvn($arg, "0 but true", 10);
+	    else
+		sv_setiv($arg, (IV)$var);
+	}
+T_ENUM
+	sv_setiv($arg, (IV)$var);
+T_U_INT
+	sv_setiv($arg, (IV)$var);
+T_SHORT
+	sv_setiv($arg, (IV)$var);
+T_U_SHORT
+	sv_setiv($arg, (IV)$var);
+T_LONG
+	sv_setiv($arg, (IV)$var);
+T_U_LONG
+	sv_setiv($arg, (IV)$var);
+T_CHAR
+	sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+	sv_setiv($arg, (IV)$var);
+T_FLOAT
+	sv_setnv($arg, (double)$var);
+T_NV
+	sv_setnv($arg, (double)$var);
+T_DOUBLE
+	sv_setnv($arg, (double)$var);
+T_PV
+	sv_setpv((SV*)$arg, $var);
+T_PTR
+	sv_setiv($arg, (IV)$var);
+T_PTRREF
+	sv_setref_pv($arg, Nullch, (void*)$var);
+T_REF_IV_REF
+	sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
+T_REF_IV_PTR
+	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTROBJ
+	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTRDESC
+	sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
+T_REFREF
+	sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
+		    ($var ? (void*)new $ntype($var) : 0));
+T_REFOBJ
+	NOT IMPLEMENTED
+T_OPAQUE
+	sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+	sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+T_PACKED
+	XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+	XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT	
+	sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+	sv_setpvn($arg, $var.context.value().chp(),
+		$var.context.value().size());
+T_ARRAY
+	ST_EXTEND($var.size);
+	for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+		ST(ix_$var) = sv_newmortal();
+	DO_ARRAY_ELEM
+	}
+	sp += $var.size - 1;
+T_IN
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
+T_INOUT
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
+T_OUT
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
new file mode 100644
index 00000000000..8554bb5054e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
@@ -0,0 +1,1218 @@
+#!./miniperl
+
+=head1 NAME
+
+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<-typemap typemap>]... file.xs
+
+=head1 DESCRIPTION
+
+I<xsubpp> will compile XS code into C code by embedding the constructs
+necessary to let C functions manipulate Perl values and creates the glue
+necessary to let Perl access those functions.  The compiler uses typemaps to
+determine how to map C function parameters and variables to Perl values.
+
+The compiler will search for typemap files called I<typemap>.  It will use
+the following search path to find default typemaps, with the rightmost
+typemap taking precedence.
+
+	../../../typemap:../../typemap:../typemap:typemap
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-C++>
+
+Adds ``extern "C"'' to the C code.
+
+
+=item B<-except>
+
+Adds exception handling stubs to the C code.
+
+=item B<-typemap typemap>
+
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps.  This option may be used multiple times, with the last
+typemap having the highest precedence.
+
+=item B<-v>
+
+Prints the I<xsubpp> version number to standard output, then exits.
+
+=item B<-prototypes>
+
+By default I<xsubpp> will not automatically generate prototype code for
+all xsubs. This flag will enable prototypes.
+
+=item B<-noversioncheck>
+
+Disables the run time test that determines if the object file (derived
+from the C<.xs> file) and the C<.pm> files have the same version
+number.
+
+=back
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Larry Wall
+
+=head1 MODIFICATION HISTORY
+
+See the file F<changes.pod>.
+
+=head1 SEE ALSO
+
+perl(1), perlxs(1), perlxstut(1), perlapi(1)
+
+=cut
+
+# Global Constants
+$XSUBPP_version = "1.935";
+require 5.002;
+use vars '$cplusplus';
+
+sub Q ;
+
+$FH = 'File0000' ;
+
+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";
+
+$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
+
+$except = "";
+$WantPrototypes = -1 ;
+$WantVersionChk = 1 ;
+$ProtoUsed = 0 ;
+SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
+    $flag = shift @ARGV;
+    $flag =~ s/^-// ;
+    $spat = shift,	next SWITCH	if $flag eq 's';
+    $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
+    $WantPrototypes = 0, next SWITCH	if $flag eq 'noprototypes';
+    $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
+    $WantVersionChk = 0, next SWITCH	if $flag eq 'noversioncheck';
+    $WantVersionChk = 1, next SWITCH	if $flag eq 'versioncheck';
+    $except = " TRY",	next SWITCH	if $flag eq 'except';
+    push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
+    (print "xsubpp version $XSUBPP_version\n"), exit  	
+	if $flag eq 'v';
+    die $usage;
+}
+if ($WantPrototypes == -1)
+  { $WantPrototypes = 0}
+else
+  { $ProtoUsed = 1 }
+
+
+@ARGV == 1 or die $usage;
+($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
+	or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
+	or ($dir, $filename) = ('.', $ARGV[0]);
+chdir($dir);
+# Check for VMS; Config.pm may not be installed yet, but this routine
+# is built into VMS perl
+if (defined(&VMS::Filespec::vmsify)) { $Is_VMS = 1; $pwd = $ENV{DEFAULT}; }
+else                                 { $Is_VMS = 0; chomp($pwd = `pwd`);   }
+
+++ $IncludedFiles{$ARGV[0]} ;
+
+my(@XSStack) = ({type => 'none'});	# Stack of conditionals and INCLUDEs
+my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
+
+sub TrimWhitespace
+{
+    $_[0] =~ s/^\s+|\s+$//go ;
+}
+
+sub TidyType
+{
+    local ($_) = @_ ;
+
+    # rationalise any '*' by joining them into bunches and removing whitespace
+    s#\s*(\*+)\s*#$1#g;
+    s#(\*+)# $1 #g ;
+
+    # change multiple whitespace into a single space
+    s/\s+/ /g ;
+    
+    # trim leading & trailing whitespace
+    TrimWhitespace($_) ;
+
+    $_ ;
+}
+
+$typemap = shift @ARGV;
+foreach $typemap (@tm) {
+    die "Can't find $typemap in $pwd\n" unless -r $typemap;
+}
+unshift @tm, qw(../../../../lib/ExtUtils/typemap ../../../lib/ExtUtils/typemap
+                ../../lib/ExtUtils/typemap ../../../typemap ../../typemap
+                ../typemap typemap);
+foreach $typemap (@tm) {
+    next unless -e $typemap ;
+    # skip directories, binary files etc.
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next 
+	unless -T $typemap ;
+    open(TYPEMAP, $typemap) 
+	or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+    $mode = 'Typemap';
+    $junk = "" ;
+    $current = \$junk;
+    while (<TYPEMAP>) {
+	next if /^\s*#/;
+	if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
+	if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
+	if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
+	if ($mode eq 'Typemap') {
+	    chomp;
+	    my $line = $_ ;
+            TrimWhitespace($_) ;
+	    # skip blank lines and comment lines
+	    next if /^$/ or /^#/ ;
+	    my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
+		warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
+            $type = TidyType($type) ;
+	    $type_kind{$type} = $kind ;
+            # prototype defaults to '$'
+            $proto = '$' unless $proto ;
+            warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
+                unless ValidProtoString($proto) ;
+            $proto_letter{$type} = C_string($proto) ;
+	}
+	elsif (/^\s/) {
+	    $$current .= $_;
+	}
+	elsif ($mode eq 'Input') {
+	    s/\s+$//;
+	    $input_expr{$_} = '';
+	    $current = \$input_expr{$_};
+	}
+	else {
+	    s/\s+$//;
+	    $output_expr{$_} = '';
+	    $current = \$output_expr{$_};
+	}
+    }
+    close(TYPEMAP);
+}
+
+foreach $key (keys %input_expr) {
+    $input_expr{$key} =~ s/\n+$//;
+}
+
+$END = "!End!\n\n";		# "impossible" keyword (multiple newline)
+
+# Match an XS keyword
+$BLOCK_re= '\s*(' . join('|', qw(
+	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
+	CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+	)) . "|$END)\\s*:";
+
+# Input:  ($_, @line) == unparsed input.
+# Output: ($_, @line) == (rest of line, following lines).
+# Return: the matched keyword if found, otherwise 0
+sub check_keyword {
+	$_ = shift(@line) while !/\S/ && @line;
+	s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
+}
+
+
+sub print_section {
+    $_ = shift(@line) while !/\S/ && @line;
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	print "$_\n";
+    }
+}
+
+sub process_keyword($)
+{
+    my($pattern) = @_ ;
+    my $kwd ;
+
+    &{"${kwd}_handler"}() 
+        while $kwd = check_keyword($pattern) ;
+}
+
+sub CASE_handler {
+    blurt ("Error: `CASE:' after unconditional `CASE:'")
+	if $condnum && $cond eq '';
+    $cond = $_;
+    TrimWhitespace($cond);
+    print "   ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
+    $_ = '' ;
+}
+
+sub INPUT_handler {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	last if /^\s*NOT_IMPLEMENTED_YET/;
+	next unless /\S/;	# skip blank lines 
+
+	TrimWhitespace($_) ;
+	my $line = $_ ;
+
+	# remove trailing semicolon if no initialisation
+	s/\s*;$//g unless /=/ ;
+
+	# check for optional initialisation code
+	my $var_init = '' ;
+	$var_init = $1 if s/\s*(=.*)$//s ;
+	$var_init =~ s/"/\\"/g;
+
+	s/\s+/ /g;
+	my ($var_type, $var_addr, $var_name) = /^(.*?[^& ]) *(\&?) *\b(\w+)$/s
+	    or blurt("Error: invalid argument declaration '$line'"), next;
+
+	# Check for duplicate definitions
+	blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
+	    if $arg_list{$var_name} ++  ;
+
+	$thisdone |= $var_name eq "THIS";
+	$retvaldone |= $var_name eq "RETVAL";
+	$var_types{$var_name} = $var_type;
+	print "\t" . &map_type($var_type);
+	$var_num = $args_match{$var_name};
+
+        $proto_arg[$var_num] = ProtoString($var_type) 
+	    if $var_num ;
+	if ($var_addr) {
+	    $var_addr{$var_name} = 1;
+	    $func_args =~ s/\b($var_name)\b/&$1/;
+	}
+	if ($var_init =~ /^=\s*NO_INIT\s*;?\s*$/) {
+	    print "\t$var_name;\n";
+	} elsif ($var_init =~ /\S/) {
+	    &output_init($var_type, $var_num, "$var_name $var_init");
+	} elsif ($var_num) {
+	    # generate initialization code
+	    &generate_init($var_type, $var_num, $var_name);
+	} else {
+	    print ";\n";
+	}
+    }
+}
+
+sub OUTPUT_handler {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
+	blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
+	    if $outargs{$outarg} ++ ;
+	if (!$gotRETVAL and $outarg eq 'RETVAL') {
+	    # deal with RETVAL last
+	    $RETVAL_code = $outcode ;
+	    $gotRETVAL = 1 ;
+	    next ;
+	}
+	blurt ("Error: OUTPUT $outarg not an argument"), next
+	    unless defined($args_match{$outarg});
+	blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
+	    unless defined $var_types{$outarg} ;
+	if ($outcode) {
+	    print "\t$outcode\n";
+	} else {
+	    $var_num = $args_match{$outarg};
+	    &generate_output($var_types{$outarg}, $var_num, $outarg); 
+	}
+    }
+}
+
+sub CLEANUP_handler() { print_section() } 
+sub PREINIT_handler() { print_section() } 
+sub INIT_handler()    { print_section() } 
+
+sub GetAliases
+{
+    my ($line) = @_ ;
+    my ($orig) = $line ;
+    my ($alias) ;
+    my ($value) ;
+
+    # Parse alias definitions
+    # format is
+    #    alias = value alias = value ...
+
+    while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
+        $alias = $1 ;
+        $orig_alias = $alias ;
+        $value = $2 ;
+
+        # check for optional package definition in the alias
+	$alias = $Packprefix . $alias if $alias !~ /::/ ;
+        
+        # check for duplicate alias name & duplicate value
+	Warn("Warning: Ignoring duplicate alias '$orig_alias'")
+	    if defined $XsubAliases{$alias} ;
+
+	Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
+	    if $XsubAliasValues{$value} ;
+
+	$XsubAliases = 1;
+	$XsubAliases{$alias} = $value ;
+	$XsubAliasValues{$value} = $orig_alias ;
+    }
+
+    blurt("Error: Cannot parse ALIAS definitions from '$orig'")
+        if $line ;
+}
+
+sub ALIAS_handler ()
+{
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	TrimWhitespace($_) ;
+        GetAliases($_) if $_ ;
+    }
+}
+
+sub REQUIRE_handler ()
+{
+    # the rest of the current line should contain a version number
+    my ($Ver) = $_ ;
+
+    TrimWhitespace($Ver) ;
+
+    death ("Error: REQUIRE expects a version number")
+	unless $Ver ;
+
+    # check that the version number is of the form n.n
+    death ("Error: REQUIRE: expected a number, got '$Ver'")
+	unless $Ver =~ /^\d+(\.\d*)?/ ;
+
+    death ("Error: xsubpp $Ver (or better) required--this is only $XSUBPP_version.")
+        unless $XSUBPP_version >= $Ver ; 
+}
+
+sub VERSIONCHECK_handler ()
+{
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE
+ 
+    TrimWhitespace($_) ;
+ 
+    # check for ENABLE/DISABLE
+    death ("Error: VERSIONCHECK: ENABLE/DISABLE")
+        unless /^(ENABLE|DISABLE)/i ;
+ 
+    $WantVersionChk = 1 if $1 eq 'ENABLE' ;
+    $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+ 
+}
+
+sub PROTOTYPE_handler ()
+{
+    my $specified ;
+
+    death("Error: Only 1 PROTOTYPE definition allowed per xsub") 
+        if $proto_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	$specified = 1 ;
+	TrimWhitespace($_) ;
+        if ($_ eq 'DISABLE') {
+	   $ProtoThisXSUB = 0 
+        }
+        elsif ($_ eq 'ENABLE') {
+	   $ProtoThisXSUB = 1 
+        }
+        else {
+            # remove any whitespace
+            s/\s+//g ;
+            death("Error: Invalid prototype '$_'")
+                unless ValidProtoString($_) ;
+            $ProtoThisXSUB = C_string($_) ;
+        }
+    }
+
+    # If no prototype specified, then assume empty prototype ""
+    $ProtoThisXSUB = 2 unless $specified ;
+
+    $ProtoUsed = 1 ;
+
+}
+
+sub PROTOTYPES_handler ()
+{
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE 
+
+    TrimWhitespace($_) ;
+
+    # check for ENABLE/DISABLE
+    death ("Error: PROTOTYPES: ENABLE/DISABLE")
+        unless /^(ENABLE|DISABLE)/i ;
+
+    $WantPrototypes = 1 if $1 eq 'ENABLE' ;
+    $WantPrototypes = 0 if $1 eq 'DISABLE' ;
+    $ProtoUsed = 1 ;
+
+}
+
+sub INCLUDE_handler ()
+{
+    # the rest of the current line should contain a valid filename
+ 
+    TrimWhitespace($_) ;
+ 
+    death("INCLUDE: filename missing")
+        unless $_ ;
+
+    death("INCLUDE: output pipe is illegal")
+        if /^\s*\|/ ;
+
+    # simple minded recursion detector
+    death("INCLUDE loop detected")
+        if $IncludedFiles{$_} ;
+
+    ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+
+    # Save the current file context.
+    push(@XSStack, {
+	type		=> 'file',
+        LastLine        => $lastline,
+        LastLineNo      => $lastline_no,
+        Line            => \@line,
+        LineNo          => \@line_no,
+        Filename        => $filename,
+        Handle          => $FH,
+        }) ;
+ 
+    ++ $FH ;
+
+    # open the new file
+    open ($FH, "$_") or death("Cannot open '$_': $!") ;
+ 
+    print Q<<"EOF" ;
+#
+#/* INCLUDE:  Including '$_' from '$filename' */
+#
+EOF
+
+    $filename = $_ ;
+
+    # Prime the pump by reading the first 
+    # non-blank line
+
+    # skip leading blank lines
+    while (<$FH>) {
+        last unless /^\s*$/ ;
+    }
+
+    $lastline = $_ ;
+    $lastline_no = $. ;
+ 
+}
+ 
+sub PopFile()
+{
+    return 0 unless $XSStack[-1]{type} eq 'file' ;
+
+    my $data     = pop @XSStack ;
+    my $ThisFile = $filename ;
+    my $isPipe   = ($filename =~ /\|\s*$/) ;
+ 
+    -- $IncludedFiles{$filename}
+        unless $isPipe ;
+
+    close $FH ;
+
+    $FH         = $data->{Handle} ;
+    $filename   = $data->{Filename} ;
+    $lastline   = $data->{LastLine} ;
+    $lastline_no = $data->{LastLineNo} ;
+    @line       = @{ $data->{Line} } ;
+    @line_no    = @{ $data->{LineNo} } ;
+
+    if ($isPipe and $? ) {
+        -- $lastline_no ;
+        print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n"  ;
+        exit 1 ;
+    }
+
+    print Q<<"EOF" ;
+#
+#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+#
+EOF
+
+    return 1 ;
+}
+
+sub ValidProtoString ($)
+{
+    my($string) = @_ ;
+
+    if ( $string =~ /^$proto_re+$/ ) {
+        return $string ;
+    }
+
+    return 0 ;
+}
+
+sub C_string ($)
+{
+    my($string) = @_ ;
+
+    $string =~ s[\\][\\\\]g ;
+    $string ;
+}
+
+sub ProtoString ($)
+{
+    my ($type) = @_ ;
+
+    $proto_letter{$type} or '$' ;
+}
+
+sub check_cpp {
+    my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line);
+    if (@cpp) {
+	my ($cpp, $cpplevel);
+	for $cpp (@cpp) {
+	    if ($cpp =~ /^\#\s*if/) {
+		$cpplevel++;
+	    } elsif (!$cpplevel) {
+		Warn("Warning: #else/elif/endif without #if in this function");
+		print STDERR "    (precede it with a blank line if the matching #if is outside the function)\n"
+		    if $XSStack[-1]{type} eq 'if';
+		return;
+	    } elsif ($cpp =~ /^\#\s*endif/) {
+		$cpplevel--;
+	    }
+	}
+	Warn("Warning: #if without #endif in this function") if $cpplevel;
+    }
+}
+
+
+sub Q {
+    my($text) = @_;
+    $text =~ s/^#//gm;
+    $text =~ s/\[\[/{/g;
+    $text =~ s/\]\]/}/g;
+    $text;
+}
+
+open($FH, $filename) or die "cannot open $filename: $!\n";
+
+# Identify the version of xsubpp used
+print <<EOM ;
+/*
+ * This file was generated automatically by xsubpp version $XSUBPP_version from the 
+ * contents of $filename. Don't edit this file, edit $filename instead.
+ *
+ *	ANY CHANGES MADE HERE WILL BE LOST! 
+ *
+ */
+
+EOM
+ 
+
+while (<$FH>) {
+    last if ($Module, $Package, $Prefix) =
+	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+    print $_;
+}
+&Exit unless defined $_;
+
+$lastline    = $_;
+$lastline_no = $.;
+
+
+# Read next xsub into @line from ($lastline, <$FH>).
+sub fetch_para {
+    # parse paragraph
+    death ("Error: Unterminated `#if/#ifdef/#ifndef'")
+	if !defined $lastline && $XSStack[-1]{type} eq 'if';
+    @line = ();
+    @line_no = () ;
+    return PopFile() if !defined $lastline;
+
+    if ($lastline =~
+	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
+	$Module = $1;
+	$Package = defined($2) ? $2 : '';	# keep -w happy
+	$Prefix  = defined($3) ? $3 : '';	# keep -w happy
+	($Module_cname = $Module) =~ s/\W/_/g;
+	($Packid = $Package) =~ tr/:/_/;
+	$Packprefix = $Package;
+	$Packprefix .= "::" if $Packprefix ne "";
+	$lastline = "";
+    }
+
+    for(;;) {
+	if ($lastline !~ /^\s*#/ ||
+	    # CPP directives:
+	    #	ANSI:	if ifdef ifndef elif else endif define undef
+	    #		line error pragma
+	    #	gcc:	warning include_next
+	    #   obj-c:	import
+	    #   others:	ident (gcc notes that some cpps have this one)
+	    $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
+	    last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
+	    push(@line, $lastline);
+	    push(@line_no, $lastline_no) ;
+	}
+
+	# Read next line and continuation lines
+	last unless defined($lastline = <$FH>);
+	$lastline_no = $.;
+	my $tmp_line;
+	$lastline .= $tmp_line
+	    while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
+	    
+	chomp $lastline;
+	$lastline =~ s/^\s+$//;
+    }
+    pop(@line), pop(@line_no) while @line && $line[-1] eq "";
+    1;
+}
+
+PARAGRAPH:
+while (fetch_para()) {
+    # Print initial preprocessor statements and blank lines
+    while (@line && $line[0] !~ /^[^\#]/) {
+	my $line = shift(@line);
+	print $line, "\n";
+	next unless $line =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
+	my $statement = $+;
+	if ($statement eq 'if') {
+	    $XSS_work_idx = @XSStack;
+	    push(@XSStack, {type => 'if'});
+	} else {
+	    death ("Error: `$statement' with no matching `if'")
+		if $XSStack[-1]{type} ne 'if';
+	    if ($XSStack[-1]{varname}) {
+		push(@InitFileCode, "#endif\n");
+		push(@BootCode,     "#endif");
+	    }
+
+	    my(@fns) = keys %{$XSStack[-1]{functions}};
+	    if ($statement ne 'endif') {
+		# Hide the functions defined in other #if branches, and reset.
+		@{$XSStack[-1]{other_functions}}{@fns} = (1) x @fns;
+		@{$XSStack[-1]}{qw(varname functions)} = ('', {});
+	    } else {
+		my($tmp) = pop(@XSStack);
+		0 while (--$XSS_work_idx
+			 && $XSStack[$XSS_work_idx]{type} ne 'if');
+		# Keep all new defined functions
+		push(@fns, keys %{$tmp->{other_functions}});
+		@{$XSStack[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
+	    }
+	}
+    }
+
+    next PARAGRAPH unless @line;
+
+    if ($XSS_work_idx && !$XSStack[$XSS_work_idx]{varname}) {
+	# We are inside an #if, but have not yet #defined its xsubpp variable.
+	print "#define $cpp_next_tmp 1\n\n";
+	push(@InitFileCode, "#if $cpp_next_tmp\n");
+	push(@BootCode,     "#if $cpp_next_tmp");
+	$XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
+    }
+
+    death ("Code is not inside a function")
+	if $line[0] =~ /^\s/;
+
+    # initialize info arrays
+    undef(%args_match);
+    undef(%var_types);
+    undef(%var_addr);
+    undef(%defaults);
+    undef($class);
+    undef($static);
+    undef($elipsis);
+    undef($wantRETVAL) ;
+    undef(%arg_list) ;
+    undef(@proto_arg) ;
+    undef($proto_in_this_xsub) ;
+    $ProtoThisXSUB = $WantPrototypes ;
+
+    $_ = shift(@line);
+    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
+        &{"${kwd}_handler"}() ;
+        next PARAGRAPH unless @line ;
+        $_ = shift(@line);
+    }
+
+    if (check_keyword("BOOT")) {
+	&check_cpp;
+        push (@BootCode, $_, @line, "") ;
+        next PARAGRAPH ;
+    }
+
+
+    # extract return type, function name and arguments
+    my($ret_type) = TidyType($_);
+
+    # a function definition needs at least 2 lines
+    blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
+	unless @line ;
+
+    $static = 1 if $ret_type =~ s/^static\s+//;
+
+    $func_header = shift(@line);
+    blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
+	unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s;
+
+    ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
+    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+    $Full_func_name = "${Packid}_$func_name";
+
+    # Check for duplicate function definition
+    for $tmp (@XSStack) {
+	next unless defined $tmp->{functions}{$Full_func_name};
+	Warn("Warning: duplicate function definition '$func_name' detected");
+	last;
+    }
+    $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+    %XsubAliases = %XsubAliasValues = ();
+
+    @args = split(/\s*,\s*/, $orig_args);
+    if (defined($class)) {
+	my $arg0 = ((defined($static) or $func_name =~ /^new/) ? "CLASS" : "THIS");
+	unshift(@args, $arg0);
+	($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/;
+    }
+    $orig_args =~ s/"/\\"/g;
+    $min_args = $num_args = @args;
+    foreach $i (0..$num_args-1) {
+	    if ($args[$i] =~ s/\.\.\.//) {
+		    $elipsis = 1;
+		    $min_args--;
+		    if ($args[$i] eq '' && $i == $num_args - 1) {
+			pop(@args);
+			last;
+		    }
+	    }
+	    if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
+		    $min_args--;
+		    $args[$i] = $1;
+		    $defaults{$args[$i]} = $2;
+		    $defaults{$args[$i]} =~ s/"/\\"/g;
+	    }
+	    $proto_arg[$i+1] = '$' ;
+    }
+    if (defined($class)) {
+	    $func_args = join(", ", @args[1..$#args]);
+    } else {
+	    $func_args = join(", ", @args);
+    }
+    @args_match{@args} = 1..@args;
+
+    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
+
+    # print function header
+    print Q<<"EOF";
+#XS(XS_${Packid}_$func_name)
+#[[
+#    dXSARGS;
+EOF
+    print Q<<"EOF" if $ALIAS ;
+#    dXSI32;
+EOF
+    if ($elipsis) {
+	$cond = ($min_args ? qq(items < $min_args) : 0);
+    }
+    elsif ($min_args == $num_args) {
+	$cond = qq(items != $min_args);
+    }
+    else {
+	$cond = qq(items < $min_args || items > $num_args);
+    }
+
+    print Q<<"EOF" if $except;
+#    char errbuf[1024];
+#    *errbuf = '\0';
+EOF
+
+    if ($ALIAS) 
+      { print Q<<"EOF" if $cond }
+#    if ($cond)
+#       croak("Usage: %s($orig_args)", GvNAME(CvGV(cv)));
+EOF
+    else 
+      { print Q<<"EOF" if $cond }
+#    if ($cond)
+#	croak("Usage: $pname($orig_args)");
+EOF
+
+    print Q<<"EOF" if $PPCODE;
+#    SP -= items;
+EOF
+
+    # Now do a block of some sort.
+
+    $condnum = 0;
+    $cond = '';			# last CASE: condidional
+    push(@line, "$END:");
+    push(@line_no, $line_no[-1]);
+    $_ = '';
+    &check_cpp;
+    while (@line) {
+	&CASE_handler if check_keyword("CASE");
+	print Q<<"EOF";
+#   $except [[
+EOF
+
+	# do initialization of input variables
+	$thisdone = 0;
+	$retvaldone = 0;
+	$deferred = "";
+	%arg_list = () ;
+        $gotRETVAL = 0;
+
+	INPUT_handler() ;
+	process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE") ;
+
+	if (!$thisdone && defined($class)) {
+	    if (defined($static) or $func_name =~ /^new/) {
+		print "\tchar *";
+		$var_types{"CLASS"} = "char *";
+		&generate_init("char *", 1, "CLASS");
+	    }
+	    else {
+		print "\t$class *";
+		$var_types{"THIS"} = "$class *";
+		&generate_init("$class *", 1, "THIS");
+	    }
+	}
+
+	# do code
+	if (/^\s*NOT_IMPLEMENTED_YET/) {
+		print "\n\tcroak(\"$pname: not implemented yet\");\n";
+		$_ = '' ;
+	} else {
+		if ($ret_type ne "void") {
+			print "\t" . &map_type($ret_type) . "\tRETVAL;\n"
+				if !$retvaldone;
+			$args_match{"RETVAL"} = 0;
+			$var_types{"RETVAL"} = $ret_type;
+		}
+		print $deferred;
+                process_keyword("INIT|ALIAS|PROTOTYPE") ;
+
+		if (check_keyword("PPCODE")) {
+			print_section();
+			death ("PPCODE must be last thing") if @line;
+			print "\tPUTBACK;\n\treturn;\n";
+		} elsif (check_keyword("CODE")) {
+			print_section() ;
+		} elsif (defined($class) and $func_name eq "DESTROY") {
+			print "\n\t";
+			print "delete THIS;\n";
+		} else {
+			print "\n\t";
+			if ($ret_type ne "void") {
+				print "RETVAL = ";
+				$wantRETVAL = 1;
+			}
+			if (defined($static)) {
+			    if ($func_name =~ /^new/) {
+				$func_name = "$class";
+			    } else {
+				print "${class}::";
+			    }
+			} elsif (defined($class)) {
+			    if ($func_name =~ /^new/) {
+				$func_name .= " $class";
+			    } else {
+				print "THIS->";
+			    }
+			}
+			$func_name =~ s/^($spat)//
+			    if defined($spat);
+			print "$func_name($func_args);\n";
+		}
+	}
+
+	# do output variables
+	$gotRETVAL = 0;
+	undef $RETVAL_code ;
+	undef %outargs ;
+        process_keyword("OUTPUT|ALIAS|PROTOTYPE"); 
+
+	# all OUTPUT done, so now push the return value on the stack
+	if ($gotRETVAL && $RETVAL_code) {
+	    print "\t$RETVAL_code\n";
+	} elsif ($gotRETVAL || $wantRETVAL) {
+	    &generate_output($ret_type, 0, 'RETVAL');
+	}
+
+	# do cleanup
+	process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
+
+	# print function trailer
+	print Q<<EOF;
+#    ]]
+EOF
+	print Q<<EOF if $except;
+#    BEGHANDLERS
+#    CATCHALL
+#	sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
+#    ENDHANDLERS
+EOF
+	if (check_keyword("CASE")) {
+	    blurt ("Error: No `CASE:' at top of function")
+		unless $condnum;
+	    $_ = "CASE: $_";	# Restore CASE: label
+	    next;
+	}
+	last if $_ eq "$END:";
+	death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
+    }
+
+    print Q<<EOF if $except;
+#    if (errbuf[0])
+#	croak(errbuf);
+EOF
+
+    print Q<<EOF unless $PPCODE;
+#    XSRETURN(1);
+EOF
+
+    print Q<<EOF;
+#]]
+#
+EOF
+
+    my $newXS = "newXS" ;
+    my $proto = "" ;
+
+    # Build the prototype string for the xsub
+    if ($ProtoThisXSUB) {
+	$newXS = "newXSproto";
+
+	if ($ProtoThisXSUB == 2) {
+	    # User has specified empty prototype
+	    $proto = ', ""' ;
+	}
+        elsif ($ProtoThisXSUB != 1) {
+            # User has specified a prototype
+            $proto = ', "' . $ProtoThisXSUB . '"';
+        }
+        else {
+	    my $s = ';';
+            if ($min_args < $num_args)  {
+                $s = ''; 
+		$proto_arg[$min_args] .= ";" ;
+	    }
+            push @proto_arg, "$s\@" 
+                if $elipsis ;
+    
+            $proto = ', "' . join ("", @proto_arg) . '"';
+        }
+    }
+
+    if (%XsubAliases) {
+	$XsubAliases{$pname} = 0 
+	    unless defined $XsubAliases{$pname} ;
+	while ( ($name, $value) = each %XsubAliases) {
+	    push(@InitFileCode, Q<<"EOF");
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        XSANY.any_i32 = $value ;
+EOF
+	push(@InitFileCode, Q<<"EOF") if $proto;
+#        sv_setpv((SV*)cv$proto) ;
+EOF
+        }
+    }
+    else {
+	push(@InitFileCode,
+	     "        ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+    }
+}
+
+# print initialization routine
+print Q<<"EOF";
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XS(boot_$Module_cname)
+#[[
+#    dXSARGS;
+#    char* file = __FILE__;
+#
+EOF
+
+print Q<<"EOF" if $WantVersionChk ;
+#    XS_VERSION_BOOTCHECK ;
+#
+EOF
+
+print Q<<"EOF" if defined $XsubAliases ;
+#    {
+#        CV * cv ;
+#
+EOF
+
+print @InitFileCode;
+
+print Q<<"EOF" if defined $XsubAliases ;
+#    }
+EOF
+
+if (@BootCode)
+{
+    print "\n    /* Initialisation Section */\n" ;
+    print grep (s/$/\n/, @BootCode) ;
+    print "\n    /* End of Initialisation Section */\n\n" ;
+}
+
+print Q<<"EOF";;
+#    ST(0) = &sv_yes;
+#    XSRETURN(1);
+#]]
+EOF
+
+warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
+    unless $ProtoUsed ;
+&Exit;
+
+
+sub output_init {
+    local($type, $num, $init) = @_;
+    local($arg) = "ST(" . ($num - 1) . ")";
+
+    eval qq/print " $init\\\n"/;
+}
+
+sub Warn
+{
+    # work out the line number
+    my $line_no = $line_no[@line_no - @line -1] ;
+ 
+    print STDERR "@_ in $filename, line $line_no\n" ;
+}
+
+sub blurt 
+{ 
+    Warn @_ ;
+    $errors ++ 
+}
+
+sub death
+{
+    Warn @_ ;
+    exit 1 ;
+}
+
+sub generate_init {
+    local($type, $num, $var) = @_;
+    local($arg) = "ST(" . ($num - 1) . ")";
+    local($argoff) = $num - 1;
+    local($ntype);
+    local($tk);
+
+    $type = TidyType($type) ;
+    blurt("Error: '$type' not in typemap"), return 
+	unless defined($type_kind{$type});
+
+    ($ntype = $type) =~ s/\s*\*/Ptr/g;
+    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+    $tk = $type_kind{$type};
+    $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
+    $type =~ tr/:/_/;
+    blurt("Error: No INPUT definition for type '$type' found"), return
+        unless defined $input_expr{$tk} ;
+    $expr = $input_expr{$tk};
+    if ($expr =~ /DO_ARRAY_ELEM/) {
+        blurt("Error: '$subtype' not in typemap"), return 
+	    unless defined($type_kind{$subtype});
+        blurt("Error: No INPUT definition for type '$subtype' found"), return
+            unless defined $input_expr{$type_kind{$subtype}} ;
+	$subexpr = $input_expr{$type_kind{$subtype}};
+	$subexpr =~ s/ntype/subtype/g;
+	$subexpr =~ s/\$arg/ST(ix_$var)/g;
+	$subexpr =~ s/\n\t/\n\t\t/g;
+	$subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
+	$subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+	$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
+    }
+    if (defined($defaults{$var})) {
+	    $expr =~ s/(\t+)/$1    /g;
+	    $expr =~ s/        /\t/g;
+	    eval qq/print "\\t$var;\\n"/;
+	    $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+    } elsif ($expr !~ /^\t\$var =/) {
+	    eval qq/print "\\t$var;\\n"/;
+	    $deferred .= eval qq/"\\n$expr;\\n"/;
+    } else {
+	    eval qq/print "$expr;\\n"/;
+    }
+}
+
+sub generate_output {
+    local($type, $num, $var) = @_;
+    local($arg) = "ST(" . ($num - ($num != 0)) . ")";
+    local($argoff) = $num - 1;
+    local($ntype);
+
+    $type = TidyType($type) ;
+    if ($type =~ /^array\(([^,]*),(.*)\)/) {
+	    print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
+    } else {
+	    blurt("Error: '$type' not in typemap"), return
+		unless defined($type_kind{$type});
+            blurt("Error: No OUTPUT definition for type '$type' found"), return
+                unless defined $output_expr{$type_kind{$type}} ;
+	    ($ntype = $type) =~ s/\s*\*/Ptr/g;
+	    $ntype =~ s/\(\)//g;
+	    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+	    $expr = $output_expr{$type_kind{$type}};
+	    if ($expr =~ /DO_ARRAY_ELEM/) {
+	        blurt("Error: '$subtype' not in typemap"), return
+		    unless defined($type_kind{$subtype});
+                blurt("Error: No OUTPUT definition for type '$subtype' found"), return
+                    unless defined $output_expr{$type_kind{$subtype}} ;
+		$subexpr = $output_expr{$type_kind{$subtype}};
+		$subexpr =~ s/ntype/subtype/g;
+		$subexpr =~ s/\$arg/ST(ix_$var)/g;
+		$subexpr =~ s/\$var/${var}[ix_$var]/g;
+		$subexpr =~ s/\n\t/\n\t\t/g;
+		$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
+		eval "print qq\a$expr\a";
+	    }
+	    elsif ($var eq 'RETVAL') {
+		if ($expr =~ /^\t\$arg = /) {
+		    eval "print qq\a$expr\a";
+		    print "\tsv_2mortal(ST(0));\n";
+		}
+		else {
+		    print "\tST(0) = sv_newmortal();\n";
+		    eval "print qq\a$expr\a";
+		}
+	    }
+	    elsif ($arg =~ /^ST\(\d+\)$/) {
+		eval "print qq\a$expr\a";
+	    }
+    }
+}
+
+sub map_type {
+    my($type) = @_;
+
+    $type =~ tr/:/_/;
+    $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+    $type;
+}
+
+
+sub Exit {
+# If this is VMS, the exit status has meaning to the shell, so we
+# use a predictable value (SS$_Normal or SS$_Abort) rather than an
+# arbitrary number.
+    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+}
diff --git a/gnu/usr.bin/perl/lib/File/Basename.pm b/gnu/usr.bin/perl/lib/File/Basename.pm
new file mode 100644
index 00000000000..daff148a638
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Basename.pm
@@ -0,0 +1,252 @@
+package File::Basename;
+
+=head1 NAME
+
+Basename - parse file specifications
+
+fileparse - split a pathname into pieces
+
+basename - extract just the filename from a path
+
+dirname - extract just the directory from a path
+
+=head1 SYNOPSIS
+
+    use File::Basename;
+
+    ($name,$path,$suffix) = fileparse($fullname,@suffixlist)
+    fileparse_set_fstype($os_string);
+    $basename = basename($fullname,@suffixlist);
+    $dirname = dirname($fullname);
+
+    ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.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", or "MacOS", 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 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 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 be identical to the
+input file specification.
+
+=back
+
+=head1 EXAMPLES
+
+Using UNIX file syntax:
+
+    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', 
+				    '\.book\d+');
+
+would yield
+
+    $base eq 'draft'
+    $path eq '/virgil/aeneid',
+    $tail eq '.book7'
+
+Similarly, using VMS syntax:
+
+    ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
+				   '\..*');
+
+would yield
+
+    $name eq 'Rhetoric'
+    $dir  eq 'Doc_Root:[Help]'
+    $type eq '.Rnh'
+
+=item C<basename>
+
+The basename() routine returns the first element of the list produced
+by calling fileparse() with the same arguments.  It is provided for
+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.  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<.>).
+
+=cut
+
+require 5.002;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+
+#   fileparse_set_fstype() - specify OS-based rules used in future
+#                            calls to routines in this package
+#
+#   Currently recognized values: VMS, MSDOS, MacOS
+#       Any other name uses Unix-style rules
+
+sub fileparse_set_fstype {
+  my($old) = $Fileparse_fstype;
+  $Fileparse_fstype = $_[0] if $_[0];
+  $old;
+}
+
+#   fileparse() - parse file specification
+#
+#   calling sequence:
+#     ($filename,$prefix,$tail) = &basename_pat($filespec,@excludelist);
+#     where  $filespec    is the file specification to be parsed, and
+#            @excludelist is a list of patterns which should be removed
+#                         from the end of $filename.
+#            $filename    is the part of $filespec after $prefix (i.e. the
+#                         name of the file).  The elements of @excludelist
+#                         are compared to $filename, and if an  
+#            $prefix     is the path portion $filespec, up to and including
+#                        the end of the last directory name
+#            $tail        any characters removed from $filename because they
+#                         matched an element of @excludelist.
+#
+#   fileparse() first removes the directory specification from $filespec,
+#   according to the syntax of the OS (code is provided below to handle
+#   VMS, Unix, MSDOS and MacOS; you can pick the one you want using
+#   fileparse_set_fstype(), or you can accept the default, which is
+#   based on the information in the builtin variable $^O).  It then compares
+#   each element of @excludelist to $filename, and if that element is a
+#   suffix of $filename, it is removed from $filename and prepended to
+#   $tail.  By specifying the elements of @excludelist in the right order,
+#   you can 'nibble back' $filename to extract the portion of interest
+#   to you.
+#
+#   For example, on a system running Unix,
+#   ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
+#                                       '\.book\d+');
+#   would yield $base == 'draft',
+#               $path == '/virgil/aeneid/'  (note trailing slash)
+#               $tail == '.book7'.
+#   Similarly, on a system running VMS,
+#   ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh','\..*');
+#   would yield $name == 'Rhetoric';
+#               $dir == 'Doc_Root:[Help]', and
+#               $type == '.Rnh'.
+#
+#   Version 2.2  13-Oct-1994  Charles Bailey  bailey@genetics.upenn.edu 
+
+
+sub fileparse {
+  my($fullname,@suffices) = @_;
+  my($fstype) = $Fileparse_fstype;
+  my($dirpath,$tail,$suffix);
+
+  if ($fstype =~ /^VMS/i) {
+    if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
+    else {
+      ($dirpath,$basename) = ($fullname =~ /(.*[:>\]])?(.*)/);
+      $dirpath = $ENV{'DEFAULT'} unless $dirpath;
+    }
+  }
+  if ($fstype =~ /^MSDOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*\\)?(.*)/);
+    $dirpath = '.\\' unless $dirpath;
+  }
+  elsif ($fstype =~ /^MAC/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*:)?(.*)/);
+  }
+  elsif ($fstype !~ /^VMS/i) {  # default to Unix
+    ($dirpath,$basename) = ($fullname =~ m#(.*/)?(.*)#);
+    $dirpath = './' unless $dirpath;
+  }
+
+  if (@suffices) {
+    $tail = '';
+    foreach $suffix (@suffices) {
+      if ($basename =~ /($suffix)$/) {
+        $tail = $1 . $tail;
+        $basename = $`;
+      }
+    }
+  }
+
+  wantarray ? ($basename,$dirpath,$tail) : $basename;
+
+}
+
+
+#   basename() - returns first element of list returned by fileparse()
+
+sub basename {
+  my($name) = shift;
+  (fileparse($name, map("\Q$_\E",@_)))[0];
+}
+  
+
+#    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.
+
+sub dirname {
+    my($basename,$dirname) = fileparse($_[0]);
+    my($fstype) = $Fileparse_fstype;
+
+    if ($fstype =~ /VMS/i) { 
+        if ($_[0] =~ m#/#) { $fstype = '' }
+        else { return $dirname }
+    }
+    if ($fstype =~ /MacOS/i) { return $dirname }
+    elsif ($fstype =~ /MSDOS/i) { 
+        if ( $dirname =~ /:\\$/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s:[^\\]+$:: unless $basename;
+        $dirname = '.' unless $dirname;
+    }
+    else { 
+        if ( $dirname eq '/') { return $dirname }
+        chop $dirname;
+        $dirname =~ s:[^/]+$:: unless $basename;
+        $dirname = '.' unless $dirname;
+    }
+
+    $dirname;
+}
+
+$Fileparse_fstype = $^O;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/File/CheckTree.pm b/gnu/usr.bin/perl/lib/File/CheckTree.pm
new file mode 100644
index 00000000000..a39308b6c96
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/CheckTree.pm
@@ -0,0 +1,151 @@
+package File::CheckTree;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+validate - run many filetest checks on a tree
+
+=head1 SYNOPSIS
+
+    use File::CheckTree;
+
+    $warnings += validate( q{
+	/vmunix                 -e || die
+	/boot                   -e || die
+	/bin                    cd
+	    csh                 -ex
+	    csh                 !-ug
+	    sh                  -ex
+	    sh                  !-ug
+	/usr                    -d || warn "What happened to $file?\n"
+    });
+
+=head1 DESCRIPTION
+
+The validate() routine takes a single multiline string consisting of
+lines containing a filename plus a file test to try on it.  (The
+file test may also be a "cd", causing subsequent relative filenames
+to be interpreted relative to that directory.)  After the file test
+you may put C<|| die> to make it a fatal error if the file test fails.
+The default is C<|| warn>.  The file test may optionally have a "!' prepended
+to test for the opposite condition.  If you do a cd and then list some
+relative filenames, you may want to indent them slightly for readability.
+If you supply your own die() or warn() message, you can use $file to
+interpolate the filename.
+
+Filetests may be bunched:  "-rwx" tests for all of C<-r>, C<-w>, and C<-x>.
+Only the first failed test of the bunch will produce a warning.
+
+The routine returns the number of warnings issued.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(validate);
+
+# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
+
+# The validate routine takes a single multiline string consisting of
+# lines containing a filename plus a file test to try on it.  (The
+# file test may also be a 'cd', causing subsequent relative filenames
+# to be interpreted relative to that directory.)  After the file test
+# you may put '|| die' to make it a fatal error if the file test fails.
+# The default is '|| warn'.  The file test may optionally have a ! prepended
+# to test for the opposite condition.  If you do a cd and then list some
+# relative filenames, you may want to indent them slightly for readability.
+# If you supply your own "die" or "warn" message, you can use $file to
+# interpolate the filename.
+
+# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
+# Only the first failed test of the bunch will produce a warning.
+
+# The routine returns the number of warnings issued.
+
+# Usage:
+#	use File::CheckTree;
+#	$warnings += validate('
+#	/vmunix			-e || die
+#	/boot			-e || die
+#	/bin			cd
+#	    csh			-ex
+#	    csh			!-ug
+#	    sh			-ex
+#	    sh			!-ug
+#	/usr			-d || warn "What happened to $file?\n"
+#	');
+
+sub validate {
+    local($file,$test,$warnings,$oldwarnings);
+    foreach $check (split(/\n/,$_[0])) {
+	next if $check =~ /^#/;
+	next if $check =~ /^$/;
+	($file,$test) = split(' ',$check,2);
+	if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
+	    $testlist = $2;
+	    @testlist = split(//,$testlist);
+	}
+	else {
+	    @testlist = ('Z');
+	}
+	$oldwarnings = $warnings;
+	foreach $one (@testlist) {
+	    $this = $test;
+	    $this =~ s/(-\w\b)/$1 \$file/g;
+	    $this =~ s/-Z/-$one/;
+	    $this .= ' || warn' unless $this =~ /\|\|/;
+	    $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/;
+	    $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
+	    eval $this;
+	    last if $warnings > $oldwarnings;
+	}
+    }
+    $warnings;
+}
+
+sub valmess {
+    local($disposition,$this) = @_;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|;
+    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
+	$neg = $1;
+	$tmp = $2;
+	$tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
+	$tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
+	$tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
+	$tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
+	$tmp eq 'R' && ($mess = "$file is not readable by you.");
+	$tmp eq 'W' && ($mess = "$file is not writable by you.");
+	$tmp eq 'X' && ($mess = "$file is not executable by you.");
+	$tmp eq 'O' && ($mess = "$file is not owned by you.");
+	$tmp eq 'e' && ($mess = "$file does not exist.");
+	$tmp eq 'z' && ($mess = "$file does not have zero size.");
+	$tmp eq 's' && ($mess = "$file does not have non-zero size.");
+	$tmp eq 'f' && ($mess = "$file is not a plain file.");
+	$tmp eq 'd' && ($mess = "$file is not a directory.");
+	$tmp eq 'l' && ($mess = "$file is not a symbolic link.");
+	$tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
+	$tmp eq 'S' && ($mess = "$file is not a socket.");
+	$tmp eq 'b' && ($mess = "$file is not a block special file.");
+	$tmp eq 'c' && ($mess = "$file is not a character special file.");
+	$tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
+	$tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
+	$tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
+	$tmp eq 'T' && ($mess = "$file is not a text file.");
+	$tmp eq 'B' && ($mess = "$file is not a binary file.");
+	if ($neg eq '!') {
+	    $mess =~ s/ is not / should not be / ||
+	    $mess =~ s/ does not / should not / ||
+	    $mess =~ s/ not / /;
+	}
+	print STDERR $mess,"\n";
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	print STDERR "Can't do $this.\n";
+    }
+    if ($disposition eq 'die') { exit 1; }
+    ++$warnings;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm
new file mode 100644
index 00000000000..68460130109
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Copy.pm
@@ -0,0 +1,224 @@
+# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
+# source code has been placed in the public domain by the author.
+# Please be kind and preserve the documentation.
+#
+
+package File::Copy;
+
+require Exporter;
+use Carp;
+
+@ISA=qw(Exporter);
+@EXPORT=qw(copy);
+@EXPORT_OK=qw(copy cp);
+
+$File::Copy::VERSION = '1.5';
+$File::Copy::Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Copy
+    return $File::Copy::VERSION;
+}
+
+sub copy {
+    croak("Usage: copy( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$to) ne 'GLOB' &&
+        !(defined ref $to and (ref($to) eq 'GLOB' ||
+          ref($to) eq 'FileHandle' || ref($to) eq 'VMS::Stdio')))
+        { return File::Copy::syscopy($_[0],$_[1]) }
+
+    my $from = shift;
+    my $to = shift;
+    my $recsep = $\;
+    my $closefrom=0;
+    my $closeto=0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+
+    $\ = '';
+
+    if (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } elsif (defined ref $from and
+	     (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle' ||
+	      ref($from) eq 'VMS::Stdio')) {
+	*FROM = *$from;
+    } else {
+	open(FROM,"<$from")||goto(fail_open1);
+	binmode FROM;
+	$closefrom = 1;
+    }
+
+    if (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } elsif (defined ref $to and
+	     (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle' ||
+	      ref($to) eq 'VMS::Stdio')) {
+	*TO = *$to;
+    } else {
+	open(TO,">$to")||goto(fail_open2);
+	binmode TO;
+	$closeto=1;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    } else {
+	$size = -s FROM;
+	$size = 1024 if ($size < 512);
+	$size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
+    }
+
+    $buf = '';
+    while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
+	if (syswrite (TO,$buf,$r) != $r) {
+	    goto fail_inner;    
+	}
+    }
+    goto fail_inner unless(defined($r));
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+    $\ = $recsep;
+    return 1;
+    
+    # All of these contortions try to preserve error messages...
+  fail_inner:
+    if ($closeto) {
+	$status = $!;
+	$! = 0;
+	close TO;
+	$! = $status unless $!;
+    }
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    $\ = $recsep;
+    return 0;
+}
+
+
+*cp = \&copy;
+# &syscopy is an XSUB under OS/2
+*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless $^O eq 'os2';
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Copy;
+
+	copy("file1","file2");
+  	copy("Copy.pm",\*STDOUT);'
+
+  	use POSIX;
+	use File::Copy cp;
+
+	$n=FileHandle->new("/dev/null","r");
+	cp($n,"x");'
+
+=head1 DESCRIPTION
+
+The File::Copy module provides a basic function C<copy> which takes two
+parameters: a file to copy from and a file to copy to. Either
+argument may be a string, a FileHandle reference or a FileHandle
+glob. Obviously, if the first argument is a filehandle of some
+sort, it will be read from, and if it is a file I<name> it will
+be opened for reading. Likewise, the second argument will be
+written to (and created if need be).  Note that passing in
+files as handles instead of names may lead to loss of information
+on some operating systems; it is recommended that you use file
+names whenever possible.
+
+An optional third parameter can be used to specify the buffer
+size used for copying. This is the number of bytes from the
+first file, that wil be held in memory at any given time, before
+being written to the second file. The default buffer size depends
+upon the file, but will generally be the whole file (up to 2Mb), or
+1k for filehandles that do not reference files (eg. sockets).
+
+You may use the syntax C<use File::Copy "cp"> to get at the
+"cp" alias for this function. The syntax is I<exactly> the same.
+
+File::Copy also provides the C<syscopy> routine, which copies the
+file specified in the first parameter to the file specified in the
+second parameter, preserving OS-specific attributes and file
+structure.  For Unix systems, this is equivalent to the simple
+C<copy> routine.  For VMS systems, this calls the C<rmscopy>
+routine (see below).  For OS/2 systems, this calls the C<syscopy>
+XSUB directly.
+
+=head2 Special behavior under VMS
+
+If the second argument to C<copy> is not a file handle for an
+already opened file, then C<copy> will perform an RMS copy of
+the input file to a new output file, in order to preserve file
+attributes, indexed file structure, I<etc.>  The buffer size
+parameter is ignored.  If the second argument to C<copy> is a
+Perl handle to an opened file, then data is copied using Perl
+operators, and no effort is made to preserve file attributes
+or record structure.
+
+The RMS copy routine may also be called directly under VMS
+as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
+is just an alias for this routine).
+
+=item rmscopy($from,$to[,$date_flag])
+
+The first and second arguments may be strings, typeglobs, or
+typeglob references; they are used in all cases to obtain the
+I<filespec> of the input and output files, respectively.  The
+name and type of the input file are used as defaults for the
+output file, if necessary.
+
+A new version of the output file is always created, which
+inherits the structure and RMS attributes of the input file,
+except for owner and protections (and possibly timestamps;
+see below).  All data from the input file is copied to the
+output file; if either of the first two parameters to C<rmscopy>
+is a file handle, its position is unchanged.  (Note that this
+means a file handle pointing to the output file will be
+associated with an old version of that file after C<rmscopy>
+returns, not the newly created version.)
+
+The third parameter is an integer flag, which tells C<rmscopy>
+how to handle timestamps.  If it is < 0, none of the input file's
+timestamps are propagated to the output file.  If it is > 0, then
+it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
+timestamps other than the revision date are propagated; if bit 1
+is set, the revision date is propagated.  If the third parameter
+to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
+if the name or type of the output file was explicitly specified,
+then no timestamps are propagated, but if they were taken implicitly
+from the input filespec, then all timestamps other than the
+revision date are propagated.  If this parameter is not supplied,
+it defaults to 0.
+
+Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
+it sets C<$!>, deletes the output file, and returns 0.
+
+=head1 RETURN
+
+Returns 1 on success, 0 on failure. $! will be set if an error was
+encountered.
+
+=head1 AUTHOR
+
+File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995.
+The VMS-specific code was added by Charles Bailey
+I<E<lt>bailey@genetics.upenn.eduE<gt>> in March 1996.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm
new file mode 100644
index 00000000000..02bacd8fc25
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Find.pm
@@ -0,0 +1,255 @@
+package File::Find;
+require 5.000;
+require Exporter;
+use Config;
+require Cwd;
+require File::Basename;
+
+
+=head1 NAME
+
+find - traverse a file tree
+
+finddepth - traverse a directory structure depth-first
+
+=head1 SYNOPSIS
+
+    use File::Find;
+    find(\&wanted, '/foo','/bar');
+    sub wanted { ... }
+    
+    use File::Find;
+    finddepth(\&wanted, '/foo','/bar');
+    sub wanted { ... }
+
+=head1 DESCRIPTION
+
+The wanted() function does whatever verifications you want.
+$File::Find::dir contains the current directory name, and $_ the
+current filename within that directory.  $File::Find::name contains
+C<"$File::Find::dir/$_">.  You are chdir()'d to $File::Find::dir when
+the function is called.  The function may set $File::Find::prune to
+prune the tree.
+
+This library is primarily for the C<find2perl> tool, which when fed, 
+
+    find2perl / -name .nfs\* -mtime +7 \
+	-exec rm -f {} \; -o -fstype nfs -prune
+
+produces something like:
+
+    sub wanted {
+        /^\.nfs.*$/ &&
+        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+        int(-M _) > 7 &&
+        unlink($_)
+        ||
+        ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+        $dev < 0 &&
+        ($File::Find::prune = 1);
+    }
+
+Set the variable $File::Find::dont_use_nlink if you're using AFS,
+since AFS cheats.
+
+C<finddepth> is just like C<find>, except that it does a depth-first
+search.
+
+Here's another interesting wanted function.  It will find all symlinks
+that don't resolve:
+
+    sub wanted {
+	-l && !-e && print "bogus link: $File::Find::name\n";
+    } 
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(find finddepth);
+
+
+sub find {
+    my $wanted = shift;
+    my $cwd = Cwd::fastcwd();
+    my ($topdir,$topdev,$topino,$topmode,$topnlink);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&$wanted;
+		my $fixtopdir = $topdir;
+	        $fixtopdir =~ s,/$,, ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS; ;
+		&finddir($wanted,$fixtopdir,$topnlink);
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    $name = $topdir;
+	    chdir $dir && &$wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddir {
+    my($wanted, $nlink);
+    local($dir, $name);
+    ($wanted, $dir, $nlink) = @_;
+
+    my($dev, $ino, $mode, $subcount);
+
+    # Get the list of files in the current directory.
+    opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
+    my(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &$wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    &$wanted;
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
+		    # unless ($nlink || $dont_use_nlink);
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			$name =~ s/\.dir$// if $Is_VMS;
+			&finddir($wanted,$name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	}
+    }
+}
+
+
+sub finddepth {
+    my $wanted = shift;
+
+    $cwd = Cwd::fastcwd();;
+
+    my($topdir, $topdev, $topino, $topmode, $topnlink);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		my $fixtopdir = $topdir;
+		$fixtopdir =~ s,/$,, ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS;
+		&finddepthdir($wanted,$fixtopdir,$topnlink);
+		($dir,$_) = ($fixtopdir,'.');
+		$name = $fixtopdir;
+		&$wanted;
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    chdir $dir && &$wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddepthdir {
+    my($wanted, $nlink);
+    local($dir, $name);
+    ($wanted,$dir,$nlink) = @_;
+    my($dev, $ino, $mode, $subcount);
+
+    # Get the list of files in the current directory.
+    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+    my(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &$wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = 0;
+	    $name = "$dir/$_";
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (chdir $_) {
+			$name =~ s/\.dir$// if $Is_VMS;
+			&finddepthdir($wanted,$name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	    &$wanted;
+	}
+    }
+}
+
+# Set dont_use_nlink in your hint file if your system's stat doesn't
+# report the number of links in a directory as an indication
+# of the number of files.
+# See, e.g. hints/machten.sh for MachTen 2.2.
+$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+
+# These are hard-coded for now, but may move to hint files.
+if ($^O eq 'VMS') {
+  $Is_VMS = 1;
+  $dont_use_nlink = 1;
+}
+
+$dont_use_nlink = 1 if $^O eq 'os2';
+$dont_use_nlink = 1 if $^O =~ m:^mswin32$:i ;
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/File/Path.pm b/gnu/usr.bin/perl/lib/File/Path.pm
new file mode 100644
index 00000000000..97cb66855dc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Path.pm
@@ -0,0 +1,165 @@
+package File::Path;
+
+=head1 NAME
+
+File::Path - create or remove a series of directories
+
+=head1 SYNOPSIS
+
+C<use File::Path>
+
+C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);>
+
+C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);>
+
+=head1 DESCRIPTION
+
+The C<mkpath> function provides a convenient way to create directories, even if
+your C<mkdir> kernel call won't create more than one level of directory at a
+time.  C<mkpath> takes three arguments:
+
+=over 4
+
+=item *
+
+the name of the path to create, or a reference
+to a list of paths to create,
+
+=item *
+
+a boolean value, which if TRUE will cause C<mkpath>
+to print the name of each directory as it is created
+(defaults to FALSE), and
+
+=item *
+
+the numeric mode to use when creating the directories
+(defaults to 0777)
+
+=back
+
+It returns a list of all directories (including intermediates, determined using
+the Unix '/' separator) created.
+
+Similarly, the C<rmtree> function provides a convenient way to delete a
+subtree from the directory structure, much like the Unix command C<rm -r>.
+C<rmtree> takes three arguments:
+
+=over 4
+
+=item *
+
+the root of the subtree to delete, or a reference to
+a list of roots.  All of the files and directories
+below each root, as well as the roots themselves,
+will be deleted.
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+print a message each time it examines a file, giving the
+name of the file, and indicating whether it's using C<rmdir>
+or C<unlink> to remove it, or that it's skipping it.
+(defaults to FALSE)
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+skip any files to which you do not have delete access
+(if running under VMS) or write access (if running
+under another OS).  This will change in the future when
+a criterion for 'delete permission' under OSs other
+than VMS is settled. (defaults to FALSE)
+
+=back
+
+It returns the number of files successfully deleted. Symlinks are
+treated as ordinary files.
+
+=head1 AUTHORS
+
+Tim Bunce <Tim.Bunce@ig.co.uk>
+Charles Bailey <bailey@genetics.upenn.edu>
+
+=head1 REVISION
+
+This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is
+1.01.
+
+=cut
+
+$VERSION = "1.01"; # That's my hobby-horse, A.K.
+
+require 5.000;
+use Carp;
+require Exporter;
+@ISA = qw( Exporter );
+@EXPORT = qw( mkpath rmtree );
+
+$Is_VMS = $^O eq 'VMS';
+
+sub mkpath {
+    my($paths, $verbose, $mode) = @_;
+    # $paths   -- either a path string or ref to list of paths
+    # $verbose -- optional print "mkdir $path" for each directory created
+    # $mode    -- optional permissions, defaults to 0777
+    local($")="/";
+    $mode = 0777 unless defined($mode);
+    $paths = [$paths] unless ref $paths;
+    my(@created);
+    foreach $path (@$paths){
+        next if -d $path;
+        my(@p);
+        foreach(split(/\//, $path)){
+            push(@p, $_);
+            next if -d "@p/";
+            print "mkdir @p\n" if $verbose;
+	    mkdir("@p",$mode) || croak "mkdir @p: $!";
+            push(@created, "@p");
+        }
+    }
+    @created;
+}
+
+sub rmtree {
+    my($roots, $verbose, $safe) = @_;
+    my(@files);
+    my($count) = 0;
+    $roots = [$roots] unless ref $roots;
+
+    foreach $root (@{$roots}) {
+       $root =~ s#/$##;
+       if (not -l $root and -d _) { 
+           opendir(D,$root);
+           ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
+           @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
+           closedir(D);
+           $count += rmtree(\@files,$verbose,$safe);
+           if ($safe &&
+               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+               print "skipped $root\n" if $verbose;
+               next;
+           }
+           print "rmdir $root\n" if $verbose;
+           (rmdir $root && ++$count) or carp "Can't remove directory $root: $!";
+        }
+        else { 
+           if ($safe &&
+               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+               print "skipped $root\n" if $verbose;
+               next;
+           }
+           print "unlink $root\n" if $verbose;
+           while (-e $root || -l $root) { # delete all versions under VMS
+               (unlink($root) && ++$count)
+                   or carp "Can't unlink file $root: $!";
+           }
+        }
+    }
+
+    $count;
+}
+
+1;
+
+__END__
diff --git a/gnu/usr.bin/perl/lib/FileCache.pm b/gnu/usr.bin/perl/lib/FileCache.pm
new file mode 100644
index 00000000000..3d01371b3b3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/FileCache.pm
@@ -0,0 +1,78 @@
+package FileCache;
+
+=head1 NAME
+
+FileCache - keep more files open than the system permits
+
+=head1 SYNOPSIS
+
+    cacheout $path;
+    print $path @data;
+
+=head1 DESCRIPTION
+
+The C<cacheout> function will make sure that there's a filehandle open
+for writing available as the pathname you give it.  It automatically
+closes and re-opens files if you exceed your system file descriptor
+maximum.
+
+=head1 BUGS
+
+F<sys/param.h> lies with its C<NOFILE> define on some systems,
+so you may have to set $cacheout::maxopen yourself.
+
+=cut
+
+require 5.000;
+use Carp;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+    cacheout
+);
+
+# Open in their package.
+
+sub cacheout_open {
+    my $pack = caller(1);
+    open(*{$pack . '::' . $_[0]}, $_[1]);
+}
+
+sub cacheout_close {
+    my $pack = caller(1);
+    close(*{$pack . '::' . $_[0]});
+}
+
+# But only this sub name is visible to them.
+
+$cacheout_seq = 0;
+$cacheout_numopen = 0;
+
+sub cacheout {
+    ($file) = @_;
+    unless (defined $cacheout_maxopen) {
+	if (open(PARAM,'/usr/include/sys/param.h')) {
+	    local $.;
+	    while (<PARAM>) {
+		$cacheout_maxopen = $1 - 4
+		    if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+	    }
+	    close PARAM;
+	}
+	$cacheout_maxopen = 16 unless $cacheout_maxopen;
+    }
+    if (!$isopen{$file}) {
+	if (++$cacheout_numopen > $cacheout_maxopen) {
+	    my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $cacheout_maxopen / 3);
+	    $cacheout_numopen -= @lru;
+	    for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
+	}
+	cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    or croak("Can't create $file: $!");
+    }
+    $isopen{$file} = ++$cacheout_seq;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Getopt/Long.pm b/gnu/usr.bin/perl/lib/Getopt/Long.pm
new file mode 100644
index 00000000000..d6a4fddf7da
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Getopt/Long.pm
@@ -0,0 +1,891 @@
+# GetOpt::Long.pm -- POSIX compatible options parsing
+
+# RCS Status      : $Id: Long.pm,v 1.1 1996/08/19 10:12:44 downsj Exp $
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Fri Feb  2 21:24:32 1996
+# Update Count    : 347
+# Status          : Released
+
+package Getopt::Long;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
+use strict;
+
+=head1 NAME
+
+GetOptions - extended processing of command line options
+
+=head1 SYNOPSIS
+
+  use Getopt::Long;
+  $result = GetOptions (...option-descriptions...);
+
+=head1 DESCRIPTION
+
+The Getopt::Long module implements an extended getopt function called
+GetOptions(). This function adheres to the POSIX syntax for command
+line options, with GNU extensions. In general, this means that options
+have long names instead of single letters, and are introduced with a
+double dash "--". There is no bundling of command line options, as was
+the case with the more traditional single-letter approach. For
+example, the UNIX "ps" command can be given the command line "option" 
+
+  -vax
+
+which means the combination of B<-v>, B<-a> and B<-x>. With the new
+syntax B<--vax> would be a single option, probably indicating a
+computer architecture. 
+
+Command line options can be used to set values. These values can be
+specified in one of two ways:
+
+  --size 24
+  --size=24
+
+GetOptions is called with a list of option-descriptions, each of which
+consists of two elements: the option specifier and the option linkage.
+The option specifier defines the name of the option and, optionally,
+the value it can take. The option linkage is usually a reference to a
+variable that will be set when the option is used. For example, the
+following call to GetOptions:
+
+  &GetOptions("size=i" => \$offset);
+
+will accept a command line option "size" that must have an integer
+value. With a command line of "--size 24" this will cause the variable
+$offset to get the value 24.
+
+Alternatively, the first argument to GetOptions may be a reference to
+a HASH describing the linkage for the options. The following call is
+equivalent to the example above:
+
+  %optctl = ("size" => \$offset);
+  &GetOptions(\%optctl, "size=i");
+
+Linkage may be specified using either of the above methods, or both.
+Linkage specified in the argument list takes precedence over the
+linkage specified in the HASH.
+
+The command line options are taken from array @ARGV. Upon completion
+of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
+the command line.
+ 
+Each option specifier designates the name of the option, optionally
+followed by an argument specifier. Values for argument specifiers are:
+
+=over 8
+
+=item <none>
+
+Option does not take an argument. 
+The option variable will be set to 1.
+
+=item !
+
+Option does not take an argument and may be negated, i.e. prefixed by
+"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
+(with value 0).
+The option variable will be set to 1, or 0 if negated.
+
+=item =s
+
+Option takes a mandatory string argument.
+This string will be assigned to the option variable.
+Note that even if the string argument starts with B<-> or B<-->, it
+will not be considered an option on itself.
+
+=item :s
+
+Option takes an optional string argument.
+This string will be assigned to the option variable.
+If omitted, it will be assigned "" (an empty string).
+If the string argument starts with B<-> or B<-->, it
+will be considered an option on itself.
+
+=item =i
+
+Option takes a mandatory integer argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value. 
+
+=item :i
+
+Option takes an optional integer argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item =f
+
+Option takes a mandatory real number argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item :f
+
+Option takes an optional real number argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+
+=back
+
+A lone dash B<-> is considered an option, the corresponding option
+name is the empty string.
+
+A double dash on itself B<--> signals end of the options list.
+
+=head2 Linkage specification
+
+The linkage specifier is optional. If no linkage is explicitly
+specified but a ref HASH is passed, GetOptions will place the value in
+the HASH. For example:
+
+  %optctl = ();
+  &GetOptions (\%optctl, "size=i");
+
+will perform the equivalent of the assignment
+
+  $optctl{"size"} = 24;
+
+For array options, a reference to an array is used, e.g.:
+
+  %optctl = ();
+  &GetOptions (\%optctl, "sizes=i@");
+
+with command line "-sizes 24 -sizes 48" will perform the equivalent of
+the assignment
+
+  $optctl{"sizes"} = [24, 48];
+
+If no linkage is explicitly specified and no ref HASH is passed,
+GetOptions will put the value in a global variable named after the
+option, prefixed by "opt_". To yield a usable Perl variable,
+characters that are not part of the syntax for variables are
+translated to underscores. For example, "--fpp-struct-return" will set
+the variable $opt_fpp_struct_return. Note that this variable resides
+in the namespace of the calling program, not necessarily B<main>.
+For example:
+
+  &GetOptions ("size=i", "sizes=i@");
+
+with command line "-size 10 -sizes 24 -sizes 48" will perform the
+equivalent of the assignments
+
+  $opt_size = 10;
+  @opt_sizes = (24, 48);
+
+A lone dash B<-> is considered an option, the corresponding Perl
+identifier is $opt_ .
+
+The linkage specifier can be a reference to a scalar, a reference to
+an array or a reference to a subroutine.
+
+If a REF SCALAR is supplied, the new value is stored in the referenced
+variable. If the option occurs more than once, the previous value is
+overwritten. 
+
+If a REF ARRAY is supplied, the new value is appended (pushed) to the
+referenced array. 
+
+If a REF CODE is supplied, the referenced subroutine is called with
+two arguments: the option name and the option value.
+The option name is always the true name, not an abbreviation or alias.
+
+=head2 Aliases and abbreviations
+
+The option name may actually be a list of option names, separated by
+"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
+op this option. If no linkage is specified, options "foo", "bar" and
+"blech" all will set $opt_foo.
+
+Option names may be abbreviated to uniqueness, depending on
+configuration variable $Getopt::Long::autoabbrev.
+
+=head2 Non-option call-back routine
+
+A special option specifier, <>, can be used to designate a subroutine
+to handle non-option arguments. GetOptions will immediately call this
+subroutine for every non-option it encounters in the options list.
+This subroutine gets the name of the non-option passed.
+This feature requires $Getopt::Long::order to have the value $PERMUTE.
+See also the examples.
+
+=head2 Option starters
+
+On the command line, options can start with B<-> (traditional), B<-->
+(POSIX) and B<+> (GNU, now being phased out). The latter is not
+allowed if the environment variable B<POSIXLY_CORRECT> has been
+defined.
+
+Options that start with "--" may have an argument appended, separated
+with an "=", e.g. "--foo=bar".
+
+=head2 Return value
+
+A return status of 0 (false) indicates that the function detected
+one or more errors.
+
+=head1 COMPATIBILITY
+
+Getopt::Long::GetOptions() is the successor of
+B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
+In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
+the module.
+
+If an "@" sign is appended to the argument specifier, the option is
+treated as an array.  Value(s) are not set, but pushed into array
+@opt_name. This only applies if no linkage is supplied.
+
+If configuration variable $Getopt::Long::getopt_compat is set to a
+non-zero value, options that start with "+" may also include their
+arguments, e.g. "+foo=bar". This is for compatiblity with older
+implementations of the GNU "getopt" routine.
+
+If the first argument to GetOptions is a string consisting of only
+non-alphanumeric characters, it is taken to specify the option starter
+characters. Everything starting with one of these characters from the
+starter will be considered an option. B<Using a starter argument is
+strongly deprecated.>
+
+For convenience, option specifiers may have a leading B<-> or B<-->,
+so it is possible to write:
+
+   GetOptions qw(-foo=s --bar=i --ar=s);
+
+=head1 EXAMPLES
+
+If the option specifier is "one:i" (i.e. takes an optional integer
+argument), then the following situations are handled:
+
+   -one -two		-> $opt_one = '', -two is next option
+   -one -2		-> $opt_one = -2
+
+Also, assume specifiers "foo=s" and "bar:s" :
+
+   -bar -xxx		-> $opt_bar = '', '-xxx' is next option
+   -foo -bar		-> $opt_foo = '-bar'
+   -foo --		-> $opt_foo = '--'
+
+In GNU or POSIX format, option names and values can be combined:
+
+   +foo=blech		-> $opt_foo = 'blech'
+   --bar=		-> $opt_bar = ''
+   --bar=--		-> $opt_bar = '--'
+
+Example of using variabel references:
+
+   $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
+
+With command line options "-foo blech -bar 24 -ar xx -ar yy" 
+this will result in:
+
+   $bar = 'blech'
+   $opt_bar = 24
+   @ar = ('xx','yy')
+
+Example of using the <> option specifier:
+
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   &GetOptions("foo=i", \$myfoo, "<>", \&mysub);
+
+Results:
+
+   &mysub("bar") will be called (with $myfoo being 1)
+   &mysub("blech") will be called (with $myfoo being 2)
+
+Compare this with:
+
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   &GetOptions("foo=i", \$myfoo);
+
+This will leave the non-options in @ARGV:
+
+   $myfoo -> 2
+   @ARGV -> qw(bar blech)
+
+=head1 CONFIGURATION VARIABLES
+
+The following variables can be set to change the default behaviour of
+GetOptions():
+
+=over 12
+
+=item $Getopt::Long::autoabbrev      
+
+Allow option names to be abbreviated to uniqueness.
+Default is 1 unless environment variable
+POSIXLY_CORRECT has been set.
+
+=item $Getopt::Long::getopt_compat   
+
+Allow '+' to start options.
+Default is 1 unless environment variable
+POSIXLY_CORRECT has been set.
+
+=item $Getopt::Long::order           
+
+Whether non-options are allowed to be mixed with
+options.
+Default is $REQUIRE_ORDER if environment variable
+POSIXLY_CORRECT has been set, $PERMUTE otherwise.
+
+$PERMUTE means that 
+
+    -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+    -foo -bar arg1 arg2 arg3
+
+If a non-option call-back routine is specified, @ARGV will always be
+empty upon succesful return of GetOptions since all options have been
+processed, except when B<--> is used:
+
+    -foo arg1 -bar arg2 -- arg3
+
+will call the call-back routine for arg1 and arg2, and terminate
+leaving arg2 in @ARGV.
+
+If $Getopt::Long::order is $REQUIRE_ORDER, options processing
+terminates when the first non-option is encountered.
+
+    -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+    -foo -- arg1 -bar arg2 arg3
+
+$RETURN_IN_ORDER is not supported by GetOptions().
+
+=item $Getopt::Long::ignorecase      
+
+Ignore case when matching options. Default is 1.
+
+=item $Getopt::Long::VERSION
+
+The version number of this Getopt::Long implementation in the format
+C<major>.C<minor>. This can be used to have Exporter check the
+version, e.g.
+
+    use Getopt::Long 2.00;
+
+You can inspect $Getopt::Long::major_version and
+$Getopt::Long::minor_version for the individual components.
+
+=item $Getopt::Long::error
+
+Internal error flag. May be incremented from a call-back routine to
+cause options parsing to fail.
+
+=item $Getopt::Long::debug           
+
+Enable copious debugging output. Default is 0.
+
+=back
+
+=cut
+
+################ Introduction ################
+#
+# This package implements an extended getopt function. This function
+# adheres to the new syntax (long option names, no bundling). It tries
+# to implement the better functionality of traditional, GNU and POSIX
+# getopt functions.
+# 
+# This program is Copyright 1990,1996 by Johan Vromans.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# If you do not have a copy of the GNU General Public License write to
+# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+# MA 02139, USA.
+
+################ History ################
+# 
+# 13-Jan-1996		Johan Vromans
+#    Generalized the linkage interface.
+#    Eliminated the linkage argument.
+#    Add code references as a possible value for the option linkage.
+#    Add option specifier <> to have a call-back for non-options.
+#
+# 26-Dec-1995		Johan Vromans
+#    Import from netgetopt.pl.
+#    Turned into a decent module.
+#    Added linkage argument.
+
+################ Configuration Section ################
+
+# Values for $order. See GNU getopt.c for details.
+($Getopt::Long::REQUIRE_ORDER,
+ $Getopt::Long::PERMUTE, 
+ $Getopt::Long::RETURN_IN_ORDER) = (0..2);
+
+my $gen_prefix;			# generic prefix (option starters)
+
+# Handle POSIX compliancy.
+if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+    $gen_prefix = "(--|-)";
+    $Getopt::Long::autoabbrev = 0;	# no automatic abbrev of options
+    $Getopt::Long::getopt_compat = 0;	# disallow '+' to start options
+    $Getopt::Long::order = $Getopt::Long::REQUIRE_ORDER;
+}
+else {
+    $gen_prefix = "(--|-|\\+)";
+    $Getopt::Long::autoabbrev = 1;	# automatic abbrev of options
+    $Getopt::Long::getopt_compat = 1;	# allow '+' to start options
+    $Getopt::Long::order = $Getopt::Long::PERMUTE;
+}
+
+# Other configurable settings.
+$Getopt::Long::debug = 0;		# for debugging
+$Getopt::Long::error = 0;		# error tally
+$Getopt::Long::ignorecase = 1;		# ignore case when matching options
+($Getopt::Long::version,
+ $Getopt::Long::major_version, 
+ $Getopt::Long::minor_version) = '$Revision: 1.1 $ ' =~ /: ((\d+)\.(\d+))/;
+$Getopt::Long::version .= '*' if length('$Locker:  $ ') > 12;
+
+################ Subroutines ################
+
+sub GetOptions {
+
+    my @optionlist = @_;	# local copy of the option descriptions
+    my $argend = '--';		# option list terminator
+    my %opctl;			# table of arg.specs
+    my $pkg = (caller)[0];	# current context
+				# Needed if linkage is omitted.
+    my %aliases;		# alias table
+    my @ret = ();		# accum for non-options
+    my %linkage;		# linkage
+    my $userlinkage;		# user supplied HASH
+    my $debug = $Getopt::Long::debug;	# convenience
+    my $genprefix = $gen_prefix; # so we can call the same module more 
+				# than once in differing environments
+    $Getopt::Long::error = 0;
+
+    print STDERR ("GetOptions $Getopt::Long::version",
+		  " [GetOpt::Long $Getopt::Long::VERSION] -- ",
+		  "called from package \"$pkg\".\n",
+		  "  autoabbrev=$Getopt::Long::autoabbrev".
+		  ",getopt_compat=$Getopt::Long::getopt_compat",
+		  ",genprefix=\"$genprefix\"",
+		  ",order=$Getopt::Long::order",
+		  ",ignorecase=$Getopt::Long::ignorecase",
+		  ".\n")
+	if $debug;
+
+    # Check for ref HASH as first argument. 
+    $userlinkage = undef;
+    if ( ref($optionlist[0]) && ref($optionlist[0]) eq 'HASH' ) {
+	$userlinkage = shift (@optionlist);
+    }
+
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    if ( $optionlist[0] =~ /^\W+$/ ) {
+	$genprefix = shift (@optionlist);
+	# Turn into regexp.
+	$genprefix =~ s/(\W)/\\$1/g;
+	$genprefix = "[" . $genprefix . "]";
+    }
+
+    # Verify correctness of optionlist.
+    %opctl = ();
+    while ( @optionlist > 0 ) {
+	my $opt = shift (@optionlist);
+
+	# Strip leading prefix so people can specify "-foo=i" if they like.
+	$opt = $' if $opt =~ /^($genprefix)+/;
+
+	if ( $opt eq '<>' ) {
+	    if ( (defined $userlinkage)
+		&& !(@optionlist > 0 && ref($optionlist[0]))
+		&& (exists $userlinkage->{$opt})
+		&& ref($userlinkage->{$opt}) ) {
+		unshift (@optionlist, $userlinkage->{$opt});
+	    }
+	    unless ( @optionlist > 0 
+		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
+		warn ("Option spec <> requires a reference to a subroutine\n");
+		$Getopt::Long::error++;
+		next;
+	    }
+	    $linkage{'<>'} = shift (@optionlist);
+	    next;
+	}
+
+	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
+	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse]@?)?$/ ) {
+	    warn ("Error in option spec: \"", $opt, "\"\n");
+	    $Getopt::Long::error++;
+	    next;
+	}
+	my ($o, $c, $a) = ($1, $2);
+
+	if ( ! defined $o ) {
+	    # empty -> '-' option
+	    $opctl{$o = ''} = defined $c ? $c : '';
+	}
+	else {
+	    # Handle alias names
+	    my @o =  split (/\|/, $o);
+	    $o = $o[0];
+	    foreach ( @o ) {
+		if ( defined $c && $c eq '!' ) {
+		    $opctl{"no$_"} = $c;
+		    $c = '';
+		}
+		$opctl{$_} = defined $c ? $c : '';
+		if ( defined $a ) {
+		    # Note alias.
+		    $aliases{$_} = $a;
+		}
+		else {
+		    # Set primary name.
+		    $a = $_;
+		}
+	    }
+	}
+
+	# If no linkage is supplied in the @optionlist, copy it from
+	# the userlinkage if available.
+	if ( defined $userlinkage ) {
+	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
+		if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
+		    print STDERR ("=> found userlinkage for \"$o\": ",
+				  "$userlinkage->{$o}\n")
+			if $debug;
+		    unshift (@optionlist, $userlinkage->{$o});
+		}
+		else {
+		    # Do nothing. Being undefined will be handled later.
+		    next;
+		}
+	    }
+	}
+
+	# Copy the linkage. If omitted, link to global variable.
+	if ( @optionlist > 0 && ref($optionlist[0]) ) {
+	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
+		if $debug;
+	    if ( ref($optionlist[0]) eq 'SCALAR'
+		|| ref($optionlist[0]) eq 'ARRAY'
+		|| ref($optionlist[0]) eq 'CODE' ) {
+		$linkage{$o} = shift (@optionlist);
+	    }
+	    else {
+		warn ("Invalid option linkage for \"", $opt, "\"\n");
+		$Getopt::Long::error++;
+	    }
+	}
+	else {
+	    # Link to global $opt_XXX variable.
+	    # Make sure a valid perl identifier results.
+	    my $ov = $o;
+	    $ov =~ s/\W/_/g;
+	    if ( $c && $c =~ /@/ ) {
+		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
+	    }
+	    else {
+		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
+	    }
+	}
+    }
+
+    # Bail out if errors found.
+    return 0 if $Getopt::Long::error;
+
+    # Sort the possible option names.
+    my @opctl = sort(keys (%opctl)) if $Getopt::Long::autoabbrev;
+
+    # Show if debugging.
+    if ( $debug ) {
+	my ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+    }
+
+    my $opt;			# current option
+    my $arg;			# current option value
+    my $array;			# current option is array typed
+
+    # Process argument list
+    while ( @ARGV > 0 ) {
+
+	# >>> See also the continue block <<<
+
+	#### Get next argument ####
+
+	$opt = shift (@ARGV);
+	$arg = undef;
+	my $optarg = undef;
+	$array = 0;
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+
+	#### Determine what we have ####
+
+	# Double dash is option list terminator.
+	if ( $opt eq $argend ) {
+	    # Finish. Push back accumulated arguments and return.
+	    unshift (@ARGV, @ret) 
+		if $Getopt::Long::order == $Getopt::Long::PERMUTE;
+	    return ($Getopt::Long::error == 0);
+	}
+
+	if ( $opt =~ /^$genprefix/ ) {
+	    # Looks like an option.
+	    $opt = $';		# option name (w/o prefix)
+	    # If it is a long opt, it may include the value.
+	    if (($& eq "--" || ($Getopt::Long::getopt_compat && $& eq "+"))
+		&& $opt =~ /^([^=]+)=/ ) {
+		$opt = $1;
+		$optarg = $';
+		print STDERR ("=> option \"", $opt, 
+			      "\", optarg = \"$optarg\"\n") if $debug;
+	    }
+
+	}
+
+	# Not an option. Save it if we $PERMUTE and don't have a <>.
+	elsif ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
+	    # Try non-options call-back.
+	    my $cb;
+	    if ( (defined ($cb = $linkage{'<>'})) ) {
+		&$cb($opt);
+	    }
+	    else {
+		push (@ret, $opt);
+	    }
+	    next;
+	}
+
+	# ...otherwise, terminate.
+	else {
+	    # Push this one back and exit.
+	    unshift (@ARGV, $opt);
+	    return ($Getopt::Long::error == 0);
+	}
+
+	#### Look it up ###
+
+	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
+
+	my $tryopt = $opt;
+	if ( $Getopt::Long::autoabbrev ) {
+	    my $pat;
+
+	    # Turn option name into pattern.
+	    ($pat = $opt) =~ s/(\W)/\\$1/g;
+	    # Look up in option names.
+	    my @hits = grep (/^$pat/, @opctl);
+	    print STDERR ("=> ", 0+@hits, " hits (@hits) with \"$pat\" ",
+			  "out of ", 0+@opctl, "\n") if $debug;
+
+	    # Check for ambiguous results.
+	    unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
+		print STDERR ("Option ", $opt, " is ambiguous (",
+			      join(", ", @hits), ")\n");
+		$Getopt::Long::error++;
+		next;
+	    }
+
+	    # Complete the option name, if appropriate.
+	    if ( @hits == 1 && $hits[0] ne $opt ) {
+		$tryopt = $hits[0];
+		print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
+		    if $debug;
+	    }
+	}
+
+	my $type;
+	unless  ( defined ( $type = $opctl{$tryopt} ) ) {
+	    print STDERR ("Unknown option: ", $opt, "\n");
+	    $Getopt::Long::error++;
+	    next;
+	}
+	$opt = $tryopt;
+	print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+
+	#### Determine argument status ####
+
+	# If it is an option w/o argument, we're almost finished with it.
+	if ( $type eq '' || $type eq '!' ) {
+	    if ( defined $optarg ) {
+		print STDERR ("Option ", $opt, " does not take an argument\n");
+		$Getopt::Long::error++;
+	    }
+	    elsif ( $type eq '' ) {
+		$arg = 1;		# supply explicit value
+	    }
+	    else {
+		substr ($opt, 0, 2) = ''; # strip NO prefix
+		$arg = 0;		# supply explicit value
+	    }
+	    next;
+	}
+
+	# Get mandatory status and type info.
+	my $mand;
+	($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
+
+	# Check if there is an option argument available.
+	if ( defined $optarg ? ($optarg eq '') : (@ARGV <= 0) ) {
+
+	    # Complain if this option needs an argument.
+	    if ( $mand eq "=" ) {
+		print STDERR ("Option ", $opt, " requires an argument\n");
+		$Getopt::Long::error++;
+	    }
+	    if ( $mand eq ":" ) {
+		$arg = $type eq "s" ? '' : 0;
+	    }
+	    next;
+	}
+
+	# Get (possibly optional) argument.
+	$arg = defined $optarg ? $optarg : shift (@ARGV);
+
+	#### Check if the argument is valid for this option ####
+
+	if ( $type eq "s" ) {	# string
+	    # A mandatory string takes anything. 
+	    next if $mand eq "=";
+
+	    # An optional string takes almost anything. 
+	    next if defined $optarg;
+	    next if $arg eq "-";
+
+	    # Check for option or option list terminator.
+	    if ($arg eq $argend ||
+		$arg =~ /^$genprefix.+/) {
+		# Push back.
+		unshift (@ARGV, $arg);
+		# Supply empty value.
+		$arg = '';
+	    }
+	    next;
+	}
+
+	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	    if ( $arg !~ /^-?[0-9]+$/ ) {
+		if ( defined $optarg || $mand eq "=" ) {
+		    print STDERR ("Value \"", $arg, "\" invalid for option ",
+				  $opt, " (number expected)\n");
+		    $Getopt::Long::error++;
+		    undef $arg;	# don't assign it
+		}
+		else {
+		    # Push back.
+		    unshift (@ARGV, $arg);
+		    # Supply default value.
+		    $arg = 0;
+		}
+	    }
+	    next;
+	}
+
+	if ( $type eq "f" ) { # fixed real number, int is also ok
+	    if ( $arg !~ /^-?[0-9.]+$/ ) {
+		if ( defined $optarg || $mand eq "=" ) {
+		    print STDERR ("Value \"", $arg, "\" invalid for option ",
+				  $opt, " (real number expected)\n");
+		    $Getopt::Long::error++;
+		    undef $arg;	# don't assign it
+		}
+		else {
+		    # Push back.
+		    unshift (@ARGV, $arg);
+		    # Supply default value.
+		    $arg = 0.0;
+		}
+	    }
+	    next;
+	}
+
+	die ("GetOpt::Long internal error (Can't happen)\n");
+    }
+
+    continue {
+	if ( defined $arg ) {
+	    $opt = $aliases{$opt} if defined $aliases{$opt};
+
+	    if ( defined $linkage{$opt} ) {
+		print STDERR ("=> ref(\$L{$opt}) -> ",
+			      ref($linkage{$opt}), "\n") if $debug;
+
+		if ( ref($linkage{$opt}) eq 'SCALAR' ) {
+		    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
+		    ${$linkage{$opt}} = $arg;
+		}
+		elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
+		    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+			if $debug;
+		    push (@{$linkage{$opt}}, $arg);
+		}
+		elsif ( ref($linkage{$opt}) eq 'CODE' ) {
+		    print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
+			if $debug;
+		    &{$linkage{$opt}}($opt, $arg);
+		}
+		else {
+		    print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
+				  "\" in linkage\n");
+		    die ("Getopt::Long -- internal error!\n");
+		}
+	    }
+	    # No entry in linkage means entry in userlinkage.
+	    elsif ( $array ) {
+		if ( defined $userlinkage->{$opt} ) {
+		    print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
+			if $debug;
+		    push (@{$userlinkage->{$opt}}, $arg);
+		}
+		else {
+		    print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
+			if $debug;
+		    $userlinkage->{$opt} = [$arg];
+		}
+	    }
+	    else {
+		print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+		$userlinkage->{$opt} = $arg;
+	    }
+	}
+    }
+
+    # Finish.
+    if ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
+	#  Push back accumulated arguments
+	unshift (@ARGV, @ret) if @ret > 0;
+    }
+
+    return ($Getopt::Long::error == 0);
+}
+
+################ Package return ################
+
+# Returning 1 is so boring...
+$Getopt::Long::major_version * 1000 + $Getopt::Long::minor_version;
diff --git a/gnu/usr.bin/perl/lib/Getopt/Std.pm b/gnu/usr.bin/perl/lib/Getopt/Std.pm
new file mode 100644
index 00000000000..4117ca7f8b5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Getopt/Std.pm
@@ -0,0 +1,128 @@
+package Getopt::Std;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+getopt - Process single-character switches with switch clustering
+
+getopts - Process single-character switches with switch clustering
+
+=head1 SYNOPSIS
+
+    use Getopt::Std;
+    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
+		      # Sets opt_* as a side effect.
+
+=head1 DESCRIPTION
+
+The getopt() functions processes single-character switches with switch
+clustering.  Pass one argument which is a string containing all switches
+that take an argument.  For each switch found, sets $opt_x (where x is the
+switch name) to the value of the argument, or 1 if no argument.  Switches
+which take an argument don't care whether there is a space between the
+switch and the argument.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(getopt getopts);
+
+# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+
+# Process single-character switches with switch clustering.  Pass one argument
+# which is a string containing all switches that take an argument.  For each
+# switch found, sets $opt_x (where x is the switch name) to the value of the
+# argument, or 1 if no argument.  Switches which take an argument don't care
+# whether there is a space between the switch and the argument.
+
+# Usage:
+#	getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+sub getopt {
+    local($argumentative) = @_;
+    local($_,$first,$rest);
+    local $Exporter::ExportLevel;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	if (index($argumentative,$first) >= 0) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+	    eval "\$opt_$first = \$rest;";
+	    push( @EXPORT, "\$opt_$first" );
+	}
+	else {
+	    eval "\$opt_$first = 1;";
+	    push( @EXPORT, "\$opt_$first" );
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $Exporter::ExportLevel++;
+    import Getopt::Std;
+}
+
+# Usage:
+#   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
+#			#  side effect.
+
+sub getopts {
+    local($argumentative) = @_;
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local $Exporter::ExportLevel;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	$pos = index($argumentative,$first);
+	if($pos >= 0) {
+	    if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
+		shift(@ARGV);
+		if($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		eval "\$opt_$first = \$rest;";
+		push( @EXPORT, "\$opt_$first" );
+	    }
+	    else {
+		eval "\$opt_$first = 1";
+		push( @EXPORT, "\$opt_$first" );
+		if($rest eq '') {
+		    shift(@ARGV);
+		}
+		else {
+		    $ARGV[0] = "-$rest";
+		}
+	    }
+	}
+	else {
+	    print STDERR "Unknown option: $first\n";
+	    ++$errs;
+	    if($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $Exporter::ExportLevel++;
+    import Getopt::Std;
+    $errs == 0;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/I18N/Collate.pm b/gnu/usr.bin/perl/lib/I18N/Collate.pm
new file mode 100644
index 00000000000..0d8314e12e4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/I18N/Collate.pm
@@ -0,0 +1,145 @@
+package I18N::Collate;
+
+=head1 NAME
+
+I18N::Collate - compare 8-bit scalar data according to the current locale
+
+=head1 SYNOPSIS
+
+    use I18N::Collate;
+    setlocale(LC_COLLATE, 'locale-of-your-choice'); 
+    $s1 = new I18N::Collate "scalar_data_1";
+    $s2 = new I18N::Collate "scalar_data_2";
+
+=head1 DESCRIPTION
+
+This module provides you with objects that will collate 
+according to your national character set, provided that the 
+POSIX setlocale() function is supported on your system.
+
+You can compare $s1 and $s2 above with
+
+    $s1 le $s2
+
+to extract the data itself, you'll need a dereference: $$s1
+
+This uses POSIX::setlocale(). The basic collation conversion is done by
+strxfrm() which terminates at NUL characters being a decent C routine.
+collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
+and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
+available locales depend on your operating system; try whether C<locale
+-a> shows them or man pages for "locale" or "nlsinfo" or
+the direct approach C<ls /usr/lib/nls/loc> or C<ls
+/usr/lib/nls>.  Not all the locales that your vendor supports
+are necessarily installed: please consult your operating system's
+documentation and possibly your local system administration.
+
+The locale names are probably something like
+C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example
+C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr),
+ISO Latin (8859) 1 (-1) which is the Western European character set.
+
+=cut
+
+# I18N::Collate.pm
+#
+# Author:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
+#		Helsinki University of Technology, Finland
+#
+# Acks:		Guy Decoux <decoux@moulon.inra.fr> understood
+#		overloading magic much deeper than I and told
+#		how to cut the size of this code by more than half.
+#		(my first version did overload all of lt gt eq le ge cmp)
+#
+# Purpose:      compare 8-bit scalar data according to the current locale
+#
+# Requirements:	Perl5 POSIX::setlocale() and POSIX::strxfrm()
+#
+# Exports:	setlocale 1)
+#		collate_xfrm 2)
+#
+# Overloads:	cmp # 3)
+#
+# Usage:	use I18N::Collate;
+#	        setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
+#		$s1 = new I18N::Collate "scalar_data_1";
+#		$s2 = new I18N::Collate "scalar_data_2";
+#		
+#		now you can compare $s1 and $s2: $s1 le $s2
+#		to extract the data itself, you need to deref: $$s1
+#		
+# Notes:	
+#		1) this uses POSIX::setlocale
+#		2) the basic collation conversion is done by strxfrm() which
+#		   terminates at NUL characters being a decent C routine.
+#		   collate_xfrm handles embedded NUL characters gracefully.
+#		3) due to cmp and overload magic, lt le eq ge gt work also
+#		4) the available locales depend on your operating system;
+#		   try whether "locale -a" shows them or man pages for
+#		   "locale" or "nlsinfo" work or the more direct
+#		   approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
+#		   Not all the locales that your vendor supports
+#		   are necessarily installed: please consult your
+#		   operating system's documentation.
+#		   The locale names are probably something like
+#		   'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
+#		   for example 'fr_CH.ISO8859-1' is the Swiss (CH)
+#		   variant of French (fr), ISO Latin (8859) 1 (-1)
+#		   which is the Western European character set.
+#
+# Updated:	19960104 1946 GMT
+#
+# ---
+
+use POSIX qw(strxfrm LC_COLLATE);
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
+@EXPORT_OK = qw();
+
+use overload qw(
+fallback	1
+cmp		collate_cmp
+);
+
+sub new { my $new = $_[1]; bless \$new }
+
+sub setlocale {
+ my ($category, $locale) = @_[0,1];
+
+ POSIX::setlocale($category, $locale) if (defined $category);
+ # the current $LOCALE 
+ $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
+}
+
+sub C {
+  my $s = ${$_[0]};
+
+  $C->{$LOCALE}->{$s} = collate_xfrm($s)
+    unless (defined $C->{$LOCALE}->{$s}); # cache when met
+
+  $C->{$LOCALE}->{$s};
+}
+
+sub collate_xfrm {
+  my $s = $_[0];
+  my $x = '';
+  
+  for (split(/(\000+)/, $s)) {
+    $x .= (/^\000/) ? $_ : strxfrm("$_\000");
+  }
+
+  $x;
+}
+
+sub collate_cmp {
+  &C($_[0]) cmp &C($_[1]);
+}
+
+# init $LOCALE
+
+&I18N::Collate::setlocale();
+
+1; # keep require happy
diff --git a/gnu/usr.bin/perl/lib/IPC/Open2.pm b/gnu/usr.bin/perl/lib/IPC/Open2.pm
new file mode 100644
index 00000000000..243412ef094
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/IPC/Open2.pm
@@ -0,0 +1,107 @@
+package IPC::Open2;
+require 5.000;
+require Exporter;
+use Carp;
+
+=head1 NAME
+
+IPC::Open2, open2 - open a process for both reading and writing
+
+=head1 SYNOPSIS
+
+    use IPC::Open2;
+    $pid = open2(\*RDR, \*WTR, 'some cmd and args');
+      # or
+    $pid = open2(\*RDR, \*WTR, 'some', 'cmd', 'and', 'args');
+
+=head1 DESCRIPTION
+
+The open2() function spawns the given $cmd and connects $rdr for
+reading and $wtr for writing.  It's what you think should work 
+when you try
+
+    open(HANDLE, "|cmd args");
+
+open2() returns the process ID of the child process.  It doesn't return on
+failure: it just raises an exception matching C</^open2:/>.
+
+=head1 WARNING 
+
+It will not create these file handles for you.  You have to do this yourself.
+So don't pass it empty variables expecting them to get filled in for you.
+
+Additionally, this is very dangerous as you may block forever.
+It assumes it's going to talk to something like B<bc>, both writing to
+it and reading from it.  This is presumably safe because you "know"
+that commands like B<bc> will read a line at a time and output a line at
+a time.  Programs like B<sort> that read their entire input stream first,
+however, are quite apt to cause deadlock.  
+
+The big problem with this approach is that if you don't have control 
+over source code being run in the the child process, you can't control what it does 
+with pipe buffering.  Thus you can't just open a pipe to C<cat -v> and continually
+read and write a line from it.
+
+=head1 SEE ALSO
+
+See L<open3> for an alternative that handles STDERR as well.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(open2);
+
+# &open2: tom christiansen, <tchrist@convex.com>
+#
+# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
+#    or  $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#
+# spawn the given $cmd and connect $rdr for
+# reading and $wtr for writing.  return pid
+# of child, or 0 on failure.  
+# 
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.  
+# 
+# $wtr is left unbuffered.
+# 
+# abort program if
+#	rdr or wtr are null
+# 	pipe or fork or exec fails
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub open2 {
+    local($kidpid);
+    local($dad_rdr, $dad_wtr, @cmd) = @_;
+
+    $dad_rdr ne '' 		|| croak "open2: rdr should not be null";
+    $dad_wtr ne '' 		|| croak "open2: wtr should not be null";
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_rdr =~ s/^[^']+$/$package'$&/ unless ref $dad_rdr;
+    $dad_wtr =~ s/^[^']+$/$package'$&/ unless ref $dad_wtr;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+
+    pipe($dad_rdr, $kid_wtr) 	|| croak "open2: pipe 1 failed: $!";
+    pipe($kid_rdr, $dad_wtr) 	|| croak "open2: pipe 2 failed: $!";
+
+    if (($kidpid = fork) < 0) {
+	croak "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	close $dad_rdr; close $dad_wtr;
+	open(STDIN,  "<&$kid_rdr");
+	open(STDOUT, ">&$kid_wtr");
+	warn "execing @cmd\n" if $debug;
+	exec @cmd
+	    or croak "open2: exec of @cmd failed";   
+    } 
+    close $kid_rdr; close $kid_wtr;
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
+
diff --git a/gnu/usr.bin/perl/lib/IPC/Open3.pm b/gnu/usr.bin/perl/lib/IPC/Open3.pm
new file mode 100644
index 00000000000..234b4c911ff
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/IPC/Open3.pm
@@ -0,0 +1,144 @@
+package IPC::Open3;
+require 5.001;
+require Exporter;
+use Carp;
+
+=head1 NAME
+
+IPC::Open3, open3 - open a process for reading, writing, and error handling
+
+=head1 SYNOPSIS
+
+    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH 
+		    'some cmd and args', 'optarg', ...);
+
+=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 '', or the same as RDRFH, then STDOUT and STDERR of the child are
+on the same file handle.
+
+If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
+the child will read from it directly.  If RDRFH or ERRFH begins with
+">&", then the child will send output directly to that file handle.  In both
+cases, there will be a dup(2) instead of a pipe(2) made.
+
+If you try to read from the child's stdout writer and their stderr
+writer, you'll have problems with blocking, which means you'll
+want to use select(), which means you'll have to use sysread() instead
+of normal stuff.
+
+All caveats from open2() continue to apply.  See L<open2> for details.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(open3);
+
+# &open3: Marc Horowitz <marc@mit.edu>
+# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
+#
+# $Id: Open3.pm,v 1.1 1996/08/19 10:12:45 downsj Exp $
+#
+# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
+#
+# spawn the given $cmd and connect rdr for
+# reading, wtr for writing, and err for errors.
+# if err is '', or the same as rdr, then stdout and
+# stderr of the child are on the same fh.  returns pid
+# of child, or 0 on failure.
+
+
+# if wtr begins with '<&', then wtr will be closed in the parent, and
+# the child will read from it directly.  if rdr or err begins with
+# '>&', then the child will send output directly to that fd.  In both
+# cases, there will be a dup() instead of a pipe() made.
+
+
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.
+#
+# $wtr is left unbuffered.
+#
+# abort program if
+#   rdr or wtr are null
+#   pipe or fork or exec fails
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub open3 {
+    my($kidpid);
+    my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    my($dup_wtr, $dup_rdr, $dup_err);
+
+    $dad_wtr			|| croak "open3: wtr should not be null";
+    $dad_rdr			|| croak "open3: rdr should not be null";
+    $dad_err = $dad_rdr if ($dad_err eq '');
+
+    $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
+    $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
+    $dup_err = ($dad_err =~ s/^[<>]&//);
+
+    # force unqualified filehandles into callers' package
+    my($package) = caller;
+    $dad_wtr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_wtr;
+    $dad_rdr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_rdr;
+    $dad_err =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_err;
+
+    my($kid_rdr) = ++$fh;
+    my($kid_wtr) = ++$fh;
+    my($kid_err) = ++$fh;
+
+    if (!$dup_wtr) {
+	pipe($kid_rdr, $dad_wtr)    || croak "open3: pipe 1 (stdin) failed: $!";
+    }
+    if (!$dup_rdr) {
+	pipe($dad_rdr, $kid_wtr)    || croak "open3: pipe 2 (stdout) failed: $!";
+    }
+    if ($dad_err ne $dad_rdr && !$dup_err) {
+	pipe($dad_err, $kid_err)    || croak "open3: pipe 3 (stderr) failed: $!";
+    }
+
+    if (($kidpid = fork) < 0) {
+        croak "open3: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	if ($dup_wtr) {
+	    open(STDIN,  "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	} else {
+	    close($dad_wtr);
+	    open(STDIN,  "<&$kid_rdr");
+	}
+	if ($dup_rdr) {
+	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
+	} else {
+	    close($dad_rdr);
+	    open(STDOUT, ">&$kid_wtr");
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+		open(STDERR, ">&$dad_err")
+		    if (fileno(STDERR) != fileno($dad_err));
+	    } else {
+		close($dad_err);
+		open(STDERR, ">&$kid_err");
+	    }
+	} else {
+	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
+	}
+	local($")=(" ");
+	exec @cmd
+	    or croak "open3: exec of @cmd failed";
+    }
+
+    close $kid_rdr; close $kid_wtr; close $kid_err;
+    if ($dup_wtr) {
+	close($dad_wtr);
+    }
+
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
+
diff --git a/gnu/usr.bin/perl/lib/Math/BigFloat.pm b/gnu/usr.bin/perl/lib/Math/BigFloat.pm
new file mode 100644
index 00000000000..7551ad01a38
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/BigFloat.pm
@@ -0,0 +1,326 @@
+package Math::BigFloat;
+
+use Math::BigInt;
+
+use Exporter;  # just for use to be happy
+@ISA = (Exporter);
+
+use overload
+'+'	=>	sub {new Math::BigFloat &fadd},
+'-'	=>	sub {new Math::BigFloat
+		       $_[2]? fsub($_[1],${$_[0]}) : fsub(${$_[0]},$_[1])},
+'<=>'	=>	sub {new Math::BigFloat
+		       $_[2]? fcmp($_[1],${$_[0]}) : fcmp(${$_[0]},$_[1])},
+'cmp'	=>	sub {new Math::BigFloat
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Math::BigFloat &fmul},
+'/'	=>	sub {new Math::BigFloat 
+		       $_[2]? scalar fdiv($_[1],${$_[0]}) :
+			 scalar fdiv(${$_[0]},$_[1])},
+'neg'	=>	sub {new Math::BigFloat &fneg},
+'abs'	=>	sub {new Math::BigFloat &fabs},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+;
+
+sub new {
+  my ($class) = shift;
+  my ($foo) = fnorm(shift);
+  panic("Not a number initialized to Math::BigFloat") if $foo eq "NaN";
+  bless \$foo, $class;
+}
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+sub stringify {
+    my $n = ${$_[0]};
+
+    $n =~ s/^\+//;
+    $n =~ s/E//;
+
+    $n =~ s/([-+]\d+)$//;
+
+    my $e = $1;
+    my $ln = length($n);
+
+    if ($e > 0) {
+	$n .= "0" x $e . '.';
+    } elsif (abs($e) < $ln) {
+	substr($n, $ln + $e, 0) = '.';
+    } else {
+	$n = '.' . ("0" x (abs($e) - $ln)) . $n;
+    }
+
+    # 1 while $n =~ s/(.*\d)(\d\d\d)/$1,$2/;
+
+    return $n;
+}
+
+$div_scale = 40;
+
+# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
+
+$rnd_mode = 'even';
+
+sub fadd; sub fsub; sub fmul; sub fdiv;
+sub fneg; sub fabs; sub fcmp;
+sub fround; sub ffround;
+sub fnorm; sub fsqrt;
+
+# Convert a number to canonical string form.
+#   Takes something that looks like a number and converts it to
+#   the form /^[+-]\d+E[+-]\d+$/.
+sub fnorm { #(string) return fnum_str
+    local($_) = @_;
+    s/\s+//g;                               # strip white space
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
+	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    } else {
+	'NaN';
+    }
+}
+
+# normalize number -- for internal use
+sub norm { #(mantissa, exponent) return fnum_str
+    local($_, $exp) = @_;
+    if ($_ eq 'NaN') {
+	'NaN';
+    } else {
+	s/^([+-])0+/$1/;                        # strip leading zeros
+	if (length($_) == 1) {
+	    '+0E+0';
+	} else {
+	    $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
+	    sprintf("%sE%+ld", $_, $exp);
+	}
+    }
+}
+
+# negation
+sub fneg { #(fnum_str) return fnum_str
+    local($_) = fnorm($_[$[]);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+    s/^H/N/;
+    $_;
+}
+
+# absolute value
+sub fabs { #(fnum_str) return fnum_str
+    local($_) = fnorm($_[$[]);
+    s/^-/+/;		                       # mash sign
+    $_;
+}
+
+# multiplication
+sub fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	&norm(Math::BigInt::bmul($xm,$ym),$xe+$ye);
+    }
+}
+
+# addition
+sub fadd { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
+	&norm(Math::BigInt::badd($ym,$xm.('0' x ($xe-$ye))),$ye);
+    }
+}
+
+# subtraction
+sub fsub { #(fnum_str, fnum_str) return fnum_str
+    fadd($_[$[],fneg($_[$[+1]));    
+}
+
+# division
+#   args are dividend, divisor, scale (optional)
+#   result has at most max(scale, length(dividend), length(divisor)) digits
+sub fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
+{
+    local($x,$y,$scale) = (fnorm($_[$[]),fnorm($_[$[+1]),$_[$[+2]);
+    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if (length($xm)-1 > $scale);
+	$scale = length($ym)-1 if (length($ym)-1 > $scale);
+	$scale = $scale + length($ym) - length($xm);
+	&norm(&round(Math::BigInt::bdiv($xm.('0' x $scale),$ym),$ym),
+	    $xe-$ye-$scale);
+    }
+}
+
+# round int $q based on fraction $r/$base using $rnd_mode
+sub round { #(int_str, int_str, int_str) return int_str
+    local($q,$r,$base) = @_;
+    if ($q eq 'NaN' || $r eq 'NaN') {
+	'NaN';
+    } elsif ($rnd_mode eq 'trunc') {
+	$q;                         # just truncate
+    } else {
+	local($cmp) = Math::BigInt::bcmp(Math::BigInt::bmul($r,'+2'),$base);
+	if ( $cmp < 0 ||
+		 ($cmp == 0 &&
+		  ( $rnd_mode eq 'zero'                             ||
+		   ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    Math::BigInt::badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
+				    # round up
+	}
+    }
+}
+
+# round the mantissa of $x to $scale digits
+sub fround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN' || $scale <= 0) {
+	$x;
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if (length($xm)-1 <= $scale) {
+	    $x;
+	} else {
+	    &norm(&round(substr($xm,$[,$scale+1),
+			 "+0".substr($xm,$[+$scale+1,1),"+10"),
+		  $xe+length($xm)-$scale-1);
+	}
+    }
+}
+
+# round $x at the 10 to the $scale digit place
+sub ffround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= $scale) {
+	    $x;
+	} else {
+	    $xe = length($xm)+$xe-$scale;
+	    if ($xe < 1) {
+		'+0E+0';
+	    } elsif ($xe == 1) {
+		&norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale);
+	    } else {
+		&norm(&round(substr($xm,$[,$xe),
+		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+    
+# compare 2 values returns one of undef, <0, =0, >0
+#   returns undef if either or both input value are not numbers
+sub fcmp #(fnum_str, fnum_str) return cond_code
+{
+    local($x, $y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq "NaN" || $y eq "NaN") {
+	undef;
+    } else {
+	ord($y) <=> ord($x)
+	||
+	(  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
+	     (($xe <=> $ye) * (substr($x,$[,1).'1')
+             || Math::BigInt::cmp($xm,$ym))
+	);
+    }
+}
+
+# square root by Newtons method.
+sub fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (fnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN' || $x =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0E+0') {
+	'+0E+0';
+    } else {
+	local($xm, $xe) = split('E',$x);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if ($scale < length($xm)-1);
+	local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
+	while ($gs < 2*$scale) {
+	    $guess = fmul(fadd($guess,fdiv($x,$guess,$gs*2)),".5");
+	    $gs *= 2;
+	}
+	new Math::BigFloat &fround($guess, $scale);
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigFloat - Arbitrary length float math package
+
+=head1 SYNOPSIS
+
+  use Math::BogFloat;
+  $f = Math::BigFloat->new($string);
+
+  $f->fadd(NSTR) return NSTR            addition
+  $f->fsub(NSTR) return NSTR            subtraction
+  $f->fmul(NSTR) return NSTR            multiplication
+  $f->fdiv(NSTR[,SCALE]) returns NSTR   division to SCALE places
+  $f->fneg() return NSTR                negation
+  $f->fabs() return NSTR                absolute value
+  $f->fcmp(NSTR) return CODE            compare undef,<0,=0,>0
+  $f->fround(SCALE) return NSTR         round to SCALE digits
+  $f->ffround(SCALE) return NSTR        round at SCALEth place
+  $f->fnorm() return (NSTR)             normalize
+  $f->fsqrt([SCALE]) return NSTR        sqrt to SCALE places
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+floats as
+
+    $float = new Math::BigFloat "2.123123123123123123123123123123123";
+
+=over 2
+
+=item number format
+
+canonical strings have the form /[+-]\d+E[+-]\d+/ .  Input values can
+have inbedded whitespace.
+
+=item Error returns 'NaN'
+
+An input parameter was "Not a Number" or divide by zero or sqrt of
+negative number.
+
+=item Division is computed to 
+
+C<max($div_scale,length(dividend)+length(divisor))> digits by default.
+Also used for default sqrt scale.
+
+=back
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm
new file mode 100644
index 00000000000..68856aea6e0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm
@@ -0,0 +1,386 @@
+package Math::BigInt;
+
+use overload
+'+'	=>	sub {new Math::BigInt &badd},
+'-'	=>	sub {new Math::BigInt
+		       $_[2]? bsub($_[1],${$_[0]}) : bsub(${$_[0]},$_[1])},
+'<=>'	=>	sub {new Math::BigInt
+		       $_[2]? bcmp($_[1],${$_[0]}) : bcmp(${$_[0]},$_[1])},
+'cmp'	=>	sub {new Math::BigInt
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Math::BigInt &bmul},
+'/'	=>	sub {new Math::BigInt 
+		       $_[2]? scalar bdiv($_[1],${$_[0]}) :
+			 scalar bdiv(${$_[0]},$_[1])},
+'%'	=>	sub {new Math::BigInt
+		       $_[2]? bmod($_[1],${$_[0]}) : bmod(${$_[0]},$_[1])},
+'**'	=>	sub {new Math::BigInt
+		       $_[2]? bpow($_[1],${$_[0]}) : bpow(${$_[0]},$_[1])},
+'neg'	=>	sub {new Math::BigInt &bneg},
+'abs'	=>	sub {new Math::BigInt &babs},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+;
+
+$NaNOK=1;
+
+sub new {
+  my($class) = shift;
+  my($foo) = bnorm(shift);
+  die "Not a number initialized to Math::BigInt" if !$NaNOK && $foo eq "NaN";
+  bless \$foo, $class;
+}
+sub stringify { "${$_[0]}" }
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+
+$zero = 0;
+
+
+# normalize string form of number.   Strip leading zeros.  Strip any
+#   white space and add a sign, if missing.
+# Strings that are not numbers result the value 'NaN'.
+
+sub bnorm { #(num_str) return num_str
+    local($_) = @_;
+    s/\s+//g;                           # strip white space
+    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
+	substr($_,$[,0) = '+' unless $1; # Add missing sign
+	s/^-0/+0/;
+	$_;
+    } else {
+	'NaN';
+    }
+}
+
+# Convert a number from string format to internal base 100000 format.
+#   Assumes normalized value as input.
+sub internal { #(num_str) return int_num_array
+    local($d) = @_;
+    ($is,$il) = (substr($d,$[,1),length($d)-2);
+    substr($d,$[,1) = '';
+    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
+}
+
+# Convert a number from internal base 100000 format to string format.
+#   This routine scribbles all over input array.
+sub external { #(int_num_array) return num_str
+    $es = shift;
+    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
+    &bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
+}
+
+# Negate input value.
+sub bneg { #(num_str) return num_str
+    local($_) = &bnorm(@_);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
+    s/^H/N/;
+    $_;
+}
+
+# Returns the absolute value of the input.
+sub babs { #(num_str) return num_str
+    &abs(&bnorm(@_));
+}
+
+sub abs { # post-normalized abs for internal use
+    local($_) = @_;
+    s/^-/+/;
+    $_;
+}
+
+# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
+sub bcmp { #(num_str, num_str) return cond_code
+    local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	undef;
+    } elsif ($y eq 'NaN') {
+	undef;
+    } else {
+	&cmp($x,$y);
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    $cx cmp $cy
+    &&
+    (
+	ord($cy) <=> ord($cx)
+	||
+	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
+    );
+}
+
+sub badd { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);             # convert to internal form
+	@y = &internal($y);
+	local($sx, $sy) = (shift @x, shift @y); # get signs
+	if ($sx eq $sy) {
+	    &external($sx, &add(*x, *y)); # if same sign add
+	} else {
+	    ($x, $y) = (&abs($x),&abs($y)); # make abs
+	    if (&cmp($y,$x) > 0) {
+		&external($sy, &sub(*y, *x));
+	    } else {
+		&external($sx, &sub(*x, *y));
+	    }
+	}
+    }
+}
+
+sub bsub { #(num_str, num_str) return num_str
+    &badd($_[$[],&bneg($_[$[+1]));    
+}
+
+# GCD -- Euclids algorithm Knuth Vol 2 pg 296
+sub bgcd { #(num_str, num_str) return num_str
+    local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	($x, $y) = ($y,&bmod($x,$y)) while $y ne '+0';
+	$x;
+    }
+}
+
+# routine to add two base 1e5 numbers
+#   stolen from Knuth Vol 2 Algorithm A pg 231
+#   there are separate routines to add and sub as per Kunth pg 233
+sub add { #(int_num_array, int_num_array) return int_num_array
+    local(*x, *y) = @_;
+    $car = 0;
+    for $x (@x) {
+	last unless @y || $car;
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+    }
+    (@x, @y, $car);
+}
+
+# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+sub sub { #(int_num_array, int_num_array) return int_num_array
+    local(*sx, *sy) = @_;
+    $bar = 0;
+    for $sx (@sx) {
+	last unless @y || $bar;
+	$sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
+    }
+    @sx;
+}
+
+# multiply two numbers -- stolen from Knuth Vol 2 pg 233
+sub bmul { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	@y = &internal($y);
+	&external(&mul(*x,*y));
+    }
+}
+
+# multiply two numbers in internal representation
+# destroys the arguments, supposes that two arguments are different
+sub mul { #(*int_num_array, *int_num_array) return int_num_array
+    local(*x, *y) = (shift, shift);
+    local($signr) = (shift @x ne shift @y) ? '-' : '+';
+    @prod = ();
+    for $x (@x) {
+      ($car, $cty) = (0, $[);
+      for $y (@y) {
+	$prod = $x * $y + $prod[$cty] + $car;
+	$prod[$cty++] =
+	  $prod - ($car = int($prod * 1e-5)) * 1e5;
+      }
+      $prod[$cty] += $car if $car;
+      $x = shift @prod;
+    }
+    ($signr, @x, @prod);
+}
+
+# modulus
+sub bmod { #(num_str, num_str) return num_str
+    (&bdiv(@_))[$[+1];
+}
+
+sub bdiv { #(dividend: num_str, divisor: num_str) return num_str
+    local (*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    return wantarray ? ('NaN','NaN') : 'NaN'
+	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
+    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
+    @x = &internal($x); @y = &internal($y);
+    $srem = $y[$[];
+    $sr = (shift @x ne shift @y) ? '-' : '+';
+    $car = $bar = $prd = 0;
+    if (($dd = int(1e5/($y[$#y]+1))) != 1) {
+	for $x (@x) {
+	    $x = $x * $dd + $car;
+	    $x -= ($car = int($x * 1e-5)) * 1e5;
+	}
+	push(@x, $car); $car = 0;
+	for $y (@y) {
+	    $y = $y * $dd + $car;
+	    $y -= ($car = int($y * 1e-5)) * 1e5;
+	}
+    }
+    else {
+	push(@x, 0);
+    }
+    @q = (); ($v2,$v1) = @y[-2,-1];
+    while ($#x > $#y) {
+	($u2,$u1,$u0) = @x[-3..-1];
+	$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
+	--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
+	if ($q) {
+	    ($car, $bar) = (0,0);
+	    for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		$prd = $q * $y[$y] + $car;
+		$prd -= ($car = int($prd * 1e-5)) * 1e5;
+		$x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
+	    }
+	    if ($x[$#x] < $car + $bar) {
+		$car = 0; --$q;
+		for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		    $x[$x] -= 1e5
+			if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
+		}
+	    }   
+	}
+	pop(@x); unshift(@q, $q);
+    }
+    if (wantarray) {
+	@d = ();
+	if ($dd != 1) {
+	    $car = 0;
+	    for $x (reverse @x) {
+		$prd = $car * 1e5 + $x;
+		$car = $prd - ($tmp = int($prd / $dd)) * $dd;
+		unshift(@d, $tmp);
+	    }
+	}
+	else {
+	    @d = @x;
+	}
+	(&external($sr, @q), &external($srem, @d, $zero));
+    } else {
+	&external($sr, @q);
+    }
+}
+
+# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
+sub bpow { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } elsif ($x eq '+1') {
+	'+1';
+    } elsif ($x eq '-1') {
+	&bmod($x,2) ? '-1': '+1';
+    } elsif ($y =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0' && $y eq '+0') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	local(@pow2)=@x;
+	local(@pow)=&internal("+1");
+	local($y1,$res,@tmp1,@tmp2)=(1); # need tmp to send to mul
+	while ($y ne '+0') {
+	  ($y,$res)=&bdiv($y,2);
+	  if ($res ne '+0') {@tmp=@pow2; @pow=&mul(*pow,*tmp);}
+	  if ($y ne '+0') {@tmp=@pow2;@pow2=&mul(*pow2,*tmp);}
+	}
+	&external(@pow);
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigInt - Arbitrary size integer math package
+
+=head1 SYNOPSIS
+
+  use Math::BigInt;
+  $i = Math::BigInt->new($string);
+
+  $i->bneg return BINT               negation
+  $i->babs return BINT               absolute value
+  $i->bcmp(BINT) return CODE         compare numbers (undef,<0,=0,>0)
+  $i->badd(BINT) return BINT         addition
+  $i->bsub(BINT) return BINT         subtraction
+  $i->bmul(BINT) return BINT         multiplication
+  $i->bdiv(BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+  $i->bmod(BINT) return BINT         modulus
+  $i->bgcd(BINT) return BINT         greatest common divisor
+  $i->bnorm return BINT              normalization
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+integers as
+
+  $i = new Math::BigInt '123 456 789 123 456 789';
+
+
+=over 2
+
+=item Canonical notation
+
+Big integer value are strings of the form C</^[+-]\d+$/> with leading
+zeros suppressed.
+
+=item Input
+
+Input values to these routines may be strings of the form
+C</^\s*[+-]?[\d\s]+$/>.
+
+=item Output
+
+Output values always always in canonical form
+
+=back
+
+Actual math is done in an internal format consisting of an array
+whose first element is the sign (/^[+-]$/) and whose remaining 
+elements are base 100000 digits with the least significant digit first.
+The string 'NaN' is used to represent the result when input arguments 
+are not numbers, as well as the result of dividing by zero.
+
+=head1 EXAMPLES
+
+   '+0'                            canonical zero value
+   '   -123 123 123'               canonical value '-123123123'
+   '1 23 456 7890'                 canonical value '+1234567890'
+
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar, overloaded interface by Ilya Zakharevich.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Math/Complex.pm b/gnu/usr.bin/perl/lib/Math/Complex.pm
new file mode 100644
index 00000000000..969f3c2c79e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/Complex.pm
@@ -0,0 +1,163 @@
+package Math::Complex;
+
+require Exporter;
+
+@ISA = ('Exporter');
+
+# just to make use happy
+
+use overload
+    '+'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                      bless [ $x1+$x2, $y1+$y2];
+             },
+
+    '-'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                      bless [ $x1-$x2, $y1-$y2];
+             },
+
+    '*'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                    bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1];
+             },
+
+    '/'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                    my $q = $x2*$x2+$y2*$y2;
+                    bless [($x1*$x2+$y1*$y2)/$q, ($y1*$x2-$y2*$x1)/$q];
+             },
+
+    'neg' => sub  { my($x,$y) = @{$_[0]}; bless [ -$x, -$y];
+             },
+
+    '~'   => sub  { my($x,$y) = @{$_[0]}; bless [ $x, -$y];
+             },
+
+    'abs'   => sub  { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y;
+             },
+
+    'cos' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
+                   my $abr = 1/(2*$ab); $ab /= 2;
+                   bless [ ($abr+$ab)*$c, ($abr-$ab)*$s];
+             },
+
+    'sin' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
+                   my $abr = 1/(2*$ab); $ab /= 2;
+                   bless [ (-$abr-$ab)*$s, ($abr-$ab)*$c];
+             },
+
+    'exp' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $x, cos $y, sin $y);
+                   bless [ $ab*$c, $ab*$s ];
+              },
+
+    'sqrt' => sub { 
+	my($zr,$zi) = @{$_[0]};
+	my ($x, $y, $r, $w);
+	my $c = new Math::Complex (0,0);
+        if (($zr == 0) && ($zi == 0)) { 
+	    # nothing, $c already set
+	}
+        else {
+	  $x = abs($zr);
+	  $y = abs($zi);
+	  if ($x >= $y) { 
+	      $r = $y/$x; 
+	      $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r))); 
+	  }
+	  else { 
+	      $r = $x/$y; 
+	      $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r))); 
+	  }
+	  if ( $zr >= 0) { 
+	      @$c = ($w, $zi/(2 * $w) ); 
+	  }
+	  else { 
+	      $c->[1] = ($zi >= 0) ? $w : -$w;
+	      $c->[0] = $zi/(2.0* $c->[1]); 
+	  }
+        } 
+        return $c;
+      },
+
+    qw("" stringify)
+;
+
+sub new {
+    my $class = shift;
+    my @C = @_;
+    bless \@C, $class;
+}
+
+sub Re {
+    my($x,$y) = @{$_[0]};
+    $x;
+}
+
+sub Im {
+    my($x,$y) = @{$_[0]};
+    $y;
+}
+
+sub arg {
+    my($x,$y) = @{$_[0]};
+    atan2($y,$x);
+}
+
+sub stringify {
+    my($x,$y) = @{$_[0]};
+    my($re,$im);
+
+    $re = $x if ($x);
+    if ($y == 1) {$im = 'i';}  
+    elsif ($y == -1){$im = '-i';} 
+    elsif ($y) {$im = "${y}i"; }
+
+    local $_ = $re.'+'.$im;
+    s/\+-/-/;
+    s/^\+//;
+    s/[\+-]$//;
+    $_ = 0 if ($_ eq '');
+    return $_;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::Complex - complex numbers package
+
+=head1 SYNOPSIS
+
+  use Math::Complex;
+  $i = new Math::Complex;
+
+=head1 DESCRIPTION
+
+Complex numbers declared as
+
+    $i = Math::Complex->new(1,1);
+
+can be manipulated with overloaded math operators. The operators
+
+  + - * / neg ~ abs cos sin exp sqrt
+
+are supported as well as
+
+  "" (stringify)
+
+The methods
+
+  Re Im arg
+
+are also provided.
+
+=head1 BUGS
+
+sqrt() should return two roots, but only returns one.
+
+=head1 AUTHORS
+
+Dave Nadler, Tom Christiansen, Tim Bunce, Larry Wall.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Net/Ping.pm b/gnu/usr.bin/perl/lib/Net/Ping.pm
new file mode 100644
index 00000000000..3ba88d57518
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Net/Ping.pm
@@ -0,0 +1,106 @@
+package Net::Ping;
+
+# Authors: karrer@bernina.ethz.ch (Andreas Karrer)
+#          pmarquess@bfsec.bt.co.uk (Paul Marquess)
+
+require 5.002 ;
+require Exporter;
+
+use strict ;
+use vars qw(@ISA @EXPORT $VERSION $tcp_proto $echo_port) ;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(ping pingecho);
+$VERSION = 1.01;
+
+use Socket 'PF_INET', 'AF_INET', 'SOCK_STREAM';
+use Carp ;
+
+$tcp_proto = (getprotobyname('tcp'))[2];
+$echo_port = (getservbyname('echo', 'tcp'))[2];
+
+sub ping {
+    croak "ping not implemented yet. Use pingecho()";
+}
+
+
+sub pingecho {
+
+    croak "usage: pingecho host [timeout]" 
+        unless @_ == 1 or @_ == 2 ;
+
+    my ($host, $timeout) = @_;
+    my ($saddr, $ip);
+    my ($ret) ;
+    local (*PINGSOCK);
+
+    # check if $host is alive by connecting to its echo port, within $timeout
+    # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found
+
+    $timeout = 5 unless $timeout;
+
+    if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/)
+      { $ip = pack ('C4', split (/\./, $1)) }
+    else
+      { $ip = (gethostbyname($host))[4] }
+
+    return 0 unless $ip;		# "no such host"
+
+    $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip);
+    $SIG{'ALRM'} = sub { die } ;
+    alarm($timeout);
+    
+    $ret = 0;
+    eval <<'EOM' ;
+    return unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ;
+    return unless connect(PINGSOCK, $saddr) ;
+    $ret=1 ;
+EOM
+    alarm(0);
+    close(PINGSOCK);
+    $ret;
+}   
+
+1;
+__END__
+
+=cut
+
+=head1 NAME
+
+Net::Ping, pingecho - check a host for upness
+
+=head1 SYNOPSIS
+
+    use Net::Ping;
+    print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ;
+
+=head1 DESCRIPTION
+
+This module contains routines to test for the reachability of remote hosts.
+Currently the only routine implemented is pingecho(). 
+
+pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the
+remote host is reachable. This is usually adequate to tell that a remote
+host is available to rsh(1), ftp(1), or telnet(1) onto.
+
+=head2 Parameters
+
+=over 5
+
+=item hostname
+
+The remote host to check, specified either as a hostname or as an IP address.
+
+=item timeout
+
+The timeout in seconds. If not specified it will default to 5 seconds.
+
+=back
+
+=head1 WARNING
+
+pingecho() uses alarm to implement the timeout, so don't set another alarm
+while you are using it.
+
+
diff --git a/gnu/usr.bin/perl/lib/Pod/Functions.pm b/gnu/usr.bin/perl/lib/Pod/Functions.pm
new file mode 100644
index 00000000000..a775cf61654
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Pod/Functions.pm
@@ -0,0 +1,295 @@
+package Pod::Functions;
+
+#:vi:set ts=20
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(%Kinds %Type %Flavor %Type_Descriptions @Type_Order);
+
+%Type_Description = (
+    'ARRAY'	=> 'Functions for real @ARRAYs',
+    'Binary'	=> 'Functions for fixed length data or records',
+    'File'	=> 'Functions for filehandles, files, or directories',
+    'Flow'	=> 'Keywords related to control flow of your perl program',
+    'HASH'	=> 'Functions for real %HASHes',
+    'I/O'	=> 'Input and output functions',
+    'LIST'	=> 'Functions for list data',
+    'Math'	=> 'Numeric functions',
+    'Misc'	=> 'Miscellaneous functions',
+    'Modules'	=> 'Keywords related to perl modules',
+    'Network'	=> 'Fetching network info',
+    'Objects'	=> 'Keywords related to classes and object-orientedness',
+    'Process'	=> 'Functions for processes and process groups',
+    'Regexp'	=> 'Regular expressions and pattern matching',
+    'Socket'	=> 'Low-level socket functions',
+    'String'	=> 'Functions for SCALARs or strings',
+    'SysV'	=> 'System V interprocess communication functions',
+    'Time'	=> 'Time-related functions',
+    'User'	=> 'Fetching user and group info',
+    'Namespace'	=> 'Keywords altering or affecting scoping of identifiers',
+);
+
+@Type_Order = qw{
+    String
+    Regexp
+    Math
+    ARRAY
+    LIST
+    HASH
+    I/O
+    Binary
+    File
+    Flow
+    Namespace
+    Misc
+    Process
+    Modules
+    Objects
+    Socket
+    SysV
+    User
+    Network
+    Time
+};
+
+while (<DATA>) {
+    chomp;
+    s/#.*//;
+    next unless $_;
+    ($name, $type, $text) = split " ", $_, 3;
+    $Type{$name} = $type;
+    $Flavor{$name} = $text;
+    for $type ( split /[,\s]+/, $type ) {
+	push @{$Kinds{$type}}, $name;
+    }
+} 
+
+unless (caller) { 
+    foreach $type ( @Type_Order ) {
+	$list = join(", ", sort @{$Kinds{$type}});
+	$typedesc = $Type_Description{$type} . ":";
+	write;
+    } 
+}
+
+format = 
+
+^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+    $typedesc 
+~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+    $typedesc 
+ ~~  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+	$list
+.
+
+1
+
+__DATA__
+-X	File	a file test (-r, -x, etc)
+abs	Math	absolute value function
+accept	Socket	accept an incoming socket connect
+alarm	Process	schedule a SIGALRM 
+atan2	Math	arctangent of Y/X 
+bind	Socket	binds an address to a socket
+binmode	I/O	prepare binary files on old systems
+bless	Objects	create an object 
+caller	Flow,Namespace	get context of the current subroutine call
+chdir	File	change your current working directory
+chmod	File	changes the permissions on a list of files
+chomp	String 	remove a trailing record separator from a string
+chop	String 	remove the last character from a string
+chown	File	change the owership on a list of files
+chr	String 	get character this number represents
+chroot	File	make directory new root for path lookups
+close	I/O	close file (or pipe or socket) handle
+closedir	I/O	close directory handle
+connect	Socket	connect to a remove socket
+continue	Flow	optional trailing block in a while or foreach 
+cos	Math	cosine function
+crypt	String	one-way passwd-style encryption
+dbmclose	Objects,I/O	breaks binding on a tied dbm file
+dbmopen	Objects,I/O	create binding on a tied dbm file
+defined	Misc	test whether a value, variable, or function is defined
+delete	HASH	deletes a value from a hash
+die	I/O,Flow	raise an exception or bail out
+do	Flow,Modules	turn a BLOCK into a TERM
+dump	Misc,Flow	create an immediate core dump
+each	HASH	retrieve the next key/value pair from a hash
+endgrent	User	be done using group file
+endhostent	User	be done using hosts file
+endnetent	User	be done using networks file
+endprotoent	Network	be done using protocols file
+endpwent	User	be done using passwd file
+endservent	Network	be done using services file
+eof	I/O	test a filehandle for its end
+eval	Flow,Misc	catch exceptions or compile code
+exec	Process	abandon this program to run another
+exists	HASH	test whether a hash key is present
+exit	Flow	terminate this program
+exp	Math	raise I<e> to a power
+fcntl	File	file control system all
+fileno	I/O	return file descriptor from filehandle
+flock	I/O	lock an entire file with an advisory lock
+fork	Process	create a new process just like this one
+format	I/O	declare a picture format with use by the write() function
+formline	Misc	internal function used for formats
+getc	I/O	get	the next character from the filehandle
+getgrent	User	get next group record 
+getgrgid	User	get group record given group user ID
+getgrnam	User	get group record given group name
+gethostbyaddr	Network	get host record given its address
+gethostbyname	Network	get host record given name
+gethostent	Network	get next hosts record 
+getlogin	User	return who logged in at this tty
+getnetbyaddr	Network	get network record given its address
+getnetbyname	Network	get networks record given name
+getnetent	Network	get next networks record 
+getpeername	Socket	find the other hend of a socket connection
+getpgrp	Process	get process group
+getppid	Process	get parent process ID
+getpriority	Process	get current nice value
+getprotobyname	Network	get protocol record given name
+getprotobynumber	Network	get protocol record numeric protocol
+getprotoent	Network	get next protocols record
+getpwent	User	get next passwd record
+getpwnam	User	get passwd record given user login name
+getpwuid	User	get passwd record given user ID
+getservbyname	Network	get services record given its name
+getservbyport	Network	get services record given numeric port
+getservent	Network	get next services record 
+getsockname	Socket	retrieve the sockaddr for a given socket
+getsockopt	Socket	get socket options on a given socket
+glob	File		expand filenames using wildcards
+gmtime	Time	convert UNIX time into record or string using Greenwich time
+goto	Flow	create spaghetti code
+grep	LIST	locate elements in a list test true against a given criterion
+hex	Math,String	convert a string to a hexadecimal number
+import	Modules,Namespace	patch a module's namespace into your own
+index	String	find a substring within a string
+int	Math	get the integer portion of a number
+ioctl	File	system-dependent device control system call
+join	LIST	join a list into a string using a separator
+keys	HASH	retrieve list of indices from a hash
+kill	Process	send a signal to a process or process group
+last	Flow	exit a block prematurely
+lc	String	return lower-case version of a string
+lcfirst	String	return a string with just the next letter in lower case
+length	String	return the number of bytes in a string
+link	File	create a hard link in the filesytem
+listen	Socket	register your socket as a server 
+local	Misc,Namespace	create a temporary value for a global variable (dynamic scoping)
+localtime	Time	convert UNIX time into record or string using local time
+log	Math	retrieve the natural logarithm for a number
+lstat	File	stat a symbolic link
+m//	Regexp	match a string with a regular expression pattern
+map	LIST	apply a change to a list to get back a new list with the changes
+mkdir	File	create a directory
+msgctl	SysV	SysV IPC message control operations
+msgget	SysV	get SysV IPC message queue
+msgrcv	SysV	receive a SysV IPC message from a message queue
+msgsnd	SysV	send a SysV IPC message to a message queue
+my	Misc,Namespace	declare and assign a local variable (lexical scoping)
+next	Flow	iterate a block prematurely
+no	Modules	unimport some module symbols or semantics at compile time
+package	Modules,Objects,Namespace	declare a separate global namespace
+oct	String,Math	convert a string to an octal number
+open	File	open a file, pipe, or descriptor
+opendir	File	open a directory
+ord	String	find a character's numeric representation
+pack	Binary,String	convert a list into a binary representation
+pipe	Process	open a pair of connected filehandles
+pop	ARRAY	remove the last element from an array and return it
+pos	Regexp	find or set the offset for the last/next m//g search
+print	I/O	output a list to a filehandle
+printf	I/O  	output a formatted list to a filehandle
+push	ARRAY	append one or more elements to an array
+q/STRING/	String	singly quote a string
+qq/STRING/	String	doubly quote a string
+quotemeta	Regexp	quote regular expression magic characters
+qw/STRING/	LIST	quote a list of words
+qx/STRING/	Process	backquote quote a string
+rand	Math	retrieve the next pseudorandom number 
+read	I/O,Binary	fixed-length buffered input from a filehandle
+readdir	I/O	get a directory from a directory handle
+readlink	File	determine where a symbolic link is pointing
+recv	Socket	receive a message over a Socket
+redo	Flow	start this loop iteration over again
+ref	Objects	find out the type of thing being referenced
+rename	File	change a filename
+require	Modules	load in external functions from a library at runtime
+reset	Misc	clear all variables of a given name
+return	Flow	get out of a function early
+reverse	String,LIST	flip a string or a list
+rewinddir	I/O	reset directory handle
+rindex	String	right-to-left substring search
+rmdir	File	remove a directory
+s///	Regexp	replace a pattern with a string
+scalar	Misc	force a scalar context
+seek	I/O	reposition file pointer for random-access I/O
+seekdir	I/O	reposition directory pointer 
+select	I/O	reset default output or do I/O multiplexing
+semctl	SysV	SysV semaphore control operations
+semget	SysV	get set of SysV semaphores
+semop	SysV	SysV semaphore operations
+send	Socket	send a message over a socket
+setgrent	User	prepare group file for use
+sethostent	Network	prepare hosts file for use
+setnetent	Network	prepare networks file for use
+setpgrp	Process	set the process group of a process
+setpriority	Process	set a process's nice value
+setprotoent	Network	prepare protocols file for use
+setpwent	User	prepare passwd file for use
+setservent	Network	prepare services file for use
+setsockopt	Socket	set some socket options
+shift	ARRAY	remove the first element of an array, and return it
+shmctl	SysV	SysV shared memory operations
+shmget	SysV	get SysV shared memory segment identifier
+shmread	SysV	read SysV shared memory 
+shmwrite	SysV	write SysV shared memory 
+shutdown	Socket	close down just half of a socket connection
+sin	Math	return the sin of a number
+sleep	Process	block for some number of seconds
+socket	Socket	create a socket
+socketpair	Socket	create a pair of sockets
+sort	LIST	sort a list of values 
+splice	ARRAY	add or remove elements anywhere in an array
+split	Regexp	split up a string using a regexp delimiter
+sprintf	String	formatted print into a string	
+sqrt	Math	square root function
+srand	Math	seed the random number generator
+stat	File	get a file's status information
+study	Regexp	optimize input data for repeated searches
+sub	Flow	declare a subroutine, possibly anonymously
+substr	String	get or alter a portion of a stirng
+symlink	File	create a symbolic link to a file
+syscall	I/O,Binary	execute an arbitrary system call
+sysread	I/O,Binary	fixed-length unbuffered input from a filehandle
+system	Process	run a separate program 
+syswrite	I/O,Binary	fixed-length unbuffered output to a filehandle
+tell	I/O	get current seekpointer on a filehandle
+telldir	I/O	get current seekpointer on a directory handle
+tie	Objects	bind a variable to an object class 
+time	Time	return number of seconds since 1970
+times	Process,Time	return elapsed time for self and child processes
+tr///	String	transliterate a string
+truncate	I/O	shorten a file
+uc	String	return upper-case version of a string
+ucfirst	String	return a string with just the next letter in upper case
+umask	File	set file creation mode mask
+undef	Misc	remove a variable or function definition
+unlink	File	remove one link to a file
+unpack	Binary,LIST	convert binary structure into normal perl variables
+unshift	ARRAY	prepend more elements to the beginning of a list
+untie	Objects	break a tie binding to a variable
+use	Modules,Namespace	load a module and import its namespace
+use 	Objects	load in a module at compile time
+utime	File	set a file's last access and modify times
+values	HASH	return a list of the values in a hash
+vec	Binary	test or set particular bits in a string
+wait	Process	wait for any child process to die
+waitpid	Process	wait for  a particular child process to die
+wantarray	Misc,Flow	get list vs array context of current subroutine call
+warn	I/O	print debugging info
+write	I/O	print a picture record
+y///	String	transliterate a string
diff --git a/gnu/usr.bin/perl/lib/Pod/Text.pm b/gnu/usr.bin/perl/lib/Pod/Text.pm
new file mode 100644
index 00000000000..ac4f72b688b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Pod/Text.pm
@@ -0,0 +1,483 @@
+package Pod::Text;
+
+# Version 1.01
+
+=head1 NAME
+
+Pod::Text - convert POD data to formatted ASCII text
+
+=head1 SYNOPSIS
+
+	use Pod::Text;
+
+	pod2text("perlfunc.pod");
+
+Also:
+
+	pod2text < input.pod
+
+=head1 DESCRIPTION
+
+Pod::Text is a module that can convert documentation in the POD format (such
+as can be found throughout the Perl distribution) into formatted ASCII.
+Termcap is optionally supported for boldface/underline, and can enabled via
+C<$Pod::Text::termcap=1>. If termcap has not been enabled, then backspaces
+will be used to simulate bold and underlined text.
+
+A separate F<pod2text> program is included that is primarily a wrapper for
+Pod::Text.
+
+The single function C<pod2text()> can take one or two arguments. The first
+should be the name of a file to read the pod from, or "<&STDIN" to read from
+STDIN. A second argument, if provided, should be a filehandle glob where
+output should be sent.
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=head1 TODO
+
+Cleanup work. The input and output locations need to be more flexible,
+termcap shouldn't be a global variable, and the terminal speed needs to
+be properly calculated.
+
+=cut
+
+use Term::Cap;
+require Exporter;
+@ISA = Exporter;
+@EXPORT = qw(pod2text);
+
+$termcap=0;
+
+#$use_format=1;
+
+$UNDL = "\x1b[4m";
+$INV = "\x1b[7m";
+$BOLD = "\x1b[1m";
+$NORM = "\x1b[0m";
+
+sub pod2text {
+local($file,*OUTPUT) = @_;
+*OUTPUT = *STDOUT if @_<2;
+
+if($termcap and !$setuptermcap) {
+	$setuptermcap=1;
+
+    my($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
+    $UNDL = $term->{'_us'};
+    $INV = $term->{'_mr'};
+    $BOLD = $term->{'_md'};
+    $NORM = $term->{'_me'};
+}
+
+$SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
+       || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
+       ||  $ENV{COLUMNS}
+       || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]
+       || 72;
+
+$/ = "";
+
+$FANCY = 0;
+
+$cutting = 1;
+$DEF_INDENT = 4;
+$indent = $DEF_INDENT;
+$needspace = 0;
+
+open(IN, $file) || die "Couldn't open $file: $!";
+
+POD_DIRECTIVE: while (<IN>) {
+    if ($cutting) {
+	next unless /^=/;
+	$cutting = 0;
+    }
+    1 while s{^(.*?)(\t+)(.*)$}{
+	$1
+	. (' ' x (length($2) * 8 - length($1) % 8))
+	. $3
+    }me;
+    # Translate verbatim paragraph
+    if (/^\s/) {
+	$needspace = 1;
+	output($_);
+	next;
+    }
+
+sub prepare_for_output {
+
+    s/\s*$/\n/;
+    &init_noremap;
+
+    # need to hide E<> first; they're processed in clear_noremap
+    s/(E<[^<>]+>)/noremap($1)/ge;
+    $maxnest = 10;
+    while ($maxnest-- && /[A-Z]</) {
+	unless ($FANCY) {
+	    s/C<(.*?)>/`$1'/g;
+	} else {
+	    s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/ge;
+	}
+        # s/[IF]<(.*?)>/italic($1)/ge;
+        s/I<(.*?)>/*$1*/g;
+        # s/[CB]<(.*?)>/bold($1)/ge;
+	s/X<.*?>//g;
+	# LREF: a manpage(3f)
+	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
+	# LREF: an =item on another manpage
+	s{
+	    L<
+		([^/]+)
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	} {the "$2" entry in the $1 manpage}gx;
+
+	# LREF: an =item on this manpage
+	s{
+	   ((?:
+	    L<
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	    (,?\s+(and\s+)?)?
+	  )+)
+	} { internal_lrefs($1) }gex;
+
+	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
+	# the "func" can disambiguate
+	s{
+	    L<
+		(?:
+		    ([a-zA-Z]\S+?) / 
+		)?
+		"?(.*?)"?
+	    >
+	}{
+	    do {
+		$1 	# if no $1, assume it means on this page.
+		    ?  "the section on \"$2\" in the $1 manpage"
+		    :  "the section on \"$2\""
+	    }
+	}gex;
+
+        s/[A-Z]<(.*?)>/$1/g;
+    }
+    clear_noremap(1);
+}
+
+    &prepare_for_output;
+
+    if (s/^=//) {
+	# $needspace = 0;		# Assume this.
+	# s/\n/ /g;
+	($Cmd, $_) = split(' ', $_, 2);
+	# clear_noremap(1);
+	if ($Cmd eq 'cut') {
+	    $cutting = 1;
+	}
+	elsif ($Cmd eq 'head1') {
+	    makespace();
+	    print OUTPUT;
+	    # print OUTPUT uc($_);
+	}
+	elsif ($Cmd eq 'head2') {
+	    makespace();
+	    # s/(\w+)/\u\L$1/g;
+	    #print ' ' x $DEF_INDENT, $_;
+	    # print "\xA7";
+	    s/(\w)/\xA7 $1/ if $FANCY;
+	    print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
+	}
+	elsif ($Cmd eq 'over') {
+	    push(@indent,$indent);
+	    $indent += ($_ + 0) || $DEF_INDENT;
+	}
+	elsif ($Cmd eq 'back') {
+	    $indent = pop(@indent);
+	    warn "Unmatched =back\n" unless defined $indent;
+	    $needspace = 1;
+	}
+	elsif ($Cmd eq 'item') {
+	    makespace();
+	    # s/\A(\s*)\*/$1\xb7/ if $FANCY;
+	    # s/^(\s*\*\s+)/$1 /;
+	    {
+		if (length() + 3 < $indent) {
+		    my $paratag = $_;
+		    $_ = <IN>;
+		    if (/^=/) {  # tricked!
+			local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+			output($paratag);
+			redo POD_DIRECTIVE;
+		    }
+		    &prepare_for_output;
+		    IP_output($paratag, $_);
+		} else {
+		    local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+		    output($_);
+		}
+	    }
+	}
+	else {
+	    warn "Unrecognized directive: $Cmd\n";
+	}
+    }
+    else {
+	# clear_noremap(1);
+	makespace();
+	output($_, 1);
+    }
+}
+
+close(IN);
+
+}
+
+#########################################################################
+
+sub makespace {
+    if ($needspace) {
+	print OUTPUT "\n";
+	$needspace = 0;
+    }
+}
+
+sub bold {
+    my $line = shift;
+    return $line if $use_format;
+    if($termcap) {
+    	$line = "$BOLD$line$NORM";
+    } else {
+	    $line =~ s/(.)/$1\b$1/g;
+	}
+#    $line = "$BOLD$line$NORM" if $ansify;
+    return $line;
+}
+
+sub italic {
+    my $line = shift;
+    return $line if $use_format;
+    if($termcap) {
+    	$line = "$UNDL$line$NORM";
+    } else {
+	    $line =~ s/(.)/$1\b_/g;
+    }
+#    $line = "$UNDL$line$NORM" if $ansify;
+    return $line;
+}
+
+# Fill a paragraph including underlined and overstricken chars.
+# It's not perfect for words longer than the margin, and it's probably
+# slow, but it works.
+sub fill {
+    local $_ = shift;
+    my $par = "";
+    my $indent_space = " " x $indent;
+    my $marg = $SCREEN-$indent;
+    my $line = $indent_space;
+    my $line_length;
+    foreach (split) {
+	my $word_length = length;
+	$word_length -= 2 while /\010/g;  # Subtract backspaces
+
+	if ($line_length + $word_length > $marg) {
+	    $par .= $line . "\n";
+	    $line= $indent_space . $_;
+	    $line_length = $word_length;
+	}
+	else {
+	    if ($line_length) {
+		$line_length++;
+		$line .= " ";
+	    }
+	    $line_length += $word_length;
+	    $line .= $_;
+	}
+    }
+    $par .= "$line\n" if $line;
+    $par .= "\n";
+    return $par;
+}
+
+sub IP_output {
+    local($tag, $_) = @_;
+    local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT;
+    $tag_cols = $SCREEN - $tag_indent;
+    $cols = $SCREEN - $indent;
+    $tag =~ s/\s*$//;
+    s/\s+/ /g;
+    s/^ //;
+    $str = "format OUTPUT = \n"
+	. (" " x ($tag_indent))
+	. '@' . ('<' x ($indent - $tag_indent - 1))
+	. "^" .  ("<" x ($cols - 1)) . "\n"
+	. '$tag, $_'
+	. "\n~~"
+	. (" " x ($indent-2))
+	. "^" .  ("<" x ($cols - 5)) . "\n"
+	. '$_' . "\n\n.\n1";
+    #warn $str; warn "tag is $tag, _ is $_";
+    eval $str || die;
+    write OUTPUT;
+}
+
+sub output {
+    local($_, $reformat) = @_;
+    if ($reformat) {
+	$cols = $SCREEN - $indent;
+	s/\s+/ /g;
+	s/^ //;
+	$str = "format OUTPUT = \n~~"
+	    . (" " x ($indent-2))
+	    . "^" .  ("<" x ($cols - 5)) . "\n"
+	    . '$_' . "\n\n.\n1";
+	eval $str || die;
+	write OUTPUT;
+    } else {
+	s/^/' ' x $indent/gem;
+	s/^\s+\n$/\n/gm;
+	print OUTPUT;
+    }
+}
+
+sub noremap {
+    local($thing_to_hide) = shift;
+    $thing_to_hide =~ tr/\000-\177/\200-\377/;
+    return $thing_to_hide;
+}
+
+sub init_noremap {
+    die "unmatched init" if $mapready++;
+    if ( /[\200-\377]/ ) {
+	warn "hit bit char in input stream";
+    }
+}
+
+sub clear_noremap {
+    my $ready_to_print = $_[0];
+    die "unmatched clear" unless $mapready--;
+    tr/\200-\377/\000-\177/;
+    # now for the E<>s, which have been hidden until now
+    # otherwise the interative \w<> processing would have
+    # been hosed by the E<gt>
+    s {
+	    E<	
+	    ( [A-Za-z]+ )	
+	    >	
+    } {
+	 do {
+	     defined $HTML_Escapes{$1}
+		? do { $HTML_Escapes{$1} }
+		: do {
+		    warn "Unknown escape: $& in $_";
+		    "E<$1>";
+		}
+	 }
+    }egx if $ready_to_print;
+}
+
+sub internal_lrefs {
+    local($_) = shift;
+    s{L</([^>]+)>}{$1}g;
+    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
+    my $retstr = "the ";
+    my $i;
+    for ($i = 0; $i <= $#items; $i++) {
+	$retstr .= "C<$items[$i]>";
+	$retstr .= ", " if @items > 2 && $i != $#items;
+	$retstr .= " and " if $i+2 == @items;
+    }
+
+    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
+	    .  " elsewhere in this document ";
+
+    return $retstr;
+
+}
+
+BEGIN {
+
+%HTML_Escapes = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1",	#   capital A, acute accent
+    "aacute"	=>	"\xE1",	#   small a, acute accent
+    "Acirc"	=>	"\xC2",	#   capital A, circumflex accent
+    "acirc"	=>	"\xE2",	#   small a, circumflex accent
+    "AElig"	=>	"\xC6",	#   capital AE diphthong (ligature)
+    "aelig"	=>	"\xE6",	#   small ae diphthong (ligature)
+    "Agrave"	=>	"\xC0",	#   capital A, grave accent
+    "agrave"	=>	"\xE0",	#   small a, grave accent
+    "Aring"	=>	"\xC5",	#   capital A, ring
+    "aring"	=>	"\xE5",	#   small a, ring
+    "Atilde"	=>	"\xC3",	#   capital A, tilde
+    "atilde"	=>	"\xE3",	#   small a, tilde
+    "Auml"	=>	"\xC4",	#   capital A, dieresis or umlaut mark
+    "auml"	=>	"\xE4",	#   small a, dieresis or umlaut mark
+    "Ccedil"	=>	"\xC7",	#   capital C, cedilla
+    "ccedil"	=>	"\xE7",	#   small c, cedilla
+    "Eacute"	=>	"\xC9",	#   capital E, acute accent
+    "eacute"	=>	"\xE9",	#   small e, acute accent
+    "Ecirc"	=>	"\xCA",	#   capital E, circumflex accent
+    "ecirc"	=>	"\xEA",	#   small e, circumflex accent
+    "Egrave"	=>	"\xC8",	#   capital E, grave accent
+    "egrave"	=>	"\xE8",	#   small e, grave accent
+    "ETH"	=>	"\xD0",	#   capital Eth, Icelandic
+    "eth"	=>	"\xF0",	#   small eth, Icelandic
+    "Euml"	=>	"\xCB",	#   capital E, dieresis or umlaut mark
+    "euml"	=>	"\xEB",	#   small e, dieresis or umlaut mark
+    "Iacute"	=>	"\xCD",	#   capital I, acute accent
+    "iacute"	=>	"\xED",	#   small i, acute accent
+    "Icirc"	=>	"\xCE",	#   capital I, circumflex accent
+    "icirc"	=>	"\xEE",	#   small i, circumflex accent
+    "Igrave"	=>	"\xCD",	#   capital I, grave accent
+    "igrave"	=>	"\xED",	#   small i, grave accent
+    "Iuml"	=>	"\xCF",	#   capital I, dieresis or umlaut mark
+    "iuml"	=>	"\xEF",	#   small i, dieresis or umlaut mark
+    "Ntilde"	=>	"\xD1",		#   capital N, tilde
+    "ntilde"	=>	"\xF1",		#   small n, tilde
+    "Oacute"	=>	"\xD3",	#   capital O, acute accent
+    "oacute"	=>	"\xF3",	#   small o, acute accent
+    "Ocirc"	=>	"\xD4",	#   capital O, circumflex accent
+    "ocirc"	=>	"\xF4",	#   small o, circumflex accent
+    "Ograve"	=>	"\xD2",	#   capital O, grave accent
+    "ograve"	=>	"\xF2",	#   small o, grave accent
+    "Oslash"	=>	"\xD8",	#   capital O, slash
+    "oslash"	=>	"\xF8",	#   small o, slash
+    "Otilde"	=>	"\xD5",	#   capital O, tilde
+    "otilde"	=>	"\xF5",	#   small o, tilde
+    "Ouml"	=>	"\xD6",	#   capital O, dieresis or umlaut mark
+    "ouml"	=>	"\xF6",	#   small o, dieresis or umlaut mark
+    "szlig"	=>	"\xDF",		#   small sharp s, German (sz ligature)
+    "THORN"	=>	"\xDE",	#   capital THORN, Icelandic
+    "thorn"	=>	"\xFE",	#   small thorn, Icelandic
+    "Uacute"	=>	"\xDA",	#   capital U, acute accent
+    "uacute"	=>	"\xFA",	#   small u, acute accent
+    "Ucirc"	=>	"\xDB",	#   capital U, circumflex accent
+    "ucirc"	=>	"\xFB",	#   small u, circumflex accent
+    "Ugrave"	=>	"\xD9",	#   capital U, grave accent
+    "ugrave"	=>	"\xF9",	#   small u, grave accent
+    "Uuml"	=>	"\xDC",	#   capital U, dieresis or umlaut mark
+    "uuml"	=>	"\xFC",	#   small u, dieresis or umlaut mark
+    "Yacute"	=>	"\xDD",	#   capital Y, acute accent
+    "yacute"	=>	"\xFD",	#   small y, acute accent
+    "yuml"	=>	"\xFF",	#   small y, dieresis or umlaut mark
+
+    "lchevron"	=>	"\xAB",	#   left chevron (double less than)
+    "rchevron"	=>	"\xBB",	#   right chevron (double greater than)
+);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Search/Dict.pm b/gnu/usr.bin/perl/lib/Search/Dict.pm
new file mode 100644
index 00000000000..295da6b31d2
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Search/Dict.pm
@@ -0,0 +1,75 @@
+package Search::Dict;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(look);
+
+=head1 NAME
+
+Search::Dict, look - search for key in dictionary file
+
+=head1 SYNOPSIS
+
+    use Search::Dict;
+    look *FILEHANDLE, $key, $dict, $fold;
+
+=head1 DESCRIPTION
+
+Sets file position in FILEHANDLE to be first line greater than or equal
+(stringwise) to I<$key>.  Returns the new file position, or -1 if an error
+occurs.
+
+The flags specify dictionary order and case folding:
+
+If I<$dict> is true, search by dictionary order (ignore anything but word
+characters and whitespace).
+
+If I<$fold> is true, ignore case.
+
+=cut
+
+sub look {
+    local(*FH,$key,$dict,$fold) = @_;
+    local($_);
+    my(@stat) = stat(FH)
+	or return -1;
+    my($size, $blksize) = @stat[7,11];
+    $blksize ||= 8192;
+    $key =~ s/[^\w\s]//g if $dict;
+    $key =~ tr/A-Z/a-z/ if $fold;
+    my($min, $max, $mid) = (0, int($size / $blksize));
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH, $mid * $blksize, 0)
+	    or return -1;
+	<FH> if $mid;			# probably a partial line
+	$_ = <FH>;
+	chop;
+	s/[^\w\s]//g if $dict;
+	tr/A-Z/a-z/ if $fold;
+	if (defined($_) && $_ lt $key) {
+	    $min = $mid;
+	}
+	else {
+	    $max = $mid;
+	}
+    }
+    $min *= $blksize;
+    seek(FH,$min,0)
+	or return -1;
+    <FH> if $min;
+    for (;;) {
+	$min = tell(FH);
+	$_ = <FH>
+	    or last;
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	last if $_ ge $key;
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/SelectSaver.pm b/gnu/usr.bin/perl/lib/SelectSaver.pm
new file mode 100644
index 00000000000..4c764bedcf1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/SelectSaver.pm
@@ -0,0 +1,50 @@
+package SelectSaver;
+
+=head1 NAME
+
+SelectSaver - save and restore selected file handle
+
+=head1 SYNOPSIS
+
+    use SelectSaver;
+
+    {
+       my $saver = new SelectSaver(FILEHANDLE);
+       # FILEHANDLE is selected
+    }
+    # previous handle is selected
+
+    {
+       my $saver = new SelectSaver;
+       # new handle may be selected, or not
+    }
+    # previous handle is selected
+
+=head1 DESCRIPTION
+
+A C<SelectSaver> object contains a reference to the file handle that
+was selected when it was created.  If its C<new> method gets an extra
+parameter, then that parameter is selected; otherwise, the selected
+file handle remains unchanged.
+
+When a C<SelectSaver> is destroyed, it re-selects the file handle
+that was selected when it was created.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
+    my $fh = (@_ > 1) ? (select qualify($_[1], caller)) : select;
+    bless [$fh], $_[0];
+}
+
+sub DESTROY {
+    my $this = $_[0];
+    select $$this[0];
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/SelfLoader.pm b/gnu/usr.bin/perl/lib/SelfLoader.pm
new file mode 100644
index 00000000000..e3da9ebadbc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/SelfLoader.pm
@@ -0,0 +1,285 @@
+package SelfLoader;
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(AUTOLOAD);
+$VERSION = 1.06; sub Version {$VERSION}
+$DEBUG = 0;
+
+my %Cache;      # private cache for all SelfLoader's client packages
+
+AUTOLOAD {
+    print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
+    my $code = $Cache{$AUTOLOAD};
+    unless ($code) {
+        # Maybe this pack had stubs before __DATA__, and never initialized.
+        # Or, this maybe an automatic DESTROY method call when none exists.
+        $AUTOLOAD =~ m/^(.*)::/;
+        SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
+        $code = $Cache{$AUTOLOAD};
+        $code = "sub $AUTOLOAD { }" if (!$code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $code;
+    }
+    print STDERR "SelfLoader::AUTOLOAD eval: $code\n" if $DEBUG;
+    eval $code;
+    if ($@) {
+        $@ =~ s/ at .*\n//;
+        croak $@;
+    }
+    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
+    delete $Cache{$AUTOLOAD};
+    goto &$AUTOLOAD
+}
+
+sub load_stubs { shift->_load_stubs((caller)[0]) }
+
+sub _load_stubs {
+    my($self, $callpack) = @_;
+    my $fh = \*{"${callpack}::DATA"};
+    my $currpack = $callpack;
+    my($line,$name,@lines, @stubs, $protoype);
+
+    print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG;
+    croak("$callpack doesn't contain an __DATA__ token")
+        unless fileno($fh);
+    $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+
+    while($line = <$fh> and $line !~ m/^__END__/) {
+        if ($line =~ m/^sub\s+([\w:]+)\s*(\([\$\@\;\%\\]*\))?/) {       # A sub declared
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $protoype = $2;
+            @lines = ($line);
+            if (index($1,'::') == -1) {         # simple sub name
+                $name = "${currpack}::$1";
+            } else {                            # sub name with package
+                $name = $1;
+                $name =~ m/^(.*)::/;
+                if (defined(&{"${1}::AUTOLOAD"})) {
+                    \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                        die 'SelfLoader Error: attempt to specify Selfloading',
+                            " sub $name in non-selfloading module $1";
+                } else {
+                    $self->export($1,'AUTOLOAD');
+                }
+            }
+        } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $self->_package_defined($line);
+            $name = '';
+            @lines = ();
+            $currpack = $1;
+            $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+            if (defined(&{"${1}::AUTOLOAD"})) {
+                \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                    die 'SelfLoader Error: attempt to specify Selfloading',
+                        " package $currpack which already has AUTOLOAD";
+            } else {
+                $self->export($currpack,'AUTOLOAD');
+            }
+        } else {
+            push(@lines,$line);
+        }
+    }
+    close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/;     # __END__
+    push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+    eval join('', @stubs) if @stubs;
+}
+
+
+sub _add_to_cache {
+    my($self,$fullname,$pack,$lines, $protoype) = @_;
+    return () unless $fullname;
+    carp("Redefining sub $fullname") if exists $Cache{$fullname};
+    $Cache{$fullname} = join('', "package $pack; ",@$lines);
+    print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
+    # return stub to be eval'd
+    defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
+}
+
+sub _package_defined {}
+
+1;
+__END__
+
+=head1 NAME
+
+SelfLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+    package FOOBAR;
+    use SelfLoader;
+    
+    ... (initializing code)
+    
+    __DATA__
+    sub {....
+
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from after the __DATA__ token.  See also L<perlsub/"Autoloading">.
+
+=head2 The __DATA__ token
+
+The __DATA__ token tells the perl compiler that the perl code
+for compilation is finished. Everything after the __DATA__ token
+is available for reading via the filehandle FOOBAR::DATA,
+where FOOBAR is the name of the current package when the __DATA__
+token is reached. This works just the same as __END__ does in
+package 'main', but for other modules data after __END__ is not
+automatically retreivable , whereas data after __DATA__ is.
+The __DATA__ token is not recognized in versions of perl prior to
+5.001m.
+
+Note that it is possible to have __DATA__ tokens in the same package
+in multiple files, and that the last __DATA__ token in a given
+package that is encountered by the compiler is the one accessible
+by the filehandle. This also applies to __END__ and main, i.e. if
+the 'main' program has an __END__, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an '__DATA__',
+then the DATA filehandle is set to access the data after the __DATA__
+in the module, _not_ the data after the __END__ token in the 'main'
+program, since the compiler encounters the 'require'd file later.
+
+=head2 SelfLoader autoloading
+
+The SelfLoader works by the user placing the __DATA__
+token _after_ perl code which needs to be compiled and
+run at 'require' time, but _before_ subroutine declarations
+that can be loaded in later - usually because they may never
+be called.
+
+The SelfLoader will read from the FOOBAR::DATA filehandle to
+load in the data after __DATA__, and load in any subroutine
+when it is called. The costs are the one-time parsing of the
+data after __DATA__, and a load delay for the _first_
+call of any autoloaded function. The benefits (hopefully)
+are a speeded up compilation phase, with no need to load
+functions which are never used.
+
+The SelfLoader will stop reading from __DATA__ if
+it encounters the __END__ token - just as you would expect.
+If the __END__ token is present, and is followed by the
+token DATA, then the SelfLoader leaves the FOOBAR::DATA
+filehandle open on the line after that token.
+
+The SelfLoader exports the AUTOLOAD subroutine to the
+package using the SelfLoader, and this loads the called
+subroutine when it is first called.
+
+There is no advantage to putting subroutines which will _always_
+be called after the __DATA__ token.
+
+=head2 Autoloading and package lexicals
+
+A 'my $pack_lexical' statement makes the variable $pack_lexical
+local _only_ to the file up to the __DATA__ token. Subroutines
+declared elsewhere _cannot_ see these types of variables,
+just as if you declared subroutines in the package but in another
+file, they cannot see these variables.
+
+So specifically, autoloaded functions cannot see package
+lexicals (this applies to both the SelfLoader and the Autoloader).
+
+=head2 SelfLoader and AutoLoader
+
+The SelfLoader can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the SelfLoader exports
+the AUTOLOAD function - but if you have your own AUTOLOAD and
+are using the AutoLoader too, you probably know what you're doing),
+and the __END__ token to __DATA__. You will need perl version 5.001m
+or later to use this (version 5.001 with all patches up to patch m).
+
+There is no need to inherit from the SelfLoader.
+
+The SelfLoader works similarly to the AutoLoader, but picks up the
+subs from after the __DATA__ instead of in the 'lib/auto' directory.
+There is a maintainance gain in not needing to run AutoSplit on the module
+at installation, and a runtime gain in not needing to keep opening and
+closing files to load subs. There is a runtime loss in needing
+to parse the code after the __DATA__.
+
+=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+This section is only relevant if you want to use
+the FOOBAR::DATA together with the SelfLoader.
+
+Data after the __DATA__ token in a module is read using the
+FOOBAR::DATA filehandle. __END__ can still be used to denote the end
+of the __DATA__ section if followed by the token DATA - this is supported
+by the SelfLoader. The FOOBAR::DATA filehandle is left open if an __END__
+followed by a DATA is found, with the filehandle positioned at the start
+of the line after the __END__ token. If no __END__ token is present,
+or an __END__ token with no DATA token on the same line, then the filehandle
+is closed.
+
+The SelfLoader reads from wherever the current
+position of the FOOBAR::DATA filehandle is, until the
+EOF or __END__. This means that if you want to use
+that filehandle (and ONLY if you want to), you should either
+
+1. Put all your subroutine declarations immediately after
+the __DATA__ token and put your own data after those
+declarations, using the __END__ token to mark the end
+of subroutine declarations. You must also ensure that the SelfLoader
+reads first by  calling 'SelfLoader->load_stubs();', or by using a
+function which is selfloaded;
+
+or
+
+2. You should read the FOOBAR::DATA filehandle first, leaving
+the handle open and positioned at the first line of subroutine
+declarations.
+
+You could conceivably do both.
+
+=head2 Classes and inherited methods.
+
+For modules which are not classes, this section is not relevant.
+This section is only relevant if you have methods which could
+be inherited.
+
+A subroutine stub (or forward declaration) looks like
+
+  sub stub;
+
+i.e. it is a subroutine declaration without the body of the
+subroutine. For modules which are not classes, there is no real
+need for stubs as far as autoloading is concerned.
+
+For modules which ARE classes, and need to handle inherited methods,
+stubs are needed to ensure that the method inheritance mechanism works
+properly. You can load the stubs into the module at 'require' time, by
+adding the statement 'SelfLoader->load_stubs();' to the module to do
+this.
+
+The alternative is to put the stubs in before the __DATA__ token BEFORE
+releasing the module, and for this purpose the Devel::SelfStubber
+module is available.  However this does require the extra step of ensuring
+that the stubs are in the module. If this is done I strongly recommend
+that this is done BEFORE releasing the module - it should NOT be done
+at install time in general.
+
+=head1 Multiple packages and fully qualified subroutine names
+
+Subroutines in multiple packages within the same file are supported - but you
+should note that this requires exporting the SelfLoader::AUTOLOAD to
+every package which requires it. This is done automatically by the
+SelfLoader when it first loads the subs into the cache, but you should
+really specify it in the initialization before the __DATA__ by putting
+a 'use SelfLoader' statement in each package.
+
+Fully qualified subroutine names are also supported. For example,
+
+   __DATA__
+   sub foo::bar {23}
+   package baz;
+   sub dob {32}
+
+will all be loaded correctly by the SelfLoader, and the SelfLoader
+will ensure that the packages 'foo' and 'baz' correctly have the
+SelfLoader AUTOLOAD method when the data after __DATA__ is first parsed.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Shell.pm b/gnu/usr.bin/perl/lib/Shell.pm
new file mode 100644
index 00000000000..bb44b5398b5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Shell.pm
@@ -0,0 +1,126 @@
+package Shell;
+
+use Config;
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    my @EXPORT;
+    if (@_) {
+	@EXPORT = @_;
+    }
+    else {
+	@EXPORT = 'AUTOLOAD';
+    }
+    foreach $sym (@EXPORT) {
+        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
+    }
+};
+
+AUTOLOAD {
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/^.*:://;
+    eval qq {
+	sub $AUTOLOAD {
+	    if (\@_ < 1) {
+		`$cmd`;
+	    }
+	    elsif (\$Config{'archname'} eq 'os2') {
+		local(\*SAVEOUT, \*READ, \*WRITE);
+
+		open SAVEOUT, '>&STDOUT' or die;
+		pipe READ, WRITE or die;
+		open STDOUT, '>&WRITE' or die;
+		close WRITE;
+
+		my \$pid = system(1, \$cmd, \@_);
+		die "Can't execute $cmd: \$!\n" if \$pid < 0;
+
+		open STDOUT, '>&SAVEOUT' or die;
+		close SAVEOUT;
+
+		if (wantarray) {
+		    my \@ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \@ret;
+		}
+		else {
+		    local(\$/) = undef;
+		    my \$ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \$ret;
+		}
+	    }
+	    else {
+		open(SUBPROC, "-|")
+			or exec '$cmd', \@_
+			or die "Can't exec $cmd: \$!\n";
+		if (wantarray) {
+		    my \@ret = <SUBPROC>;
+		    close SUBPROC;	# XXX Oughta use a destructor.
+		    \@ret;
+		}
+		else {
+		    local(\$/) = undef;
+		    my \$ret = <SUBPROC>;
+		    close SUBPROC;
+		    \$ret;
+		}
+	    }
+	}
+    };
+    goto &$AUTOLOAD;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+See below.
+
+=head1 DESCRIPTION
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
+  To: perl5-porters@isu.edu
+  From: Larry Wall <lwall@scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/tmp/passwd");
+
+That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
+package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+Larry
+
+
+=head1 AUTHOR
+
+Larry Wall
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Symbol.pm b/gnu/usr.bin/perl/lib/Symbol.pm
new file mode 100644
index 00000000000..67808af082a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Symbol.pm
@@ -0,0 +1,100 @@
+package Symbol;
+
+=head1 NAME
+
+Symbol - manipulate Perl symbols and their names
+
+=head1 SYNOPSIS
+
+    use Symbol;
+
+    $sym = gensym;
+    open($sym, "filename");
+    $_ = <$sym>;
+    # etc.
+
+    ungensym $sym;      # no effect
+
+    print qualify("x"), "\n";              # "Test::x"
+    print qualify("x", "FOO"), "\n"        # "FOO::x"
+    print qualify("BAR::x"), "\n";         # "BAR::x"
+    print qualify("BAR::x", "FOO"), "\n";  # "BAR::x"
+    print qualify("STDOUT", "FOO"), "\n";  # "main::STDOUT" (global)
+    print qualify(\*x), "\n";              # returns \*x
+    print qualify(\*x, "FOO"), "\n";       # returns \*x
+
+=head1 DESCRIPTION
+
+C<Symbol::gensym> creates an anonymous glob and returns a reference
+to it.  Such a glob reference can be used as a file or directory
+handle.
+
+For backward compatibility with older implementations that didn't
+support anonymous globs, C<Symbol::ungensym> is also provided.
+But it doesn't do anything.
+
+C<Symbol::qualify> turns unqualified symbol names into qualified
+variable names (e.g. "myvar" -> "MyPackage::myvar").  If it is given a
+second parameter, C<qualify> uses it as the default package;
+otherwise, it uses the package of its caller.  Regardless, global
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
+"main::".
+
+Qualification applies only to symbol names (strings).  References are
+left unchanged under the assumption that they are glob references,
+which are qualified by their nature.
+
+=cut
+
+BEGIN { require 5.002; }
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(gensym ungensym qualify);
+
+my $genpkg = "Symbol::";
+my $genseq = 0;
+
+my %global;
+while (<DATA>) {
+    chomp;
+    $global{$_} = 1;
+}
+close DATA;
+
+sub gensym () {
+    my $name = "GEN" . $genseq++;
+    local *{$genpkg . $name};
+    \delete ${$genpkg}{$name};
+}
+
+sub ungensym ($) {}
+
+sub qualify ($;$) {
+    my ($name) = @_;
+    if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
+	my $pkg;
+	# Global names: special character, "^x", or other. 
+	if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
+	    $pkg = "main";
+	}
+	else {
+	    $pkg = (@_ > 1) ? $_[1] : caller;
+	}
+	$name = $pkg . "::" . $name;
+    }
+    $name;
+}
+
+1;
+
+__DATA__
+ARGV
+ARGVOUT
+ENV
+INC
+SIG
+STDERR
+STDIN
+STDOUT
diff --git a/gnu/usr.bin/perl/lib/Sys/Hostname.pm b/gnu/usr.bin/perl/lib/Sys/Hostname.pm
new file mode 100644
index 00000000000..2c40361b51a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Sys/Hostname.pm
@@ -0,0 +1,99 @@
+package Sys::Hostname;
+
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(hostname);
+
+=head1 NAME
+
+Sys::Hostname - Try every conceivable way to get hostname
+
+=head1 SYNOPSIS
+
+    use Sys::Hostname;
+    $host = hostname;
+
+=head1 DESCRIPTION
+
+Attempts several methods of getting the system hostname and
+then caches the result.  It tries C<syscall(SYS_gethostname)>,
+C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
+If all that fails it C<croak>s.
+
+All nulls, returns, and newlines are removed from the result.
+
+=head1 AUTHOR
+
+David Sundstrom <sunds@asictest.sc.ti.com>
+
+Texas Instruments
+
+=cut
+
+sub hostname {
+
+  # method 1 - we already know it
+  return $host if defined $host;
+
+  if ($^O eq 'VMS') {
+
+    # method 2 - no sockets ==> return DECnet node name
+    eval {gethostbyname('me')};
+    if ($@) { return $host = $ENV{'SYS$NODE'}; }
+
+    # method 3 - has someone else done the job already?  It's common for the
+    #    TCP/IP stack to advertise the hostname via a logical name.  (Are
+    #    there any other logicals which TCP/IP stacks use for the host name?)
+    $host = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
+            $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
+            $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
+    return $host if $host;
+
+    # method 4 - does hostname happen to work?
+    my($rslt) = `hostname`;
+    if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; }
+    return $host if $host;
+
+    # rats!
+    $host = '';
+    Carp::croak "Cannot get host name of local machine";  
+
+  }
+  else {  # Unix
+
+    # method 2 - syscall is preferred since it avoids tainting problems
+    eval {
+	{
+	    package main;
+	    require "syscall.ph";
+	}
+	$host = "\0" x 65; ## preload scalar
+	syscall(&main::SYS_gethostname, $host, 65) == 0;
+    }
+
+    # method 3 - trusty old hostname command
+    || eval {
+	$host = `(hostname) 2>/dev/null`; # bsdish
+    }
+
+    # method 4 - sysV uname command (may truncate)
+    || eval {
+	$host = `uname -n 2>/dev/null`; ## sysVish
+    }
+
+    # method 5 - Apollo pre-SR10
+    || eval {
+	($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
+    }
+
+    # bummer
+    || Carp::croak "Cannot get host name of local machine";  
+
+    # remove garbage 
+    $host =~ tr/\0\r\n//d;
+    $host;
+  }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Sys/Syslog.pm b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
new file mode 100644
index 00000000000..f02a2b516c3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
@@ -0,0 +1,221 @@
+package Sys::Syslog;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(openlog closelog setlogmask syslog);
+
+use Socket;
+
+# adapted from syslog.pl
+#
+# Tom Christiansen <tchrist@convex.com>
+# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
+# NOTE: openlog now takes three arguments, just like openlog(3)
+
+=head1 NAME
+
+Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
+
+=head1 SYNOPSIS
+
+    use Sys::Syslog;
+
+    openlog $ident, $logopt, $facility;
+    syslog $priority, $mask, $format, @args;
+    $oldmask = setlogmask $mask_priority;
+    closelog;
+
+=head1 DESCRIPTION
+
+Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
+Call C<syslog()> with a string priority and a list of C<printf()> args
+just like C<syslog(3)>.
+
+Syslog provides the functions:
+
+=over
+
+=item openlog $ident, $logopt, $facility
+
+I<$ident> is prepended to every message.
+I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
+I<$facility> specifies the part of the system
+
+=item syslog $priority, $mask, $format, @args
+
+If I<$priority> and I<$mask> permit, logs I<($format, @args)>
+printed as by C<printf(3V)>, with the addition that I<%m>
+is replaced with C<"$!"> (the latest error message).
+
+=item setlogmask $mask_priority
+
+Sets log mask I<$mask_priority> and returns the old mask.
+
+=item closelog
+
+Closes the log file.
+
+=back
+
+Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
+
+=head1 EXAMPLES
+
+    openlog($program, 'cons,pid', 'user');
+    syslog('info', 'this is another test');
+    syslog('mail|warning', 'this is a better test: %d', time);
+    closelog();
+
+    syslog('debug', 'this is the last test');
+    openlog("$program $$", 'ndelay', 'user');
+    syslog('notice', 'fooprogram: this is really done');
+
+    $! = 55;
+    syslog('info', 'problem was %m'); # %m == $! in syslog(3)
+
+=head1 DEPENDENCIES
+
+B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
+
+=head1 SEE ALSO
+
+L<syslog(3)>
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<lwall@sems.com>E<gt>
+
+=cut
+
+$host = hostname() unless $host;	# set $Syslog::host to change
+
+require 'syslog.ph';
+
+$maskpri = &LOG_UPTO(&LOG_DEBUG);
+
+sub openlog {
+    ($ident, $logopt, $facility) = @_;  # package vars
+    $lo_pid = $logopt =~ /\bpid\b/;
+    $lo_ndelay = $logopt =~ /\bndelay\b/;
+    $lo_cons = $logopt =~ /\bcons\b/;
+    $lo_nowait = $logopt =~ /\bnowait\b/;
+    &connect if $lo_ndelay;
+} 
+
+sub closelog {
+    $facility = $ident = '';
+    &disconnect;
+} 
+
+sub setlogmask {
+    local($oldmask) = $maskpri;
+    $maskpri = shift;
+    $oldmask;
+}
+ 
+sub syslog {
+    local($priority) = shift;
+    local($mask) = shift;
+    local($message, $whoami);
+    local(@words, $num, $numpri, $numfac, $sum);
+    local($facility) = $facility;	# may need to change temporarily.
+
+    croak "syslog: expected both priority and mask" unless $mask && $priority;
+
+    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
+    undef $numpri;
+    undef $numfac;
+    foreach (@words) {
+	$num = &xlate($_);		# Translate word to number.
+	if (/^kern$/ || $num < 0) {
+	    croak "syslog: invalid level/facility: $_";
+	}
+	elsif ($num <= &LOG_PRIMASK) {
+	    croak "syslog: too many levels given: $_" if defined($numpri);
+	    $numpri = $num;
+	    return 0 unless &LOG_MASK($numpri) & $maskpri;
+	}
+	else {
+	    croak "syslog: too many facilities given: $_" if defined($numfac);
+	    $facility = $_;
+	    $numfac = $num;
+	}
+    }
+
+    croak "syslog: level must be given" unless defined($numpri);
+
+    if (!defined($numfac)) {	# Facility not specified in this call.
+	$facility = 'user' unless $facility;
+	$numfac = &xlate($facility);
+    }
+
+    &connect unless $connected;
+
+    $whoami = $ident;
+
+    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+	$whoami = $1;
+	$mask = $2;
+    } 
+
+    unless ($whoami) {
+	($whoami = getlogin) ||
+	    ($whoami = getpwuid($<)) ||
+		($whoami = 'syslog');
+    }
+
+    $whoami .= "[$$]" if $lo_pid;
+
+    $mask =~ s/%m/$!/g;
+    $mask .= "\n" unless $mask =~ /\n$/;
+    $message = sprintf ($mask, @_);
+
+    $sum = $numpri + $numfac;
+    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+	if ($lo_cons) {
+	    if ($pid = fork) {
+		unless ($lo_nowait) {
+		    $died = waitpid($pid, 0);
+		}
+	    }
+	    else {
+		open(CONS,">/dev/console");
+		print CONS "<$facility.$priority>$whoami: $message\r";
+		exit if defined $pid;		# if fork failed, we're parent
+		close CONS;
+	    }
+	}
+    }
+}
+
+sub xlate {
+    local($name) = @_;
+    $name =~ y/a-z/A-Z/;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "Sys::Syslog::$name";
+    eval(&$name) || -1;
+}
+
+sub connect {
+    unless ($host) {
+	require Sys::Hostname;
+	$host = Sys::Hostname::hostname();
+    }
+    my $udp = getprotobyname('udp');
+    my $syslog = getservbyname('syslog','udp');
+    my $this = sockaddr_in($syslog, INADDR_ANY);
+    my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
+    socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) 	     || croak "socket: $!";
+    connect(SYSLOG,$that) 			     || croak "connect: $!";
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Term/Cap.pm b/gnu/usr.bin/perl/lib/Term/Cap.pm
new file mode 100644
index 00000000000..656889591a6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/Cap.pm
@@ -0,0 +1,403 @@
+package Term::Cap;
+use Carp;
+
+# Last updated: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
+
+# TODO:
+# support Berkeley DB termcaps
+# should probably be a .xs module
+# force $FH into callers package?
+# keep $FH in object at Tgetent time?
+
+=head1 NAME
+
+Term::Cap - Perl termcap interface
+
+=head1 SYNOPSIS
+
+    require Term::Cap;
+    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
+    $terminal->Trequire(qw/ce ku kd/);
+    $terminal->Tgoto('cm', $col, $row, $FH);
+    $terminal->Tputs('dl', $count, $FH);
+    $terminal->Tpad($string, $count, $FH);
+
+=head1 DESCRIPTION
+
+These are low-level functions to extract and use capabilities from
+a terminal capability (termcap) database.
+
+The B<Tgetent> function extracts the entry of the specified terminal
+type I<TERM> (defaults to the environment variable I<TERM>) from the
+database.
+
+It will look in the environment for a I<TERMCAP> variable.  If
+found, and the value does not begin with a slash, and the terminal
+type name is the same as the environment string I<TERM>, the
+I<TERMCAP> string is used instead of reading a termcap file.  If
+it does begin with a slash, the string is used as a path name of
+the termcap file to search.  If I<TERMCAP> does not begin with a
+slash and name is different from I<TERM>, B<Tgetent> searches the
+files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
+in that order, unless the environment variable I<TERMPATH> exists,
+in which case it specifies a list of file pathnames (separated by
+spaces or colons) to be searched B<instead>.  Whenever multiple
+files are searched and a tc field occurs in the requested entry,
+the entry it names must be found in the same file or one of the
+succeeding files.  If there is a C<:tc=...:> in the I<TERMCAP>
+environment variable string it will continue the search in the
+files as above.
+
+I<OSPEED> is the terminal output bit rate (often mistakenly called
+the baud rate).  I<OSPEED> can be specified as either a POSIX
+termios/SYSV termio speeds (where 9600 equals 9600) or an old
+BSD-style speeds (where 13 equals 9600).
+
+B<Tgetent> returns a blessed object reference which the user can
+then use to send the control strings to the terminal using B<Tputs>
+and B<Tgoto>.  It calls C<croak> on failure.
+
+B<Tgoto> decodes a cursor addressing string with the given parameters.
+
+The output strings for B<Tputs> are cached for counts of 1 for performance.
+B<Tgoto> and B<Tpad> do not cache.  C<$self-E<gt>{_xx}> is the raw termcap
+data and C<$self-E<gt>{xx}> is the cached version.
+
+    print $terminal->Tpad($self->{_xx}, 1);
+
+B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
+output the string to $FH if specified.
+
+The extracted termcap entry is available in the object
+as C<$self-E<gt>{TERMCAP}>.
+
+=head1 EXAMPLES
+
+    # Get terminal output speed
+    require POSIX;
+    my $termios = new POSIX::Termios;
+    $termios->getattr;
+    my $ospeed = $termios->getospeed;
+
+    # Old-style ioctl code to get ospeed:
+    #     require 'ioctl.pl';
+    #     ioctl(TTY,$TIOCGETP,$sgtty);
+    #     ($ispeed,$ospeed) = unpack('cc',$sgtty);
+
+    # allocate and initialize a terminal structure
+    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
+
+    # require certain capabilities to be available
+    $terminal->Trequire(qw/ce ku kd/);
+
+    # Output Routines, if $FH is undefined these just return the string
+
+    # Tgoto does the % expansion stuff with the given args
+    $terminal->Tgoto('cm', $col, $row, $FH);
+
+    # Tputs doesn't do any % expansion.
+    $terminal->Tputs('dl', $count = 1, $FH);
+
+=cut
+
+# Returns a list of termcap files to check.
+sub termcap_path { ## private
+    my @termcap_path;
+    # $TERMCAP, if it's a filespec
+    push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) &&
+                                           ($ENV{TERMCAP} =~ /^\//));
+    if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
+	# Add the users $TERMPATH
+	push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH}))
+    }
+    else {
+	# Defaults
+	push(@termcap_path,
+	    $ENV{'HOME'} . '/.termcap',
+	    '/etc/termcap',
+	    '/usr/share/misc/termcap',
+	);
+    }
+    # return the list of those termcaps that exist
+    grep(-f, @termcap_path);
+}
+
+sub Tgetent { ## public -- static method
+    my $class = shift;
+    my $self = bless shift, $class;
+    my($term,$cap,$search,$field,$max,$tmp_term,$TERMCAP);
+    local($termpat,$state,$first,$entry);	# used inside eval
+    local $_;
+
+    # Compute PADDING factor from OSPEED (to be used by Tpad)
+    if (! $self->{OSPEED}) {
+	carp "OSPEED was not set, defaulting to 9600";
+	$self->{OSPEED} = 9600;
+    }
+    if ($self->{OSPEED} < 16) {
+	# delays for old style speeds
+	my @pad = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
+	$self->{PADDING} = $pad[$self->{OSPEED}];
+    }
+    else {
+	$self->{PADDING} = 10000 / $self->{OSPEED};
+    }
+
+    $self->{TERM} = ($self->{TERM} || $ENV{TERM} || croak "TERM not set");
+    $term = $self->{TERM};	# $term is the term type we are looking for
+
+    # $tmp_term is always the next term (possibly :tc=...:) we are looking for
+    $tmp_term = $self->{TERM};
+    # protect any pattern metacharacters in $tmp_term 
+    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+
+    my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '');
+
+    # $entry is the extracted termcap entry
+    if (($foo !~ m:^/:) && ($foo =~ m/(^|\|)${termpat}[:|]/)) {
+	$entry = $foo;
+    }
+
+    my @termcap_path = termcap_path;
+    croak "Can't find a valid termcap file" unless @termcap_path || $entry;
+
+    $state = 1;					# 0 == finished
+						# 1 == next file
+						# 2 == search again
+
+    $first = 0;					# first entry (keeps term name)
+
+    $max = 32;					# max :tc=...:'s
+
+    if ($entry) {
+	# ok, we're starting with $TERMCAP
+	$first++;				# we're the first entry
+	# do we need to continue?
+	if ($entry =~ s/:tc=([^:]+):/:/) {
+	    $tmp_term = $1;
+	    # protect any pattern metacharacters in $tmp_term 
+	    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+	}
+	else {
+	    $state = 0;				# we're already finished
+	}
+    }
+
+    # This is eval'ed inside the while loop for each file
+    $search = q{
+	while ($_ = <TERMCAP>) {
+	    next if /^\\t/ || /^#/;
+	    if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
+		chomp;
+		s/^[^:]*:// if $first++;
+		$state = 0;
+		while ($_ =~ s/\\\\$//) { $_ .= <TERMCAP>; chomp; }
+		last;
+	    }
+	}
+	$entry .= $_;
+    };
+
+    while ($state != 0) {
+	if ($state == 1) {
+	    # get the next TERMCAP
+	    $TERMCAP = shift @termcap_path
+		|| croak "failed termcap lookup on $tmp_term";
+	}
+	else {
+	    # do the same file again
+	    # prevent endless recursion
+	    $max-- || croak "failed termcap loop at $tmp_term";
+	    $state = 1;		# ok, maybe do a new file next time
+	}
+
+	open(TERMCAP,"< $TERMCAP\0") || croak "open $TERMCAP: $!";
+	eval $search;
+	die $@ if $@;
+	close TERMCAP;
+
+	# If :tc=...: found then search this file again
+	$entry =~ s/:tc=([^:]+):/:/ && ($tmp_term = $1, $state = 2);
+	# protect any pattern metacharacters in $tmp_term 
+	$termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+    }
+
+    croak "Can't find $term" if $entry eq '';
+    $entry =~ s/:+\s*:+/:/g;				# cleanup $entry
+    $entry =~ s/:+/:/g;					# cleanup $entry
+    $self->{TERMCAP} = $entry;				# save it
+    # print STDERR "DEBUG: $entry = ", $entry, "\n";
+
+    # Precompile $entry into the object
+    $entry =~ s/^[^:]*://;
+    foreach $field (split(/:[\s:\\]*/,$entry)) {
+	if ($field =~ /^(\w\w)$/) {
+	    $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
+	    # print STDERR "DEBUG: flag $1\n";
+	}
+	elsif ($field =~ /^(\w\w)\@/) {
+	    $self->{'_' . $1} = "";
+	    # print STDERR "DEBUG: unset $1\n";
+	}
+	elsif ($field =~ /^(\w\w)#(.*)/) {
+	    $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
+	    # print STDERR "DEBUG: numeric $1 = $2\n";
+	}
+	elsif ($field =~ /^(\w\w)=(.*)/) {
+	    # print STDERR "DEBUG: string $1 = $2\n";
+	    next if defined $self->{'_' . ($cap = $1)};
+	    $_ = $2;
+	    s/\\E/\033/g;
+	    s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
+	    s/\\n/\n/g;
+	    s/\\r/\r/g;
+	    s/\\t/\t/g;
+	    s/\\b/\b/g;
+	    s/\\f/\f/g;
+	    s/\\\^/\377/g;
+	    s/\^\?/\177/g;
+	    s/\^(.)/pack('c',ord($1) & 31)/eg;
+	    s/\\(.)/$1/g;
+	    s/\377/^/g;
+	    $self->{'_' . $cap} = $_;
+	}
+	# else { carp "junk in $term ignored: $field"; }
+    }
+    $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
+    $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
+    $self;
+}
+
+# $terminal->Tpad($string, $cnt, $FH);
+sub Tpad { ## public
+    my $self = shift;
+    my($string, $cnt, $FH) = @_;
+    my($decr, $ms);
+
+    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
+	$ms = $1;
+	$ms *= $cnt if $2;
+	$string = $3;
+	$decr = $self->{PADDING};
+	if ($decr > .1) {
+	    $ms += $decr / 2;
+	    $string .= $self->{'_pc'} x ($ms / $decr);
+	}
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+# $terminal->Tputs($cap, $cnt, $FH);
+sub Tputs { ## public
+    my $self = shift;
+    my($cap, $cnt, $FH) = @_;
+    my $string;
+
+    if ($cnt > 1) {
+	$string = Tpad($self, $self->{'_' . $cap}, $cnt);
+    } else {
+	# cache result because Tpad can be slow
+	$string = defined $self->{$cap} ? $self->{$cap} :
+	    ($self->{$cap} = Tpad($self, $self->{'_' . $cap}, 1));
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+# %%   output `%'
+# %d   output value as in printf %d
+# %2   output value as in printf %2d
+# %3   output value as in printf %3d
+# %.   output value as in printf %c
+# %+x  add x to value, then do %.
+#
+# %>xy if value > x then add y, no output
+# %r   reverse order of two parameters, no output
+# %i   increment by one, no output
+# %B   BCD (16*(value/10)) + (value%10), no output
+#
+# %n   exclusive-or all parameters with 0140 (Datamedia 2500)
+# %D   Reverse coding (value - 2*(value%16)), no output (Delta Data)
+#
+# $terminal->Tgoto($cap, $col, $row, $FH);
+sub Tgoto { ## public
+    my $self = shift;
+    my($cap, $code, $tmp, $FH) = @_;
+    my $string = $self->{'_' . $cap};
+    my $result = '';
+    my $after = '';
+    my $online = 0;
+    my @tmp = ($tmp,$code);
+    my $cnt = $code;
+
+    while ($string =~ /^([^%]*)%(.)(.*)/) {
+	$result .= $1;
+	$code = $2;
+	$string = $3;
+	if ($code eq 'd') {
+	    $result .= sprintf("%d",shift(@tmp));
+	}
+	elsif ($code eq '.') {
+	    $tmp = shift(@tmp);
+	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
+		if ($online) {
+		    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
+		}
+		else {
+		    ++$tmp, $after .= $self->{'_bc'};
+		}
+	    }
+	    $result .= sprintf("%c",$tmp);
+	    $online = !$online;
+	}
+	elsif ($code eq '+') {
+	    $result .= sprintf("%c",shift(@tmp)+ord($string));
+	    $string = substr($string,1,99);
+	    $online = !$online;
+	}
+	elsif ($code eq 'r') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($tmp,$code);
+	    $online = !$online;
+	}
+	elsif ($code eq '>') {
+	    ($code,$tmp,$string) = unpack("CCa99",$string);
+	    if ($tmp[$[] > $code) {
+		$tmp[$[] += $tmp;
+	    }
+	}
+	elsif ($code eq '2') {
+	    $result .= sprintf("%02d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq '3') {
+	    $result .= sprintf("%03d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq 'i') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($code+1,$tmp+1);
+	}
+	else {
+	    return "OOPS";
+	}
+    }
+    $string = Tpad($self, $result . $string . $after, $cnt);
+    print $FH $string if $FH;
+    $string;
+}
+
+# $terminal->Trequire(qw/ce ku kd/);
+sub Trequire { ## public
+    my $self = shift;
+    my($cap,@undefined);
+    foreach $cap (@_) {
+	push(@undefined, $cap)
+	    unless defined $self->{'_' . $cap} && $self->{'_' . $cap};
+    }
+    croak "Terminal does not support: (@undefined)" if @undefined;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Term/Complete.pm b/gnu/usr.bin/perl/lib/Term/Complete.pm
new file mode 100644
index 00000000000..6faef2296ed
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/Complete.pm
@@ -0,0 +1,146 @@
+package Term::Complete;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(Complete);
+
+#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
+
+=head1 NAME
+
+Term::Complete - Perl word completion module
+
+=head1 SYNOPSIS
+
+    $input = complete('prompt_string', \@completion_list);
+    $input = complete('prompt_string', @completion_list);
+
+=head1 DESCRIPTION
+
+This routine provides word completion on the list of words in
+the array (or array ref).
+
+The tty driver is put into raw mode using the system command
+C<stty raw -echo> and restored using C<stty -raw echo>.
+
+The following command characters are defined:
+
+=over 4
+
+=item <tab>
+Attempts word completion.
+Cannot be changed.
+
+=item ^D
+
+Prints completion list.
+Defined by I<$Term::Complete::complete>.
+
+=item ^U
+
+Erases the current input.
+Defined by I<$Term::Complete::kill>.
+
+=item <del>, <bs>
+
+Erases one character.
+Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+Bell sounds when word completion fails.
+
+=head1 BUGS
+
+The completion charater <tab> cannot be changed.
+
+=head1 AUTHOR
+
+Wayne Thompson
+
+=cut
+
+CONFIG: {
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
+sub Complete {
+    $prompt = shift;
+    if (ref $_[0] || $_[0] =~ /^\*/) {
+	@cmp_lst = sort @{$_[0]};
+    }
+    else {
+	@cmp_lst = sort(@_);
+    }
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef($r, $return);
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
+    }
+    system('stty -raw echo');
+    print("\n");
+    $return;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
new file mode 100644
index 00000000000..2ce74231867
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
@@ -0,0 +1,189 @@
+=head1 NAME
+
+Term::ReadLine - Perl interface to various C<readline> packages. If
+no real package is found, substitutes stubs instead of basic functions.
+
+=head1 SYNOPSIS
+
+  use Term::ReadLine;
+  $term = new Term::ReadLine 'Simple Perl calc';
+  $prompt = "Enter your arithmetic expression: ";
+  $OUT = $term->OUT || STDOUT;
+  while ( defined ($_ = $term->readline($prompt)) ) {
+    $res = eval($_), "\n";
+    warn $@ if $@;
+    print $OUT $res, "\n" unless $@;
+    $term->addhistory($_) if /\S/;
+  }
+
+=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.
+
+=head1 Minimal set of supported functions
+
+All the supported functions should be called as methods, i.e., either as 
+
+  $term = new Term::ReadLine 'name';
+
+or as 
+
+  $term->addhistory('row');
+
+where $term is a return value of Term::ReadLine->Init.
+
+=over 12
+
+=item C<ReadLine>
+
+returns the actual package that executes the commands. Among possible
+values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
+C<Term::ReadLine::Stub Exporter>.
+
+=item C<new>
+
+returns the handle for subsequent calls to following
+functions. Argument is the name of the application. Optionally can be
+followed by two arguments for C<IN> and C<OUT> filehandles. These
+arguments should be globs.
+
+=item C<readline>
+
+gets an input line, I<possibly> with actual C<readline>
+support. Trailing newline is removed. Returns C<undef> on C<EOF>.
+
+=item C<addhistory>
+
+adds the line to the history of input, from where it can be used if
+the actual C<readline> is present.
+
+=item C<IN>, $C<OUT>
+
+return the filehandles for input and output or C<undef> if C<readline>
+input and output cannot be used for Perl.
+
+=item C<MinLine>
+
+If argument is specified, it is an advice on minimal size of line to
+be included into history.  C<undef> means do not include anything into
+history. Returns the old value.
+
+=item C<findConsole>
+
+returns an array with two strings that give most appropriate names for
+files for input and output using conventions C<"<$in">, C<"E<gt>out">.
+
+=item C<Features>
+
+Returns a reference to a hash with keys being features present in
+current implementation. Several optional features are used in the
+minimal interface: C<appname> should be present if the first argument
+to C<new> is recognized, and C<minline> should be present if
+C<MinLine> method is not dummy.  C<autohistory> should be present if
+lines are put into history automatically (maybe subject to
+C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
+
+=back
+
+Actually C<Term::ReadLine> can use some other package, that will
+support reacher set of commands.
+
+=head1 EXPORTS
+
+None
+
+=cut
+
+package Term::ReadLine::Stub;
+
+$DB::emacs = $DB::emacs;	# To peacify -w
+
+sub ReadLine {'Term::ReadLine::Stub'}
+sub readline {
+  my ($in,$out,$str) = @{shift()};
+  print $out shift; 
+  $str = scalar <$in>;
+  # bug in 5.000: chomping empty string creats length -1:
+  chomp $str if defined $str;
+  $str;
+}
+sub addhistory {}
+
+sub findConsole {
+    my $console;
+
+    if (-e "/dev/tty") {
+	$console = "/dev/tty";
+    } elsif (-e "con") {
+	$console = "con";
+    } else {
+	$console = "sys\$command";
+    }
+
+    if (defined $ENV{'OS2_SHELL'}) { # In OS/2
+      if ($DB::emacs) {
+	$console = undef;
+      } else {
+	$console = "/dev/con";
+      }
+    }
+
+    $consoleOUT = $console;
+    $console = "&STDIN" unless defined $console;
+    if (!defined $consoleOUT) {
+      $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
+    }
+    ($console,$consoleOUT);
+}
+
+sub new {
+  die "method new called with wrong number of arguments" 
+    unless @_==2 or @_==4;
+  #local (*FIN, *FOUT);
+  my ($FIN, $FOUT);
+  if (@_==2) {
+    ($console, $consoleOUT) = findConsole;
+
+    open(FIN, "<$console"); 
+    open(FOUT,">$consoleOUT");
+    #OUT->autoflush(1);		# Conflicts with debugger?
+    $sel = select(FOUT);
+    $| = 1;				# for DB::OUT
+    select($sel);
+    bless [\*FIN, \*FOUT];
+  } else {			# Filehandles supplied
+    $FIN = $_[2]; $FOUT = $_[3];
+    #OUT->autoflush(1);		# Conflicts with debugger?
+    $sel = select($FOUT);
+    $| = 1;				# for DB::OUT
+    select($sel);
+    bless [$FIN, $FOUT];
+  }
+}
+sub IN { shift->[0] }
+sub OUT { shift->[1] }
+sub MinLine { undef }
+sub Features { {} }
+
+package Term::ReadLine;		# So late to allow the above code be defined?
+eval "use Term::ReadLine::Gnu;" or eval "use Term::ReadLine::Perl;";
+
+#require FileHandle;
+
+# To make possible switch off RL in debugger: (Not needed, work done
+# in debugger).
+
+if (defined &Term::ReadLine::Gnu::readline) {
+  @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
+} elsif (defined &Term::ReadLine::Perl::readline) {
+  @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
+} else {
+  @ISA = qw(Term::ReadLine::Stub);
+}
+
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Test/Harness.pm b/gnu/usr.bin/perl/lib/Test/Harness.pm
new file mode 100644
index 00000000000..7d899a69f92
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/Harness.pm
@@ -0,0 +1,258 @@
+package Test::Harness;
+
+use Exporter;
+use Benchmark;
+use Config;
+use FileHandle;
+use vars qw($VERSION $verbose $switches);
+require 5.002;
+
+$VERSION = "1.07";
+
+@ISA=('Exporter');
+@EXPORT= qw(&runtests);
+@EXPORT_OK= qw($verbose $switches);
+
+
+$verbose = 0;
+$switches = "-w";
+
+sub runtests {
+    my(@tests) = @_;
+    local($|) = 1;
+    my($test,$te,$ok,$next,$max,$pct);
+    my $totmax = 0;
+    my $files = 0;
+    my $bad = 0;
+    my $good = 0;
+    my $total = @tests;
+    local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); # pass -I flags to children
+
+    my $t_start = new Benchmark;
+    while ($test = shift(@tests)) {
+	$te = $test;
+	chop($te);
+	print "$te" . '.' x (20 - length($te));
+	my $fh = new FileHandle;
+	$fh->open("$^X $switches $test|") || (print "can't run. $!\n");
+	$ok = $next = $max = 0;
+	@failed = ();
+	while (<$fh>) {
+	    if( $verbose ){
+		print $_;
+	    }
+	    unless (/^\s*\#/) {
+		if (/^1\.\.([0-9]+)/) {
+		    $max = $1;
+		    $totmax += $max;
+		    $files++;
+		    $next = 1;
+		} elsif ($max && /^(not\s+)?ok\b/) {
+		    my $this = $next;
+		    if (/^not ok\s*(\d*)/){
+			$this = $1 if $1 > 0;
+			push @failed, $this;
+		    } elsif (/^ok\s*(\d*)/) {
+			$this = $1 if $1 > 0;
+			$ok++;
+			$totok++;
+		    }
+		    if ($this > $next) {
+			# warn "Test output counter mismatch [test $this]\n";
+			# no need to warn probably
+			push @failed, $next..$this-1;
+		    } elsif ($this < $next) {
+			#we have seen more "ok" lines than the number suggests
+			warn "Aborting test: output counter mismatch [test $this answered when test $next expected]\n";
+			last;
+		    }
+		    $next = $this + 1;
+		}
+	    }
+	}
+	$fh->close; # must close to reap child resource values
+	my $wstatus = $?;
+	my $estatus = $wstatus >> 8;
+	if ($ok == $max && $next == $max+1 && ! $estatus) {
+	    print "ok\n";
+	    $good++;
+	} elsif ($max) {
+	    if ($next <= $max) {
+		push @failed, $next..$max;
+	    }
+	    if (@failed) {
+		print canonfailed($max,@failed);
+	    } else {
+		print "Don't know which tests failed for some reason\n";
+	    }
+	    $bad++;
+	} elsif ($next == 0) {
+	    print "FAILED before any test output arrived\n";
+	    $bad++;
+	}
+	if ($wstatus) {
+	    print "\tTest returned status $estatus (wstat $wstatus)\n";
+	}
+    }
+    my $t_total = timediff(new Benchmark, $t_start);
+    
+    if ($bad == 0 && $totmax) {
+	    print "All tests successful.\n";
+    } elsif ($total==0){
+	die "FAILED--no tests were run for some reason.\n";
+    } elsif ($totmax==0) {
+	my $blurb = $total==1 ? "script" : "scripts";
+	die "FAILED--$total test $blurb could be run, alas -- no output ever seen\n";
+    } else {
+	$pct = sprintf("%.2f", $good / $total * 100);
+	my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
+	$totmax - $totok, $totmax, 100*$totok/$totmax;
+	if ($bad == 1) {
+	    die "Failed 1 test script, $pct% okay.$subpct\n";
+	} else {
+	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
+	}
+    }
+    printf("Files=%d,  Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
+}
+
+sub canonfailed ($@) {
+    my($max,@failed) = @_;
+    my %seen;
+    @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
+    my $failed = @failed;
+    my @result = ();
+    my @canon = ();
+    my $min;
+    my $last = $min = shift @failed;
+    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";
+		}
+		$min = $_;
+	    }
+	    $last = $_;
+	}
+	local $" = ", ";
+	push @result, "FAILED tests @canon\n";
+    } else {
+	push @result, "FAILED test $last\n";
+    }
+
+    push @result, "\tFailed $failed/$max tests, ";
+    push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
+    join "", @result;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Test::Harness - run perl standard test scripts with statistics
+
+=head1 SYNOPSIS
+
+use Test::Harness;
+
+runtests(@tests);
+
+=head1 DESCRIPTION
+
+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 scxript is C<"1..M"> with C<M> being the
+number of tests that should be run within the test
+script. Test::Harness::runscripts(@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, runscripts() prints some
+performance statistics that are computed by the Benchmark module.
+
+=head2 The test script output
+
+Any output from the testscript to standard error is ignored and
+bypassed, thus will be seen by the user. Lines written to standard
+output that look like perl comments (start with C</^\s*\#/>) are
+discarded. Lines containing C</^(not\s+)?ok\b/> are interpreted as
+feedback for runtests().
+
+It is tolerated if the test numbers after C<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
+
+The global variable $Test::Harness::verbose is exportable and can be
+used to let runscripts() display the standard output of the script
+without altering the behavior otherwise.
+
+=head1 EXPORT
+
+C<&runscripts> is exported by Test::Harness per default.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
+
+If all tests are successful some statistics about the performance are
+printed.
+
+=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
+
+For any single script that has failing subtests statistics like the
+above are printed.
+
+=item C<Test returned status %d (wstat %d)>
+
+Scripts that return a non-zero exit status, both $?>>8 and $? are
+printed in a message similar to the above.
+
+=item C<Failed 1 test, %.2f%% okay. %s>
+
+=item C<Failed %d/%d tests, %.2f%% okay. %s>
+
+If not all tests were successful, the script dies with one of the
+above messages.
+
+=back
+
+=head1 SEE ALSO
+
+See L<Benchmark> for the underlying timing routines.
+
+=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. Current maintainer is Andreas
+Koenig.
+
+=head1 BUGS
+
+Test::Harness uses $^X to determine the perl binary to run the tests
+with. Test scripts running via the shebang (C<#!>) line may not be
+portable because $^X is not consistent for shebang scripts across
+platforms. This is no problem when Test::Harness is run with an
+absolute path to the perl binary or when $^X can be found in the path.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Text/Abbrev.pm b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
new file mode 100644
index 00000000000..d12dfb36a69
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
@@ -0,0 +1,59 @@
+package Text::Abbrev;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+abbrev - create an abbreviation table from a list
+
+=head1 SYNOPSIS
+
+    use Abbrev;
+    abbrev *HASH, LIST
+
+
+=head1 DESCRIPTION
+
+Stores all unambiguous truncations of each element of LIST
+as keys key in the associative array indicated by C<*hash>.
+The values are the original list elements.
+
+=head1 EXAMPLE
+
+    abbrev(*hash,qw("list edit send abort gripe"));
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(abbrev);
+
+# Usage:
+#	&abbrev(*foo,LIST);
+#	...
+#	$long = $foo{$short};
+
+sub abbrev {
+    local(*domain) = shift;
+    @cmp = @_;
+    %domain = ();
+    foreach $name (@_) {
+	@extra = split(//,$name);
+	$abbrev = shift(@extra);
+	$len = 1;
+	foreach $cmp (@cmp) {
+	    next if $cmp eq $name;
+	    while (substr($cmp,0,$len) eq $abbrev) {
+		$abbrev .= shift(@extra);
+		++$len;
+	    }
+	}
+	$domain{$abbrev} = $name;
+	while (@extra) {
+	    $abbrev .= shift(@extra);
+	    $domain{$abbrev} = $name;
+	}
+    }
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
new file mode 100644
index 00000000000..89951387ef6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
@@ -0,0 +1,173 @@
+package Text::ParseWords;
+
+require 5.000;
+require Exporter;
+require AutoLoader;
+use Carp;
+
+@ISA = qw(Exporter AutoLoader);
+@EXPORT = qw(shellwords quotewords);
+@EXPORT_OK = qw(old_shellwords);
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens
+
+=head1 SYNOPSIS
+
+  use Text::ParseWords;
+  @words = &quotewords($delim, $keep, @lines);
+  @words = &shellwords(@lines);
+  @words = &old_shellwords(@lines);
+
+=head1 DESCRIPTION
+
+&quotewords() accepts a delimiter (which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes.
+
+The $keep argument is a boolean flag.  If true, the quotes are kept
+with each word, otherwise quotes are stripped in the splitting process.
+$keep also defines whether unprotected backslashes are retained.
+
+A &shellwords() replacement is included to demonstrate the new package.
+This version differs from the original in that it will _NOT_ default
+to using $_ if no arguments are given.  I personally find the old behavior
+to be a mis-feature.
+
+
+&quotewords() works by simply jamming all of @lines into a single
+string in $_ and then pulling off words a bit at a time until $_
+is exhausted.
+
+=head1 AUTHORS
+
+Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
+
+Basically an update and generalization of the old shellwords.pl.
+Much code shamelessly stolen from the old version (author unknown).
+
+=cut
+
+1;
+__END__
+
+sub shellwords {
+    local(@lines) = @_;
+    $lines[$#lines] =~ s/\s+$//;
+    &quotewords('\s+', 0, @lines);
+}
+
+
+
+sub quotewords {
+
+# The inner "for" loop builds up each word (or $field) one $snippet
+# at a time.  A $snippet is a quoted string, a backslashed character,
+# or an unquoted string.  We fall out of the "for" loop when we reach
+# the end of $_ or when we hit a delimiter.  Falling out of the "for"
+# loop, we push the $field we've been building up onto the list of
+# @words we'll be returning, and then loop back and pull another word
+# off of $_.
+#
+# The first two cases inside the "for" loop deal with quoted strings.
+# The first case matches a double quoted string, removes it from $_,
+# and assigns the double quoted string to $snippet in the body of the
+# conditional.  The second case handles single quoted strings.  In
+# the third case we've found a quote at the current beginning of $_,
+# but it didn't match the quoted string regexps in the first two cases,
+# so it must be an unbalanced quote and we croak with an error (which can
+# be caught by eval()).
+#
+# The next case handles backslashed characters, and the next case is the
+# exit case on reaching the end of the string or finding a delimiter.
+#
+# Otherwise, we've found an unquoted thing and we pull of characters one
+# at a time until we reach something that could start another $snippet--
+# a quote of some sort, a backslash, or the delimiter.  This one character
+# at a time behavior was necessary if the delimiter was going to be a
+# regexp (love to hear it if you can figure out a better way).
+
+    local($delim, $keep, @lines) = @_;
+    local(@words,$snippet,$field,$_);
+
+    $_ = join('', @lines);
+    while ($_) {
+	$field = '';
+	for (;;) {
+            $snippet = '';
+	    if (s/^"(([^"\\]|\\[\\"])*)"//) {
+		$snippet = $1;
+                $snippet = "\"$snippet\"" if ($keep);
+	    }
+	    elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
+		$snippet = $1;
+                $snippet = "'$snippet'" if ($keep);
+	    }
+	    elsif (/^["']/) {
+		croak "Unmatched quote";
+	    }
+            elsif (s/^\\(.)//) {
+                $snippet = $1;
+                $snippet = "\\$snippet" if ($keep);
+            }
+	    elsif (!$_ || s/^$delim//) {
+               last;
+	    }
+	    else {
+                while ($_ && !(/^$delim/ || /^['"\\]/)) {
+		   $snippet .=  substr($_, 0, 1);
+                   substr($_, 0, 1) = '';
+                }
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
+
+
+sub old_shellwords {
+
+    # Usage:
+    #	use ParseWords;
+    #	@words = old_shellwords($line);
+    #	or
+    #	@words = old_shellwords(@lines);
+
+    local($_) = join('', @_);
+    my(@words,$snippet,$field);
+
+    s/^\s+//;
+    while ($_ ne '') {
+	$field = '';
+	for (;;) {
+	    if (s/^"(([^"\\]|\\.)*)"//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^"/) {
+		croak "Unmatched double quote: $_";
+	    }
+	    elsif (s/^'(([^'\\]|\\.)*)'//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^'/) {
+		croak "Unmatched single quote: $_";
+	    }
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+	    }
+	    elsif (s/^([^\s\\'"]+)//) {
+		$snippet = $1;
+	    }
+	    else {
+		s/^\s+//;
+		last;
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.pm b/gnu/usr.bin/perl/lib/Text/Soundex.pm
new file mode 100644
index 00000000000..8723c4739f6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Soundex.pm
@@ -0,0 +1,151 @@
+package Text::Soundex;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&soundex $soundex_nocode);
+
+# $Id: Soundex.pm,v 1.1 1996/08/19 10:12:51 downsj Exp $
+#
+# Implementation of soundex algorithm as described by Knuth in volume
+# 3 of The Art of Computer Programming, with ideas stolen from Ian
+# Phillips <ian@pipex.net>.
+#
+# Mike Stok <Mike.Stok@meiko.concord.ma.us>, 2 March 1994.
+#
+# Knuth's test cases are:
+# 
+# Euler, Ellery -> E460
+# Gauss, Ghosh -> G200
+# Hilbert, Heilbronn -> H416
+# Knuth, Kant -> K530
+# Lloyd, Ladd -> L300
+# Lukasiewicz, Lissajous -> L222
+#
+# $Log: Soundex.pm,v $
+# Revision 1.1  1996/08/19 10:12:51  downsj
+# Initial revision
+#
+# Revision 1.2  1994/03/24  00:30:27  mike
+# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
+# in the way I handles leasing characters which were different but had
+# the same soundex code.  This showed up comparing it with Oracle's
+# soundex output.
+#
+# Revision 1.1  1994/03/02  13:01:30  mike
+# Initial revision
+#
+#
+##############################################################################
+
+# $soundex_nocode is used to indicate a string doesn't have a soundex
+# code, I like undef other people may want to set it to 'Z000'.
+
+$soundex_nocode = undef;
+
+sub soundex
+{
+  local (@s, $f, $fc, $_) = @_;
+
+  push @s, '' unless @s;	# handle no args as a single empty string
+
+  foreach (@s)
+  {
+    tr/a-z/A-Z/;
+    tr/A-Z//cd;
+
+    if ($_ eq '')
+    {
+      $_ = $soundex_nocode;
+    }
+    else
+    {
+      ($f) = /^(.)/;
+      tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/;
+      ($fc) = /^(.)/;
+      s/^$fc+//;
+      tr///cs;
+      tr/0//d;
+      $_ = $f . $_ . '000';
+      s/^(.{4}).*/$1/;
+    }
+  }
+
+  wantarray ? @s : shift @s;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::Soundex - Implementation of the Soundex Algorithm as Described by Knuth
+
+=head1 SYNOPSIS
+
+  use Text::Soundex;
+
+  $code = soundex $string;            # get soundex code for a string
+  @codes = soundex @list;             # get list of codes for list of strings
+
+  # set value to be returned for strings without soundex code
+
+  $soundex_nocode = 'Z000';
+
+=head1 DESCRIPTION
+
+This module implements the soundex algorithm as described by Donald Knuth
+in Volume 3 of B<The Art of Computer Programming>.  The algorithm is
+intended to hash words (in particular surnames) into a small space using a
+simple model which approximates the sound of the word when spoken by an English
+speaker.  Each word is reduced to a four character string, the first
+character being an upper case letter and the remaining three being digits.
+
+If there is no soundex code representation for a string then the value of
+C<$soundex_nocode> is returned.  This is initially set to C<undef>, but
+many people seem to prefer an I<unlikely> value like C<Z000>
+(how unlikely this is depends on the data set being dealt with.)  Any value
+can be assigned to C<$soundex_nocode>.
+
+In scalar context C<soundex> returns the soundex code of its first
+argument, and in array context a list is returned in which each element is the 
+soundex code for the corresponding argument passed to C<soundex> e.g.
+
+  @codes = soundex qw(Mike Stok);
+
+leaves C<@codes> containing C<('M200', 'S320')>.
+
+=head1 EXAMPLES
+
+Knuth's examples of various names and the soundex codes they map to
+are listed below:
+
+  Euler, Ellery -> E460
+  Gauss, Ghosh -> G200
+  Hilbert, Heilbronn -> H416
+  Knuth, Kant -> K530
+  Lloyd, Ladd -> L300
+  Lukasiewicz, Lissajous -> L222
+
+so:
+
+  $code = soundex 'Knuth';              # $code contains 'K530'
+  @list = soundex qw(Lloyd Gauss);	# @list contains 'L300', 'G200'
+
+=head1 LIMITATIONS
+
+As the soundex algorithm was originally used a B<long> time ago in the US
+it considers only the English alphabet and pronunciation.
+
+As it is mapping a large space (arbitrary length strings) onto a small
+space (single letter plus 3 digits) no inference can be made about the
+similarity of two strings which end up with the same soundex code.  For 
+example, both C<Hilbert> and C<Heilbronn> end up with a soundex code
+of C<H416>.
+
+=head1 AUTHOR
+
+This code was implemented by Mike Stok (C<stok@cybercom.net>) from the 
+description given by Knuth.  Ian Phillips (C<ian@pipex.net>) and Rich Pinder 
+(C<rpinder@hsc.usc.edu>) supplied ideas and spotted mistakes.
diff --git a/gnu/usr.bin/perl/lib/Text/Tabs.pm b/gnu/usr.bin/perl/lib/Text/Tabs.pm
new file mode 100644
index 00000000000..2481d81ec6b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Tabs.pm
@@ -0,0 +1,80 @@
+#
+# expand and unexpand tabs as per the unix expand and 
+# unexpand programs.
+#
+# expand and unexpand operate on arrays of lines.  Do not
+# feed strings that contain newlines to them.
+#
+# David Muir Sharnoff <muir@idiom.com>
+# 
+# Version: 9/21/95
+#
+
+=head1 NAME
+
+Text::Tabs -- expand and unexpand tabs
+
+=head1 SYNOPSIS
+
+	use Text::Tabs;
+	
+	#$tabstop = 8; # Defaults
+	print expand("Hello\tworld");
+	print unexpand("Hello,        world");
+	$tabstop = 4;
+	print join("\n",expand(split(/\n/,
+		"Hello\tworld,\nit's a nice day.\n"
+		)));
+
+=head1 DESCRIPTION
+
+This module expands and unexpands tabs into spaces, as per the unix expand
+and unexpand programs. Either function should be passed an array of strings
+(newlines may I<not> be included, and should be used to split an incoming
+string into separate elements.) which will be processed and returned.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
+
+=cut
+
+package Text::Tabs;
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(expand unexpand $tabstop);
+
+$tabstop = 8;
+
+sub expand
+{
+	my @l = @_;
+	for $_ (@l) {
+		1 while s/^([^\t]*)(\t+)/
+			$1 . (" " x 
+				($tabstop * length($2)
+				- (length($1) % $tabstop)))
+			/e;
+	}
+	return @l if wantarray;
+	return @l[0];
+}
+
+sub unexpand
+{
+	my @l = &expand(@_);
+	my @e;
+	for $x (@l) {
+		@e = split(/(.{$tabstop})/,$x);
+		for $_ (@e) {
+			s/  +$/\t/;
+		}
+		$x = join('',@e);
+	}
+	return @l if wantarray;
+	return @l[0];
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm
new file mode 100644
index 00000000000..b665752f942
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm
@@ -0,0 +1,93 @@
+
+package Text::Wrap;
+
+#
+# This is a very simple paragraph formatter.  It formats one 
+# paragraph at a time by wrapping and indenting text.
+#
+# Usage:
+#
+#	use Text::Wrap;
+#
+#	print wrap($initial_tab,$subsequent_tab,@text);
+#
+# You can also set the number of columns to wrap before:
+#
+#	$Text::Wrap::columns = 135; # <= width of screen
+#
+#	use Text::Wrap qw(wrap $columns); 
+#	$columns = 70;
+#	
+#
+# The first line will be printed with $initial_tab prepended.  All
+# following lines will have $subsequent_tab prepended.
+#
+# Example:
+#
+#	print wrap("\t","","This is a bit of text that ...");
+#
+# David Muir Sharnoff <muir@idiom.com>
+# Version: 9/21/95
+#
+
+=head1 NAME
+
+Text::Wrap -- wrap text into a paragraph
+
+=head1 SYNOPSIS
+
+	use Text::Wrap;
+	
+	$Text::Wrap::columns = 20; # Default
+	print wrap("\t","",Hello, world, it's a nice day, isn't it?");
+
+=head1 DESCRIPTION
+
+This module is a simple paragraph formatter that wraps text into a paragraph
+and indents each line. The single exported function, wrap(), takes three
+arguments. The first is included before the first output line, and the
+second argument is included before each subsequest output line. The third
+argument is the text to be wrapped.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
+
+=cut
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(wrap);
+@EXPORT_OK = qw($columns);
+
+BEGIN	{
+	$Text::Wrap::columns = 76;  # <= screen width
+}
+
+use Text::Tabs;
+use strict;
+
+sub wrap
+{
+	my ($ip, $xp, @t) = @_;
+
+	my $r;
+	my $t = expand(join(" ",@t));
+	my $lead = $ip;
+	my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+	if ($t =~ s/^([^\n]{0,$ll})\s//) {
+		$r .= unexpand($lead . $1 . "\n");
+		$lead = $xp;
+		my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+		while ($t =~ s/^([^\n]{0,$ll})\s//) {
+			$r .= unexpand($lead . $1 . "\n");
+		}
+	} 
+	die "couldn't wrap '$t'" 
+		if length($t) > $ll;
+	$r .= $t;
+	return $r;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm
new file mode 100644
index 00000000000..9a9d059a7f7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm
@@ -0,0 +1,158 @@
+package Tie::Hash;
+
+=head1 NAME
+
+Tie::Hash, Tie::StdHash - base class definitions for tied hashes
+
+=head1 SYNOPSIS
+
+    package NewHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::Hash);
+    
+    sub DELETE { ... }		# Provides needed method
+    sub CLEAR { ... }		# Overrides inherited method
+    
+    
+    package NewStdHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::StdHash);
+    
+    # All methods provided by default, define only those needing overrides
+    sub DELETE { ... }
+    
+    
+    package main;
+    
+    tie %new_hash, NewHash;
+    tie %new_std_hash, NewStdHash;
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for hash-tying classes. See
+L<perltie> for a list of the functions required in order to tie a hash
+to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
+as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
+provides most methods required for hashes in L<perltie>. It inherits from
+B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
+allowing for selective overloading of methods. The C<new> method is provided
+as grandfathering in the case a class forgets to include a C<TIEHASH> method.
+
+For developers wishing to write their own tied hashes, the required methods
+are briefly defined below. See the L<perltie> section for more detailed
+descriptive, as well as example code:
+
+=over
+
+=item TIEHASH classname, LIST
+
+The method invoked by the command C<tie %hash, classname>. Associates a new
+hash instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item STORE this, key, value
+
+Store datum I<value> into I<key> for the tied hash I<this>.
+
+=item FETCH this, key
+
+Retrieve the datum in I<key> for the tied hash I<this>.
+
+=item FIRSTKEY this
+
+Return the (key, value) pair for the first key in the hash.
+
+=item NEXTKEY this, lastkey
+
+Return the next (key, value) pair for the hash.
+
+=item EXISTS this, key
+
+Verify that I<key> exists with the tied hash I<this>.
+
+=item DELETE this, key
+
+Delete the key I<key> from the tied hash I<this>.
+
+=item CLEAR this
+
+Clear all values from the tied hash I<this>.
+
+=back
+
+=head1 CAVEATS
+
+The L<perltie> documentation includes a method called C<DESTROY> as
+a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
+define a default for this method. This is a standard for class packages,
+but may be omitted in favor of a simple default.
+
+=head1 MORE INFORMATION
+
+The packages relating to various DBM-related implemetations (F<DB_File>,
+F<NDBM_File>, etc.) show examples of general tied hashes, as does the
+L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
+good working examples.
+
+=cut
+    
+use Carp;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIEHASH(@_);
+}
+
+# Grandfather "new"
+
+sub TIEHASH {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
+	    if $^W;
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIEHASH method";
+    }
+}
+
+sub EXISTS {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define an EXISTS method";
+}
+
+sub CLEAR {
+    my $self = shift;
+    my $key = $self->FIRSTKEY(@_);
+    my @keys;
+
+    while (defined $key) {
+	push @keys, $key;
+	$key = $self->NEXTKEY(@_, $key);
+    }
+    foreach $key (@keys) {
+	$self->DELETE(@_, $key);
+    }
+}
+
+# The Tie::StdHash package implements standard perl hash behaviour.
+# It exists to act as a base class for classes which only wish to
+# alter some parts of their behaviour.
+
+package Tie::StdHash;
+@ISA = qw(Tie::Hash);
+
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FETCH    { $_[0]->{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub EXISTS   { exists $_[0]->{$_[1]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/Scalar.pm b/gnu/usr.bin/perl/lib/Tie/Scalar.pm
new file mode 100644
index 00000000000..2db02ae1daf
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/Scalar.pm
@@ -0,0 +1,138 @@
+package Tie::Scalar;
+
+=head1 NAME
+
+Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
+
+=head1 SYNOPSIS
+
+    package NewScalar;
+    require Tie::Scalar;
+     
+    @ISA = (Tie::Scalar);
+     
+    sub FETCH { ... }		# Provide a needed method
+    sub TIESCALAR { ... }	# Overrides inherited method
+         
+     
+    package NewStdScalar;
+    require Tie::Scalar;
+    
+    @ISA = (Tie::StdScalar);
+    
+    # All methods provided by default, so define only what needs be overridden
+    sub FETCH { ... }
+    
+    
+    package main;
+    
+    tie $new_scalar, NewScalar;
+    tie $new_std_scalar, NewStdScalar;
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for scalar-tying classes. See
+L<perltie> for a list of the functions required in tying a scalar to a
+package. The basic B<Tie::Scalar> package provides a C<new> method, as well
+as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar>
+package provides all the methods specified in  L<perltie>. It inherits from
+B<Tie::Scalar> and causes scalars tied to it to behave exactly like the
+built-in scalars, allowing for selective overloading of methods. The C<new>
+method is provided as a means of grandfathering, for classes that forget to
+provide their own C<TIESCALAR> method.
+
+For developers wishing to write their own tied-scalar classes, the methods
+are summarized below. The L<perltie> section not only documents these, but
+has sample code as well:
+
+=over
+
+=item TIESCALAR classname, LIST
+
+The method invoked by the command C<tie $scalar, classname>. Associates a new
+scalar instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item FETCH this
+
+Retrieve the value of the tied scalar referenced by I<this>.
+
+=item STORE this, value
+
+Store data I<value> in the tied scalar referenced by I<this>.
+
+=item DESTROY this
+
+Free the storage associated with the tied scalar referenced by I<this>.
+This is rarely needed, as Perl manages its memory quite well. But the
+option exists, should a class wish to perform specific actions upon the
+destruction of an instance.
+
+=back
+
+=head1 MORE INFORMATION
+
+The L<perltie> section uses a good example of tying scalars by associating
+process IDs with priority.
+
+=cut
+
+use Carp;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIESCALAR(@_);
+}
+
+# "Grandfather" the new, a la Tie::Hash
+
+sub TIESCALAR {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
+	    if $^W;
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIESCALAR method";
+    }
+}
+
+sub FETCH {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a FETCH method";
+}
+
+sub STORE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a STORE method";
+}
+
+#
+# The Tie::StdScalar package provides scalars that behave exactly like
+# Perl's built-in scalars. Good base to inherit from, if you're only going to
+# tweak a small bit.
+#
+package Tie::StdScalar;
+@ISA = (Tie::Scalar);
+
+sub TIESCALAR {
+    my $class = shift;
+    my $instance = shift || undef;
+    return bless \$instance => $class;
+}
+
+sub FETCH {
+    return ${$_[0]};
+}
+
+sub STORE {
+    ${$_[0]} = $_[1];
+}
+
+sub DESTROY {
+    undef ${$_[0]};
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
new file mode 100644
index 00000000000..a01c66ef8d5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
@@ -0,0 +1,176 @@
+package Tie::SubstrHash;
+
+=head1 NAME
+
+Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
+
+=head1 SYNOPSIS
+
+    require Tie::SubstrHash;
+
+    tie %myhash, Tie::SubstrHash, $key_len, $value_len, $table_size;
+
+=head1 DESCRIPTION
+
+The B<Tie::SubstrHash> package provides a hash-table-like interface to
+an array of determinate size, with constant key size and record size.
+
+Upon tying a new hash to this package, the developer must specify the
+size of the keys that will be used, the size of the value fields that the
+keys will index, and the size of the overall table (in terms of key-value
+pairs, not size in hard memory). I<These values will not change for the
+duration of the tied hash>. The newly-allocated hash table may now have
+data stored and retrieved. Efforts to store more than C<$table_size>
+elements will result in a fatal error, as will efforts to store a value
+not exactly C<$value_len> characters in length, or reference through a
+key not exactly C<$key_len> characters in length. While these constraints
+may seem excessive, the result is a hash table using much less internal
+memory than an equivalent freely-allocated hash table.
+
+=head1 CAVEATS
+
+Because the current implementation uses the table and key sizes for the
+hashing algorithm, there is no means by which to dynamically change the
+value of any of the initialization parameters.
+
+=cut
+
+use Carp;
+
+sub TIEHASH {
+    my $pack = shift;
+    my ($klen, $vlen, $tsize) = @_;
+    my $rlen = 1 + $klen + $vlen;
+    $tsize = findprime($tsize * 1.1);	# Allow 10% empty.
+    $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
+    $$self[0] x= $rlen * $tsize;
+    $self;
+}
+
+sub FETCH {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    return substr($record, 1+$klen, $vlen);
+	}
+	&rehash;
+    }
+}
+
+sub STORE {
+    local($self,$key,$val) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    croak("Table is full") if $self[5] == $tsize;
+    croak(qq/Value "$val" is not $vlen characters long./)
+	if length($val) != $vlen;
+    my $writeoffset;
+
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    $writeoffset = $offset unless defined $writeoffset;
+	    substr($$self[0], $writeoffset, $rlen) = $record;
+	    ++$$self[5];
+	    return;
+	}
+	elsif (ord($record) == 1) {
+	    $writeoffset = $offset unless defined $writeoffset;
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    substr($$self[0], $offset, $rlen) = $record;
+	    return;
+	}
+	&rehash;
+    }
+}
+
+sub DELETE {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    substr($$self[0], $offset, 1) = "\1";
+	    return substr($record, 1+$klen, $vlen);
+	    --$$self[5];
+	}
+	&rehash;
+    }
+}
+
+sub FIRSTKEY {
+    local($self) = @_;
+    $$self[6] = -1;
+    &NEXTKEY;
+}
+
+sub NEXTKEY {
+    local($self) = @_;
+    local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6];
+    for (++$iterix; $iterix < $tsize; ++$iterix) {
+	next unless substr($$self[0], $iterix * $rlen, 1) eq "\2";
+	$$self[6] = $iterix;
+	return substr($$self[0], $iterix * $rlen + 1, $klen);
+    }
+    $$self[6] = -1;
+    undef;
+}
+
+sub hashkey {
+    croak(qq/Key "$key" is not $klen characters long.\n/)
+	if length($key) != $klen;
+    $hash = 2;
+    for (unpack('C*', $key)) {
+	$hash = $hash * 33 + $_;
+    }
+    $hash = $hash - int($hash / $tsize) * $tsize
+	if $hash >= $tsize;
+    $hash = 1 unless $hash;
+    $hashbase = $hash;
+}
+
+sub rehash {
+    $hash += $hashbase;
+    $hash -= $tsize if $hash >= $tsize;
+}
+
+sub findprime {
+    use integer;
+
+    my $num = shift;
+    $num++ unless $num % 2;
+
+    $max = int sqrt $num;
+
+  NUM:
+    for (;; $num += 2) {
+	for ($i = 3; $i <= $max; $i += 2) {
+	    next NUM unless $num % $i;
+	}
+	return $num;
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Time/Local.pm b/gnu/usr.bin/perl/lib/Time/Local.pm
new file mode 100644
index 00000000000..451c7fa20c7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Time/Local.pm
@@ -0,0 +1,112 @@
+package Time::Local;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(timegm timelocal);
+
+=head1 NAME
+
+Time::Local - efficiently compute tome from local and GMT time
+
+=head1 SYNOPSIS
+
+    $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+    $time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+=head1 DESCRIPTION
+
+These routines are quite efficient and yet are always guaranteed to agree
+with localtime() and gmtime().  We manage this by caching the start times
+of any months we've seen before.  If we know the start time of the month,
+we can always calculate any time within the month.  The start times
+themselves are guessed by successive approximation starting at the
+current time, since most dates seen in practice are close to the
+current date.  Unlike algorithms that do a binary search (calling gmtime
+once for each bit of the time value, resulting in 32 calls), this algorithm
+calls it at most 6 times, and usually only once or twice.  If you hit
+the month cache, of course, it doesn't call it at all.
+
+timelocal is implemented using the same cache.  We just assume that we're
+translating a GMT time, and then fudge it when we're done for the timezone
+and daylight savings arguments.  The timezone is determined by examining
+the result of localtime(0) when the package is initialized.  The daylight
+savings offset is currently assumed to be one hour.
+
+Both routines return -1 if the integer limit is hit. I.e. for dates
+after the 1st of January, 2038 on most machines.
+
+=cut
+
+@epoch = localtime(0);
+$tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
+if ($tzmin > 0) {
+    $tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
+    $tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
+}
+
+$SEC = 1;
+$MIN = 60 * $SEC;
+$HR = 60 * $MIN;
+$DAYS = 24 * $HR;
+$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+
+sub timegm {
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    return -1 if $cheat<0;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    $time = &timegm + $tzmin*$MIN;
+    return -1 if $cheat<0;
+    @test = localtime($time);
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    croak "Month out of range 0..11 in timelocal.pl" 
+	if $month > 11 || $month < 0;
+    croak "Day out of range 1..31 in timelocal.pl" 
+	if $_[3] > 31 || $_[3] < 1;
+    croak "Hour out of range 0..23 in timelocal.pl"
+	if $_[2] > 23 || $_[2] < 0;
+    croak "Minute out of range 0..59 in timelocal.pl"
+	if $_[1] > 59 || $_[1] < 0;
+    croak "Second out of range 0..59 in timelocal.pl"
+	if $_[0] > 59 || $_[0] < 0;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
+    $lastguess = "";
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (363 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (27 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    @gfake = gmtime($guess-1); #still being sceptic
+    if ("@gfake" eq $lastguess){
+	return -1; #date beyond this machine's integer limit
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $cheat{$ym} = $guess;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/abbrev.pl b/gnu/usr.bin/perl/lib/abbrev.pl
new file mode 100644
index 00000000000..c233d4af7e6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/abbrev.pl
@@ -0,0 +1,33 @@
+;# Usage:
+;#	%foo = ();
+;#	&abbrev(*foo,LIST);
+;#	...
+;#	$long = $foo{$short};
+
+package abbrev;
+
+sub main'abbrev {
+    local(*domain) = @_;
+    shift(@_);
+    @cmp = @_;
+    local($[) = 0;
+    foreach $name (@_) {
+	@extra = split(//,$name);
+	$abbrev = shift(@extra);
+	$len = 1;
+	foreach $cmp (@cmp) {
+	    next if $cmp eq $name;
+	    while (substr($cmp,0,$len) eq $abbrev) {
+		$abbrev .= shift(@extra);
+		++$len;
+	    }
+	}
+	$domain{$abbrev} = $name;
+	while ($#extra >= 0) {
+	    $abbrev .= shift(@extra);
+	    $domain{$abbrev} = $name;
+	}
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/assert.pl b/gnu/usr.bin/perl/lib/assert.pl
new file mode 100644
index 00000000000..4c9ebf20a0d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/assert.pl
@@ -0,0 +1,55 @@
+# assert.pl
+# tchrist@convex.com (Tom Christiansen)
+# 
+# Usage:
+# 
+#     &assert('@x > @y');
+#     &assert('$var > 10', $var, $othervar, @various_info);
+# 
+# That is, if the first expression evals false, we blow up.  The
+# rest of the args, if any, are nice to know because they will
+# be printed out by &panic, which is just the stack-backtrace
+# routine shamelessly borrowed from the perl debugger.
+
+sub assert {
+    &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
+} 
+
+sub panic {
+    package DB;
+
+    select(STDERR);
+
+    print "\npanic: @_\n";
+
+    exit 1 if $] <= 4.003;  # caller broken
+
+    # stack traceback gratefully borrowed from perl debugger
+
+    local $_;
+    my $i;
+    my ($p,$f,$l,$s,$h,$a,@a,@frames);
+    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+	@a = @args;
+	for (@a) {
+	    if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+		$_ = sprintf("%s",$_);
+	    }
+	    else {
+		s/'/\\'/g;
+		s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+		s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    }
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	push(@frames, "$w&$s$a from file $f line $l\n");
+    }
+    for ($i=0; $i <= $#frames; $i++) {
+	print $frames[$i];
+    }
+    exit 1;
+} 
+
+1;
diff --git a/gnu/usr.bin/perl/lib/bigfloat.pl b/gnu/usr.bin/perl/lib/bigfloat.pl
new file mode 100644
index 00000000000..9ad171f295a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigfloat.pl
@@ -0,0 +1,233 @@
+package bigfloat;
+require "bigint.pl";
+# Arbitrary length float math package
+#
+# by Mark Biggar
+#
+# number format
+#   canonical strings have the form /[+-]\d+E[+-]\d+/
+#   Input values can have inbedded whitespace
+# Error returns
+#   'NaN'           An input parameter was "Not a Number" or 
+#                       divide by zero or sqrt of negative number
+# Division is computed to 
+#   max($div_scale,length(dividend)+length(divisor)) 
+#   digits by default.
+# Also used for default sqrt scale
+
+$div_scale = 40;
+
+# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
+
+$rnd_mode = 'even';
+
+#   bigfloat routines
+#
+#   fadd(NSTR, NSTR) return NSTR            addition
+#   fsub(NSTR, NSTR) return NSTR            subtraction
+#   fmul(NSTR, NSTR) return NSTR            multiplication
+#   fdiv(NSTR, NSTR[,SCALE]) returns NSTR   division to SCALE places
+#   fneg(NSTR) return NSTR                  negation
+#   fabs(NSTR) return NSTR                  absolute value
+#   fcmp(NSTR,NSTR) return CODE             compare undef,<0,=0,>0
+#   fround(NSTR, SCALE) return NSTR         round to SCALE digits
+#   ffround(NSTR, SCALE) return NSTR        round at SCALEth place
+#   fnorm(NSTR) return (NSTR)               normalize
+#   fsqrt(NSTR[, SCALE]) return NSTR        sqrt to SCALE places
+
+# Convert a number to canonical string form.
+#   Takes something that looks like a number and converts it to
+#   the form /^[+-]\d+E[+-]\d+$/.
+sub main'fnorm { #(string) return fnum_str
+    local($_) = @_;
+    s/\s+//g;                               # strip white space
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
+	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    } else {
+	'NaN';
+    }
+}
+
+# normalize number -- for internal use
+sub norm { #(mantissa, exponent) return fnum_str
+    local($_, $exp) = @_;
+    if ($_ eq 'NaN') {
+	'NaN';
+    } else {
+	s/^([+-])0+/$1/;                        # strip leading zeros
+	if (length($_) == 1) {
+	    '+0E+0';
+	} else {
+	    $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
+	    sprintf("%sE%+ld", $_, $exp);
+	}
+    }
+}
+
+# negation
+sub main'fneg { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[$[]);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+    s/^H/N/;
+    $_;
+}
+
+# absolute value
+sub main'fabs { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[$[]);
+    s/^-/+/;		                       # mash sign
+    $_;
+}
+
+# multiplication
+sub main'fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	&norm(&'bmul($xm,$ym),$xe+$ye);
+    }
+}
+
+# addition
+sub main'fadd { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
+	&norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye);
+    }
+}
+
+# subtraction
+sub main'fsub { #(fnum_str, fnum_str) return fnum_str
+    &'fadd($_[$[],&'fneg($_[$[+1]));    
+}
+
+# division
+#   args are dividend, divisor, scale (optional)
+#   result has at most max(scale, length(dividend), length(divisor)) digits
+sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
+{
+    local($x,$y,$scale) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]),$_[$[+2]);
+    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if (length($xm)-1 > $scale);
+	$scale = length($ym)-1 if (length($ym)-1 > $scale);
+	$scale = $scale + length($ym) - length($xm);
+	&norm(&round(&'bdiv($xm.('0' x $scale),$ym),$ym),
+	    $xe-$ye-$scale);
+    }
+}
+
+# round int $q based on fraction $r/$base using $rnd_mode
+sub round { #(int_str, int_str, int_str) return int_str
+    local($q,$r,$base) = @_;
+    if ($q eq 'NaN' || $r eq 'NaN') {
+	'NaN';
+    } elsif ($rnd_mode eq 'trunc') {
+	$q;                         # just truncate
+    } else {
+	local($cmp) = &'bcmp(&'bmul($r,'+2'),$base);
+	if ( $cmp < 0 ||
+		 ($cmp == 0 &&
+		  ( $rnd_mode eq 'zero'                             ||
+		   ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    &'badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
+				    # round up
+	}
+    }
+}
+
+# round the mantissa of $x to $scale digits
+sub main'fround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN' || $scale <= 0) {
+	$x;
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if (length($xm)-1 <= $scale) {
+	    $x;
+	} else {
+	    &norm(&round(substr($xm,$[,$scale+1),
+			 "+0".substr($xm,$[+$scale+1,1),"+10"),
+		  $xe+length($xm)-$scale-1);
+	}
+    }
+}
+
+# round $x at the 10 to the $scale digit place
+sub main'ffround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= $scale) {
+	    $x;
+	} else {
+	    $xe = length($xm)+$xe-$scale;
+	    if ($xe < 1) {
+		'+0E+0';
+	    } elsif ($xe == 1) {
+		&norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale);
+	    } else {
+		&norm(&round(substr($xm,$[,$xe),
+		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+    
+# compare 2 values returns one of undef, <0, =0, >0
+#   returns undef if either or both input value are not numbers
+sub main'fcmp #(fnum_str, fnum_str) return cond_code
+{
+    local($x, $y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq "NaN" || $y eq "NaN") {
+	undef;
+    } else {
+	ord($y) <=> ord($x)
+	||
+	(  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
+	     (($xe <=> $ye) * (substr($x,$[,1).'1')
+             || &bigint'cmp($xm,$ym))
+	);
+    }
+}
+
+# square root by Newtons method.
+sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (&'fnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN' || $x =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0E+0') {
+	'+0E+0';
+    } else {
+	local($xm, $xe) = split('E',$x);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if ($scale < length($xm)-1);
+	local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
+	while ($gs < 2*$scale) {
+	    $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5");
+	    $gs *= 2;
+	}
+	&'fround($guess, $scale);
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/bigint.pl b/gnu/usr.bin/perl/lib/bigint.pl
new file mode 100644
index 00000000000..e6ba644e3b3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigint.pl
@@ -0,0 +1,275 @@
+package bigint;
+
+# arbitrary size integer math package
+#
+# by Mark Biggar
+#
+# Canonical Big integer value are strings of the form
+#       /^[+-]\d+$/ with leading zeros suppressed
+# Input values to these routines may be strings of the form
+#       /^\s*[+-]?[\d\s]+$/.
+# Examples:
+#   '+0'                            canonical zero value
+#   '   -123 123 123'               canonical value '-123123123'
+#   '1 23 456 7890'                 canonical value '+1234567890'
+# Output values always always in canonical form
+#
+# Actual math is done in an internal format consisting of an array
+#   whose first element is the sign (/^[+-]$/) and whose remaining 
+#   elements are base 100000 digits with the least significant digit first.
+# The string 'NaN' is used to represent the result when input arguments 
+#   are not numbers, as well as the result of dividing by zero
+#
+# routines provided are:
+#
+#   bneg(BINT) return BINT              negation
+#   babs(BINT) return BINT              absolute value
+#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
+#   badd(BINT,BINT) return BINT         addition
+#   bsub(BINT,BINT) return BINT         subtraction
+#   bmul(BINT,BINT) return BINT         multiplication
+#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+#   bmod(BINT,BINT) return BINT         modulus
+#   bgcd(BINT,BINT) return BINT         greatest common divisor
+#   bnorm(BINT) return BINT             normalization
+#
+
+$zero = 0;
+
+
+# normalize string form of number.   Strip leading zeros.  Strip any
+#   white space and add a sign, if missing.
+# Strings that are not numbers result the value 'NaN'.
+
+sub main'bnorm { #(num_str) return num_str
+    local($_) = @_;
+    s/\s+//g;                           # strip white space
+    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
+	substr($_,$[,0) = '+' unless $1; # Add missing sign
+	s/^-0/+0/;
+	$_;
+    } else {
+	'NaN';
+    }
+}
+
+# Convert a number from string format to internal base 100000 format.
+#   Assumes normalized value as input.
+sub internal { #(num_str) return int_num_array
+    local($d) = @_;
+    ($is,$il) = (substr($d,$[,1),length($d)-2);
+    substr($d,$[,1) = '';
+    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
+}
+
+# Convert a number from internal base 100000 format to string format.
+#   This routine scribbles all over input array.
+sub external { #(int_num_array) return num_str
+    $es = shift;
+    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
+    &'bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
+}
+
+# Negate input value.
+sub main'bneg { #(num_str) return num_str
+    local($_) = &'bnorm(@_);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
+    s/^H/N/;
+    $_;
+}
+
+# Returns the absolute value of the input.
+sub main'babs { #(num_str) return num_str
+    &abs(&'bnorm(@_));
+}
+
+sub abs { # post-normalized abs for internal use
+    local($_) = @_;
+    s/^-/+/;
+    $_;
+}
+
+# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
+sub main'bcmp { #(num_str, num_str) return cond_code
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	undef;
+    } elsif ($y eq 'NaN') {
+	undef;
+    } else {
+	&cmp($x,$y);
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    $cx cmp $cy
+    &&
+    (
+	ord($cy) <=> ord($cx)
+	||
+	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
+    );
+}
+
+sub main'badd { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);             # convert to internal form
+	@y = &internal($y);
+	local($sx, $sy) = (shift @x, shift @y); # get signs
+	if ($sx eq $sy) {
+	    &external($sx, &add(*x, *y)); # if same sign add
+	} else {
+	    ($x, $y) = (&abs($x),&abs($y)); # make abs
+	    if (&cmp($y,$x) > 0) {
+		&external($sy, &sub(*y, *x));
+	    } else {
+		&external($sx, &sub(*x, *y));
+	    }
+	}
+    }
+}
+
+sub main'bsub { #(num_str, num_str) return num_str
+    &'badd($_[$[],&'bneg($_[$[+1]));    
+}
+
+# GCD -- Euclids algorithm Knuth Vol 2 pg 296
+sub main'bgcd { #(num_str, num_str) return num_str
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
+	$x;
+    }
+}
+
+# routine to add two base 1e5 numbers
+#   stolen from Knuth Vol 2 Algorithm A pg 231
+#   there are separate routines to add and sub as per Kunth pg 233
+sub add { #(int_num_array, int_num_array) return int_num_array
+    local(*x, *y) = @_;
+    $car = 0;
+    for $x (@x) {
+	last unless @y || $car;
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+    }
+    (@x, @y, $car);
+}
+
+# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+sub sub { #(int_num_array, int_num_array) return int_num_array
+    local(*sx, *sy) = @_;
+    $bar = 0;
+    for $sx (@sx) {
+	last unless @y || $bar;
+	$sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
+    }
+    @sx;
+}
+
+# multiply two numbers -- stolen from Knuth Vol 2 pg 233
+sub main'bmul { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	@y = &internal($y);
+	local($signr) = (shift @x ne shift @y) ? '-' : '+';
+	@prod = ();
+	for $x (@x) {
+	    ($car, $cty) = (0, $[);
+	    for $y (@y) {
+		$prod = $x * $y + $prod[$cty] + $car;
+		$prod[$cty++] =
+		    $prod - ($car = int($prod * 1e-5)) * 1e5;
+	    }
+	    $prod[$cty] += $car if $car;
+	    $x = shift @prod;
+	}
+	&external($signr, @x, @prod);
+    }
+}
+
+# modulus
+sub main'bmod { #(num_str, num_str) return num_str
+    (&'bdiv(@_))[$[+1];
+}
+
+sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
+    local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+    return wantarray ? ('NaN','NaN') : 'NaN'
+	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
+    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
+    @x = &internal($x); @y = &internal($y);
+    $srem = $y[$[];
+    $sr = (shift @x ne shift @y) ? '-' : '+';
+    $car = $bar = $prd = 0;
+    if (($dd = int(1e5/($y[$#y]+1))) != 1) {
+	for $x (@x) {
+	    $x = $x * $dd + $car;
+	    $x -= ($car = int($x * 1e-5)) * 1e5;
+	}
+	push(@x, $car); $car = 0;
+	for $y (@y) {
+	    $y = $y * $dd + $car;
+	    $y -= ($car = int($y * 1e-5)) * 1e5;
+	}
+    }
+    else {
+	push(@x, 0);
+    }
+    @q = (); ($v2,$v1) = @y[-2,-1];
+    while ($#x > $#y) {
+	($u2,$u1,$u0) = @x[-3..-1];
+	$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
+	--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
+	if ($q) {
+	    ($car, $bar) = (0,0);
+	    for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		$prd = $q * $y[$y] + $car;
+		$prd -= ($car = int($prd * 1e-5)) * 1e5;
+		$x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
+	    }
+	    if ($x[$#x] < $car + $bar) {
+		$car = 0; --$q;
+		for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		    $x[$x] -= 1e5
+			if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
+		}
+	    }   
+	}
+	pop(@x); unshift(@q, $q);
+    }
+    if (wantarray) {
+	@d = ();
+	if ($dd != 1) {
+	    $car = 0;
+	    for $x (reverse @x) {
+		$prd = $car * 1e5 + $x;
+		$car = $prd - ($tmp = int($prd / $dd)) * $dd;
+		unshift(@d, $tmp);
+	    }
+	}
+	else {
+	    @d = @x;
+	}
+	(&external($sr, @q), &external($srem, @d, $zero));
+    } else {
+	&external($sr, @q);
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/bigrat.pl b/gnu/usr.bin/perl/lib/bigrat.pl
new file mode 100644
index 00000000000..fb436ce5708
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigrat.pl
@@ -0,0 +1,149 @@
+package bigrat;
+require "bigint.pl";
+
+# Arbitrary size rational math package
+#
+# by Mark Biggar
+#
+# Input values to these routines consist of strings of the form 
+#   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
+# Examples:
+#   "+0/1"                          canonical zero value
+#   "3"                             canonical value "+3/1"
+#   "   -123/123 123"               canonical value "-1/1001"
+#   "123 456/7890"                  canonical value "+20576/1315"
+# Output values always include a sign and no leading zeros or
+#   white space.
+# This package makes use of the bigint package.
+# The string 'NaN' is used to represent the result when input arguments 
+#   that are not numbers, as well as the result of dividing by zero and
+#       the sqrt of a negative number.
+# Extreamly naive algorthims are used.
+#
+# Routines provided are:
+#
+#   rneg(RAT) return RAT                negation
+#   rabs(RAT) return RAT                absolute value
+#   rcmp(RAT,RAT) return CODE           compare numbers (undef,<0,=0,>0)
+#   radd(RAT,RAT) return RAT            addition
+#   rsub(RAT,RAT) return RAT            subtraction
+#   rmul(RAT,RAT) return RAT            multiplication
+#   rdiv(RAT,RAT) return RAT            division
+#   rmod(RAT) return (RAT,RAT)          integer and fractional parts
+#   rnorm(RAT) return RAT               normalization
+#   rsqrt(RAT, cycles) return RAT       square root
+
+# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
+sub main'rnorm { #(string) return rat_num
+    local($_) = @_;
+    s/\s+//g;
+    if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
+	&norm($1, $3 ? $3 : '+1');
+    } else {
+	'NaN';
+    }
+}
+
+# Normalize by reducing to lowest terms
+sub norm { #(bint, bint) return rat_num
+    local($num,$dom) = @_;
+    if ($num eq 'NaN') {
+	'NaN';
+    } elsif ($dom eq 'NaN') {
+	'NaN';
+    } elsif ($dom =~ /^[+-]?0+$/) {
+	'NaN';
+    } else {
+	local($gcd) = &'bgcd($num,$dom);
+	$gcd =~ s/^-/+/;
+	if ($gcd ne '+1') { 
+	    $num = &'bdiv($num,$gcd);
+	    $dom = &'bdiv($dom,$gcd);
+	} else {
+	    $num = &'bnorm($num);
+	    $dom = &'bnorm($dom);
+	}
+	substr($dom,$[,1) = '';
+	"$num/$dom";
+    }
+}
+
+# negation
+sub main'rneg { #(rat_num) return rat_num
+    local($_) = &'rnorm(@_);
+    tr/-+/+-/ if ($_ ne '+0/1');
+    $_;
+}
+
+# absolute value
+sub main'rabs { #(rat_num) return $rat_num
+    local($_) = &'rnorm(@_);
+    substr($_,$[,1) = '+' unless $_ eq 'NaN';
+    $_;
+}
+
+# multipication
+sub main'rmul { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
+}
+
+# division
+sub main'rdiv { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
+}
+
+# addition
+sub main'radd { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# subtraction
+sub main'rsub { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# comparison
+sub main'rcmp { #(rat_num, rat_num) return cond_code
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
+}
+
+# int and frac parts
+sub main'rmod { #(rat_num) return (rat_num,rat_num)
+    local($xn,$xd) = split('/',&'rnorm(@_));
+    local($i,$f) = &'bdiv($xn,$xd);
+    if (wantarray) {
+	("$i/1", "$f/$xd");
+    } else {
+	"$i/1";
+    }   
+}
+
+# square root by Newtons method.
+#   cycles specifies the number of iterations default: 5
+sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
+    local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($x =~ /^-/) {
+	'NaN';
+    } else {
+	local($gscale, $guess) = (0, '+1/1');
+	$scale = 5 if (!$scale);
+	while ($gscale++ < $scale) {
+	    $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
+	}
+	"$guess";          # quotes necessary due to perl bug
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/cacheout.pl b/gnu/usr.bin/perl/lib/cacheout.pl
new file mode 100644
index 00000000000..48d594bf825
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/cacheout.pl
@@ -0,0 +1,46 @@
+# Open in their package.
+
+sub cacheout'open {
+    open($_[0], $_[1]);
+}
+
+# Close as well
+
+sub cacheout'close {
+    close($_[0]);
+}
+
+# But only this sub name is visible to them.
+
+sub cacheout {
+    package cacheout;
+
+    ($file) = @_;
+    if (!$isopen{$file}) {
+	if (++$numopen > $maxopen) {
+	    local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $maxopen / 3);
+	    $numopen -= @lru;
+	    for (@lru) { &close($_); delete $isopen{$_}; }
+	}
+	&open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    || die "Can't create $file: $!\n";
+    }
+    $isopen{$file} = ++$seq;
+}
+
+package cacheout;
+
+$seq = 0;
+$numopen = 0;
+
+if (open(PARAM,'/usr/include/sys/param.h')) {
+    local($.);
+    while (<PARAM>) {
+	$maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+    }
+    close PARAM;
+}
+$maxopen = 16 unless $maxopen;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/chat2.inter b/gnu/usr.bin/perl/lib/chat2.inter
new file mode 100644
index 00000000000..6934f1cc285
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/chat2.inter
@@ -0,0 +1,495 @@
+Article 20992 of comp.lang.perl:
+Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!ames!koriel!male.EBay.Sun.COM!jethro.Corp.Sun.COM!eric
+From: eric.arnold@sun.com (Eric Arnold)
+Newsgroups: comp.lang.perl
+Subject: Re: Need a bidirectional filter for interactive Unix applications
+Date: 15 Apr 94 21:24:03 GMT
+Organization: Sun Microsystems
+Lines: 478
+Sender: news@sun.com
+Message-ID: <ERIC.94Apr15212403@sun.com>
+References: <dgfCo9F2J.Jzw@netcom.com> <1994Apr15.110134.4581@chemabs.uucp>
+NNTP-Posting-Host: animus.corp.sun.com
+X-Newsreader: prn Ver 1.09
+In-reply-to: btf64@cas.org's message of Fri, 15 Apr 1994 11:01:34 GMT
+
+In article <1994Apr15.110134.4581@chemabs.uucp>
+	btf64@cas.org (Bernard T. French) writes:
+
+>In article <dgfCo9F2J.Jzw@netcom.com> dgf@netcom.com (David Feldman) writes:
+>>I need to write a bidirectional filter that would (ideally) sit between a
+..
+>>program's stdin & stdout to point to a pty pair known to perl. The perl app-
+>>lication would talk to the user's crt/keyboard, translate (application-specific)
+>>the input & output streams, and pass these as appropriate to/from the pty pair,
+..
+>
+>     I'm afraid I can't offer you a perl solution, but err..... there is a
+>Tcl solution.  There is a Tcl extension called "expect" that is designed to
+
+There *is* an old, established Perl solution:  "chat2.pl" which does
+everything (well, basically) "expect" does but you get it in the
+expressive Perl environment.  "chat2.pl" is delivered with the Perl
+source.
+
+Randal:  "interact()" still hasn't made it into Perl5alpha8
+"chat2.pl", so I've included a version which does.
+
+-Eric
+
+
+## chat.pl: chat with a server
+## V2.01.alpha.7 91/06/16
+## Randal L. Schwartz
+
+package chat;
+
+$sockaddr = 'S n a4 x8';
+chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4];
+$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+
+# *S = symbol for current I/O, gets assigned *chatsymbol....
+$next = "chatsymbol000000"; # next one
+$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
+
+
+## $handle = &chat'open_port("server.address",$port_number);
+## opens a named or numbered TCP server
+
+sub open_port { ## public
+	local($server, $port) = @_;
+
+	local($serveraddr,$serverproc);
+
+	*S = ++$next;
+	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+		$serveraddr = pack('C4', $1, $2, $3, $4);
+	} else {
+		local(@x) = gethostbyname($server);
+		return undef unless @x;
+		$serveraddr = $x[4];
+	}
+	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
+	unless (socket(S, 2, 1, 6)) {
+		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
+		# but who the heck would change these anyway? (:-)
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (bind(S, $thisproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (connect(S, $serverproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	select((select(S), $| = 1)[0]);
+	$next; # return symbol for switcharound
+}
+
+## ($host, $port, $handle) = &chat'open_listen([$port_number]);
+## opens a TCP port on the current machine, ready to be listened to
+## if $port_number is absent or zero, pick a default port number
+## process must be uid 0 to listen to a low port number
+
+sub open_listen { ## public
+
+	*S = ++$next;
+	local($thisport) = shift || 0;
+	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
+	local(*NS) = "__" . time;
+	unless (socket(NS, 2, 1, 6)) {
+		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
+		# but who the heck would change these anyway? (:-)
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (bind(NS, $thisproc_local)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (listen(NS, 1)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	select((select(NS), $| = 1)[0]);
+	local($family, $port, @myaddr) =
+		unpack("S n C C C C x8", getsockname(NS));
+	$S{"needs_accept"} = *NS; # so expect will open it
+	(@myaddr, $port, $next); # returning this
+}
+
+## $handle = &chat'open_proc("command","arg1","arg2",...);
+## opens a /bin/sh on a pseudo-tty
+
+sub open_proc { ## public
+	local(@cmd) = @_;
+
+	*S = ++$next;
+	local(*TTY) = "__TTY" . time;
+	local($pty,$tty,$pty_handle) = &_getpty(S,TTY);
+
+	#local($pty,$tty,$pty_handle) = &getpty(S,TTY);
+	#$Tty = $tty;
+
+	die "Cannot find a new pty" unless defined $pty;
+	local($pid) = fork;
+	die "Cannot fork: $!" unless defined $pid;
+	unless ($pid) {
+		close STDIN; close STDOUT; close STDERR;
+		#close($pty_handle);
+		setpgrp(0,$$);
+		if (open(DEVTTY, "/dev/tty")) {
+		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
+		    close DEVTTY;
+		}
+		open(STDIN,"<&TTY");
+		open(STDOUT,">&TTY");
+		open(STDERR,">&STDOUT");
+		die "Oops" unless fileno(STDERR) == 2;	# sanity
+		close(S);
+
+		exec @cmd;
+		die "Cannot exec @cmd: $!";
+	}
+	close(TTY);
+	$PID{$next} = $pid;
+	$next; # return symbol for switcharound
+
+}
+
+# $S is the read-ahead buffer
+
+## $return = &chat'expect([$handle,] $timeout_time,
+## 	$pat1, $body1, $pat2, $body2, ... )
+## $handle is from previous &chat'open_*().
+## $timeout_time is the time (either relative to the current time, or
+## absolute, ala time(2)) at which a timeout event occurs.
+## $pat1, $pat2, and so on are regexs which are matched against the input
+## stream.  If a match is found, the entire matched string is consumed,
+## and the corresponding body eval string is evaled.
+##
+## Each pat is a regular-expression (probably enclosed in single-quotes
+## in the invocation).  ^ and $ will work, respecting the current value of $*.
+## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
+## If pat is 'EOF', the body is executed if the process exits before
+## the other patterns are seen.
+##
+## Pats are scanned in the order given, so later pats can contain
+## general defaults that won't be examined unless the earlier pats
+## have failed.
+##
+## The result of eval'ing body is returned as the result of
+## the invocation.  Recursive invocations are not thought
+## through, and may work only accidentally. :-)
+##
+## undef is returned if either a timeout or an eof occurs and no
+## corresponding body has been defined.
+## I/O errors of any sort are treated as eof.
+
+$nextsubname = "expectloop000000"; # used for subroutines
+
+sub expect { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	local($endtime) = shift;
+
+	local($timeout,$eof) = (1,1);
+	local($caller) = caller;
+	local($rmask, $nfound, $timeleft, $thisbuf);
+	local($cases, $pattern, $action, $subname);
+	$endtime += time if $endtime < 600_000_000;
+
+	if (defined $S{"needs_accept"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_accept"};
+		delete $S{"needs_accept"};
+		$S{"needs_close"} = *NS;
+		unless(accept(S,NS)) {
+			($!) = ($!, close(S), close(NS));
+			return undef;
+		}
+		select((select(S), $| = 1)[0]);
+	}
+
+	# now see whether we need to create a new sub:
+
+	unless ($subname = $expect_subname{$caller,@_}) {
+		# nope.  make a new one:
+		$expect_subname{$caller,@_} = $subname = $nextsubname++;
+
+		$cases .= <<"EDQ"; # header is funny to make everything elsif's
+sub $subname {
+	LOOP: {
+		if (0) { ; }
+EDQ
+		while (@_) {
+			($pattern,$action) = splice(@_,0,2);
+			if ($pattern =~ /^eof$/i) {
+				$cases .= <<"EDQ";
+		elsif (\$eof) {
+	 		package $caller;
+			$action;
+		}
+EDQ
+				$eof = 0;
+			} elsif ($pattern =~ /^timeout$/i) {
+			$cases .= <<"EDQ";
+		elsif (\$timeout) {
+		 	package $caller;
+			$action;
+		}
+EDQ
+				$timeout = 0;
+			} else {
+				$pattern =~ s#/#\\/#g;
+			$cases .= <<"EDQ";
+		elsif (\$S =~ /$pattern/) {
+			\$S = \$';
+		 	package $caller;
+			$action;
+		}
+EDQ
+			}
+		}
+		$cases .= <<"EDQ" if $eof;
+		elsif (\$eof) {
+			undef;
+		}
+EDQ
+		$cases .= <<"EDQ" if $timeout;
+		elsif (\$timeout) {
+			undef;
+		}
+EDQ
+		$cases .= <<'ESQ';
+		else {
+			$rmask = "";
+			vec($rmask,fileno(S),1) = 1;
+			($nfound, $rmask) =
+		 		select($rmask, undef, undef, $endtime - time);
+			if ($nfound) {
+				$nread = sysread(S, $thisbuf, 1024);
+				if ($nread > 0) {
+					$S .= $thisbuf;
+				} else {
+					$eof++, redo LOOP; # any error is also eof
+				}
+			} else {
+				$timeout++, redo LOOP; # timeout
+			}
+			redo LOOP;
+		}
+	}
+}
+ESQ
+		eval $cases; die "$cases:\n$@" if $@;
+	}
+	$eof = $timeout = 0;
+	do $subname();
+}
+
+## &chat'print([$handle,] @data)
+## $handle is from previous &chat'open().
+## like print $handle @data
+
+sub print { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	print S @_;
+}
+
+## &chat'close([$handle,])
+## $handle is from previous &chat'open().
+## like close $handle
+
+sub close { ## public
+	local($pid);
+	if ($_[0] =~ /$nextpat/) {
+		$pid = $PID{$_[0]};
+	 	*S = shift;
+	} else {
+		$pid = $PID{$next};
+	}
+	close(S);
+	waitpid($pid,0);
+	if (defined $S{"needs_close"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_close"};
+		delete $S{"needs_close"};
+		close(NS);
+	}
+}
+
+## @ready_handles = &chat'select($timeout, @handles)
+## select()'s the handles with a timeout value of $timeout seconds.
+## Returns an array of handles that are ready for I/O.
+## Both user handles and chat handles are supported (but beware of
+## stdio's buffering for user handles).
+
+sub select { ## public
+	local($timeout) = shift;
+	local(@handles) = @_;
+	local(%handlename) = ();
+	local(%ready) = ();
+	local($caller) = caller;
+	local($rmask) = "";
+	for (@handles) {
+		if (/$nextpat/o) { # one of ours... see if ready
+			local(*SYM) = $_;
+			if (length($SYM)) {
+				$timeout = 0; # we have a winner
+				$ready{$_}++;
+			}
+			$handlename{fileno($_)} = $_;
+		} else {
+			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
+		}
+	}
+	for (sort keys %handlename) {
+		vec($rmask, $_, 1) = 1;
+	}
+	select($rmask, undef, undef, $timeout);
+	for (sort keys %handlename) {
+		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
+	}
+	sort keys %ready;
+}
+
+# ($pty,$tty) = $chat'_getpty(PTY,TTY):
+# internal procedure to get the next available pty.
+# opens pty on handle PTY, and matching tty on handle TTY.
+# returns undef if can't find a pty.
+
+sub _getpty { ## private
+	local($_PTY,$_TTY) = @_;
+	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	local($pty,$tty);
+	for $bank (112..127) {
+		next unless -e sprintf("/dev/pty%c0", $bank);
+		for $unit (48..57) {
+			$pty = sprintf("/dev/pty%c%c", $bank, $unit);
+			open($_PTY,"+>$pty") || next;
+			select((select($_PTY), $| = 1)[0]);
+			($tty = $pty) =~ s/pty/tty/;
+			open($_TTY,"+>$tty") || next;
+			select((select($_TTY), $| = 1)[0]);
+			system "stty nl>$tty";
+			return ($pty,$tty,$_PTY);
+		}
+	}
+	undef;
+}
+
+
+sub getpty {
+  local( $pty_handle, $tty_handle ) = @_;
+
+print "--------in getpty----------\n";
+  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+
+  #$pty_handle = ++$next_handle;
+  chop( @ptys = `ls /dev/pty*` );
+
+  for $pty ( @ptys )
+  {
+    open($pty_handle,"+>$pty") || next;
+    select((select($pty_handle), $| = 1)[0]);
+    ($tty = $pty) =~ s/pty/tty/;
+
+    open($tty_handle,"+>$tty") || next;
+    select((select($tty_handle), $| = 1)[0]);
+    ($tty = $pty) =~ s/pty/tty/;
+
+    return ($pty, $tty, $pty_handle );
+  }
+  return undef;
+}
+
+
+
+# from: Randal L. Schwartz
+
+# Usage:
+#
+# ($chathandle = &chat'open_proc("/bin/sh")) || die "cannot open shell";
+# system("stty cbreak raw -echo >/dev/tty\n");
+# &chat'interact($chathandle);
+# &chat'close($chathandle);
+# system("stty -cbreak -raw echo >/dev/tty\n");
+
+sub interact
+{
+  local( $chathandle ) = @_;
+
+  &chat'print($chathandle, "stty sane\n");
+  select(STDOUT) ; $| = 1; # unbuffer STDOUT
+
+  #print "tty=$Tty,whoami=",`whoami`,"\n";
+  #&change_utmp( "", $Tty, "eric", "", time() );
+
+  {
+    @ready = &chat'select(30, STDIN,$chathandle);
+    print "after select, ready=",join(",",@ready),"\n";
+    #(warn "[waiting]"), redo unless @ready;
+    if (grep($_ eq $chathandle, @ready)) {
+	    print "checking $chathandle\n";
+	    last unless $text = &chat'expect($chathandle,0,'[\s\S]+','$&');
+	    print "$chathandle OK\n";
+	    print "got=($text)";
+	    #print $text;
+    }
+    if (grep($_ eq STDIN, @ready)) {
+	    print "checking STDIN\n";
+	    last unless sysread(STDIN,$buf,1024) > 0;
+	    print "STDIN OK\n";
+	    &chat'print($chathandle,$buf);
+    }
+    redo;
+  }
+  #&change_utmp( $Tty, "$Tty", "", "", 0 );
+  print "leaving interact, \$!=$!\n";
+}
+
+## $handle = &chat'open_duphandle(handle);
+## duplicates an input file handle to conform to chat format
+
+sub open_duphandle { ## public
+    *S = ++$next;
+    open(S,"<&$_[0]");
+    $next; # return symbol for switcharound
+}
+
+#Here is an example which uses this routine.
+#
+#    # The following lines makes stdin unbuffered
+#    
+#    $BSD = -f '/vmunix';
+#    
+#    if ($BSD) {
+#        system "stty cbreak </dev/tty >/dev/tty 2>&1";
+#    }
+#    else {
+#        system "stty", '-icanon';
+#        system "stty", 'eol', '^A';
+#    }
+#
+#    require 'mychat2.pl';
+#    
+#    &chat'open_duphandle(STDIN);
+#    
+#    print 
+#    &chat'expect(3,
+#      '[A-Z]', '" :-)"',
+#      '.', '" :-("',
+#      TIMEOUT,  '"-o-"',
+#      EOF, '"\$\$"'),
+#    "\n";
+
+
+1;
+
+
diff --git a/gnu/usr.bin/perl/lib/chat2.pl b/gnu/usr.bin/perl/lib/chat2.pl
new file mode 100644
index 00000000000..0d9a7d3d503
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/chat2.pl
@@ -0,0 +1,368 @@
+# chat.pl: chat with a server
+# Based on: V2.01.alpha.7 91/06/16
+# Randal L. Schwartz (was <merlyn@stonehenge.com>)
+# multihome additions by A.Macpherson@bnr.co.uk
+# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
+
+package chat;
+
+require 'sys/socket.ph';
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+
+$sockaddr = 'S n a4 x8';
+chop($thishost = `hostname`);
+
+# *S = symbol for current I/O, gets assigned *chatsymbol....
+$next = "chatsymbol000000"; # next one
+$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
+
+
+## $handle = &chat'open_port("server.address",$port_number);
+## opens a named or numbered TCP server
+
+sub open_port { ## public
+	local($server, $port) = @_;
+
+	local($serveraddr,$serverproc);
+
+	# We may be multi-homed, start with 0, fixup once connexion is made
+	$thisaddr = "\0\0\0\0" ;
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+
+	*S = ++$next;
+	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+		$serveraddr = pack('C4', $1, $2, $3, $4);
+	} else {
+		local(@x) = gethostbyname($server);
+		return undef unless @x;
+		$serveraddr = $x[4];
+	}
+	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
+	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (bind(S, $thisproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (connect(S, $serverproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+# We opened with the local address set to ANY, at this stage we know
+# which interface we are using.  This is critical if our machine is
+# multi-homed, with IP forwarding off, so fix-up.
+	local($fam,$lport);
+	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+# end of post-connect fixup
+	select((select(S), $| = 1)[0]);
+	$next; # return symbol for switcharound
+}
+
+## ($host, $port, $handle) = &chat'open_listen([$port_number]);
+## opens a TCP port on the current machine, ready to be listened to
+## if $port_number is absent or zero, pick a default port number
+## process must be uid 0 to listen to a low port number
+
+sub open_listen { ## public
+
+	*S = ++$next;
+	local($thisport) = shift || 0;
+	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
+	local(*NS) = "__" . time;
+	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (bind(NS, $thisproc_local)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (listen(NS, 1)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	select((select(NS), $| = 1)[0]);
+	local($family, $port, @myaddr) =
+		unpack("S n C C C C x8", getsockname(NS));
+	$S{"needs_accept"} = *NS; # so expect will open it
+	(@myaddr, $port, $next); # returning this
+}
+
+## $handle = &chat'open_proc("command","arg1","arg2",...);
+## opens a /bin/sh on a pseudo-tty
+
+sub open_proc { ## public
+	local(@cmd) = @_;
+
+	*S = ++$next;
+	local(*TTY) = "__TTY" . time;
+	local($pty,$tty) = &_getpty(S,TTY);
+	die "Cannot find a new pty" unless defined $pty;
+	$pid = fork;
+	die "Cannot fork: $!" unless defined $pid;
+	unless ($pid) {
+		close STDIN; close STDOUT; close STDERR;
+		setpgrp(0,$$);
+		if (open(DEVTTY, "/dev/tty")) {
+		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
+		    close DEVTTY;
+		}
+		open(STDIN,"<&TTY");
+		open(STDOUT,">&TTY");
+		open(STDERR,">&STDOUT");
+		die "Oops" unless fileno(STDERR) == 2;	# sanity
+		close(S);
+		exec @cmd;
+		die "Cannot exec @cmd: $!";
+	}
+	close(TTY);
+	$next; # return symbol for switcharound
+}
+
+# $S is the read-ahead buffer
+
+## $return = &chat'expect([$handle,] $timeout_time,
+## 	$pat1, $body1, $pat2, $body2, ... )
+## $handle is from previous &chat'open_*().
+## $timeout_time is the time (either relative to the current time, or
+## absolute, ala time(2)) at which a timeout event occurs.
+## $pat1, $pat2, and so on are regexs which are matched against the input
+## stream.  If a match is found, the entire matched string is consumed,
+## and the corresponding body eval string is evaled.
+##
+## Each pat is a regular-expression (probably enclosed in single-quotes
+## in the invocation).  ^ and $ will work, respecting the current value of $*.
+## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
+## If pat is 'EOF', the body is executed if the process exits before
+## the other patterns are seen.
+##
+## Pats are scanned in the order given, so later pats can contain
+## general defaults that won't be examined unless the earlier pats
+## have failed.
+##
+## The result of eval'ing body is returned as the result of
+## the invocation.  Recursive invocations are not thought
+## through, and may work only accidentally. :-)
+##
+## undef is returned if either a timeout or an eof occurs and no
+## corresponding body has been defined.
+## I/O errors of any sort are treated as eof.
+
+$nextsubname = "expectloop000000"; # used for subroutines
+
+sub expect { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	local($endtime) = shift;
+
+	local($timeout,$eof) = (1,1);
+	local($caller) = caller;
+	local($rmask, $nfound, $timeleft, $thisbuf);
+	local($cases, $pattern, $action, $subname);
+	$endtime += time if $endtime < 600_000_000;
+
+	if (defined $S{"needs_accept"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_accept"};
+		delete $S{"needs_accept"};
+		$S{"needs_close"} = *NS;
+		unless(accept(S,NS)) {
+			($!) = ($!, close(S), close(NS));
+			return undef;
+		}
+		select((select(S), $| = 1)[0]);
+	}
+
+	# now see whether we need to create a new sub:
+
+	unless ($subname = $expect_subname{$caller,@_}) {
+		# nope.  make a new one:
+		$expect_subname{$caller,@_} = $subname = $nextsubname++;
+
+		$cases .= <<"EDQ"; # header is funny to make everything elsif's
+sub $subname {
+	LOOP: {
+		if (0) { ; }
+EDQ
+		while (@_) {
+			($pattern,$action) = splice(@_,0,2);
+			if ($pattern =~ /^eof$/i) {
+				$cases .= <<"EDQ";
+		elsif (\$eof) {
+	 		package $caller;
+			$action;
+		}
+EDQ
+				$eof = 0;
+			} elsif ($pattern =~ /^timeout$/i) {
+			$cases .= <<"EDQ";
+		elsif (\$timeout) {
+		 	package $caller;
+			$action;
+		}
+EDQ
+				$timeout = 0;
+			} else {
+				$pattern =~ s#/#\\/#g;
+			$cases .= <<"EDQ";
+		elsif (\$S =~ /$pattern/) {
+			\$S = \$';
+		 	package $caller;
+			$action;
+		}
+EDQ
+			}
+		}
+		$cases .= <<"EDQ" if $eof;
+		elsif (\$eof) {
+			undef;
+		}
+EDQ
+		$cases .= <<"EDQ" if $timeout;
+		elsif (\$timeout) {
+			undef;
+		}
+EDQ
+		$cases .= <<'ESQ';
+		else {
+			$rmask = "";
+			vec($rmask,fileno(S),1) = 1;
+			($nfound, $rmask) =
+		 		select($rmask, undef, undef, $endtime - time);
+			if ($nfound) {
+				$nread = sysread(S, $thisbuf, 1024);
+				if ($nread > 0) {
+					$S .= $thisbuf;
+				} else {
+					$eof++, redo LOOP; # any error is also eof
+				}
+			} else {
+				$timeout++, redo LOOP; # timeout
+			}
+			redo LOOP;
+		}
+	}
+}
+ESQ
+		eval $cases; die "$cases:\n$@" if $@;
+	}
+	$eof = $timeout = 0;
+	do $subname();
+}
+
+## &chat'print([$handle,] @data)
+## $handle is from previous &chat'open().
+## like print $handle @data
+
+sub print { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	print S @_;
+	if( $chat'debug ){
+		print STDERR "printed:";
+		print STDERR @_;
+	}
+}
+
+## &chat'close([$handle,])
+## $handle is from previous &chat'open().
+## like close $handle
+
+sub close { ## public
+	if ($_[0] =~ /$nextpat/) {
+	 	*S = shift;
+	}
+	close(S);
+	if (defined $S{"needs_close"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_close"};
+		delete $S{"needs_close"};
+		close(NS);
+	}
+}
+
+## @ready_handles = &chat'select($timeout, @handles)
+## select()'s the handles with a timeout value of $timeout seconds.
+## Returns an array of handles that are ready for I/O.
+## Both user handles and chat handles are supported (but beware of
+## stdio's buffering for user handles).
+
+sub select { ## public
+	local($timeout) = shift;
+	local(@handles) = @_;
+	local(%handlename) = ();
+	local(%ready) = ();
+	local($caller) = caller;
+	local($rmask) = "";
+	for (@handles) {
+		if (/$nextpat/o) { # one of ours... see if ready
+			local(*SYM) = $_;
+			if (length($SYM)) {
+				$timeout = 0; # we have a winner
+				$ready{$_}++;
+			}
+			$handlename{fileno($_)} = $_;
+		} else {
+			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
+		}
+	}
+	for (sort keys %handlename) {
+		vec($rmask, $_, 1) = 1;
+	}
+	select($rmask, undef, undef, $timeout);
+	for (sort keys %handlename) {
+		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
+	}
+	sort keys %ready;
+}
+
+# ($pty,$tty) = $chat'_getpty(PTY,TTY):
+# internal procedure to get the next available pty.
+# opens pty on handle PTY, and matching tty on handle TTY.
+# returns undef if can't find a pty.
+# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
+
+sub _getpty { ## private
+	local($_PTY,$_TTY) = @_;
+	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	local($pty, $tty, $kind);
+	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
+		$kind = "pts";		## SVR4 Streams
+	} else {
+		$kind = "pty";		## BSD Clist stuff
+	}
+	for $bank (112..127) {
+		next unless -e sprintf("/dev/$kind%c0", $bank);
+		for $unit (48..57) {
+			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
+			open($_PTY,"+>$pty") || next;
+			select((select($_PTY), $| = 1)[0]);
+			($tty = $pty) =~ s/pty/tty/;
+			open($_TTY,"+>$tty") || next;
+			select((select($_TTY), $| = 1)[0]);
+			system "stty nl>$tty";
+			return ($pty,$tty);
+		}
+	}
+	undef;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/complete.pl b/gnu/usr.bin/perl/lib/complete.pl
new file mode 100644
index 00000000000..1e08f9145ae
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/complete.pl
@@ -0,0 +1,110 @@
+;#
+;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
+;#
+;# Author: Wayne Thompson
+;#
+;# Description:
+;#     This routine provides word completion.
+;#     (TAB) attempts word completion.
+;#     (^D)  prints completion list.
+;#      (These may be changed by setting $Complete'complete, etc.)
+;#
+;# Diagnostics:
+;#     Bell when word completion fails.
+;#
+;# Dependencies:
+;#     The tty driver is put into raw mode.
+;#
+;# Bugs:
+;#
+;# Usage:
+;#     $input = &Complete('prompt_string', *completion_list);
+;#         or
+;#     $input = &Complete('prompt_string', @completion_list);
+;#
+
+CONFIG: {
+    package Complete;
+
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
+sub Complete {
+    package Complete;
+
+    local($[,$return) = 0;
+    if ($_[1] =~ /^StB\0/) {
+        ($prompt, *_) = @_;
+    }
+    else {
+        $prompt = shift(@_);
+    }
+    @cmp_lst = sort(@_);
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef($r, $return);
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
+    }
+    system('stty -raw echo');
+    print("\n");
+    $return;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ctime.pl b/gnu/usr.bin/perl/lib/ctime.pl
new file mode 100644
index 00000000000..14e122adda0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ctime.pl
@@ -0,0 +1,51 @@
+;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
+;#
+;# Waldemar Kebsch, Federal Republic of Germany, November 1988
+;# kebsch.pad@nixpbe.UUCP
+;# Modified March 1990, Feb 1991 to properly handle timezones
+;#  $RCSfile: ctime.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:47 $
+;#   Marion Hakanson (hakanson@cse.ogi.edu)
+;#   Oregon Graduate Institute of Science and Technology
+;#
+;# usage:
+;#
+;#     #include <ctime.pl>          # see the -P and -I option in perl.man
+;#     $Date = &ctime(time);
+
+CONFIG: {
+    package ctime;
+
+    @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+    @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
+	    'Jul','Aug','Sep','Oct','Nov','Dec');
+}
+
+sub ctime {
+    package ctime;
+
+    local($time) = @_;
+    local($[) = 0;
+    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
+
+    # Determine what time zone is in effect.
+    # Use GMT if TZ is defined as null, local time if TZ undefined.
+    # There's no portable way to find the system default timezone.
+
+    $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
+    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+        ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
+
+    # Hack to deal with 'PST8PDT' format of TZ
+    # Note that this can't deal with all the esoteric forms, but it
+    # does recognize the most common: [:]STDoff[DST[off][,rule]]
+
+    if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
+        $TZ = $isdst ? $4 : $1;
+    }
+    $TZ .= ' ' unless $TZ eq '';
+
+    $year += 1900;
+    sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
+      $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm
new file mode 100644
index 00000000000..3560f2d708d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/diagnostics.pm
@@ -0,0 +1,507 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if 0;
+
+use Config;
+if ($^O eq 'VMS') {
+   $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlib'}) .
+                           '/pod/perldiag.pod';
+}
+else { $diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod"; }
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    local($Carp::CarpLevel) = 1;
+    confess "Uncaught exception from user code:\n\t$exception";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
diff --git a/gnu/usr.bin/perl/lib/dotsh.pl b/gnu/usr.bin/perl/lib/dotsh.pl
new file mode 100644
index 00000000000..8e9d9620e59
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/dotsh.pl
@@ -0,0 +1,67 @@
+#
+#   @(#)dotsh.pl                                               03/19/94
+#
+#   Author: Charles Collins
+#
+#   Description:
+#      This routine takes a shell script and 'dots' it into the current perl
+#      environment. This makes it possible to use existing system scripts
+#      to alter environment variables on the fly.
+#
+#   Usage:
+#      &dotsh ('ShellScript', 'DependentVariable(s)');
+#
+#         where
+#
+#      'ShellScript' is the full name of the shell script to be dotted
+#
+#      'DependentVariable(s)' is an optional list of shell variables in the
+#         form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is
+#         dependent upon. These variables MUST be defined using shell syntax.
+#
+#   Example:
+#      &dotsh ('/tmp/foo', 'arg1');
+#      &dotsh ('/tmp/foo');
+#      &dotsh ('/tmp/foo arg1 ... argN');
+#
+sub dotsh {
+   local(@sh) = @_;
+   local($tmp,$key,$shell,*dotsh,$command,$args,$vars) = '';
+   $dotsh = shift(@sh);
+   @dotsh = split (/\s/, $dotsh);
+   $command = shift (@dotsh);
+   $args = join (" ", @dotsh);
+   $vars = join ("\n", @sh);
+   open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
+   chop($_ = <_SH_ENV>);
+   $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
+   close (_SH_ENV);
+   if (!$shell) {
+      if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/csh$/) {
+	 $shell = "$ENV{'SHELL'} -c";
+      } else {
+	 print "SHELL not recognized!\nUsing /bin/sh...\n";
+	 $shell = "/bin/sh -c";
+      }
+   }
+   if (length($vars) > 0) {
+      system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\"";
+   } else {
+      system "$shell \". $command $args; set > /tmp/_sh_env$$\"";
+   }
+
+   open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n";
+   while (<_SH_ENV>) {
+       chop;
+       /=/;
+       $ENV{$`} = $';
+   }
+   close (_SH_ENV);
+   system "rm -f /tmp/_sh_env$$";
+
+   foreach $key (keys(%ENV)) {
+       $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
+   }
+   eval $tmp;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
new file mode 100644
index 00000000000..06c09305816
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -0,0 +1,408 @@
+require 5.002;			# For (defined ref)
+package dumpvar;
+
+# Needed for PrettyPrinter only:
+
+# require 5.001;  # Well, it coredumps anyway undef DB in 5.000 (not now)
+
+# translate control chars to ^X - Randal Schwartz
+# Modifications to print types by Peter Gordon v1.0
+
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+# Won't dump symbol tables and contents of debugged files by default
+
+$winsize = 80 unless defined $winsize;
+
+
+# Defaults
+
+# $globPrint = 1;
+$printUndef = 1 unless defined $printUndef;
+$tick = "auto" unless defined $tick;
+$unctrl = 'quote' unless defined $unctrl;
+$subdump = 1;
+
+sub main::dumpValue {
+  local %address;
+  (print "undef\n"), return unless defined $_[0];
+  (print &stringify($_[0]), "\n"), return unless ref $_[0];
+  dumpvar::unwrap($_[0],0);
+}
+
+# This one is good for variable names:
+
+sub unctrl {
+	local($_) = @_;
+	local($v) ; 
+
+	return \$_ if ref \$_ eq "GLOB";
+	s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+	$_;
+}
+
+sub stringify {
+	local($_,$noticks) = @_;
+	local($v) ; 
+	my $tick = $tick;
+
+	return 'undef' unless defined $_ or not $printUndef;
+	return $_ . "" if ref \$_ eq 'GLOB';
+	if ($tick eq 'auto') {
+	  if (/[\000-\011\013-\037\177]/) {
+	    $tick = '"';
+	  }else {
+	    $tick = "'";
+	  }
+	}
+	if ($tick eq "'") {
+	  s/([\'\\])/\\$1/g;
+	} elsif ($unctrl eq 'unctrl') {
+	  s/([\"\\])/\\$1/g ;
+	  s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+	  s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg 
+	    if $quoteHighBit;
+	} 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/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $quoteHighBit;
+	($noticks || /^\d+(\.\d*)?\Z/) 
+	  ? $_ 
+	  : $tick . $_ . $tick;
+}
+
+sub ShortArray {
+  my $tArrayDepth = $#{$_[0]} ; 
+  $tArrayDepth = $#{$_[0]} < $arrayDepth-1 ? $#{$_[0]} : $arrayDepth-1 
+    unless  $arrayDepth eq '' ; 
+  my $shortmore = "";
+  $shortmore = " ..." if $tArrayDepth < $#{$_[0]} ;
+  if (!grep(ref $_, @{$_[0]})) {
+    $short = "0..$#{$_[0]}  '" . 
+      join("' '", @{$_[0]}[0..$tArrayDepth]) . "'$shortmore";
+    return $short if length $short <= $compactDump;
+  }
+  undef;
+}
+
+sub DumpElem {
+  my $short = &stringify($_[0], ref $_[0]);
+  if ($veryCompact && ref $_[0]
+      && (ref $_[0] eq 'ARRAY' and !grep(ref $_, @{$_[0]}) )) {
+    my $end = "0..$#{$v}  '" . 
+      join("' '", @{$_[0]}[0..$tArrayDepth]) . "'$shortmore";
+  } elsif ($veryCompact && ref $_[0]
+      && (ref $_[0] eq 'HASH') and !grep(ref $_, values %{$_[0]})) {
+    my $end = 1;
+	  $short = $sp . "0..$#{$v}  '" . 
+	    join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
+  } else {
+    print "$short\n";
+    unwrap($_[0],$_[1]);
+  }
+}
+
+sub unwrap {
+    return if $DB::signal;
+    local($v) = shift ; 
+    local($s) = shift ; # extra no of spaces
+    local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ;
+    local($tHashDepth,$tArrayDepth) ;
+
+    $sp = " " x $s ;
+    $s += 3 ; 
+
+    # Check for reused addresses
+    if (ref $v) { 
+      ($address) = $v =~ /(0x[0-9a-f]+)/ ; 
+      if (defined $address) { 
+	($type) = $v =~ /=(.*?)\(/ ;
+	$address{$address}++ ;
+	if ( $address{$address} > 1 ) { 
+	  print "${sp}-> REUSED_ADDRESS\n" ; 
+	  return ; 
+	} 
+      }
+    } elsif (ref \$v eq 'GLOB') {
+      $address = "$v" . "";	# To avoid a bug with globs
+      $address{$address}++ ;
+      if ( $address{$address} > 1 ) { 
+	print "${sp}*DUMPED_GLOB*\n" ; 
+	return ; 
+      } 
+    }
+
+    if ( ref $v eq 'HASH' or $type eq 'HASH') { 
+	@sortKeys = sort keys(%$v) ;
+	undef $more ; 
+	$tHashDepth = $#sortKeys ; 
+	$tHashDepth = $#sortKeys < $hashDepth-1 ? $#sortKeys : $hashDepth-1
+	  unless $hashDepth eq '' ; 
+	$more = "....\n" if $tHashDepth < $#sortKeys ; 
+	$shortmore = "";
+	$shortmore = ", ..." if $tHashDepth < $#sortKeys ; 
+	$#sortKeys = $tHashDepth ; 
+	if ($compactDump && !grep(ref $_, values %{$v})) {
+	  #$short = $sp . 
+	  #  (join ', ', 
+# Next row core dumps during require from DB on 5.000, even with map {"_"}
+	  #   map {&stringify($_) . " => " . &stringify($v->{$_})} 
+	  #   @sortKeys) . "'$shortmore";
+	  $short = $sp;
+	  my @keys;
+	  for (@sortKeys) {
+	    push @keys, &stringify($_) . " => " . &stringify($v->{$_});
+	  }
+	  $short .= join ', ', @keys;
+	  $short .= $shortmore;
+	  (print "$short\n"), return if length $short <= $compactDump;
+	}
+	for $key (@sortKeys) {
+	    return if $DB::signal;
+	    $value = $ {$v}{$key} ;
+	    print "$sp", &stringify($key), " => ";
+	    DumpElem $value, $s;
+	}
+	print "$sp  empty hash\n" unless @sortKeys;
+	print "$sp$more" if defined $more ;
+    } elsif ( ref $v eq 'ARRAY' or $type eq 'ARRAY') { 
+	$tArrayDepth = $#{$v} ; 
+	undef $more ; 
+	$tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 
+	  unless  $arrayDepth eq '' ; 
+	$more = "....\n" if $tArrayDepth < $#{$v} ; 
+	$shortmore = "";
+	$shortmore = " ..." if $tArrayDepth < $#{$v} ;
+	if ($compactDump && !grep(ref $_, @{$v})) {
+	  if ($#$v >= 0) {
+	    $short = $sp . "0..$#{$v}  " . 
+	      join(" ", 
+		   map {stringify $_} @{$v}[0..$tArrayDepth])
+		. "$shortmore";
+	  } else {
+	    $short = $sp . "empty array";
+	  }
+	  (print "$short\n"), return if length $short <= $compactDump;
+	}
+	#if ($compactDump && $short = ShortArray($v)) {
+	#  print "$short\n";
+	#  return;
+	#}
+	for $num ($[ .. $tArrayDepth) {
+	    return if $DB::signal;
+	    print "$sp$num  ";
+	    DumpElem $v->[$num], $s;
+	}
+	print "$sp  empty array\n" unless @$v;
+	print "$sp$more" if defined $more ;  
+    } elsif ( ref $v eq 'SCALAR' or ref $v eq 'REF' or $type eq 'SCALAR' ) { 
+	    print "$sp-> ";
+	    DumpElem $$v, $s;
+    } elsif ( ref $v eq 'CODE' or $type eq 'CODE' ) { 
+	    print "$sp-> ";
+	    dumpsub (0, $v);
+    } elsif (ref $v eq 'GLOB') {
+      print "$sp-> ",&stringify($$v,1),"\n";
+      if ($globPrint) {
+	$s += 3;
+	dumpglob($s, "{$$v}", $$v, 1);
+      } elsif (defined ($fileno = fileno($v))) {
+	print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
+      }
+    } elsif (ref \$v eq 'GLOB') {
+      if ($globPrint) {
+	dumpglob($s, "{$v}", $v, 1) if $globPrint;
+      } elsif (defined ($fileno = fileno(\$v))) {
+	print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
+      }
+    }
+}
+
+sub matchvar {
+  $_[0] eq $_[1] or 
+    ($_[1] =~ /^([!~])(.)/) and 
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$'/});
+}
+
+sub compactDump {
+  $compactDump = shift if @_;
+  $compactDump = 6*80-1 if $compactDump and $compactDump < 2;
+  $compactDump;
+}
+
+sub veryCompact {
+  $veryCompact = shift if @_;
+  compactDump(1) if !$compactDump and $veryCompact;
+  $veryCompact;
+}
+
+sub unctrlSet {
+  if (@_) {
+    my $in = shift;
+    if ($in eq 'unctrl' or $in eq 'quote') {
+      $unctrl = $in;
+    } else {
+      print "Unknown value for `unctrl'.\n";
+    }
+  }
+  $unctrl;
+}
+
+sub quote {
+  if (@_ and $_[0] eq '"') {
+    $tick = '"';
+    $unctrl = 'quote';
+  } elsif (@_ and $_[0] eq 'auto') {
+    $tick = 'auto';
+    $unctrl = 'quote';
+  } elsif (@_) {		# Need to set
+    $tick = "'";
+    $unctrl = 'unctrl';
+  }
+  $tick;
+}
+
+sub dumpglob {
+    return if $DB::signal;
+    my ($off,$key, $val, $all) = @_;
+    local(*entry) = $val;
+    my $fileno;
+    if (($key !~ /^_</ or $dumpDBFiles) and defined $entry) {
+      print( (' ' x $off) . "\$", &unctrl($key), " = " );
+      DumpElem $entry, 3+$off;
+    }
+    if (($key !~ /^_</ or $dumpDBFiles) and defined @entry) {
+      print( (' ' x $off) . "\@$key = (\n" );
+      unwrap(\@entry,3+$off) ;
+      print( (' ' x $off) .  ")\n" );
+    }
+    if ($key ne "main::" && $key ne "DB::" && defined %entry
+	&& ($dumpPackages or $key !~ /::$/)
+	&& ($key !~ /^_</ or $dumpDBFiles)
+	&& !($package eq "dumpvar" and $key eq "stab")) {
+      print( (' ' x $off) . "\%$key = (\n" );
+      unwrap(\%entry,3+$off) ;
+      print( (' ' x $off) .  ")\n" );
+    }
+    if (defined ($fileno = fileno(*entry))) {
+      print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
+    }
+    if ($all) {
+      if (defined &entry) {
+	dumpsub($off, $key);
+      }
+    }
+}
+
+sub dumpsub {
+    my ($off,$sub) = @_;
+    $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
+    my $subref = \&$sub;
+    my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub})
+      || ($subdump && ($sub = findsubs("$subref")) && $DB::sub{$sub});
+    $place = '???' unless defined $place;
+    print( (' ' x $off) .  "&$sub in $place\n" );
+}
+
+sub findsubs {
+  return undef unless defined %DB::sub;
+  my ($addr, $name, $loc);
+  while (($name, $loc) = each %DB::sub) {
+    $addr = \&$name;
+    $subs{"$addr"} = $name;
+  }
+  $subdump = 0;
+  $subs{ shift() };
+}
+
+sub main::dumpvar {
+    my ($package,@vars) = @_;
+    local(%address,$key,$val);
+    $package .= "::" unless $package =~ /::$/;
+    *stab = *{"main::"};
+    while ($package =~ /(\w+?::)/g){
+      *stab = $ {stab}{$1};
+    }
+    local $TotalStrings = 0;
+    local $Strings = 0;
+    local $CompleteTotal = 0;
+    while (($key,$val) = each(%stab)) {
+      return if $DB::signal;
+      next if @vars && !grep( matchvar($key, $_), @vars );
+      if ($usageOnly) {
+	globUsage(\$val, $key) unless $package eq 'dumpvar' and $key eq 'stab';
+      } else {
+	dumpglob(0,$key, $val);
+      }
+    }
+    if ($usageOnly) {
+      print "String space: $TotalStrings bytes in $Strings strings.\n";
+      $CompleteTotal += $TotalStrings;
+      print "Grand total = $CompleteTotal bytes (1 level deep) + overhead.\n";
+    }
+}
+
+sub scalarUsage {
+  my $size = length($_[0]);
+  $TotalStrings += $size;
+  $Strings++;
+  $size;
+}
+
+sub arrayUsage {		# array ref, name
+  my $size = 0;
+  map {$size += scalarUsage($_)} @{$_[0]};
+  my $len = @{$_[0]};
+  print "\@$_[1] = $len item", ($len > 1 ? "s" : ""),
+    " (data: $size bytes)\n"
+      if defined $_[1];
+  $CompleteTotal +=  $size;
+  $size;
+}
+
+sub hashUsage {		# hash ref, name
+  my @keys = keys %{$_[0]};
+  my @values = values %{$_[0]};
+  my $keys = arrayUsage \@keys;
+  my $values = arrayUsage \@values;
+  my $len = @keys;
+  my $total = $keys + $values;
+  print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
+    " (keys: $keys; values: $values; total: $total bytes)\n"
+      if defined $_[1];
+  $total;
+}
+
+sub globUsage {			# glob ref, name
+  local *name = *{$_[0]};
+  $total = 0;
+  $total += scalarUsage $name if defined $name;
+  $total += arrayUsage \@name, $_[1] if defined @name;
+  $total += hashUsage \%name, $_[1] if defined %name and $_[1] ne "main::" 
+    and $_[1] ne "DB::";   #and !($package eq "dumpvar" and $key eq "stab"));
+  $total;
+}
+
+sub packageUsage {
+  my ($package,@vars) = @_;
+  $package .= "::" unless $package =~ /::$/;
+  local *stab = *{"main::"};
+  while ($package =~ /(\w+?::)/g){
+    *stab = $ {stab}{$1};
+  }
+  local $TotalStrings = 0;
+  local $CompleteTotal = 0;
+  my ($key,$val);
+  while (($key,$val) = each(%stab)) {
+    next if @vars && !grep($key eq $_,@vars);
+    globUsage \$val, $key unless $package eq 'dumpvar' and $key eq 'stab';
+  }
+  print "String space: $TotalStrings.\n";
+  $CompleteTotal += $TotalStrings;
+  print "\nGrand total = $CompleteTotal bytes\n";
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/exceptions.pl b/gnu/usr.bin/perl/lib/exceptions.pl
new file mode 100644
index 00000000000..02c4498d321
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/exceptions.pl
@@ -0,0 +1,54 @@
+# exceptions.pl
+# tchrist@convex.com
+# 
+# Here's a little code I use for exception handling.  It's really just
+# glorfied eval/die.  The way to use use it is when you might otherwise
+# exit, use &throw to raise an exception.  The first enclosing &catch
+# handler looks at the exception and decides whether it can catch this kind
+# (catch takes a list of regexps to catch), and if so, it returns the one it
+# caught.  If it *can't* catch it, then it will reraise the exception
+# for someone else to possibly see, or to die otherwise.
+# 
+# I use oddly named variables in order to make darn sure I don't conflict 
+# with my caller.  I also hide in my own package, and eval the code in his.
+# 
+# The EXCEPTION: prefix is so you can tell whether it's a user-raised
+# exception or a perl-raised one (eval error).
+# 
+# --tom
+#
+# examples:
+#	if (&catch('/$user_input/', 'regexp', 'syntax error') {
+#		warn "oops try again";
+#		redo;
+#	}
+#
+#	if ($error = &catch('&subroutine()')) { # catches anything
+#
+#	&throw('bad input') if /^$/;
+
+sub catch {
+    package exception;
+    local($__code__, @__exceptions__) = @_;
+    local($__package__) = caller;
+    local($__exception__);
+
+    eval "package $__package__; $__code__";
+    if ($__exception__ = &'thrown) {
+	for (@__exceptions__) {
+	    return $__exception__ if /$__exception__/;
+	} 
+	&'throw($__exception__);
+    } 
+} 
+
+sub throw {
+    local($exception) = @_;
+    die "EXCEPTION: $exception\n";
+} 
+
+sub thrown {
+    $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
+} 
+
+1;
diff --git a/gnu/usr.bin/perl/lib/fastcwd.pl b/gnu/usr.bin/perl/lib/fastcwd.pl
new file mode 100644
index 00000000000..6b452e8d788
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/fastcwd.pl
@@ -0,0 +1,35 @@
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# 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 {
+	local($odev, $oino, $cdev, $cino, $tdev, $tino);
+	local(@path, $path);
+	local(*DIR);
+
+	($cdev, $cino) = stat('.');
+	for (;;) {
+		($odev, $oino) = ($cdev, $cino);
+		chdir('..');
+		($cdev, $cino) = stat('.');
+		last if $odev == $cdev && $oino == $cino;
+		opendir(DIR, '.');
+		for (;;) {
+			$_ = readdir(DIR);
+			next if $_ eq '.';
+			next if $_ eq '..';
+
+			last unless $_;
+			($tdev, $tino) = lstat($_);
+			last unless $tdev != $odev || $tino != $oino;
+		}
+		closedir(DIR);
+		unshift(@path, $_);
+	}
+	chdir($path = '/' . join('/', @path));
+	$path;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/find.pl b/gnu/usr.bin/perl/lib/find.pl
new file mode 100644
index 00000000000..40e613e97ee
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/find.pl
@@ -0,0 +1,108 @@
+# Usage:
+#	require "find.pl";
+#
+#	&find('/foo','/bar');
+#
+#	sub wanted { ... }
+#		where wanted does whatever you want.  $dir contains the
+#		current directory name, and $_ the current filename within
+#		that directory.  $name contains "$dir/$_".  You are cd'ed
+#		to $dir when the function is called.  The function may
+#		set $prune to prune the tree.
+#
+# This library is primarily for find2perl, which, when fed
+#
+#   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+#
+# spits out something like this
+#
+#	sub wanted {
+#	    /^\.nfs.*$/ &&
+#	    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+#	    int(-M _) > 7 &&
+#	    unlink($_)
+#	    ||
+#	    ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+#	    $dev < 0 &&
+#	    ($prune = 1);
+#	}
+#
+# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
+
+sub find {
+    chop($cwd = `pwd`);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&wanted;
+		($fixtopdir = $topdir) =~ s,/$,, ;
+		&finddir($fixtopdir,$topnlink);
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    $name = $topdir;
+	    chdir $dir && &wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddir {
+    local($dir,$nlink) = @_;
+    local($dev,$ino,$mode,$subcount);
+    local($name);
+
+    # Get the list of files in the current directory.
+
+    opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
+    local(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    &wanted;
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			&finddir($name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	}
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/finddepth.pl b/gnu/usr.bin/perl/lib/finddepth.pl
new file mode 100644
index 00000000000..1fe6a375b6c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/finddepth.pl
@@ -0,0 +1,105 @@
+# Usage:
+#	require "finddepth.pl";
+#
+#	&finddepth('/foo','/bar');
+#
+#	sub wanted { ... }
+#		where wanted does whatever you want.  $dir contains the
+#		current directory name, and $_ the current filename within
+#		that directory.  $name contains "$dir/$_".  You are cd'ed
+#		to $dir when the function is called.  The function may
+#		set $prune to prune the tree.
+#
+# This library is primarily for find2perl, which, when fed
+#
+#   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+#
+# spits out something like this
+#
+#	sub wanted {
+#	    /^\.nfs.*$/ &&
+#	    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+#	    int(-M _) > 7 &&
+#	    unlink($_)
+#	    ||
+#	    ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+#	    $dev < 0 &&
+#	    ($prune = 1);
+#	}
+
+sub finddepth {
+    chop($cwd = `pwd`);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($fixtopdir = $topdir) =~ s,/$,, ;
+		&finddepthdir($fixtopdir,$topnlink);
+		($dir,$_) = ($fixtopdir,'.');
+		$name = $fixtopdir;
+		&wanted;
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    chdir $dir && &wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddepthdir {
+    local($dir,$nlink) = @_;
+    local($dev,$ino,$mode,$subcount);
+    local($name);
+
+    # Get the list of files in the current directory.
+
+    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+    local(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2) {        # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    if ($subcount > 0) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			&finddepthdir($name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	    &wanted;
+	}
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/flush.pl b/gnu/usr.bin/perl/lib/flush.pl
new file mode 100644
index 00000000000..55002b9919c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/flush.pl
@@ -0,0 +1,23 @@
+;# Usage: &flush(FILEHANDLE)
+;# flushes the named filehandle
+
+;# Usage: &printflush(FILEHANDLE, "prompt: ")
+;# prints arguments and flushes filehandle
+
+sub flush {
+    local($old) = select(shift);
+    $| = 1;
+    print "";
+    $| = 0;
+    select($old);
+}
+
+sub printflush {
+    local($old) = select(shift);
+    $| = 1;
+    print @_;
+    $| = 0;
+    select($old);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ftp.pl b/gnu/usr.bin/perl/lib/ftp.pl
new file mode 100644
index 00000000000..a0f926430cb
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ftp.pl
@@ -0,0 +1,1079 @@
+#-*-perl-*-
+# This is a wrapper to the chat2.pl routines that make life easier
+# to do ftp type work.
+# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
+# based on original version by Alan R. Martello <al@ee.pitt.edu>
+# And by A.Macpherson@bnr.co.uk for multi-homed hosts
+#
+# $Header: /cvs/OpenBSD/src/gnu/usr.bin/perl/lib/Attic/ftp.pl,v 1.1 1996/08/19 10:12:34 downsj Exp $
+# $Log: ftp.pl,v $
+# Revision 1.1  1996/08/19 10:12:34  downsj
+# Initial revision
+#
+# Revision 1.17  1993/04/21  10:06:54  lmjm
+# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
+# Allow target file to be '-' meaning STDOUT
+# Added ftp'quote
+#
+# Revision 1.16  1993/01/28  18:59:05  lmjm
+# Allow socket arguemtns to come from main.
+# Minor cleanups - removed old comments.
+#
+# Revision 1.15  1992/11/25  21:09:30  lmjm
+# Added another REST return code.
+#
+# Revision 1.14  1992/08/12  14:33:42  lmjm
+# Fail ftp'write if out of space.
+#
+# Revision 1.13  1992/03/20  21:01:03  lmjm
+# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
+# Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
+#
+# Revision 1.12  1992/02/06  23:25:56  lmjm
+# Moved code around so can use this as a lib for both mirror and ftpmail.
+# Time out opens.  In case Unix doesn't bother to.
+#
+# Revision 1.11  1991/11/27  22:05:57  lmjm
+# Match the response code number at the start of a line allowing
+# for any leading junk.
+#
+# Revision 1.10  1991/10/23  22:42:20  lmjm
+# Added better timeout code.
+# Tried to optimise file transfer
+# Moved open/close code to not leak file handles.
+# Cleaned up the alarm code.
+# Added $fatalerror to show wether the ftp link is really dead.
+#
+# Revision 1.9  1991/10/07  18:30:35  lmjm
+# Made the timeout-read code work.
+# Added restarting file gets.
+# Be more verbose if ever have to call die.
+#
+# Revision 1.8  1991/09/17  22:53:16  lmjm
+# Spot when open_data_socket fails and return a failure rather than dying.
+#
+# Revision 1.7  1991/09/12  22:40:25  lmjm
+# Added Andrew Macpherson's patches for hosts without ip forwarding.
+#
+# Revision 1.6  1991/09/06  19:53:52  lmjm
+# Relaid out the code the way I like it!
+# Changed the debuggin to produce more "appropriate" messages
+# Fixed bugs in the ordering of put and dir listing.
+# Allow for hash printing when getting files (a la ftp).
+# Added the new commands from Al.
+# Don't print passwords in debugging.
+#
+# Revision 1.5  1991/08/29  16:23:49  lmjm
+# Timeout reads from the remote ftp server.
+# No longer call die expect on fatal errors.  Just return fail codes.
+# Changed returns so higher up routines can tell whats happening.
+# Get expect/accept in correct order for dir listing.
+# When ftp_show is set then print hashes every 1k transfered (like ftp).
+# Allow for stripping returns out of incoming data.
+# Save last error in a global string.
+#
+# Revision 1.4  1991/08/14  21:04:58  lmjm
+# ftp'get now copes with ungetable files.
+# ftp'expect code changed such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+# Implemented patches from al.  Removed spuiours tracing statements.
+#
+# Revision 1.3  1991/08/09  21:32:18  lmjm
+# Allow for another ok code on cwd's
+# Rejigger the log levels
+# Send \r\n for some odd ftp daemons
+#
+# Revision 1.2  1991/08/09  18:07:37  lmjm
+# Don't print messages unless ftp_show says to.
+#
+# Revision 1.1  1991/08/08  20:31:00  lmjm
+# Initial revision
+#
+
+require 'chat2.pl';
+eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
+
+
+package ftp;
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+# If the remote ftp daemon doesn't respond within this time presume its dead
+# or something.
+$timeout = 30;
+
+# Timeout a read if I don't get data back within this many seconds
+$timeout_read = 20 * $timeout;
+
+# Timeout an open
+$timeout_open = $timeout;
+
+# This is a "global" it contains the last response from the remote ftp server
+# for use in error messages
+$ftp'response = "";
+# Also ftp'NS is the socket containing the data coming in from the remote ls
+# command.
+
+# The size of block to be read or written when talking to the remote
+# ftp server
+$ftp'ftpbufsize = 4096;
+
+# How often to print a hash out, when debugging
+$ftp'hashevery = 1024;
+# Output a newline after this many hashes to prevent outputing very long lines
+$ftp'hashnl = 70;
+
+# If a proxy connection then who am I really talking to?
+$real_site = "";
+
+# This is just a tracing aid.
+$ftp_show = 0;
+sub ftp'debug
+{
+	$ftp_show = @_[0];
+#	if( $ftp_show ){
+#		print STDERR "ftp debugging on\n";
+#	}
+}
+
+sub ftp'set_timeout
+{
+	$timeout = @_[0];
+	$timeout_open = $timeout;
+	$timeout_read = 20 * $timeout;
+	if( $ftp_show ){
+		print STDERR "ftp timeout set to $timeout\n";
+	}
+}
+
+
+sub ftp'open_alarm
+{
+	die "timeout: open";
+}
+
+sub ftp'timed_open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+	local( $connect_site, $connect_port );
+	local( $res );
+
+	alarm( $timeout_open );
+
+	while( $attempts-- ){
+		if( $ftp_show ){
+			print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
+			print STDERR "Connecting to $site";
+			if( $ftp_port != 21 ){
+				print STDERR " [port $ftp_port]";
+			}
+			print STDERR "\n";
+		}
+		
+		if( $proxy ) {
+			if( ! $proxy_gateway ) {
+				# if not otherwise set
+				$proxy_gateway = "internet-gateway";
+			}
+			if( $debug ) {
+				print STDERR "using proxy services of $proxy_gateway, ";
+				print STDERR "at $proxy_ftp_port\n";
+			}
+			$connect_site = $proxy_gateway;
+			$connect_port = $proxy_ftp_port;
+			$real_site = $site;
+		}
+		else {
+			$connect_site = $site;
+			$connect_port = $ftp_port;
+		}
+		if( ! &chat'open_port( $connect_site, $connect_port ) ){
+			if( $retry_call ){
+				print STDERR "Failed to connect\n" if $ftp_show;
+				next;
+			}
+			else {
+				print STDERR "proxy connection failed " if $proxy;
+				print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
+				return 0;
+			}
+		}
+		$res = &ftp'expect( $timeout,
+				    120, "service unavailable to $site", 0, 
+	                            220, "ready for login to $site", 1,
+				    421, "service unavailable to $site, closing connection", 0);
+		if( ! $res ){
+			&chat'close();
+			next;
+		}
+		return 1;
+	}
+	continue {
+		print STDERR "Pausing between retries\n";
+		sleep( $retry_pause );
+	}
+	return 0;
+}
+
+sub ftp'open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+
+	$SIG{ 'ALRM' } = "ftp\'open_alarm";
+
+	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+sub ftp'login
+{
+	local( $remote_user, $remote_password ) = @_;
+
+	if( $proxy ){
+		&ftp'send( "USER $remote_user@$site" );
+	}
+	else {
+		&ftp'send( "USER $remote_user" );
+	}
+        local( $val ) =
+               &ftp'expect($timeout,
+	           230, "$remote_user logged in", 1,
+		   331, "send password for $remote_user", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+		   332, "account for login not supported", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $val == 1 ){
+		return 1;
+	}
+	if( $val == 2 ){
+		# A password is needed
+		&ftp'send( "PASS $remote_password" );
+
+		$val = &ftp'expect( $timeout,
+		   230, "$remote_user logged in", 1,
+
+		   202, "command not implemented", 0,
+		   332, "account for login not supported", 0,
+
+		   530, "not logged in", 0,
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   503, "bad sequence of commands", 0, 
+
+		   421, "service unavailable, closing connection", 0);
+		if( $val == 1){
+			# Logged in
+			return 1;
+		}
+	}
+	# If I got here I failed to login
+	return 0;
+}
+
+sub ftp'close
+{
+	&ftp'quit();
+	&chat'close();
+}
+
+# Change directory
+# return 1 if successful
+# 0 on a failure
+sub ftp'cwd
+{
+	local( $dir ) = @_;
+
+	&ftp'send( "CWD $dir" );
+
+	return &ftp'expect( $timeout,
+		200, "working directory = $dir", 1,
+		250, "working directory = $dir", 1,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+                502, "command not implemented", 0,
+		530, "not logged in", 0,
+                550, "cannot change directory", 0,
+		421, "service unavailable, closing connection", 0 );
+}
+
+# Get a full directory listing:
+# &ftp'dir( remote LIST options )
+# Start a list goin with the given options.
+# Presuming that the remote deamon uses the ls command to generate the
+# data to send back then then you can send it some extra options (eg: -lRa)
+# return 1 if sucessful and 0 on a failure
+sub ftp'dir_open
+{
+	local( $options ) = @_;
+	local( $ret );
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	if( $options ){
+		&ftp'send( "LIST $options" );
+	}
+	else {
+		&ftp'send( "LIST" );
+	}
+	
+	$ret = &ftp'expect( $timeout,
+		150, "reading directory", 1,
+	
+		125, "data connection already open?", 0,
+	
+		450, "file unavailable", 0,
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		502, "command not implemented", 0,
+		530, "not logged in", 0,
+	
+		   421, "service unavailable, closing connection", 0 );
+	if( ! $ret ){
+		&ftp'close_data_socket;
+		return 0;
+	}
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed $!";
+	
+	return 1;
+}
+
+
+# Close down reading the result of a remote ls command
+# return 1 if successful and 0 on failure
+sub ftp'dir_close
+{
+	local( $ret );
+
+	# read the close
+	#
+	$ret = &ftp'expect($timeout,
+        	226, "", 1,     # transfer complete, closing connection
+        	250, "", 1,     # action completed
+
+	        425, "can't open data connection", 0,
+        	426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+	        421, "service unavailable, closing connection", 0);
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( ! $ret ){
+		return 0;
+	}
+
+	return 1;
+}
+
+# Quit from the remote ftp server
+# return 1 if successful and 0 on failure
+sub ftp'quit
+{
+	$site_command_check = 0;
+	@site_command_list = ();
+
+	&ftp'send("QUIT");
+
+	return &ftp'expect($timeout, 
+		221, "Goodbye", 1,     # transfer complete, closing connection
+	
+		500, "error quitting??", 0);
+}
+
+sub ftp'read_alarm
+{
+	die "timeout: read";
+}
+
+sub ftp'timed_read
+{
+	alarm( $timeout_read );
+	return sysread( NS, $buf, $ftpbufsize );
+}
+
+sub ftp'read
+{
+	$SIG{ 'ALRM' } = "ftp\'read_alarm";
+
+	local( $ret ) = eval '&timed_read()';
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+# Get a remote file back into a local file.
+# If no loc_fname passed then uses rem_fname.
+# returns 1 on success and 0 on failure
+sub ftp'get
+{
+	local($rem_fname, $loc_fname, $restart ) = @_;
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		print STDERR "Cannot open data socket\n";
+		return 0;
+	}
+
+	if( $loc_fname ne '-' ){
+		# Find the size of the target file
+		local( $restart_at ) = &ftp'filesize( $loc_fname );
+		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
+			$restart = 1;
+			# Make sure the file can be updated
+			chmod( 0644, $loc_fname );
+		}
+		else {
+			$restart = 0;
+			unlink( $loc_fname );
+		}
+	}
+
+	&ftp'send( "RETR $rem_fname" );
+	
+	local( $ret ) =
+		&ftp'expect($timeout, 
+                   150, "receiving $rem_fname", 1,
+
+                   125, "data connection already open?", 0,
+
+                   450, "file unavailable", 2,
+                   550, "file unavailable", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $ret != 1 ){
+		print STDERR "Failure on RETR command\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+	# 
+	# the data should be coming at us now
+	#
+
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+
+	#
+	#  open the local fname
+	#  concatenate on the end if restarting, else just overwrite
+	if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
+		print STDERR "Cannot create local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+#    while (<NS>) {
+#        print FH ;
+#    }
+
+	local( $start_time ) = time;
+	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
+	while( ($len = &ftp'read()) > 0 ){
+		$bytes += $len;
+		if( $strip_cr ){
+			$ftp'buf =~ s/\r//g;
+		}
+		if( $ftp_show ){
+			while( $bytes > ($lasthash + $ftp'hashevery) ){
+				print STDERR '#';
+				$lasthash += $ftp'hashevery;
+				$hashes++;
+				if( ($hashes % $ftp'hashnl) == 0 ){
+					print STDERR "\n";
+				}
+			}
+		}
+		if( ! print FH $ftp'buf ){
+			print STDERR "\nfailed to write data";
+			return 0;
+		}
+	}
+	close( FH );
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( $len < 0 ){
+		print STDERR "\ntimed out reading data!\n";
+
+		return 0;
+	}
+		
+	if( $ftp_show ){
+		if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
+			print STDERR "\n";
+		}
+		local( $secs ) = (time - $start_time);
+		if( $secs <= 0 ){
+			$secs = 1; # To avoid a divide by zero;
+		}
+
+		local( $rate ) = int( $bytes / $secs );
+		print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
+	}
+
+	#
+	# read the close
+	#
+
+	$ret = &ftp'expect($timeout, 
+		226, "Got file", 1,     # transfer complete, closing connection
+	        250, "Got file", 1,     # action completed
+	
+	        110, "restart not supported", 0,
+	        425, "can't open data connection", 0,
+	        426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+		421, "service unavailable, closing connection", 0);
+
+	return $ret;
+}
+
+sub ftp'delete
+{
+	local( $rem_fname, $val ) = @_;
+
+	&ftp'send("DELE $rem_fname" );
+	$val = &ftp'expect( $timeout, 
+			   250,"Deleted $rem_fname", 1,
+			   550,"Permission denied",0
+			   );
+	return $val == 1;
+}
+
+sub ftp'deldir
+{
+    local( $fname ) = @_;
+
+    # not yet implemented
+    # RMD
+}
+
+# UPDATE ME!!!!!!
+# Add in the hash printing and newline conversion
+sub ftp'put
+{
+	local( $loc_fname, $rem_fname ) = @_;
+	local( $strip_cr );
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	&ftp'send("STOR $rem_fname");
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	local( $ret ) =
+	&ftp'expect($timeout, 
+		150, "sending $loc_fname", 1,
+
+		125, "data connection already open?", 0,
+		450, "file unavailable", 0,
+
+		532, "need account for storing files", 0,
+		452, "insufficient storage on system", 0,
+		553, "file name not allowed", 0,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+
+	if( $ret != 1 ){
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+	
+	#
+	#  open the local fname
+	#
+	if( !open(FH, "<$loc_fname") ){
+		print STDERR "Cannot open local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+	
+	while (<FH>) {
+		print NS ;
+	}
+	close(FH);
+	
+	# shut down our end of the socket to signal EOF
+	&ftp'close_data_socket;
+	
+	#
+	# read the close
+	#
+	
+	$ret = &ftp'expect($timeout, 
+		226, "file put", 1,     # transfer complete, closing connection
+		250, "file put", 1,     # action completed
+	
+		110, "restart not supported", 0,
+		425, "can't open data connection", 0,
+		426, "connection closed, transfer aborted", 0,
+		451, "action aborted, local error", 0,
+		551, "page type unknown", 0,
+		552, "storage allocation exceeded", 0,
+	
+		421, "service unavailable, closing connection", 0);
+	if( ! $ret ){
+		print STDERR "error putting $loc_fname\n";
+	}
+	return $ret;
+}
+
+sub ftp'restart
+{
+	local( $restart_point, $ret ) = @_;
+
+	&ftp'send("REST $restart_point");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   350, "restarting at $restart_point", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "REST not implemented", 2,
+			   530, "not logged in", 0,
+			   554, "REST not implemented", 2,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+# Set the file transfer type
+sub ftp'type
+{
+	local( $type ) = @_;
+
+	&ftp'send("TYPE $type");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   200, "file type set to $type", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   504, "Invalid form or byte size for type $type", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+$site_command_check = 0;
+@site_command_list = ();
+
+# routine to query the remote server for 'SITE' commands supported
+sub ftp'site_commands
+{
+	local( $ret );
+	
+	# if we havent sent a 'HELP SITE', send it now
+	if( !$site_command_check ){
+	
+		$site_command_check = 1;
+	
+		&ftp'send( "HELP SITE" );
+	
+		# assume the line in the HELP SITE response with the 'HELP'
+		# command is the one for us
+		$ret = &ftp'expect( $timeout,
+			".*HELP.*", "", "\$1",
+			214, "", "0",
+			202, "", "0" );
+	
+		if( $ret eq "0" ){
+			print STDERR "No response from HELP SITE\n" if( $ftp_show );
+		}
+	
+		@site_command_list = split(/\s+/, $ret);
+	}
+	
+	return @site_command_list;
+}
+
+# return the pwd, or null if we can't get the pwd
+sub ftp'pwd
+{
+	local( $ret, $cwd );
+
+	&ftp'send( "PWD" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "working dir is", 1,
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "PWD not implemented", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	if( $ret ){
+		if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
+			$cwd = $1;
+		}
+	}
+	return $cwd;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'mkdir
+{
+	local( $path ) = @_;
+	local( $ret );
+
+	&ftp'send( "MKD $path" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "made directory $path", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "MKD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'chmod
+{
+	local( $path, $mode ) = @_;
+	local( $ret );
+
+	&ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   200, "chmod $mode $path succeeded", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "CHMOD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# rename a file
+sub ftp'rename
+{
+	local( $old_name, $new_name ) = @_;
+	local( $ret );
+
+	&ftp'send( "RNFR $old_name" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   350, "", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "RNFR not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+	                   450, "file unavailable", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+
+
+	# check if the "rename from" occurred ok
+	if( $ret ) {
+		&ftp'send( "RNTO $new_name" );
+	
+		# 
+		# see what they say
+	
+		$ret = &ftp'expect( $timeout, 
+			           250, "rename $old_name to $new_name", 1, 
+
+				   500, "syntax error", 0,
+				   501, "syntax error", 0,
+				   502, "RNTO not implemented", 0,
+				   503, "bad sequence of commands", 0,
+				   530, "not logged in", 0,
+		                   532, "need account for storing files", 0,
+		                   553, "file name not allowed", 0,
+				   
+				   421, "service unavailable, closing connection", 0);
+	}
+
+	return $ret;
+}
+
+
+sub ftp'quote
+{
+      local( $cmd ) = @_;
+
+      &ftp'send( $cmd );
+
+      return &ftp'expect( $timeout, 
+              200, "Remote '$cmd' OK", 1,
+              500, "error in remote '$cmd'", 0 );
+}
+
+# ------------------------------------------------------------------------------
+# These are the lower level support routines
+
+sub ftp'expectgot
+{
+	($ftp'response, $ftp'fatalerror) = @_;
+	if( $ftp_show ){
+		print STDERR "$ftp'response\n";
+	}
+}
+
+#
+#  create the list of parameters for chat'expect
+#
+#  ftp'expect(time_out, {value, string_to_print, return value});
+#     if the string_to_print is "" then nothing is printed
+#  the last response is stored in $ftp'response
+#
+# NOTE: lmjm has changed this code such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+#
+sub ftp'expect {
+	local( $ret );
+	local( $time_out );
+	local( $expect_args );
+	
+	$ftp'response = '';
+	$ftp'fatalerror = 0;
+
+	@expect_args = ();
+	
+	$time_out = shift(@_);
+	
+	while( @_ ){
+		local( $code ) = shift( @_ );
+		local( $pre ) = '^';
+		if( $code =~ /^\d/ ){
+			$pre =~ "[.|\n]*^";
+		}
+		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
+		shift( @_ );
+		push( @expect_args, 
+			"&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
+	}
+	
+	# Treat all unrecognised lines as continuations
+	push( @expect_args, "^(.*)\\015\\n" );
+	push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
+	
+	# add patterns TIMEOUT and EOF
+	
+	push( @expect_args, 'TIMEOUT' );
+	push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
+	
+	push( @expect_args, 'EOF' );
+	push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
+	
+	if( $ftp_show > 9 ){
+		&printargs( $time_out, @expect_args );
+	}
+	
+	$ret = &chat'expect( $time_out, @expect_args );
+	if( $ret == 100 ){
+		# we saw a continuation line, wait for the end
+		push( @expect_args, "^.*\n" );
+		push( @expect_args, "100" );
+	
+		while( $ret == 100 ){
+			$ret = &chat'expect( $time_out, @expect_args );
+		}
+	}
+	
+	return $ret;
+}
+
+#
+#  opens NS for io
+#
+sub ftp'open_data_socket
+{
+	local( $ret );
+	local( $hostname );
+	local( $sockaddr, $name, $aliases, $proto, $port );
+	local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
+	local( $mysockaddr, $family, $hi, $lo );
+	
+	
+	$sockaddr = 'S n a4 x8';
+	chop( $hostname = `hostname` );
+	
+	$port = "ftp";
+	
+	($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	($name, $aliases, $port) = getservbyname( $port, 'tcp' );
+	
+#	($name, $aliases, $type, $len, $thisaddr) =
+#	gethostbyname( $hostname );
+	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
+	
+#	$this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
+	$this = $chat'thisproc;
+	
+	socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
+	bind(S, $this) || die "bind: $!";
+	
+	# get the port number
+	$mysockaddr = getsockname(S);
+	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
+	
+	$hi = ($port >> 8) & 0x00ff;
+	$lo = $port & 0x00ff;
+	
+	#
+	# we MUST do a listen before sending the port otherwise
+	# the PORT may fail
+	#
+	listen( S, 5 ) || die "listen";
+	
+	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
+	
+	return &ftp'expect($timeout,
+		200, "PORT command successful", 1,
+		250, "PORT command successful", 1 ,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+}
+	
+sub ftp'close_data_socket
+{
+	close(NS);
+}
+
+sub ftp'send
+{
+	local($send_cmd) = @_;
+	if( $send_cmd =~ /\n/ ){
+		print STDERR "ERROR, \\n in send string for $send_cmd\n";
+	}
+	
+	if( $ftp_show ){
+		local( $sc ) = $send_cmd;
+
+		if( $send_cmd =~ /^PASS/){
+			$sc = "PASS <somestring>";
+		}
+		print STDERR "---> $sc\n";
+	}
+	
+	&chat'print( "$send_cmd\r\n" );
+}
+
+sub ftp'printargs
+{
+	while( @_ ){
+		print STDERR shift( @_ ) . "\n";
+	}
+}
+
+sub ftp'filesize
+{
+	local( $fname ) = @_;
+
+	if( ! -f $fname ){
+		return -1;
+	}
+
+	return (stat( _ ))[ 7 ];
+	
+}
+
+# make this package return true
+1;
diff --git a/gnu/usr.bin/perl/lib/getcwd.pl b/gnu/usr.bin/perl/lib/getcwd.pl
new file mode 100644
index 00000000000..8db8e20c069
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getcwd.pl
@@ -0,0 +1,62 @@
+# By Brandon S. Allbery
+#
+# Usage: $cwd = &getcwd;
+
+sub getcwd
+{
+    local($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat('.'))
+    {
+	warn "stat(.): $!";
+	return '';
+    }
+    $cwd = '';
+    do
+    {
+	$dotdots .= '/' if $dotdots;
+	$dotdots .= '..';
+	@pst = @cst;
+	unless (opendir(getcwd'PARENT, $dotdots))			#'))
+	{
+	    warn "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    warn "stat($dotdots): $!";
+	    closedir(getcwd'PARENT);					#');
+	    return '';
+	}
+	if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
+	{
+	    $dir = '';
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
+		{
+		    warn "readdir($dotdots): $!";
+		    closedir(getcwd'PARENT);				#');
+		    return '';
+		}
+		unless (@tst = lstat("$dotdots/$dir"))
+		{
+		    warn "lstat($dotdots/$dir): $!";
+		    closedir(getcwd'PARENT);				#');
+		    return '';
+		}
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
+		   $tst[$[ + 1] != $pst[$[ + 1]);
+	}
+	$cwd = "$dir/$cwd";
+	closedir(getcwd'PARENT);					#');
+    } while ($dir);
+    chop($cwd);
+    $cwd;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/getopt.pl b/gnu/usr.bin/perl/lib/getopt.pl
new file mode 100644
index 00000000000..a6023c80bc9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getopt.pl
@@ -0,0 +1,41 @@
+;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+
+;# Process single-character switches with switch clustering.  Pass one argument
+;# which is a string containing all switches that take an argument.  For each
+;# switch found, sets $opt_x (where x is the switch name) to the value of the
+;# argument, or 1 if no argument.  Switches which take an argument don't care
+;# whether there is a space between the switch and the argument.
+
+;# Usage:
+;#	do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+sub Getopt {
+    local($argumentative) = @_;
+    local($_,$first,$rest);
+    local($[) = 0;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	if (index($argumentative,$first) >= $[) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+	    eval "\$opt_$first = \$rest;";
+	}
+	else {
+	    eval "\$opt_$first = 1;";
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/getopts.pl b/gnu/usr.bin/perl/lib/getopts.pl
new file mode 100644
index 00000000000..a0818d1e3a0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getopts.pl
@@ -0,0 +1,50 @@
+;# getopts.pl - a better getopt.pl
+
+;# Usage:
+;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
+;#                           #  side effect.
+
+sub Getopts {
+    local($argumentative) = @_;
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local($[) = 0;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	$pos = index($argumentative,$first);
+	if($pos >= $[) {
+	    if($args[$pos+1] eq ':') {
+		shift(@ARGV);
+		if($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		eval "\$opt_$first = \$rest;";
+	    }
+	    else {
+		eval "\$opt_$first = 1";
+		if($rest eq '') {
+		    shift(@ARGV);
+		}
+		else {
+		    $ARGV[0] = "-$rest";
+		}
+	    }
+	}
+	else {
+	    print STDERR "Unknown option: $first\n";
+	    ++$errs;
+	    if($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $errs == 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/hostname.pl b/gnu/usr.bin/perl/lib/hostname.pl
new file mode 100644
index 00000000000..5394c6ec693
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/hostname.pl
@@ -0,0 +1,23 @@
+# From: asherman@fmrco.com (Aaron Sherman)
+
+sub hostname
+{
+	local(*P,@tmp,$hostname,$_);
+	if (open(P,"hostname 2>&1 |") && (@tmp = <P>) && close(P))
+	{
+		chop($hostname = $tmp[$#tmp]);
+	}
+	elsif (open(P,"uname -n 2>&1 |") && (@tmp = <P>) && close(P))
+	{
+		chop($hostname = $tmp[$#tmp]);
+	}
+	else
+	{
+		die "$0: Cannot get hostname from 'hostname' or 'uname -n'\n";
+	}
+	@tmp = ();
+	close P; # Just in case we failed in an odd spot....
+	$hostname;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/importenv.pl b/gnu/usr.bin/perl/lib/importenv.pl
new file mode 100644
index 00000000000..d56f32633b8
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/importenv.pl
@@ -0,0 +1,16 @@
+;# $RCSfile: importenv.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:02 $
+
+;# This file, when interpreted, pulls the environment into normal variables.
+;# Usage:
+;#	require 'importenv.pl';
+;# or
+;#	#include <importenv.pl>
+
+local($tmp,$key) = '';
+
+foreach $key (keys(ENV)) {
+    $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
+}
+eval $tmp;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/integer.pm b/gnu/usr.bin/perl/lib/integer.pm
new file mode 100644
index 00000000000..a88ce6a77c8
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/integer.pm
@@ -0,0 +1,32 @@
+package integer;
+
+=head1 NAME
+
+integer - Perl pragma to compute arithmetic in integer instead of double
+
+=head1 SYNOPSIS
+
+    use integer;
+    $x = 10/3;
+    # $x is now 3, not 3.33333333333333333
+
+=head1 DESCRIPTION
+
+This tells the compiler that it's okay to use integer operations
+from here to the end of the enclosing BLOCK.  On many machines, 
+this doesn't matter a great deal for most computations, but on those 
+without floating point hardware, it can make a big difference.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+sub import {
+    $^H |= 1;
+}
+
+sub unimport {
+    $^H &= ~1;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/less.pm b/gnu/usr.bin/perl/lib/less.pm
new file mode 100644
index 00000000000..b3afef0fcdc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/less.pm
@@ -0,0 +1,23 @@
+package less;
+
+=head1 NAME
+
+less - perl pragma to request less of something from the compiler
+
+=head1 SYNOPSIS
+
+    use less;  # unimplemented
+
+=head1 DESCRIPTION
+
+Currently unimplemented, this may someday be a compiler directive
+to make certain trade-offs, such as perhaps
+
+    use less 'memory';
+    use less 'CPU';
+    use less 'fat';
+
+
+=cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/lib.pm b/gnu/usr.bin/perl/lib/lib.pm
new file mode 100644
index 00000000000..546ae87b891
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/lib.pm
@@ -0,0 +1,128 @@
+package lib;
+
+use Config;
+
+my $archname = $Config{'archname'};
+
+@ORIG_INC = ();		# (avoid typo warning)
+@ORIG_INC = @INC;	# take a handy copy of 'original' value
+
+
+sub import {
+    shift;
+    foreach (reverse @_) {
+	unshift(@INC, $_);
+	# Put a corresponding archlib directory infront of $_ if it
+	# looks like $_ has an archlib directory below it.
+	unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
+    }
+}
+
+
+sub unimport {
+    shift;
+    my $mode = shift if $_[0] =~ m/^:[A-Z]+/;
+
+    my %names;
+    foreach(@_) {
+	++$names{$_};
+	++$names{"$_/$archname"} if -d "$_/$archname/auto";
+    }
+
+    if ($mode and $mode eq ':ALL') {
+	# Remove ALL instances of each named directory.
+	@INC = grep { !exists $names{$_} } @INC;
+    } else {
+	# Remove INITIAL instance(s) of each named directory.
+	@INC = grep { --$names{$_} < 0   } @INC;
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+lib - manipulate @INC at compile time
+
+=head1 SYNOPSIS
+
+    use lib LIST;
+
+    no lib LIST;
+
+=head1 DESCRIPTION
+
+This is a small simple module which simplifies the manipulation of @INC
+at compile time.
+
+It is typically used to add extra directories to perl's search path so
+that later C<use> or C<require> statements will find modules which are
+not located on perl's default search path.
+
+
+=head2 ADDING DIRECTORIES TO @INC
+
+The parameters to C<use lib> are added to the start of the perl search
+path. Saying
+
+    use lib LIST;
+
+is I<almost> the same as saying
+
+    BEGIN { unshift(@INC, LIST) }
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is added to @INC in front of $dir.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be added to @INC twice (if $dir/$archname/auto exists).
+
+
+=head2 DELETING DIRECTORIES FROM @INC
+
+You should normally only add directories to @INC.  If you need to
+delete directories from @INC take care to only delete those which you
+added yourself or which you are certain are not needed by other modules
+in your script.  Other modules may have added directories which they
+need for correct operation.
+
+By default the C<no lib> statement deletes the I<first> instance of
+each named directory from @INC.  To delete multiple instances of the
+same name from @INC you can specify the name multiple times.
+
+To delete I<all> instances of I<all> the specified names from @INC you can
+specify ':ALL' as the first parameter of C<no lib>. For example:
+
+    no lib qw(:ALL .);
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is also deleted from @INC.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be deleted from @INC twice (if $dir/$archname/auto exists).
+
+
+=head2 RESTORING ORIGINAL @INC
+
+When the lib module is first loaded it records the current value of @INC
+in an array C<@lib::ORIG_INC>. To restore @INC to that value you
+can say
+
+    @INC = @lib::ORIG_INC;
+
+
+=head1 SEE ALSO
+
+AddINC - optional module which deals with paths relative to the source file.
+
+=head1 AUTHOR
+
+Tim Bunce, 2nd June 1995.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/look.pl b/gnu/usr.bin/perl/lib/look.pl
new file mode 100644
index 00000000000..4c14e64727a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/look.pl
@@ -0,0 +1,44 @@
+;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
+
+;# Sets file position in FILEHANDLE to be first line greater than or equal
+;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
+
+sub look {
+    local(*FH,$key,$dict,$fold) = @_;
+    local($max,$min,$mid,$_);
+    local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat(FH);
+    $blksize = 8192 unless $blksize;
+    $key =~ s/[^\w\s]//g if $dict;
+    $key =~ y/A-Z/a-z/ if $fold;
+    $max = int($size / $blksize);
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH,$mid * $blksize,0);
+	$_ = <FH> if $mid;		# probably a partial line
+	$_ = <FH>;
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	if ($_ lt $key) {
+	    $min = $mid;
+	}
+	else {
+	    $max = $mid;
+	}
+    }
+    $min *= $blksize;
+    seek(FH,$min,0);
+    <FH> if $min;
+    while (<FH>) {
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	last if $_ ge $key;
+	$min = tell(FH);
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/newgetopt.pl b/gnu/usr.bin/perl/lib/newgetopt.pl
new file mode 100644
index 00000000000..38cad59c73e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/newgetopt.pl
@@ -0,0 +1,58 @@
+# newgetopt.pl -- new options parsing.
+# Now just a wrapper around the Getopt::Long module.
+# $Id: newgetopt.pl,v 1.15 1995/12/26 14:57:33 jv Exp $
+
+{   package newgetopt;
+
+    # Values for $order. See GNU getopt.c for details.
+    $REQUIRE_ORDER = 0;
+    $PERMUTE = 1;
+    $RETURN_IN_ORDER = 2;
+
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$autoabbrev = 0;	# no automatic abbrev of options (???)
+	$getopt_compat = 0;	# disallow '+' to start options
+	$option_start = "(--|-)";
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$autoabbrev = 1;	# automatic abbrev of options
+	$getopt_compat = 1;	# allow '+' to start options
+	$option_start = "(--|-|\\+)";
+	$order = $PERMUTE;
+    }
+
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $ignorecase = 1;		# ignore case when matching options
+    $argv_end = "--";		# don't change this!
+}
+
+use Getopt::Long;
+
+################ Subroutines ################
+
+sub NGetOpt {
+
+    $Getopt::Long::debug = $newgetopt::debug 
+	if defined $newgetopt::debug;
+    $Getopt::Long::autoabbrev = $newgetopt::autoabbrev 
+	if defined $newgetopt::autoabbrev;
+    $Getopt::Long::getopt_compat = $newgetopt::getopt_compat 
+	if defined $newgetopt::getopt_compat;
+    $Getopt::Long::option_start = $newgetopt::option_start 
+	if defined $newgetopt::option_start;
+    $Getopt::Long::order = $newgetopt::order 
+	if defined $newgetopt::order;
+    $Getopt::Long::ignorecase = $newgetopt::ignorecase 
+	if defined $newgetopt::ignorecase;
+
+    &GetOptions;
+}
+
+################ Package return ################
+
+1;
+
+################ End of newgetopt.pl ################
diff --git a/gnu/usr.bin/perl/lib/open2.pl b/gnu/usr.bin/perl/lib/open2.pl
new file mode 100644
index 00000000000..dcd68a8cd3a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/open2.pl
@@ -0,0 +1,54 @@
+# &open2: tom christiansen, <tchrist@convex.com>
+#
+# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
+#    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#
+# spawn the given $cmd and connect $rdr for
+# reading and $wtr for writing.  return pid
+# of child, or 0 on failure.  
+# 
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.  
+# 
+# $wtr is left unbuffered.
+# 
+# abort program if
+#	rdr or wtr are null
+# 	pipe or fork or exec fails
+
+package open2;
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub main'open2 {
+    local($kidpid);
+    local($dad_rdr, $dad_wtr, @cmd) = @_;
+
+    $dad_rdr ne '' 		|| die "open2: rdr should not be null";
+    $dad_wtr ne '' 		|| die "open2: wtr should not be null";
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_rdr =~ s/^[^']+$/$package'$&/;
+    $dad_wtr =~ s/^[^']+$/$package'$&/;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+
+    pipe($dad_rdr, $kid_wtr) 	|| die "open2: pipe 1 failed: $!";
+    pipe($kid_rdr, $dad_wtr) 	|| die "open2: pipe 2 failed: $!";
+
+    if (($kidpid = fork) < 0) {
+	die "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	close $dad_rdr; close $dad_wtr;
+	open(STDIN,  "<&$kid_rdr");
+	open(STDOUT, ">&$kid_wtr");
+	warn "execing @cmd\n" if $debug;
+	exec @cmd;
+	die "open2: exec of @cmd failed";   
+    } 
+    close $kid_rdr; close $kid_wtr;
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
diff --git a/gnu/usr.bin/perl/lib/open3.pl b/gnu/usr.bin/perl/lib/open3.pl
new file mode 100644
index 00000000000..7c8b6ae2884
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/open3.pl
@@ -0,0 +1,106 @@
+# &open3: Marc Horowitz <marc@mit.edu>
+# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+#
+# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
+#
+# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
+#
+# spawn the given $cmd and connect rdr for
+# reading, wtr for writing, and err for errors.
+# if err is '', or the same as rdr, then stdout and
+# stderr of the child are on the same fh.  returns pid
+# of child, or 0 on failure.
+
+
+# if wtr begins with '>&', then wtr will be closed in the parent, and
+# the child will read from it directly.  if rdr or err begins with
+# '>&', then the child will send output directly to that fd.  In both
+# cases, there will be a dup() instead of a pipe() made.
+
+
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.
+#
+# $wtr is left unbuffered.
+#
+# abort program if
+#   rdr or wtr are null
+#   pipe or fork or exec fails
+
+package open3;
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub main'open3 {
+    local($kidpid);
+    local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    local($dup_wtr, $dup_rdr, $dup_err);
+
+    $dad_wtr			|| die "open3: wtr should not be null";
+    $dad_rdr			|| die "open3: rdr should not be null";
+    $dad_err = $dad_rdr if ($dad_err eq '');
+
+    $dup_wtr = ($dad_wtr =~ s/^\>\&//);
+    $dup_rdr = ($dad_rdr =~ s/^\>\&//);
+    $dup_err = ($dad_err =~ s/^\>\&//);
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_wtr =~ s/^[^']+$/$package'$&/;
+    $dad_rdr =~ s/^[^']+$/$package'$&/;
+    $dad_err =~ s/^[^']+$/$package'$&/;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+    local($kid_err) = ++$fh;
+
+    if (!$dup_wtr) {
+	pipe($kid_rdr, $dad_wtr)    || die "open3: pipe 1 (stdin) failed: $!";
+    }
+    if (!$dup_rdr) {
+	pipe($dad_rdr, $kid_wtr)    || die "open3: pipe 2 (stdout) failed: $!";
+    }
+    if ($dad_err ne $dad_rdr && !$dup_err) {
+	pipe($dad_err, $kid_err)    || die "open3: pipe 3 (stderr) failed: $!";
+    }
+
+    if (($kidpid = fork) < 0) {
+        die "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	if ($dup_wtr) {
+	    open(STDIN,  ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	} else {
+	    close($dad_wtr);
+	    open(STDIN,  ">&$kid_rdr");
+	}
+	if ($dup_rdr) {
+	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
+	} else {
+	    close($dad_rdr);
+	    open(STDOUT, ">&$kid_wtr");
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+		open(STDERR, ">&$dad_err")
+		    if (fileno(STDERR) != fileno($dad_err));
+	    } else {
+		close($dad_err);
+		open(STDERR, ">&$kid_err");
+	    }
+	} else {
+	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
+	}
+	local($")=(" ");
+	exec @cmd;
+        die "open2: exec of @cmd failed";
+    }
+
+    close $kid_rdr; close $kid_wtr; close $kid_err;
+    if ($dup_wtr) {
+	close($dad_wtr);
+    }
+
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm
new file mode 100644
index 00000000000..54d2cbb4411
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/overload.pm
@@ -0,0 +1,489 @@
+package overload;
+
+sub OVERLOAD {
+  $package = shift;
+  my %arg = @_;
+  my $hash = \%{$package . "::OVERLOAD"};
+  for (keys %arg) {
+    $hash->{$_} = $arg{$_};
+  }
+}
+
+sub import {
+  $package = (caller())[0];
+  # *{$package . "::OVERLOAD"} = \&OVERLOAD;
+  shift;
+  $package->overload::OVERLOAD(@_);
+}
+
+sub unimport {
+  $package = (caller())[0];
+  my $hash = \%{$package . "::OVERLOAD"};
+  shift;
+  for (@_) {
+    delete $hash->{$_};
+  }
+}
+
+sub Overloaded {
+  defined ($package = ref $_[0]) and defined %{$package . "::OVERLOAD"};
+}
+
+sub OverloadedStringify {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      exists $ {$package . "::OVERLOAD"}{'""'} and
+	defined &{$ {$package . "::OVERLOAD"}{'""'}};
+}
+
+sub Method {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      $ {$package . "::OVERLOAD"}{$_[1]};
+}
+
+sub AddrRef {
+  $package = ref $_[0];
+  bless $_[0], Overload::Fake;	# Non-overloaded package
+  my $str = "$_[0]";
+  bless $_[0], $package;	# Back
+  $str;
+}
+
+sub StrVal {
+  (OverloadedStringify) ?
+    (AddrRef) :
+    "$_[0]";
+}
+
+1;
+
+__END__
+
+=head1 NAME 
+
+overload - Package for overloading perl operations
+
+=head1 SYNOPSIS
+
+    package SomeThing;
+
+    use overload 
+	'+' => \&myadd,
+	'-' => \&mysub;
+	# etc
+    ...
+
+    package main;
+    $a = new SomeThing 57;
+    $b=5+$a;
+    ...
+    if (overload::Overloaded $b) {...}
+    ...
+    $strval = overload::StrVal $b;
+
+=head1 CAVEAT SCRIPTOR
+
+Overloading of operators is a subject not to be taken lightly.
+Neither its precise implementation, syntax, nor semantics are
+100% endorsed by Larry Wall.  So any of these may be changed 
+at some point in the future.
+
+=head1 DESCRIPTION
+
+=head2 Declaration of overloaded functions
+
+The compilation directive
+
+    package Number;
+    use overload
+	"+" => \&add, 
+	"*=" => "muas";
+
+declares function Number::add() for addition, and method muas() in
+the "class" C<Number> (or one of its base classes)
+for the assignment form C<*=> of multiplication.  
+
+Arguments of this directive come in (key, value) pairs.  Legal values
+are values legal inside a C<&{ ... }> call, so the name of a subroutine,
+a reference to a subroutine, or an anonymous subroutine will all work.
+Legal keys are listed below.
+
+The subroutine C<add> will be called to execute C<$a+$b> if $a
+is a reference to an object blessed into the package C<Number>, or if $a is
+not an object from a package with defined mathemagic addition, but $b is a
+reference to a C<Number>.  It can also be called in other situations, like
+C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
+methods refer to methods triggered by an overloaded mathematical
+operator.)
+
+=head2 Calling Conventions for Binary Operations
+
+The functions specified in the C<use overload ...> directive are called
+with three (in one particular case with four, see L<Last Resort>)
+arguments.  If the corresponding operation is binary, then the first
+two arguments are the two arguments of the operation.  However, due to
+general object calling conventions, the first argument should always be
+an object in the package, so in the situation of C<7+$a>, the
+order of the arguments is interchanged.  It probably does not matter
+when implementing the addition method, but whether the arguments
+are reversed is vital to the subtraction method.  The method can
+query this information by examining the third argument, which can take
+three different values:
+
+=over 7
+
+=item FALSE
+
+the order of arguments is as in the current operation.
+
+=item TRUE
+
+the arguments are reversed.
+
+=item C<undef>
+
+the current operation is an assignment variant (as in
+C<$a+=7>), but the usual function is called instead.  This additional
+information can be used to generate some optimizations.
+
+=back
+
+=head2 Calling Conventions for Unary Operations
+
+Unary operation are considered binary operations with the second
+argument being C<undef>.  Thus the functions that overloads C<{"++"}>
+is called with arguments C<($a,undef,'')> when $a++ is executed.
+
+=head2 Overloadable Operations
+
+The following symbols can be specified in C<use overload>:
+
+=over 5
+
+=item * I<Arithmetic operations>
+
+    "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
+    "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
+
+For these operations a substituted non-assignment variant can be called if
+the assignment variant is not available.  Methods for operations "C<+>",
+"C<->", "C<+=>", and "C<-=>" can be called to automatically generate
+increment and decrement methods.  The operation "C<->" can be used to
+autogenerate missing methods for unary minus or C<abs>.
+
+=item * I<Comparison operations>
+
+    "<",  "<=", ">",  ">=", "==", "!=", "<=>",
+    "lt", "le", "gt", "ge", "eq", "ne", "cmp",
+
+If the corresponding "spaceship" variant is available, it can be
+used to substitute for the missing operation.  During C<sort>ing
+arrays, C<cmp> is used to compare values subject to C<use overload>.
+
+=item * I<Bit operations>
+
+    "&", "^", "|", "neg", "!", "~",
+
+"C<neg>" stands for unary minus.  If the method for C<neg> is not
+specified, it can be autogenerated using the method for subtraction.
+
+=item * I<Increment and decrement>
+
+    "++", "--",
+
+If undefined, addition and subtraction methods can be
+used instead.  These operations are called both in prefix and
+postfix form.
+
+=item * I<Transcendental functions>
+
+    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt",
+
+If C<abs> is unavailable, it can be autogenerated using methods
+for "<" or "<=>" combined with either unary minus or subtraction.
+
+=item * I<Boolean, string and numeric conversion>
+
+    "bool", "\"\"", "0+",
+
+If one or two of these operations are unavailable, the remaining ones can
+be used instead.  C<bool> is used in the flow control operators
+(like C<while>) and for the ternary "C<?:>" operation.  These functions can
+return any arbitrary Perl value.  If the corresponding operation for this value
+is overloaded too, that operation will be called again with this value.
+
+=item * I<Special>
+
+    "nomethod", "fallback", "=",
+
+see L<SPECIAL SYMBOLS FOR C<use overload>>.
+
+=back
+
+See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
+
+=head1 SPECIAL SYMBOLS FOR C<use overload>
+
+Three keys are recognized by Perl that are not covered by the above
+description.
+
+=head2  Last Resort
+
+C<"nomethod"> should be followed by a reference to a function of four
+parameters.  If defined, it is called when the overloading mechanism
+cannot find a method for some operation.  The first three arguments of
+this function coincide with the arguments for the corresponding method if
+it were found, the fourth argument is the symbol
+corresponding to the missing method.  If several methods are tried,
+the last one is used.  Say, C<1-$a> can be equivalent to
+
+	&nomethodMethod($a,1,1,"-")
+
+if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
+C<use overload> directive.
+
+If some operation cannot be resolved, and there is no function
+assigned to C<"nomethod">, then an exception will be raised via die()--
+unless C<"fallback"> was specified as a key in C<use overload> directive.
+
+=head2 Fallback 
+
+The key C<"fallback"> governs what to do if a method for a particular
+operation is not found.  Three different cases are possible depending on
+the value of C<"fallback">:
+
+=over 16
+
+=item * C<undef>
+
+Perl tries to use a
+substituted method (see L<MAGIC AUTOGENERATION>).  If this fails, it
+then tries to calls C<"nomethod"> value; if missing, an exception
+will be raised.
+
+=item * TRUE
+
+The same as for the C<undef> value, but no exception is raised.  Instead,
+it silently reverts to what it would have done were there no C<use overload>
+present.
+
+=item * defined, but FALSE
+
+No autogeneration is tried.  Perl tries to call
+C<"nomethod"> value, and if this is missing, raises an exception. 
+
+=back
+
+=head2 Copy Constructor
+
+The value for C<"="> is a reference to a function with three
+arguments, i.e., it looks like the other values in C<use
+overload>. However, it does not overload the Perl assignment
+operator. This would go against Camel hair.
+
+This operation is called in the situations when a mutator is applied
+to a reference that shares its object with some other reference, such
+as
+
+	$a=$b; 
+	$a++;
+
+To make this change $a and not change $b, a copy of C<$$a> is made,
+and $a is assigned a reference to this new object.  This operation is
+done during execution of the C<$a++>, and not during the assignment,
+(so before the increment C<$$a> coincides with C<$$b>).  This is only
+done if C<++> is expressed via a method for C<'++'> or C<'+='>.  Note
+that if this operation is expressed via C<'+'> a nonmutator, i.e., as
+in
+
+	$a=$b; 
+	$a=$a+1;
+
+then C<$a> does not reference a new copy of C<$$a>, since $$a does not
+appear as lvalue when the above code is executed.
+
+If the copy constructor is required during the execution of some mutator,
+but a method for C<'='> was not specified, it can be autogenerated as a
+string copy if the object is a plain scalar.
+
+=over 5
+
+=item B<Example>
+
+The actually executed code for 
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	++$a;
+
+may be
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	$a = $a->clone(undef,"");
+        $a->incr(undef,"");
+
+if $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
+C<'='> was overloaded with C<\&clone>.
+
+=back
+
+=head1 MAGIC AUTOGENERATION
+
+If a method for an operation is not found, and the value for  C<"fallback"> is
+TRUE or undefined, Perl tries to autogenerate a substitute method for
+the missing operation based on the defined operations.  Autogenerated method
+substitutions are possible for the following operations:
+
+=over 16
+
+=item I<Assignment forms of arithmetic operations>
+
+C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
+is not defined.
+
+=item I<Conversion operations> 
+
+String, numeric, and boolean conversion are calculated in terms of one
+another if not all of them are defined.
+
+=item I<Increment and decrement>
+
+The C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
+and C<$a--> in terms of C<$a-=1> and C<$a-1>.
+
+=item C<abs($a)>
+
+can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
+
+=item I<Unary minus>
+
+can be expressed in terms of subtraction.
+
+=item I<Concatenation>
+
+can be expressed in terms of string conversion.
+
+=item I<Comparison operations> 
+
+can be expressed in terms of its "spaceship" counterpart: either
+C<E<lt>=E<gt>> or C<cmp>:
+ 
+    <, >, <=, >=, ==, != 	in terms of <=>
+    lt, gt, le, ge, eq, ne 	in terms of cmp
+
+=item I<Copy operator>
+
+can be expressed in terms of an assignment to the dereferenced value, if this
+value is a scalar and not a reference.
+
+=back
+
+=head1 WARNING
+
+The restriction for the comparison operation is that even if, for example,
+`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
+function will produce only a standard logical value based on the
+numerical value of the result of `C<cmp>'.  In particular, a working
+numeric conversion is needed in this case (possibly expressed in terms of
+other conversions).
+
+Similarly, C<.=>  and C<x=> operators lose their mathemagical properties
+if the string conversion substitution is applied.
+
+When you chop() a mathemagical object it is promoted to a string and its
+mathemagical properties are lost.  The same can happen with other
+operations as well.
+
+=head1 Run-time Overloading
+
+Since all C<use> directives are executed at compile-time, the only way to
+change overloading during run-time is to
+
+    eval 'use overload "+" => \&addmethod';
+
+You can also use
+
+    eval 'no overload "+", "--", "<="';
+
+though the use of these constructs during run-time is questionable.
+
+=head1 Public functions
+
+Package C<overload.pm> provides the following public functions:
+
+=over 5
+
+=item overload::StrVal(arg)
+
+Gives string value of C<arg> as in absence of stringify overloading.
+
+=item overload::Overloaded(arg)
+
+Returns true if C<arg> is subject to overloading of some operations.
+
+=item overload::Method(obj,op)
+
+Returns C<undef> or a reference to the method that implements C<op>.
+
+=back
+
+=head1 IMPLEMENTATION
+
+What follows is subject to change RSN.
+
+The table of methods for all operations is cached as magic in the
+symbol table hash for the package.  The table is rechecked for changes due to
+C<use overload>, C<no overload>, and @ISA only during
+C<bless>ing; so if they are changed dynamically, you'll need an
+additional fake C<bless>ing to update the table.
+
+(Every SVish thing has a magic queue, and magic is an entry in that queue.
+This is how a single variable may participate in multiple forms of magic
+simultaneously.  For instance, environment variables regularly have two
+forms at once: their %ENV magic and their taint magic.)
+
+If an object belongs to a package using overload, it carries a special
+flag.  Thus the only speed penalty during arithmetic operations without
+overloading is the checking of this flag.
+
+In fact, if C<use overload> is not present, there is almost no overhead for
+overloadable operations, so most programs should not suffer measurable
+performance penalties.  A considerable effort was made to minimize the overhead
+when overload is used and the current operation is overloadable but
+the arguments in question do not belong to packages using overload.  When
+in doubt, test your speed with C<use overload> and without it.  So far there
+have been no reports of substantial speed degradation if Perl is compiled
+with optimization turned on.
+
+There is no size penalty for data if overload is not used. 
+
+Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is 
+carried out before any operation that can imply an assignment to the
+object $a (or $b) refers to, like C<$a++>.  You can override this
+behavior by defining your own copy constructor (see L<"Copy Constructor">).
+
+It is expected that arguments to methods that are not explicitly supposed
+to be changed are constant (but this is not enforced).
+
+=head1 AUTHOR
+
+Ilya Zakharevich <F<ilya@math.mps.ohio-state.edu>>.
+
+=head1 DIAGNOSTICS
+
+When Perl is run with the B<-Do> switch or its equivalent, overloading
+induces diagnostic messages.
+
+=head1 BUGS
+
+Because it is used for overloading, the per-package associative array
+%OVERLOAD now has a special meaning in Perl.
+
+As shipped, mathemagical properties are not inherited via the @ISA tree.
+
+This document is confusing.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl
new file mode 100644
index 00000000000..5c8d2727b72
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/perl5db.pl
@@ -0,0 +1,1446 @@
+package DB;
+
+# Debugger for Perl 5.00x; perl5db.pl patch level:
+
+$header = 'perl5db.pl patch level 0.94';
+
+# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
+# Latest version available: ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
+
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+# Johan Vromans -- upgrade to 4.0 pl 10
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+#
+# This file is automatically included if you do perl -d.
+# It's probably not useful to include this yourself.
+#
+# Perl supplies the values for @line and %sub.  It effectively inserts
+# a &DB'DB(<linenum>); in front of every place that can have a
+# breakpoint. Instead of a subroutine call it calls &DB::sub with
+# $DB::sub being the called subroutine. It also inserts a BEGIN
+# {require 'perl5db.pl'} before the first line.
+#
+# Note that no subroutine call is possible until &DB::sub is defined
+# (for subroutines defined outside this file). In fact the same is
+# true if $deep is not defined.
+#
+# $Log:	perldb.pl,v $
+
+#
+# At start reads $rcfile that may set important options.  This file
+# may define a subroutine &afterinit that will be executed after the
+# debugger is initialized.
+#
+# After $rcfile is read reads environment variable PERLDB_OPTS and parses
+# it as a rest of `O ...' line in debugger prompt.
+#
+# The options that can be specified only at startup:
+# [To set in $rcfile, call &parse_options("optionName=new_value").]
+#
+# TTY  - the TTY to use for debugging i/o.
+#
+# noTTY - if set, goes in NonStop mode.  On interrupt if TTY is not set
+# uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
+# Term::Rendezvous.  Current variant is to have the name of TTY in this
+# file.
+#
+# ReadLine - If false, dummy ReadLine is used, so you can debug
+# ReadLine applications.
+#
+# NonStop - if true, no i/o is performed until interrupt.
+#
+# LineInfo - file or pipe to print line number info to.  If it is a
+# pipe, a short "emacs like" message is used.
+#
+# Example $rcfile: (delete leading hashes!)
+#
+# &parse_options("NonStop=1 LineInfo=db.out");
+# sub afterinit { $trace = 1; }
+#
+# The script will run without human intervention, putting trace
+# information into db.out.  (If you interrupt it, you would better
+# reset LineInfo to something "interactive"!)
+#
+
+# Needed for the statement after exec():
+
+BEGIN { $ini_warn = $^W; $^W = 0 } # Switch compilation warnings off until another BEGIN.
+local($^W) = 0;			# Switch run-time warnings off during init.
+warn (			# Do not ;-)
+      $dumpvar::hashDepth,     
+      $dumpvar::arrayDepth,    
+      $dumpvar::dumpDBFiles,   
+      $dumpvar::dumpPackages,  
+      $dumpvar::quoteHighBit,  
+      $dumpvar::printUndef,    
+      $dumpvar::globPrint,     
+      $readline::Tk_toloop,    
+      $dumpvar::usageOnly,
+      @ARGS,
+      $Carp::CarpLevel,
+      $panic,
+      $first_time,
+     ) if 0;
+
+# Command-line + PERLLIB:
+@ini_INC = @INC;
+
+# $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!
+
+$trace = $signal = $single = 0;	# Uninitialized warning suppression
+                                # (local $^W cannot help - other packages!).
+@stack = (0);
+
+$option{PrintRet} = 1;
+
+@options     = qw(hashDepth arrayDepth DumpDBFiles DumpPackages 
+		  compactDump veryCompact quote HighBit undefPrint
+		  globPrint PrintRet UsageOnly frame
+		  TTY noTTY ReadLine NonStop LineInfo
+		  recallCommand ShellBang pager tkRunning
+		  signalLevel warnLevel dieLevel);
+
+%optionVars    = (
+		 hashDepth	=> \$dumpvar::hashDepth,
+		 arrayDepth	=> \$dumpvar::arrayDepth,
+		 DumpDBFiles	=> \$dumpvar::dumpDBFiles,
+		 DumpPackages	=> \$dumpvar::dumpPackages,
+		 HighBit	=> \$dumpvar::quoteHighBit,
+		 undefPrint	=> \$dumpvar::printUndef,
+		 globPrint	=> \$dumpvar::globPrint,
+		 tkRunning	=> \$readline::Tk_toloop,
+		 UsageOnly	=> \$dumpvar::usageOnly,     
+		  frame           => \$frame,
+);
+
+%optionAction  = (
+		  compactDump	=> \&dumpvar::compactDump,
+		  veryCompact	=> \&dumpvar::veryCompact,
+		  quote		=> \&dumpvar::quote,
+		  TTY		=> \&TTY,
+		  noTTY		=> \&noTTY,
+		  ReadLine	=> \&ReadLine,
+		  NonStop	=> \&NonStop,
+		  LineInfo	=> \&LineInfo,
+		  recallCommand	=> \&recallCommand,
+		  ShellBang	=> \&shellBang,
+		  pager		=> \&pager,
+		  signalLevel	=> \&signalLevel,
+		  warnLevel	=> \&warnLevel,
+		  dieLevel	=> \&dieLevel,
+		 );
+
+%optionRequire = (
+		  compactDump	=> 'dumpvar.pl',
+		  veryCompact	=> 'dumpvar.pl',
+		  quote		=> 'dumpvar.pl',
+		 );
+
+# These guys may be defined in $ENV{PERL5DB} :
+$rl = 1 unless defined $rl;
+warnLevel($warnLevel);
+dieLevel($dieLevel);
+signalLevel($signalLevel);
+&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
+&recallCommand("!") unless defined $prc;
+&shellBang("!") unless defined $psh;
+
+if (-e "/dev/tty") {
+  $rcfile=".perldb";
+} else {
+  $rcfile="perldb.ini";
+}
+
+if (-f $rcfile) {
+    do "./$rcfile";
+} elsif (defined $ENV{LOGDIR} and -f "$ENV{LOGDIR}/$rcfile") {
+    do "$ENV{LOGDIR}/$rcfile";
+} elsif (defined $ENV{HOME} and -f "$ENV{HOME}/$rcfile") {
+    do "$ENV{HOME}/$rcfile";
+}
+
+if (defined $ENV{PERLDB_OPTS}) {
+  parse_options($ENV{PERLDB_OPTS});
+}
+
+if (exists $ENV{PERLDB_RESTART}) {
+  delete $ENV{PERLDB_RESTART};
+  # $restart = 1;
+  @hist = get_list('PERLDB_HIST');
+  my @visited = get_list("PERLDB_VISITED");
+  for (0 .. $#visited) {
+    %{$postponed{$visited[$_]}} = get_list("PERLDB_FILE_$_");
+  }
+  my %opt = get_list("PERLDB_OPT");
+  my ($opt,$val);
+  while (($opt,$val) = each %opt) {
+    $val =~ s/[\\\']/\\$1/g;
+    parse_options("$opt'$val'");
+  }
+  @INC = get_list("PERLDB_INC");
+  @ini_INC = @INC;
+}
+
+if ($notty) {
+  $runnonstop = 1;
+} else {
+  # Is Perl being run from Emacs?
+  $emacs = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
+  $rl = 0, shift(@main::ARGV) if $emacs;
+
+  #require Term::ReadLine;
+
+  if (-e "/dev/tty") {
+    $console = "/dev/tty";
+  } elsif (-e "con") {
+    $console = "con";
+  } else {
+    $console = "sys\$command";
+  }
+
+  # Around a bug:
+  if (defined $ENV{OS2_SHELL} and $emacs) { # In OS/2
+    $console = undef;
+  }
+
+  $console = $tty if defined $tty;
+
+  if (defined $console) {
+    open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
+    open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
+      || open(OUT,">&STDOUT");	# so we don't dongle stdout
+  } else {
+    open(IN,"<&STDIN");
+    open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
+    $console = 'STDIN/OUT';
+  }
+  # so open("|more") can read from STDOUT and so we don't dingle stdin
+  $IN = \*IN;
+
+  $OUT = \*OUT;
+  select($OUT);
+  $| = 1;			# for DB::OUT
+  select(STDOUT);
+
+  $LINEINFO = $OUT unless defined $LINEINFO;
+  $lineinfo = $console unless defined $lineinfo;
+
+  $| = 1;			# for real STDOUT
+
+  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+  unless ($runnonstop) {
+    print $OUT "\nLoading DB routines from $header\n";
+    print $OUT ("Emacs support ",
+		$emacs ? "enabled" : "available",
+		".\n");
+    print $OUT "\nEnter h or `h h' for help.\n\n";
+  }
+}
+
+@ARGS = @ARGV;
+for (@args) {
+    s/\'/\\\'/g;
+    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+}
+
+if (defined &afterinit) {	# May be defined in $rcfile
+  &afterinit();
+}
+
+############################################################ Subroutines
+
+sub DB {
+    unless ($first_time++) {	# Do when-running init
+      if ($runnonstop) {		# Disable until signal
+	for ($i=0; $i <= $#stack; ) {
+	    $stack[$i++] &= ~1;
+	}
+	$single = 0;
+	return;
+      }
+      # Define a subroutine in which we will stop
+#       eval <<'EOE';
+# sub at_end::db {"Debuggee terminating";}
+# END {
+#   $DB::step = 1; 
+#   print $OUT "Debuggee terminating.\n"; 
+#   &at_end::db;}
+# EOE
+    }
+    &save;
+    if ($doret) {
+	$doret = 0;
+	if ($option{PrintRet}) {
+	    print $OUT "$retctx context return from $lastsub:", 
+	      ($retctx eq 'list') ? "\n" : " " ;
+	    dumpit( ($retctx eq 'list') ? \@ret : $ret );
+	}
+    }
+    ($package, $filename, $line) = caller;
+    $filename_ini = $filename;
+    $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+      "package $package;";	# this won't let them modify, alas
+    local(*dbline) = "::_<$filename";
+    install_breakpoints($filename) unless $visited{$filename}++;
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	} elsif ($stop) {
+	    $evalarg = "\$DB::signal |= do {$stop;}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    if ($single || $trace || $signal) {
+	$term || &setterm;
+	if ($emacs) {
+	    $position = "\032\032$filename:$line:0\n";
+	    print $LINEINFO $position;
+	} else {
+	    $sub =~ s/\'/::/;
+	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
+	    $prefix .= "$sub($filename:";
+	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
+	    if (length($prefix) > 30) {
+	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+		print $LINEINFO $position;
+		$prefix = "";
+		$infix = ":\t";
+	    } else {
+		$infix = "):\t";
+		$position = "$prefix$line$infix$dbline[$line]$after";
+		print $LINEINFO $position;
+	    }
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
+		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
+		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
+		print $LINEINFO $incr_pos;
+		$position .= $incr_pos;
+	    }
+	}
+    }
+    $evalarg = $action, &eval if $action;
+    if ($single || $signal) {
+	local $level = $level + 1;
+	$evalarg = $pre, &eval if $pre;
+	print $OUT $#stack . " levels deep in subroutine calls!\n"
+	  if $single & 4;
+	$start = $line;
+      CMD:
+	while (($term || &setterm),
+	       defined ($cmd=&readline("  DB" . ('<' x $level) .
+				       ($#hist+1) . ('>' x $level) .
+				       " "))) {
+	    #{			# <-- Do we know what this brace is for?
+		$single = 0;
+		$signal = 0;
+		$cmd =~ s/\\$/\n/ && do {
+		    $cmd .= &readline("  cont: ");
+		    redo CMD;
+		};
+		$cmd =~ /^q$/ && exit 0;
+		$cmd =~ /^$/ && ($cmd = $laststep);
+		push(@hist,$cmd) if length($cmd) > 1;
+	      PIPE: {
+		    ($i) = split(/\s+/,$cmd);
+		    eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
+		    $cmd =~ /^h$/ && do {
+			print $OUT $help;
+			next CMD; };
+		    $cmd =~ /^h\s+h$/ && do {
+			print $OUT $summary;
+			next CMD; };
+		    $cmd =~ /^h\s+(\S)$/ && do {
+			my $asked = "\Q$1";
+			if ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/m) {
+			    print $OUT $1;
+			} else {
+			    print $OUT "`$asked' is not a debugger command.\n";
+			}
+			next CMD; };
+		    $cmd =~ /^t$/ && do {
+			$trace = !$trace;
+			print $OUT "Trace = ".($trace?"on":"off")."\n";
+			next CMD; };
+		    $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
+			$Srev = defined $2; $Spatt = $3; $Snocheck = ! defined $1;
+			foreach $subname (sort(keys %sub)) {
+			    if ($Snocheck or $Srev^($subname =~ /$Spatt/)) {
+				print $OUT $subname,"\n";
+			    }
+			}
+			next CMD; };
+		    $cmd =~ s/^X\b/V $package/;
+		    $cmd =~ /^V$/ && do {
+			$cmd = "V $package"; };
+		    $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+			local ($savout) = select($OUT);
+			$packname = $1;
+			@vars = split(' ',$2);
+			do 'dumpvar.pl' unless defined &main::dumpvar;
+			if (defined &main::dumpvar) {
+			    local $frame = 0;
+			    &main::dumpvar($packname,@vars);
+			} else {
+			    print $OUT "dumpvar.pl not available.\n";
+			}
+			select ($savout);
+			next CMD; };
+		    $cmd =~ s/^x\b/ / && do { # So that will be evaled
+			$onetimeDump = 1; };
+		    $cmd =~ /^f\b\s*(.*)/ && do {
+			$file = $1;
+			if (!$file) {
+			    print $OUT "The old f command is now the r command.\n";
+			    print $OUT "The new f command switches filenames.\n";
+			    next CMD;
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
+					      $file = substr($try,2);
+					      print "\n$file:\n";
+					  }}
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    print $OUT "There's no code here matching $file.\n";
+			    next CMD;
+			} elsif ($file ne $filename) {
+			    *dbline = "::_<$file";
+			    $visited{$file}++;
+			    $max = $#dbline;
+			    $filename = $file;
+			    $start = 1;
+			    $cmd = "l";
+			} };
+		    $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*)/ && do {
+			$subname = $1;
+			$subname =~ s/\'/::/;
+			$subname = "main::".$subname unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			@pieces = split(/:/,$sub{$subname});
+			$subrange = pop @pieces;
+			$file = join(':', @pieces);
+			if ($file ne $filename) {
+			    *dbline = "::_<$file";
+			    $visited{$file}++;
+			    $max = $#dbline;
+			    $filename = $file;
+			}
+			if ($subrange) {
+			    if (eval($subrange) < -$window) {
+				$subrange =~ s/-.*/+/;
+			    }
+			    $cmd = "l $subrange";
+			} else {
+			    print $OUT "Subroutine $subname not found.\n";
+			    next CMD;
+			} };
+		    $cmd =~ /^\.$/ && do {
+			$start = $line;
+			$filename = $filename_ini;
+			*dbline = "::_<$filename";
+			$max = $#dbline;
+			print $LINEINFO $position;
+			next CMD };
+		    $cmd =~ /^w\b\s*(\d*)$/ && do {
+			$incr = $window - 1;
+			$start = $1 if $1;
+			$start -= $preview;
+			#print $OUT 'l ' . $start . '-' . ($start + $incr);
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^-$/ && do {
+			$incr = $window - 1;
+			$cmd = 'l ' . ($start-$window*2) . '+'; };
+		    $cmd =~ /^l$/ && do {
+			$incr = $window - 1;
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do {
+			$start = $1 if $1;
+			$incr = $2;
+			$incr = $window - 1 unless $incr;
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^l\b\s*((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+			$end = (!defined $2) ? $max : ($4 ? $4 : $2);
+			$end = $max if $end > $max;
+			$i = $2;
+			$i = $line if $i eq '.';
+			$i = 1 if $i < 1;
+			if ($emacs) {
+			    print $OUT "\032\032$filename:$i:0\n";
+			    $i = $end;
+			} else {
+			    for (; $i <= $end; $i++) {
+			        ($stop,$action) = split(/\0/, $dbline{$i});
+			        $arrow = ($i==$line 
+					  and $filename eq $filename_ini) 
+				  ?  '==>' 
+				    : ':' ;
+				$arrow .= 'b' if $stop;
+				$arrow .= 'a' if $action;
+				print $OUT "$i$arrow\t", $dbline[$i];
+				last if $signal;
+			    }
+			}
+			$start = $i; # remember in case they want more
+			$start = $max if $start > $max;
+			next CMD; };
+		    $cmd =~ /^D$/ && do {
+			print $OUT "Deleting all breakpoints...\n";
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/^[^\0]+//;
+				if ($dbline{$i} =~ s/^\0?$//) {
+				    delete $dbline{$i};
+				}
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^L$/ && do {
+			for ($i = 1; $i <= $max; $i++) {
+			    if (defined $dbline{$i}) {
+				print $OUT "$i:\t", $dbline[$i];
+				($stop,$action) = split(/\0/, $dbline{$i});
+				print $OUT "  break if (", $stop, ")\n"
+				  if $stop;
+				print $OUT "  action:  ", $action, "\n"
+				  if $action;
+				last if $signal;
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+			$subname = $1;
+			$cond = $2 || '1';
+			$subname =~ s/\'/::/;
+			$subname = "${'package'}::" . $subname
+			  unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			# Filename below can contain ':'
+			($file,$i) = ($sub{$subname} =~ /^(.*):(.*)$/);
+			$i += 0;
+			if ($i) {
+			    $filename = $file;
+			    *dbline = "::_<$filename";
+			    $visited{$filename}++;
+			    $max = $#dbline;
+			    ++$i while $dbline[$i] == 0 && $i < $max;
+			    $dbline{$i} =~ s/^[^\0]*/$cond/;
+			} else {
+			    print $OUT "Subroutine $subname not found.\n";
+			}
+			next CMD; };
+		    $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
+			$i = ($1?$1:$line);
+			$cond = $2 || '1';
+			if ($dbline[$i] == 0) {
+			    print $OUT "Line $i not breakable.\n";
+			} else {
+			    $dbline{$i} =~ s/^[^\0]*/$cond/;
+			}
+			next CMD; };
+		    $cmd =~ /^d\b\s*(\d+)?/ && do {
+			$i = ($1?$1:$line);
+			$dbline{$i} =~ s/^[^\0]*//;
+			delete $dbline{$i} if $dbline{$i} eq '';
+			next CMD; };
+		    $cmd =~ /^A$/ && do {
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/\0[^\0]*//;
+				delete $dbline{$i} if $dbline{$i} eq '';
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^O\s*$/ && do {
+			for (@options) {
+			    &dump_option($_);
+			}
+			next CMD; };
+		    $cmd =~ /^O\s*(\S.*)/ && do {
+			parse_options($1);
+			next CMD; };
+		    $cmd =~ /^<\s*(.*)/ && do {
+			$pre = action($1);
+			next CMD; };
+		    $cmd =~ /^>\s*(.*)/ && do {
+			$post = action($1);
+			next CMD; };
+		    $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
+			$i = $1; $j = $3;
+			if ($dbline[$i] == 0) {
+			    print $OUT "Line $i may not have an action.\n";
+			} else {
+			    $dbline{$i} =~ s/\0[^\0]*//;
+			    $dbline{$i} .= "\0" . action($j);
+			}
+			next CMD; };
+		    $cmd =~ /^n$/ && do {
+			$single = 2;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^s$/ && do {
+			$single = 1;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+			$i = $1;
+			if ($i =~ /\D/) { # subroutine name
+			    ($file,$i) = ($sub{$i} =~ /^(.*):(.*)$/);
+			    $i += 0;
+			    if ($i) {
+			        $filename = $file;
+				*dbline = "::_<$filename";
+				$visited{$filename}++;
+				$max = $#dbline;
+				++$i while $dbline[$i] == 0 && $i < $max;
+			    } else {
+				print $OUT "Subroutine $subname not found.\n";
+				next CMD; 
+			    }
+			}
+			if ($i) {
+			    if ($dbline[$i] == 0) {
+				print $OUT "Line $i not breakable.\n";
+				next CMD;
+			    }
+			    $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
+			}
+			for ($i=0; $i <= $#stack; ) {
+			    $stack[$i++] &= ~1;
+			}
+			last CMD; };
+		    $cmd =~ /^r$/ && do {
+			$stack[$#stack] |= 1;
+			$doret = 1;
+			last CMD; };
+		    $cmd =~ /^R$/ && do {
+		        print $OUT "Warning: a lot of settings and command-line options may be lost!\n";
+			my (@script, @flags, $cl);
+			push @flags, '-w' if $ini_warn;
+			# Put all the old includes at the start to get
+			# the same debugger.
+			for (@ini_INC) {
+			  push @flags, '-I', $_;
+			}
+			# Arrange for setting the old INC:
+			set_list("PERLDB_INC", @ini_INC);
+			if ($0 eq '-e') {
+			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
+			    chomp ($cl =  $ {'::_<-e'}[$_]);
+			    push @script, '-e', $cl;
+			  }
+			} else {
+			  @script = $0;
+			}
+			set_list("PERLDB_HIST", 
+				 $term->Features->{getHistory} 
+				 ? $term->GetHistory : @hist);
+			my @visited = keys %visited;
+			set_list("PERLDB_VISITED", @visited);
+			set_list("PERLDB_OPT", %option);
+			for (0 .. $#visited) {
+			  *dbline = "::_<$visited[$_]";
+			  set_list("PERLDB_FILE_$_", %dbline);
+			}
+			$ENV{PERLDB_RESTART} = 1;
+			#print "$^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS";
+			exec $^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS;
+			print $OUT "exec failed: $!\n";
+			last CMD; };
+		    $cmd =~ /^T$/ && do {
+			local($p,$f,$l,$s,$h,$a,$e,$r,@a,@sub);
+			for ($i = 1; 
+			     ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); 
+			     $i++) {
+			    @a = ();
+			    for $arg (@args) {
+				$_ = "$arg";
+				s/([\'\\])/\\$1/g;
+				s/([^\0]*)/'$1'/
+				  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+				s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+				s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+				push(@a, $_);
+			    }
+			    $w = $w ? '@ = ' : '$ = ';
+			    $a = $h ? '(' . join(', ', @a) . ')' : '';
+			    $e =~ s/\n\s*\;\s*\Z// if $e;
+			    $e =~ s/[\\\']/\\$1/g if $e;
+			    if ($r) {
+			      $s = "require '$e'";
+			    } elsif (defined $r) {
+			      $s = "eval '$e'";
+			    } elsif ($s eq '(eval)') {
+			      $s = "eval {...}";
+			    }
+			    $f = "file `$f'" unless $f eq '-e';
+			    push(@sub, "$w$s$a called from $f line $l\n");
+			    last if $signal;
+			}
+			for ($i=0; $i <= $#sub; $i++) {
+			    last if $signal;
+			    print $OUT $sub[$i];
+			}
+			next CMD; };
+		    $cmd =~ /^\/(.*)$/ && do {
+			$inpat = $1;
+			$inpat =~ s:([^\\])/$:$1:;
+			if ($inpat ne "") {
+			    eval '$inpat =~ m'."\a$inpat\a";	
+			    if ($@ ne "") {
+				print $OUT "$@";
+				next CMD;
+			    }
+			    $pat = $inpat;
+			}
+			$end = $start;
+			eval '
+			    for (;;) {
+				++$start;
+				$start = 1 if ($start > $max);
+				last if ($start == $end);
+				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+				    if ($emacs) {
+					print $OUT "\032\032$filename:$start:0\n";
+				    } else {
+					print $OUT "$start:\t", $dbline[$start], "\n";
+				    }
+				    last;
+				}
+			    } ';
+			print $OUT "/$pat/: not found\n" if ($start == $end);
+			next CMD; };
+		    $cmd =~ /^\?(.*)$/ && do {
+			$inpat = $1;
+			$inpat =~ s:([^\\])\?$:$1:;
+			if ($inpat ne "") {
+			    eval '$inpat =~ m'."\a$inpat\a";	
+			    if ($@ ne "") {
+				print $OUT "$@";
+				next CMD;
+			    }
+			    $pat = $inpat;
+			}
+			$end = $start;
+			eval '
+			    for (;;) {
+				--$start;
+				$start = $max if ($start <= 0);
+				last if ($start == $end);
+				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+				    if ($emacs) {
+					print $OUT "\032\032$filename:$start:0\n";
+				    } else {
+					print $OUT "$start:\t", $dbline[$start], "\n";
+				    }
+				    last;
+				}
+			    } ';
+			print $OUT "?$pat?: not found\n" if ($start == $end);
+			next CMD; };
+		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
+			pop(@hist) if length($cmd) > 1;
+			$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
+			$cmd = $hist[$i] . "\n";
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$sh\s*/ && do {
+			&system($');
+			next CMD; };
+		    $cmd =~ /^$rc([^$rc].*)$/ && do {
+			$pat = "^$1";
+			pop(@hist) if length($cmd) > 1;
+			for ($i = $#hist; $i; --$i) {
+			    last if $hist[$i] =~ /$pat/;
+			}
+			if (!$i) {
+			    print $OUT "No such command!\n\n";
+			    next CMD;
+			}
+			$cmd = $hist[$i] . "\n";
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$/ && do {
+			&system($ENV{SHELL}||"/bin/sh");
+			next CMD; };
+		    $cmd =~ /^$sh\s*/ && do {
+			&system($ENV{SHELL}||"/bin/sh","-c",$');
+			next CMD; };
+		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
+			$end = $2?($#hist-$2):0;
+			$hist = 0 if $hist < 0;
+			for ($i=$#hist; $i>$end; $i--) {
+			    print $OUT "$i: ",$hist[$i],"\n"
+			      unless $hist[$i] =~ /^.?$/;
+			};
+			next CMD; };
+		    $cmd =~ s/^p$/print \$DB::OUT \$_/;
+		    $cmd =~ s/^p\b/print \$DB::OUT /;
+		    $cmd =~ /^=/ && do {
+			if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
+			    $alias{$k}="s~$k~$v~";
+			    print $OUT "$k = $v\n";
+			} elsif ($cmd =~ /^=\s*$/) {
+			    foreach $k (sort keys(%alias)) {
+				if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
+				    print $OUT "$k = $v\n";
+				} else {
+				    print $OUT "$k\t$alias{$k}\n";
+				};
+			    };
+			};
+			next CMD; };
+		    $cmd =~ /^\|\|?\s*[^|]/ && do {
+			if ($pager =~ /^\|/) {
+			    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
+			    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
+			} else {
+			    open(SAVEOUT,">&OUT") || &warn("Can't save DB::OUT");
+			}
+			unless ($piped=open(OUT,$pager)) {
+			    &warn("Can't pipe output to `$pager'");
+			    if ($pager =~ /^\|/) {
+				open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+				open(STDOUT,">&SAVEOUT")
+				  || &warn("Can't restore STDOUT");
+				close(SAVEOUT);
+			    } else {
+				open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+			    }
+			    next CMD;
+			}
+			$SIG{PIPE}= "DB::catch" if $pager =~ /^\|/
+			  && "" eq $SIG{PIPE}  ||  "DEFAULT" eq $SIG{PIPE};
+			$selected= select(OUT);
+			$|= 1;
+			select( $selected ), $selected= "" unless $cmd =~ /^\|\|/;
+			$cmd =~ s/^\|+\s*//;
+			redo PIPE; };
+		    # XXX Local variants do not work!
+		    $cmd =~ s/^t\s/\$DB::trace = 1;\n/;
+		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
+		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
+		}		# PIPE:
+	    #}			# <-- Do we know what this brace is for?
+	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
+	    if ($onetimeDump) {
+		$onetimeDump = undef;
+	    } else {
+		print $OUT "\n";
+	    }
+	} continue {		# CMD:
+	    if ($piped) {
+		if ($pager =~ /^\|/) {
+		    $?= 0;  close(OUT) || &warn("Can't close DB::OUT");
+		    &warn( "Pager `$pager' failed: ",
+			  ($?>>8) > 128 ? ($?>>8)-256 : ($?>>8),
+			  ( $? & 128 ) ? " (core dumped)" : "",
+			  ( $? & 127 ) ? " (SIG ".($?&127).")" : "", "\n" ) if $?;
+		    open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+		    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
+		    $SIG{PIPE}= "DEFAULT" if $SIG{PIPE} eq "DB::catch";
+		    # Will stop ignoring SIGPIPE if done like nohup(1)
+		    # does SIGINT but Perl doesn't give us a choice.
+		} else {
+		    open(OUT,">&SAVEOUT") || &warn("Can't restore DB::OUT");
+		}
+		close(SAVEOUT);
+		select($selected), $selected= "" unless $selected eq "";
+		$piped= "";
+	    }
+	}			# CMD:
+	if ($post) {
+	    $evalarg = $post; &eval;
+	}
+    }				# if ($single || $signal)
+    ($@, $!, $,, $/, $\, $^W) = @saved;
+    ();
+}
+
+# The following code may be executed now:
+# BEGIN {warn 4}
+
+sub sub {
+    print $LINEINFO ' ' x $#stack, "entering $sub\n" if $frame;
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    if (wantarray) {
+	@ret = &$sub;
+	$single |= pop(@stack);
+	$retctx = "list";
+	$lastsub = $sub;
+print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	@ret;
+    } else {
+	$ret = &$sub;
+	$single |= pop(@stack);
+	$retctx = "scalar";
+	$lastsub = $sub;
+print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	$ret;
+    }
+}
+
+sub save {
+    @saved = ($@, $!, $,, $/, $\, $^W);
+    $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
+}
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub eval {
+    my @res;
+    {
+	local (@stack) = @stack; # guard against recursive debugging
+	my $otrace = $trace;
+	my $osingle = $single;
+	my $od = $^D;
+	@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
+	$trace = $otrace;
+	$single = $osingle;
+	$^D = $od;
+    }
+    my $at = $@;
+    eval "&DB::save";
+    if ($at) {
+	print $OUT $at;
+    } elsif ($onetimeDump) {
+	dumpit(\@res);
+    }
+}
+
+sub install_breakpoints {
+  my $filename = shift;
+  return unless exists $postponed{$filename};
+  my %break = %{$postponed{$filename}};
+  for (keys %break) {
+    my $i = $_;
+    #if (/\D/) {			# Subroutine name
+    #} 
+    $dbline{$i} = $break{$_};	# Cannot be done before the file is around
+  }
+}
+
+sub dumpit {
+    local ($savout) = select($OUT);
+    do 'dumpvar.pl' unless defined &main::dumpValue;
+    if (defined &main::dumpValue) {
+        local $frame = 0;
+	&main::dumpValue(shift);
+    } else {
+	print $OUT "dumpvar.pl not available.\n";
+    }
+    select ($savout);    
+}
+
+sub action {
+    my $action = shift;
+    while ($action =~ s/\\$//) {
+	#print $OUT "+ ";
+	#$action .= "\n";
+	$action .= &gets;
+    }
+    $action;
+}
+
+sub gets {
+    local($.);
+    #<IN>;
+    &readline("cont: ");
+}
+
+sub system {
+    # We save, change, then restore STDIN and STDOUT to avoid fork() since
+    # many non-Unix systems can do system() but have problems with fork().
+    open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
+    open(SAVEOUT,">&OUT") || &warn("Can't save STDOUT");
+    open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
+    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
+    system(@_);
+    open(STDIN,"<&SAVEIN") || &warn("Can't restore STDIN");
+    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
+    close(SAVEIN); close(SAVEOUT);
+    &warn( "(Command returned ", ($?>>8) > 128 ? ($?>>8)-256 : ($?>>8), ")",
+	  ( $? & 128 ) ? " (core dumped)" : "",
+	  ( $? & 127 ) ? " (SIG ".($?&127).")" : "", "\n" ) if $?;
+    $?;
+}
+
+sub setterm {
+    local $frame = 0;
+    eval "require Term::ReadLine;" or die $@;
+    if ($notty) {
+	if ($tty) {
+	    open(IN,"<$tty") or die "Cannot open TTY `$TTY' for read: $!";
+	    open(OUT,">$tty") or die "Cannot open TTY `$TTY' for write: $!";
+	    $IN = \*IN;
+	    $OUT = \*OUT;
+	    my $sel = select($OUT);
+	    $| = 1;
+	    select($sel);
+	} else {
+	    eval "require Term::Rendezvous;" or die $@;
+	    my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
+	    my $term_rv = new Term::Rendezvous $rv;
+	    $IN = $term_rv->IN;
+	    $OUT = $term_rv->OUT;
+	}
+    }
+    if (!$rl) {
+	$term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+    } else {
+	$term = new Term::ReadLine 'perldb', $IN, $OUT;
+
+	$readline::rl_basic_word_break_characters .= "[:" 
+	  if defined $readline::rl_basic_word_break_characters 
+	    and index($readline::rl_basic_word_break_characters, ":") == -1;
+    }
+    $LINEINFO = $OUT unless defined $LINEINFO;
+    $lineinfo = $console unless defined $lineinfo;
+    $term->MinLine(2);
+    if ($term->Features->{setHistory} and "@hist" ne "?") {
+      $term->SetHistory(@hist);
+    }
+}
+
+sub readline {
+  if (@typeahead) {
+    my $left = @typeahead;
+    my $got = shift @typeahead;
+    print $OUT "auto(-$left)", shift, $got, "\n";
+    $term->AddHistory($got) 
+      if length($got) > 1 and defined $term->Features->{addHistory};
+    return $got;
+  }
+  local $frame = 0;
+  $term->readline(@_);
+}
+
+sub dump_option {
+    my ($opt, $val)= @_;
+    if (defined $optionVars{$opt}
+	and defined $ {$optionVars{$opt}}) {
+	$val = $ {$optionVars{$opt}};
+    } elsif (defined $optionAction{$opt}
+	and defined &{$optionAction{$opt}}) {
+	$val = &{$optionAction{$opt}}();
+    } elsif (defined $optionAction{$opt}
+	     and not defined $option{$opt}
+	     or defined $optionVars{$opt}
+	     and not defined $ {$optionVars{$opt}}) {
+	$val = 'N/A';
+    } else {
+	$val = $option{$opt};
+    }
+    $val =~ s/[\\\']/\\$&/g;
+    printf $OUT "%20s = '%s'\n", $opt, $val;
+}
+
+sub parse_options {
+    local($_)= @_;
+    while ($_ ne "") {
+	s/^(\w+)(\s*$|\W)// or print($OUT "Invalid option `$_'\n"), last;
+	my ($opt,$sep) = ($1,$2);
+	my $val;
+	if ("?" eq $sep) {
+	    print($OUT "Option query `$opt?' followed by non-space `$_'\n"), last
+	      if /^\S/;
+	    #&dump_option($opt);
+	} elsif ($sep !~ /\S/) {
+	    $val = "1";
+	} elsif ($sep eq "=") {
+	    s/^(\S*)($|\s+)//;
+	    $val = $1;
+	} else { #{ to "let some poor schmuck bounce on the % key in B<vi>."
+	    my ($end) = "\\" . substr( ")]>}$sep", index("([<{",$sep), 1 ); #}
+	    s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)// or
+	      print($OUT "Unclosed option value `$opt$sep$_'\n"), last;
+	    $val = $1;
+	    $val =~ s/\\([\\$end])/$1/g;
+	}
+	my ($option);
+	my $matches =
+	  grep(  /^\Q$opt/ && ($option = $_),  @options  );
+	$matches =  grep(  /^\Q$opt/i && ($option = $_),  @options  )
+	  unless $matches;
+	print $OUT "Unknown option `$opt'\n" unless $matches;
+	print $OUT "Ambiguous option `$opt'\n" if $matches > 1;
+	$option{$option} = $val if $matches == 1 and defined $val;
+	eval "local \$frame = 0; require '$optionRequire{$option}'"
+	  if $matches == 1 and defined $optionRequire{$option} and defined $val;
+	$ {$optionVars{$option}} = $val 
+	  if $matches == 1
+	    and defined $optionVars{$option} and defined $val;
+	& {$optionAction{$option}} ($val) 
+	  if $matches == 1
+	    and defined $optionAction{$option}
+	      and defined &{$optionAction{$option}} and defined $val;
+	&dump_option($option) if $matches == 1 && $OUT ne \*STDERR; # Not $rcfile
+        s/^\s+//;
+    }
+}
+
+sub set_list {
+  my ($stem,@list) = @_;
+  my $val;
+  $ENV{"$ {stem}_n"} = @list;
+  for $i (0 .. $#list) {
+    $val = $list[$i];
+    $val =~ s/\\/\\\\/g;
+    $val =~ s/[\0-\37\177\200-\377]/"\\0x" . unpack('H2',$&)/eg;
+    $ENV{"$ {stem}_$i"} = $val;
+  }
+}
+
+sub get_list {
+  my $stem = shift;
+  my @list;
+  my $n = delete $ENV{"$ {stem}_n"};
+  my $val;
+  for $i (0 .. $n - 1) {
+    $val = delete $ENV{"$ {stem}_$i"};
+    $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
+    push @list, $val;
+  }
+  @list;
+}
+
+sub catch {
+    $signal = 1;
+}
+
+sub warn {
+    my($msg)= join("",@_);
+    $msg .= ": $!\n" unless $msg =~ /\n$/;
+    print $OUT $msg;
+}
+
+sub TTY {
+    if ($term) {
+	&warn("Too late to set TTY!\n") if @_;
+    } else {
+	$tty = shift if @_;
+    }
+    $tty or $console;
+}
+
+sub noTTY {
+    if ($term) {
+	&warn("Too late to set noTTY!\n") if @_;
+    } else {
+	$notty = shift if @_;
+    }
+    $notty;
+}
+
+sub ReadLine {
+    if ($term) {
+	&warn("Too late to set ReadLine!\n") if @_;
+    } else {
+	$rl = shift if @_;
+    }
+    $rl;
+}
+
+sub NonStop {
+    if ($term) {
+	&warn("Too late to set up NonStop mode!\n") if @_;
+    } else {
+	$runnonstop = shift if @_;
+    }
+    $runnonstop;
+}
+
+sub pager {
+    if (@_) {
+	$pager = shift;
+	$pager="|".$pager unless $pager =~ /^(\+?\>|\|)/;
+    }
+    $pager;
+}
+
+sub shellBang {
+    if (@_) {
+	$sh = quotemeta shift;
+	$sh .= "\\b" if $sh =~ /\w$/;
+    }
+    $psh = $sh;
+    $psh =~ s/\\b$//;
+    $psh =~ s/\\(.)/$1/g;
+    &sethelp;
+    $psh;
+}
+
+sub recallCommand {
+    if (@_) {
+	$rc = quotemeta shift;
+	$rc .= "\\b" if $rc =~ /\w$/;
+    }
+    $prc = $rc;
+    $prc =~ s/\\b$//;
+    $prc =~ s/\\(.)/$1/g;
+    &sethelp;
+    $prc;
+}
+
+sub LineInfo {
+    return $lineinfo unless @_;
+    $lineinfo = shift;
+    my $stream = ($lineinfo =~ /^(\+?\>|\|)/) ? $lineinfo : ">$lineinfo";
+    $emacs = ($stream =~ /^\|/);
+    open(LINEINFO, "$stream") || &warn("Cannot open `$stream' for write");
+    $LINEINFO = \*LINEINFO;
+    my $save = select($LINEINFO);
+    $| = 1;
+    select($save);
+    $lineinfo;
+}
+
+sub sethelp {
+    $help = "
+T		Stack trace.
+s [expr]	Single step [in expr].
+n [expr]	Next, steps over subroutine calls [in expr].
+<CR>		Repeat last n or s command.
+r		Return from current subroutine.
+c [line]	Continue; optionally inserts a one-time-only breakpoint
+		at the specified line.
+l min+incr	List incr+1 lines starting at min.
+l min-max	List lines min through max.
+l line		List single line.
+l subname	List first window of lines from subroutine.
+l		List next window of lines.
+-		List previous window of lines.
+w [line]	List window around line.
+.		Return to the executed line.
+f filename	Switch to viewing filename.
+/pattern/	Search forwards for pattern; final / is optional.
+?pattern?	Search backwards for pattern; final ? is optional.
+L		List all breakpoints and actions for the current file.
+S [[!]pattern]	List subroutine names [not] matching pattern.
+t		Toggle trace mode.
+t expr		Trace through execution of expr.
+b [line] [condition]
+		Set breakpoint; line defaults to the current execution line;
+		condition breaks if it evaluates to true, defaults to '1'.
+b subname [condition]
+		Set breakpoint at first line of subroutine.
+d [line]	Delete the breakpoint for line.
+D		Delete all breakpoints.
+a [line] command
+		Set an action to be done before the line is executed.
+		Sequence is: check for breakpoint, print line if necessary,
+		do action, prompt user if breakpoint or step, evaluate line.
+A		Delete all actions.
+V [pkg [vars]]	List some (default all) variables in package (default current).
+		Use ~pattern and !pattern for positive and negative regexps.
+X [vars]	Same as \"V currentpackage [vars]\".
+x expr		Evals expression in array context, dumps the result.
+O [opt[=val]] [opt\"val\"] [opt?]...
+		Set or query values of options.  val defaults to 1.  opt can
+		be abbreviated.  Several options can be listed.
+    recallCommand, ShellBang:	chars used to recall command or spawn shell;
+    pager:			program for output of \"|cmd\";
+  The following options affect what happens with V, X, and x commands:
+    arrayDepth, hashDepth:	print only first N elements ('' for all);
+    compactDump, veryCompact:	change style of array and hash dump;
+    globPrint:			whether to print contents of globs;
+    DumpDBFiles:		dump arrays holding debugged files;
+    DumpPackages:		dump symbol tables of packages;
+    quote, HighBit, undefPrint:	change style of string dump;
+    tkRunning:			run Tk while prompting (with ReadLine);
+    signalLevel warnLevel dieLevel:	level of verbosity;
+  Option PrintRet affects printing of return value after r command,
+         frame    affects printing messages on entry and exit from subroutines.
+		During startup options are initialized from \$ENV{PERLDB_OPTS}.
+		You can put additional initialization options TTY, noTTY,
+		ReadLine, and NonStop there.
+< command	Define command to run before each prompt.
+> command	Define command to run after each prompt.
+$prc number	Redo a previous command (default previous command).
+$prc -number	Redo number'th-to-last command.
+$prc pattern	Redo last command that started with pattern.
+		See 'O recallCommand' too.
+$psh$psh cmd  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+  . ( $rc eq $sh ? "" : "
+$psh [cmd] 	Run cmd in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+		See 'O shellBang' too.
+H -number	Display last number commands (default all).
+p expr		Same as \"print DB::OUT expr\" in current package.
+|dbcmd		Run debugger command, piping DB::OUT to current pager.
+||dbcmd		Same as |dbcmd but DB::OUT is temporarilly select()ed as well.
+\= [alias value]	Define a command alias, or list current aliases.
+command		Execute as a perl statement in current package.
+R		Pure-man-restart of debugger, debugger state and command-line
+		options are lost.
+h [db_command]	Get help [on a specific debugger command], enter |h to page.
+h h		Summary of debugger commands.
+q or ^D		Quit.
+
+";
+    $summary = <<"END_SUM";
+List/search source lines:               Control script execution:
+  l [ln|sub]  List source code            T           Stack trace
+  - or .      List previous/current line  s [expr]    Single step [in expr]
+  w [line]    List around line            n [expr]    Next, steps over subs
+  f filename  View source in file         <CR>        Repeat last n or s
+  /pattern/   Search forward              r           Return from subroutine
+  ?pattern?   Search backward             c [line]    Continue until line
+Debugger controls:                        L           List break pts & actions
+  O [...]     Set debugger options        t [expr]    Toggle trace [trace expr]
+  < command   Command for before prompt   b [ln] [c]  Set breakpoint
+  > command   Command for after prompt    b sub [c]   Set breakpoint for sub
+  $prc [N|pat]   Redo a previous command     d [line]    Delete a breakpoint
+  H [-num]    Display last num commands   D           Delete all breakpoints
+  = [a val]   Define/list an alias        a [ln] cmd  Do cmd before line
+  h [db_cmd]  Get help on command         A           Delete all actions
+  |[|]dbcmd   Send output to pager        $psh\[$psh\] syscmd Run cmd in a subprocess
+  q or ^D     Quit			  R	      Attempt a restart
+Data Examination:	      expr     Execute perl code, also see: s,n,t expr
+  S [[!]pat]	List subroutine names [not] matching pattern
+  V [Pk [Vars]]	List Variables in Package.  Vars can be ~pattern or !pattern.
+  X [Vars]	Same as \"V current_package [Vars]\".
+  x expr	Evals expression in array context, dumps the result.
+  p expr	Print expression (uses script's current package).
+END_SUM
+				# '); # Fix balance of Emacs parsing
+}
+
+sub diesignal {
+    local $frame = 0;
+    $SIG{'ABRT'} = DEFAULT;
+    kill 'ABRT', $$ if $panic++;
+    print $DB::OUT "Got $_[0]!\n";	# in the case cannot continue
+    local $SIG{__WARN__} = '';
+    require Carp; 
+    local $Carp::CarpLevel = 2;		# mydie + confess
+    &warn(Carp::longmess("Signal @_"));
+    kill 'ABRT', $$;
+}
+
+sub dbwarn { 
+  local $frame = 0;
+  local $SIG{__WARN__} = '';
+  require Carp; 
+  #&warn("Entering dbwarn\n");
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  #&warn("Warning in dbwarn\n");
+  &warn($mess); 
+  #&warn("Exiting dbwarn\n");
+}
+
+sub dbdie {
+  local $frame = 0;
+  local $SIG{__DIE__} = '';
+  local $SIG{__WARN__} = '';
+  my $i = 0; my $ineval = 0; my $sub;
+  #&warn("Entering dbdie\n");
+  if ($dieLevel != 2) {
+    while ((undef,undef,undef,$sub) = caller(++$i)) {
+      $ineval = 1, last if $sub eq '(eval)';
+    }
+    {
+      local $SIG{__WARN__} = \&dbwarn;
+      &warn(@_) if $dieLevel > 2; # Ineval is false during destruction?
+    }
+    #&warn("dieing quietly in dbdie\n") if $ineval and $dieLevel < 2;
+    die @_ if $ineval and $dieLevel < 2;
+  }
+  require Carp; 
+  # We do not want to debug this chunk (automatic disabling works
+  # inside DB::DB, but not in Carp).
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  #&warn("dieing loudly in dbdie\n");
+  die $mess;
+}
+
+sub warnLevel {
+  if (@_) {
+    $prevwarn = $SIG{__WARN__} unless $warnLevel;
+    $warnLevel = shift;
+    if ($warnLevel) {
+      $SIG{__WARN__} = 'DB::dbwarn';
+    } else {
+      $SIG{__WARN__} = $prevwarn;
+    }
+  }
+  $warnLevel;
+}
+
+sub dieLevel {
+  if (@_) {
+    $prevdie = $SIG{__DIE__} unless $dieLevel;
+    $dieLevel = shift;
+    if ($dieLevel) {
+      $SIG{__DIE__} = 'DB::dbdie'; # if $dieLevel < 2;
+      #$SIG{__DIE__} = 'DB::diehard' if $dieLevel >= 2;
+      print $OUT "Stack dump during die enabled", 
+        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n";
+      print $OUT "Dump printed too.\n" if $dieLevel > 2;
+    } else {
+      $SIG{__DIE__} = $prevdie;
+      print $OUT "Default die handler restored.\n";
+    }
+  }
+  $dieLevel;
+}
+
+sub signalLevel {
+  if (@_) {
+    $prevsegv = $SIG{SEGV} unless $signalLevel;
+    $prevbus = $SIG{BUS} unless $signalLevel;
+    $signalLevel = shift;
+    if ($signalLevel) {
+      $SIG{SEGV} = 'DB::diesignal';
+      $SIG{BUS} = 'DB::diesignal';
+    } else {
+      $SIG{SEGV} = $prevsegv;
+      $SIG{BUS} = $prevbus;
+    }
+  }
+  $signalLevel;
+}
+
+# The following BEGIN is very handy if debugger goes havoc, debugging debugger?
+
+BEGIN {			# This does not compile, alas.
+  $IN = \*STDIN;		# For bugs before DB::OUT has been opened
+  $OUT = \*STDERR;		# For errors before DB::OUT has been opened
+  $sh = '!';
+  $rc = ',';
+  @hist = ('?');
+  $deep = 100;			# warning if stack gets this deep
+  $window = 10;
+  $preview = 3;
+  $sub = '';
+  #$SIG{__WARN__} = "DB::dbwarn";
+  #$SIG{__DIE__} = 'DB::dbdie';
+  #$SIG{SEGV} = "DB::diesignal";
+  #$SIG{BUS} = "DB::diesignal";
+  $SIG{INT} = "DB::catch";
+  #$SIG{FPE} = "DB::catch";
+  #warn "SIGFPE installed";
+  $warnLevel = 1 unless defined $warnLevel;
+  $dieLevel = 1 unless defined $dieLevel;
+  $signalLevel = 1 unless defined $signalLevel;
+
+  $db_stop = 0;			# Compiler warning
+  $db_stop = 1 << 30;
+  $level = 0;			# Level of recursive debugging
+}
+
+BEGIN {$^W = $ini_warn;}	# Switch warnings back
+
+#use Carp;			# This did break, left for debuggin
+
+1;
diff --git a/gnu/usr.bin/perl/lib/pwd.pl b/gnu/usr.bin/perl/lib/pwd.pl
new file mode 100644
index 00000000000..beb591679e2
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/pwd.pl
@@ -0,0 +1,58 @@
+;# pwd.pl - keeps track of current working directory in PWD environment var
+;#
+;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
+;#
+;# $Log:	pwd.pl,v $
+;#
+;# Usage:
+;#	require "pwd.pl";
+;#	&initpwd;
+;#	...
+;#	&chdir($newdir);
+
+package pwd;
+
+sub main'initpwd {
+    if ($ENV{'PWD'}) {
+	local($dd,$di) = stat('.');
+	local($pd,$pi) = stat($ENV{'PWD'});
+	if ($di != $pi || $dd != $pd) {
+	    chop($ENV{'PWD'} = `pwd`);
+	}
+    }
+    else {
+	chop($ENV{'PWD'} = `pwd`);
+    }
+    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+	local($pd,$pi) = stat($2);
+	local($dd,$di) = stat($1);
+	if ($di == $pi && $dd == $pd) {
+	    $ENV{'PWD'}="$2$3";
+	}
+    }
+}
+
+sub main'chdir {
+    local($newdir) = shift;
+    $newdir =~ s|/{2,}|/|g;
+    if (chdir $newdir) {
+	if ($newdir =~ m#^/#) {
+	    $ENV{'PWD'} = $newdir;
+	}
+	else {
+	    local(@curdir) = split(m#/#,$ENV{'PWD'});
+	    @curdir = '' unless @curdir;
+	    foreach $component (split(m#/#, $newdir)) {
+		next if $component eq '.';
+		pop(@curdir),next if $component eq '..';
+		push(@curdir,$component);
+	    }
+	    $ENV{'PWD'} = join('/',@curdir) || '/';
+	}
+    }
+    else {
+	0;
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/shellwords.pl b/gnu/usr.bin/perl/lib/shellwords.pl
new file mode 100644
index 00000000000..1c45a5a0903
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/shellwords.pl
@@ -0,0 +1,48 @@
+;# shellwords.pl
+;#
+;# Usage:
+;#	require 'shellwords.pl';
+;#	@words = &shellwords($line);
+;#	or
+;#	@words = &shellwords(@lines);
+;#	or
+;#	@words = &shellwords;		# defaults to $_ (and clobbers it)
+
+sub shellwords {
+    package shellwords;
+    local($_) = join('', @_) if @_;
+    local(@words,$snippet,$field);
+
+    s/^\s+//;
+    while ($_ ne '') {
+	$field = '';
+	for (;;) {
+	    if (s/^"(([^"\\]|\\.)*)"//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^"/) {
+		die "Unmatched double quote: $_\n";
+	    }
+	    elsif (s/^'(([^'\\]|\\.)*)'//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^'/) {
+		die "Unmatched single quote: $_\n";
+	    }
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+	    }
+	    elsif (s/^([^\s\\'"]+)//) {
+		$snippet = $1;
+	    }
+	    else {
+		s/^\s+//;
+		last;
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/sigtrap.pm b/gnu/usr.bin/perl/lib/sigtrap.pm
new file mode 100644
index 00000000000..e099ac46581
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/sigtrap.pm
@@ -0,0 +1,79 @@
+package sigtrap;
+
+=head1 NAME
+
+sigtrap - Perl pragma to enable stack backtrace on unexpected signals
+
+=head1 SYNOPSIS
+
+    use sigtrap;
+    use sigtrap qw(BUS SEGV PIPE SYS ABRT TRAP);
+
+=head1 DESCRIPTION
+
+The C<sigtrap> pragma initializes some default signal handlers that print
+a stack dump of your Perl program, then sends itself a SIGABRT.  This
+provides a nice starting point if something horrible goes wrong.
+
+By default, handlers are installed for the ABRT, BUS, EMT, FPE, ILL, PIPE,
+QUIT, SEGV, SYS, TERM, and TRAP signals.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+require Carp;
+
+sub import {
+    my $pack = shift;
+    my @sigs = @_;
+    @sigs or @sigs = qw(QUIT ILL TRAP ABRT EMT FPE BUS SEGV SYS PIPE TERM);
+    foreach $sig (@sigs) {
+	$SIG{$sig} = 'sigtrap::trap';
+    }
+}
+
+sub trap {
+    package DB;		# To get subroutine args.
+    $SIG{'ABRT'} = DEFAULT;
+    kill 'ABRT', $$ if $panic++;
+    syswrite(STDERR, 'Caught a SIG', 12);
+    syswrite(STDERR, $_[0], length($_[0]));
+    syswrite(STDERR, ' at ', 4);
+    ($pack,$file,$line) = caller;
+    syswrite(STDERR, $file, length($file));
+    syswrite(STDERR, ' line ', 6);
+    syswrite(STDERR, $line, length($line));
+    syswrite(STDERR, "\n", 1);
+
+    # Now go for broke.
+    for ($i = 1; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
+        @a = ();
+	for $arg (@args) {
+	    $_ = "$arg";
+	    s/([\'\\])/\\$1/g;
+	    s/([^\0]*)/'$1'/
+	      unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+	    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+	    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    push(@a, $_);
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	$e =~ s/\n\s*\;\s*\Z// if $e;
+	$e =~ s/[\\\']/\\$1/g if $e;
+	if ($r) {
+	    $s = "require '$e'";
+	} elsif (defined $r) {
+	    $s = "eval '$e'";
+	} elsif ($s eq '(eval)') {
+	    $s = "eval {...}";
+	}
+	$f = "file `$f'" unless $f eq '-e';
+	$mess = "$w$s$a called from $f line $l\n";
+	syswrite(STDERR, $mess, length($mess));
+    }
+    kill 'ABRT', $$;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/splain b/gnu/usr.bin/perl/lib/splain
new file mode 100644
index 00000000000..f40c51e0308
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/splain
@@ -0,0 +1,503 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if 0;
+
+use Config;
+$diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod";
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    local($Carp::CarpLevel) = 1;
+    confess "Uncaught exception from user code:\n\t$exception";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
diff --git a/gnu/usr.bin/perl/lib/stat.pl b/gnu/usr.bin/perl/lib/stat.pl
new file mode 100644
index 00000000000..f7c240a4b3e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/stat.pl
@@ -0,0 +1,31 @@
+;# $RCSfile: stat.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:13 $
+
+;# Usage:
+;#	require 'stat.pl';
+;#	@ary = stat(foo);
+;#	$st_dev = @ary[$ST_DEV];
+;#
+$ST_DEV =	0 + $[;
+$ST_INO =	1 + $[;
+$ST_MODE =	2 + $[;
+$ST_NLINK =	3 + $[;
+$ST_UID =	4 + $[;
+$ST_GID =	5 + $[;
+$ST_RDEV =	6 + $[;
+$ST_SIZE =	7 + $[;
+$ST_ATIME =	8 + $[;
+$ST_MTIME =	9 + $[;
+$ST_CTIME =	10 + $[;
+$ST_BLKSIZE =	11 + $[;
+$ST_BLOCKS =	12 + $[;
+
+;# Usage:
+;#	require 'stat.pl';
+;#	do Stat('foo');		# sets st_* as a side effect
+;#
+sub Stat {
+    ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
+	$st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(shift(@_));
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/strict.pm b/gnu/usr.bin/perl/lib/strict.pm
new file mode 100644
index 00000000000..6f6028cad4e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/strict.pm
@@ -0,0 +1,95 @@
+package strict;
+
+=head1 NAME
+
+strict - Perl pragma to restrict unsafe constructs
+
+=head1 SYNOPSIS
+
+    use strict;
+
+    use strict "vars";
+    use strict "refs";
+    use strict "subs";
+
+    use strict;
+    no strict "vars";
+
+=head1 DESCRIPTION
+
+If no import list is supplied, all possible restrictions are assumed.
+(This is the safest mode to operate in, but is sometimes too strict for
+casual programming.)  Currently, there are three possible things to be
+strict about:  "subs", "vars", and "refs".
+
+=over 6
+
+=item C<strict refs>
+
+This generates a runtime error if you 
+use symbolic references (see L<perlref>).
+
+    use strict 'refs';
+    $ref = \$foo;
+    print $$ref;	# ok
+    $ref = "foo";
+    print $$ref;	# runtime error; normally ok
+
+=item C<strict vars>
+
+This generates a compile-time error if you access a variable that wasn't
+localized via C<my()> or wasn't fully qualified.  Because this is to avoid
+variable suicide problems and subtle dynamic scoping issues, a merely
+local() variable isn't good enough.  See L<perlfunc/my> and
+L<perlfunc/local>.
+
+    use strict 'vars';
+    $X::foo = 1;	 # ok, fully qualified
+    my $foo = 10;	 # ok, my() var
+    local $foo = 9;	 # blows up
+
+The local() generated a compile-time error because you just touched a global
+name without fully qualifying it.
+
+=item C<strict subs>
+
+This disables the poetry optimization, generating a compile-time error if
+you try to use a bareword identifier that's not a subroutine, unless it
+appears in curly braces or on the left hand side of the "=>" symbol.
+
+
+    use strict 'subs';
+    $SIG{PIPE} = Plumber;   	# blows up
+    $SIG{PIPE} = "Plumber"; 	# just fine: bareword in curlies always ok
+    $SIG{PIPE} = \&Plumber; 	# preferred form
+
+
+
+=back
+
+See L<perlmod/Pragmatic Modules>.
+
+
+=cut
+
+sub bits {
+    my $bits = 0;
+    foreach $sememe (@_) {
+	$bits |= 0x00000002 if $sememe eq 'refs';
+	$bits |= 0x00000200 if $sememe eq 'subs';
+	$bits |= 0x00000400 if $sememe eq 'vars';
+    }
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(@_ ? @_ : qw(refs subs vars));
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/subs.pm b/gnu/usr.bin/perl/lib/subs.pm
new file mode 100644
index 00000000000..84c913a346a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/subs.pm
@@ -0,0 +1,32 @@
+package subs;
+
+=head1 NAME
+
+subs - Perl pragma to predeclare sub names
+
+=head1 SYNOPSIS
+
+    use subs qw(frob);
+    frob 3..10;
+
+=head1 DESCRIPTION
+
+This will predeclare all the subroutine whose names are 
+in the list, allowing you to use them without parentheses
+even before they're declared.
+
+See L<perlmod/Pragmatic Modules> and L<strict/subs>.
+
+=cut
+require 5.000;
+
+sub import {
+    my $callpack = caller;
+    my $pack = shift;
+    my @imports = @_;
+    foreach $sym (@imports) {
+	*{"${callpack}::$sym"} = \&{"${callpack}::$sym"};
+    }
+};
+
+1;
diff --git a/gnu/usr.bin/perl/lib/syslog.pl b/gnu/usr.bin/perl/lib/syslog.pl
new file mode 100644
index 00000000000..29c3a1cc9af
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/syslog.pl
@@ -0,0 +1,197 @@
+#
+# syslog.pl
+#
+# $Log:	syslog.pl,v $
+# 
+# tom christiansen <tchrist@convex.com>
+# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
+# NOTE: openlog now takes three arguments, just like openlog(3)
+#
+# call syslog() with a string priority and a list of printf() args
+# like syslog(3)
+#
+#  usage: require 'syslog.pl';
+#
+#  then (put these all in a script to test function)
+#		
+#
+#	do openlog($program,'cons,pid','user');
+#	do syslog('info','this is another test');
+#	do syslog('mail|warning','this is a better test: %d', time);
+#	do closelog();
+#	
+#	do syslog('debug','this is the last test');
+#	do openlog("$program $$",'ndelay','user');
+#	do syslog('notice','fooprogram: this is really done');
+#
+#	$! = 55;
+#	do syslog('info','problem was %m'); # %m == $! in syslog(3)
+
+package syslog;
+
+$host = 'localhost' unless $host;	# set $syslog'host to change
+
+if ($] >= 5) {
+    warn "You should 'use Sys::Syslog' instead; continuing" # if $^W
+} 
+
+require 'syslog.ph';
+
+ eval 'use Socket' 			||
+     eval { require "socket.ph" } 	||
+     require "sys/socket.ph";
+
+$maskpri = &LOG_UPTO(&LOG_DEBUG);
+
+sub main'openlog {
+    ($ident, $logopt, $facility) = @_;  # package vars
+    $lo_pid = $logopt =~ /\bpid\b/;
+    $lo_ndelay = $logopt =~ /\bndelay\b/;
+    $lo_cons = $logopt =~ /\bcons\b/;
+    $lo_nowait = $logopt =~ /\bnowait\b/;
+    &connect if $lo_ndelay;
+} 
+
+sub main'closelog {
+    $facility = $ident = '';
+    &disconnect;
+} 
+
+sub main'setlogmask {
+    local($oldmask) = $maskpri;
+    $maskpri = shift;
+    $oldmask;
+}
+ 
+sub main'syslog {
+    local($priority) = shift;
+    local($mask) = shift;
+    local($message, $whoami);
+    local(@words, $num, $numpri, $numfac, $sum);
+    local($facility) = $facility;	# may need to change temporarily.
+
+    die "syslog: expected both priority and mask" unless $mask && $priority;
+
+    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
+    undef $numpri;
+    undef $numfac;
+    foreach (@words) {
+	$num = &xlate($_);		# Translate word to number.
+	if (/^kern$/ || $num < 0) {
+	    die "syslog: invalid level/facility: $_\n";
+	}
+	elsif ($num <= &LOG_PRIMASK) {
+	    die "syslog: too many levels given: $_\n" if defined($numpri);
+	    $numpri = $num;
+	    return 0 unless &LOG_MASK($numpri) & $maskpri;
+	}
+	else {
+	    die "syslog: too many facilities given: $_\n" if defined($numfac);
+	    $facility = $_;
+	    $numfac = $num;
+	}
+    }
+
+    die "syslog: level must be given\n" unless defined($numpri);
+
+    if (!defined($numfac)) {	# Facility not specified in this call.
+	$facility = 'user' unless $facility;
+	$numfac = &xlate($facility);
+    }
+
+    &connect unless $connected;
+
+    $whoami = $ident;
+
+    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+	$whoami = $1;
+	$mask = $2;
+    } 
+
+    unless ($whoami) {
+	($whoami = getlogin) ||
+	    ($whoami = getpwuid($<)) ||
+		($whoami = 'syslog');
+    }
+
+    $whoami .= "[$$]" if $lo_pid;
+
+    $mask =~ s/%m/$!/g;
+    $mask .= "\n" unless $mask =~ /\n$/;
+    $message = sprintf ($mask, @_);
+
+    $sum = $numpri + $numfac;
+    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+	if ($lo_cons) {
+	    if ($pid = fork) {
+		unless ($lo_nowait) {
+		    do {$died = wait;} until $died == $pid || $died < 0;
+		}
+	    }
+	    else {
+		open(CONS,">/dev/console");
+		print CONS "<$facility.$priority>$whoami: $message\r";
+		exit if defined $pid;		# if fork failed, we're parent
+		close CONS;
+	    }
+	}
+    }
+}
+
+sub xlate {
+    local($name) = @_;
+    $name =~ y/a-z/A-Z/;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "syslog'$name";
+    eval(&$name) || -1;
+}
+
+sub connect {
+    $pat = 'S n C4 x8';
+
+    $af_unix = &AF_UNIX;
+    $af_inet = &AF_INET;
+
+    $stream = &SOCK_STREAM;
+    $datagram = &SOCK_DGRAM;
+
+    ($name,$aliases,$proto) = getprotobyname('udp');
+    $udp = $proto;
+
+    ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
+    $syslog = $port;
+
+    if (chop($myname = `hostname`)) {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
+	die "Can't lookup $myname\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    else {
+	@bytes = (0,0,0,0);
+    }
+    $this = pack($pat, $af_inet, 0, @bytes);
+
+    if ($host =~ /^\d+\./) {
+	@bytes = split(/\./,$host);
+    }
+    else {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
+	die "Can't lookup $host\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    $that = pack($pat,$af_inet,$syslog,@bytes);
+
+    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
+    bind(SYSLOG,$this) || die "bind: $!\n";
+    connect(SYSLOG,$that) || die "connect: $!\n";
+
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/tainted.pl b/gnu/usr.bin/perl/lib/tainted.pl
new file mode 100644
index 00000000000..6e24867a83d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/tainted.pl
@@ -0,0 +1,9 @@
+# This subroutine returns true if its argument is tainted, false otherwise.
+
+sub tainted {
+    local($@);
+    eval { kill 0 * $_[0] };
+    $@ =~ /^Insecure/;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/termcap.pl b/gnu/usr.bin/perl/lib/termcap.pl
new file mode 100644
index 00000000000..e8f108df067
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/termcap.pl
@@ -0,0 +1,166 @@
+;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
+;#
+;# Usage:
+;#	require 'ioctl.pl';
+;#	ioctl(TTY,$TIOCGETP,$foo);
+;#	($ispeed,$ospeed) = unpack('cc',$foo);
+;#	require 'termcap.pl';
+;#	&Tgetent('vt100');	# sets $TC{'cm'}, etc.
+;#	&Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
+;#	&Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
+;#
+sub Tgetent {
+    local($TERM) = @_;
+    local($TERMCAP,$_,$entry,$loop,$field);
+
+    warn "Tgetent: no ospeed set" unless $ospeed;
+    foreach $key (keys(TC)) {
+	delete $TC{$key};
+    }
+    $TERM = $ENV{'TERM'} unless $TERM;
+    $TERM =~ s/(\W)/\\$1/g;
+    $TERMCAP = $ENV{'TERMCAP'};
+    $TERMCAP = '/etc/termcap' unless $TERMCAP;
+    if ($TERMCAP !~ m:^/:) {
+	if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
+	    $TERMCAP = '/etc/termcap';
+	}
+    }
+    if ($TERMCAP =~ m:^/:) {
+	$entry = '';
+	do {
+	    $loop = "
+	    open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
+	    while (<TERMCAP>) {
+		next if /^#/;
+		next if /^\t/;
+		if (/(^|\\|)${TERM}[:\\|]/) {
+		    chop;
+		    while (chop eq '\\\\') {
+			\$_ .= <TERMCAP>;
+			chop;
+		    }
+		    \$_ .= ':';
+		    last;
+		}
+	    }
+	    close TERMCAP;
+	    \$entry .= \$_;
+	    ";
+	    eval $loop;
+	} while s/:tc=([^:]+):/:/ && ($TERM = $1);
+	$TERMCAP = $entry;
+    }
+
+    foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
+	if ($field =~ /^\w\w$/) {
+	    $TC{$field} = 1;
+	}
+	elsif ($field =~ /^(\w\w)#(.*)/) {
+	    $TC{$1} = $2 if $TC{$1} eq '';
+	}
+	elsif ($field =~ /^(\w\w)=(.*)/) {
+	    $entry = $1;
+	    $_ = $2;
+	    s/\\E/\033/g;
+	    s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
+	    s/\\n/\n/g;
+	    s/\\r/\r/g;
+	    s/\\t/\t/g;
+	    s/\\b/\b/g;
+	    s/\\f/\f/g;
+	    s/\\\^/\377/g;
+	    s/\^\?/\177/g;
+	    s/\^(.)/pack('c',ord($1) & 31)/eg;
+	    s/\\(.)/$1/g;
+	    s/\377/^/g;
+	    $TC{$entry} = $_ if $TC{$entry} eq '';
+	}
+    }
+    $TC{'pc'} = "\0" if $TC{'pc'} eq '';
+    $TC{'bc'} = "\b" if $TC{'bc'} eq '';
+}
+
+@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
+
+sub Tputs {
+    local($string,$affcnt,$FH) = @_;
+    local($ms);
+    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
+	$ms = $1;
+	$ms *= $affcnt if $2;
+	$string = $3;
+	$decr = $Tputs[$ospeed];
+	if ($decr > .1) {
+	    $ms += $decr / 2;
+	    $string .= $TC{'pc'} x ($ms / $decr);
+	}
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+sub Tgoto {
+    local($string) = shift(@_);
+    local($result) = '';
+    local($after) = '';
+    local($code,$tmp) = @_;
+    local(@tmp);
+    @tmp = ($tmp,$code);
+    local($online) = 0;
+    while ($string =~ /^([^%]*)%(.)(.*)/) {
+	$result .= $1;
+	$code = $2;
+	$string = $3;
+	if ($code eq 'd') {
+	    $result .= sprintf("%d",shift(@tmp));
+	}
+	elsif ($code eq '.') {
+	    $tmp = shift(@tmp);
+	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
+		if ($online) {
+		    ++$tmp, $after .= $TC{'up'} if $TC{'up'};
+		}
+		else {
+		    ++$tmp, $after .= $TC{'bc'};
+		}
+	    }
+	    $result .= sprintf("%c",$tmp);
+	    $online = !$online;
+	}
+	elsif ($code eq '+') {
+	    $result .= sprintf("%c",shift(@tmp)+ord($string));
+	    $string = substr($string,1,99);
+	    $online = !$online;
+	}
+	elsif ($code eq 'r') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($tmp,$code);
+	    $online = !$online;
+	}
+	elsif ($code eq '>') {
+	    ($code,$tmp,$string) = unpack("CCa99",$string);
+	    if ($tmp[$[] > $code) {
+		$tmp[$[] += $tmp;
+	    }
+	}
+	elsif ($code eq '2') {
+	    $result .= sprintf("%02d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq '3') {
+	    $result .= sprintf("%03d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq 'i') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($code+1,$tmp+1);
+	}
+	else {
+	    return "OOPS";
+	}
+    }
+    $result . $string . $after;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/timelocal.pl b/gnu/usr.bin/perl/lib/timelocal.pl
new file mode 100644
index 00000000000..75f1ac1851a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/timelocal.pl
@@ -0,0 +1,109 @@
+;# timelocal.pl
+;#
+;# Usage:
+;#	$time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+;#	$time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+;# These routines are quite efficient and yet are always guaranteed to agree
+;# with localtime() and gmtime().  We manage this by caching the start times
+;# of any months we've seen before.  If we know the start time of the month,
+;# we can always calculate any time within the month.  The start times
+;# themselves are guessed by successive approximation starting at the
+;# current time, since most dates seen in practice are close to the
+;# current date.  Unlike algorithms that do a binary search (calling gmtime
+;# once for each bit of the time value, resulting in 32 calls), this algorithm
+;# calls it at most 6 times, and usually only once or twice.  If you hit
+;# the month cache, of course, it doesn't call it at all.
+
+;# timelocal is implemented using the same cache.  We just assume that we're
+;# translating a GMT time, and then fudge it when we're done for the timezone
+;# and daylight savings arguments.  The timezone is determined by examining
+;# the result of localtime(0) when the package is initialized.  The daylight
+;# savings offset is currently assumed to be one hour.
+
+;# Both routines return -1 if the integer limit is hit. I.e. for dates
+;# after the 1st of January, 2038 on most machines.
+
+CONFIG: {
+    package timelocal;
+    
+    local($[) = 0;
+    @epoch = localtime(0);
+    $tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
+    if ($tzmin > 0) {
+	$tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
+	$tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
+    }
+
+    $SEC = 1;
+    $MIN = 60 * $SEC;
+    $HR = 60 * $MIN;
+    $DAYS = 24 * $HR;
+    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+    1;
+}
+
+sub timegm {
+    package timelocal;
+
+    local($[) = 0;
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    return -1 if $cheat<0;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    package timelocal;
+
+    local($[) = 0;
+    $time = &main'timegm + $tzmin*$MIN;
+    return -1 if $cheat<0;
+    @test = localtime($time);
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+package timelocal;
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    die "Month out of range 0..11 in timelocal.pl\n" 
+	if $month > 11 || $month < 0;
+    die "Day out of range 1..31 in timelocal.pl\n" 
+	if $_[3] > 31 || $_[3] < 1;
+    die "Hour out of range 0..23 in timelocal.pl\n"
+	if $_[2] > 23 || $_[2] < 0;
+    die "Minute out of range 0..59 in timelocal.pl\n"
+	if $_[1] > 59 || $_[1] < 0;
+    die "Second out of range 0..59 in timelocal.pl\n"
+	if $_[0] > 59 || $_[0] < 0;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
+    $lastguess = "";
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (363 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (27 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    @gfake = gmtime($guess-1); #still being sceptic
+    if ("@gfake" eq $lastguess){
+	return -1; #date beyond this machine's integer limit
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $cheat{$ym} = $guess;
+}
diff --git a/gnu/usr.bin/perl/lib/validate.pl b/gnu/usr.bin/perl/lib/validate.pl
new file mode 100644
index 00000000000..21d0505ad4d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/validate.pl
@@ -0,0 +1,104 @@
+;# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
+
+;# The validate routine takes a single multiline string consisting of
+;# lines containing a filename plus a file test to try on it.  (The
+;# file test may also be a 'cd', causing subsequent relative filenames
+;# to be interpreted relative to that directory.)  After the file test
+;# you may put '|| die' to make it a fatal error if the file test fails.
+;# The default is '|| warn'.  The file test may optionally have a ! prepended
+;# to test for the opposite condition.  If you do a cd and then list some
+;# relative filenames, you may want to indent them slightly for readability.
+;# If you supply your own "die" or "warn" message, you can use $file to
+;# interpolate the filename.
+
+;# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
+;# Only the first failed test of the bunch will produce a warning.
+
+;# The routine returns the number of warnings issued.
+
+;# Usage:
+;#	require "validate.pl";
+;#	$warnings += do validate('
+;#	/vmunix			-e || die
+;#	/boot			-e || die
+;#	/bin			cd
+;#	    csh			-ex
+;#	    csh			!-ug
+;#	    sh			-ex
+;#	    sh			!-ug
+;#	/usr			-d || warn "What happened to $file?\n"
+;#	');
+
+sub validate {
+    local($file,$test,$warnings,$oldwarnings);
+    foreach $check (split(/\n/,$_[0])) {
+	next if $check =~ /^#/;
+	next if $check =~ /^$/;
+	($file,$test) = split(' ',$check,2);
+	if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
+	    $testlist = $2;
+	    @testlist = split(//,$testlist);
+	}
+	else {
+	    @testlist = ('Z');
+	}
+	$oldwarnings = $warnings;
+	foreach $one (@testlist) {
+	    $this = $test;
+	    $this =~ s/(-\w\b)/$1 \$file/g;
+	    $this =~ s/-Z/-$one/;
+	    $this .= ' || warn' unless $this =~ /\|\|/;
+	    $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/;
+	    $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
+	    eval $this;
+	    last if $warnings > $oldwarnings;
+	}
+    }
+    $warnings;
+}
+
+sub valmess {
+    local($disposition,$this) = @_;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|;
+    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
+	$neg = $1;
+	$tmp = $2;
+	$tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
+	$tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
+	$tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
+	$tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
+	$tmp eq 'R' && ($mess = "$file is not readable by you.");
+	$tmp eq 'W' && ($mess = "$file is not writable by you.");
+	$tmp eq 'X' && ($mess = "$file is not executable by you.");
+	$tmp eq 'O' && ($mess = "$file is not owned by you.");
+	$tmp eq 'e' && ($mess = "$file does not exist.");
+	$tmp eq 'z' && ($mess = "$file does not have zero size.");
+	$tmp eq 's' && ($mess = "$file does not have non-zero size.");
+	$tmp eq 'f' && ($mess = "$file is not a plain file.");
+	$tmp eq 'd' && ($mess = "$file is not a directory.");
+	$tmp eq 'l' && ($mess = "$file is not a symbolic link.");
+	$tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
+	$tmp eq 'S' && ($mess = "$file is not a socket.");
+	$tmp eq 'b' && ($mess = "$file is not a block special file.");
+	$tmp eq 'c' && ($mess = "$file is not a character special file.");
+	$tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
+	$tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
+	$tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
+	$tmp eq 'T' && ($mess = "$file is not a text file.");
+	$tmp eq 'B' && ($mess = "$file is not a binary file.");
+	if ($neg eq '!') {
+	    $mess =~ s/ is not / should not be / ||
+	    $mess =~ s/ does not / should not / ||
+	    $mess =~ s/ not / /;
+	}
+	print stderr $mess,"\n";
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	print stderr "Can't do $this.\n";
+    }
+    if ($disposition eq 'die') { exit 1; }
+    ++$warnings;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/vars.pm b/gnu/usr.bin/perl/lib/vars.pm
new file mode 100644
index 00000000000..b9519291c4b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/vars.pm
@@ -0,0 +1,39 @@
+package vars;
+
+=head1 NAME
+
+vars - Perl pragma to predeclare global variable names
+
+=head1 SYNOPSIS
+
+    use vars qw($frob @mung %seen);
+
+=head1 DESCRIPTION
+
+This will predeclare all the variables whose names are 
+in the list, allowing you to use them under "use strict", and
+disabling any typo warnings.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+require 5.000;
+use Carp;
+
+sub import {
+    my $callpack = caller;
+    my ($pack, @imports, $sym, $ch) = @_;
+    foreach $sym (@imports) {
+	croak "Can't declare another package's variables" if $sym =~ /::/;
+        ($ch, $sym) = unpack('a1a*', $sym);
+        *{"${callpack}::$sym"} =
+          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
+           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
+           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
+           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
+           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+           : croak "'$ch$sym' is not a valid variable name\n");
+    }
+};
+
+1;