vendor/perl5/5.005.02

155 files changed, 55968 insertions, 0 deletions

diff --git a/contrib/perl5/lib/AnyDBM_File.pm b/contrib/perl5/lib/AnyDBM_File.pm
new file mode 100644
index 000000000000..aff3c7cdec95
--- /dev/null
+++ b/contrib/perl5/lib/AnyDBM_File.pm
@@ -0,0 +1,92 @@
+package AnyDBM_File;
+
+use vars qw(@ISA);
+@ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
+
+my $mod;
+for $mod (@ISA) {
+    if (eval "require $mod") {
+	@ISA = ($mod);	# if we leave @ISA alone, warnings abound
+	return 1;
+    }
+}
+
+die "No DBM package was successfully found or installed";
+#return 0;
+
+=head1 NAME
+
+AnyDBM_File - provide framework for multiple DBMs
+
+NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_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:
+
+    BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
+    use AnyDBM_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/contrib/perl5/lib/AutoLoader.pm b/contrib/perl5/lib/AutoLoader.pm
new file mode 100644
index 000000000000..666c6cacf92d
--- /dev/null
+++ b/contrib/perl5/lib/AutoLoader.pm
@@ -0,0 +1,295 @@
+package AutoLoader;
+
+use vars qw(@EXPORT @EXPORT_OK);
+
+my $is_dosish;
+my $is_vms;
+
+BEGIN {
+    require Exporter;
+    @EXPORT = ();
+    @EXPORT_OK = qw(AUTOLOAD);
+    $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
+    $is_vms = $^O eq 'VMS';
+}
+
+AUTOLOAD {
+    my $name;
+    # Braces used to preserve $1 et al.
+    {
+	# Try to find the autoloaded file from the package-qualified
+	# name of the sub. e.g., if the sub needed is
+	# Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
+	# something like '/usr/lib/perl5/Getopt/Long.pm', and the
+	# autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
+	#
+	# However, if @INC is a relative path, this might not work.  If,
+	# for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
+	# 'lib/Getopt/Long.pm', and we want to require
+	# 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
+	# In this case, we simple prepend the 'auto/' and let the
+	# C<require> take care of the searching for us.
+
+	my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
+	$pkg =~ s#::#/#g;
+	if (defined($name=$INC{"$pkg.pm"})) {
+	    $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
+
+	    # if the file exists, then make sure that it is a
+	    # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
+	    # or './lib/auto/foo/bar.al'.  This avoids C<require> searching
+	    # (and failing) to find the 'lib/auto/foo/bar.al' because it
+	    # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
+
+	    if (-r $name) {
+	        unless ($name =~ m|^/|) {
+		    if ($is_dosish) {
+			unless ($name =~ m{^([a-z]:)?[\\/]}i) {
+			     $name = "./$name";
+			}
+		    }
+		    elsif ($is_vms) {
+		        # XXX todo by VMSmiths
+			$name = "./$name";
+		    }
+		    else {
+			$name = "./$name";
+		    }
+		}
+	    }
+	    else {
+		$name = undef;
+	    }
+	}
+	unless (defined $name) {
+	    # let C<require> do the searching
+	    $name = "auto/$AUTOLOAD.al";
+	    $name =~ s#::#/#g;
+	}
+    }
+    my $save = $@;
+    eval { local $SIG{__DIE__}; require $name };
+    if ($@) {
+	if (substr($AUTOLOAD,-9) eq '::DESTROY') {
+	    *$AUTOLOAD = sub {};
+	} else {
+	    # 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 {local $SIG{__DIE__};require $name};
+	    }
+	    if ($@){
+		$@ =~ s/ at .*\n//;
+		my $error = $@;
+		require Carp;
+		Carp::croak($error);
+	    }
+	}
+    }
+    $@ = $save;
+    goto &$AUTOLOAD;
+}
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+
+    #
+    # Export symbols, but not by accident of inheritance.
+    #
+
+    Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader';
+
+    #
+    # 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').
+    #
+
+    (my $calldir = $callpkg) =~ s#::#/#g;
+    my $path = $INC{$calldir . '.pm'};
+    if (defined($path)) {
+	# Try absolute path name.
+	$path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#;
+	eval { require $path; };
+	# If that failed, try relative path with normal @INC searching.
+	if ($@) {
+	    $path ="auto/$calldir/autosplit.ix";
+	    eval { require $path; };
+	}
+	if ($@) {
+	    my $error = $@;
+	    require Carp;
+	    Carp::carp($error);
+	}
+    } 
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+AutoLoader - load subroutines only on demand
+
+=head1 SYNOPSIS
+
+    package Foo;
+    use AutoLoader 'AUTOLOAD';   # import the default AUTOLOAD subroutine
+
+    package Bar;
+    use AutoLoader;              # don't import AUTOLOAD, define our own
+    sub AUTOLOAD {
+        ...
+        $AutoLoader::AUTOLOAD = "...";
+        goto &AutoLoader::AUTOLOAD;
+    }
+
+=head1 DESCRIPTION
+
+The B<AutoLoader> module works with the B<AutoSplit> module and the
+C<__END__> token to defer the loading of some subroutines until they are
+used rather than loading them all at once.
+
+To use B<AutoLoader>, the author of a module has to place the
+definitions of subroutines to be autoloaded after an C<__END__> token.
+(See L<perldata>.)  The B<AutoSplit> module can then be run manually to
+extract the definitions into individual files F<auto/funcname.al>.
+
+B<AutoLoader> implements an AUTOLOAD subroutine.  When an undefined
+subroutine in is called in a client module of B<AutoLoader>,
+B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a
+file with a name related to the location of the file from which the
+client module was read.  As an example, if F<POSIX.pm> is located in
+F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl
+subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where
+the C<.al> file has the same name as the subroutine, sans package.  If
+such a file exists, AUTOLOAD will read and evaluate it,
+thus (presumably) defining the needed subroutine.  AUTOLOAD will then
+C<goto> the newly defined subroutine.
+
+Once this process completes for a given funtion, it is defined, so
+future calls to the subroutine will bypass the AUTOLOAD mechanism.
+
+=head2 Subroutine Stubs
+
+In order for object method lookup and/or prototype checking to operate
+correctly even when methods have not yet been defined it is necessary to
+"forward declare" each subroutine (as in C<sub NAME;>).  See
+L<perlsub/"SYNOPSIS">.  Such forward declaration creates "subroutine
+stubs", which are place holders with no code.
+
+The AutoSplit and B<AutoLoader> modules automate the creation of forward
+declarations.  The AutoSplit module creates an 'index' file containing
+forward declarations of all the AutoSplit subroutines.  When the
+AutoLoader module is 'use'd it loads these declarations into its callers
+package.
+
+Because of this mechanism it is important that B<AutoLoader> is always
+C<use>d and not C<require>d.
+
+=head2 Using B<AutoLoader>'s AUTOLOAD Subroutine
+
+In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must>
+explicitly import it:
+
+    use AutoLoader 'AUTOLOAD';
+
+=head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine
+
+Some modules, mainly extensions, provide their own AUTOLOAD subroutines.
+They typically need to check for some special cases (such as constants)
+and then fallback to B<AutoLoader>'s AUTOLOAD for the rest.
+
+Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine.
+Instead, they should define their own AUTOLOAD subroutines along these
+lines:
+
+    use AutoLoader;
+    use Carp;
+
+    sub AUTOLOAD {
+        my $constname;
+        ($constname = $AUTOLOAD) =~ s/.*:://;
+        my $val = constant($constname, @_ ? $_[0] : 0);
+        if ($! != 0) {
+            if ($! =~ /Invalid/) {
+                $AutoLoader::AUTOLOAD = $AUTOLOAD;
+                goto &AutoLoader::AUTOLOAD;
+            }
+            else {
+                croak "Your vendor has not defined constant $constname";
+            }
+        }
+	*$AUTOLOAD = sub { $val }; # same as: eval "sub $AUTOLOAD { $val }";
+        goto &$AUTOLOAD;
+    }
+
+If any module's own AUTOLOAD subroutine has no need to fallback to the
+AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit
+subroutines), then that module should not use B<AutoLoader> at all.
+
+=head2 Package Lexicals
+
+Package lexicals declared with C<my> in the main block of a package
+using B<AutoLoader> will not be visible to auto-loaded subroutines, due to
+the fact that the given scope ends at the C<__END__> marker.  A module
+using such variables as package globals will not work properly under the
+B<AutoLoader>.
+
+The C<vars> pragma (see L<perlmod/"vars">) may be used in such
+situations as an alternative to explicitly qualifying all globals with
+the package namespace.  Variables pre-declared with this pragma will be
+visible to any autoloaded routines (but will not be invisible outside
+the package, unfortunately).
+
+=head2 B<AutoLoader> vs. B<SelfLoader>
+
+The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the
+loading of subroutines.
+
+B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>.
+While this avoids the use of a hierarchy of disk files and the
+associated open/close for each routine loaded, B<SelfLoader> suffers a
+startup speed disadvantage in the one-time parsing of the lines after
+C<__DATA__>, after which routines are cached.  B<SelfLoader> can also
+handle multiple packages in a file.
+
+B<AutoLoader> only reads code as it is requested, and in many cases
+should be faster, but requires a machanism like B<AutoSplit> be used to
+create the individual files.  L<ExtUtils::MakeMaker> will invoke
+B<AutoSplit> automatically if B<AutoLoader> is used in a module source
+file.
+
+=head1 CAVEATS
+
+AutoLoaders prior to Perl 5.002 had a slightly different interface.  Any
+old modules which use B<AutoLoader> should be changed to the new calling
+style.  Typically this just means changing a require to a use, adding
+the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader>
+from C<@ISA>.
+
+On systems with restrictions on file name length, the file corresponding
+to a subroutine may have a shorter name that the routine itself.  This
+can lead to conflicting file names.  The I<AutoSplit> package warns of
+these potential conflicts when used to split a module.
+
+AutoLoader may fail to find the autosplit files (or even find the wrong
+ones) in cases where C<@INC> contains relative paths, B<and> the program
+does C<chdir>.
+
+=head1 SEE ALSO
+
+L<SelfLoader> - an autoloader that doesn't use external files.
+
+=cut
diff --git a/contrib/perl5/lib/AutoSplit.pm b/contrib/perl5/lib/AutoSplit.pm
new file mode 100644
index 000000000000..121d26154d30
--- /dev/null
+++ b/contrib/perl5/lib/AutoSplit.pm
@@ -0,0 +1,461 @@
+package AutoSplit;
+
+use Exporter ();
+use Config qw(%Config);
+use Carp qw(carp);
+use File::Basename ();
+use File::Path qw(mkpath);
+use strict;
+use vars qw(
+	    $VERSION @ISA @EXPORT @EXPORT_OK
+	    $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
+	   );
+
+$VERSION = "1.0302";
+@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
+
+ autosplit($file, $dir, $keep, $check, $modtime);
+
+ autosplit_lib_modules(@modules);
+
+=head1 DESCRIPTION
+
+This function will split up your program into files that the AutoLoader
+module can handle. It is used by both the standard perl libraries and by
+the MakeMaker utility, to automatically configure libraries for autoloading.
+
+The C<autosplit> interface splits the specified file into a hierarchy 
+rooted at the directory C<$dir>. It creates directories as needed to reflect
+class hierarchy, and creates the file F<autosplit.ix>. This file acts as
+both forward declaration of all package routines, and as timestamp for the
+last update of the hierarchy.
+
+The remaining three arguments to C<autosplit> govern other options to
+the autosplitter.
+
+=over 2
+
+=item $keep
+
+If the third argument, I<$keep>, is false, then any
+pre-existing C<*.al> files in the autoload directory are removed if
+they are no longer part of the module (obsoleted functions).
+$keep defaults to 0.
+
+=item $check
+
+The
+fourth argument, I<$check>, instructs C<autosplit> to check the module
+currently being split to ensure that it does include a C<use>
+specification for the AutoLoader module, and skips the module if
+AutoLoader is not detected.
+$check defaults to 1.
+
+=item $modtime
+
+Lastly, the I<$modtime> argument specifies
+that C<autosplit> is to check the modification time of the module
+against that of the C<autosplit.ix> file, and only split the module if
+it is newer.
+$modtime defaults to 1.
+
+=back
+
+Typical use of AutoSplit in the perl MakeMaker utility is via the command-line
+with:
+
+ perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)'
+
+Defined as a Make macro, it is invoked with file and directory arguments;
+C<autosplit> will split the specified file into the specified directory and
+delete obsolete C<.al> files, after checking first that the module does use
+the AutoLoader, and ensuring that the module is not already currently split
+in its current form (the modtime test).
+
+The C<autosplit_lib_modules> form is used in the building of perl. It takes
+as input a list of files (modules) that are assumed to reside in a directory
+B<lib> relative to the current directory. Each file is sent to the 
+autosplitter one at a time, to be split into the directory B<lib/auto>.
+
+In both usages of the autosplitter, only subroutines defined following the
+perl I<__END__> token are split out into separate files. Some
+routines may be placed prior to this marker to force their immediate loading
+and parsing.
+
+=head2 Multiple packages
+
+As of version 1.01 of the AutoSplit module it is possible to have
+multiple packages within a single file. Both of the following cases
+are supported:
+
+   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 { ... }
+
+=head1 DIAGNOSTICS
+
+C<AutoSplit> will inform the user if it is necessary to create the
+top-level directory specified in the invocation. It is preferred that
+the script or installation process that invokes C<AutoSplit> have
+created the full directory path ahead of time. This warning may
+indicate that the module is being split into an incorrect path.
+
+C<AutoSplit> will warn the user of all subroutines whose name causes
+potential file naming conflicts on machines with drastically limited
+(8 characters or less) file name length. Since the subroutine name is
+used as the file name, these warnings can aid in portability to such
+systems.
+
+Warnings are issued and the file skipped if C<AutoSplit> cannot locate
+either the I<__END__> marker or a "package Name;"-style specification.
+
+C<AutoSplit> will also emit general diagnostics for inability to
+create directories or files.
+
+=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;
+
+my $IndexFile = "autosplit.ix";	# file also serves as timestamp
+my $maxflen = 255;
+$maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
+if (defined (&Dos::UseLFN)) {
+     $maxflen = Dos::UseLFN() ? 255 : 11;
+}
+my $Is_VMS = ($^O eq 'VMS');
+
+
+sub autosplit{
+    my($file, $autodir,  $keep, $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 $keep;
+    $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_lib_modules(@ARGV)' ...
+
+sub autosplit_lib_modules{
+    my(@modules) = @_; # list of Module names
+
+    while(defined($_ = shift @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(@outfiles);
+    local($_);
+    local($/) = "\n";
+
+    # where to write output files
+    $autodir ||= "lib/auto";
+    if ($Is_VMS) {
+	($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/$||;
+	$filename = VMS::Filespec::unixify($filename); # may have dirs
+    }
+    unless (-d $autodir){
+	mkpath($autodir,0,0755);
+	# 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") or die "AutoSplit: Can't open $filename: $!\n";
+    my($pm_mod_time) = (stat($filename))[9];
+    my($autoloader_seen) = 0;
+    my($in_pod) = 0;
+    my($def_package,$last_package,$this_package,$fnr);
+    while (<IN>) {
+	# Skip pod text.
+	$fnr++;
+	$in_pod = 1 if /^=/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+
+	# record last package name seen
+	$def_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";
+
+    $def_package or die "Can't find 'package Name;' in $filename\n";
+
+    my($modpname) = _modpname($def_package); 
+
+    # this _has_ to match so we have a reasonable timestamp file
+    die "Package $def_package ($modpname.pm) does not ".
+	"match filename $filename"
+	    unless ($filename =~ m/\Q$modpname.pm\E$/ or
+		    ($^O eq 'dos') or ($^O eq 'MSWin32') or
+	            $Is_VMS && $filename =~ m/$modpname.pm/i);
+
+    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+
+    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 than $filename)\n"
+		if ($Verbose >= 2);
+	    return undef;	# one undef, not a list
+	}
+    }
+
+    print "AutoSplitting $filename ($autodir/$modpname)\n"
+	if $Verbose;
+
+    unless (-d "$autodir/$modpname"){
+	mkpath("$autodir/$modpname",0,0777);
+    }
+
+    # 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.
+
+    my $Is83 = $maxflen==11;  # plain, case INSENSITIVE dos filenames
+
+    my(@subnames, $subname, %proto, %package);
+    my @cache = ();
+    my $caching = 1;
+    $last_package = '';
+    while (<IN>) {
+	$fnr++;
+	$in_pod = 1 if /^=/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+	# the following (tempting) old coding gives big troubles if a
+	# cut is forgotten at EOF:
+	# next if /^=\w/ .. /^=cut/;
+	if (/^package\s+([\w:]+)\s*;/) {
+	    $this_package = $def_package = $1;
+	}
+	if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
+	    print OUT "# end of $last_package\::$subname\n1;\n"
+		if $last_package;
+	    $subname = $1;
+	    my $proto = $2 || '';
+	    if ($subname =~ s/(.*):://){
+		$this_package = $1;
+	    } else {
+		$this_package = $def_package;
+	    }
+	    my $fq_subname = "$this_package\::$subname";
+	    $package{$fq_subname} = $this_package;
+	    $proto{$fq_subname} = $proto;
+	    push(@subnames, $fq_subname);
+	    my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
+	    $modpname = _modpname($this_package);
+	    mkpath("$autodir/$modpname",0,0777);
+	    my($lpath) = "$autodir/$modpname/$lname.al";
+	    my($spath) = "$autodir/$modpname/$sname.al";
+	    my $path;
+	    if (!$Is83 and open(OUT, ">$lpath")){
+	        $path=$lpath;
+		print "  writing $lpath\n" if ($Verbose>=2);
+	    } else {
+		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+		$path=$spath;
+		print "  writing $spath (with truncated name)\n"
+			if ($Verbose>=1);
+	    }
+	    push(@outfiles, $path);
+	    print OUT <<EOT;
+# NOTE: Derived from $filename.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package $this_package;
+
+#line $fnr "$filename (autosplit into $path)"
+EOT
+	    print OUT @cache;
+	    @cache = ();
+	    $caching = 0;
+	}
+	if($caching) {
+	    push(@cache, $_) if @cache || /\S/;
+	} else {
+	    print OUT $_;
+	}
+	if(/^\}/) {
+	    if($caching) {
+		print OUT @cache;
+		@cache = ();
+	    }
+	    print OUT "\n";
+	    $caching = 1;
+	}
+	$last_package = $this_package if defined $this_package;
+    }
+    print OUT @cache,"1;\n# end of $last_package\::$subname\n";
+    close(OUT);
+    close(IN);
+    
+    if (!$keep){  # don't keep any obsolete *.al files in the directory
+	my(%outfiles);
+	# @outfiles{@outfiles} = @outfiles;
+	# perl downcases all filenames on VMS (which upcases all filenames) so
+	# we'd better downcase the sub name list too, or subs with upper case
+	# letters in them will get their .al files deleted right after they're
+	# created. (The mixed case sub name won't match the all-lowercase
+	# filename, and so be cleaned up as a scrap file)
+	if ($Is_VMS or $Is83) {
+	    %outfiles = map {lc($_) => lc($_) } @outfiles;
+	} else {
+	    @outfiles{@outfiles} = @outfiles;
+	}  
+	my(%outdirs,@outdirs);
+	for (@outfiles) {
+	    $outdirs{File::Basename::dirname($_)}||=1;
+	}
+	for my $dir (keys %outdirs) {
+	    opendir(OUTDIR,$dir);
+	    foreach (sort readdir(OUTDIR)){
+		next unless /\.al$/;
+		my($file) = "$dir/$_";
+		$file = lc $file if $Is83 or $Is_VMS;
+		next if $outfiles{$file};
+		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\n";
+    print TS "#    (file acts as timestamp)\n";
+    $last_package = '';
+    for my $fqs (@subnames) {
+	my($subname) = $fqs;
+	$subname =~ s/.*:://;
+	print TS "package $package{$fqs};\n"
+	    unless $last_package eq $package{$fqs};
+	print TS "sub $subname $proto{$fqs};\n";
+	$last_package = $package{$fqs};
+    }
+    print TS "1;\n";
+    close(TS);
+
+    _check_unique($filename, $Maxlen, 1, @outfiles);
+
+    @outfiles;
+}
+
+sub _modpname ($) {
+    my($package) = @_;
+    my $modpname = $package;
+    if ($^O eq 'MSWin32') {
+	$modpname =~ s#::#\\#g; 
+    } else {
+	$modpname =~ s#::#/#g;
+    }
+    $modpname;
+}
+
+sub _check_unique {
+    my($filename, $maxlen, $warn, @outfiles) = @_;
+    my(%notuniq) = ();
+    my(%shorts)  = ();
+    my(@toolong) = grep(
+			length(File::Basename::basename($_))
+			> $maxlen,
+			@outfiles
+		       );
+
+    foreach (@toolong){
+	my($dir) = File::Basename::dirname($_);
+	my($file) = File::Basename::basename($_);
+	my($trunc) = substr($file,0,$maxlen);
+	$notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
+	$shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
+	    "$shorts{$dir}{$trunc}, $file" : $file;
+    }
+    if (%notuniq && $warn){
+	print "$filename: some names are not unique when " .
+	    "truncated to $maxlen characters:\n";
+	foreach my $dir (sort keys %notuniq){
+	    print " directory $dir:\n";
+	    foreach my $trunc (sort keys %{$notuniq{$dir}}) {
+		print "  $shorts{$dir}{$trunc} truncate to $trunc\n";
+	    }
+	}
+    }
+}
+
+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 testtesttesttest4_1  { "test 4\n"; }
+sub testtesttesttest4_2  { "duplicate test 4\n"; }
+sub Just::Another::test5 { "another test 5\n"; }
+sub test6       { return join ":", __FILE__,__LINE__; }
+package Yet::Another::AutoSplit;
+sub testtesttesttest4_1 ($)  { "another test 4\n"; }
+sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; }
diff --git a/contrib/perl5/lib/Benchmark.pm b/contrib/perl5/lib/Benchmark.pm
new file mode 100644
index 000000000000..a28f510d1126
--- /dev/null
+++ b/contrib/perl5/lib/Benchmark.pm
@@ -0,0 +1,515 @@
+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");
+
+    # Use Perl code in strings...
+    timethese($count, {
+	'Name1' => '...code1...',
+	'Name2' => '...code2...',
+    });
+
+    # ... or use subroutine references.
+    timethese($count, {
+	'Name1' => sub { ...code1... },
+	'Name2' => sub { ...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($td),"\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 times to run the loop, and CODE is
+the code to run.  CODE may be either a code reference or a string to
+be eval'd; either way it will be run in the caller's package.
+
+Returns: a Benchmark object.
+
+=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
+
+Time COUNT iterations of CODE. CODE may be a string to eval or a
+code reference; either way the CODE will run in the caller's package.
+Results will be printed to STDOUT as TITLE followed by the times.
+TITLE defaults to "timethis COUNT" if none is provided. STYLE
+determines the format of the output, as described for timestr() below.
+
+The COUNT can be zero or negative: this means the I<minimum number of
+CPU seconds> to run.  A zero signifies the default of 3 seconds.  For
+example to run at least for 10 seconds:
+
+	timethis(-10, $code)
+
+or to run two pieces of code tests for at least 3 seconds:
+
+	timethese(0, { test1 => '...', test2 => '...'})
+
+CPU seconds is, in UNIX terms, the user time plus the system time of
+the process itself, as opposed to the real (wallclock) time and the
+time spent by the child processes.  Less than 0.1 seconds is not
+accepted (-0.01 as the count, for example, will cause a fatal runtime
+exception).
+
+Note that the CPU seconds is the B<minimum> time: CPU scheduling and
+other operating system factors may complicate the attempt so that a
+little bit more time is spent.  The benchmark output will, however,
+also tell the number of C<$code> runs/second, which should be a more
+interesting number than the actually spent seconds.
+
+Returns a Benchmark object.
+
+=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
+
+The CODEHASHREF is a reference to a hash containing names as keys
+and either a string to eval or a code reference for each value.
+For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
+call
+
+	timethis(COUNT, VALUE, KEY, STYLE)
+
+The routines are called in string comparison order of KEY.
+
+The COUNT can be zero or negative, see timethis().
+
+=item timediff ( T1, T2 )
+
+Returns the difference between two Benchmark times as a Benchmark
+object suitable for passing to timestr().
+
+=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
+
+Returns a string that formats the times in the TIMEDIFF object in
+the requested STYLE. TIMEDIFF is expected to be a Benchmark object
+similar to that returned by timediff().
+
+STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
+of the 5 times available ('wallclock' time, user time, system time,
+user time of children, and system time of children). 'noc' shows all
+except the two children times. 'nop' shows only wallclock and the
+two children times. 'auto' (the default) will act as 'all' unless
+the children times are both zero, in which case it acts as 'noc'.
+
+FORMAT is the L<printf(3)>-style format specifier (without the
+leading '%') to use to print the times. It defaults to '5.2f'.
+
+=back
+
+=head2 Optional Exports
+
+The following routines will be exported into your namespace
+if you specifically ask that they be imported:
+
+=over 10
+
+=item clearcache ( COUNT )
+
+Clear the cached time for COUNT rounds of the null loop.
+
+=item clearallcache ( )
+
+Clear all cached times.
+
+=item disablecache ( )
+
+Disable caching of timings for the null loop. This will force Benchmark
+to recalculate these timings for each new piece of code timed.
+
+=item enablecache ( )
+
+Enable caching of timings for the null loop. The time taken for COUNT
+rounds of the null loop will be calculated only once for each
+different COUNT used.
+
+=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.
+
+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
+
+Comparing eval'd strings with code references will give you
+inaccurate results: a code reference will show a slower
+execution time than the equivalent eval'd string.
+
+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 E<lt> 0.
+
+=head1 AUTHORS
+
+Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
+
+=head1 MODIFICATION HISTORY
+
+September 8th, 1994; by Tim Bunce.
+
+March 28th, 1997; by Hugo van der Sanden: added support for code
+references and the already documented 'debug' method; revamped
+documentation.
+
+April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
+functionality.
+
+=cut
+
+# evaluate something in a clean lexical environment
+sub _doeval { eval shift }
+
+#
+# put any lexicals at file scope AFTER here
+#
+
+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 debug { $debug = ($_[1] != 0); }
+
+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, @_ == 2 ? $_[1] : 0);
+	  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 (my $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 (@t)" unless @t==6;
+    my($r, $pu, $ps, $cu, $cs, $n) = @t;
+    my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
+    $f = $defaultfmt unless defined $f;
+    # format a time in the required style, other formats may be added here
+    $style ||= $defaultstyle;
+    $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
+    my $s = "@t $style"; # default for unknown style
+    $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
+			    @t,$t) if $style eq 'all';
+    $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
+			    $r,$pu,$ps,$pt) if $style eq 'noc';
+    $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
+			    $r,$cu,$cs,$ct) if $style eq 'nop';
+    $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
+    $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 "negative loopcount $n" if $n<0;
+    confess "Usage: runloop(number, [string | coderef])" 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, $subref);
+    if (ref $c eq 'CODE') {
+	$subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
+        $subref  = eval $subcode;
+    }
+    else {
+	$subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
+        $subref  = _doeval($subcode);
+    }
+    croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
+    print STDERR "runloop $n '$subcode'\n" if $debug;
+
+    $t0 = Benchmark->new(0);
+    &$subref;
+    $t1 = Benchmark->new($n);
+    $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;
+}
+
+
+my $default_for = 3;
+my $min_for     = 0.1;
+
+sub runfor {
+    my ($code, $tmax) = @_;
+
+    if ( not defined $tmax or $tmax == 0 ) {
+	$tmax = $default_for;
+    } elsif ( $tmax < 0 ) {
+	$tmax = -$tmax;
+    }
+
+    die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
+	if $tmax < $min_for;
+
+    my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
+
+    # First find the minimum $n that gives a non-zero timing.
+    
+    my $nmin;
+
+    for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
+	$td = timeit($n, $code);
+	$tc = $td->[1] + $td->[2];
+    }
+
+    $nmin = $n;
+
+    my $ttot = 0;
+    my $tpra = 0.05 * $tmax; # Target/time practice.
+
+    # Double $n until we have think we have practiced enough.
+    for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
+	$td = timeit($n, $code);
+	$tc = $td->cpu_p;
+	$ntot += $n;
+	$rtot += $td->[0];
+	$utot += $td->[1];
+	$stot += $td->[2];
+	$ttot = $utot + $stot;
+	$cutot += $td->[3];
+	$cstot += $td->[4];
+    }
+
+    my $r;
+
+    # Then iterate towards the $tmax.
+    while ( $ttot < $tmax ) {
+	$r = $tmax / $ttot - 1; # Linear approximation.
+	$n = int( $r * $n );
+	$n = $nmin if $n < $nmin;
+	$td = timeit($n, $code);
+	$ntot += $n;
+	$rtot += $td->[0];
+	$utot += $td->[1];
+	$stot += $td->[2];
+	$ttot = $utot + $stot;
+	$cutot += $td->[3];
+	$cstot += $td->[4];
+    }
+
+    return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
+}
+
+# --- Functions implementing high-level time-then-print utilities
+
+sub n_to_for {
+    my $n = shift;
+    return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
+}
+
+sub timethis{
+    my($n, $code, $title, $style) = @_;
+    my($t, $for, $forn);
+
+    if ( $n > 0 ) {
+	croak "non-integer loopcount $n, stopped" if int($n)<$n;
+	$t = timeit($n, $code);
+	$title = "timethis $n" unless defined $title;
+    } else {
+	$fort  = n_to_for( $n );
+	$t     = runfor($code, $fort);
+	$title = "timethis for $fort" unless defined $title;
+	$forn  = $t->[-1];
+    }
+    local $| = 1;
+    $style = "" unless defined $style;
+    printf("%10s: ", $title);
+    print timestr($t, $style, $defaultfmt),"\n";
+
+    $n = $forn if defined $forn;
+
+    # 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 @names = sort keys %$alt;
+    $style = "" unless defined $style;
+    print "Benchmark: ";
+    if ( $n > 0 ) {
+	croak "non-integer loopcount $n, stopped" if int($n)<$n;
+	print "timing $n iterations of";
+    } else {
+	print "running";
+    }
+    print " ", join(', ',@names);
+    unless ( $n > 0 ) {
+	my $for = n_to_for( $n );
+	print ", each for at least $for CPU seconds";
+    }
+    print "...\n";
+
+    # we could save the results in an array and produce a summary here
+    # sum, min, max, avg etc etc
+    foreach my $name (@names) {
+        timethis ($n, $alt -> {$name}, $name, $style);
+    }
+}
+
+1;
diff --git a/contrib/perl5/lib/CGI.pm b/contrib/perl5/lib/CGI.pm
new file mode 100644
index 000000000000..22d91a46c7cc
--- /dev/null
+++ b/contrib/perl5/lib/CGI.pm
@@ -0,0 +1,6102 @@
+package CGI;
+require 5.004;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995-1998 Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::revision = '$Id: CGI.pm,v 1.32 1998/05/28 21:55:43 lstein Exp lstein $';
+$CGI::VERSION='2.42';
+
+# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
+# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
+# $TempFile::TMPDIRECTORY = '/usr/tmp';
+
+# >>>>> Here are some globals that you might want to adjust <<<<<<
+sub initialize_globals {
+    # Set this to 1 to enable copious autoloader debugging messages
+    $AUTOLOAD_DEBUG = 0;
+
+    # Change this to the preferred DTD to print in start_html()
+    # or use default_dtd('text of DTD to use');
+    $DEFAULT_DTD = '-//IETF//DTD HTML//EN';
+
+    # Set this to 1 to enable NPH scripts
+    # or: 
+    #    1) use CGI qw(-nph)
+    #    2) $CGI::nph(1)
+    #    3) print header(-nph=>1)
+    $NPH = 0;
+
+    # Set this to 1 to disable debugging from the
+    # command line
+    $NO_DEBUG = 0;
+
+    # Set this to 1 to make the temporary files created
+    # during file uploads safe from prying eyes
+    # or do...
+    #    1) use CGI qw(:private_tempfiles)
+    #    2) $CGI::private_tempfiles(1);
+    $PRIVATE_TEMPFILES = 0;
+
+    # Set this to a positive value to limit the size of a POSTing
+    # to a certain number of bytes:
+    $POST_MAX = -1;
+
+    # Change this to 1 to disable uploads entirely:
+    $DISABLE_UPLOADS = 0;
+
+    # Other globals that you shouldn't worry about.
+    undef $Q;
+    $BEEN_THERE = 0;
+    undef @QUERY_PARAM;
+    undef %EXPORT;
+
+    # prevent complaints by mod_perl
+    1;
+}
+
+# ------------------ START OF THE LIBRARY ------------
+
+# make mod_perlhappy
+initialize_globals();
+
+# FIGURE OUT THE OS WE'RE RUNNING UNDER
+# Some systems support the $^O variable.  If not
+# available then require() the Config library
+unless ($OS) {
+    unless ($OS = $^O) {
+	require Config;
+	$OS = $Config::Config{'osname'};
+    }
+}
+if ($OS=~/Win/i) {
+    $OS = 'WINDOWS';
+} elsif ($OS=~/vms/i) {
+    $OS = 'VMS';
+} elsif ($OS=~/^MacOS$/i) {
+    $OS = 'MACINTOSH';
+} elsif ($OS=~/os2/i) {
+    $OS = 'OS2';
+} else {
+    $OS = 'UNIX';
+}
+
+# Some OS logic.  Binary mode enabled on DOS, NT and VMS
+$needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;
+
+# This is the default class for the CGI object to use when all else fails.
+$DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
+
+# This is where to look for autoloaded routines.
+$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
+
+# The path separator is a slash, backslash or semicolon, depending
+# on the paltform.
+$SL = {
+    UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', MACINTOSH=>':', VMS=>'/'
+    }->{$OS};
+
+# This no longer seems to be necessary
+# Turn on NPH scripts by default when running under IIS server!
+# $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
+$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
+
+# Turn on special checking for Doug MacEachern's modperl
+if (defined($ENV{'GATEWAY_INTERFACE'}) && 
+    ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) 
+{
+    $| = 1;
+    require Apache;
+}
+# Turn on special checking for ActiveState's PerlEx
+$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+
+# Define the CRLF sequence.  I can't use a simple "\r\n" because the meaning
+# of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF
+# and sometimes CR).  The most popular VMS web server
+# doesn't accept CRLF -- instead it wants a LR.  EBCDIC machines don't
+# use ASCII, so \015\012 means something different.  I find this all 
+# really annoying.
+$EBCDIC = "\t" ne "\011";
+if ($OS eq 'VMS') {
+    $CRLF = "\n";
+} elsif ($EBCDIC) {
+    $CRLF= "\r\n";
+} else {
+    $CRLF = "\015\012";
+}
+
+if ($needs_binmode) {
+    $CGI::DefaultClass->binmode(main::STDOUT);
+    $CGI::DefaultClass->binmode(main::STDIN);
+    $CGI::DefaultClass->binmode(main::STDERR);
+}
+
+%EXPORT_TAGS = (
+		':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em
+			   tt u i b blockquote pre img a address cite samp dfn html head
+			   base body Link nextid title meta kbd start_html end_html
+			   input Select option comment/],
+		':html3'=>[qw/div table caption th td TR Tr sup sub strike applet Param 
+			   embed basefont style span layer ilayer font frameset frame script small big/],
+		':netscape'=>[qw/blink fontsize center/],
+		':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group 
+			  submit reset defaults radio_group popup_menu button autoEscape
+			  scrolling_list image_button start_form end_form startform endform
+			  start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
+		':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
+			 raw_cookie request_method query_string accept user_agent remote_host 
+			 remote_addr referer server_name server_software server_port server_protocol
+			 virtual_host remote_ident auth_type http use_named_parameters 
+			 save_parameters restore_parameters param_fetch
+			 remote_user user_name header redirect import_names put Delete Delete_all url_param/],
+		':ssl' => [qw/https/],
+		':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
+		':html' => [qw/:html2 :html3 :netscape/],
+		':standard' => [qw/:html2 :html3 :form :cgi/],
+		':push' => [qw/multipart_init multipart_start multipart_end/],
+		':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
+		);
+
+# to import symbols into caller
+sub import {
+    my $self = shift;
+
+# This causes modules to clash.  
+#    undef %EXPORT_OK;
+#    undef %EXPORT;
+
+    $self->_setup_symbols(@_);
+    my ($callpack, $callfile, $callline) = caller;
+
+    # To allow overriding, search through the packages
+    # Till we find one in which the correct subroutine is defined.
+    my @packages = ($self,@{"$self\:\:ISA"});
+    foreach $sym (keys %EXPORT) {
+	my $pck;
+	my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
+	foreach $pck (@packages) {
+	    if (defined(&{"$pck\:\:$sym"})) {
+		$def = $pck;
+		last;
+	    }
+	}
+	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
+    }
+}
+
+sub compile {
+    my $pack = shift;
+    $pack->_setup_symbols('-compile',@_);
+}
+
+sub expand_tags {
+    my($tag) = @_;
+    my(@r);
+    return ($tag) unless $EXPORT_TAGS{$tag};
+    foreach (@{$EXPORT_TAGS{$tag}}) {
+	push(@r,&expand_tags($_));
+    }
+    return @r;
+}
+
+#### Method: new
+# The new routine.  This will check the current environment
+# for an existing query string, and initialize itself, if so.
+####
+sub new {
+    my($class,$initializer) = @_;
+    my $self = {};
+    bless $self,ref $class || $class || $DefaultClass;
+    if ($MOD_PERL) {
+	Apache->request->register_cleanup(\&CGI::_reset_globals);
+	undef $NPH;
+    }
+    $self->_reset_globals if $PERLEX;
+    $self->init($initializer);
+    return $self;
+}
+
+# We provide a DESTROY method so that the autoloader
+# doesn't bother trying to find it.
+sub DESTROY { }
+
+#### Method: param
+# Returns the value(s)of a named parameter.
+# If invoked in a list context, returns the
+# entire list.  Otherwise returns the first
+# member of the list.
+# If name is not provided, return a list of all
+# the known parameters names available.
+# If more than one argument is provided, the
+# second and subsequent arguments are used to
+# set the value of the parameter.
+####
+sub param {
+    my($self,@p) = self_or_default(@_);
+    return $self->all_parameters unless @p;
+    my($name,$value,@other);
+
+    # For compatibility between old calling style and use_named_parameters() style, 
+    # we have to special case for a single parameter present.
+    if (@p > 1) {
+	($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
+	my(@values);
+
+	if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
+	    @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
+	} else {
+	    foreach ($value,@other) {
+		push(@values,$_) if defined($_);
+	    }
+	}
+	# If values is provided, then we set it.
+	if (@values) {
+	    $self->add_parameter($name);
+	    $self->{$name}=[@values];
+	}
+    } else {
+	$name = $p[0];
+    }
+
+    return () unless defined($name) && $self->{$name};
+    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+}
+
+sub self_or_default {
+    return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI');
+    unless (defined($_[0]) && 
+	    (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case
+	    ) {
+	$Q = $CGI::DefaultClass->new unless defined($Q);
+	unshift(@_,$Q);
+    }
+    return @_;
+}
+
+sub self_or_CGI {
+    local $^W=0;                # prevent a warning
+    if (defined($_[0]) &&
+	(substr(ref($_[0]),0,3) eq 'CGI' 
+	 || UNIVERSAL::isa($_[0],'CGI'))) {
+	return @_;
+    } else {
+	return ($DefaultClass,@_);
+    }
+}
+
+########################################
+# THESE METHODS ARE MORE OR LESS PRIVATE
+# GO TO THE __DATA__ SECTION TO SEE MORE
+# PUBLIC METHODS
+########################################
+
+# Initialize the query object from the environment.
+# If a parameter list is found, this object will be set
+# to an associative array in which parameter names are keys
+# and the values are stored as lists
+# If a keyword list is found, this method creates a bogus
+# parameter list with the single parameter 'keywords'.
+
+sub init {
+    my($self,$initializer) = @_;
+    my($query_string,$meth,$content_length,$fh,@lines) = ('','','','');
+
+    # if we get called more than once, we want to initialize
+    # ourselves from the original query (which may be gone
+    # if it was read from STDIN originally.)
+    if (defined(@QUERY_PARAM) && !defined($initializer)) {
+	foreach (@QUERY_PARAM) {
+	    $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
+	}
+	return;
+    }
+
+    $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
+    $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0;
+    die "Client attempted to POST $content_length bytes, but POSTs are limited to $POST_MAX"
+	if ($POST_MAX > 0) && ($content_length > $POST_MAX);
+    $fh = to_filehandle($initializer) if $initializer;
+
+  METHOD: {
+
+      # Process multipart postings, but only if the initializer is
+      # not defined.
+      if ($meth eq 'POST'
+	  && defined($ENV{'CONTENT_TYPE'})
+	  && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
+	  && !defined($initializer)
+	  ) {
+	  my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";]+)\"?/;
+	  $self->read_multipart($boundary,$content_length);
+	  last METHOD;
+      } 
+
+      # If initializer is defined, then read parameters
+      # from it.
+      if (defined($initializer)) {
+	  if (UNIVERSAL::isa($initializer,'CGI')) {
+	      $query_string = $initializer->query_string;
+	      last METHOD;
+	  }
+	  if (ref($initializer) && ref($initializer) eq 'HASH') {
+	      foreach (keys %$initializer) {
+		  $self->param('-name'=>$_,'-value'=>$initializer->{$_});
+	      }
+	      last METHOD;
+	  }
+	  
+	  if (defined($fh) && ($fh ne '')) {
+	      while (<$fh>) {
+		  chomp;
+		  last if /^=/;
+		  push(@lines,$_);
+	      }
+	      # massage back into standard format
+	      if ("@lines" =~ /=/) {
+		  $query_string=join("&",@lines);
+	      } else {
+		  $query_string=join("+",@lines);
+	      }
+	      last METHOD;
+	  }
+
+	  # last chance -- treat it as a string
+	  $initializer = $$initializer if ref($initializer) eq 'SCALAR';
+	  $query_string = $initializer;
+
+	  last METHOD;
+      }
+
+      # If method is GET or HEAD, fetch the query from
+      # the environment.
+      if ($meth=~/^(GET|HEAD)$/) {
+	  $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
+	  last METHOD;
+      }
+
+      if ($meth eq 'POST') {
+	  $self->read_from_client(\*STDIN,\$query_string,$content_length,0)
+	      if $content_length > 0;
+	  # Some people want to have their cake and eat it too!
+	  # Uncomment this line to have the contents of the query string
+	  # APPENDED to the POST data.
+	  # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
+	  last METHOD;
+      }
+
+      # If $meth is not of GET, POST or HEAD, assume we're being debugged offline.
+      # Check the command line and then the standard input for data.
+      # We use the shellwords package in order to behave the way that
+      # UN*X programmers expect.
+      $query_string = read_from_cmdline() unless $NO_DEBUG;
+  }
+
+    # We now have the query string in hand.  We do slightly
+    # different things for keyword lists and parameter lists.
+    if ($query_string ne '') {
+	if ($query_string =~ /=/) {
+	    $self->parse_params($query_string);
+	} else {
+	    $self->add_parameter('keywords');
+	    $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
+	}
+    }
+
+    # Special case.  Erase everything if there is a field named
+    # .defaults.
+    if ($self->param('.defaults')) {
+	undef %{$self};
+    }
+
+    # Associative array containing our defined fieldnames
+    $self->{'.fieldnames'} = {};
+    foreach ($self->param('.cgifields')) {
+	$self->{'.fieldnames'}->{$_}++;
+    }
+    
+    # Clear out our default submission button flag if present
+    $self->delete('.submit');
+    $self->delete('.cgifields');
+    $self->save_request unless $initializer;
+}
+
+# FUNCTIONS TO OVERRIDE:
+# Turn a string into a filehandle
+sub to_filehandle {
+    my $thingy = shift;
+    return undef unless $thingy;
+    return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+    return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+    if (!ref($thingy)) {
+	my $caller = 1;
+	while (my $package = caller($caller++)) {
+	    my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; 
+	    return $tmp if defined(fileno($tmp));
+	}
+    }
+    return undef;
+}
+
+# send output to the browser
+sub put {
+    my($self,@p) = self_or_default(@_);
+    $self->print(@p);
+}
+
+# print to standard output (for overriding in mod_perl)
+sub print {
+    shift;
+    CORE::print(@_);
+}
+
+# unescape URL-encoded data
+sub unescape {
+    shift() if ref($_[0]);
+    my $todecode = shift;
+    return undef unless defined($todecode);
+    $todecode =~ tr/+/ /;       # pluses become spaces
+    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
+    return $todecode;
+}
+
+# URL-encode data
+sub escape {
+    shift() if ref($_[0]) || $_[0] eq $DefaultClass;
+    my $toencode = shift;
+    return undef unless defined($toencode);
+    $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+    return $toencode;
+}
+
+sub save_request {
+    my($self) = @_;
+    # We're going to play with the package globals now so that if we get called
+    # again, we initialize ourselves in exactly the same way.  This allows
+    # us to have several of these objects.
+    @QUERY_PARAM = $self->param; # save list of parameters
+    foreach (@QUERY_PARAM) {
+	$QUERY_PARAM{$_}=$self->{$_};
+    }
+}
+
+sub parse_params {
+    my($self,$tosplit) = @_;
+    my(@pairs) = split('&',$tosplit);
+    my($param,$value);
+    foreach (@pairs) {
+	($param,$value) = split('=',$_,2);
+	$param = unescape($param);
+	$value = unescape($value);
+	$self->add_parameter($param);
+	push (@{$self->{$param}},$value);
+    }
+}
+
+sub add_parameter {
+    my($self,$param)=@_;
+    push (@{$self->{'.parameters'}},$param) 
+	unless defined($self->{$param});
+}
+
+sub all_parameters {
+    my $self = shift;
+    return () unless defined($self) && $self->{'.parameters'};
+    return () unless @{$self->{'.parameters'}};
+    return @{$self->{'.parameters'}};
+}
+
+# put a filehandle into binary mode (DOS)
+sub binmode {
+    CORE::binmode($_[1]);
+}
+
+sub _make_tag_func {
+    my $tagname = shift;
+    return qq{
+	sub $tagname { 
+	    # handle various cases in which we're called
+	    # most of this bizarre stuff is to avoid -w errors
+	    shift if \$_[0] && 
+		(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
+		    (ref(\$_[0]) &&
+		     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+		    UNIVERSAL::isa(\$_[0],'CGI')));
+	    
+	    my(\$attr) = '';
+	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
+		my(\@attr) = make_attributes( '',shift() );
+		\$attr = " \@attr" if \@attr;
+	    }
+	    my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
+	    return \$tag unless \@_;
+	    my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    return "\@result";
+         }
+}
+}
+
+sub AUTOLOAD {
+    print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
+    my $func = &_compile;
+    goto &$func;
+}
+
+# PRIVATE SUBROUTINE
+# Smart rearrangement of parameters to allow named parameter
+# calling.  We do the rearangement if:
+# 1. The first parameter begins with a -
+# 2. The use_named_parameters() method returns true
+sub rearrange {
+    my($self,$order,@param) = @_;
+    return () unless @param;
+
+    if (ref($param[0]) eq 'HASH') {
+	@param = %{$param[0]};
+    } else {
+	return @param 
+	    unless (defined($param[0]) && substr($param[0],0,1) eq '-')
+		|| $self->use_named_parameters;
+    }
+
+    # map parameters into positional indices
+    my ($i,%pos);
+    $i = 0;
+    foreach (@$order) {
+	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
+	$i++;
+    }
+
+    my (@result,%leftover);
+    $#result = $#$order;  # preextend
+    while (@param) {
+	my $key = uc(shift(@param));
+	$key =~ s/^\-//;
+	if (exists $pos{$key}) {
+	    $result[$pos{$key}] = shift(@param);
+	} else {
+	    $leftover{$key} = shift(@param);
+	}
+    }
+
+    push (@result,$self->make_attributes(\%leftover)) if %leftover;
+    @result;
+}
+
+sub _compile {
+    my($func) = $AUTOLOAD;
+    my($pack,$func_name);
+    {
+	local($1,$2); # this fixes an obscure variable suicide problem.
+	$func=~/(.+)::([^:]+)$/;
+	($pack,$func_name) = ($1,$2);
+	$pack=~s/::SUPER$//;	# fix another obscure problem
+	$pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
+	    unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
+
+        my($sub) = \%{"$pack\:\:SUBS"};
+        unless (%$sub) {
+	   my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
+	   eval "package $pack; $$auto";
+	   die $@ if $@;
+           $$auto = '';  # Free the unneeded storage (but don't undef it!!!)
+       }
+       my($code) = $sub->{$func_name};
+
+       $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
+       if (!$code) {
+	   if ($EXPORT{':any'} || 
+	       $EXPORT{'-any'} ||
+	       $EXPORT{$func_name} || 
+	       (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
+	           && $EXPORT_OK{$func_name}) {
+	       $code = _make_tag_func($func_name);
+	   }
+       }
+       die "Undefined subroutine $AUTOLOAD\n" unless $code;
+       eval "package $pack; $code";
+       if ($@) {
+	   $@ =~ s/ at .*\n//;
+	   die $@;
+       }
+    }       
+    delete($sub->{$func_name});  #free storage
+    return "$pack\:\:$func_name";
+}
+
+sub _reset_globals { initialize_globals(); }
+
+sub _setup_symbols {
+    my $self = shift;
+    my $compile = 0;
+    foreach (@_) {
+	$NPH++, next if /^[:-]nph$/;
+	$NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/;
+	$PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
+	$EXPORT{$_}++, next if /^[:-]any$/;
+	$compile++, next if /^[:-]compile$/;
+	
+	# This is probably extremely evil code -- to be deleted
+	# some day.
+	if (/^[-]autoload$/) {
+	    my($pkg) = caller(1);
+	    *{"${pkg}::AUTOLOAD"} = sub { 
+		my($routine) = $AUTOLOAD;
+		$routine =~ s/^.*::/CGI::/;
+		&$routine;
+	    };
+	    next;
+	}
+
+	foreach (&expand_tags($_)) {
+	    tr/a-zA-Z0-9_//cd;  # don't allow weird function names
+	    $EXPORT{$_}++;
+	}
+    }
+    _compile_all(keys %EXPORT) if $compile;
+}
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # get rid of -w warning
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+
+%SUBS = (
+
+'URL_ENCODED'=> <<'END_OF_FUNC',
+sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
+END_OF_FUNC
+
+'MULTIPART' => <<'END_OF_FUNC',
+sub MULTIPART {  'multipart/form-data'; }
+END_OF_FUNC
+
+'SERVER_PUSH' => <<'END_OF_FUNC',
+sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
+END_OF_FUNC
+
+'use_named_parameters' => <<'END_OF_FUNC',
+#### Method: use_named_parameters
+# Force CGI.pm to use named parameter-style method calls
+# rather than positional parameters.  The same effect
+# will happen automatically if the first parameter
+# begins with a -.
+sub use_named_parameters {
+    my($self,$use_named) = self_or_default(@_);
+    return $self->{'.named'} unless defined ($use_named);
+
+    # stupidity to avoid annoying warnings
+    return $self->{'.named'}=$use_named;
+}
+END_OF_FUNC
+
+'new_MultipartBuffer' => <<'END_OF_FUNC',
+# Create a new multipart buffer
+sub new_MultipartBuffer {
+    my($self,$boundary,$length,$filehandle) = @_;
+    return MultipartBuffer->new($self,$boundary,$length,$filehandle);
+}
+END_OF_FUNC
+
+'read_from_client' => <<'END_OF_FUNC',
+# Read data from a file handle
+sub read_from_client {
+    my($self, $fh, $buff, $len, $offset) = @_;
+    local $^W=0;                # prevent a warning
+    return undef unless defined($fh);
+    return read($fh, $$buff, $len, $offset);
+}
+END_OF_FUNC
+
+'delete' => <<'END_OF_FUNC',
+#### Method: delete
+# Deletes the named parameter entirely.
+####
+sub delete {
+    my($self,$name) = self_or_default(@_);
+    delete $self->{$name};
+    delete $self->{'.fieldnames'}->{$name};
+    @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
+    return wantarray ? () : undef;
+}
+END_OF_FUNC
+
+#### Method: import_names
+# Import all parameters into the given namespace.
+# Assumes namespace 'Q' if not specified
+####
+'import_names' => <<'END_OF_FUNC',
+sub import_names {
+    my($self,$namespace,$delete) = self_or_default(@_);
+    $namespace = 'Q' unless defined($namespace);
+    die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
+    if ($delete || $MOD_PERL) {
+	# can anyone find an easier way to do this?
+	foreach (keys %{"${namespace}::"}) {
+	    local *symbol = "${namespace}::${_}";
+	    undef $symbol;
+	    undef @symbol;
+	    undef %symbol;
+	}
+    }
+    my($param,@value,$var);
+    foreach $param ($self->param) {
+	# protect against silly names
+	($var = $param)=~tr/a-zA-Z0-9_/_/c;
+	$var =~ s/^(?=\d)/_/;
+	local *symbol = "${namespace}::$var";
+	@value = $self->param($param);
+	@symbol = @value;
+	$symbol = $value[0];
+    }
+}
+END_OF_FUNC
+
+#### Method: keywords
+# Keywords acts a bit differently.  Calling it in a list context
+# returns the list of keywords.  
+# Calling it in a scalar context gives you the size of the list.
+####
+'keywords' => <<'END_OF_FUNC',
+sub keywords {
+    my($self,@values) = self_or_default(@_);
+    # If values is provided, then we set it.
+    $self->{'keywords'}=[@values] if defined(@values);
+    my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
+    @result;
+}
+END_OF_FUNC
+
+# These are some tie() interfaces for compatibility
+# with Steve Brenner's cgi-lib.pl routines
+'ReadParse' => <<'END_OF_FUNC',
+sub ReadParse {
+    local(*in);
+    if (@_) {
+	*in = $_[0];
+    } else {
+	my $pkg = caller();
+	*in=*{"${pkg}::in"};
+    }
+    tie(%in,CGI);
+    return scalar(keys %in);
+}
+END_OF_FUNC
+
+'PrintHeader' => <<'END_OF_FUNC',
+sub PrintHeader {
+    my($self) = self_or_default(@_);
+    return $self->header();
+}
+END_OF_FUNC
+
+'HtmlTop' => <<'END_OF_FUNC',
+sub HtmlTop {
+    my($self,@p) = self_or_default(@_);
+    return $self->start_html(@p);
+}
+END_OF_FUNC
+
+'HtmlBot' => <<'END_OF_FUNC',
+sub HtmlBot {
+    my($self,@p) = self_or_default(@_);
+    return $self->end_html(@p);
+}
+END_OF_FUNC
+
+'SplitParam' => <<'END_OF_FUNC',
+sub SplitParam {
+    my ($param) = @_;
+    my (@params) = split ("\0", $param);
+    return (wantarray ? @params : $params[0]);
+}
+END_OF_FUNC
+
+'MethGet' => <<'END_OF_FUNC',
+sub MethGet {
+    return request_method() eq 'GET';
+}
+END_OF_FUNC
+
+'MethPost' => <<'END_OF_FUNC',
+sub MethPost {
+    return request_method() eq 'POST';
+}
+END_OF_FUNC
+
+'TIEHASH' => <<'END_OF_FUNC',
+sub TIEHASH { 
+    return $Q || new CGI;
+}
+END_OF_FUNC
+
+'STORE' => <<'END_OF_FUNC',
+sub STORE {
+    $_[0]->param($_[1],split("\0",$_[2]));
+}
+END_OF_FUNC
+
+'FETCH' => <<'END_OF_FUNC',
+sub FETCH {
+    return $_[0] if $_[1] eq 'CGI';
+    return undef unless defined $_[0]->param($_[1]);
+    return join("\0",$_[0]->param($_[1]));
+}
+END_OF_FUNC
+
+'FIRSTKEY' => <<'END_OF_FUNC',
+sub FIRSTKEY {
+    $_[0]->{'.iterator'}=0;
+    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
+}
+END_OF_FUNC
+
+'NEXTKEY' => <<'END_OF_FUNC',
+sub NEXTKEY {
+    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
+}
+END_OF_FUNC
+
+'EXISTS' => <<'END_OF_FUNC',
+sub EXISTS {
+    exists $_[0]->{$_[1]};
+}
+END_OF_FUNC
+
+'DELETE' => <<'END_OF_FUNC',
+sub DELETE {
+    $_[0]->delete($_[1]);
+}
+END_OF_FUNC
+
+'CLEAR' => <<'END_OF_FUNC',
+sub CLEAR {
+    %{$_[0]}=();
+}
+####
+END_OF_FUNC
+
+####
+# Append a new value to an existing query
+####
+'append' => <<'EOF',
+sub append {
+    my($self,@p) = @_;
+    my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
+    my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
+    if (@values) {
+	$self->add_parameter($name);
+	push(@{$self->{$name}},@values);
+    }
+    return $self->param($name);
+}
+EOF
+
+#### Method: delete_all
+# Delete all parameters
+####
+'delete_all' => <<'EOF',
+sub delete_all {
+    my($self) = self_or_default(@_);
+    undef %{$self};
+}
+EOF
+
+'Delete' => <<'EOF',
+sub Delete {
+    my($self,@p) = self_or_default(@_);
+    $self->delete(@p);
+}
+EOF
+
+'Delete_all' => <<'EOF',
+sub Delete_all {
+    my($self,@p) = self_or_default(@_);
+    $self->delete_all(@p);
+}
+EOF
+
+#### Method: autoescape
+# If you want to turn off the autoescaping features,
+# call this method with undef as the argument
+'autoEscape' => <<'END_OF_FUNC',
+sub autoEscape {
+    my($self,$escape) = self_or_default(@_);
+    $self->{'dontescape'}=!$escape;
+}
+END_OF_FUNC
+
+
+#### Method: version
+# Return the current version
+####
+'version' => <<'END_OF_FUNC',
+sub version {
+    return $VERSION;
+}
+END_OF_FUNC
+
+'make_attributes' => <<'END_OF_FUNC',
+sub make_attributes {
+    my($self,$attr) = @_;
+    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
+    my(@att);
+    foreach (keys %{$attr}) {
+	my($key) = $_;
+	$key=~s/^\-//;     # get rid of initial - if present
+	$key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+	push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/);
+    }
+    return @att;
+}
+END_OF_FUNC
+
+#### Method: url_param
+# Return a parameter in the QUERY_STRING, regardless of
+# whether this was a POST or a GET
+####
+'url_param' => <<'END_OF_FUNC',
+sub url_param {
+    my ($self,@p) = self_or_default(@_);
+    my $name = shift(@p);
+    return undef unless exists($ENV{QUERY_STRING});
+    unless (exists($self->{'.url_param'})) {
+	$self->{'.url_param'}={}; # empty hash
+	if ($ENV{QUERY_STRING} =~ /=/) {
+	    my(@pairs) = split('&',$ENV{QUERY_STRING});
+	    my($param,$value);
+	    foreach (@pairs) {
+		($param,$value) = split('=',$_,2);
+		$param = unescape($param);
+		$value = unescape($value);
+		push(@{$self->{'.url_param'}->{$param}},$value);
+	    }
+	} else {
+	    $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})];
+	}
+    }
+    return keys %{$self->{'.url_param'}} unless defined($name);
+    return () unless $self->{'.url_param'}->{$name};
+    return wantarray ? @{$self->{'.url_param'}->{$name}}
+                     : $self->{'.url_param'}->{$name}->[0];
+}
+END_OF_FUNC
+
+#### Method: dump
+# Returns a string in which all the known parameter/value 
+# pairs are represented as nested lists, mainly for the purposes 
+# of debugging.
+####
+'dump' => <<'END_OF_FUNC',
+sub dump {
+    my($self) = self_or_default(@_);
+    my($param,$value,@result);
+    return '<UL></UL>' unless $self->param;
+    push(@result,"<UL>");
+    foreach $param ($self->param) {
+	my($name)=$self->escapeHTML($param);
+	push(@result,"<LI><STRONG>$param</STRONG>");
+	push(@result,"<UL>");
+	foreach $value ($self->param($param)) {
+	    $value = $self->escapeHTML($value);
+	    push(@result,"<LI>$value");
+	}
+	push(@result,"</UL>");
+    }
+    push(@result,"</UL>\n");
+    return join("\n",@result);
+}
+END_OF_FUNC
+
+#### Method as_string
+#
+# synonym for "dump"
+####
+'as_string' => <<'END_OF_FUNC',
+sub as_string {
+    &dump(@_);
+}
+END_OF_FUNC
+
+#### Method: save
+# Write values out to a filehandle in such a way that they can
+# be reinitialized by the filehandle form of the new() method
+####
+'save' => <<'END_OF_FUNC',
+sub save {
+    my($self,$filehandle) = self_or_default(@_);
+    $filehandle = to_filehandle($filehandle);
+    my($param);
+    local($,) = '';  # set print field separator back to a sane value
+    foreach $param ($self->param) {
+	my($escaped_param) = escape($param);
+	my($value);
+	foreach $value ($self->param($param)) {
+	    print $filehandle "$escaped_param=",escape($value),"\n";
+	}
+    }
+    print $filehandle "=\n";    # end of record
+}
+END_OF_FUNC
+
+
+#### Method: save_parameters
+# An alias for save() that is a better name for exportation.
+# Only intended to be used with the function (non-OO) interface.
+####
+'save_parameters' => <<'END_OF_FUNC',
+sub save_parameters {
+    my $fh = shift;
+    return save(to_filehandle($fh));
+}
+END_OF_FUNC
+
+#### Method: restore_parameters
+# A way to restore CGI parameters from an initializer.
+# Only intended to be used with the function (non-OO) interface.
+####
+'restore_parameters' => <<'END_OF_FUNC',
+sub restore_parameters {
+    $Q = $CGI::DefaultClass->new(@_);
+}
+END_OF_FUNC
+
+#### Method: multipart_init
+# Return a Content-Type: style header for server-push
+# This has to be NPH, and it is advisable to set $| = 1
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_init' => <<'END_OF_FUNC',
+sub multipart_init {
+    my($self,@p) = self_or_default(@_);
+    my($boundary,@other) = $self->rearrange([BOUNDARY],@p);
+    $boundary = $boundary || '------- =_aaaaaaaaaa0';
+    $self->{'separator'} = "\n--$boundary\n";
+    $type = SERVER_PUSH($boundary);
+    return $self->header(
+	-nph => 1,
+	-type => $type,
+	(map { split "=", $_, 2 } @other),
+    ) . $self->multipart_end;
+}
+END_OF_FUNC
+
+
+#### Method: multipart_start
+# Return a Content-Type: style header for server-push, start of section
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_start' => <<'END_OF_FUNC',
+sub multipart_start {
+    my($self,@p) = self_or_default(@_);
+    my($type,@other) = $self->rearrange([TYPE],@p);
+    $type = $type || 'text/html';
+    return $self->header(
+	-type => $type,
+	(map { split "=", $_, 2 } @other),
+    );
+}
+END_OF_FUNC
+
+
+#### Method: multipart_end
+# Return a Content-Type: style header for server-push, end of section
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_end' => <<'END_OF_FUNC',
+sub multipart_end {
+    my($self,@p) = self_or_default(@_);
+    return $self->{'separator'};
+}
+END_OF_FUNC
+
+
+#### Method: header
+# Return a Content-Type: style header
+#
+####
+'header' => <<'END_OF_FUNC',
+sub header {
+    my($self,@p) = self_or_default(@_);
+    my(@header);
+
+    my($type,$status,$cookie,$target,$expires,$nph,@other) = 
+	$self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+
+    $nph ||= $NPH;
+    # rearrange() was designed for the HTML portion, so we
+    # need to fix it up a little.
+    foreach (@other) {
+	next unless my($header,$value) = /([^\s=]+)=\"?([^\"]+)\"?/;
+	($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
+    }
+
+    $type = $type || 'text/html';
+
+    # Maybe future compatibility.  Maybe not.
+    my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
+    push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
+
+    push(@header,"Status: $status") if $status;
+    push(@header,"Window-Target: $target") if $target;
+    # push all the cookies -- there may be several
+    if ($cookie) {
+	my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
+	foreach (@cookie) {
+	    push(@header,"Set-Cookie: " . (UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_));
+	}
+    }
+    # if the user indicates an expiration time, then we need
+    # both an Expires and a Date header (so that the browser is
+    # uses OUR clock)
+    push(@header,"Expires: " . expires($expires,'http'))
+	if $expires;
+    push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
+    push(@header,"Pragma: no-cache") if $self->cache();
+    push(@header,@other);
+    push(@header,"Content-Type: $type");
+
+    my $header = join($CRLF,@header)."${CRLF}${CRLF}";
+    if ($MOD_PERL and not $nph) {
+	my $r = Apache->request;
+	$r->send_cgi_header($header);
+	return '';
+    }
+    return $header;
+}
+END_OF_FUNC
+
+
+#### Method: cache
+# Control whether header() will produce the no-cache
+# Pragma directive.
+####
+'cache' => <<'END_OF_FUNC',
+sub cache {
+    my($self,$new_value) = self_or_default(@_);
+    $new_value = '' unless $new_value;
+    if ($new_value ne '') {
+	$self->{'cache'} = $new_value;
+    }
+    return $self->{'cache'};
+}
+END_OF_FUNC
+
+
+#### Method: redirect
+# Return a Location: style header
+#
+####
+'redirect' => <<'END_OF_FUNC',
+sub redirect {
+    my($self,@p) = self_or_default(@_);
+    my($url,$target,$cookie,$nph,@other) = $self->rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
+    $url = $url || $self->self_url;
+    my(@o);
+    foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
+    unshift(@o,
+	 '-Status'=>'302 Moved',
+	 '-Location'=>$url,
+	 '-nph'=>$nph);
+    unshift(@o,'-Target'=>$target) if $target;
+    unshift(@o,'-Cookie'=>$cookie) if $cookie;
+    return $self->header(@o);
+}
+END_OF_FUNC
+
+
+#### Method: start_html
+# Canned HTML header
+#
+# Parameters:
+# $title -> (optional) The title for this HTML document (-title)
+# $author -> (optional) e-mail address of the author (-author)
+# $base -> (optional) if set to true, will enter the BASE address of this document
+#          for resolving relative references (-base) 
+# $xbase -> (optional) alternative base at some remote location (-xbase)
+# $target -> (optional) target window to load all links into (-target)
+# $script -> (option) Javascript code (-script)
+# $no_script -> (option) Javascript <noscript> tag (-noscript)
+# $meta -> (optional) Meta information tags
+# $head -> (optional) any other elements you'd like to incorporate into the <HEAD> tag
+#           (a scalar or array ref)
+# $style -> (optional) reference to an external style sheet
+# @other -> (optional) any other named parameters you'd like to incorporate into
+#           the <BODY> tag.
+####
+'start_html' => <<'END_OF_FUNC',
+sub start_html {
+    my($self,@p) = &self_or_default(@_);
+    my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,@other) = 
+	$self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
+
+    # strangely enough, the title needs to be escaped as HTML
+    # while the author needs to be escaped as a URL
+    $title = $self->escapeHTML($title || 'Untitled Document');
+    $author = $self->escape($author);
+    my(@result);
+    $dtd = $DEFAULT_DTD unless $dtd && $dtd =~ m|^-//|;
+    push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">)) if $dtd;
+    push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
+    push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if defined $author;
+
+    if ($base || $xbase || $target) {
+	my $href = $xbase || $self->url('-path'=>1);
+	my $t = $target ? qq/ TARGET="$target"/ : '';
+	push(@result,qq/<BASE HREF="$href"$t>/);
+    }
+
+    if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
+	foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
+    }
+
+    push(@result,ref($head) ? @$head : $head) if $head;
+
+    # handle the infrequently-used -style and -script parameters
+    push(@result,$self->_style($style)) if defined $style;
+    push(@result,$self->_script($script)) if defined $script;
+
+    # handle -noscript parameter
+    push(@result,<<END) if $noscript;
+<NOSCRIPT>
+$noscript
+</NOSCRIPT>
+END
+    ;
+    my($other) = @other ? " @other" : '';
+    push(@result,"</HEAD><BODY$other>");
+    return join("\n",@result);
+}
+END_OF_FUNC
+
+### Method: _style
+# internal method for generating a CSS style section
+####
+'_style' => <<'END_OF_FUNC',
+sub _style {
+    my ($self,$style) = @_;
+    my (@result);
+    my $type = 'text/css';
+    if (ref($style)) {
+	my($src,$code,$stype,@other) =
+	    $self->rearrange([SRC,CODE,TYPE],
+			     '-foo'=>'bar',	# a trick to allow the '-' to be omitted
+			     ref($style) eq 'ARRAY' ? @$style : %$style);
+	$type = $stype if $stype;
+	push(@result,qq/<LINK REL="stylesheet" HREF="$src">/) if $src;
+	push(@result,style({'type'=>$type},"<!--\n$code\n-->")) if $code;
+    } else {
+	push(@result,style({'type'=>$type},"<!--\n$style\n-->"));
+    }
+    @result;
+}
+END_OF_FUNC
+
+
+'_script' => <<'END_OF_FUNC',
+sub _script {
+    my ($self,$script) = @_;
+    my (@result);
+    my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
+    foreach $script (@scripts) {
+	my($src,$code,$language);
+	if (ref($script)) { # script is a hash
+	    ($src,$code,$language) =
+		$self->rearrange([SRC,CODE,LANGUAGE],
+				 '-foo'=>'bar',	# a trick to allow the '-' to be omitted
+				 ref($style) eq 'ARRAY' ? @$script : %$script);
+	    
+	} else {
+	    ($src,$code,$language) = ('',$script,'JavaScript');
+	}
+	my(@satts);
+	push(@satts,'src'=>$src) if $src;
+	push(@satts,'language'=>$language || 'JavaScript');
+	$code = "<!-- Hide script\n$code\n// End script hiding -->"
+	    if $code && $language=~/javascript/i;
+	$code = "<!-- Hide script\n$code\n\# End script hiding -->"
+	    if $code && $language=~/perl/i;
+	push(@result,script({@satts},$code));
+    }
+    @result;
+}
+END_OF_FUNC
+
+#### Method: end_html
+# End an HTML document.
+# Trivial method for completeness.  Just returns "</BODY>"
+####
+'end_html' => <<'END_OF_FUNC',
+sub end_html {
+    return "</BODY></HTML>";
+}
+END_OF_FUNC
+
+
+################################
+# METHODS USED IN BUILDING FORMS
+################################
+
+#### Method: isindex
+# Just prints out the isindex tag.
+# Parameters:
+#  $action -> optional URL of script to run
+# Returns:
+#   A string containing a <ISINDEX> tag
+'isindex' => <<'END_OF_FUNC',
+sub isindex {
+    my($self,@p) = self_or_default(@_);
+    my($action,@other) = $self->rearrange([ACTION],@p);
+    $action = qq/ACTION="$action"/ if $action;
+    my($other) = @other ? " @other" : '';
+    return "<ISINDEX $action$other>";
+}
+END_OF_FUNC
+
+
+#### Method: startform
+# Start a form
+# Parameters:
+#   $method -> optional submission method to use (GET or POST)
+#   $action -> optional URL of script to run
+#   $enctype ->encoding to use (URL_ENCODED or MULTIPART)
+'startform' => <<'END_OF_FUNC',
+sub startform {
+    my($self,@p) = self_or_default(@_);
+
+    my($method,$action,$enctype,@other) = 
+	$self->rearrange([METHOD,ACTION,ENCTYPE],@p);
+
+    $method = $method || 'POST';
+    $enctype = $enctype || &URL_ENCODED;
+    $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
+	'ACTION="'.$self->script_name.'"' : '';
+    my($other) = @other ? " @other" : '';
+    $self->{'.parametersToAdd'}={};
+    return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
+}
+END_OF_FUNC
+
+
+#### Method: start_form
+# synonym for startform
+'start_form' => <<'END_OF_FUNC',
+sub start_form {
+    &startform;
+}
+END_OF_FUNC
+
+
+#### Method: start_multipart_form
+# synonym for startform
+'start_multipart_form' => <<'END_OF_FUNC',
+sub start_multipart_form {
+    my($self,@p) = self_or_default(@_);
+    if ($self->use_named_parameters || 
+	(defined($param[0]) && substr($param[0],0,1) eq '-')) {
+	my(%p) = @p;
+	$p{'-enctype'}=&MULTIPART;
+	return $self->startform(%p);
+    } else {
+	my($method,$action,@other) = 
+	    $self->rearrange([METHOD,ACTION],@p);
+	return $self->startform($method,$action,&MULTIPART,@other);
+    }
+}
+END_OF_FUNC
+
+
+#### Method: endform
+# End a form
+'endform' => <<'END_OF_FUNC',
+sub endform {
+    my($self,@p) = self_or_default(@_);    
+    return ($self->get_fields,"</FORM>");
+}
+END_OF_FUNC
+
+
+#### Method: end_form
+# synonym for endform
+'end_form' => <<'END_OF_FUNC',
+sub end_form {
+    &endform;
+}
+END_OF_FUNC
+
+
+'_textfield' => <<'END_OF_FUNC',
+sub _textfield {
+    my($self,$tag,@p) = self_or_default(@_);
+    my($name,$default,$size,$maxlength,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+
+    my $current = $override ? $default : 
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
+    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
+    my($other) = @other ? " @other" : '';    
+    return qq/<INPUT TYPE="$tag" NAME="$name" VALUE="$current"$s$m$other>/;
+}
+END_OF_FUNC
+
+#### Method: textfield
+# Parameters:
+#   $name -> Name of the text field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $size ->  Optional width of field in characaters.
+#   $maxlength -> Optional maximum number of characters.
+# Returns:
+#   A string containing a <INPUT TYPE="text"> field
+#
+'textfield' => <<'END_OF_FUNC',
+sub textfield {
+    my($self,@p) = self_or_default(@_);
+    $self->_textfield('text',@p);
+}
+END_OF_FUNC
+
+
+#### Method: filefield
+# Parameters:
+#   $name -> Name of the file upload field
+#   $size ->  Optional width of field in characaters.
+#   $maxlength -> Optional maximum number of characters.
+# Returns:
+#   A string containing a <INPUT TYPE="text"> field
+#
+'filefield' => <<'END_OF_FUNC',
+sub filefield {
+    my($self,@p) = self_or_default(@_);
+    $self->_textfield('file',@p);
+}
+END_OF_FUNC
+
+
+#### Method: password
+# Create a "secret password" entry field
+# Parameters:
+#   $name -> Name of the field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $size ->  Optional width of field in characters.
+#   $maxlength -> Optional maximum characters that can be entered.
+# Returns:
+#   A string containing a <INPUT TYPE="password"> field
+#
+'password_field' => <<'END_OF_FUNC',
+sub password_field {
+    my ($self,@p) = self_or_default(@_);
+    $self->_textfield('password',@p);
+}
+END_OF_FUNC
+
+#### Method: textarea
+# Parameters:
+#   $name -> Name of the text field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $rows ->  Optional number of rows in text area
+#   $columns -> Optional number of columns in text area
+# Returns:
+#   A string containing a <TEXTAREA></TEXTAREA> tag
+#
+'textarea' => <<'END_OF_FUNC',
+sub textarea {
+    my($self,@p) = self_or_default(@_);
+    
+    my($name,$default,$rows,$cols,$override,@other) =
+	$self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
+
+    my($current)= $override ? $default :
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    my($r) = $rows ? " ROWS=$rows" : '';
+    my($c) = $cols ? " COLS=$cols" : '';
+    my($other) = @other ? " @other" : '';
+    return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
+}
+END_OF_FUNC
+
+
+#### Method: button
+# Create a javascript button.
+# Parameters:
+#   $name ->  (optional) Name for the button. (-name)
+#   $value -> (optional) Value of the button when selected (and visible name) (-value)
+#   $onclick -> (optional) Text of the JavaScript to run when the button is
+#                clicked.
+# Returns:
+#   A string containing a <INPUT TYPE="button"> tag
+####
+'button' => <<'END_OF_FUNC',
+sub button {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
+							 [ONCLICK,SCRIPT]],@p);
+
+    $label=$self->escapeHTML($label);
+    $value=$self->escapeHTML($value);
+    $script=$self->escapeHTML($script);
+
+    my($name) = '';
+    $name = qq/ NAME="$label"/ if $label;
+    $value = $value || $label;
+    my($val) = '';
+    $val = qq/ VALUE="$value"/ if $value;
+    $script = qq/ ONCLICK="$script"/ if $script;
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="button"$name$val$script$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: submit
+# Create a "submit query" button.
+# Parameters:
+#   $name ->  (optional) Name for the button.
+#   $value -> (optional) Value of the button when selected (also doubles as label).
+#   $label -> (optional) Label printed on the button(also doubles as the value).
+# Returns:
+#   A string containing a <INPUT TYPE="submit"> tag
+####
+'submit' => <<'END_OF_FUNC',
+sub submit {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
+
+    $label=$self->escapeHTML($label);
+    $value=$self->escapeHTML($value);
+
+    my($name) = ' NAME=".submit"';
+    $name = qq/ NAME="$label"/ if defined($label);
+    $value = defined($value) ? $value : $label;
+    my($val) = '';
+    $val = qq/ VALUE="$value"/ if defined($value);
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="submit"$name$val$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: reset
+# Create a "reset" button.
+# Parameters:
+#   $name -> (optional) Name for the button.
+# Returns:
+#   A string containing a <INPUT TYPE="reset"> tag
+####
+'reset' => <<'END_OF_FUNC',
+sub reset {
+    my($self,@p) = self_or_default(@_);
+    my($label,@other) = $self->rearrange([NAME],@p);
+    $label=$self->escapeHTML($label);
+    my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="reset"$value$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: defaults
+# Create a "defaults" button.
+# Parameters:
+#   $name -> (optional) Name for the button.
+# Returns:
+#   A string containing a <INPUT TYPE="submit" NAME=".defaults"> tag
+#
+# Note: this button has a special meaning to the initialization script,
+# and tells it to ERASE the current query string so that your defaults
+# are used again!
+####
+'defaults' => <<'END_OF_FUNC',
+sub defaults {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
+
+    $label=$self->escapeHTML($label);
+    $label = $label || "Defaults";
+    my($value) = qq/ VALUE="$label"/;
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: comment
+# Create an HTML <!-- comment -->
+# Parameters: a string
+'comment' => <<'END_OF_FUNC',
+sub comment {
+    my($self,@p) = self_or_CGI(@_);
+    return "<!-- @p -->";
+}
+END_OF_FUNC
+
+#### Method: checkbox
+# Create a checkbox that is not logically linked to any others.
+# The field value is "on" when the button is checked.
+# Parameters:
+#   $name -> Name of the checkbox
+#   $checked -> (optional) turned on by default if true
+#   $value -> (optional) value of the checkbox, 'on' by default
+#   $label -> (optional) a user-readable label printed next to the box.
+#             Otherwise the checkbox name is used.
+# Returns:
+#   A string containing a <INPUT TYPE="checkbox"> field
+####
+'checkbox' => <<'END_OF_FUNC',
+sub checkbox {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$checked,$value,$label,$override,@other) = 
+	$self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
+    
+    $value = defined $value ? $value : 'on';
+
+    if (!$override && ($self->{'.fieldnames'}->{$name} || 
+		       defined $self->param($name))) {
+	$checked = grep($_ eq $value,$self->param($name)) ? ' CHECKED' : '';
+    } else {
+	$checked = $checked ? ' CHECKED' : '';
+    }
+    my($the_label) = defined $label ? $label : $name;
+    $name = $self->escapeHTML($name);
+    $value = $self->escapeHTML($value);
+    $the_label = $self->escapeHTML($the_label);
+    my($other) = @other ? " @other" : '';
+    $self->register_parameter($name);
+    return <<END;
+<INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label
+END
+}
+END_OF_FUNC
+
+
+#### Method: checkbox_group
+# Create a list of logically-linked checkboxes.
+# Parameters:
+#   $name -> Common name for all the check boxes
+#   $values -> A pointer to a regular array containing the
+#             values for each checkbox in the group.
+#   $defaults -> (optional)
+#             1. If a pointer to a regular array of checkbox values,
+#             then this will be used to decide which
+#             checkboxes to turn on by default.
+#             2. If a scalar, will be assumed to hold the
+#             value of a single checkbox in the group to turn on. 
+#   $linebreak -> (optional) Set to true to place linebreaks
+#             between the buttons.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   An ARRAY containing a series of <INPUT TYPE="checkbox"> fields
+####
+'checkbox_group' => <<'END_OF_FUNC',
+sub checkbox_group {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
+       $rowheaders,$colheaders,$override,$nolabels,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
+			  LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
+			  ROWHEADERS,COLHEADERS,
+			  [OVERRIDE,FORCE],NOLABELS],@p);
+
+    my($checked,$break,$result,$label);
+
+    my(%checked) = $self->previous_or_default($name,$defaults,$override);
+
+    $break = $linebreak ? "<BR>" : '';
+    $name=$self->escapeHTML($name);
+
+    # Create the elements
+    my(@elements,@values);
+
+    @values = $self->_set_values_and_labels($values,\$labels,$name);
+
+    my($other) = @other ? " @other" : '';
+    foreach (@values) {
+	$checked = $checked{$_} ? ' CHECKED' : '';
+	$label = '';
+	unless (defined($nolabels) && $nolabels) {
+	    $label = $_;
+	    $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	    $label = $self->escapeHTML($label);
+	}
+	$_ = $self->escapeHTML($_);
+	push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label}${break}/);
+    }
+    $self->register_parameter($name);
+    return wantarray ? @elements : join(' ',@elements)            
+        unless defined($columns) || defined($rows);
+    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
+}
+END_OF_FUNC
+
+# Escape HTML -- used internally
+'escapeHTML' => <<'END_OF_FUNC',
+sub escapeHTML {
+    my($self,$toencode) = @_;
+    $toencode = $self unless ref($self);
+    return undef unless defined($toencode);
+    return $toencode if ref($self) && $self->{'dontescape'};
+
+    $toencode=~s/&/&amp;/g;
+    $toencode=~s/\"/&quot;/g;
+    $toencode=~s/>/&gt;/g;
+    $toencode=~s/</&lt;/g;
+    return $toencode;
+}
+END_OF_FUNC
+
+# unescape HTML -- used internally
+'unescapeHTML' => <<'END_OF_FUNC',
+sub unescapeHTML {
+    my $string = ref($_[0]) ? $_[1] : $_[0];
+    return undef unless defined($string);
+    $string=~s/&amp;/&/ig;
+    $string=~s/&quot;/\"/ig;
+    $string=~s/&gt;/>/ig;
+    $string=~s/&lt;/</ig;
+    $string=~s/&#(\d+);/chr($1)/eg; 
+    $string=~s/&#[xX]([0-9a-fA-F]);/chr(hex($1))/eg; 
+    return $string;
+}
+END_OF_FUNC
+
+# Internal procedure - don't use
+'_tableize' => <<'END_OF_FUNC',
+sub _tableize {
+    my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
+    my($result);
+
+    if (defined($columns)) {
+	$rows = int(0.99 + @elements/$columns) unless defined($rows);
+    }
+    if (defined($rows)) {
+	$columns = int(0.99 + @elements/$rows) unless defined($columns);
+    }
+    
+    # rearrange into a pretty table
+    $result = "<TABLE>";
+    my($row,$column);
+    unshift(@$colheaders,'') if defined(@$colheaders) && defined(@$rowheaders);
+    $result .= "<TR>" if defined(@{$colheaders});
+    foreach (@{$colheaders}) {
+	$result .= "<TH>$_</TH>";
+    }
+    for ($row=0;$row<$rows;$row++) {
+	$result .= "<TR>";
+	$result .= "<TH>$rowheaders->[$row]</TH>" if defined(@$rowheaders);
+	for ($column=0;$column<$columns;$column++) {
+	    $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"
+		if defined($elements[$column*$rows + $row]);
+	}
+	$result .= "</TR>";
+    }
+    $result .= "</TABLE>";
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: radio_group
+# Create a list of logically-linked radio buttons.
+# Parameters:
+#   $name -> Common name for all the buttons.
+#   $values -> A pointer to a regular array containing the
+#             values for each button in the group.
+#   $default -> (optional) Value of the button to turn on by default.  Pass '-'
+#               to turn _nothing_ on.
+#   $linebreak -> (optional) Set to true to place linebreaks
+#             between the buttons.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   An ARRAY containing a series of <INPUT TYPE="radio"> fields
+####
+'radio_group' => <<'END_OF_FUNC',
+sub radio_group {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$default,$linebreak,$labels,
+       $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
+			  ROWS,[COLUMNS,COLS],
+			  ROWHEADERS,COLHEADERS,
+			  [OVERRIDE,FORCE],NOLABELS],@p);
+    my($result,$checked);
+
+    if (!$override && defined($self->param($name))) {
+	$checked = $self->param($name);
+    } else {
+	$checked = $default;
+    }
+    # If no check array is specified, check the first by default
+    $checked = $values->[0] unless defined($checked) && $checked ne '';
+    $name=$self->escapeHTML($name);
+
+    my(@elements,@values);
+
+    @values = $self->_set_values_and_labels($values,\$labels,$name);
+
+    my($other) = @other ? " @other" : '';
+    foreach (@values) {
+	my($checkit) = $checked eq $_ ? ' CHECKED' : '';
+	my($break) = $linebreak ? '<BR>' : '';
+	my($label)='';
+	unless (defined($nolabels) && $nolabels) {
+	    $label = $_;
+	    $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	    $label = $self->escapeHTML($label);
+	}
+	$_=$self->escapeHTML($_);
+	push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label}${break}/);
+    }
+    $self->register_parameter($name);
+    return wantarray ? @elements : join(' ',@elements) 
+           unless defined($columns) || defined($rows);
+    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
+}
+END_OF_FUNC
+
+
+#### Method: popup_menu
+# Create a popup menu.
+# Parameters:
+#   $name -> Name for all the menu
+#   $values -> A pointer to a regular array containing the
+#             text of each menu item.
+#   $default -> (optional) Default item to display
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   A string containing the definition of a popup menu.
+####
+'popup_menu' => <<'END_OF_FUNC',
+sub popup_menu {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$default,$labels,$override,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
+    my($result,$selected);
+
+    if (!$override && defined($self->param($name))) {
+	$selected = $self->param($name);
+    } else {
+	$selected = $default;
+    }
+    $name=$self->escapeHTML($name);
+    my($other) = @other ? " @other" : '';
+
+    my(@values);
+    @values = $self->_set_values_and_labels($values,\$labels,$name);
+
+    $result = qq/<SELECT NAME="$name"$other>\n/;
+    foreach (@values) {
+	my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
+	my($label) = $_;
+	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	my($value) = $self->escapeHTML($_);
+	$label=$self->escapeHTML($label);
+	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
+    }
+
+    $result .= "</SELECT>\n";
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: scrolling_list
+# Create a scrolling list.
+# Parameters:
+#   $name -> name for the list
+#   $values -> A pointer to a regular array containing the
+#             values for each option line in the list.
+#   $defaults -> (optional)
+#             1. If a pointer to a regular array of options,
+#             then this will be used to decide which
+#             lines to turn on by default.
+#             2. Otherwise holds the value of the single line to turn on.
+#   $size -> (optional) Size of the list.
+#   $multiple -> (optional) If set, allow multiple selections.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   A string containing the definition of a scrolling list.
+####
+'scrolling_list' => <<'END_OF_FUNC',
+sub scrolling_list {
+    my($self,@p) = self_or_default(@_);
+    my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
+	= $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
+			    SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
+
+    my($result,@values);
+    @values = $self->_set_values_and_labels($values,\$labels,$name);
+
+    $size = $size || scalar(@values);
+
+    my(%selected) = $self->previous_or_default($name,$defaults,$override);
+    my($is_multiple) = $multiple ? ' MULTIPLE' : '';
+    my($has_size) = $size ? " SIZE=$size" : '';
+    my($other) = @other ? " @other" : '';
+
+    $name=$self->escapeHTML($name);
+    $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
+    foreach (@values) {
+	my($selectit) = $selected{$_} ? 'SELECTED' : '';
+	my($label) = $_;
+	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	$label=$self->escapeHTML($label);
+	my($value)=$self->escapeHTML($_);
+	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
+    }
+    $result .= "</SELECT>\n";
+    $self->register_parameter($name);
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: hidden
+# Parameters:
+#   $name -> Name of the hidden field
+#   @default -> (optional) Initial values of field (may be an array)
+#      or
+#   $default->[initial values of field]
+# Returns:
+#   A string containing a <INPUT TYPE="hidden" NAME="name" VALUE="value">
+####
+'hidden' => <<'END_OF_FUNC',
+sub hidden {
+    my($self,@p) = self_or_default(@_);
+
+    # this is the one place where we departed from our standard
+    # calling scheme, so we have to special-case (darn)
+    my(@result,@value);
+    my($name,$default,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
+
+    my $do_override = 0;
+    if ( ref($p[0]) || substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
+	@value = ref($default) ? @{$default} : $default;
+	$do_override = $override;
+    } else {
+	foreach ($default,$override,@other) {
+	    push(@value,$_) if defined($_);
+	}
+    }
+
+    # use previous values if override is not set
+    my @prev = $self->param($name);
+    @value = @prev if !$do_override && @prev;
+
+    $name=$self->escapeHTML($name);
+    foreach (@value) {
+	$_=$self->escapeHTML($_);
+	push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
+    }
+    return wantarray ? @result : join('',@result);
+}
+END_OF_FUNC
+
+
+#### Method: image_button
+# Parameters:
+#   $name -> Name of the button
+#   $src ->  URL of the image source
+#   $align -> Alignment style (TOP, BOTTOM or MIDDLE)
+# Returns:
+#   A string containing a <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment">
+####
+'image_button' => <<'END_OF_FUNC',
+sub image_button {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$src,$alignment,@other) =
+	$self->rearrange([NAME,SRC,ALIGN],@p);
+
+    my($align) = $alignment ? " ALIGN=\U$alignment" : '';
+    my($other) = @other ? " @other" : '';
+    $name=$self->escapeHTML($name);
+    return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: self_url
+# Returns a URL containing the current script and all its
+# param/value pairs arranged as a query.  You can use this
+# to create a link that, when selected, will reinvoke the
+# script with all its state information preserved.
+####
+'self_url' => <<'END_OF_FUNC',
+sub self_url {
+    my($self,@p) = self_or_default(@_);
+    return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p);
+}
+END_OF_FUNC
+
+
+# This is provided as a synonym to self_url() for people unfortunate
+# enough to have incorporated it into their programs already!
+'state' => <<'END_OF_FUNC',
+sub state {
+    &self_url;
+}
+END_OF_FUNC
+
+
+#### Method: url
+# Like self_url, but doesn't return the query string part of
+# the URL.
+####
+'url' => <<'END_OF_FUNC',
+sub url {
+    my($self,@p) = self_or_default(@_);
+    my ($relative,$absolute,$full,$path_info,$query) = 
+	$self->rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
+    my $url;
+    $full++ if !($relative || $absolute);
+
+    if ($full) {
+	my $protocol = $self->protocol();
+	$url = "$protocol://";
+	my $vh = http('host');
+	if ($vh) {
+	    $url .= $vh;
+	} else {
+	    $url .= server_name();
+	    my $port = $self->server_port;
+	    $url .= ":" . $port
+		unless (lc($protocol) eq 'http' && $port == 80)
+		    || (lc($protocol) eq 'https' && $port == 443);
+	}
+	$url .= $self->script_name;
+    } elsif ($relative) {
+	($url) = $self->script_name =~ m!([^/]+)$!;
+    } elsif ($absolute) {
+	$url = $self->script_name;
+    }
+    $url .= $self->path_info if $path_info and $self->path_info;
+    $url .= "?" . $self->query_string if $query and $self->query_string;
+    return $url;
+}
+
+END_OF_FUNC
+
+#### Method: cookie
+# Set or read a cookie from the specified name.
+# Cookie can then be passed to header().
+# Usual rules apply to the stickiness of -value.
+#  Parameters:
+#   -name -> name for this cookie (optional)
+#   -value -> value of this cookie (scalar, array or hash) 
+#   -path -> paths for which this cookie is valid (optional)
+#   -domain -> internet domain in which this cookie is valid (optional)
+#   -secure -> if true, cookie only passed through secure channel (optional)
+#   -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional)
+####
+'cookie' => <<'END_OF_FUNC',
+sub cookie {
+    my($self,@p) = self_or_default(@_);
+    my($name,$value,$path,$domain,$secure,$expires) =
+	$self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
+
+    require CGI::Cookie;
+
+    # if no value is supplied, then we retrieve the
+    # value of the cookie, if any.  For efficiency, we cache the parsed
+    # cookies in our state variables.
+    unless ( defined($value) ) {
+	$self->{'.cookies'} = CGI::Cookie->fetch
+	    unless $self->{'.cookies'};
+
+	# If no name is supplied, then retrieve the names of all our cookies.
+	return () unless $self->{'.cookies'};
+	return keys %{$self->{'.cookies'}} unless $name;
+	return () unless $self->{'.cookies'}->{$name};
+	return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne '';
+    }
+
+    # If we get here, we're creating a new cookie
+    return undef unless $name;	# this is an error
+
+    my @param;
+    push(@param,'-name'=>$name);
+    push(@param,'-value'=>$value);
+    push(@param,'-domain'=>$domain) if $domain;
+    push(@param,'-path'=>$path) if $path;
+    push(@param,'-expires'=>$expires) if $expires;
+    push(@param,'-secure'=>$secure) if $secure;
+
+    return new CGI::Cookie(@param);
+}
+END_OF_FUNC
+
+# This internal routine creates an expires time exactly some number of
+# hours from the current time.  It incorporates modifications from 
+# Mark Fisher.
+'expire_calc' => <<'END_OF_FUNC',
+sub expire_calc {
+    my($time) = @_;
+    my(%mult) = ('s'=>1,
+                 'm'=>60,
+                 'h'=>60*60,
+                 'd'=>60*60*24,
+                 'M'=>60*60*24*30,
+                 'y'=>60*60*24*365);
+    # format for time can be in any of the forms...
+    # "now" -- expire immediately
+    # "+180s" -- in 180 seconds
+    # "+2m" -- in 2 minutes
+    # "+12h" -- in 12 hours
+    # "+1d"  -- in 1 day
+    # "+3M"  -- in 3 months
+    # "+2y"  -- in 2 years
+    # "-3m"  -- 3 minutes ago(!)
+    # If you don't supply one of these forms, we assume you are
+    # specifying the date yourself
+    my($offset);
+    if (!$time || (lc($time) eq 'now')) {
+        $offset = 0;
+    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
+        $offset = ($mult{$2} || 1)*$1;
+    } else {
+        return $time;
+    }
+    return (time+$offset);
+}
+END_OF_FUNC
+
+# This internal routine creates date strings suitable for use in
+# cookies and HTTP headers.  (They differ, unfortunately.)
+# Thanks to Fisher Mark for this.
+'expires' => <<'END_OF_FUNC',
+sub expires {
+    my($time,$format) = @_;
+    $format ||= 'http';
+
+    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+    # pass through preformatted dates for the sake of expire_calc()
+    $time = expire_calc($time);
+    return $time unless $time =~ /^\d+$/;
+
+    # make HTTP/cookie date string from GMT'ed time
+    # (cookies use '-' as date separator, HTTP uses ' ')
+    my($sc) = ' ';
+    $sc = '-' if $format eq "cookie";
+    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
+    $year += 1900;
+    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
+                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
+}
+END_OF_FUNC
+
+'parse_keywordlist' => <<'END_OF_FUNC',
+sub parse_keywordlist {
+    my($self,$tosplit) = @_;
+    $tosplit = unescape($tosplit); # unescape the keywords
+    $tosplit=~tr/+/ /;          # pluses to spaces
+    my(@keywords) = split(/\s+/,$tosplit);
+    return @keywords;
+}
+END_OF_FUNC
+
+'param_fetch' => <<'END_OF_FUNC',
+sub param_fetch {
+    my($self,@p) = self_or_default(@_);
+    my($name) = $self->rearrange([NAME],@p);
+    unless (exists($self->{$name})) {
+	$self->add_parameter($name);
+	$self->{$name} = [];
+    }
+    
+    return $self->{$name};
+}
+END_OF_FUNC
+
+###############################################
+# OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
+###############################################
+
+#### Method: path_info
+# Return the extra virtual path information provided
+# after the URL (if any)
+####
+'path_info' => <<'END_OF_FUNC',
+sub path_info {
+    my ($self,$info) = self_or_default(@_);
+    if (defined($info)) {
+	$info = "/$info" if $info ne '' &&  substr($info,0,1) ne '/';
+	$self->{'.path_info'} = $info;
+    } elsif (! defined($self->{'.path_info'}) ) {
+	$self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ? 
+	    $ENV{'PATH_INFO'} : '';
+
+	# hack to fix broken path info in IIS
+	$self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
+
+    }
+    return $self->{'.path_info'};
+}
+END_OF_FUNC
+
+
+#### Method: request_method
+# Returns 'POST', 'GET', 'PUT' or 'HEAD'
+####
+'request_method' => <<'END_OF_FUNC',
+sub request_method {
+    return $ENV{'REQUEST_METHOD'};
+}
+END_OF_FUNC
+
+#### Method: path_translated
+# Return the physical path information provided
+# by the URL (if any)
+####
+'path_translated' => <<'END_OF_FUNC',
+sub path_translated {
+    return $ENV{'PATH_TRANSLATED'};
+}
+END_OF_FUNC
+
+
+#### Method: query_string
+# Synthesize a query string from our current
+# parameters
+####
+'query_string' => <<'END_OF_FUNC',
+sub query_string {
+    my($self) = self_or_default(@_);
+    my($param,$value,@pairs);
+    foreach $param ($self->param) {
+	my($eparam) = escape($param);
+	foreach $value ($self->param($param)) {
+	    $value = escape($value);
+	    push(@pairs,"$eparam=$value");
+	}
+    }
+    return join("&",@pairs);
+}
+END_OF_FUNC
+
+
+#### Method: accept
+# Without parameters, returns an array of the
+# MIME types the browser accepts.
+# With a single parameter equal to a MIME
+# type, will return undef if the browser won't
+# accept it, 1 if the browser accepts it but
+# doesn't give a preference, or a floating point
+# value between 0.0 and 1.0 if the browser
+# declares a quantitative score for it.
+# This handles MIME type globs correctly.
+####
+'accept' => <<'END_OF_FUNC',
+sub accept {
+    my($self,$search) = self_or_CGI(@_);
+    my(%prefs,$type,$pref,$pat);
+    
+    my(@accept) = split(',',$self->http('accept'));
+
+    foreach (@accept) {
+	($pref) = /q=(\d\.\d+|\d+)/;
+	($type) = m#(\S+/[^;]+)#;
+	next unless $type;
+	$prefs{$type}=$pref || 1;
+    }
+
+    return keys %prefs unless $search;
+    
+    # if a search type is provided, we may need to
+    # perform a pattern matching operation.
+    # The MIME types use a glob mechanism, which
+    # is easily translated into a perl pattern match
+
+    # First return the preference for directly supported
+    # types:
+    return $prefs{$search} if $prefs{$search};
+
+    # Didn't get it, so try pattern matching.
+    foreach (keys %prefs) {
+	next unless /\*/;       # not a pattern match
+	($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
+	$pat =~ s/\*/.*/g; # turn it into a pattern
+	return $prefs{$_} if $search=~/$pat/;
+    }
+}
+END_OF_FUNC
+
+
+#### Method: user_agent
+# If called with no parameters, returns the user agent.
+# If called with one parameter, does a pattern match (case
+# insensitive) on the user agent.
+####
+'user_agent' => <<'END_OF_FUNC',
+sub user_agent {
+    my($self,$match)=self_or_CGI(@_);
+    return $self->http('user_agent') unless $match;
+    return $self->http('user_agent') =~ /$match/i;
+}
+END_OF_FUNC
+
+
+#### Method: raw_cookie
+# Returns the magic cookies for the session.
+# The cookies are not parsed or altered in any way, i.e.
+# cookies are returned exactly as given in the HTTP
+# headers.  If a cookie name is given, only that cookie's
+# value is returned, otherwise the entire raw cookie
+# is returned.
+####
+'raw_cookie' => <<'END_OF_FUNC',
+sub raw_cookie {
+    my($self,$key) = self_or_CGI(@_);
+
+    require CGI::Cookie;
+
+    if (defined($key)) {
+	$self->{'.raw_cookies'} = CGI::Cookie->raw_fetch
+	    unless $self->{'.raw_cookies'};
+
+	return () unless $self->{'.raw_cookies'};
+	return () unless $self->{'.raw_cookies'}->{$key};
+	return $self->{'.raw_cookies'}->{$key};
+    }
+    return $self->http('cookie') || $ENV{'COOKIE'} || '';
+}
+END_OF_FUNC
+
+#### Method: virtual_host
+# Return the name of the virtual_host, which
+# is not always the same as the server
+######
+'virtual_host' => <<'END_OF_FUNC',
+sub virtual_host {
+    my $vh = http('host') || server_name();
+    $vh =~ s/:\d+$//;		# get rid of port number
+    return $vh;
+}
+END_OF_FUNC
+
+#### Method: remote_host
+# Return the name of the remote host, or its IP
+# address if unavailable.  If this variable isn't
+# defined, it returns "localhost" for debugging
+# purposes.
+####
+'remote_host' => <<'END_OF_FUNC',
+sub remote_host {
+    return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} 
+    || 'localhost';
+}
+END_OF_FUNC
+
+
+#### Method: remote_addr
+# Return the IP addr of the remote host.
+####
+'remote_addr' => <<'END_OF_FUNC',
+sub remote_addr {
+    return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
+}
+END_OF_FUNC
+
+
+#### Method: script_name
+# Return the partial URL to this script for
+# self-referencing scripts.  Also see
+# self_url(), which returns a URL with all state information
+# preserved.
+####
+'script_name' => <<'END_OF_FUNC',
+sub script_name {
+    return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
+    # These are for debugging
+    return "/$0" unless $0=~/^\//;
+    return $0;
+}
+END_OF_FUNC
+
+
+#### Method: referer
+# Return the HTTP_REFERER: useful for generating
+# a GO BACK button.
+####
+'referer' => <<'END_OF_FUNC',
+sub referer {
+    my($self) = self_or_CGI(@_);
+    return $self->http('referer');
+}
+END_OF_FUNC
+
+
+#### Method: server_name
+# Return the name of the server
+####
+'server_name' => <<'END_OF_FUNC',
+sub server_name {
+    return $ENV{'SERVER_NAME'} || 'localhost';
+}
+END_OF_FUNC
+
+#### Method: server_software
+# Return the name of the server software
+####
+'server_software' => <<'END_OF_FUNC',
+sub server_software {
+    return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
+}
+END_OF_FUNC
+
+#### Method: server_port
+# Return the tcp/ip port the server is running on
+####
+'server_port' => <<'END_OF_FUNC',
+sub server_port {
+    return $ENV{'SERVER_PORT'} || 80; # for debugging
+}
+END_OF_FUNC
+
+#### Method: server_protocol
+# Return the protocol (usually HTTP/1.0)
+####
+'server_protocol' => <<'END_OF_FUNC',
+sub server_protocol {
+    return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging
+}
+END_OF_FUNC
+
+#### Method: http
+# Return the value of an HTTP variable, or
+# the list of variables if none provided
+####
+'http' => <<'END_OF_FUNC',
+sub http {
+    my ($self,$parameter) = self_or_CGI(@_);
+    return $ENV{$parameter} if $parameter=~/^HTTP/;
+    return $ENV{"HTTP_\U$parameter\E"} if $parameter;
+    my(@p);
+    foreach (keys %ENV) {
+	push(@p,$_) if /^HTTP/;
+    }
+    return @p;
+}
+END_OF_FUNC
+
+#### Method: https
+# Return the value of HTTPS
+####
+'https' => <<'END_OF_FUNC',
+sub https {
+    local($^W)=0;
+    my ($self,$parameter) = self_or_CGI(@_);
+    return $ENV{HTTPS} unless $parameter;
+    return $ENV{$parameter} if $parameter=~/^HTTPS/;
+    return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
+    my(@p);
+    foreach (keys %ENV) {
+	push(@p,$_) if /^HTTPS/;
+    }
+    return @p;
+}
+END_OF_FUNC
+
+#### Method: protocol
+# Return the protocol (http or https currently)
+####
+'protocol' => <<'END_OF_FUNC',
+sub protocol {
+    local($^W)=0;
+    my $self = shift;
+    return 'https' if uc($self->https()) eq 'ON'; 
+    return 'https' if $self->server_port == 443;
+    my $prot = $self->server_protocol;
+    my($protocol,$version) = split('/',$prot);
+    return "\L$protocol\E";
+}
+END_OF_FUNC
+
+#### Method: remote_ident
+# Return the identity of the remote user
+# (but only if his host is running identd)
+####
+'remote_ident' => <<'END_OF_FUNC',
+sub remote_ident {
+    return $ENV{'REMOTE_IDENT'};
+}
+END_OF_FUNC
+
+
+#### Method: auth_type
+# Return the type of use verification/authorization in use, if any.
+####
+'auth_type' => <<'END_OF_FUNC',
+sub auth_type {
+    return $ENV{'AUTH_TYPE'};
+}
+END_OF_FUNC
+
+
+#### Method: remote_user
+# Return the authorization name used for user
+# verification.
+####
+'remote_user' => <<'END_OF_FUNC',
+sub remote_user {
+    return $ENV{'REMOTE_USER'};
+}
+END_OF_FUNC
+
+
+#### Method: user_name
+# Try to return the remote user's name by hook or by
+# crook
+####
+'user_name' => <<'END_OF_FUNC',
+sub user_name {
+    my ($self) = self_or_CGI(@_);
+    return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
+}
+END_OF_FUNC
+
+#### Method: nph
+# Set or return the NPH global flag
+####
+'nph' => <<'END_OF_FUNC',
+sub nph {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::NPH = $param if defined($param);
+    return $CGI::NPH;
+}
+END_OF_FUNC
+
+#### Method: private_tempfiles
+# Set or return the private_tempfiles global flag
+####
+'private_tempfiles' => <<'END_OF_FUNC',
+sub private_tempfiles {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::PRIVATE_TEMPFILES = $param if defined($param);
+    return $CGI::PRIVATE_TEMPFILES;
+}
+END_OF_FUNC
+
+#### Method: default_dtd
+# Set or return the default_dtd global
+####
+'default_dtd' => <<'END_OF_FUNC',
+sub default_dtd {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::DEFAULT_DTD = $param if defined($param);
+    return $CGI::DEFAULT_DTD;
+}
+END_OF_FUNC
+
+# -------------- really private subroutines -----------------
+'previous_or_default' => <<'END_OF_FUNC',
+sub previous_or_default {
+    my($self,$name,$defaults,$override) = @_;
+    my(%selected);
+
+    if (!$override && ($self->{'.fieldnames'}->{$name} || 
+		       defined($self->param($name)) ) ) {
+	grep($selected{$_}++,$self->param($name));
+    } elsif (defined($defaults) && ref($defaults) && 
+	     (ref($defaults) eq 'ARRAY')) {
+	grep($selected{$_}++,@{$defaults});
+    } else {
+	$selected{$defaults}++ if defined($defaults);
+    }
+
+    return %selected;
+}
+END_OF_FUNC
+
+'register_parameter' => <<'END_OF_FUNC',
+sub register_parameter {
+    my($self,$param) = @_;
+    $self->{'.parametersToAdd'}->{$param}++;
+}
+END_OF_FUNC
+
+'get_fields' => <<'END_OF_FUNC',
+sub get_fields {
+    my($self) = @_;
+    return $self->CGI::hidden('-name'=>'.cgifields',
+			      '-values'=>[keys %{$self->{'.parametersToAdd'}}],
+			      '-override'=>1);
+}
+END_OF_FUNC
+
+'read_from_cmdline' => <<'END_OF_FUNC',
+sub read_from_cmdline {
+    my($input,@words);
+    my($query_string);
+    if (@ARGV) {
+	@words = @ARGV;
+    } else {
+	require "shellwords.pl";
+	print STDERR "(offline mode: enter name=value pairs on standard input)\n";
+	chomp(@lines = <STDIN>); # remove newlines
+	$input = join(" ",@lines);
+	@words = &shellwords($input);    
+    }
+    foreach (@words) {
+	s/\\=/%3D/g;
+	s/\\&/%26/g;	    
+    }
+
+    if ("@words"=~/=/) {
+	$query_string = join('&',@words);
+    } else {
+	$query_string = join('+',@words);
+    }
+    return $query_string;
+}
+END_OF_FUNC
+
+#####
+# subroutine: read_multipart
+#
+# Read multipart data and store it into our parameters.
+# An interesting feature is that if any of the parts is a file, we
+# create a temporary file and open up a filehandle on it so that the
+# caller can read from it if necessary.
+#####
+'read_multipart' => <<'END_OF_FUNC',
+sub read_multipart {
+    my($self,$boundary,$length,$filehandle) = @_;
+    my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle);
+    return unless $buffer;
+    my(%header,$body);
+    my $filenumber = 0;
+    while (!$buffer->eof) {
+	%header = $buffer->readHeader;
+	die "Malformed multipart POST\n" unless %header;
+
+	my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
+
+	# Bug:  Netscape doesn't escape quotation marks in file names!!!
+	my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
+
+	# add this parameter to our list
+	$self->add_parameter($param);
+
+	# If no filename specified, then just read the data and assign it
+	# to our parameter list.
+	unless ($filename) {
+	    my($value) = $buffer->readBody;
+	    push(@{$self->{$param}},$value);
+	    next;
+	}
+
+	my ($tmpfile,$tmp,$filehandle);
+      UPLOADS: {
+	  # If we get here, then we are dealing with a potentially large
+	  # uploaded form.  Save the data to a temporary file, then open
+	  # the file for reading.
+
+	  # skip the file if uploads disabled
+	  if ($DISABLE_UPLOADS) {
+	      while (defined($data = $buffer->read)) { }
+	      last UPLOADS;
+	  }
+
+	  $tmpfile = new TempFile;
+	  $tmp = $tmpfile->as_string;
+	  
+	  $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES);
+
+	  $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+	  chmod 0600,$tmp;    # only the owner can tamper with it
+
+	  my ($data);
+	  while (defined($data = $buffer->read)) {
+	      print $filehandle $data;
+	  }
+
+	  # back up to beginning of file
+	  seek($filehandle,0,0);
+	  $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+
+	  # Save some information about the uploaded file where we can get
+	  # at it later.
+	  $self->{'.tmpfiles'}->{$filename}= {
+	      name => $tmpfile,
+	      info => {%header},
+	  };
+	  push(@{$self->{$param}},$filehandle);
+      }
+    }
+}
+END_OF_FUNC
+
+'tmpFileName' => <<'END_OF_FUNC',
+sub tmpFileName {
+    my($self,$filename) = self_or_default(@_);
+    return $self->{'.tmpfiles'}->{$filename}->{name} ?
+	$self->{'.tmpfiles'}->{$filename}->{name}->as_string
+	    : '';
+}
+END_OF_FUNC
+
+'uploadInfo' => <<'END_OF_FUNC',
+sub uploadInfo {
+    my($self,$filename) = self_or_default(@_);
+    return $self->{'.tmpfiles'}->{$filename}->{info};
+}
+END_OF_FUNC
+
+# internal routine, don't use
+'_set_values_and_labels' => <<'END_OF_FUNC',
+sub _set_values_and_labels {
+    my $self = shift;
+    my ($v,$l,$n) = @_;
+    $$l = $v if ref($v) eq 'HASH' && !ref($$l);
+    return $self->param($n) if !defined($v);
+    return $v if !ref($v);
+    return ref($v) eq 'HASH' ? keys %$v : @$v;
+}
+END_OF_FUNC
+
+'_compile_all' => <<'END_OF_FUNC',
+sub _compile_all {
+    foreach (@_) {
+	next if defined(&$_);
+	$AUTOLOAD = "CGI::$_";
+	_compile();
+    }
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+;
+
+#########################################################
+# Globals and stubs for other packages that we use.
+#########################################################
+
+################### Fh -- lightweight filehandle ###############
+package Fh;
+use overload 
+    '""'  => \&asString,
+    'cmp' => \&compare,
+    'fallback'=>1;
+
+$FH='fh00000';
+
+*Fh::AUTOLOAD = \&CGI::AUTOLOAD;
+
+$AUTOLOADED_ROUTINES = '';      # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS =  (
+'asString' => <<'END_OF_FUNC',
+sub asString {
+    my $self = shift;
+    my $i = $$self;
+    $i=~ s/^\*(\w+::)+//; # get rid of package name
+    $i =~ s/\\(.)/$1/g;
+    return $i;
+}
+END_OF_FUNC
+
+'compare' => <<'END_OF_FUNC',
+sub compare {
+    my $self = shift;
+    my $value = shift;
+    return "$self" cmp $value;
+}
+END_OF_FUNC
+
+'new'  => <<'END_OF_FUNC',
+sub new {
+    my($pack,$name,$file,$delete) = @_;
+    require Fcntl unless defined &Fcntl::O_RDWR;
+    ++$FH;
+    *{$FH} = quotemeta($name);
+    sysopen($FH,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL()) 
+	|| die "CGI open of $file: $!\n";
+    unlink($file) if $delete;
+    return bless \*{$FH},$pack;
+}
+END_OF_FUNC
+
+'DESTROY'  => <<'END_OF_FUNC',
+sub DESTROY {
+    my $self = shift;
+    close $self;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+######################## MultipartBuffer ####################
+package MultipartBuffer;
+
+# how many bytes to read at a time.  We use
+# a 5K buffer by default.
+$INITIAL_FILLUNIT = 1024 * 5;
+$TIMEOUT = 10*60;       # 10 minute timeout
+$SPIN_LOOP_MAX = 1000;  # bug fix for some Netscape servers
+$CRLF=$CGI::CRLF;
+
+#reuse the autoload function
+*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
+
+# avoid autoloader warnings
+sub DESTROY {}
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS =  (
+
+'new' => <<'END_OF_FUNC',
+sub new {
+    my($package,$interface,$boundary,$length,$filehandle) = @_;
+    $FILLUNIT = $INITIAL_FILLUNIT;
+    my $IN;
+    if ($filehandle) {
+	my($package) = caller;
+	# force into caller's package if necessary
+	$IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; 
+    }
+    $IN = "main::STDIN" unless $IN;
+
+    $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
+    
+    # If the user types garbage into the file upload field,
+    # then Netscape passes NOTHING to the server (not good).
+    # We may hang on this read in that case. So we implement
+    # a read timeout.  If nothing is ready to read
+    # by then, we return.
+
+    # Netscape seems to be a little bit unreliable
+    # about providing boundary strings.
+    if ($boundary) {
+
+	# Under the MIME spec, the boundary consists of the 
+	# characters "--" PLUS the Boundary string
+
+	# BUG: IE 3.01 on the Macintosh uses just the boundary -- not
+	# the two extra spaces.  We do a special case here on the user-agent!!!!
+	$boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12];  Mac');
+
+    } else { # otherwise we find it ourselves
+	my($old);
+	($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
+	$boundary = <$IN>;      # BUG: This won't work correctly under mod_perl
+	$length -= length($boundary);
+	chomp($boundary);               # remove the CRLF
+	$/ = $old;                      # restore old line separator
+    }
+
+    my $self = {LENGTH=>$length,
+		BOUNDARY=>$boundary,
+		IN=>$IN,
+		INTERFACE=>$interface,
+		BUFFER=>'',
+	    };
+
+    $FILLUNIT = length($boundary)
+	if length($boundary) > $FILLUNIT;
+
+    my $retval = bless $self,ref $package || $package;
+
+    # Read the preamble and the topmost (boundary) line plus the CRLF.
+    while ($self->read(0)) { }
+    die "Malformed multipart POST\n" if $self->eof;
+
+    return $retval;
+}
+END_OF_FUNC
+
+'readHeader' => <<'END_OF_FUNC',
+sub readHeader {
+    my($self) = @_;
+    my($end);
+    my($ok) = 0;
+    my($bad) = 0;
+
+    if ($CGI::OS eq 'VMS') {  # tssk, tssk: inconsistency alert!
+	local($CRLF) = "\015\012";
+    }
+
+    do {
+	$self->fillBuffer($FILLUNIT);
+	$ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
+	$ok++ if $self->{BUFFER} eq '';
+	$bad++ if !$ok && $self->{LENGTH} <= 0;
+	# this was a bad idea
+	# $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; 
+    } until $ok || $bad;
+    return () if $bad;
+
+    my($header) = substr($self->{BUFFER},0,$end+2);
+    substr($self->{BUFFER},0,$end+4) = '';
+    my %return;
+
+    
+    # See RFC 2045 Appendix A and RFC 822 sections 3.4.8
+    #   (Folding Long Header Fields), 3.4.3 (Comments)
+    #   and 3.4.5 (Quoted-Strings).
+
+    my $token = '[-\w!\#$%&\'*+.^_\`|{}~]';
+    $header=~s/$CRLF\s+/ /og;		# merge continuation lines
+    while ($header=~/($token+):\s+([^$CRLF]*)/mgox) {
+	my ($field_name,$field_value) = ($1,$2); # avoid taintedness
+	$field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize
+	$return{$field_name}=$field_value;
+    }
+    return %return;
+}
+END_OF_FUNC
+
+# This reads and returns the body as a single scalar value.
+'readBody' => <<'END_OF_FUNC',
+sub readBody {
+    my($self) = @_;
+    my($data);
+    my($returnval)='';
+    while (defined($data = $self->read)) {
+	$returnval .= $data;
+    }
+    return $returnval;
+}
+END_OF_FUNC
+
+# This will read $bytes or until the boundary is hit, whichever happens
+# first.  After the boundary is hit, we return undef.  The next read will
+# skip over the boundary and begin reading again;
+'read' => <<'END_OF_FUNC',
+sub read {
+    my($self,$bytes) = @_;
+
+    # default number of bytes to read
+    $bytes = $bytes || $FILLUNIT;       
+
+    # Fill up our internal buffer in such a way that the boundary
+    # is never split between reads.
+    $self->fillBuffer($bytes);
+
+    # Find the boundary in the buffer (it may not be there).
+    my $start = index($self->{BUFFER},$self->{BOUNDARY});
+    # protect against malformed multipart POST operations
+    die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
+
+    # If the boundary begins the data, then skip past it
+    # and return undef.  The +2 here is a fiendish plot to
+    # remove the CR/LF pair at the end of the boundary.
+    if ($start == 0) {
+
+	# clear us out completely if we've hit the last boundary.
+	if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
+	    $self->{BUFFER}='';
+	    $self->{LENGTH}=0;
+	    return undef;
+	}
+
+	# just remove the boundary.
+	substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
+	return undef;
+    }
+
+    my $bytesToReturn;    
+    if ($start > 0) {           # read up to the boundary
+	$bytesToReturn = $start > $bytes ? $bytes : $start;
+    } else {    # read the requested number of bytes
+	# leave enough bytes in the buffer to allow us to read
+	# the boundary.  Thanks to Kevin Hendrick for finding
+	# this one.
+	$bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
+    }
+
+    my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
+    substr($self->{BUFFER},0,$bytesToReturn)='';
+    
+    # If we hit the boundary, remove the CRLF from the end.
+    return ($start > 0) ? substr($returnval,0,-2) : $returnval;
+}
+END_OF_FUNC
+
+
+# This fills up our internal buffer in such a way that the
+# boundary is never split between reads
+'fillBuffer' => <<'END_OF_FUNC',
+sub fillBuffer {
+    my($self,$bytes) = @_;
+    return unless $self->{LENGTH};
+
+    my($boundaryLength) = length($self->{BOUNDARY});
+    my($bufferLength) = length($self->{BUFFER});
+    my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
+    $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
+
+    # Try to read some data.  We may hang here if the browser is screwed up.  
+    my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
+							 \$self->{BUFFER},
+							 $bytesToRead,
+							 $bufferLength);
+
+    # An apparent bug in the Apache server causes the read()
+    # to return zero bytes repeatedly without blocking if the
+    # remote user aborts during a file transfer.  I don't know how
+    # they manage this, but the workaround is to abort if we get
+    # more than SPIN_LOOP_MAX consecutive zero reads.
+    if ($bytesRead == 0) {
+	die  "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
+	    if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
+    } else {
+	$self->{ZERO_LOOP_COUNTER}=0;
+    }
+
+    $self->{LENGTH} -= $bytesRead;
+}
+END_OF_FUNC
+
+
+# Return true when we've finished reading
+'eof' => <<'END_OF_FUNC'
+sub eof {
+    my($self) = @_;
+    return 1 if (length($self->{BUFFER}) == 0)
+		 && ($self->{LENGTH} <= 0);
+    undef;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+####################################################################################
+################################## TEMPORARY FILES #################################
+####################################################################################
+package TempFile;
+
+$SL = $CGI::SL;
+$MAC = $CGI::OS eq 'MACINTOSH';
+my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
+unless ($TMPDIRECTORY) {
+    @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
+	   "${SL}tmp","${SL}temp","${vol}${SL}Temporary Items",
+	   "${SL}WWW_ROOT");
+    foreach (@TEMP) {
+	do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
+    }
+}
+
+$TMPDIRECTORY  = $MAC ? "" : "." unless $TMPDIRECTORY;
+$SEQUENCE=0;
+$MAXTRIES = 5000;
+
+# cute feature, but overload implementation broke it
+# %OVERLOAD = ('""'=>'as_string');
+*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS = (
+
+'new' => <<'END_OF_FUNC',
+sub new {
+    my($package) = @_;
+    my $directory;
+    my $i;
+    for ($i = 0; $i < $MAXTRIES; $i++) {
+	$directory = sprintf("${TMPDIRECTORY}${SL}CGItemp%d%04d",${$},++$SEQUENCE);
+	last if ! -f $directory;
+    }
+    return bless \$directory;
+}
+END_OF_FUNC
+
+'DESTROY' => <<'END_OF_FUNC',
+sub DESTROY {
+    my($self) = @_;
+    unlink $$self;              # get rid of the file
+}
+END_OF_FUNC
+
+'as_string' => <<'END_OF_FUNC'
+sub as_string {
+    my($self) = @_;
+    return $$self;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+package CGI;
+
+# We get a whole bunch of warnings about "possibly uninitialized variables"
+# when running with the -w switch.  Touch them all once to get rid of the
+# warnings.  This is ugly and I hate it.
+if ($^W) {
+    $CGI::CGI = '';
+    $CGI::CGI=<<EOF;
+    $CGI::VERSION;
+    $MultipartBuffer::SPIN_LOOP_MAX;
+    $MultipartBuffer::CRLF;
+    $MultipartBuffer::TIMEOUT;
+    $MultipartBuffer::INITIAL_FILLUNIT;
+    $TempFile::SEQUENCE;
+EOF
+    ;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+CGI - Simple Common Gateway Interface Class
+
+=head1 SYNOPSIS
+
+  # CGI script that creates a fill-out form
+  # and echoes back its values.
+
+  use CGI qw/:standard/;
+  print header,
+        start_html('A Simple Example'),
+        h1('A Simple Example'),
+        start_form,
+        "What's your name? ",textfield('name'),p,
+        "What's the combination?", p,
+        checkbox_group(-name=>'words',
+		       -values=>['eenie','meenie','minie','moe'],
+		       -defaults=>['eenie','minie']), p,
+        "What's your favorite color? ",
+        popup_menu(-name=>'color',
+	           -values=>['red','green','blue','chartreuse']),p,
+        submit,
+        end_form,
+        hr;
+
+   if (param()) {
+       print "Your name is",em(param('name')),p,
+	     "The keywords are: ",em(join(", ",param('words'))),p,
+	     "Your favorite color is ",em(param('color')),
+	     hr;
+   }
+
+=head1 ABSTRACT
+
+This perl library uses perl5 objects to make it easy to create Web
+fill-out forms and parse their contents.  This package defines CGI
+objects, entities that contain the values of the current query string
+and other state variables.  Using a CGI object's methods, you can
+examine keywords and parameters passed to your script, and create
+forms whose initial values are taken from the current query (thereby
+preserving state information).  The module provides shortcut functions
+that produce boilerplate HTML, reducing typing and coding errors. It
+also provides functionality for some of the more advanced features of
+CGI scripting, including support for file uploads, cookies, cascading
+style sheets, server push, and frames.
+
+CGI.pm also provides a simple function-oriented programming style for
+those who don't need its object-oriented features.
+
+The current version of CGI.pm is available at
+
+  http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+  ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+=head1 DESCRIPTION
+
+=head2 PROGRAMMING STYLE
+
+There are two styles of programming with CGI.pm, an object-oriented
+style and a function-oriented style.  In the object-oriented style you
+create one or more CGI objects and then use object methods to create
+the various elements of the page.  Each CGI object starts out with the
+list of named parameters that were passed to your CGI script by the
+server.  You can modify the objects, save them to a file or database
+and recreate them.  Because each object corresponds to the "state" of
+the CGI script, and because each object's parameter list is
+independent of the others, this allows you to save the state of the
+script and restore it later.
+
+For example, using the object oriented style, here is now you create
+a simple "Hello World" HTML page:
+
+   #!/usr/local/bin/pelr
+   use CGI;                             # load CGI routines
+   $q = new CGI;                        # create new CGI object
+   print $q->header,                    # create the HTTP header
+         $q->start_html('hello world'), # start the HTML
+         $q->h1('hello world'),         # level 1 header
+         $q->end_html;                  # end the HTML
+
+In the function-oriented style, there is one default CGI object that
+you rarely deal with directly.  Instead you just call functions to
+retrieve CGI parameters, create HTML tags, manage cookies, and so
+on.  This provides you with a cleaner programming interface, but
+limits you to using one CGI object at a time.  The following example
+prints the same page, but uses the function-oriented interface.
+The main differences are that we now need to import a set of functions
+into our name space (usually the "standard" functions), and we don't
+need to create the CGI object.
+
+   #!/usr/local/bin/pelr
+   use CGI qw/:standard/;           # load standard CGI routines
+   print header,                    # create the HTTP header
+         start_html('hello world'), # start the HTML
+         h1('hello world'),         # level 1 header
+         end_html;                  # end the HTML
+
+The examples in this document mainly use the object-oriented style.
+See HOW TO IMPORT FUNCTIONS for important information on
+function-oriented programming in CGI.pm
+
+=head2 CALLING CGI.PM ROUTINES
+
+Most CGI.pm routines accept several arguments, sometimes as many as 20
+optional ones!  To simplify this interface, all routines use a named
+argument calling style that looks like this:
+
+   print $q->header(-type=>'image/gif',-expires=>'+3d');
+
+Each argument name is preceded by a dash.  Neither case nor order
+matters in the argument list.  -type, -Type, and -TYPE are all
+acceptable.  In fact, only the first argument needs to begin with a
+dash.  If a dash is present in the first argument, CGI.pm assumes
+dashes for the subsequent ones.
+
+You don't have to use the hyphen at allif you don't want to.  After
+creating a CGI object, call the B<use_named_parameters()> method with
+a nonzero value.  This will tell CGI.pm that you intend to use named
+parameters exclusively:
+
+   $query = new CGI;
+   $query->use_named_parameters(1);
+   $field = $query->radio_group('name'=>'OS',
+				'values'=>['Unix','Windows','Macintosh'],
+				'default'=>'Unix');
+
+Several routines are commonly called with just one argument.  In the
+case of these routines you can provide the single argument without an
+argument name.  header() happens to be one of these routines.  In this
+case, the single argument is the document type.
+
+   print $q->header('text/html');
+
+Other such routines are documented below.
+
+Sometimes named arguments expect a scalar, sometimes a reference to an
+array, and sometimes a reference to a hash.  Often, you can pass any
+type of argument and the routine will do whatever is most appropriate.
+For example, the param() routine is used to set a CGI parameter to a
+single or a multi-valued value.  The two cases are shown below:
+
+   $q->param(-name=>'veggie',-value=>'tomato');
+   $q->param(-name=>'veggie',-value=>'[tomato','tomahto','potato','potahto']);
+
+A large number of routines in CGI.pm actually aren't specifically
+defined in the module, but are generated automatically as needed.
+These are the "HTML shortcuts," routines that generate HTML tags for
+use in dynamically-generated pages.  HTML tags have both attributes
+(the attribute="value" pairs within the tag itself) and contents (the
+part between the opening and closing pairs.)  To distinguish between
+attributes and contents, CGI.pm uses the convention of passing HTML
+attributes as a hash reference as the first argument, and the
+contents, if any, as any subsequent arguments.  It works out like
+this:
+
+   Code                           Generated HTML
+   ----                           --------------
+   h1()                           <H1>
+   h1('some','contents');         <H1>some contents</H1>
+   h1({-align=>left});            <H1 ALIGN="LEFT">
+   h1({-align=>left},'contents'); <H1 ALIGN="LEFT">contents</H1>
+
+HTML tags are described in more detail later.  
+
+Many newcomers to CGI.pm are puzzled by the difference between the
+calling conventions for the HTML shortcuts, which require curly braces
+around the HTML tag attributes, and the calling conventions for other
+routines, which manage to generate attributes without the curly
+brackets.  Don't be confused.  As a convenience the curly braces are
+optional in all but the HTML shortcuts.  If you like, you can use
+curly braces when calling any routine that takes named arguments.  For
+example:
+
+   print $q->header( {-type=>'image/gif',-expires=>'+3d'} );
+
+If you use the B<-w> switch, you will be warned that some CGI.pm argument
+names conflict with built-in Perl functions.  The most frequent of
+these is the -values argument, used to create multi-valued menus,
+radio button clusters and the like.  To get around this warning, you
+have several choices:
+
+=over 4
+
+=item 1. Use another name for the argument, if one is available.  For
+example, -value is an alias for -values.
+
+=item 2. Change the capitalization, e.g. -Values
+
+=item 3. Put quotes around the argument name, e.g. '-values'
+
+=back
+
+Many routines will do something useful with a named argument that it
+doesn't recognize.  For example, you can produce non-standard HTTP
+header fields by providing them as named arguments:
+
+  print $q->header(-type  =>  'text/html',
+                   -cost  =>  'Three smackers',
+                   -annoyance_level => 'high',
+                   -complaints_to   => 'bit bucket');
+
+This will produce the following nonstandard HTTP header:
+
+   HTTP/1.0 200 OK
+   Cost: Three smackers
+   Annoyance-level: high
+   Complaints-to: bit bucket
+   Content-type: text/html
+
+Notice the way that underscores are translated automatically into
+hyphens.  HTML-generating routines perform a different type of
+translation. 
+
+This feature allows you to keep up with the rapidly changing HTTP and
+HTML "standards".
+
+=head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
+
+     $query = new CGI;
+
+This will parse the input (from both POST and GET methods) and store
+it into a perl5 object called $query.  
+
+=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
+
+     $query = new CGI(INPUTFILE);
+
+If you provide a file handle to the new() method, it will read
+parameters from the file (or STDIN, or whatever).  The file can be in
+any of the forms describing below under debugging (i.e. a series of
+newline delimited TAG=VALUE pairs will work).  Conveniently, this type
+of file is created by the save() method (see below).  Multiple records
+can be saved and restored.
+
+Perl purists will be pleased to know that this syntax accepts
+references to file handles, or even references to filehandle globs,
+which is the "official" way to pass a filehandle:
+
+    $query = new CGI(\*STDIN);
+
+You can also initialize the CGI object with a FileHandle or IO::File
+object.
+
+If you are using the function-oriented interface and want to
+initialize CGI state from a file handle, the way to do this is with
+B<restore_parameters()>.  This will (re)initialize the
+default CGI object from the indicated file handle.
+
+    open (IN,"test.in") || die;
+    restore_parameters(IN);
+    close IN;
+
+You can also initialize the query object from an associative array
+reference:
+
+    $query = new CGI( {'dinosaur'=>'barney',
+		       'song'=>'I love you',
+		       'friends'=>[qw/Jessica George Nancy/]}
+		    );
+
+or from a properly formatted, URL-escaped query string:
+
+    $query = new CGI('dinosaur=barney&color=purple');
+
+or from a previously existing CGI object (currently this clones the
+parameter list, but none of the other object-specific fields, such as
+autoescaping):
+
+    $old_query = new CGI;
+    $new_query = new CGI($old_query);
+
+To create an empty query, initialize it from an empty string or hash:
+
+   $empty_query = new CGI("");
+
+       -or-
+
+   $empty_query = new CGI({});
+
+=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
+
+     @keywords = $query->keywords
+
+If the script was invoked as the result of an <ISINDEX> search, the
+parsed keywords can be obtained as an array using the keywords() method.
+
+=head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT:
+
+     @names = $query->param
+
+If the script was invoked with a parameter list
+(e.g. "name1=value1&name2=value2&name3=value3"), the param()
+method will return the parameter names as a list.  If the
+script was invoked as an <ISINDEX> script, there will be a
+single parameter named 'keywords'.
+
+NOTE: As of version 1.5, the array of parameter names returned will
+be in the same order as they were submitted by the browser.
+Usually this order is the same as the order in which the 
+parameters are defined in the form (however, this isn't part
+of the spec, and so isn't guaranteed).
+
+=head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER:
+
+    @values = $query->param('foo');
+
+	      -or-
+
+    $value = $query->param('foo');
+
+Pass the param() method a single argument to fetch the value of the
+named parameter. If the parameter is multivalued (e.g. from multiple
+selections in a scrolling list), you can ask to receive an array.  Otherwise
+the method will return a single value.
+
+=head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
+
+    $query->param('foo','an','array','of','values');
+
+This sets the value for the named parameter 'foo' to an array of
+values.  This is one way to change the value of a field AFTER
+the script has been invoked once before.  (Another way is with
+the -override parameter accepted by all methods that generate
+form elements.)
+
+param() also recognizes a named parameter style of calling described
+in more detail later:
+
+    $query->param(-name=>'foo',-values=>['an','array','of','values']);
+
+			      -or-
+
+    $query->param(-name=>'foo',-value=>'the value');
+
+=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
+
+   $query->append(-name=>'foo',-values=>['yet','more','values']);
+
+This adds a value or list of values to the named parameter.  The
+values are appended to the end of the parameter if it already exists.
+Otherwise the parameter is created.  Note that this method only
+recognizes the named argument calling syntax.
+
+=head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE:
+
+   $query->import_names('R');
+
+This creates a series of variables in the 'R' namespace.  For example,
+$R::foo, @R:foo.  For keyword lists, a variable @R::keywords will appear.
+If no namespace is given, this method will assume 'Q'.
+WARNING:  don't import anything into 'main'; this is a major security
+risk!!!!
+
+In older versions, this method was called B<import()>.  As of version 2.20, 
+this name has been removed completely to avoid conflict with the built-in
+Perl module B<import> operator.
+
+=head2 DELETING A PARAMETER COMPLETELY:
+
+    $query->delete('foo');
+
+This completely clears a parameter.  It sometimes useful for
+resetting parameters that you don't want passed down between
+script invocations.
+
+If you are using the function call interface, use "Delete()" instead
+to avoid conflicts with Perl's built-in delete operator.
+
+=head2 DELETING ALL PARAMETERS:
+
+   $query->delete_all();
+
+This clears the CGI object completely.  It might be useful to ensure
+that all the defaults are taken when you create a fill-out form.
+
+Use Delete_all() instead if you are using the function call interface.
+
+=head2 DIRECT ACCESS TO THE PARAMETER LIST:
+
+   $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
+   unshift @{$q->param_fetch(-name=>'address')},'George Munster';
+
+If you need access to the parameter list in a way that isn't covered
+by the methods above, you can obtain a direct reference to it by
+calling the B<param_fetch()> method with the name of the .  This
+will return an array reference to the named parameters, which you then
+can manipulate in any way you like.
+
+You can also use a named argument style using the B<-name> argument.
+
+=head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
+
+    $query->save(FILEHANDLE)
+
+This will write the current state of the form to the provided
+filehandle.  You can read it back in by providing a filehandle
+to the new() method.  Note that the filehandle can be a file, a pipe,
+or whatever!
+
+The format of the saved file is:
+
+	NAME1=VALUE1
+	NAME1=VALUE1'
+	NAME2=VALUE2
+	NAME3=VALUE3
+	=
+
+Both name and value are URL escaped.  Multi-valued CGI parameters are
+represented as repeated names.  A session record is delimited by a
+single = symbol.  You can write out multiple records and read them
+back in with several calls to B<new>.  You can do this across several
+sessions by opening the file in append mode, allowing you to create
+primitive guest books, or to keep a history of users' queries.  Here's
+a short example of creating multiple session records:
+
+   use CGI;
+
+   open (OUT,">>test.out") || die;
+   $records = 5;
+   foreach (0..$records) {
+       my $q = new CGI;
+       $q->param(-name=>'counter',-value=>$_);
+       $q->save(OUT);
+   }
+   close OUT;
+
+   # reopen for reading
+   open (IN,"test.out") || die;
+   while (!eof(IN)) {
+       my $q = new CGI(IN);
+       print $q->param('counter'),"\n";
+   }
+
+The file format used for save/restore is identical to that used by the
+Whitehead Genome Center's data exchange format "Boulderio", and can be
+manipulated and even databased using Boulderio utilities.  See
+	
+  http://www.genome.wi.mit.edu/genome_software/other/boulder.html
+
+for further details.
+
+If you wish to use this method from the function-oriented (non-OO)
+interface, the exported name for this method is B<save_parameters()>.
+
+=head2 USING THE FUNCTION-ORIENTED INTERFACE
+
+To use the function-oriented interface, you must specify which CGI.pm
+routines or sets of routines to import into your script's namespace.
+There is a small overhead associated with this importation, but it
+isn't much.
+
+   use CGI <list of methods>;
+
+The listed methods will be imported into the current package; you can
+call them directly without creating a CGI object first.  This example
+shows how to import the B<param()> and B<header()>
+methods, and then use them directly:
+
+   use CGI 'param','header';
+   print header('text/plain');
+   $zipcode = param('zipcode');
+
+More frequently, you'll import common sets of functions by referring
+to the gropus by name.  All function sets are preceded with a ":"
+character as in ":html3" (for tags defined in the HTML 3 standard).
+
+Here is a list of the function sets you can import:
+
+=over 4
+
+=item B<:cgi>
+
+Import all CGI-handling methods, such as B<param()>, B<path_info()>
+and the like.
+
+=item B<:form>
+
+Import all fill-out form generating methods, such as B<textfield()>.
+
+=item B<:html2>
+
+Import all methods that generate HTML 2.0 standard elements.
+
+=item B<:html3>
+
+Import all methods that generate HTML 3.0 proposed elements (such as
+<table>, <super> and <sub>).
+
+=item B<:netscape>
+
+Import all methods that generate Netscape-specific HTML extensions.
+
+=item B<:html>
+
+Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
+'netscape')...
+
+=item B<:standard>
+
+Import "standard" features, 'html2', 'html3', 'form' and 'cgi'.
+
+=item B<:all>
+
+Import all the available methods.  For the full list, see the CGI.pm
+code, where the variable %TAGS is defined.
+
+=back
+
+If you import a function name that is not part of CGI.pm, the module
+will treat it as a new HTML tag and generate the appropriate
+subroutine.  You can then use it like any other HTML tag.  This is to
+provide for the rapidly-evolving HTML "standard."  For example, say
+Microsoft comes out with a new tag called <GRADIENT> (which causes the
+user's desktop to be flooded with a rotating gradient fill until his
+machine reboots).  You don't need to wait for a new version of CGI.pm
+to start using it immeidately:
+
+   use CGI qw/:standard :html3 gradient/;
+   print gradient({-start=>'red',-end=>'blue'});
+
+Note that in the interests of execution speed CGI.pm does B<not> use
+the standard L<Exporter> syntax for specifying load symbols.  This may
+change in the future.
+
+If you import any of the state-maintaining CGI or form-generating
+methods, a default CGI object will be created and initialized
+automatically the first time you use any of the methods that require
+one to be present.  This includes B<param()>, B<textfield()>,
+B<submit()> and the like.  (If you need direct access to the CGI
+object, you can find it in the global variable B<$CGI::Q>).  By
+importing CGI.pm methods, you can create visually elegant scripts:
+
+   use CGI qw/:standard/;
+   print 
+       header,
+       start_html('Simple Script'),
+       h1('Simple Script'),
+       start_form,
+       "What's your name? ",textfield('name'),p,
+       "What's the combination?",
+       checkbox_group(-name=>'words',
+		      -values=>['eenie','meenie','minie','moe'],
+		      -defaults=>['eenie','moe']),p,
+       "What's your favorite color?",
+       popup_menu(-name=>'color',
+		  -values=>['red','green','blue','chartreuse']),p,
+       submit,
+       end_form,
+       hr,"\n";
+
+    if (param) {
+       print 
+	   "Your name is ",em(param('name')),p,
+	   "The keywords are: ",em(join(", ",param('words'))),p,
+	   "Your favorite color is ",em(param('color')),".\n";
+    }
+    print end_html;
+
+=head2 PRAGMAS
+
+In addition to the function sets, there are a number of pragmas that
+you can import.  Pragmas, which are always preceded by a hyphen,
+change the way that CGI.pm functions in various ways.  Pragmas,
+function sets, and individual functions can all be imported in the
+same use() line.  For example, the following use statement imports the
+standard set of functions and disables debugging mode (pragma
+-no_debug):
+
+   use CGI qw/:standard -no_debug/;
+
+The current list of pragmas is as follows:
+
+=over 4
+
+=item -any
+
+When you I<use CGI -any>, then any method that the query object
+doesn't recognize will be interpreted as a new HTML tag.  This allows
+you to support the next I<ad hoc> Netscape or Microsoft HTML
+extension.  This lets you go wild with new and unsupported tags:
+
+   use CGI qw(-any);
+   $q=new CGI;
+   print $q->gradient({speed=>'fast',start=>'red',end=>'blue'});
+
+Since using <cite>any</cite> causes any mistyped method name
+to be interpreted as an HTML tag, use it with care or not at
+all.
+
+=item -compile
+
+This causes the indicated autoloaded methods to be compiled up front,
+rather than deferred to later.  This is useful for scripts that run
+for an extended period of time under FastCGI or mod_perl, and for
+those destined to be crunched by Malcom Beattie's Perl compiler.  Use
+it in conjunction with the methods or method familes you plan to use.
+
+   use CGI qw(-compile :standard :html3);
+
+or even
+
+   use CGI qw(-compile :all);
+
+Note that using the -compile pragma in this way will always have
+the effect of importing the compiled functions into the current
+namespace.  If you want to compile without importing use the
+compile() method instead (see below).
+
+=item -nph
+
+This makes CGI.pm produce a header appropriate for an NPH (no
+parsed header) script.  You may need to do other things as well
+to tell the server that the script is NPH.  See the discussion
+of NPH scripts below.
+
+=item -autoload
+
+This overrides the autoloader so that any function in your program
+that is not recognized is referred to CGI.pm for possible evaluation.
+This allows you to use all the CGI.pm functions without adding them to
+your symbol table, which is of concern for mod_perl users who are
+worried about memory consumption.  I<Warning:> when
+I<-autoload> is in effect, you cannot use "poetry mode"
+(functions without the parenthesis).  Use I<hr()> rather
+than I<hr>, or add something like I<use subs qw/hr p header/> 
+to the top of your script.
+
+=item -no_debug
+
+This turns off the command-line processing features.  If you want to
+run a CGI.pm script from the command line to produce HTML, and you
+don't want it pausing to request CGI parameters from standard input or
+the command line, then use this pragma:
+
+   use CGI qw(-no_debug :standard);
+
+If you'd like to process the command-line parameters but not standard
+input, this should work:
+
+   use CGI qw(-no_debug :standard);
+   restore_parameters(join('&',@ARGV));
+  
+See the section on debugging for more details.
+
+=item -private_tempfiles
+
+CGI.pm can process uploaded file. Ordinarily it spools the
+uploaded file to a temporary directory, then deletes the file
+when done.  However, this opens the risk of eavesdropping as
+described in the file upload section.
+Another CGI script author could peek at this data during the
+upload, even if it is confidential information. On Unix systems,
+the -private_tempfiles pragma will cause the temporary file to be unlinked as soon
+as it is opened and before any data is written into it,
+eliminating the risk of eavesdropping.
+n
+=back
+
+=head1 GENERATING DYNAMIC DOCUMENTS
+
+Most of CGI.pm's functions deal with creating documents on the fly.
+Generally you will produce the HTTP header first, followed by the
+document itself.  CGI.pm provides functions for generating HTTP
+headers of various types as well as for generating HTML.  For creating
+GIF images, see the GD.pm module.
+
+Each of these functions produces a fragment of HTML or HTTP which you
+can print out directly so that it displays in the browser window,
+append to a string, or save to a file for later use.
+
+=head2 CREATING A STANDARD HTTP HEADER:
+
+Normally the first thing you will do in any CGI script is print out an
+HTTP header.  This tells the browser what type of document to expect,
+and gives other optional information, such as the language, expiration
+date, and whether to cache the document.  The header can also be
+manipulated for special purposes, such as server push and pay per view
+pages.
+
+	print $query->header;
+
+	     -or-
+
+	print $query->header('image/gif');
+
+	     -or-
+
+	print $query->header('text/html','204 No response');
+
+	     -or-
+
+	print $query->header(-type=>'image/gif',
+			     -nph=>1,
+			     -status=>'402 Payment required',
+			     -expires=>'+3d',
+			     -cookie=>$cookie,
+			     -Cost=>'$2.00');
+
+header() returns the Content-type: header.  You can provide your own
+MIME type if you choose, otherwise it defaults to text/html.  An
+optional second parameter specifies the status code and a human-readable
+message.  For example, you can specify 204, "No response" to create a
+script that tells the browser to do nothing at all.
+
+The last example shows the named argument style for passing arguments
+to the CGI methods using named parameters.  Recognized parameters are
+B<-type>, B<-status>, B<-expires>, and B<-cookie>.  Any other named
+parameters will be stripped of their initial hyphens and turned into
+header fields, allowing you to specify any HTTP header you desire.
+Internal underscores will be turned into hyphens:
+
+    print $query->header(-Content_length=>3002);
+
+Most browsers will not cache the output from CGI scripts.  Every time
+the browser reloads the page, the script is invoked anew.  You can
+change this behavior with the B<-expires> parameter.  When you specify
+an absolute or relative expiration interval with this parameter, some
+browsers and proxy servers will cache the script's output until the
+indicated expiration date.  The following forms are all valid for the
+-expires field:
+
+	+30s                              30 seconds from now
+	+10m                              ten minutes from now
+	+1h                               one hour from now
+	-1d                               yesterday (i.e. "ASAP!")
+	now                               immediately
+	+3M                               in three months
+	+10y                              in ten years time
+	Thursday, 25-Apr-1999 00:40:33 GMT  at the indicated time & date
+
+The B<-cookie> parameter generates a header that tells the browser to provide
+a "magic cookie" during all subsequent transactions with your script.
+Netscape cookies have a special format that includes interesting attributes
+such as expiration time.  Use the cookie() method to create and retrieve
+session cookies.
+
+The B<-nph> parameter, if set to a true value, will issue the correct
+headers to work with a NPH (no-parse-header) script.  This is important
+to use with certain servers, such as Microsoft Internet Explorer, which
+expect all their scripts to be NPH.
+
+=head2 GENERATING A REDIRECTION HEADER
+
+   print $query->redirect('http://somewhere.else/in/movie/land');
+
+Sometimes you don't want to produce a document yourself, but simply
+redirect the browser elsewhere, perhaps choosing a URL based on the
+time of day or the identity of the user.  
+
+The redirect() function redirects the browser to a different URL.  If
+you use redirection like this, you should B<not> print out a header as
+well.  As of version 2.0, we produce both the unofficial Location:
+header and the official URI: header.  This should satisfy most servers
+and browsers.
+
+One hint I can offer is that relative links may not work correctly
+when you generate a redirection to another document on your site.
+This is due to a well-intentioned optimization that some servers use.
+The solution to this is to use the full URL (including the http: part)
+of the document you are redirecting to.
+
+You can also use named arguments:
+
+    print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
+			   -nph=>1);
+
+The B<-nph> parameter, if set to a true value, will issue the correct
+headers to work with a NPH (no-parse-header) script.  This is important
+to use with certain servers, such as Microsoft Internet Explorer, which
+expect all their scripts to be NPH.
+
+=head2 CREATING THE HTML DOCUMENT HEADER
+
+   print $query->start_html(-title=>'Secrets of the Pyramids',
+			    -author=>'fred@capricorn.org',
+			    -base=>'true',
+			    -target=>'_blank',
+			    -meta=>{'keywords'=>'pharaoh secret mummy',
+				    'copyright'=>'copyright 1996 King Tut'},
+			    -style=>{'src'=>'/styles/style1.css'},
+			    -BGCOLOR=>'blue');
+
+After creating the HTTP header, most CGI scripts will start writing
+out an HTML document.  The start_html() routine creates the top of the
+page, along with a lot of optional information that controls the
+page's appearance and behavior.
+
+This method returns a canned HTML header and the opening <BODY> tag.
+All parameters are optional.  In the named parameter form, recognized
+parameters are -title, -author, -base, -xbase and -target (see below
+for the explanation).  Any additional parameters you provide, such as
+the Netscape unofficial BGCOLOR attribute, are added to the <BODY>
+tag.  Additional parameters must be proceeded by a hyphen.
+
+The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
+different from the current location, as in
+
+    -xbase=>"http://home.mcom.com/"
+
+All relative links will be interpreted relative to this tag.
+
+The argument B<-target> allows you to provide a default target frame
+for all the links and fill-out forms on the page.  See the Netscape
+documentation on frames for details of how to manipulate this.
+
+    -target=>"answer_window"
+
+All relative links will be interpreted relative to this tag.
+You add arbitrary meta information to the header with the B<-meta>
+argument.  This argument expects a reference to an associative array
+containing name/value pairs of meta information.  These will be turned
+into a series of header <META> tags that look something like this:
+
+    <META NAME="keywords" CONTENT="pharaoh secret mummy">
+    <META NAME="description" CONTENT="copyright 1996 King Tut">
+
+There is no support for the HTTP-EQUIV type of <META> tag.  This is
+because you can modify the HTTP header directly with the B<header()>
+method.  For example, if you want to send the Refresh: header, do it
+in the header() method:
+
+    print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
+
+The B<-style> tag is used to incorporate cascading stylesheets into
+your code.  See the section on CASCADING STYLESHEETS for more information.
+
+You can place other arbitrary HTML elements to the <HEAD> section with the
+B<-head> tag.  For example, to place the rarely-used <LINK> element in the
+head section, use this:
+
+    print $q->start_html(-head=>Link({-rel=>'next',
+				  -href=>'http://www.capricorn.com/s2.html'}));
+
+To incorporate multiple HTML elements into the <HEAD> section, just pass an
+array reference:
+
+    print $q->start_html(-head=>[ 
+                              Link({-rel=>'next',
+				    -href=>'http://www.capricorn.com/s2.html'}),
+			      Link({-rel=>'previous',
+				    -href=>'http://www.capricorn.com/s1.html'})
+			     ]
+		     );
+
+JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
+to add Netscape JavaScript calls to your pages.  B<-script> should
+point to a block of text containing JavaScript function definitions.
+This block will be placed within a <SCRIPT> block inside the HTML (not
+HTTP) header.  The block is placed in the header in order to give your
+page a fighting chance of having all its JavaScript functions in place
+even if the user presses the stop button before the page has loaded
+completely.  CGI.pm attempts to format the script in such a way that
+JavaScript-naive browsers will not choke on the code: unfortunately
+there are some browsers, such as Chimera for Unix, that get confused
+by it nevertheless.
+
+The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
+code to execute when the page is respectively opened and closed by the
+browser.  Usually these parameters are calls to functions defined in the
+B<-script> field:
+
+      $query = new CGI;
+      print $query->header;
+      $JSCRIPT=<<END;
+      // Ask a silly question
+      function riddle_me_this() {
+	 var r = prompt("What walks on four legs in the morning, " +
+		       "two legs in the afternoon, " +
+		       "and three legs in the evening?");
+	 response(r);
+      }
+      // Get a silly answer
+      function response(answer) {
+	 if (answer == "man")
+	    alert("Right you are!");
+	 else
+	    alert("Wrong!  Guess again.");
+      }
+      END
+      print $query->start_html(-title=>'The Riddle of the Sphinx',
+			       -script=>$JSCRIPT);
+
+Use the B<-noScript> parameter to pass some HTML text that will be displayed on 
+browsers that do not have JavaScript (or browsers where JavaScript is turned
+off).
+
+Netscape 3.0 recognizes several attributes of the <SCRIPT> tag,
+including LANGUAGE and SRC.  The latter is particularly interesting,
+as it allows you to keep the JavaScript code in a file or CGI script
+rather than cluttering up each page with the source.  To use these
+attributes pass a HASH reference in the B<-script> parameter containing
+one or more of -language, -src, or -code:
+
+    print $q->start_html(-title=>'The Riddle of the Sphinx',
+			 -script=>{-language=>'JAVASCRIPT',
+                                   -src=>'/javascript/sphinx.js'}
+			 );
+
+    print $q->(-title=>'The Riddle of the Sphinx',
+	       -script=>{-language=>'PERLSCRIPT'},
+			 -code=>'print "hello world!\n;"'
+	       );
+
+
+A final feature allows you to incorporate multiple <SCRIPT> sections into the
+header.  Just pass the list of script sections as an array reference.
+this allows you to specify different source files for different dialects
+of JavaScript.  Example:     
+
+     print $q-&gt;start_html(-title=&gt;'The Riddle of the Sphinx',
+                          -script=&gt;[
+                                    { -language =&gt; 'JavaScript1.0',
+                                      -src      =&gt; '/javascript/utilities10.js'
+                                    },
+                                    { -language =&gt; 'JavaScript1.1',
+                                      -src      =&gt; '/javascript/utilities11.js'
+                                    },
+                                    { -language =&gt; 'JavaScript1.2',
+                                      -src      =&gt; '/javascript/utilities12.js'
+                                    },
+                                    { -language =&gt; 'JavaScript28.2',
+                                      -src      =&gt; '/javascript/utilities219.js'
+                                    }
+                                 ]
+                             );
+     </pre>
+
+If this looks a bit extreme, take my advice and stick with straight CGI scripting.  
+
+See
+
+   http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
+
+for more information about JavaScript.
+
+The old-style positional parameters are as follows:
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The title
+
+=item 2.
+
+The author's e-mail address (will create a <LINK REV="MADE"> tag if present
+
+=item 3.
+
+A 'true' flag if you want to include a <BASE> tag in the header.  This
+helps resolve relative addresses to absolute ones when the document is moved, 
+but makes the document hierarchy non-portable.  Use with care!
+
+=item 4, 5, 6...
+
+Any other parameters you want to include in the <BODY> tag.  This is a good
+place to put Netscape extensions, such as colors and wallpaper patterns.
+
+=back
+
+=head2 ENDING THE HTML DOCUMENT:
+
+	print $query->end_html
+
+This ends an HTML document by printing the </BODY></HTML> tags.
+
+=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+
+    $myself = $query->self_url;
+    print "<A HREF=$myself>I'm talking to myself.</A>";
+
+self_url() will return a URL, that, when selected, will reinvoke
+this script with all its state information intact.  This is most
+useful when you want to jump around within the document using
+internal anchors but you don't want to disrupt the current contents
+of the form(s).  Something like this will do the trick.
+
+     $myself = $query->self_url;
+     print "<A HREF=$myself#table1>See table 1</A>";
+     print "<A HREF=$myself#table2>See table 2</A>";
+     print "<A HREF=$myself#yourself>See for yourself</A>";
+
+If you want more control over what's returned, using the B<url()>
+method instead.
+
+You can also retrieve the unprocessed query string with query_string():
+
+    $the_string = $query->query_string;
+
+=head2 OBTAINING THE SCRIPT'S URL
+
+    $full_url      = $query->url();
+    $full_url      = $query->url(-full=>1);  #alternative syntax
+    $relative_url  = $query->url(-relative=>1);
+    $absolute_url  = $query->url(-absolute=>1);
+    $url_with_path = $query->url(-path_info=>1);
+    $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
+
+B<url()> returns the script's URL in a variety of formats.  Called
+without any arguments, it returns the full form of the URL, including
+host name and port number
+
+    http://your.host.com/path/to/script.cgi
+
+You can modify this format with the following named arguments:
+
+=over 4
+
+=item B<-absolute>
+
+If true, produce an absolute URL, e.g.
+
+    /path/to/script.cgi
+
+=item B<-relative>
+
+Produce a relative URL.  This is useful if you want to reinvoke your
+script with different parameters. For example:
+
+    script.cgi
+
+=item B<-full>
+
+Produce the full URL, exactly as if called without any arguments.
+This overrides the -relative and -absolute arguments.
+
+=item B<-path> (B<-path_info>)
+
+Append the additional path information to the URL.  This can be
+combined with B<-full>, B<-absolute> or B<-relative>.  B<-path_info>
+is provided as a synonym.
+
+=item B<-query> (B<-query_string>)
+
+Append the query string to the URL.  This can be combined with
+B<-full>, B<-absolute> or B<-relative>.  B<-query_string> is provided
+as a synonym.
+
+=back
+
+=head1 CREATING STANDARD HTML ELEMENTS:
+
+CGI.pm defines general HTML shortcut methods for most, if not all of
+the HTML 3 and HTML 4 tags.  HTML shortcuts are named after a single
+HTML element and return a fragment of HTML text that you can then
+print or manipulate as you like.  Each shortcut returns a fragment of
+HTML code that you can append to a string, save to a file, or, most
+commonly, print out so that it displays in the browser window.
+
+This example shows how to use the HTML methods:
+
+   $q = new CGI;
+   print $q->blockquote(
+		     "Many years ago on the island of",
+		     $q->a({href=>"http://crete.org/"},"Crete"),
+		     "there lived a minotaur named",
+		     $q->strong("Fred."),
+		    ),
+       $q->hr;
+
+This results in the following HTML code (extra newlines have been
+added for readability):
+
+   <blockquote>
+   Many years ago on the island of
+   <a HREF="http://crete.org/">Crete</a> there lived
+   a minotaur named <strong>Fred.</strong> 
+   </blockquote>
+   <hr>
+
+If you find the syntax for calling the HTML shortcuts awkward, you can
+import them into your namespace and dispense with the object syntax
+completely (see the next section for more details):
+
+   use CGI ':standard';
+   print blockquote(
+      "Many years ago on the island of",
+      a({href=>"http://crete.org/"},"Crete"),
+      "there lived a minotaur named",
+      strong("Fred."),
+      ),
+      hr;
+
+=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
+
+The HTML methods will accept zero, one or multiple arguments.  If you
+provide no arguments, you get a single tag:
+
+   print hr;  	#  <HR>
+
+If you provide one or more string arguments, they are concatenated
+together with spaces and placed between opening and closing tags:
+
+   print h1("Chapter","1"); # <H1>Chapter 1</H1>"
+
+If the first argument is an associative array reference, then the keys
+and values of the associative array become the HTML tag's attributes:
+
+   print a({-href=>'fred.html',-target=>'_new'},
+      "Open a new frame");
+
+	    <A HREF="fred.html",TARGET="_new">Open a new frame</A>
+   
+You may dispense with the dashes in front of the attribute names if
+you prefer:
+
+   print img {src=>'fred.gif',align=>'LEFT'};
+
+	   <IMG ALIGN="LEFT" SRC="fred.gif">
+
+Sometimes an HTML tag attribute has no argument.  For example, ordered
+lists can be marked as COMPACT.  The syntax for this is an argument that
+that points to an undef string:
+
+   print ol({compact=>undef},li('one'),li('two'),li('three'));
+
+Prior to CGI.pm version 2.41, providing an empty ('') string as an
+attribute argument was the same as providing undef.  However, this has
+changed in order to accomodate those who want to create tags of the form 
+<IMG ALT="">.  The difference is shown in these two pieces of code:
+  
+   CODE                   RESULT
+   img({alt=>undef})      <IMG ALT>
+   img({alt=>''})         <IMT ALT="">
+
+=head2 THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS
+
+One of the cool features of the HTML shortcuts is that they are
+distributive.  If you give them an argument consisting of a
+B<reference> to a list, the tag will be distributed across each
+element of the list.  For example, here's one way to make an ordered
+list:
+
+   print ul(
+             li({-type=>'disc'},['Sneezy','Doc','Sleepy','Happy']);
+           );
+
+This example will result in HTML output that looks like this:
+
+   <UL>
+     <LI TYPE="disc">Sneezy</LI>
+     <LI TYPE="disc">Doc</LI>
+     <LI TYPE="disc">Sleepy</LI>
+     <LI TYPE="disc">Happy</LI>
+   </UL>
+
+This is extremely useful for creating tables.  For example:
+
+   print table({-border=>undef},
+           caption('When Should You Eat Your Vegetables?'),
+           Tr({-align=>CENTER,-valign=>TOP},
+           [
+              th(['Vegetable', 'Breakfast','Lunch','Dinner']),
+              td(['Tomatoes' , 'no', 'yes', 'yes']),
+              td(['Broccoli' , 'no', 'no',  'yes']),
+              td(['Onions'   , 'yes','yes', 'yes'])
+           ]
+           )
+        );
+
+=head2 HTML SHORTCUTS AND LIST INTERPOLATION
+
+Consider this bit of code:
+
+   print blockquote(em('Hi'),'mom!'));
+
+It will ordinarily return the string that you probably expect, namely:
+
+   <BLOCKQUOTE><EM>Hi</EM> mom!</BLOCKQUOTE>
+
+Note the space between the element "Hi" and the element "mom!".
+CGI.pm puts the extra space there using array interpolation, which is
+controlled by the magic $" variable.  Sometimes this extra space is
+not what you want, for example, when you are trying to align a series
+of images.  In this case, you can simply change the value of $" to an
+empty string.
+
+   {
+      local($") = '';
+      print blockquote(em('Hi'),'mom!'));
+    }
+
+I suggest you put the code in a block as shown here.  Otherwise the
+change to $" will affect all subsequent code until you explicitly
+reset it.
+
+=head2 NON-STANDARD HTML SHORTCUTS
+
+A few HTML tags don't follow the standard pattern for various
+reasons.  
+
+B<comment()> generates an HTML comment (<!-- comment -->).  Call it
+like
+
+    print comment('here is my comment');
+
+Because of conflicts with built-in Perl functions, the following functions
+begin with initial caps:
+
+    Select
+    Tr
+    Link
+    Delete
+
+In addition, start_html(), end_html(), start_form(), end_form(),
+start_multipart_form() and all the fill-out form tags are special.
+See their respective sections.
+
+=head1 CREATING FILL-OUT FORMS:
+
+I<General note>  The various form-creating methods all return strings
+to the caller, containing the tag or tags that will create the requested
+form element.  You are responsible for actually printing out these strings.
+It's set up this way so that you can place formatting tags
+around the form elements.
+
+I<Another note> The default values that you specify for the forms are only
+used the B<first> time the script is invoked (when there is no query
+string).  On subsequent invocations of the script (when there is a query
+string), the former values are used even if they are blank.  
+
+If you want to change the value of a field from its previous value, you have two
+choices:
+
+(1) call the param() method to set it.
+
+(2) use the -override (alias -force) parameter (a new feature in version 2.15).
+This forces the default value to be used, regardless of the previous value:
+
+   print $query->textfield(-name=>'field_name',
+			   -default=>'starting value',
+			   -override=>1,
+			   -size=>50,
+			   -maxlength=>80);
+
+I<Yet another note> By default, the text and labels of form elements are
+escaped according to HTML rules.  This means that you can safely use
+"<CLICK ME>" as the label for a button.  However, it also interferes with
+your ability to incorporate special HTML character sequences, such as &Aacute;,
+into your fields.  If you wish to turn off automatic escaping, call the
+autoEscape() method with a false value immediately after creating the CGI object:
+
+   $query = new CGI;
+   $query->autoEscape(undef);
+			     
+
+=head2 CREATING AN ISINDEX TAG
+
+   print $query->isindex(-action=>$action);
+
+	 -or-
+
+   print $query->isindex($action);
+
+Prints out an <ISINDEX> tag.  Not very exciting.  The parameter
+-action specifies the URL of the script to process the query.  The
+default is to process the query with the current script.
+
+=head2 STARTING AND ENDING A FORM
+
+    print $query->startform(-method=>$method,
+			    -action=>$action,
+			    -encoding=>$encoding);
+      <... various form stuff ...>
+    print $query->endform;
+
+	-or-
+
+    print $query->startform($method,$action,$encoding);
+      <... various form stuff ...>
+    print $query->endform;
+
+startform() will return a <FORM> tag with the optional method,
+action and form encoding that you specify.  The defaults are:
+	
+    method: POST
+    action: this script
+    encoding: application/x-www-form-urlencoded
+
+endform() returns the closing </FORM> tag.  
+
+Startform()'s encoding method tells the browser how to package the various
+fields of the form before sending the form to the server.  Two
+values are possible:
+
+=over 4
+
+=item B<application/x-www-form-urlencoded>
+
+This is the older type of encoding used by all browsers prior to
+Netscape 2.0.  It is compatible with many CGI scripts and is
+suitable for short fields containing text data.  For your
+convenience, CGI.pm stores the name of this encoding
+type in B<$CGI::URL_ENCODED>.
+
+=item B<multipart/form-data>
+
+This is the newer type of encoding introduced by Netscape 2.0.
+It is suitable for forms that contain very large fields or that
+are intended for transferring binary data.  Most importantly,
+it enables the "file upload" feature of Netscape 2.0 forms.  For
+your convenience, CGI.pm stores the name of this encoding type
+in B<&CGI::MULTIPART>
+
+Forms that use this type of encoding are not easily interpreted
+by CGI scripts unless they use CGI.pm or another library designed
+to handle them.
+
+=back
+
+For compatibility, the startform() method uses the older form of
+encoding by default.  If you want to use the newer form of encoding
+by default, you can call B<start_multipart_form()> instead of
+B<startform()>.
+
+JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
+for use with JavaScript.  The -name parameter gives the
+form a name so that it can be identified and manipulated by
+JavaScript functions.  -onSubmit should point to a JavaScript
+function that will be executed just before the form is submitted to your
+server.  You can use this opportunity to check the contents of the form 
+for consistency and completeness.  If you find something wrong, you
+can put up an alert box or maybe fix things up yourself.  You can 
+abort the submission by returning false from this function.  
+
+Usually the bulk of JavaScript functions are defined in a <SCRIPT>
+block in the HTML header and -onSubmit points to one of these function
+call.  See start_html() for details.
+
+=head2 CREATING A TEXT FIELD
+
+    print $query->textfield(-name=>'field_name',
+			    -default=>'starting value',
+			    -size=>50,
+			    -maxlength=>80);
+	-or-
+
+    print $query->textfield('field_name','starting value',50,80);
+
+textfield() will return a text input field.  
+
+=over 4
+
+=item B<Parameters>
+
+=item 1.
+
+The first parameter is the required name for the field (-name).  
+
+=item 2.
+
+The optional second parameter is the default starting value for the field
+contents (-default).  
+
+=item 3.
+
+The optional third parameter is the size of the field in
+      characters (-size).
+
+=item 4.
+
+The optional fourth parameter is the maximum number of characters the
+      field will accept (-maxlength).
+
+=back
+
+As with all these methods, the field will be initialized with its 
+previous contents from earlier invocations of the script.
+When the form is processed, the value of the text field can be
+retrieved with:
+
+       $value = $query->param('foo');
+
+If you want to reset it from its initial value after the script has been
+called once, you can do so like this:
+
+       $query->param('foo',"I'm taking over this value!");
+
+NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
+value, you can force its current value by using the -override (alias -force)
+parameter:
+
+    print $query->textfield(-name=>'field_name',
+			    -default=>'starting value',
+			    -override=>1,
+			    -size=>50,
+			    -maxlength=>80);
+
+JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
+B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
+parameters to register JavaScript event handlers.  The onChange
+handler will be called whenever the user changes the contents of the
+text field.  You can do text validation if you like.  onFocus and
+onBlur are called respectively when the insertion point moves into and
+out of the text field.  onSelect is called when the user changes the
+portion of the text that is selected.
+
+=head2 CREATING A BIG TEXT FIELD
+
+   print $query->textarea(-name=>'foo',
+			  -default=>'starting value',
+			  -rows=>10,
+			  -columns=>50);
+
+	-or
+
+   print $query->textarea('foo','starting value',10,50);
+
+textarea() is just like textfield, but it allows you to specify
+rows and columns for a multiline text entry box.  You can provide
+a starting value for the field, which can be long and contain
+multiple lines.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
+B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
+recognized.  See textfield().
+
+=head2 CREATING A PASSWORD FIELD
+
+   print $query->password_field(-name=>'secret',
+				-value=>'starting value',
+				-size=>50,
+				-maxlength=>80);
+	-or-
+
+   print $query->password_field('secret','starting value',50,80);
+
+password_field() is identical to textfield(), except that its contents 
+will be starred out on the web page.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized.  See textfield().
+
+=head2 CREATING A FILE UPLOAD FIELD
+
+    print $query->filefield(-name=>'uploaded_file',
+			    -default=>'starting value',
+			    -size=>50,
+			    -maxlength=>80);
+	-or-
+
+    print $query->filefield('uploaded_file','starting value',50,80);
+
+filefield() will return a file upload field for Netscape 2.0 browsers.
+In order to take full advantage of this I<you must use the new 
+multipart encoding scheme> for the form.  You can do this either
+by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>,
+or by calling the new method B<start_multipart_form()> instead of
+vanilla B<startform()>.
+
+=over 4
+
+=item B<Parameters>
+
+=item 1.
+
+The first parameter is the required name for the field (-name).  
+
+=item 2.
+
+The optional second parameter is the starting value for the field contents
+to be used as the default file name (-default).
+
+The beta2 version of Netscape 2.0 currently doesn't pay any attention
+to this field, and so the starting value will always be blank.  Worse,
+the field loses its "sticky" behavior and forgets its previous
+contents.  The starting value field is called for in the HTML
+specification, however, and possibly later versions of Netscape will
+honor it.
+
+=item 3.
+
+The optional third parameter is the size of the field in
+characters (-size).
+
+=item 4.
+
+The optional fourth parameter is the maximum number of characters the
+field will accept (-maxlength).
+
+=back
+
+When the form is processed, you can retrieve the entered filename
+by calling param().
+
+       $filename = $query->param('uploaded_file');
+
+In Netscape Navigator 2.0, the filename that gets returned is the full
+local filename on the B<remote user's> machine.  If the remote user is
+on a Unix machine, the filename will follow Unix conventions:
+
+	/path/to/the/file
+
+On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions:
+
+	C:\PATH\TO\THE\FILE.MSW
+
+On a Macintosh machine, the filename will follow Mac conventions:
+
+	HD 40:Desktop Folder:Sort Through:Reminders
+
+The filename returned is also a file handle.  You can read the contents
+of the file using standard Perl file reading calls:
+
+	# Read a text file and print it out
+	while (<$filename>) {
+	   print;
+	}
+
+	# Copy a binary file to somewhere safe
+	open (OUTFILE,">>/usr/local/web/users/feedback");
+	while ($bytesread=read($filename,$buffer,1024)) {
+	   print OUTFILE $buffer;
+	}
+
+When a file is uploaded the browser usually sends along some
+information along with it in the format of headers.  The information
+usually includes the MIME content type.  Future browsers may send
+other information as well (such as modification date and size). To
+retrieve this information, call uploadInfo().  It returns a reference to
+an associative array containing all the document headers.
+
+       $filename = $query->param('uploaded_file');
+       $type = $query->uploadInfo($filename)->{'Content-Type'};
+       unless ($type eq 'text/html') {
+	  die "HTML FILES ONLY!";
+       }
+
+If you are using a machine that recognizes "text" and "binary" data
+modes, be sure to understand when and how to use them (see the Camel book).  
+Otherwise you may find that binary files are corrupted during file uploads.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized.  See textfield() for details.
+
+=head2 CREATING A POPUP MENU
+
+   print $query->popup_menu('menu_name',
+			    ['eenie','meenie','minie'],
+			    'meenie');
+
+      -or-
+
+   %labels = ('eenie'=>'your first choice',
+	      'meenie'=>'your second choice',
+	      'minie'=>'your third choice');
+   print $query->popup_menu('menu_name',
+			    ['eenie','meenie','minie'],
+			    'meenie',\%labels);
+
+	-or (named parameter style)-
+
+   print $query->popup_menu(-name=>'menu_name',
+			    -values=>['eenie','meenie','minie'],
+			    -default=>'meenie',
+			    -labels=>\%labels);
+
+popup_menu() creates a menu.
+
+=over 4
+
+=item 1.
+
+The required first argument is the menu's name (-name).
+
+=item 2.
+
+The required second argument (-values) is an array B<reference>
+containing the list of menu items in the menu.  You can pass the
+method an anonymous array, as shown in the example, or a reference to
+a named array, such as "\@foo".
+
+=item 3.
+
+The optional third parameter (-default) is the name of the default
+menu choice.  If not specified, the first item will be the default.
+The values of the previous choice will be maintained across queries.
+
+=item 4.
+
+The optional fourth parameter (-labels) is provided for people who
+want to use different values for the user-visible label inside the
+popup menu nd the value returned to your script.  It's a pointer to an
+associative array relating menu values to user-visible labels.  If you
+leave this parameter blank, the menu values will be displayed by
+default.  (You can also leave a label undefined if you want to).
+
+=back
+
+When the form is processed, the selected value of the popup menu can
+be retrieved using:
+
+      $popup_menu_value = $query->param('menu_name');
+
+JAVASCRIPTING: popup_menu() recognizes the following event handlers:
+B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
+B<-onBlur>.  See the textfield() section for details on when these
+handlers are called.
+
+=head2 CREATING A SCROLLING LIST
+
+   print $query->scrolling_list('list_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],5,'true');
+      -or-
+
+   print $query->scrolling_list('list_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],5,'true',
+				\%labels);
+
+	-or-
+
+   print $query->scrolling_list(-name=>'list_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-default=>['eenie','moe'],
+				-size=>5,
+				-multiple=>'true',
+				-labels=>\%labels);
+
+scrolling_list() creates a scrolling list.  
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first and second arguments are the list name (-name) and values
+(-values).  As in the popup menu, the second argument should be an
+array reference.
+
+=item 2.
+
+The optional third argument (-default) can be either a reference to a
+list containing the values to be selected by default, or can be a
+single value to select.  If this argument is missing or undefined,
+then nothing is selected when the list first appears.  In the named
+parameter version, you can use the synonym "-defaults" for this
+parameter.
+
+=item 3.
+
+The optional fourth argument is the size of the list (-size).
+
+=item 4.
+
+The optional fifth argument can be set to true to allow multiple
+simultaneous selections (-multiple).  Otherwise only one selection
+will be allowed at a time.
+
+=item 5.
+
+The optional sixth argument is a pointer to an associative array
+containing long user-visible labels for the list items (-labels).
+If not provided, the values will be displayed.
+
+When this form is processed, all selected list items will be returned as
+a list under the parameter name 'list_name'.  The values of the
+selected items can be retrieved with:
+
+      @selected = $query->param('list_name');
+
+=back
+
+JAVASCRIPTING: scrolling_list() recognizes the following event
+handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
+and B<-onBlur>.  See textfield() for the description of when these
+handlers are called.
+
+=head2 CREATING A GROUP OF RELATED CHECKBOXES
+
+   print $query->checkbox_group(-name=>'group_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-default=>['eenie','moe'],
+				-linebreak=>'true',
+				-labels=>\%labels);
+
+   print $query->checkbox_group('group_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],'true',\%labels);
+
+   HTML3-COMPATIBLE BROWSERS ONLY:
+
+   print $query->checkbox_group(-name=>'group_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-rows=2,-columns=>2);
+    
+
+checkbox_group() creates a list of checkboxes that are related
+by the same name.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first and second arguments are the checkbox name and values,
+respectively (-name and -values).  As in the popup menu, the second
+argument should be an array reference.  These values are used for the
+user-readable labels printed next to the checkboxes as well as for the
+values passed to your script in the query string.
+
+=item 2.
+
+The optional third argument (-default) can be either a reference to a
+list containing the values to be checked by default, or can be a
+single value to checked.  If this argument is missing or undefined,
+then nothing is selected when the list first appears.
+
+=item 3.
+
+The optional fourth argument (-linebreak) can be set to true to place
+line breaks between the checkboxes so that they appear as a vertical
+list.  Otherwise, they will be strung together on a horizontal line.
+
+=item 4.
+
+The optional fifth argument is a pointer to an associative array
+relating the checkbox values to the user-visible labels that will
+be printed next to them (-labels).  If not provided, the values will
+be used as the default.
+
+=item 5.
+
+B<HTML3-compatible browsers> (such as Netscape) can take advantage of
+the optional parameters B<-rows>, and B<-columns>.  These parameters
+cause checkbox_group() to return an HTML3 compatible table containing
+the checkbox group formatted with the specified number of rows and
+columns.  You can provide just the -columns parameter if you wish;
+checkbox_group will calculate the correct number of rows for you.
+
+To include row and column headings in the returned table, you
+can use the B<-rowheaders> and B<-colheaders> parameters.  Both
+of these accept a pointer to an array of headings to use.
+The headings are just decorative.  They don't reorganize the
+interpretation of the checkboxes -- they're still a single named
+unit.
+
+=back
+
+When the form is processed, all checked boxes will be returned as
+a list under the parameter name 'group_name'.  The values of the
+"on" checkboxes can be retrieved with:
+
+      @turned_on = $query->param('group_name');
+
+The value returned by checkbox_group() is actually an array of button
+elements.  You can capture them and use them within tables, lists,
+or in other creative ways:
+
+    @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
+    &use_in_creative_way(@h);
+
+JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
+parameter.  This specifies a JavaScript code fragment or
+function call to be executed every time the user clicks on
+any of the buttons in the group.  You can retrieve the identity
+of the particular button clicked on using the "this" variable.
+
+=head2 CREATING A STANDALONE CHECKBOX
+
+    print $query->checkbox(-name=>'checkbox_name',
+			   -checked=>'checked',
+			   -value=>'ON',
+			   -label=>'CLICK ME');
+
+	-or-
+
+    print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
+
+checkbox() is used to create an isolated checkbox that isn't logically
+related to any others.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first parameter is the required name for the checkbox (-name).  It
+will also be used for the user-readable label printed next to the
+checkbox.
+
+=item 2.
+
+The optional second parameter (-checked) specifies that the checkbox
+is turned on by default.  Synonyms are -selected and -on.
+
+=item 3.
+
+The optional third parameter (-value) specifies the value of the
+checkbox when it is checked.  If not provided, the word "on" is
+assumed.
+
+=item 4.
+
+The optional fourth parameter (-label) is the user-readable label to
+be attached to the checkbox.  If not provided, the checkbox name is
+used.
+
+=back
+
+The value of the checkbox can be retrieved using:
+
+    $turned_on = $query->param('checkbox_name');
+
+JAVASCRIPTING: checkbox() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=head2 CREATING A RADIO BUTTON GROUP
+
+   print $query->radio_group(-name=>'group_name',
+			     -values=>['eenie','meenie','minie'],
+			     -default=>'meenie',
+			     -linebreak=>'true',
+			     -labels=>\%labels);
+
+	-or-
+
+   print $query->radio_group('group_name',['eenie','meenie','minie'],
+					  'meenie','true',\%labels);
+
+
+   HTML3-COMPATIBLE BROWSERS ONLY:
+
+   print $query->radio_group(-name=>'group_name',
+			     -values=>['eenie','meenie','minie','moe'],
+			     -rows=2,-columns=>2);
+
+radio_group() creates a set of logically-related radio buttons
+(turning one member of the group on turns the others off)
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument is the name of the group and is required (-name).
+
+=item 2.
+
+The second argument (-values) is the list of values for the radio
+buttons.  The values and the labels that appear on the page are
+identical.  Pass an array I<reference> in the second argument, either
+using an anonymous array, as shown, or by referencing a named array as
+in "\@foo".
+
+=item 3.
+
+The optional third parameter (-default) is the name of the default
+button to turn on. If not specified, the first item will be the
+default.  You can provide a nonexistent button name, such as "-" to
+start up with no buttons selected.
+
+=item 4.
+
+The optional fourth parameter (-linebreak) can be set to 'true' to put
+line breaks between the buttons, creating a vertical list.
+
+=item 5.
+
+The optional fifth parameter (-labels) is a pointer to an associative
+array relating the radio button values to user-visible labels to be
+used in the display.  If not provided, the values themselves are
+displayed.
+
+=item 6.
+
+B<HTML3-compatible browsers> (such as Netscape) can take advantage 
+of the optional 
+parameters B<-rows>, and B<-columns>.  These parameters cause
+radio_group() to return an HTML3 compatible table containing
+the radio group formatted with the specified number of rows
+and columns.  You can provide just the -columns parameter if you
+wish; radio_group will calculate the correct number of rows
+for you.
+
+To include row and column headings in the returned table, you
+can use the B<-rowheader> and B<-colheader> parameters.  Both
+of these accept a pointer to an array of headings to use.
+The headings are just decorative.  They don't reorganize the
+interpetation of the radio buttons -- they're still a single named
+unit.
+
+=back
+
+When the form is processed, the selected radio button can
+be retrieved using:
+
+      $which_radio_button = $query->param('group_name');
+
+The value returned by radio_group() is actually an array of button
+elements.  You can capture them and use them within tables, lists,
+or in other creative ways:
+
+    @h = $query->radio_group(-name=>'group_name',-values=>\@values);
+    &use_in_creative_way(@h);
+
+=head2 CREATING A SUBMIT BUTTON 
+
+   print $query->submit(-name=>'button_name',
+			-value=>'value');
+
+	-or-
+
+   print $query->submit('button_name','value');
+
+submit() will create the query submission button.  Every form
+should have one of these.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument (-name) is optional.  You can give the button a
+name if you have several submission buttons in your form and you want
+to distinguish between them.  The name will also be used as the
+user-visible label.  Be aware that a few older browsers don't deal with this correctly and
+B<never> send back a value from a button.
+
+=item 2.
+
+The second argument (-value) is also optional.  This gives the button
+a value that will be passed to your script in the query string.
+
+=back
+
+You can figure out which button was pressed by using different
+values for each one:
+
+     $which_one = $query->param('button_name');
+
+JAVASCRIPTING: radio_group() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=head2 CREATING A RESET BUTTON
+
+   print $query->reset
+
+reset() creates the "reset" button.  Note that it restores the
+form to its value from the last time the script was called, 
+NOT necessarily to the defaults.
+
+=head2 CREATING A DEFAULT BUTTON
+
+   print $query->defaults('button_label')
+
+defaults() creates a button that, when invoked, will cause the
+form to be completely reset to its defaults, wiping out all the
+changes the user ever made.
+
+=head2 CREATING A HIDDEN FIELD
+
+	print $query->hidden(-name=>'hidden_name',
+			     -default=>['value1','value2'...]);
+
+		-or-
+
+	print $query->hidden('hidden_name','value1','value2'...);
+
+hidden() produces a text field that can't be seen by the user.  It
+is useful for passing state variable information from one invocation
+of the script to the next.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument is required and specifies the name of this
+field (-name).
+
+=item 2.  
+
+The second argument is also required and specifies its value
+(-default).  In the named parameter style of calling, you can provide
+a single value here or a reference to a whole list
+
+=back
+
+Fetch the value of a hidden field this way:
+
+     $hidden_value = $query->param('hidden_name');
+
+Note, that just like all the other form elements, the value of a
+hidden field is "sticky".  If you want to replace a hidden field with
+some other values after the script has been called once you'll have to
+do it manually:
+
+     $query->param('hidden_name','new','values','here');
+
+=head2 CREATING A CLICKABLE IMAGE BUTTON
+
+     print $query->image_button(-name=>'button_name',
+				-src=>'/source/URL',
+				-align=>'MIDDLE');      
+
+	-or-
+
+     print $query->image_button('button_name','/source/URL','MIDDLE');
+
+image_button() produces a clickable image.  When it's clicked on the
+position of the click is returned to your script as "button_name.x"
+and "button_name.y", where "button_name" is the name you've assigned
+to it.
+
+JAVASCRIPTING: image_button() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument (-name) is required and specifies the name of this
+field.
+
+=item 2.
+
+The second argument (-src) is also required and specifies the URL
+
+=item 3.
+The third option (-align, optional) is an alignment type, and may be
+TOP, BOTTOM or MIDDLE
+
+=back
+
+Fetch the value of the button this way:
+     $x = $query->param('button_name.x');
+     $y = $query->param('button_name.y');
+
+=head2 CREATING A JAVASCRIPT ACTION BUTTON
+
+     print $query->button(-name=>'button_name',
+			  -value=>'user visible label',
+			  -onClick=>"do_something()");
+
+	-or-
+
+     print $query->button('button_name',"do_something()");
+
+button() produces a button that is compatible with Netscape 2.0's
+JavaScript.  When it's pressed the fragment of JavaScript code
+pointed to by the B<-onClick> parameter will be executed.  On
+non-Netscape browsers this form element will probably not even
+display.
+
+=head1 NETSCAPE COOKIES
+
+Netscape browsers versions 1.1 and higher support a so-called
+"cookie" designed to help maintain state within a browser session.
+CGI.pm has several methods that support cookies.
+
+A cookie is a name=value pair much like the named parameters in a CGI
+query string.  CGI scripts create one or more cookies and send
+them to the browser in the HTTP header.  The browser maintains a list
+of cookies that belong to a particular Web server, and returns them
+to the CGI script during subsequent interactions.
+
+In addition to the required name=value pair, each cookie has several
+optional attributes:
+
+=over 4
+
+=item 1. an expiration time
+
+This is a time/date string (in a special GMT format) that indicates
+when a cookie expires.  The cookie will be saved and returned to your
+script until this expiration date is reached if the user exits
+Netscape and restarts it.  If an expiration date isn't specified, the cookie
+will remain active until the user quits Netscape.
+
+=item 2. a domain
+
+This is a partial or complete domain name for which the cookie is 
+valid.  The browser will return the cookie to any host that matches
+the partial domain name.  For example, if you specify a domain name
+of ".capricorn.com", then Netscape will return the cookie to
+Web servers running on any of the machines "www.capricorn.com", 
+"www2.capricorn.com", "feckless.capricorn.com", etc.  Domain names
+must contain at least two periods to prevent attempts to match
+on top level domains like ".edu".  If no domain is specified, then
+the browser will only return the cookie to servers on the host the
+cookie originated from.
+
+=item 3. a path
+
+If you provide a cookie path attribute, the browser will check it
+against your script's URL before returning the cookie.  For example,
+if you specify the path "/cgi-bin", then the cookie will be returned
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
+and "/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl".  By default, path is set to "/", which
+causes the cookie to be sent to any CGI script on your site.
+
+=item 4. a "secure" flag
+
+If the "secure" attribute is set, the cookie will only be sent to your
+script if the CGI request is occurring on a secure channel, such as SSL.
+
+=back
+
+The interface to Netscape cookies is the B<cookie()> method:
+
+    $cookie = $query->cookie(-name=>'sessionID',
+			     -value=>'xyzzy',
+			     -expires=>'+1h',
+			     -path=>'/cgi-bin/database',
+			     -domain=>'.capricorn.org',
+			     -secure=>1);
+    print $query->header(-cookie=>$cookie);
+
+B<cookie()> creates a new cookie.  Its parameters include:
+
+=over 4
+
+=item B<-name>
+
+The name of the cookie (required).  This can be any string at all.
+Although Netscape limits its cookie names to non-whitespace
+alphanumeric characters, CGI.pm removes this restriction by escaping
+and unescaping cookies behind the scenes.
+
+=item B<-value>
+
+The value of the cookie.  This can be any scalar value,
+array reference, or even associative array reference.  For example,
+you can store an entire associative array into a cookie this way:
+
+	$cookie=$query->cookie(-name=>'family information',
+			       -value=>\%childrens_ages);
+
+=item B<-path>
+
+The optional partial path for which this cookie will be valid, as described
+above.
+
+=item B<-domain>
+
+The optional partial domain for which this cookie will be valid, as described
+above.
+
+=item B<-expires>
+
+The optional expiration date for this cookie.  The format is as described 
+in the section on the B<header()> method:
+
+	"+1h"  one hour from now
+
+=item B<-secure>
+
+If set to true, this cookie will only be used within a secure
+SSL session.
+
+=back
+
+The cookie created by cookie() must be incorporated into the HTTP
+header within the string returned by the header() method:
+
+	print $query->header(-cookie=>$my_cookie);
+
+To create multiple cookies, give header() an array reference:
+
+	$cookie1 = $query->cookie(-name=>'riddle_name',
+				  -value=>"The Sphynx's Question");
+	$cookie2 = $query->cookie(-name=>'answers',
+				  -value=>\%answers);
+	print $query->header(-cookie=>[$cookie1,$cookie2]);
+
+To retrieve a cookie, request it by name by calling cookie()
+method without the B<-value> parameter:
+
+	use CGI;
+	$query = new CGI;
+	%answers = $query->cookie(-name=>'answers');
+	# $query->cookie('answers') will work too!
+
+The cookie and CGI namespaces are separate.  If you have a parameter
+named 'answers' and a cookie named 'answers', the values retrieved by
+param() and cookie() are independent of each other.  However, it's
+simple to turn a CGI parameter into a cookie, and vice-versa:
+
+   # turn a CGI parameter into a cookie
+   $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
+   # vice-versa
+   $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
+
+See the B<cookie.cgi> example script for some ideas on how to use
+cookies effectively.
+
+B<NOTE:> There appear to be some (undocumented) restrictions on
+Netscape cookies.  In Netscape 2.01, at least, I haven't been able to
+set more than three cookies at a time.  There may also be limits on
+the length of cookies.  If you need to store a lot of information,
+it's probably better to create a unique session ID, store it in a
+cookie, and use the session ID to locate an external file/database
+saved on the server's side of the connection.
+
+=head1 WORKING WITH NETSCAPE FRAMES
+
+It's possible for CGI.pm scripts to write into several browser
+panels and windows using Netscape's frame mechanism.  
+There are three techniques for defining new frames programmatically:
+
+=over 4
+
+=item 1. Create a <Frameset> document
+
+After writing out the HTTP header, instead of creating a standard
+HTML document using the start_html() call, create a <FRAMESET> 
+document that defines the frames on the page.  Specify your script(s)
+(with appropriate parameters) as the SRC for each of the frames.
+
+There is no specific support for creating <FRAMESET> sections 
+in CGI.pm, but the HTML is very simple to write.  See the frame
+documentation in Netscape's home pages for details 
+
+  http://home.netscape.com/assist/net_sites/frames.html
+
+=item 2. Specify the destination for the document in the HTTP header
+
+You may provide a B<-target> parameter to the header() method:
+   
+    print $q->header(-target=>'ResultsWindow');
+
+This will tell Netscape to load the output of your script into the
+frame named "ResultsWindow".  If a frame of that name doesn't
+already exist, Netscape will pop up a new window and load your
+script's document into that.  There are a number of magic names
+that you can use for targets.  See the frame documents on Netscape's
+home pages for details.
+
+=item 3. Specify the destination for the document in the <FORM> tag
+
+You can specify the frame to load in the FORM tag itself.  With
+CGI.pm it looks like this:
+
+    print $q->startform(-target=>'ResultsWindow');
+
+When your script is reinvoked by the form, its output will be loaded
+into the frame named "ResultsWindow".  If one doesn't already exist
+a new window will be created.
+
+=back
+
+The script "frameset.cgi" in the examples directory shows one way to
+create pages in which the fill-out form and the response live in
+side-by-side frames.
+
+=head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
+
+CGI.pm has limited support for HTML3's cascading style sheets (css).
+To incorporate a stylesheet into your document, pass the
+start_html() method a B<-style> parameter.  The value of this
+parameter may be a scalar, in which case it is incorporated directly
+into a <STYLE> section, or it may be a hash reference.  In the latter
+case you should provide the hash with one or more of B<-src> or
+B<-code>.  B<-src> points to a URL where an externally-defined
+stylesheet can be found.  B<-code> points to a scalar value to be
+incorporated into a <STYLE> section.  Style definitions in B<-code>
+override similarly-named ones in B<-src>, hence the name "cascading."
+
+You may also specify the type of the stylesheet by adding the optional
+B<-type> parameter to the hash pointed to by B<-style>.  If not
+specified, the style defaults to 'text/css'.
+
+To refer to a style within the body of your document, add the
+B<-class> parameter to any HTML element:
+
+    print h1({-class=>'Fancy'},'Welcome to the Party');
+
+Or define styles on the fly with the B<-style> parameter:
+
+    print h1({-style=>'Color: red;'},'Welcome to Hell');
+
+You may also use the new B<span()> element to apply a style to a
+section of text:
+
+    print span({-style=>'Color: red;'},
+	       h1('Welcome to Hell'),
+	       "Where did that handbasket get to?"
+	       );
+
+Note that you must import the ":html3" definitions to have the
+B<span()> method available.  Here's a quick and dirty example of using
+CSS's.  See the CSS specification at
+http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
+
+    use CGI qw/:standard :html3/;
+
+    #here's a stylesheet incorporated directly into the page
+    $newStyle=<<END;
+    <!-- 
+    P.Tip {
+	margin-right: 50pt;
+	margin-left: 50pt;
+        color: red;
+    }
+    P.Alert {
+	font-size: 30pt;
+        font-family: sans-serif;
+      color: red;
+    }
+    -->
+    END
+    print header();
+    print start_html( -title=>'CGI with Style',
+		      -style=>{-src=>'http://www.capricorn.com/style/st1.css',
+		               -code=>$newStyle}
+	             );
+    print h1('CGI with Style'),
+          p({-class=>'Tip'},
+	    "Better read the cascading style sheet spec before playing with this!"),
+          span({-style=>'color: magenta'},
+	       "Look Mom, no hands!",
+	       p(),
+	       "Whooo wee!"
+	       );
+    print end_html;
+
+=head1 DEBUGGING
+
+If you are running the script
+from the command line or in the perl debugger, you can pass the script
+a list of keywords or parameter=value pairs on the command line or 
+from standard input (you don't have to worry about tricking your
+script into reading from environment variables).
+You can pass keywords like this:
+
+    your_script.pl keyword1 keyword2 keyword3
+
+or this:
+
+   your_script.pl keyword1+keyword2+keyword3
+
+or this:
+
+    your_script.pl name1=value1 name2=value2
+
+or this:
+
+    your_script.pl name1=value1&name2=value2
+
+or even as newline-delimited parameters on standard input.
+
+When debugging, you can use quotes and backslashes to escape 
+characters in the familiar shell manner, letting you place
+spaces and other funny characters in your parameter=value
+pairs:
+
+   your_script.pl "name1='I am a long value'" "name2=two\ words"
+
+=head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
+
+The dump() method produces a string consisting of all the query's
+name/value pairs formatted nicely as a nested list.  This is useful
+for debugging purposes:
+
+    print $query->dump
+    
+
+Produces something that looks like:
+
+    <UL>
+    <LI>name1
+	<UL>
+	<LI>value1
+	<LI>value2
+	</UL>
+    <LI>name2
+	<UL>
+	<LI>value1
+	</UL>
+    </UL>
+
+You can pass a value of 'true' to dump() in order to get it to
+print the results out as plain text, suitable for incorporating
+into a <PRE> section.
+
+As a shortcut, as of version 1.56 you can interpolate the entire CGI
+object into a string and it will be replaced with the a nice HTML dump
+shown above:
+
+    $query=new CGI;
+    print "<H2>Current Values</H2> $query\n";
+
+=head1 FETCHING ENVIRONMENT VARIABLES
+
+Some of the more useful environment variables can be fetched
+through this interface.  The methods are as follows:
+
+=over 4
+
+=item B<accept()>
+
+Return a list of MIME types that the remote browser
+accepts. If you give this method a single argument
+corresponding to a MIME type, as in
+$query->accept('text/html'), it will return a
+floating point value corresponding to the browser's
+preference for this type from 0.0 (don't want) to 1.0.
+Glob types (e.g. text/*) in the browser's accept list
+are handled correctly.
+
+=item B<raw_cookie()>
+
+Returns the HTTP_COOKIE variable, an HTTP extension implemented by
+Netscape browsers version 1.1 and higher.  Cookies have a special
+format, and this method call just returns the raw form (?cookie
+dough).  See cookie() for ways of setting and retrieving cooked
+cookies.
+
+Called with no parameters, raw_cookie() returns the packed cookie
+structure.  You can separate it into individual cookies by splitting
+on the character sequence "; ".  Called with the name of a cookie,
+retrieves the B<unescaped> form of the cookie.  You can use the
+regular cookie() method to get the names, or use the raw_fetch()
+method from the CGI::Cookie module.
+
+=item B<user_agent()>
+
+Returns the HTTP_USER_AGENT variable.  If you give
+this method a single argument, it will attempt to
+pattern match on it, allowing you to do something
+like $query->user_agent(netscape);
+
+=item B<path_info()>
+
+Returns additional path information from the script URL.
+E.G. fetching /cgi-bin/your_script/additional/stuff will
+result in $query->path_info() returning
+"additional/stuff".
+
+NOTE: The Microsoft Internet Information Server
+is broken with respect to additional path information.  If
+you use the Perl DLL library, the IIS server will attempt to
+execute the additional path information as a Perl script.
+If you use the ordinary file associations mapping, the
+path information will be present in the environment, 
+but incorrect.  The best thing to do is to avoid using additional
+path information in CGI scripts destined for use with IIS.
+
+=item B<path_translated()>
+
+As per path_info() but returns the additional
+path information translated into a physical path, e.g.
+"/usr/local/etc/httpd/htdocs/additional/stuff".
+
+The Microsoft IIS is broken with respect to the translated
+path as well.
+
+=item B<remote_host()>
+
+Returns either the remote host name or IP address.
+if the former is unavailable.
+
+=item B<script_name()>
+Return the script name as a partial URL, for self-refering
+scripts.
+
+=item B<referer()>
+
+Return the URL of the page the browser was viewing
+prior to fetching your script.  Not available for all
+browsers.
+
+=item B<auth_type ()>
+
+Return the authorization/verification method in use for this
+script, if any.
+
+=item B<server_name ()>
+
+Returns the name of the server, usually the machine's host
+name.
+
+=item B<virtual_host ()>
+
+When using virtual hosts, returns the name of the host that
+the browser attempted to contact
+
+=item B<server_software ()>
+
+Returns the server software and version number.
+
+=item B<remote_user ()>
+
+Return the authorization/verification name used for user
+verification, if this script is protected.
+
+=item B<user_name ()>
+
+Attempt to obtain the remote user's name, using a variety
+of different techniques.  This only works with older browsers
+such as Mosaic.  Netscape does not reliably report the user
+name!
+
+=item B<request_method()>
+
+Returns the method used to access your script, usually
+one of 'POST', 'GET' or 'HEAD'.
+
+=back
+
+=head1 USING NPH SCRIPTS
+
+NPH, or "no-parsed-header", scripts bypass the server completely by
+sending the complete HTTP header directly to the browser.  This has
+slight performance benefits, but is of most use for taking advantage
+of HTTP extensions that are not directly supported by your server,
+such as server push and PICS headers.
+
+Servers use a variety of conventions for designating CGI scripts as
+NPH.  Many Unix servers look at the beginning of the script's name for
+the prefix "nph-".  The Macintosh WebSTAR server and Microsoft's
+Internet Information Server, in contrast, try to decide whether a
+program is an NPH script by examining the first line of script output.
+
+
+CGI.pm supports NPH scripts with a special NPH mode.  When in this
+mode, CGI.pm will output the necessary extra header information when
+the header() and redirect() methods are
+called.
+
+The Microsoft Internet Information Server requires NPH mode.  As of version
+2.30, CGI.pm will automatically detect when the script is running under IIS
+and put itself into this mode.  You do not need to do this manually, although
+it won't hurt anything if you do.
+
+There are a number of ways to put CGI.pm into NPH mode:
+
+=over 4
+
+=item In the B<use> statement 
+
+Simply add the "-nph" pragmato the list of symbols to be imported into
+your script:
+
+      use CGI qw(:standard -nph)
+
+=item By calling the B<nph()> method:
+
+Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
+
+      CGI->nph(1)
+
+=item By using B<-nph> parameters in the B<header()> and B<redirect()>  statements:
+
+      print $q->header(-nph=>1);
+
+=back
+
+=head1 Server Push
+
+CGI.pm provides three simple functions for producing multipart
+documents of the type needed to implement server push.  These
+functions were graciously provided by Ed Jordan <ed@fidalgo.net>.  To
+import these into your namespace, you must import the ":push" set.
+You are also advised to put the script into NPH mode and to set $| to
+1 to avoid buffering problems.
+
+Here is a simple script that demonstrates server push:
+
+  #!/usr/local/bin/perl
+  use CGI qw/:push -nph/;
+  $| = 1;
+  print multipart_init(-boundary=>'----------------here we go!');
+  while (1) {
+      print multipart_start(-type=>'text/plain'),
+            "The current time is ",scalar(localtime),"\n",
+            multipart_end;
+      sleep 1;
+  }
+
+This script initializes server push by calling B<multipart_init()>.
+It then enters an infinite loop in which it begins a new multipart
+section by calling B<multipart_start()>, prints the current local time,
+and ends a multipart section with B<multipart_end()>.  It then sleeps
+a second, and begins again.
+
+=over 4
+
+=item multipart_init()
+     
+  multipart_init(-boundary=>$boundary);
+
+Initialize the multipart system.  The -boundary argument specifies
+what MIME boundary string to use to separate parts of the document.
+If not provided, CGI.pm chooses a reasonable boundary for you.
+
+=item multipart_start()
+
+  multipart_start(-type=>$type)
+
+Start a new part of the multipart document using the specified MIME
+type.  If not specified, text/html is assumed.
+
+=item multipart_end()
+
+  multipart_end()
+
+End a part.  You must remember to call multipart_end() once for each
+multipart_start().
+
+=back
+
+Users interested in server push applications should also have a look
+at the CGI::Push module.
+
+=head1 Avoiding Denial of Service Attacks
+
+A potential problem with CGI.pm is that, by default, it attempts to
+process form POSTings no matter how large they are.  A wily hacker
+could attack your site by sending a CGI script a huge POST of many
+megabytes.  CGI.pm will attempt to read the entire POST into a
+variable, growing hugely in size until it runs out of memory.  While
+the script attempts to allocate the memory the system may slow down
+dramatically.  This is a form of denial of service attack.
+
+Another possible attack is for the remote user to force CGI.pm to
+accept a huge file upload.  CGI.pm will accept the upload and store it
+in a temporary directory even if your script doesn't expect to receive
+an uploaded file.  CGI.pm will delete the file automatically when it
+terminates, but in the meantime the remote user may have filled up the
+server's disk space, causing problems for other programs.
+
+The best way to avoid denial of service attacks is to limit the amount
+of memory, CPU time and disk space that CGI scripts can use.  Some Web
+servers come with built-in facilities to accomplish this. In other
+cases, you can use the shell I<limit> or I<ulimit>
+commands to put ceilings on CGI resource usage.
+
+
+CGI.pm also has some simple built-in protections against denial of
+service attacks, but you must activate them before you can use them.
+These take the form of two global variables in the CGI name space:
+
+=over 4
+
+=item B<$CGI::POST_MAX>
+
+If set to a non-negative integer, this variable puts a ceiling
+on the size of POSTings, in bytes.  If CGI.pm detects a POST
+that is greater than the ceiling, it will immediately exit with an error
+message.  This value will affect both ordinary POSTs and
+multipart POSTs, meaning that it limits the maximum size of file
+uploads as well.  You should set this to a reasonably high
+value, such as 1 megabyte.
+
+=item B<$CGI::DISABLE_UPLOADS>
+
+If set to a non-zero value, this will disable file uploads
+completely.  Other fill-out form values will work as usual.
+
+=back
+
+You can use these variables in either of two ways.
+
+=over 4
+
+=item B<1. On a script-by-script basis>
+
+Set the variable at the top of the script, right after the "use" statement:
+
+    use CGI qw/:standard/;
+    use CGI::Carp 'fatalsToBrowser';
+    $CGI::POST_MAX=1024 * 100;  # max 100K posts
+    $CGI::DISABLE_UPLOADS = 1;  # no uploads
+
+=item B<2. Globally for all scripts>
+
+Open up CGI.pm, find the definitions for $POST_MAX and 
+$DISABLE_UPLOADS, and set them to the desired values.  You'll 
+find them towards the top of the file in a subroutine named 
+initialize_globals().
+
+=back
+
+Since an attempt to send a POST larger than $POST_MAX bytes
+will cause a fatal error, you might want to use CGI::Carp to echo the
+fatal error message to the browser window as shown in the example
+above.  Otherwise the remote user will see only a generic "Internal
+Server" error message.  See the L<CGI::Carp> manual page for more
+details.
+
+=head1 COMPATIBILITY WITH CGI-LIB.PL
+
+To make it easier to port existing programs that use cgi-lib.pl
+the compatibility routine "ReadParse" is provided.  Porting is
+simple:
+
+OLD VERSION
+    require "cgi-lib.pl";
+    &ReadParse;
+    print "The value of the antique is $in{antique}.\n";
+
+NEW VERSION
+    use CGI;
+    CGI::ReadParse
+    print "The value of the antique is $in{antique}.\n";
+
+CGI.pm's ReadParse() routine creates a tied variable named %in,
+which can be accessed to obtain the query variables.  Like
+ReadParse, you can also provide your own variable.  Infrequently
+used features of ReadParse, such as the creation of @in and $in 
+variables, are not supported.
+
+Once you use ReadParse, you can retrieve the query object itself
+this way:
+
+    $q = $in{CGI};
+    print $q->textfield(-name=>'wow',
+			-value=>'does this really work?');
+
+This allows you to start using the more interesting features
+of CGI.pm without rewriting your old scripts from scratch.
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1995-1997, Lincoln D. Stein.  All rights reserved.  It may
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 CREDITS
+
+Thanks very much to:
+
+=over 4
+
+=item Matt Heffron (heffron@falstaff.css.beckman.com)
+
+=item James Taylor (james.taylor@srs.gov)
+
+=item Scott Anguish <sanguish@digifix.com>
+
+=item Mike Jewell (mlj3u@virginia.edu)
+
+=item Timothy Shimmin (tes@kbs.citri.edu.au)
+
+=item Joergen Haegg (jh@axis.se)
+
+=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
+
+=item Richard Resnick (applepi1@aol.com)
+
+=item Craig Bishop (csb@barwonwater.vic.gov.au)
+
+=item Tony Curtis (tc@vcpc.univie.ac.at)
+
+=item Tim Bunce (Tim.Bunce@ig.co.uk)
+
+=item Tom Christiansen (tchrist@convex.com)
+
+=item Andreas Koenig (k@franz.ww.TU-Berlin.DE)
+
+=item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au)
+
+=item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu)
+
+=item Stephen Dahmen (joyfire@inxpress.net)
+
+=item Ed Jordan (ed@fidalgo.net)
+
+=item David Alan Pisoni (david@cnation.com)
+
+=item Doug MacEachern (dougm@opengroup.org)
+
+=item Robin Houston (robin@oneworld.org)
+
+=item ...and many many more...
+
+for suggestions and bug fixes.
+
+=back
+
+=head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
+
+
+	#!/usr/local/bin/perl
+     
+	use CGI;
+ 
+	$query = new CGI;
+
+	print $query->header;
+	print $query->start_html("Example CGI.pm Form");
+	print "<H1> Example CGI.pm Form</H1>\n";
+	&print_prompt($query);
+	&do_work($query);
+	&print_tail;
+	print $query->end_html;
+ 
+	sub print_prompt {
+	   my($query) = @_;
+ 
+	   print $query->startform;
+	   print "<EM>What's your name?</EM><BR>";
+	   print $query->textfield('name');
+	   print $query->checkbox('Not my real name');
+ 
+	   print "<P><EM>Where can you find English Sparrows?</EM><BR>";
+	   print $query->checkbox_group(
+				 -name=>'Sparrow locations',
+				 -values=>[England,France,Spain,Asia,Hoboken],
+				 -linebreak=>'yes',
+				 -defaults=>[England,Asia]);
+ 
+	   print "<P><EM>How far can they fly?</EM><BR>",
+		$query->radio_group(
+			-name=>'how far',
+			-values=>['10 ft','1 mile','10 miles','real far'],
+			-default=>'1 mile');
+ 
+	   print "<P><EM>What's your favorite color?</EM>  ";
+	   print $query->popup_menu(-name=>'Color',
+				    -values=>['black','brown','red','yellow'],
+				    -default=>'red');
+ 
+	   print $query->hidden('Reference','Monty Python and the Holy Grail');
+ 
+	   print "<P><EM>What have you got there?</EM><BR>";
+	   print $query->scrolling_list(
+			 -name=>'possessions',
+			 -values=>['A Coconut','A Grail','An Icon',
+				   'A Sword','A Ticket'],
+			 -size=>5,
+			 -multiple=>'true');
+ 
+	   print "<P><EM>Any parting comments?</EM><BR>";
+	   print $query->textarea(-name=>'Comments',
+				  -rows=>10,
+				  -columns=>50);
+ 
+	   print "<P>",$query->reset;
+	   print $query->submit('Action','Shout');
+	   print $query->submit('Action','Scream');
+	   print $query->endform;
+	   print "<HR>\n";
+	}
+ 
+	sub do_work {
+	   my($query) = @_;
+	   my(@values,$key);
+
+	   print "<H2>Here are the current settings in this form</H2>";
+
+	   foreach $key ($query->param) {
+	      print "<STRONG>$key</STRONG> -> ";
+	      @values = $query->param($key);
+	      print join(", ",@values),"<BR>\n";
+	  }
+	}
+ 
+	sub print_tail {
+	   print <<END;
+	<HR>
+	<ADDRESS>Lincoln D. Stein</ADDRESS><BR>
+	<A HREF="/">Home Page</A>
+	END
+	}
+
+=head1 BUGS
+
+This module has grown large and monolithic.  Furthermore it's doing many
+things, such as handling URLs, parsing CGI input, writing HTML, etc., that
+are also done in the LWP modules. It should be discarded in favor of
+the CGI::* modules, but somehow I continue to work on it.
+
+Note that the code is truly contorted in order to avoid spurious
+warnings when programs are run with the B<-w> switch.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
+L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>,
+L<CGI::Push>, L<CGI::Fast>
+
+=cut
+
diff --git a/contrib/perl5/lib/CGI/Apache.pm b/contrib/perl5/lib/CGI/Apache.pm
new file mode 100644
index 000000000000..eed3e55c51c8
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Apache.pm
@@ -0,0 +1,103 @@
+package CGI::Apache;
+use Apache ();
+use vars qw(@ISA $VERSION);
+require CGI;
+@ISA = qw(CGI);
+
+$VERSION = (qw$Revision: 1.1 $)[1];
+$CGI::DefaultClass = 'CGI::Apache';
+$CGI::Apache::AutoloadClass = 'CGI';
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    ${"${callpack}::AutoloadClass"} = 'CGI';
+}
+
+sub new {
+    my($class) = shift;
+    my($r) = Apache->request;
+    %ENV = $r->cgi_env unless defined $ENV{GATEWAY_INTERFACE}; #PerlSetupEnv On 
+    my $self = $class->SUPER::new(@_);
+    $self->{'.req'} = $r;
+    $self;
+}
+
+sub header {
+    my ($self,@rest) = CGI::self_or_default(@_);
+    my $r = $self->{'.req'};
+    $r->basic_http_header;
+    return CGI::header($self,@rest);
+}		     
+
+sub print {
+    my($self,@rest) = CGI::self_or_default(@_);
+    $self->{'.req'}->print(@rest);
+}
+
+sub read_from_client {
+    my($self, $fh, $buff, $len, $offset) = @_;
+    my $r = $self->{'.req'} || Apache->request;
+    return $r->read($$buff, $len, $offset);
+}
+
+sub new_MultipartBuffer {
+    my $self = shift;
+    my $new = CGI::Apache::MultipartBuffer->new($self, @_); 
+    $new->{'.req'} = $self->{'.req'} || Apache->request;
+    return $new;
+}
+
+package CGI::Apache::MultipartBuffer;
+use vars qw(@ISA);
+@ISA = qw(MultipartBuffer);
+
+$CGI::Apache::MultipartBuffer::AutoloadClass = 'MultipartBuffer';
+*CGI::Apache::MultipartBuffer::read_from_client = 
+    \&CGI::Apache::read_from_client;
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+CGI::Apache - Make things work with CGI.pm against Perl-Apache API
+
+=head1 SYNOPSIS
+
+ require CGI::Apache;
+
+ my $q = new Apache::CGI;
+
+ $q->print($q->header);
+
+ #do things just like you do with CGI.pm
+
+=head1 DESCRIPTION
+
+When using the Perl-Apache API, your applications are faster, but the
+enviroment is different than CGI.
+This module attempts to set-up that environment as best it can.
+
+=head1 NOTE 1
+
+This module used to be named Apache::CGI.  Sorry for the confusion.
+
+=head1 NOTE 2
+
+If you're going to inherit from this class, make sure to "use" it
+after your package declaration rather than "require" it.  This is
+because CGI.pm does a little magic during the import() step in order
+to make autoloading work correctly.
+
+=head1 SEE ALSO
+
+perl(1), Apache(3), CGI(3)
+
+=head1 AUTHOR
+
+Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
+
+=cut
diff --git a/contrib/perl5/lib/CGI/Carp.pm b/contrib/perl5/lib/CGI/Carp.pm
new file mode 100644
index 000000000000..e20f7542b8af
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Carp.pm
@@ -0,0 +1,331 @@
+package CGI::Carp;
+
+=head1 NAME
+
+B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
+
+=head1 SYNOPSIS
+
+    use CGI::Carp;
+
+    croak "We're outta here!";
+    confess "It was my fault: $!";
+    carp "It was your fault!";   
+    warn "I'm confused";
+    die  "I'm dying.\n";
+
+=head1 DESCRIPTION
+
+CGI scripts have a nasty habit of leaving warning messages in the error
+logs that are neither time stamped nor fully identified.  Tracking down
+the script that caused the error is a pain.  This fixes that.  Replace
+the usual
+
+    use Carp;
+
+with
+
+    use CGI::Carp
+
+And the standard warn(), die (), croak(), confess() and carp() calls
+will automagically be replaced with functions that write out nicely
+time-stamped messages to the HTTP server error log.
+
+For example:
+
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
+   [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
+
+=head1 REDIRECTING ERROR MESSAGES
+
+By default, error messages are sent to STDERR.  Most HTTPD servers
+direct STDERR to the server's error log.  Some applications may wish
+to keep private error logs, distinct from the server's error log, or
+they may wish to direct error messages to STDOUT so that the browser
+will receive them.
+
+The C<carpout()> function is provided for this purpose.  Since
+carpout() is not exported by default, you must import it explicitly by
+saying
+
+   use CGI::Carp qw(carpout);
+
+The carpout() function requires one argument, which should be a
+reference to an open filehandle for writing errors.  It should be
+called in a C<BEGIN> block at the top of the CGI application so that
+compiler errors will be caught.  Example:
+
+   BEGIN {
+     use CGI::Carp qw(carpout);
+     open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
+       die("Unable to open mycgi-log: $!\n");
+     carpout(LOG);
+   }
+
+carpout() does not handle file locking on the log for you at this point.
+
+The real STDERR is not closed -- it is moved to SAVEERR.  Some
+servers, when dealing with CGI scripts, close their connection to the
+browser when the script closes STDOUT and STDERR.  SAVEERR is used to
+prevent this from happening prematurely.
+
+You can pass filehandles to carpout() in a variety of ways.  The "correct"
+way according to Tom Christiansen is to pass a reference to a filehandle 
+GLOB:
+
+    carpout(\*LOG);
+
+This looks weird to mere mortals however, so the following syntaxes are
+accepted as well:
+
+    carpout(LOG);
+    carpout(main::LOG);
+    carpout(main'LOG);
+    carpout(\LOG);
+    carpout(\'main::LOG');
+
+    ... and so on
+
+FileHandle and other objects work as well.
+
+Use of carpout() is not great for performance, so it is recommended
+for debugging purposes or for moderate-use applications.  A future
+version of this module may delay redirecting STDERR until one of the
+CGI::Carp methods is called to prevent the performance hit.
+
+=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
+
+If you want to send fatal (die, confess) errors to the browser, ask to 
+import the special "fatalsToBrowser" subroutine:
+
+    use CGI::Carp qw(fatalsToBrowser);
+    die "Bad error here";
+
+Fatal errors will now be echoed to the browser as well as to the log.  CGI::Carp
+arranges to send a minimal HTTP header to the browser so that even errors that
+occur in the early compile phase will be seen.
+Nonfatal errors will still be directed to the log file only (unless redirected
+with carpout).
+
+=head2 Changing the default message
+
+By default, the software error message is followed by a note to
+contact the Webmaster by e-mail with the time and date of the error.
+If this message is not to your liking, you can change it using the
+set_message() routine.  This is not imported by default; you should
+import it on the use() line:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    set_message("It's not a bug, it's a feature!");
+
+You may also pass in a code reference in order to create a custom
+error message.  At run time, your code will be called with the text
+of the error message that caused the script to die.  Example:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    BEGIN {
+       sub handle_errors {
+          my $msg = shift;
+          print "<h1>Oh gosh</h1>";
+          print "Got an error: $msg";
+      }
+      set_message(\&handle_errors);
+    }
+
+In order to correctly intercept compile-time errors, you should call
+set_message() from within a BEGIN{} block.
+
+=head1 CHANGE LOG
+
+1.05 carpout() added and minor corrections by Marc Hedlund
+     <hedlund@best.com> on 11/26/95.
+
+1.06 fatalsToBrowser() no longer aborts for fatal errors within
+     eval() statements.
+
+1.08 set_message() added and carpout() expanded to allow for FileHandle
+     objects.
+
+1.09 set_message() now allows users to pass a code REFERENCE for 
+     really custom error messages.  croak and carp are now
+     exported by default.  Thanks to Gunther Birznieks for the
+     patches.
+
+1.10 Patch from Chris Dean (ctdean@cogit.com) to allow 
+     module to run correctly under mod_perl.
+
+=head1 AUTHORS
+
+Lincoln D. Stein <lstein@genome.wi.mit.edu>.  Feel free to redistribute
+this under the Perl Artistic License.
+
+
+=head1 SEE ALSO
+
+Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
+CGI::Response
+
+=cut
+
+require 5.000;
+use Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(confess croak carp);
+@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message);
+
+$main::SIG{__WARN__}=\&CGI::Carp::warn;
+$main::SIG{__DIE__}=\&CGI::Carp::die;
+$CGI::Carp::VERSION = '1.101';
+$CGI::Carp::CUSTOM_MSG = undef;
+
+# fancy import routine detects and handles 'errorWrap' specially.
+sub import {
+    my $pkg = shift;
+    my(%routines);
+    grep($routines{$_}++,@_,@EXPORT);
+    $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
+    my($oldlevel) = $Exporter::ExportLevel;
+    $Exporter::ExportLevel = 1;
+    Exporter::import($pkg,keys %routines);
+    $Exporter::ExportLevel = $oldlevel;
+}
+
+# These are the originals
+# XXX Why not just use CORE::die etc., instead of these two?  GSAR
+sub realwarn { CORE::warn(@_); }
+sub realdie { CORE::die(@_); }
+
+sub id {
+    my $level = shift;
+    my($pack,$file,$line,$sub) = caller($level);
+    my($id) = $file=~m|([^/]+)$|;
+    return ($file,$line,$id);
+}
+
+sub stamp {
+    my $time = scalar(localtime);
+    my $frame = 0;
+    my ($id,$pack,$file);
+    do {
+	$id = $file;
+	($pack,$file) = caller($frame++);
+    } until !$file;
+    ($id) = $id=~m|([^/]+)$|;
+    return "[$time] $id: ";
+}
+
+sub warn {
+    my $message = shift;
+    my($file,$line,$id) = id(1);
+    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    my $stamp = stamp;
+    $message=~s/^/$stamp/gm;
+    realwarn $message;
+}
+
+# The mod_perl package Apache::Registry loads CGI programs by calling
+# eval.  These evals don't count when looking at the stack backtrace.
+sub _longmess {
+    my $message = Carp::longmess();
+    my $mod_perl = ($ENV{'GATEWAY_INTERFACE'} 
+                    && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//);
+    $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
+    return( $message );    
+}
+
+sub die {
+    my $message = shift;
+    my $time = scalar(localtime);
+    my($file,$line,$id) = id(1);
+    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
+    my $stamp = stamp;
+    $message=~s/^/$stamp/gm;
+    realdie $message;
+}
+
+sub set_message {
+    $CGI::Carp::CUSTOM_MSG = shift;
+    return $CGI::Carp::CUSTOM_MSG;
+}
+
+# Avoid generating "subroutine redefined" warnings with the following
+# hack:
+{
+    local $^W=0;
+    eval <<EOF;
+sub confess { CGI::Carp::die Carp::longmess \@_; }
+sub croak { CGI::Carp::die Carp::shortmess \@_; }
+sub carp { CGI::Carp::warn Carp::shortmess \@_; }
+EOF
+    ;
+}
+
+# We have to be ready to accept a filehandle as a reference
+# or a string.
+sub carpout {
+    my($in) = @_;
+    my($no) = fileno(to_filehandle($in));
+    realdie "Invalid filehandle $in\n" unless defined $no;
+    
+    open(SAVEERR, ">&STDERR");
+    open(STDERR, ">&$no") or 
+	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
+}
+
+# headers
+sub fatalsToBrowser {
+    my($msg) = @_;
+    $msg=~s/>/&gt;/g;
+    $msg=~s/</&lt;/g;
+    $msg=~s/&/&amp;/g;
+    $msg=~s/\"/&quot;/g;
+    my($wm) = $ENV{SERVER_ADMIN} ? 
+	qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+	"this site's webmaster";
+    my ($outer_message) = <<END;
+For help, please send mail to $wm, giving this error message 
+and the time and date of the error.
+END
+    ;
+    print STDOUT "Content-type: text/html\n\n";
+
+    if ($CUSTOM_MSG) {
+	if (ref($CUSTOM_MSG) eq 'CODE') {
+	    &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+	    return;
+	} else {
+	    $outer_message = $CUSTOM_MSG;
+	}
+    }
+    
+    print STDOUT <<END;
+<H1>Software error:</H1>
+<CODE>$msg</CODE>
+<P>
+$outer_message;
+END
+    ;
+}
+
+# Cut and paste from CGI.pm so that we don't have the overhead of
+# always loading the entire CGI module.
+sub to_filehandle {
+    my $thingy = shift;
+    return undef unless $thingy;
+    return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+    return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+    if (!ref($thingy)) {
+	my $caller = 1;
+	while (my $package = caller($caller++)) {
+	    my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; 
+	    return $tmp if defined(fileno($tmp));
+	}
+    }
+    return undef;
+}
+
+1;
diff --git a/contrib/perl5/lib/CGI/Cookie.pm b/contrib/perl5/lib/CGI/Cookie.pm
new file mode 100644
index 000000000000..c32891a33123
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Cookie.pm
@@ -0,0 +1,418 @@
+package CGI::Cookie;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::Cookie::VERSION='1.06';
+
+use CGI;
+use overload '""' => \&as_string,
+    'cmp' => \&compare,
+    'fallback'=>1;
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookies are parsed as normal
+# escaped URL data.
+sub fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    return $class->parse($raw_cookie);
+}
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookie values are not unescaped
+# or altered in any way.
+sub raw_fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    my %results;
+    my($key,$value);
+
+    my(@pairs) = split("; ",$raw_cookie);
+    foreach (@pairs) {
+	if (/^([^=]+)=(.*)/) {
+	    $key = $1;
+	    $value = $2;
+	}
+	else {
+	    $key = $_;
+	    $value = '';
+	}
+	$results{$key} = $value;
+    }
+    return \%results unless wantarray;
+    return %results;
+}
+
+sub parse {
+    my ($self,$raw_cookie) = @_;
+    my %results;
+
+    my(@pairs) = split("; ",$raw_cookie);
+    foreach (@pairs) {
+	my($key,$value) = split("=");
+	my(@values) = map CGI::unescape($_),split('&',$value);
+	$key = CGI::unescape($key);
+	$results{$key} = $self->new(-name=>$key,-value=>\@values);
+    }
+    return \%results unless wantarray;
+    return %results;
+}
+
+sub new {
+    my $class = shift;
+    $class = ref($class) if ref($class);
+    my($name,$value,$path,$domain,$secure,$expires) =
+	CGI->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+
+    # Pull out our parameters.
+    my @values;
+    if (ref($value)) {
+	if (ref($value) eq 'ARRAY') {
+	    @values = @$value;
+	} elsif (ref($value) eq 'HASH') {
+	    @values = %$value;
+	}
+    } else {
+	@values = ($value);
+    }
+
+    bless my $self = {
+	'name'=>$name,
+	'value'=>[@values],
+	},$class;
+
+    # IE requires the path to be present for some reason.
+    ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+
+    $self->path($path) if defined $path;
+    $self->domain($domain) if defined $domain;
+    $self->secure($secure) if defined $secure;
+    $self->expires($expires) if defined $expires;
+    return $self;
+}
+
+sub as_string {
+    my $self = shift;
+    return "" unless $self->name;
+
+    my(@constant_values,$domain,$path,$expires,$secure);
+
+    push(@constant_values,"domain=$domain") if $domain = $self->domain;
+    push(@constant_values,"path=$path") if $path = $self->path;
+    push(@constant_values,"expires=$expires") if $expires = $self->expires;
+    push(@constant_values,'secure') if $secure = $self->secure;
+
+    my($key) = CGI::escape($self->name);
+    my($cookie) = join("=",$key,join("&",map CGI::escape($_),$self->value));
+    return join("; ",$cookie,@constant_values);
+}
+
+sub compare {
+    my $self = shift;
+    my $value = shift;
+    return "$self" cmp $value;
+}
+
+# accessors
+sub name {
+    my $self = shift;
+    my $name = shift;
+    $self->{'name'} = $name if defined $name;
+    return $self->{'name'};
+}
+
+sub value {
+    my $self = shift;
+    my $value = shift;
+    $self->{'value'} = $value if defined $value;
+    return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
+}
+
+sub domain {
+    my $self = shift;
+    my $domain = shift;
+    $self->{'domain'} = $domain if defined $domain;
+    return $self->{'domain'};
+}
+
+sub secure {
+    my $self = shift;
+    my $secure = shift;
+    $self->{'secure'} = $secure if defined $secure;
+    return $self->{'secure'};
+}
+
+sub expires {
+    my $self = shift;
+    my $expires = shift;
+    $self->{'expires'} = CGI::expires($expires,'cookie') if defined $expires;
+    return $self->{'expires'};
+}
+
+sub path {
+    my $self = shift;
+    my $path = shift;
+    $self->{'path'} = $path if defined $path;
+    return $self->{'path'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Cookie - Interface to Netscape Cookies
+
+=head1 SYNOPSIS
+
+    use CGI qw/:standard/;
+    use CGI::Cookie;
+
+    # Create new cookies and send them
+    $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456);
+    $cookie2 = new CGI::Cookie(-name=>'preferences',
+                               -value=>{ font => Helvetica,
+                                         size => 12 } 
+                               );
+    print header(-cookie=>[$cookie1,$cookie2]);
+
+    # fetch existing cookies
+    %cookies = fetch CGI::Cookie;
+    $id = $cookies{'ID'}->value;
+
+    # create cookies returned from an external source
+    %cookies = parse CGI::Cookie($ENV{COOKIE});
+
+=head1 DESCRIPTION
+
+CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an
+innovation that allows Web servers to store persistent information on
+the browser's side of the connection.  Although CGI::Cookie is
+intended to be used in conjunction with CGI.pm (and is in fact used by
+it internally), you can use this module independently.
+
+For full information on cookies see 
+
+	http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
+
+=head1 USING CGI::Cookie
+
+CGI::Cookie is object oriented.  Each cookie object has a name and a
+value.  The name is any scalar value.  The value is any scalar or
+array value (associative arrays are also allowed).  Cookies also have
+several optional attributes, including:
+
+=over 4
+
+=item B<1. expiration date>
+
+The expiration date tells the browser how long to hang on to the
+cookie.  If the cookie specifies an expiration date in the future, the
+browser will store the cookie information in a disk file and return it
+to the server every time the user reconnects (until the expiration
+date is reached).  If the cookie species an expiration date in the
+past, the browser will remove the cookie from the disk file.  If the
+expiration date is not specified, the cookie will persist only until
+the user quits the browser.
+
+=item B<2. domain>
+
+This is a partial or complete domain name for which the cookie is 
+valid.  The browser will return the cookie to any host that matches
+the partial domain name.  For example, if you specify a domain name
+of ".capricorn.com", then Netscape will return the cookie to
+Web servers running on any of the machines "www.capricorn.com", 
+"ftp.capricorn.com", "feckless.capricorn.com", etc.  Domain names
+must contain at least two periods to prevent attempts to match
+on top level domains like ".edu".  If no domain is specified, then
+the browser will only return the cookie to servers on the host the
+cookie originated from.
+
+=item B<3. path>
+
+If you provide a cookie path attribute, the browser will check it
+against your script's URL before returning the cookie.  For example,
+if you specify the path "/cgi-bin", then the cookie will be returned
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
+and "/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl".  By default, path is set to "/", which
+causes the cookie to be sent to any CGI script on your site.
+
+=item B<4. secure flag>
+
+If the "secure" attribute is set, the cookie will only be sent to your
+script if the CGI request is occurring on a secure channel, such as SSL.
+
+=back
+
+=head2 Creating New Cookies
+
+	$c = new CGI::Cookie(-name    =>  'foo',
+                             -value   =>  'bar',
+                             -expires =>  '+3M',
+                             -domain  =>  '.capricorn.com',
+                             -path    =>  '/cgi-bin/database'
+                             -secure  =>  1
+	                    );
+
+Create cookies from scratch with the B<new> method.  The B<-name> and
+B<-value> parameters are required.  The name must be a scalar value.
+The value can be a scalar, an array reference, or a hash reference.
+(At some point in the future cookies will support one of the Perl
+object serialization protocols for full generality).
+
+B<-expires> accepts any of the relative or absolute date formats
+recognized by CGI.pm, for example "+3M" for three months in the
+future.  See CGI.pm's documentation for details.
+
+B<-domain> points to a domain name or to a fully qualified host name.
+If not specified, the cookie will be returned only to the Web server
+that created it.
+
+B<-path> points to a partial URL on the current server.  The cookie
+will be returned to all URLs beginning with the specified path.  If
+not specified, it defaults to '/', which returns the cookie to all
+pages at your site.
+
+B<-secure> if set to a true value instructs the browser to return the
+cookie only when a cryptographic protocol is in use.
+
+=head2 Sending the Cookie to the Browser
+
+Within a CGI script you can send a cookie to the browser by creating
+one or more Set-Cookie: fields in the HTTP header.  Here is a typical
+sequence:
+
+  my $c = new CGI::Cookie(-name    =>  'foo',
+                          -value   =>  ['bar','baz'],
+                          -expires =>  '+3M');
+
+  print "Set-Cookie: $c\n";
+  print "Content-Type: text/html\n\n";
+
+To send more than one cookie, create several Set-Cookie: fields.
+Alternatively, you may concatenate the cookies together with "; " and
+send them in one field.
+
+If you are using CGI.pm, you send cookies by providing a -cookie
+argument to the header() method:
+
+  print header(-cookie=>$c);
+
+Mod_perl users can set cookies using the request object's header_out()
+method:
+
+  $r->header_out('Set-Cookie',$c);
+
+Internally, Cookie overloads the "" operator to call its as_string()
+method when incorporated into the HTTP header.  as_string() turns the
+Cookie's internal representation into an RFC-compliant text
+representation.  You may call as_string() yourself if you prefer:
+
+  print "Set-Cookie: ",$c->as_string,"\n";
+
+=head2 Recovering Previous Cookies
+
+	%cookies = fetch CGI::Cookie;
+
+B<fetch> returns an associative array consisting of all cookies
+returned by the browser.  The keys of the array are the cookie names.  You
+can iterate through the cookies this way:
+
+	%cookies = fetch CGI::Cookie;
+	foreach (keys %cookies) {
+	   do_something($cookies{$_});
+        }
+
+In a scalar context, fetch() returns a hash reference, which may be more
+efficient if you are manipulating multiple cookies.
+    
+CGI.pm uses the URL escaping methods to save and restore reserved characters
+in its cookies.  If you are trying to retrieve a cookie set by a foreign server,
+this escaping method may trip you up.  Use raw_fetch() instead, which has the
+same semantics as fetch(), but performs no unescaping.
+
+You may also retrieve cookies that were stored in some external
+form using the parse() class method:
+
+       $COOKIES = `cat /usr/tmp/Cookie_stash`;
+       %cookies = parse CGI::Cookie($COOKIES);
+
+=head2 Manipulating Cookies
+
+Cookie objects have a series of accessor methods to get and set cookie
+attributes.  Each accessor has a similar syntax.  Called without
+arguments, the accessor returns the current value of the attribute.
+Called with an argument, the accessor changes the attribute and
+returns its new value.
+
+=over 4
+
+=item B<name()>
+
+Get or set the cookie's name.  Example:
+
+	$name = $c->name;
+	$new_name = $c->name('fred');
+
+=item B<value()>
+
+Get or set the cookie's value.  Example:
+
+	$value = $c->value;
+	@new_value = $c->value(['a','b','c','d']);
+
+B<value()> is context sensitive.  In an array context it will return
+the current value of the cookie as an array.  In a scalar context it
+will return the B<first> value of a multivalued cookie.
+
+=item B<domain()>
+
+Get or set the cookie's domain.
+
+=item B<path()>
+
+Get or set the cookie's path.
+
+=item B<expires()>
+
+Get or set the cookie's expiration time.
+
+=back
+
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+ 
+=cut
diff --git a/contrib/perl5/lib/CGI/Fast.pm b/contrib/perl5/lib/CGI/Fast.pm
new file mode 100644
index 000000000000..03b54072c961
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Fast.pm
@@ -0,0 +1,173 @@
+package CGI::Fast;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+$CGI::Fast::VERSION='1.00a';
+
+use CGI;
+use FCGI;
+@ISA = ('CGI');
+
+# workaround for known bug in libfcgi
+while (($ignore) = each %ENV) { }
+
+# override the initialization behavior so that
+# state is NOT maintained between invocations 
+sub save_request {
+    # no-op
+}
+
+# New is slightly different in that it calls FCGI's
+# accept() method.
+sub new {
+    return undef unless FCGI::accept() >= 0;
+    my($self,@param) = @_;
+    return $CGI::Q = $self->SUPER::new(@param);
+}
+
+1;
+
+=head1 NAME
+
+CGI::Fast - CGI Interface for Fast CGI
+
+=head1 SYNOPSIS
+
+    use CGI::Fast qw(:standard);
+    $COUNTER = 0;
+    while (new CGI::Fast) {
+	print header;
+	print start_html("Fast CGI Rocks");
+	print
+	    h1("Fast CGI Rocks"),
+	    "Invocation number ",b($COUNTER++),
+            " PID ",b($$),".",
+	    hr;
+        print end_html;
+    }
+
+=head1 DESCRIPTION
+
+CGI::Fast is a subclass of the CGI object created by
+CGI.pm.  It is specialized to work well with the Open Market
+FastCGI standard, which greatly speeds up CGI scripts by
+turning them into persistently running server processes.  Scripts
+that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections,
+will see large performance improvements.
+
+=head1 OTHER PIECES OF THE PUZZLE
+
+In order to use CGI::Fast you'll need a FastCGI-enabled Web
+server.  Open Market's server is FastCGI-savvy.  There are also
+freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
+FastCGI-enabling modules for Microsoft Internet Information Server and
+Netscape Communications Server have been announced.
+
+In addition, you'll need a version of the Perl interpreter that has
+been linked with the FastCGI I/O library.  Precompiled binaries are
+available for several platforms, including DEC Alpha, HP-UX and 
+SPARC/Solaris, or you can rebuild Perl from source with patches
+provided in the FastCGI developer's kit.  The FastCGI Perl interpreter
+can be used in place of your normal Perl without ill consequences.
+
+You can find FastCGI modules for Apache and NCSA httpd, precompiled
+Perl interpreters, and the FastCGI developer's kit all at URL:
+
+  http://www.fastcgi.com/
+
+=head1 WRITING FASTCGI PERL SCRIPTS
+
+FastCGI scripts are persistent: one or more copies of the script 
+are started up when the server initializes, and stay around until
+the server exits or they die a natural death.  After performing
+whatever one-time initialization it needs, the script enters a 
+loop waiting for incoming connections, processing the request, and
+waiting some more.
+
+A typical FastCGI script will look like this:
+
+    #!/usr/local/bin/perl    # must be a FastCGI version of perl!
+    use CGI::Fast;
+    &do_some_initialization();
+    while ($q = new CGI::Fast) {
+	&process_request($q);
+    }
+
+Each time there's a new request, CGI::Fast returns a
+CGI object to your loop.  The rest of the time your script
+waits in the call to new().  When the server requests that
+your script be terminated, new() will return undef.  You can
+of course exit earlier if you choose.  A new version of the
+script will be respawned to take its place (this may be
+necessary in order to avoid Perl memory leaks in long-running
+scripts).
+
+CGI.pm's default CGI object mode also works.  Just modify the loop
+this way:
+
+    while (new CGI::Fast) {
+	&process_request;
+    }
+
+Calls to header(), start_form(), etc. will all operate on the
+current request.
+
+=head1 INSTALLING FASTCGI SCRIPTS
+
+See the FastCGI developer's kit documentation for full details.  On
+the Apache server, the following line must be added to srm.conf:
+
+    AddType application/x-httpd-fcgi .fcgi
+
+FastCGI scripts must end in the extension .fcgi.  For each script you
+install, you must add something like the following to srm.conf:
+
+   AppClass /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2
+
+This instructs Apache to launch two copies of file_upload.fcgi at 
+startup time.
+
+=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS
+
+Any script that works correctly as a FastCGI script will also work
+correctly when installed as a vanilla CGI script.  However it will
+not see any performance benefit.
+
+=head1 CAVEATS
+
+I haven't tested this very much.
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+ 
+=cut
diff --git a/contrib/perl5/lib/CGI/Push.pm b/contrib/perl5/lib/CGI/Push.pm
new file mode 100644
index 000000000000..eeec3f81108f
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Push.pm
@@ -0,0 +1,313 @@
+package CGI::Push;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::Push::VERSION='1.01';
+use CGI;
+@ISA = ('CGI');
+
+$CGI::DefaultClass = 'CGI::Push';
+$CGI::Push::AutoloadClass = 'CGI';
+
+# add do_push() and push_delay() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
+
+sub do_push {
+    my ($self,@p) = CGI::self_or_default(@_);
+
+    # unbuffer output
+    $| = 1;
+    srand;
+    my ($random) = sprintf("%16.0f",rand()*1E16);
+    my ($boundary) = "----------------------------------$random";
+
+    my (@header);
+    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
+	$self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
+    $type = 'text/html' unless $type;
+    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
+    $delay = 1 unless defined($delay);
+    $self->push_delay($delay);
+
+    my(@o);
+    foreach (@other) { push(@o,split("=")); }
+    push(@o,'-Target'=>$target) if defined($target);
+    push(@o,'-Cookie'=>$cookie) if defined($cookie);
+    push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary");
+    push(@o,'-Server'=>"CGI.pm Push Module");
+    push(@o,'-Status'=>'200 OK');
+    push(@o,'-nph'=>1);
+    print $self->header(@o);
+    print "${boundary}$CGI::CRLF";
+    
+    # now we enter a little loop
+    my @contents;
+    while (1) {
+	last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" 
+	    unless $type eq 'dynamic';
+	print @contents,"$CGI::CRLF";
+	print "${boundary}$CGI::CRLF";
+	do_sleep($self->push_delay()) if $self->push_delay();
+    }
+
+    # Optional last page
+    if ($last_page && ref($last_page) eq 'CODE') {
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+	print  &$last_page($self,$COUNTER),"$CGI::CRLF${boundary}$CGI::CRLF";
+    }
+}
+
+sub simple_counter {
+    my ($self,$count) = @_;
+    return (
+	    CGI->start_html("CGI::Push Default Counter"),
+	    CGI->h1("CGI::Push Default Counter"),
+	    "This page has been updated ",CGI->strong($count)," times.",
+	    CGI->hr(),
+	    CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
+	    CGI->end_html
+	    );
+}
+
+sub do_sleep {
+    my $delay = shift;
+    if ( ($delay >= 1) && ($delay!~/\./) ){
+	sleep($delay);
+    } else {
+	select(undef,undef,undef,$delay);
+    }
+}
+
+sub push_delay {
+   my ($self,$delay) = CGI::self_or_default(@_);
+   return defined($delay) ? $self->{'.delay'} = 
+	$delay : $self->{'.delay'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Push - Simple Interface to Server Push
+
+=head1 SYNOPSIS
+
+    use CGI::Push qw(:standard);
+
+    do_push(-next_page=>\&next_page,
+            -last_page=>\&last_page,
+            -delay=>0.5);
+
+    sub next_page {
+        my($q,$counter) = @_;
+        return undef if $counter >= 10;
+        return start_html('Test'),
+  	       h1('Visible'),"\n",
+               "This page has been called ", strong($counter)," times",
+               end_html();
+      }
+
+     sub last_page {
+	 my($q,$counter) = @_;
+         return start_html('Done'),
+                h1('Finished'),
+                strong($counter),' iterations.',
+                end_html;
+     }
+
+=head1 DESCRIPTION
+
+CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
+specialized for server push operations, which allow you to create
+animated pages whose content changes at regular intervals.
+
+You provide CGI::Push with a pointer to a subroutine that will draw
+one page.  Every time your subroutine is called, it generates a new
+page.  The contents of the page will be transmitted to the browser
+in such a way that it will replace what was there beforehand.  The
+technique will work with HTML pages as well as with graphics files, 
+allowing you to create animated GIFs.
+
+=head1 USING CGI::Push
+
+CGI::Push adds one new method to the standard CGI suite, do_push().
+When you call this method, you pass it a reference to a subroutine
+that is responsible for drawing each new page, an interval delay, and
+an optional subroutine for drawing the last page.  Other optional
+parameters include most of those recognized by the CGI header()
+method.
+
+You may call do_push() in the object oriented manner or not, as you
+prefer:
+
+    use CGI::Push;
+    $q = new CGI::Push;
+    $q->do_push(-next_page=>\&draw_a_page);
+
+        -or-
+
+    use CGI::Push qw(:standard);
+    do_push(-next_page=>\&draw_a_page);
+
+Parameters are as follows:
+
+=over 4
+
+=item -next_page
+
+    do_push(-next_page=>\&my_draw_routine);
+
+This required parameter points to a reference to a subroutine responsible for
+drawing each new page.  The subroutine should expect two parameters
+consisting of the CGI object and a counter indicating the number
+of times the subroutine has been called.  It should return the
+contents of the page as an B<array> of one or more items to print.  
+It can return a false value (or an empty array) in order to abort the
+redrawing loop and print out the final page (if any)
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return undef if $counter > 100;
+        return start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+You are of course free to refer to create and use global variables
+within your draw routine in order to achieve special effects.
+
+=item -last_page
+
+This optional parameter points to a reference to the subroutine
+responsible for drawing the last page of the series.  It is called
+after the -next_page routine returns a false value.  The subroutine
+itself should have exactly the same calling conventions as the
+-next_page routine.
+
+=item -type
+
+This optional parameter indicates the content type of each page.  It
+defaults to "text/html".  Normally the module assumes that each page
+is of a homogenous MIME type.  However if you provide either of the
+magic values "heterogeneous" or "dynamic" (the latter provided for the
+convenience of those who hate long parameter names), you can specify
+the MIME type -- and other header fields -- on a per-page basis.  See 
+"heterogeneous pages" for more details.
+
+=item -delay
+
+This indicates the delay, in seconds, between frames.  Smaller delays
+refresh the page faster.  Fractional values are allowed.
+
+B<If not specified, -delay will default to 1 second>
+
+=item -cookie, -target, -expires
+
+These have the same meaning as the like-named parameters in
+CGI::header().
+
+=back
+
+=head2 Heterogeneous Pages
+
+Ordinarily all pages displayed by CGI::Push share a common MIME type.
+However by providing a value of "heterogeneous" or "dynamic" in the
+do_push() -type parameter, you can specify the MIME type of each page
+on a case-by-case basis.  
+
+If you use this option, you will be responsible for producing the
+HTTP header for each page.  Simply modify your draw routine to
+look like this:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+You can add any header fields that you like, but some (cookies and
+status fields included) may not be interpreted by the browser.  One
+interesting effect is to display a series of pages, then, after the
+last page, to redirect the browser to a new URL.  Because redirect() 
+does b<not> work, the easiest way is with a -refresh header field,
+as shown below:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+	return undef if $counter > 10;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+   
+    sub my_last_page {
+	header(-refresh=>'5; URL=http://somewhere.else/finished.html',
+	       -type=>'text/html'),
+        start_html('Moved'),
+        h1('This is the last page'),
+	'Goodbye!'
+         hr,	
+         end_html; 
+    }
+
+=head2 Changing the Page Delay on the Fly
+
+If you would like to control the delay between pages on a page-by-page
+basis, call push_delay() from within your draw routine.  push_delay()
+takes a single numeric argument representing the number of seconds you
+wish to delay after the current page is displayed and before
+displaying the next one.  The delay may be fractional.  Without
+parameters, push_delay() just returns the current delay.
+
+=head1 INSTALLING CGI::Push SCRIPTS
+
+Server push scripts B<must> be installed as no-parsed-header (NPH)
+scripts in order to work correctly.  On Unix systems, this is most
+often accomplished by prefixing the script's name with "nph-".  
+Recognition of NPH scripts happens automatically with WebSTAR and 
+Microsoft IIS.  Users of other servers should see their documentation
+for help.
+
+=head1 CAVEATS
+
+This is a new module.  It hasn't been extensively tested.
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+
+=cut
+
diff --git a/contrib/perl5/lib/CGI/Switch.pm b/contrib/perl5/lib/CGI/Switch.pm
new file mode 100644
index 000000000000..8afc6a6cb347
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Switch.pm
@@ -0,0 +1,71 @@
+package CGI::Switch;
+use Carp;
+use strict;
+use vars qw($VERSION @Pref);
+$VERSION = '0.06';
+@Pref = qw(CGI::Apache CGI); #default
+
+sub import {
+    my($self,@arg) = @_;
+    @Pref = @arg if @arg;
+}
+
+sub new {
+    shift;
+    my($file,$pack);
+    for $pack (@Pref) {
+	($file = $pack) =~ s|::|/|g;
+	eval { require "$file.pm"; };
+	if ($@) {
+#XXX	    warn $@;
+	    next;
+	} else {
+#XXX	    warn "Going to try $pack\->new\n";
+	    my $obj;
+	    eval {$obj = $pack->new(@_)};
+	    if ($@) {
+#XXX		warn $@;
+	    } else {
+		return $obj;
+	    }
+	}
+    }
+    Carp::croak "Couldn't load+construct any of @Pref\n";
+}
+
+1;
+__END__
+
+=head1 NAME
+
+CGI::Switch - Try more than one constructors and return the first object available
+
+=head1 SYNOPSIS
+
+ 
+ use CGISwitch;
+
+  -or-
+
+ use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI;
+
+ my $q = new CGI::Switch;
+
+=head1 DESCRIPTION
+
+Per default the new() method tries to call new() in the three packages
+Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it
+succeeds with.
+
+The import method allows you to set up the default order of the
+modules to be tested.
+
+=head1 SEE ALSO
+
+perl(1), Apache(3), CGI(3), CGI::XA(3)
+
+=head1 AUTHOR
+
+Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>
+
+=cut
diff --git a/contrib/perl5/lib/CPAN.pm b/contrib/perl5/lib/CPAN.pm
new file mode 100644
index 000000000000..b510ea2082da
--- /dev/null
+++ b/contrib/perl5/lib/CPAN.pm
@@ -0,0 +1,4368 @@
+package CPAN;
+use vars qw{$Try_autoload $Revision
+	    $META $Signal $Cwd $End
+	    $Suppress_readline %Dontload
+	    $Frontend  $Defaultsite
+	   };
+
+$VERSION = '1.3901';
+
+# $Id: CPAN.pm,v 1.226 1998/07/08 22:29:29 k Exp k $
+
+# only used during development:
+$Revision = "";
+# $Revision = "[".substr(q$Revision: 1.226 $, 10)."]";
+
+use Carp ();
+use Config ();
+use Cwd ();
+use DirHandle;
+use Exporter ();
+use ExtUtils::MakeMaker ();
+use File::Basename ();
+use File::Copy ();
+use File::Find;
+use File::Path ();
+use FileHandle ();
+use Safe ();
+use Text::ParseWords ();
+use Text::Wrap;
+
+END { $End++; &cleanup; }
+
+%CPAN::DEBUG = qw(
+		  CPAN              1
+		  Index             2
+		  InfoObj           4
+		  Author            8
+		  Distribution     16
+		  Bundle           32
+		  Module           64
+		  CacheMgr        128
+		  Complete        256
+		  FTP             512
+		  Shell          1024
+		  Eval           2048
+		  Config         4096
+		  Tarzip         8192
+		 );
+
+$CPAN::DEBUG ||= 0;
+$CPAN::Signal ||= 0;
+$CPAN::Frontend ||= "CPAN::Shell";
+$CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
+
+package CPAN;
+use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
+use strict qw(vars);
+
+@CPAN::ISA = qw(CPAN::Debug Exporter MM); # MM will go away
+                                          # soonish. Already version
+                                          # 1.29 doesn't rely on
+                                          # catfile and catdir being
+                                          # available via
+                                          # inheritance. Anything else
+                                          # in danger?
+
+@EXPORT = qw(
+	     autobundle bundle expand force get
+	     install make readme recompile shell test clean
+	    );
+
+#-> sub CPAN::AUTOLOAD ;
+sub AUTOLOAD {
+    my($l) = $AUTOLOAD;
+    $l =~ s/.*:://;
+    my(%EXPORT);
+    @EXPORT{@EXPORT} = '';
+    if (exists $EXPORT{$l}){
+	CPAN::Shell->$l(@_);
+    } else {
+	my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
+	if ($ok) {
+	    goto &$AUTOLOAD;
+#	} else {
+#	    $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
+	}
+	$CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
+				qq{Type ? for help.
+});
+    }
+}
+
+#-> sub CPAN::shell ;
+sub shell {
+    $Suppress_readline ||= ! -t STDIN;
+
+    my $prompt = "cpan> ";
+    local($^W) = 1;
+    unless ($Suppress_readline) {
+	require Term::ReadLine;
+#	import Term::ReadLine;
+	$term = Term::ReadLine->new('CPAN Monitor');
+	$readline::rl_completion_function =
+	    $readline::rl_completion_function = 'CPAN::Complete::cpl';
+    }
+
+    no strict;
+    $META->checklock();
+    my $getcwd;
+    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $cwd = CPAN->$getcwd();
+    my $rl_avail = $Suppress_readline ? "suppressed" :
+	($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
+	    "available (try ``install Bundle::CPAN'')";
+
+    $CPAN::Frontend->myprint(
+			     qq{
+cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
+ReadLine support $rl_avail
+
+}) unless $CPAN::Config->{'inhibit_startup_message'} ;
+    my($continuation) = "";
+    while () {
+	if ($Suppress_readline) {
+	    print $prompt;
+	    last unless defined ($_ = <> );
+	    chomp;
+	} else {
+	    last unless defined ($_ = $term->readline($prompt));
+	}
+	$_ = "$continuation$_" if $continuation;
+	s/^\s+//;
+	next if /^$/;
+	$_ = 'h' if $_ eq '?';
+	if (/^(?:q(?:uit)?|bye|exit)$/i) {
+	    last;
+	} elsif (s/\\$//s) {
+	    chomp;
+	    $continuation = $_;
+	    $prompt = "    > ";
+	} elsif (/^\!/) {
+	    s/^\!//;
+	    my($eval) = $_;
+	    package CPAN::Eval;
+	    use vars qw($import_done);
+	    CPAN->import(':DEFAULT') unless $import_done++;
+	    CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
+	    eval($eval);
+	    warn $@ if $@;
+	    $continuation = "";
+	    $prompt = "cpan> ";
+	} elsif (/./) {
+	    my(@line);
+	    if ($] < 5.00322) { # parsewords had a bug until recently
+		@line = split;
+	    } else {
+		eval { @line = Text::ParseWords::shellwords($_) };
+		warn($@), next if $@;
+	    }
+	    $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
+	    my $command = shift @line;
+	    eval { CPAN::Shell->$command(@line) };
+	    warn $@ if $@;
+	    chdir $cwd;
+	    $CPAN::Frontend->myprint("\n");
+	    $continuation = "";
+	    $prompt = "cpan> ";
+	}
+    } continue {
+      $Signal=0;
+    }
+}
+
+package CPAN::CacheMgr;
+@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
+use File::Find;
+
+package CPAN::Config;
+import ExtUtils::MakeMaker 'neatvalue';
+use vars qw(%can $dot_cpan);
+
+%can = (
+  'commit' => "Commit changes to disk",
+  'defaults' => "Reload defaults from disk",
+  'init'   => "Interactive setting of all options",
+);
+
+package CPAN::FTP;
+use vars qw($Ua $Thesite $Themethod);
+@CPAN::FTP::ISA = qw(CPAN::Debug);
+
+package CPAN::Complete;
+@CPAN::Complete::ISA = qw(CPAN::Debug);
+
+package CPAN::Index;
+use vars qw($last_time $date_of_03);
+@CPAN::Index::ISA = qw(CPAN::Debug);
+$last_time ||= 0;
+$date_of_03 ||= 0;
+
+package CPAN::InfoObj;
+@CPAN::InfoObj::ISA = qw(CPAN::Debug);
+
+package CPAN::Author;
+@CPAN::Author::ISA = qw(CPAN::InfoObj);
+
+package CPAN::Distribution;
+@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
+
+package CPAN::Bundle;
+@CPAN::Bundle::ISA = qw(CPAN::Module);
+
+package CPAN::Module;
+@CPAN::Module::ISA = qw(CPAN::InfoObj);
+
+package CPAN::Shell;
+use vars qw($AUTOLOAD $redef @ISA);
+@CPAN::Shell::ISA = qw(CPAN::Debug);
+
+#-> sub CPAN::Shell::AUTOLOAD ;
+sub AUTOLOAD {
+    my($autoload) = $AUTOLOAD;
+    my $class = shift(@_);
+    # warn "autoload[$autoload] class[$class]";
+    $autoload =~ s/.*:://;
+    if ($autoload =~ /^w/) {
+	if ($CPAN::META->has_inst('CPAN::WAIT')) {
+	    CPAN::WAIT->$autoload(@_);
+	} else {
+	    $CPAN::Frontend->mywarn(qq{
+Commands starting with "w" require CPAN::WAIT to be installed.
+Please consider installing CPAN::WAIT to use the fulltext index.
+For this you just need to type 
+    install CPAN::WAIT
+});
+	}
+    } else {
+	my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
+	if ($ok) {
+	    goto &$AUTOLOAD;
+#	} else {
+#	    $CPAN::Frontend->mywarn("Could not autoload $autoload");
+	}
+	$CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
+				qq{Type ? for help.
+});
+    }
+}
+
+#-> CPAN::Shell::try_dot_al
+sub try_dot_al {
+    my($class,$autoload) = @_;
+    return unless $CPAN::Try_autoload;
+    # I don't see how to re-use that from the AutoLoader...
+    my($name,$ok);
+    # Braces used to preserve $1 et al.
+    {
+	my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/;
+	$pkg =~ s|::|/|g;
+	if (defined($name=$INC{"$pkg.pm"}))
+	    {
+		$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
+		$name = undef unless (-r $name); 
+	    }
+	unless (defined $name)
+	    {
+		$name = "auto/$autoload.al";
+		$name =~ s|::|/|g;
+	    }
+    }
+    my $save = $@;
+    eval {local $SIG{__DIE__};require $name};
+    if ($@) {
+	if (substr($autoload,-9) eq '::DESTROY') {
+	    *$autoload = sub {};
+	    $ok = 1;
+	} else {
+	    if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+		eval {local $SIG{__DIE__};require $name};
+	    }
+	    if ($@){
+		$@ =~ s/ at .*\n//;
+		Carp::croak $@;
+	    } else {
+		$ok = 1;
+	    }
+	}
+    } else {
+	$ok = 1;
+    }
+    $@ = $save;
+#    my $lm = Carp::longmess();
+#    warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
+    return $ok;
+}
+
+#### autoloader is experimental
+#### to try it we have to set $Try_autoload and uncomment
+#### the use statement and uncomment the __END__ below
+#### You also need AutoSplit 1.01 available. MakeMaker will
+#### then build CPAN with all the AutoLoad stuff.
+# use AutoLoader;
+# $Try_autoload = 1;
+
+if ($CPAN::Try_autoload) {
+    my $p;
+    for $p (qw(
+	       CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
+	       CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
+	       CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
+		 )) {
+	*{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD;
+    }
+}
+
+package CPAN::Tarzip;
+use vars qw($AUTOLOAD @ISA);
+@CPAN::Tarzip::ISA = qw(CPAN::Debug);
+
+package CPAN::Queue;
+# currently only used to determine if we should or shouldn't announce
+# the availability of a new CPAN module
+sub new {
+  my($class,$mod) = @_;
+  # warn "Queue object for mod[$mod]";
+  bless {mod => $mod}, $class;
+}
+
+package CPAN;
+
+$META ||= CPAN->new;                 # In case we reeval ourselves we
+                                    # need a ||
+
+# Do this after you have set up the whole inheritance
+CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
+
+1;
+
+# __END__ # uncomment this and AutoSplit version 1.01 will split it
+
+#-> sub CPAN::autobundle ;
+sub autobundle;
+#-> sub CPAN::bundle ;
+sub bundle;
+#-> sub CPAN::expand ;
+sub expand;
+#-> sub CPAN::force ;
+sub force;
+#-> sub CPAN::install ;
+sub install;
+#-> sub CPAN::make ;
+sub make;
+#-> sub CPAN::clean ;
+sub clean;
+#-> sub CPAN::test ;
+sub test;
+
+#-> sub CPAN::all ;
+sub all {
+    my($mgr,$class) = @_;
+    CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
+    CPAN::Index->reload;
+    values %{ $META->{$class} };
+}
+
+# Called by shell, not in batch mode. Not clean XXX
+#-> sub CPAN::checklock ;
+sub checklock {
+    my($self) = @_;
+    my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
+    if (-f $lockfile && -M _ > 0) {
+	my $fh = FileHandle->new($lockfile);
+	my $other = <$fh>;
+	$fh->close;
+	if (defined $other && $other) {
+	    chomp $other;
+	    return if $$==$other; # should never happen
+	    $CPAN::Frontend->mywarn(
+				    qq{
+There seems to be running another CPAN process ($other). Contacting...
+});
+	    if (kill 0, $other) {
+		$CPAN::Frontend->mydie(qq{Other job is running.
+You may want to kill it and delete the lockfile, maybe. On UNIX try:
+    kill $other
+    rm $lockfile
+});
+	    } elsif (-w $lockfile) {
+		my($ans) =
+		    ExtUtils::MakeMaker::prompt
+			(qq{Other job not responding. Shall I overwrite }.
+			 qq{the lockfile? (Y/N)},"y");
+		$CPAN::Frontend->myexit("Ok, bye\n")
+		    unless $ans =~ /^y/i;
+	    } else {
+		Carp::croak(
+			    qq{Lockfile $lockfile not writeable by you. }.
+			    qq{Cannot proceed.\n}.
+			    qq{    On UNIX try:\n}.
+			    qq{    rm $lockfile\n}.
+			    qq{  and then rerun us.\n}
+			   );
+	    }
+	}
+    }
+    File::Path::mkpath($CPAN::Config->{cpan_home});
+    my $fh;
+    unless ($fh = FileHandle->new(">$lockfile")) {
+	if ($! =~ /Permission/) {
+	    my $incc = $INC{'CPAN/Config.pm'};
+	    my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
+	    $CPAN::Frontend->myprint(qq{
+
+Your configuration suggests that CPAN.pm should use a working
+directory of
+    $CPAN::Config->{cpan_home}
+Unfortunately we could not create the lock file
+    $lockfile
+due to permission problems.
+
+Please make sure that the configuration variable
+    \$CPAN::Config->{cpan_home}
+points to a directory where you can write a .lock file. You can set
+this variable in either
+    $incc
+or
+    $myincc
+
+});
+	}
+	$CPAN::Frontend->mydie("Could not open >$lockfile: $!");
+    }
+    $fh->print($$, "\n");
+    $self->{LOCK} = $lockfile;
+    $fh->close;
+    $SIG{'TERM'} = sub {
+	&cleanup;
+	$CPAN::Frontend->mydie("Got SIGTERM, leaving");
+    };
+    $SIG{'INT'} = sub {
+      # no blocks!!!
+      &cleanup if $Signal;
+      $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
+      print "Caught SIGINT\n";
+      $Signal++;
+    };
+    $SIG{'__DIE__'} = \&cleanup;
+    $self->debug("Signal handler set.") if $CPAN::DEBUG;
+}
+
+#-> sub CPAN::DESTROY ;
+sub DESTROY {
+    &cleanup; # need an eval?
+}
+
+#-> sub CPAN::cwd ;
+sub cwd {Cwd::cwd();}
+
+#-> sub CPAN::getcwd ;
+sub getcwd {Cwd::getcwd();}
+
+#-> sub CPAN::exists ;
+sub exists {
+    my($mgr,$class,$id) = @_;
+    CPAN::Index->reload;
+    ### Carp::croak "exists called without class argument" unless $class;
+    $id ||= "";
+    exists $META->{$class}{$id};
+}
+
+#-> sub CPAN::delete ;
+sub delete {
+  my($mgr,$class,$id) = @_;
+  delete $META->{$class}{$id};
+}
+
+#-> sub CPAN::has_inst
+sub has_inst {
+    my($self,$mod,$message) = @_;
+    Carp::croak("CPAN->has_inst() called without an argument")
+	unless defined $mod;
+    if (defined $message && $message eq "no") {
+	$Dontload{$mod}||=1;
+	return 0;
+    } elsif (exists $Dontload{$mod}) {
+	return 0;
+    }
+    my $file = $mod;
+    my $obj;
+    $file =~ s|::|/|g;
+    $file =~ s|/|\\|g if $^O eq 'MSWin32';
+    $file .= ".pm";
+    if ($INC{$file}) {
+#	warn "$file in %INC"; #debug
+	return 1;
+    } elsif (eval { require $file }) {
+	# eval is good: if we haven't yet read the database it's
+	# perfect and if we have installed the module in the meantime,
+	# it tries again. The second require is only a NOOP returning
+	# 1 if we had success, otherwise it's retrying
+	$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
+	if ($mod eq "CPAN::WAIT") {
+	    push @CPAN::Shell::ISA, CPAN::WAIT;
+	}
+	return 1;
+    } elsif ($mod eq "Net::FTP") {
+	warn qq{
+  Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
+  if you just type
+      install Bundle::libnet
+
+};
+	sleep 2;
+    } elsif ($mod eq "MD5"){
+	$CPAN::Frontend->myprint(qq{
+  CPAN: MD5 security checks disabled because MD5 not installed.
+  Please consider installing the MD5 module.
+
+});
+	sleep 2;
+    }
+    return 0;
+}
+
+#-> sub CPAN::instance ;
+sub instance {
+    my($mgr,$class,$id) = @_;
+    CPAN::Index->reload;
+    $id ||= "";
+    $META->{$class}{$id} ||= $class->new(ID => $id );
+}
+
+#-> sub CPAN::new ;
+sub new {
+    bless {}, shift;
+}
+
+#-> sub CPAN::cleanup ;
+sub cleanup {
+    local $SIG{__DIE__} = '';
+    my $i = 0; my $ineval = 0; my $sub;
+    while ((undef,undef,undef,$sub) = caller(++$i)) {
+      $ineval = 1, last if $sub eq '(eval)';
+    }
+    return if $ineval && !$End;
+    return unless defined $META->{'LOCK'};
+    return unless -f $META->{'LOCK'};
+    unlink $META->{'LOCK'};
+    $CPAN::Frontend->mywarn("Lockfile removed.\n");
+}
+
+package CPAN::CacheMgr;
+
+#-> sub CPAN::CacheMgr::as_string ;
+sub as_string {
+    eval { require Data::Dumper };
+    if ($@) {
+	return shift->SUPER::as_string;
+    } else {
+	return Data::Dumper::Dumper(shift);
+    }
+}
+
+#-> sub CPAN::CacheMgr::cachesize ;
+sub cachesize {
+    shift->{DU};
+}
+
+sub tidyup {
+  my($self) = @_;
+  return unless -d $self->{ID};
+  while ($self->{DU} > $self->{'MAX'} ) {
+    my($toremove) = shift @{$self->{FIFO}};
+    $CPAN::Frontend->myprint(sprintf(
+				     "Deleting from cache".
+				     ": $toremove (%.1f>%.1f MB)\n",
+				     $self->{DU}, $self->{'MAX'})
+			    );
+    return if $CPAN::Signal;
+    $self->force_clean_cache($toremove);
+    return if $CPAN::Signal;
+  }
+}
+
+#-> sub CPAN::CacheMgr::dir ;
+sub dir {
+    shift->{ID};
+}
+
+#-> sub CPAN::CacheMgr::entries ;
+sub entries {
+    my($self,$dir) = @_;
+    return unless defined $dir;
+    $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
+    $dir ||= $self->{ID};
+    my $getcwd;
+    $getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
+    my($cwd) = CPAN->$getcwd();
+    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
+    my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
+    my(@entries);
+    for ($dh->read) {
+	next if $_ eq "." || $_ eq "..";
+	if (-f $_) {
+	    push @entries, MM->catfile($dir,$_);
+	} elsif (-d _) {
+	    push @entries, MM->catdir($dir,$_);
+	} else {
+	    $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
+	}
+    }
+    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
+    sort { -M $b <=> -M $a} @entries;
+}
+
+#-> sub CPAN::CacheMgr::disk_usage ;
+sub disk_usage {
+    my($self,$dir) = @_;
+    return if exists $self->{SIZE}{$dir};
+    return if $CPAN::Signal;
+    my($Du) = 0;
+    find(
+	 sub {
+	     $File::Find::prune++ if $CPAN::Signal;
+	     return if -l $_;
+	     $Du += -s _;
+	 },
+	 $dir
+	);
+    return if $CPAN::Signal;
+    $self->{SIZE}{$dir} = $Du/1024/1024;
+    push @{$self->{FIFO}}, $dir;
+    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
+    $self->{DU} += $Du/1024/1024;
+    $self->{DU};
+}
+
+#-> sub CPAN::CacheMgr::force_clean_cache ;
+sub force_clean_cache {
+    my($self,$dir) = @_;
+    return unless -e $dir;
+    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
+	if $CPAN::DEBUG;
+    File::Path::rmtree($dir);
+    $self->{DU} -= $self->{SIZE}{$dir};
+    delete $self->{SIZE}{$dir};
+}
+
+#-> sub CPAN::CacheMgr::new ;
+sub new {
+    my $class = shift;
+    my $time = time;
+    my($debug,$t2);
+    $debug = "";
+    my $self = {
+		ID => $CPAN::Config->{'build_dir'},
+		MAX => $CPAN::Config->{'build_cache'},
+		DU => 0
+	       };
+    File::Path::mkpath($self->{ID});
+    my $dh = DirHandle->new($self->{ID});
+    bless $self, $class;
+    my $e;
+    $CPAN::Frontend->myprint(
+			     sprintf("Scanning cache %s for sizes\n",
+				     $self->{ID}));
+    for $e ($self->entries($self->{ID})) {
+	next if $e eq ".." || $e eq ".";
+	$self->disk_usage($e);
+	return if $CPAN::Signal;
+    }
+    $self->tidyup;
+    $t2 = time;
+    $debug .= "timing of CacheMgr->new: ".($t2 - $time);
+    $time = $t2;
+    CPAN->debug($debug) if $CPAN::DEBUG;
+    $self;
+}
+
+package CPAN::Debug;
+
+#-> sub CPAN::Debug::debug ;
+sub debug {
+    my($self,$arg) = @_;
+    my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
+                                               # Complete, caller(1)
+                                               # eg readline
+    ($caller) = caller(0);
+    $caller =~ s/.*:://;
+    $arg = "" unless defined $arg;
+    my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
+    if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
+	if ($arg and ref $arg) {
+	    eval { require Data::Dumper };
+	    if ($@) {
+		$CPAN::Frontend->myprint($arg->as_string);
+	    } else {
+		$CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
+	    }
+	} else {
+	    $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
+	}
+    }
+}
+
+package CPAN::Config;
+
+#-> sub CPAN::Config::edit ;
+sub edit {
+    my($class,@args) = @_;
+    return unless @args;
+    CPAN->debug("class[$class]args[".join(" | ",@args)."]");
+    my($o,$str,$func,$args,$key_exists);
+    $o = shift @args;
+    if($can{$o}) {
+	$class->$o(@args);
+	return 1;
+    } else {
+	if (ref($CPAN::Config->{$o}) eq ARRAY) {
+	    $func = shift @args;
+	    $func ||= "";
+	    # Let's avoid eval, it's easier to comprehend without.
+	    if ($func eq "push") {
+		push @{$CPAN::Config->{$o}}, @args;
+	    } elsif ($func eq "pop") {
+		pop @{$CPAN::Config->{$o}};
+	    } elsif ($func eq "shift") {
+		shift @{$CPAN::Config->{$o}};
+	    } elsif ($func eq "unshift") {
+		unshift @{$CPAN::Config->{$o}}, @args;
+	    } elsif ($func eq "splice") {
+		splice @{$CPAN::Config->{$o}}, @args;
+	    } elsif (@args) {
+		$CPAN::Config->{$o} = [@args];
+	    } else {
+		$CPAN::Frontend->myprint(
+					 join "",
+					 "  $o  ",
+					 ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
+					 "\n"
+		     );
+	    }
+	} else {
+	    $CPAN::Config->{$o} = $args[0] if defined $args[0];
+	    $CPAN::Frontend->myprint("    $o    " .
+				     (defined $CPAN::Config->{$o} ?
+				      $CPAN::Config->{$o} : "UNDEFINED"));
+	}
+    }
+}
+
+#-> sub CPAN::Config::commit ;
+sub commit {
+    my($self,$configpm) = @_;
+    unless (defined $configpm){
+	$configpm ||= $INC{"CPAN/MyConfig.pm"};
+	$configpm ||= $INC{"CPAN/Config.pm"};
+	$configpm || Carp::confess(qq{
+CPAN::Config::commit called without an argument.
+Please specify a filename where to save the configuration or try
+"o conf init" to have an interactive course through configing.
+});
+    }
+    my($mode);
+    if (-f $configpm) {
+	$mode = (stat $configpm)[2];
+	if ($mode && ! -w _) {
+	    Carp::confess("$configpm is not writable");
+	}
+    }
+
+    my $msg = <<EOF unless $configpm =~ /MyConfig/;
+
+# This is CPAN.pm's systemwide configuration file. This file provides
+# defaults for users, and the values can be changed in a per-user
+# configuration file. The user-config file is being looked for as
+# ~/.cpan/CPAN/MyConfig.pm.
+
+EOF
+    $msg ||= "\n";
+    my($fh) = FileHandle->new;
+    open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
+    $fh->print(qq[$msg\$CPAN::Config = \{\n]);
+    foreach (sort keys %$CPAN::Config) {
+	$fh->print(
+		   "  '$_' => ",
+		   ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
+		   ",\n"
+		  );
+    }
+
+    $fh->print("};\n1;\n__END__\n");
+    close $fh;
+
+    #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+    #chmod $mode, $configpm;
+###why was that so?    $self->defaults;
+    $CPAN::Frontend->myprint("commit: wrote $configpm\n");
+    1;
+}
+
+*default = \&defaults;
+#-> sub CPAN::Config::defaults ;
+sub defaults {
+    my($self) = @_;
+    $self->unload;
+    $self->load;
+    1;
+}
+
+sub init {
+    my($self) = @_;
+    undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
+                                                      # have the least
+                                                      # important
+                                                      # variable
+                                                      # undefined
+    $self->load;
+    1;
+}
+
+#-> sub CPAN::Config::load ;
+sub load {
+    my($self) = shift;
+    my(@miss);
+    eval {require CPAN::Config;};       # We eval because of some
+                                        # MakeMaker problems
+    unless ($dot_cpan++){
+      unshift @INC, MM->catdir($ENV{HOME},".cpan");
+      eval {require CPAN::MyConfig;};   # where you can override
+                                        # system wide settings
+      shift @INC;
+    }
+    return unless @miss = $self->not_loaded;
+    # XXX better check for arrayrefs too
+    require CPAN::FirstTime;
+    my($configpm,$fh,$redo,$theycalled);
+    $redo ||= "";
+    $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
+    if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
+	$configpm = $INC{"CPAN/Config.pm"};
+	$redo++;
+    } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
+	$configpm = $INC{"CPAN/MyConfig.pm"};
+	$redo++;
+    } else {
+	my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
+	my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
+	my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
+	if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
+	    if (-w $configpmtest) {
+		$configpm = $configpmtest;
+	    } elsif (-w $configpmdir) {
+		#_#_# following code dumped core on me with 5.003_11, a.k.
+		unlink "$configpmtest.bak" if -f "$configpmtest.bak";
+		rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
+		my $fh = FileHandle->new;
+		if ($fh->open(">$configpmtest")) {
+		    $fh->print("1;\n");
+		    $configpm = $configpmtest;
+		} else {
+		    # Should never happen
+		    Carp::confess("Cannot open >$configpmtest");
+		}
+	    }
+	}
+	unless ($configpm) {
+	    $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
+	    File::Path::mkpath($configpmdir);
+	    $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
+	    if (-w $configpmtest) {
+		$configpm = $configpmtest;
+	    } elsif (-w $configpmdir) {
+		#_#_# following code dumped core on me with 5.003_11, a.k.
+		my $fh = FileHandle->new;
+		if ($fh->open(">$configpmtest")) {
+		    $fh->print("1;\n");
+		    $configpm = $configpmtest;
+		} else {
+		    # Should never happen
+		    Carp::confess("Cannot open >$configpmtest");
+		}
+	    } else {
+		Carp::confess(qq{WARNING: CPAN.pm is unable to }.
+			      qq{create a configuration file.});
+	    }
+	}
+    }
+    local($") = ", ";
+    $CPAN::Frontend->myprint(qq{
+We have to reconfigure CPAN.pm due to following uninitialized parameters:
+
+@miss
+}) if $redo && ! $theycalled;
+    $CPAN::Frontend->myprint(qq{
+$configpm initialized.
+});
+    sleep 2;
+    CPAN::FirstTime::init($configpm);
+}
+
+#-> sub CPAN::Config::not_loaded ;
+sub not_loaded {
+    my(@miss);
+    for (qw(
+	    cpan_home keep_source_where build_dir build_cache index_expire
+	    gzip tar unzip make pager makepl_arg make_arg make_install_arg
+	    urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
+	   )) {
+	push @miss, $_ unless defined $CPAN::Config->{$_};
+    }
+    return @miss;
+}
+
+#-> sub CPAN::Config::unload ;
+sub unload {
+    delete $INC{'CPAN/MyConfig.pm'};
+    delete $INC{'CPAN/Config.pm'};
+}
+
+*h = \&help;
+#-> sub CPAN::Config::help ;
+sub help {
+    $CPAN::Frontend->myprint(qq{
+Known options:
+  defaults  reload default config values from disk
+  commit    commit session changes to disk
+  init      go through a dialog to set all parameters
+
+You may edit key values in the follow fashion:
+
+  o conf build_cache 15
+
+  o conf build_dir "/foo/bar"
+
+  o conf urllist shift
+
+  o conf urllist unshift ftp://ftp.foo.bar/
+
+});
+    undef; #don't reprint CPAN::Config
+}
+
+#-> sub CPAN::Config::cpl ;
+sub cpl {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@words) = split " ", substr($line,0,$pos+1);
+    if (
+	defined($words[2])
+	and
+	(
+	 $words[2] =~ /list$/ && @words == 3
+	 ||
+	 $words[2] =~ /list$/ && @words == 4 && length($word)
+	)
+       ) {
+	return grep /^\Q$word\E/, qw(splice shift unshift pop push);
+    } elsif (@words >= 4) {
+	return ();
+    }
+    my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
+    return grep /^\Q$word\E/, @o_conf;
+}
+
+package CPAN::Shell;
+
+#-> sub CPAN::Shell::h ;
+sub h {
+    my($class,$about) = @_;
+    if (defined $about) {
+	$CPAN::Frontend->myprint("Detailed help not yet implemented\n");
+    } else {
+	$CPAN::Frontend->myprint(q{
+command   arguments       description
+a         string                  authors
+b         or              display bundles
+d         /regex/         info    distributions
+m         or              about   modules
+i         none                    anything of above
+
+r          as             reinstall recommendations
+u          above          uninstalled distributions
+See manpage for autobundle, recompile, force, look, etc.
+
+make                      make
+test      modules,        make test (implies make)
+install   dists, bundles, make install (implies test)
+clean     "r" or "u"      make clean
+readme                    display the README file
+
+reload    index|cpan    load most recent indices/CPAN.pm
+h or ?                  display this menu
+o         various       set and query options
+!         perl-code     eval a perl command
+q                       quit the shell subroutine
+});
+    }
+}
+
+*help = \&h;
+
+#-> sub CPAN::Shell::a ;
+sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
+#-> sub CPAN::Shell::b ;
+sub b {
+    my($self,@which) = @_;
+    CPAN->debug("which[@which]") if $CPAN::DEBUG;
+    my($incdir,$bdir,$dh);
+    foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
+	$bdir = MM->catdir($incdir,"Bundle");
+	if ($dh = DirHandle->new($bdir)) { # may fail
+	    my($entry);
+	    for $entry ($dh->read) {
+		next if -d MM->catdir($bdir,$entry);
+		next unless $entry =~ s/\.pm$//;
+		$CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
+	    }
+	}
+    }
+    $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
+}
+#-> sub CPAN::Shell::d ;
+sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
+#-> sub CPAN::Shell::m ;
+sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));}
+
+#-> sub CPAN::Shell::i ;
+sub i {
+    my($self) = shift;
+    my(@args) = @_;
+    my(@type,$type,@m);
+    @type = qw/Author Bundle Distribution Module/;
+    @args = '/./' unless @args;
+    my(@result);
+    for $type (@type) {
+	push @result, $self->expand($type,@args);
+    }
+    my $result =  @result == 1 ?
+	$result[0]->as_string :
+	    join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects found of any type for argument @args\n";
+    $CPAN::Frontend->myprint($result);
+}
+
+#-> sub CPAN::Shell::o ;
+sub o {
+    my($self,$o_type,@o_what) = @_;
+    $o_type ||= "";
+    CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
+    if ($o_type eq 'conf') {
+	shift @o_what if @o_what && $o_what[0] eq 'help';
+	if (!@o_what) {
+	    my($k,$v);
+	    $CPAN::Frontend->myprint("CPAN::Config options");
+	    if (exists $INC{'CPAN/Config.pm'}) {
+	      $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
+	    }
+	    if (exists $INC{'CPAN/MyConfig.pm'}) {
+	      $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
+	    }
+	    $CPAN::Frontend->myprint(":\n");
+	    for $k (sort keys %CPAN::Config::can) {
+		$v = $CPAN::Config::can{$k};
+		$CPAN::Frontend->myprint(sprintf "    %-18s %s\n", $k, $v);
+	    }
+	    $CPAN::Frontend->myprint("\n");
+	    for $k (sort keys %$CPAN::Config) {
+		$v = $CPAN::Config->{$k};
+		if (ref $v) {
+		    $CPAN::Frontend->myprint(
+					     join(
+						  "",
+						  sprintf(
+							  "    %-18s\n",
+							  $k
+							 ),
+						  map {"\t$_\n"} @{$v}
+						 )
+					    );
+		} else {
+		    $CPAN::Frontend->myprint(sprintf "    %-18s %s\n", $k, $v);
+		}
+	    }
+	    $CPAN::Frontend->myprint("\n");
+	} elsif (!CPAN::Config->edit(@o_what)) {
+	    $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
+	}
+    } elsif ($o_type eq 'debug') {
+	my(%valid);
+	@o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
+	if (@o_what) {
+	    while (@o_what) {
+		my($what) = shift @o_what;
+		if ( exists $CPAN::DEBUG{$what} ) {
+		    $CPAN::DEBUG |= $CPAN::DEBUG{$what};
+		} elsif ($what =~ /^\d/) {
+		    $CPAN::DEBUG = $what;
+		} elsif (lc $what eq 'all') {
+		    my($max) = 0;
+		    for (values %CPAN::DEBUG) {
+			$max += $_;
+		    }
+		    $CPAN::DEBUG = $max;
+		} else {
+		    my($known) = 0;
+		    for (keys %CPAN::DEBUG) {
+			next unless lc($_) eq lc($what);
+			$CPAN::DEBUG |= $CPAN::DEBUG{$_};
+			$known = 1;
+		    }
+		    $CPAN::Frontend->myprint("unknown argument [$what]\n")
+			unless $known;
+		}
+	    }
+	} else {
+	    $CPAN::Frontend->myprint("Valid options for debug are ".
+				     join(", ",sort(keys %CPAN::DEBUG), 'all').
+		    qq{ or a number. Completion works on the options. }.
+			qq{Case is ignored.\n\n});
+	}
+	if ($CPAN::DEBUG) {
+	    $CPAN::Frontend->myprint("Options set for debugging:\n");
+	    my($k,$v);
+	    for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
+		$v = $CPAN::DEBUG{$k};
+		$CPAN::Frontend->myprint(sprintf "    %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
+	    }
+	} else {
+	    $CPAN::Frontend->myprint("Debugging turned off completely.\n");
+	}
+    } else {
+	$CPAN::Frontend->myprint(qq{
+Known options:
+  conf    set or get configuration variables
+  debug   set or get debugging options
+});
+    }
+}
+
+#-> sub CPAN::Shell::reload ;
+sub reload {
+    my($self,$command,@arg) = @_;
+    $command ||= "";
+    $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
+    if ($command =~ /cpan/i) {
+	CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
+	my $fh = FileHandle->new($INC{'CPAN.pm'});
+	local($/);
+	undef $/;
+	$redef = 0;
+	local($SIG{__WARN__})
+	    = sub {
+		if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
+		    ++$redef;
+		    local($|) = 1;
+		    $CPAN::Frontend->myprint(".");
+		    return;
+		}
+		warn @_;
+	    };
+	eval <$fh>;
+	warn $@ if $@;
+	$CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+    } elsif ($command =~ /index/) {
+	CPAN::Index->force_reload;
+    } else {
+	$CPAN::Frontend->myprint(qq{cpan     re-evals the CPAN.pm file
+index    re-reads the index files
+});
+    }
+}
+
+#-> sub CPAN::Shell::_binary_extensions ;
+sub _binary_extensions {
+    my($self) = shift @_;
+    my(@result,$module,%seen,%need,$headerdone);
+    my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
+    for $module ($self->expand('Module','/./')) {
+	my $file  = $module->cpan_file;
+	next if $file eq "N/A";
+	next if $file =~ /^Contact Author/;
+	next if $file =~ / $isaperl /xo;
+	next unless $module->xs_file;
+	local($|) = 1;
+	$CPAN::Frontend->myprint(".");
+	push @result, $module;
+    }
+#    print join " | ", @result;
+    $CPAN::Frontend->myprint("\n");
+    return @result;
+}
+
+#-> sub CPAN::Shell::recompile ;
+sub recompile {
+    my($self) = shift @_;
+    my($module,@module,$cpan_file,%dist);
+    @module = $self->_binary_extensions();
+    for $module (@module){  # we force now and compile later, so we
+                            # don't do it twice
+	$cpan_file = $module->cpan_file;
+	my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+	$pack->force;
+	$dist{$cpan_file}++;
+    }
+    for $cpan_file (sort keys %dist) {
+	$CPAN::Frontend->myprint("  CPAN: Recompiling $cpan_file\n\n");
+	my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+	$pack->install;
+	$CPAN::Signal = 0; # it's tempting to reset Signal, so we can
+                           # stop a package from recompiling,
+                           # e.g. IO-1.12 when we have perl5.003_10
+    }
+}
+
+#-> sub CPAN::Shell::_u_r_common ;
+sub _u_r_common {
+    my($self) = shift @_;
+    my($what) = shift @_;
+    CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
+    Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
+    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
+    my(@args) = @_;
+    @args = '/./' unless @args;
+    my(@result,$module,%seen,%need,$headerdone,
+       $version_undefs,$version_zeroes);
+    $version_undefs = $version_zeroes = 0;
+    my $sprintf = "%-25s %9s %9s  %s\n";
+    for $module ($self->expand('Module',@args)) {
+	my $file  = $module->cpan_file;
+	next unless defined $file; # ??
+	my($latest) = $module->cpan_version;
+	my($inst_file) = $module->inst_file;
+	my($have);
+	return if $CPAN::Signal;
+	if ($inst_file){
+	    if ($what eq "a") {
+		$have = $module->inst_version;
+	    } elsif ($what eq "r") {
+		$have = $module->inst_version;
+		local($^W) = 0;
+		if ($have eq "undef"){
+		    $version_undefs++;
+		} elsif ($have == 0){
+		    $version_zeroes++;
+		}
+		next if $have >= $latest;
+# to be pedantic we should probably say:
+#    && !($have eq "undef" && $latest ne "undef" && $latest gt "");
+# to catch the case where CPAN has a version 0 and we have a version undef
+	    } elsif ($what eq "u") {
+		next;
+	    }
+	} else {
+	    if ($what eq "a") {
+		next;
+	    } elsif ($what eq "r") {
+		next;
+	    } elsif ($what eq "u") {
+		$have = "-";
+	    }
+	}
+	return if $CPAN::Signal; # this is sometimes lengthy
+	$seen{$file} ||= 0;
+	if ($what eq "a") {
+	    push @result, sprintf "%s %s\n", $module->id, $have;
+	} elsif ($what eq "r") {
+	    push @result, $module->id;
+	    next if $seen{$file}++;
+	} elsif ($what eq "u") {
+	    push @result, $module->id;
+	    next if $seen{$file}++;
+	    next if $file =~ /^Contact/;
+	}
+	unless ($headerdone++){
+	    $CPAN::Frontend->myprint("\n");
+	    $CPAN::Frontend->myprint(sprintf(
+		   $sprintf,
+		   "Package namespace",
+		   "installed",
+		   "latest",
+		   "in CPAN file"
+		   ));
+	}
+	$latest = substr($latest,0,8) if length($latest) > 8;
+	$have = substr($have,0,8) if length($have) > 8;
+	$CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
+	$need{$module->id}++;
+    }
+    unless (%need) {
+	if ($what eq "u") {
+	    $CPAN::Frontend->myprint("No modules found for @args\n");
+	} elsif ($what eq "r") {
+	    $CPAN::Frontend->myprint("All modules are up to date for @args\n");
+	}
+    }
+    if ($what eq "r") {
+	if ($version_zeroes) {
+	    my $s_has = $version_zeroes > 1 ? "s have" : " has";
+	    $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
+		qq{a version number of 0\n});
+	}
+	if ($version_undefs) {
+	    my $s_has = $version_undefs > 1 ? "s have" : " has";
+	    $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
+		qq{parseable version number\n});
+	}
+    }
+    @result;
+}
+
+#-> sub CPAN::Shell::r ;
+sub r {
+    shift->_u_r_common("r",@_);
+}
+
+#-> sub CPAN::Shell::u ;
+sub u {
+    shift->_u_r_common("u",@_);
+}
+
+#-> sub CPAN::Shell::autobundle ;
+sub autobundle {
+    my($self) = shift;
+    my(@bundle) = $self->_u_r_common("a",@_);
+    my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+    File::Path::mkpath($todir);
+    unless (-d $todir) {
+	$CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
+	return;
+    }
+    my($y,$m,$d) =  (localtime)[5,4,3];
+    $y+=1900;
+    $m++;
+    my($c) = 0;
+    my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
+    my($to) = MM->catfile($todir,"$me.pm");
+    while (-f $to) {
+	$me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
+	$to = MM->catfile($todir,"$me.pm");
+    }
+    my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
+    $fh->print(
+	       "package Bundle::$me;\n\n",
+	       "\$VERSION = '0.01';\n\n",
+	       "1;\n\n",
+	       "__END__\n\n",
+	       "=head1 NAME\n\n",
+	       "Bundle::$me - Snapshot of installation on ",
+	       $Config::Config{'myhostname'},
+	       " on ",
+	       scalar(localtime),
+	       "\n\n=head1 SYNOPSIS\n\n",
+	       "perl -MCPAN -e 'install Bundle::$me'\n\n",
+	       "=head1 CONTENTS\n\n",
+	       join("\n", @bundle),
+	       "\n\n=head1 CONFIGURATION\n\n",
+	       Config->myconfig,
+	       "\n\n=head1 AUTHOR\n\n",
+	       "This Bundle has been generated automatically ",
+	       "by the autobundle routine in CPAN.pm.\n",
+	      );
+    $fh->close;
+    $CPAN::Frontend->myprint("\nWrote bundle file
+    $to\n\n");
+}
+
+#-> sub CPAN::Shell::expand ;
+sub expand {
+    shift;
+    my($type,@args) = @_;
+    my($arg,@m);
+    for $arg (@args) {
+	my $regex;
+	if ($arg =~ m|^/(.*)/$|) {
+	    $regex = $1;
+	}
+	my $class = "CPAN::$type";
+	my $obj;
+	if (defined $regex) {
+	    for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
+		push @m, $obj
+		    if
+			$obj->id =~ /$regex/i
+			    or
+			(
+			 (
+			  $] < 5.00303 ### provide sort of compatibility with 5.003
+			  ||
+			  $obj->can('name')
+			 )
+			 &&
+			 $obj->name  =~ /$regex/i
+			);
+	    }
+	} else {
+	    my($xarg) = $arg;
+	    if ( $type eq 'Bundle' ) {
+		$xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
+	    }
+	    if ($CPAN::META->exists($class,$xarg)) {
+		$obj = $CPAN::META->instance($class,$xarg);
+	    } elsif ($CPAN::META->exists($class,$arg)) {
+		$obj = $CPAN::META->instance($class,$arg);
+	    } else {
+		next;
+	    }
+	    push @m, $obj;
+	}
+    }
+    return wantarray ? @m : $m[0];
+}
+
+#-> sub CPAN::Shell::format_result ;
+sub format_result {
+    my($self) = shift;
+    my($type,@args) = @_;
+    @args = '/./' unless @args;
+    my(@result) = $self->expand($type,@args);
+    my $result =  @result == 1 ?
+	$result[0]->as_string :
+	    join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects of type $type found for argument @args\n";
+    $result;
+}
+
+# The only reason for this method is currently to have a reliable
+# debugging utility that reveals which output is going through which
+# channel. No, I don't like the colors ;-)
+sub print_ornamented {
+    my($self,$what,$ornament) = @_;
+    my $longest = 0;
+    my $ornamenting = 0; # turn the colors on
+
+    if ($ornamenting) {
+	unless (defined &color) {
+	    if ($CPAN::META->has_inst("Term::ANSIColor")) {
+		import Term::ANSIColor "color";
+	    } else {
+		*color = sub { return "" };
+	    }
+	}
+	my $line;
+	for $line (split /\n/, $what) {
+	    $longest = length($line) if length($line) > $longest;
+	}
+	my $sprintf = "%-" . $longest . "s";
+	while ($what){
+	    $what =~ s/(.*\n?)//m;
+	    my $line = $1;
+	    last unless $line;
+	    my($nl) = chomp $line ? "\n" : "";
+	    #	print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
+	    print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
+	}
+    } else {
+	print $what;
+    }
+}
+
+sub myprint {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold blue on_yellow');
+}
+
+sub myexit {
+    my($self,$what) = @_;
+    $self->myprint($what);
+    exit;
+}
+
+sub mywarn {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_yellow');
+}
+
+sub myconfess {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_white');
+    Carp::confess "died";
+}
+
+sub mydie {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_white');
+    die "\n";
+}
+
+#-> sub CPAN::Shell::rematein ;
+# RE-adme||MA-ke||TE-st||IN-stall
+sub rematein {
+    shift;
+    my($meth,@some) = @_;
+    my $pragma = "";
+    if ($meth eq 'force') {
+	$pragma = $meth;
+	$meth = shift @some;
+    }
+    CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
+    my($s,@s);
+    foreach $s (@some) {
+	my $obj;
+	if (ref $s) {
+	    $obj = $s;
+	} elsif ($s =~ m|/|) { # looks like a file
+	    $obj = $CPAN::META->instance('CPAN::Distribution',$s);
+	} elsif ($s =~ m|^Bundle::|) {
+	    $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
+	    $obj = $CPAN::META->instance('CPAN::Bundle',$s);
+	} else {
+	    $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
+	    $obj = $CPAN::META->instance('CPAN::Module',$s)
+		if $CPAN::META->exists('CPAN::Module',$s);
+	}
+	if (ref $obj) {
+	    CPAN->debug(
+			qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+			$obj->as_string.
+			qq{\]}
+		       ) if $CPAN::DEBUG;
+	    $obj->$pragma()
+		if
+		    $pragma
+			&&
+		    ($] < 5.00303 || $obj->can($pragma)); ###
+                                                          ### compatibility
+                                                          ### with
+                                                          ### 5.003
+	    if ($]>=5.00303 && $obj->can('called_for')) {
+	      $obj->called_for($s);
+	    }
+	    $obj->$meth();
+	} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
+	    $obj = $CPAN::META->instance('CPAN::Author',$s);
+	    $CPAN::Frontend->myprint(
+				     join "",
+				     "Don't be silly, you can't $meth ",
+				     $obj->fullname,
+				     " ;-)\n"
+				    );
+	} else {
+	    $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
+Try the command
+
+    i /$s/
+
+to find objects with similar identifiers.
+});
+	}
+    }
+}
+
+#-> sub CPAN::Shell::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Shell::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Shell::readme ;
+sub readme  { shift->rematein('readme',@_); }
+#-> sub CPAN::Shell::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Shell::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Shell::install ;
+sub install { shift->rematein('install',@_); }
+#-> sub CPAN::Shell::clean ;
+sub clean   { shift->rematein('clean',@_); }
+#-> sub CPAN::Shell::look ;
+sub look   { shift->rematein('look',@_); }
+
+package CPAN::FTP;
+
+#-> sub CPAN::FTP::ftp_get ;
+sub ftp_get {
+    my($class,$host,$dir,$file,$target) = @_;
+    $class->debug(
+		       qq[Going to fetch file [$file] from dir [$dir]
+	on host [$host] as local [$target]\n]
+		      ) if $CPAN::DEBUG;
+    my $ftp = Net::FTP->new($host);
+    return 0 unless defined $ftp;
+    $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
+    $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
+    unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
+	warn "Couldn't login on $host";
+	return;
+    }
+    unless ( $ftp->cwd($dir) ){
+	warn "Couldn't cwd $dir";
+	return;
+    }
+    $ftp->binary;
+    $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
+    unless ( $ftp->get($file,$target) ){
+	warn "Couldn't fetch $file from $host\n";
+	return;
+    }
+    $ftp->quit; # it's ok if this fails
+    return 1;
+}
+
+# If more accuracy is wanted/needed, Chris Leach sent me this patch...
+ 
+ # leach,> *** /install/perl/live/lib/CPAN.pm-	Wed Sep 24 13:08:48 1997
+ # leach,> --- /tmp/cp	Wed Sep 24 13:26:40 1997
+ # leach,> ***************
+ # leach,> *** 1562,1567 ****
+ # leach,> --- 1562,1580 ----
+ # leach,>       return 1 if substr($url,0,4) eq "file";
+ # leach,>       return 1 unless $url =~ m|://([^/]+)|;
+ # leach,>       my $host = $1;
+ # leach,> +     my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+ # leach,> +     if ($proxy) {
+ # leach,> +         $proxy =~ m|://([^/:]+)|;
+ # leach,> +         $proxy = $1;
+ # leach,> +         my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+ # leach,> +         if ($noproxy) {
+ # leach,> +             if ($host !~ /$noproxy$/) {
+ # leach,> +                 $host = $proxy;
+ # leach,> +             }
+ # leach,> +         } else {
+ # leach,> +             $host = $proxy;
+ # leach,> +         }
+ # leach,> +     }
+ # leach,>       require Net::Ping;
+ # leach,>       return 1 unless $Net::Ping::VERSION >= 2;
+ # leach,>       my $p;
+
+
+# this is quite optimistic and returns one on several occasions where
+# inappropriate. But this does no harm. It would do harm if we were
+# too pessimistic (as I was before the http_proxy
+sub is_reachable {
+    my($self,$url) = @_;
+    return 1; # we can't simply roll our own, firewalls may break ping
+    return 0 unless $url;
+    return 1 if substr($url,0,4) eq "file";
+    return 1 unless $url =~ m|^(\w+)://([^/]+)|;
+    my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
+    my $host = $2;
+    return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
+    require Net::Ping;
+    return 1 unless $Net::Ping::VERSION >= 2;
+    my $p;
+    # 1.3101 had it different: only if the first eval raised an
+    # exception we tried it with TCP. Now we are happy if icmp wins
+    # the order and return, we don't even check for $@. Thanks to
+    # thayer@uis.edu for the suggestion.
+    eval {$p = Net::Ping->new("icmp");};
+    return 1 if $p && ref($p) && $p->ping($host, 10);
+    eval {$p = Net::Ping->new("tcp");};
+    $CPAN::Frontend->mydie($@) if $@;
+    return $p->ping($host, 10);
+}
+
+#-> sub CPAN::FTP::localize ;
+# sorry for the ugly code here, I'll clean it up as soon as Net::FTP
+# is in the core
+sub localize {
+    my($self,$file,$aslocal,$force) = @_;
+    $force ||= 0;
+    Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
+	unless defined $aslocal;
+    $self->debug("file[$file] aslocal[$aslocal] force[$force]")
+	if $CPAN::DEBUG;
+
+    return $aslocal if -f $aslocal && -r _ && !($force & 1);
+    my($restore) = 0;
+    if (-f $aslocal){
+	rename $aslocal, "$aslocal.bak";
+	$restore++;
+    }
+
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+    $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
+	qq{directory "$aslocal_dir".
+    I\'ll continue, but if you encounter problems, they may be due
+    to insufficient permissions.\n}) unless -w $aslocal_dir;
+
+    # Inheritance is not easier to manage than a few if/else branches
+    if ($CPAN::META->has_inst('LWP')) {
+	require LWP::UserAgent;
+ 	unless ($Ua) {
+	    $Ua = LWP::UserAgent->new;
+	    my($var);
+	    $Ua->proxy('ftp',  $var)
+		if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
+	    $Ua->proxy('http', $var)
+		if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+	    $Ua->no_proxy($var)
+		if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+	}
+    }
+
+    # Try the list of urls for each single object. We keep a record
+    # where we did get a file from
+    my(@reordered,$last);
+    $CPAN::Config->{urllist} ||= [];
+    $last = $#{$CPAN::Config->{urllist}};
+    if ($force & 2) { # local cpans probably out of date, don't reorder
+	@reordered = (0..$last);
+    } else {
+	@reordered =
+	    sort {
+		(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
+		    <=> 
+		(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
+		    or
+		defined($Thesite)
+		    and
+		($b == $Thesite)
+		    <=>
+		($a == $Thesite)
+	    } 0..$last;
+
+#	    ((grep { substr($CPAN::Config->{urllist}[$_],0,4)
+#			 eq "file" } 0..$last),
+#	     (grep { substr($CPAN::Config->{urllist}[$_],0,4)
+#			 ne "file" } 0..$last));
+    }
+    my($level,@levels);
+    if ($Themethod) {
+	@levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
+    } else {
+	@levels = qw/easy hard hardest/;
+    }
+    for $level (@levels) {
+	my $method = "host$level";
+	my @host_seq = $level eq "easy" ?
+	    @reordered : 0..$last;  # reordered has CDROM up front
+	@host_seq = (0) unless @host_seq;
+	my $ret = $self->$method(\@host_seq,$file,$aslocal);
+	if ($ret) {
+	    $Themethod = $level;
+	    $self->debug("level[$level]") if $CPAN::DEBUG;
+	    return $ret;
+	}
+    }
+    my(@mess);
+    push @mess,
+    qq{Please check, if the URLs I found in your configuration file \(}.
+	join(", ", @{$CPAN::Config->{urllist}}).
+	    qq{\) are valid. The urllist can be edited.},
+	    qq{E.g. with ``o conf urllist push ftp://myurl/''};
+    $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
+    sleep 2;
+    $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+    if ($restore) {
+	rename "$aslocal.bak", $aslocal;
+	$CPAN::Frontend->myprint("Trying to get away with old file:\n" .
+				 $self->ls($aslocal));
+	return $aslocal;
+    }
+    return;
+}
+
+sub hosteasy {
+    my($self,$host_seq,$file,$aslocal) = @_;
+    my($i);
+  HOSTEASY: for $i (@$host_seq) {
+      my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
+	unless ($self->is_reachable($url)) {
+	    $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
+	    sleep 2;
+	    next;
+	}
+	$url .= "/" unless substr($url,-1) eq "/";
+	$url .= $file;
+	$self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
+	if ($url =~ /^file:/) {
+	    my $l;
+	    if ($CPAN::META->has_inst('LWP')) {
+		require URI::URL;
+		my $u =  URI::URL->new($url);
+		$l = $u->path;
+	    } else { # works only on Unix, is poorly constructed, but
+		# hopefully better than nothing.
+		# RFC 1738 says fileurl BNF is
+		# fileurl = "file://" [ host | "localhost" ] "/" fpath
+		# Thanks to "Mark D. Baushke" <mdb@cisco.com> for
+		# the code
+		($l = $url) =~ s,^file://[^/]+,,; # discard the host part
+		$l =~ s/^file://;	# assume they meant file://localhost
+	    }
+	    if ( -f $l && -r _) {
+		$Thesite = $i;
+		return $l;
+	    }
+	    # Maybe mirror has compressed it?
+	    if (-f "$l.gz") {
+		$self->debug("found compressed $l.gz") if $CPAN::DEBUG;
+		CPAN::Tarzip->gunzip("$l.gz", $aslocal);
+		if ( -f $aslocal) {
+		    $Thesite = $i;
+		    return $aslocal;
+		}
+	    }
+	}
+	if ($CPAN::META->has_inst('LWP')) {
+	  $CPAN::Frontend->myprint("Fetching with LWP:
+  $url
+");
+	  my $res = $Ua->mirror($url, $aslocal);
+	  if ($res->is_success) {
+	    $Thesite = $i;
+	    return $aslocal;
+	  } elsif ($url !~ /\.gz$/) {
+	    my $gzurl = "$url.gz";
+	    $CPAN::Frontend->myprint("Fetching with LWP:
+  $gzurl
+");
+	    $res = $Ua->mirror($gzurl, "$aslocal.gz");
+	    if ($res->is_success &&
+		CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
+	       ) {
+	      $Thesite = $i;
+	      return $aslocal;
+	    } else {
+	      # next HOSTEASY ;
+	    }
+	  } else {
+	    # Alan Burlison informed me that in firewall envs Net::FTP
+	    # can still succeed where LWP fails. So we do not skip
+	    # Net::FTP anymore when LWP is available.
+	    # next HOSTEASY ;
+	  }
+	} else {
+	  $self->debug("LWP not installed") if $CPAN::DEBUG;
+	}
+	if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+	    # that's the nice and easy way thanks to Graham
+	    my($host,$dir,$getfile) = ($1,$2,$3);
+	    if ($CPAN::META->has_inst('Net::FTP')) {
+		$dir =~ s|/+|/|g;
+		$CPAN::Frontend->myprint("Fetching with Net::FTP:
+  $url
+");
+		$self->debug("getfile[$getfile]dir[$dir]host[$host]" .
+			     "aslocal[$aslocal]") if $CPAN::DEBUG;
+		if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
+		    $Thesite = $i;
+		    return $aslocal;
+		}
+		if ($aslocal !~ /\.gz$/) {
+		    my $gz = "$aslocal.gz";
+		    $CPAN::Frontend->myprint("Fetching with Net::FTP
+  $url.gz
+");
+		    if (CPAN::FTP->ftp_get($host,
+					   $dir,
+					   "$getfile.gz",
+					   $gz) &&
+			CPAN::Tarzip->gunzip($gz,$aslocal)
+		       ){
+			$Thesite = $i;
+			return $aslocal;
+		    }
+		}
+		# next HOSTEASY;
+	    }
+	}
+    }
+}
+
+sub hosthard {
+    my($self,$host_seq,$file,$aslocal) = @_;
+
+    # Came back if Net::FTP couldn't establish connection (or
+    # failed otherwise) Maybe they are behind a firewall, but they
+    # gave us a socksified (or other) ftp program...
+
+    my($i);
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+  HOSTHARD: for $i (@$host_seq) {
+	my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
+	unless ($self->is_reachable($url)) {
+	    $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
+	    next;
+	}
+	$url .= "/" unless substr($url,-1) eq "/";
+	$url .= $file;
+	my($proto,$host,$dir,$getfile);
+
+	# Courtesy Mark Conty mark_conty@cargill.com change from
+	# if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+	# to
+	if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
+	    # proto not yet used
+	    ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
+	} else {
+	    next HOSTHARD; # who said, we could ftp anything except ftp?
+	}
+	$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
+	my($f,$funkyftp);
+	for $f ('lynx','ncftp') {
+	    next unless exists $CPAN::Config->{$f};
+	    $funkyftp = $CPAN::Config->{$f};
+	    next unless defined $funkyftp;
+	    next if $funkyftp =~ /^\s*$/;
+	    my($want_compressed);
+	    my $aslocal_uncompressed;
+	    ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
+	    my($source_switch) = "";
+	    $source_switch = "-source" if $funkyftp =~ /\blynx$/;
+	    $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
+	    $CPAN::Frontend->myprint(
+		  qq{
+Trying with "$funkyftp $source_switch" to get
+    $url
+});
+	    my($system) = "$funkyftp $source_switch '$url' > ".
+		"$aslocal_uncompressed";
+	    $self->debug("system[$system]") if $CPAN::DEBUG;
+	    my($wstatus);
+	    if (($wstatus = system($system)) == 0
+		&&
+		-s $aslocal_uncompressed   # lynx returns 0 on my
+                                           # system even if it fails
+	       ) {
+		if ($aslocal_uncompressed ne $aslocal) {
+		  # test gzip integrity
+		  if (
+		      CPAN::Tarzip->gtest($aslocal_uncompressed)
+		     ) {
+		    rename $aslocal_uncompressed, $aslocal;
+		  } else {
+		    CPAN::Tarzip->gzip($aslocal_uncompressed,
+				     "$aslocal_uncompressed.gz");
+		  }
+		  $Thesite = $i;
+		  return $aslocal;
+		}
+	    } elsif ($url !~ /\.gz$/) {
+		my $gz = "$aslocal.gz";
+		my $gzurl = "$url.gz";
+		$CPAN::Frontend->myprint(
+		      qq{
+Trying with "$funkyftp $source_switch" to get
+  $url.gz
+});
+		my($system) = "$funkyftp $source_switch '$url.gz' > ".
+		    "$aslocal_uncompressed.gz";
+		$self->debug("system[$system]") if $CPAN::DEBUG;
+		my($wstatus);
+		if (($wstatus = system($system)) == 0
+		    &&
+		    -s "$aslocal_uncompressed.gz"
+		   ) {
+		    # test gzip integrity
+		    if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
+		      CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
+					 $aslocal);
+		    } else {
+			rename $aslocal_uncompressed, $aslocal;
+		    }
+#line 1739
+		    $Thesite = $i;
+		    return $aslocal;
+		}
+	    } else {
+		my $estatus = $wstatus >> 8;
+		my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
+		$CPAN::Frontend->myprint(qq{
+System call "$system"
+returned status $estatus (wstat $wstatus)$size
+});
+	    }
+	}
+    }
+}
+
+sub hosthardest {
+    my($self,$host_seq,$file,$aslocal) = @_;
+
+    my($i);
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+  HOSTHARDEST: for $i (@$host_seq) {
+	unless (length $CPAN::Config->{'ftp'}) {
+	    $CPAN::Frontend->myprint("No external ftp command available\n\n");
+	    last HOSTHARDEST;
+	}
+	my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
+	unless ($self->is_reachable($url)) {
+	    $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
+	    next;
+	}
+	$url .= "/" unless substr($url,-1) eq "/";
+	$url .= $file;
+	$self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
+	unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+	    next;
+	}
+	my($host,$dir,$getfile) = ($1,$2,$3);
+	my($netrcfile,$fh);
+	my $timestamp = 0;
+	my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+	   $ctime,$blksize,$blocks) = stat($aslocal);
+	$timestamp = $mtime ||= 0;
+	my($netrc) = CPAN::FTP::netrc->new;
+	my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
+	my $targetfile = File::Basename::basename($aslocal);
+	my(@dialog);
+	push(
+	     @dialog,
+	     "lcd $aslocal_dir",
+	     "cd /",
+	     map("cd $_", split "/", $dir), # RFC 1738
+	     "bin",
+	     "get $getfile $targetfile",
+	     "quit"
+	    );
+	if (! $netrc->netrc) {
+	    CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
+	} elsif ($netrc->hasdefault || $netrc->contains($host)) {
+	    CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
+				$netrc->hasdefault,
+				$netrc->contains($host))) if $CPAN::DEBUG;
+	    if ($netrc->protected) {
+		$CPAN::Frontend->myprint(qq{
+  Trying with external ftp to get
+    $url
+  As this requires some features that are not thoroughly tested, we\'re
+  not sure, that we get it right....
+
+}
+		     );
+		$self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
+				@dialog);
+		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+		 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+		$mtime ||= 0;
+		if ($mtime > $timestamp) {
+		    $CPAN::Frontend->myprint("GOT $aslocal\n");
+		    $Thesite = $i;
+		    return $aslocal;
+		} else {
+		    $CPAN::Frontend->myprint("Hmm... Still failed!\n");
+		}
+	    } else {
+		$CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
+					qq{correctly protected.\n});
+	    }
+	} else {
+	    $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
+  nor does it have a default entry\n");
+	}
+	
+	# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
+	# then and login manually to host, using e-mail as
+	# password.
+	$CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
+	unshift(
+		@dialog,
+		"open $host",
+		"user anonymous $Config::Config{'cf_email'}"
+	       );
+	$self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
+	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+	 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+	$mtime ||= 0;
+	if ($mtime > $timestamp) {
+	    $CPAN::Frontend->myprint("GOT $aslocal\n");
+	    $Thesite = $i;
+	    return $aslocal;
+	} else {
+	    $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
+	}
+	$CPAN::Frontend->myprint("Can't access URL $url.\n\n");
+	sleep 2;
+    }
+}
+
+sub talk_ftp {
+    my($self,$command,@dialog) = @_;
+    my $fh = FileHandle->new;
+    $fh->open("|$command") or die "Couldn't open ftp: $!";
+    foreach (@dialog) { $fh->print("$_\n") }
+    $fh->close;		# Wait for process to complete
+    my $wstatus = $?;
+    my $estatus = $wstatus >> 8;
+    $CPAN::Frontend->myprint(qq{
+Subprocess "|$command"
+  returned status $estatus (wstat $wstatus)
+}) if $wstatus;
+    
+}
+
+# find2perl needs modularization, too, all the following is stolen
+# from there
+# CPAN::FTP::ls
+sub ls {
+    my($self,$name) = @_;
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
+     $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
+
+    my($perms,%user,%group);
+    my $pname = $name;
+
+    if ($blocks) {
+	$blocks = int(($blocks + 1) / 2);
+    }
+    else {
+	$blocks = int(($sizemm + 1023) / 1024);
+    }
+
+    if    (-f _) { $perms = '-'; }
+    elsif (-d _) { $perms = 'd'; }
+    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
+    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
+    elsif (-p _) { $perms = 'p'; }
+    elsif (-S _) { $perms = 's'; }
+    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
+
+    my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
+    my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+    my $tmpmode = $mode;
+    my $tmp = $rwx[$tmpmode & 7];
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
+    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
+    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
+    $perms .= $tmp;
+
+    my $user = $user{$uid} || $uid;   # too lazy to implement lookup
+    my $group = $group{$gid} || $gid;
+
+    my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
+    my($timeyear);
+    my($moname) = $moname[$mon];
+    if (-M _ > 365.25 / 2) {
+	$timeyear = $year + 1900;
+    }
+    else {
+	$timeyear = sprintf("%02d:%02d", $hour, $min);
+    }
+
+    sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
+	    $ino,
+		 $blocks,
+		      $perms,
+			    $nlink,
+				$user,
+				     $group,
+					  $sizemm,
+					      $moname,
+						 $mday,
+						     $timeyear,
+							 $pname;
+}
+
+package CPAN::FTP::netrc;
+
+sub new {
+    my($class) = @_;
+    my $file = MM->catfile($ENV{HOME},".netrc");
+
+    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+	= stat($file);
+    $mode ||= 0;
+    my $protected = 0;
+
+    my($fh,@machines,$hasdefault);
+    $hasdefault = 0;
+    $fh = FileHandle->new or die "Could not create a filehandle";
+
+    if($fh->open($file)){
+	$protected = ($mode & 077) == 0;
+	local($/) = "";
+      NETRC: while (<$fh>) {
+	    my(@tokens) = split " ", $_;
+	  TOKEN: while (@tokens) {
+		my($t) = shift @tokens;
+		if ($t eq "default"){
+		    $hasdefault++;
+		    last NETRC;
+		}
+		last TOKEN if $t eq "macdef";
+		if ($t eq "machine") {
+		    push @machines, shift @tokens;
+		}
+	    }
+	}
+    } else {
+	$file = $hasdefault = $protected = "";
+    }
+
+    bless {
+	   'mach' => [@machines],
+	   'netrc' => $file,
+	   'hasdefault' => $hasdefault,
+	   'protected' => $protected,
+	  }, $class;
+}
+
+sub hasdefault { shift->{'hasdefault'} }
+sub netrc      { shift->{'netrc'}      }
+sub protected  { shift->{'protected'}  }
+sub contains {
+    my($self,$mach) = @_;
+    for ( @{$self->{'mach'}} ) {
+	return 1 if $_ eq $mach;
+    }
+    return 0;
+}
+
+package CPAN::Complete;
+
+#-> sub CPAN::Complete::cpl ;
+sub cpl {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    $line ||= "";
+    $pos ||= 0;
+    CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    $line =~ s/^\s*//;
+    if ($line =~ s/^(force\s*)//) {
+	$pos -= length($1);
+    }
+    my @return;
+    if ($pos == 0) {
+	@return = grep(
+		       /^$word/,
+		       sort qw(
+			       ! a b d h i m o q r u autobundle clean
+			       make test install force reload look
+			      )
+		      );
+    } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
+	@return = ();
+    } elsif ($line =~ /^a\s/) {
+	@return = cplx('CPAN::Author',$word);
+    } elsif ($line =~ /^b\s/) {
+	@return = cplx('CPAN::Bundle',$word);
+    } elsif ($line =~ /^d\s/) {
+	@return = cplx('CPAN::Distribution',$word);
+    } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
+	@return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
+    } elsif ($line =~ /^i\s/) {
+	@return = cpl_any($word);
+    } elsif ($line =~ /^reload\s/) {
+	@return = cpl_reload($word,$line,$pos);
+    } elsif ($line =~ /^o\s/) {
+	@return = cpl_option($word,$line,$pos);
+    } else {
+	@return = ();
+    }
+    return @return;
+}
+
+#-> sub CPAN::Complete::cplx ;
+sub cplx {
+    my($class, $word) = @_;
+    grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
+}
+
+#-> sub CPAN::Complete::cpl_any ;
+sub cpl_any {
+    my($word) = shift;
+    return (
+	    cplx('CPAN::Author',$word),
+	    cplx('CPAN::Bundle',$word),
+	    cplx('CPAN::Distribution',$word),
+	    cplx('CPAN::Module',$word),
+	   );
+}
+
+#-> sub CPAN::Complete::cpl_reload ;
+sub cpl_reload {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@words) = split " ", $line;
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@ok) = qw(cpan index);
+    return @ok if @words == 1;
+    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+}
+
+#-> sub CPAN::Complete::cpl_option ;
+sub cpl_option {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@words) = split " ", $line;
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@ok) = qw(conf debug);
+    return @ok if @words == 1;
+    return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
+    if (0) {
+    } elsif ($words[1] eq 'index') {
+	return ();
+    } elsif ($words[1] eq 'conf') {
+	return CPAN::Config::cpl(@_);
+    } elsif ($words[1] eq 'debug') {
+	return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
+    }
+}
+
+package CPAN::Index;
+
+#-> sub CPAN::Index::force_reload ;
+sub force_reload {
+    my($class) = @_;
+    $CPAN::Index::last_time = 0;
+    $class->reload(1);
+}
+
+#-> sub CPAN::Index::reload ;
+sub reload {
+    my($cl,$force) = @_;
+    my $time = time;
+
+    # XXX check if a newer one is available. (We currently read it
+    # from time to time)
+    for ($CPAN::Config->{index_expire}) {
+	$_ = 0.001 unless $_ > 0.001;
+    }
+    return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
+	and ! $force;
+    my($debug,$t2);
+    $last_time = $time;
+
+    my $needshort = $^O eq "dos";
+
+    $cl->rd_authindex($cl->reload_x(
+				    "authors/01mailrc.txt.gz",
+				    $needshort ? "01mailrc.gz" : "",
+				    $force));
+    $t2 = time;
+    $debug = "timing reading 01[".($t2 - $time)."]";
+    $time = $t2;
+    return if $CPAN::Signal; # this is sometimes lengthy
+    $cl->rd_modpacks($cl->reload_x(
+				   "modules/02packages.details.txt.gz",
+				   $needshort ? "02packag.gz" : "",
+				   $force));
+    $t2 = time;
+    $debug .= "02[".($t2 - $time)."]";
+    $time = $t2;
+    return if $CPAN::Signal; # this is sometimes lengthy
+    $cl->rd_modlist($cl->reload_x(
+				  "modules/03modlist.data.gz",
+				  $needshort ? "03mlist.gz" : "",
+				  $force));
+    $t2 = time;
+    $debug .= "03[".($t2 - $time)."]";
+    $time = $t2;
+    CPAN->debug($debug) if $CPAN::DEBUG;
+}
+
+#-> sub CPAN::Index::reload_x ;
+sub reload_x {
+    my($cl,$wanted,$localname,$force) = @_;
+    $force |= 2; # means we're dealing with an index here
+    CPAN::Config->load; # we should guarantee loading wherever we rely
+                        # on Config XXX
+    $localname ||= $wanted;
+    my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
+				   $localname);
+    if (
+	-f $abs_wanted &&
+	-M $abs_wanted < $CPAN::Config->{'index_expire'} &&
+	!($force & 1)
+       ) {
+	my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
+	$cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
+		   qq{day$s. I\'ll use that.});
+	return $abs_wanted;
+    } else {
+	$force |= 1; # means we're quite serious about it.
+    }
+    return CPAN::FTP->localize($wanted,$abs_wanted,$force);
+}
+
+#-> sub CPAN::Index::rd_authindex ;
+sub rd_authindex {
+    my($cl,$index_target) = @_;
+    return unless defined $index_target;
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
+#    my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+#    while ($_ = $fh->READLINE) {
+    # no strict 'refs';
+    local(*FH);
+    tie *FH, CPAN::Tarzip, $index_target;
+    local($/) = "\n";
+    while (<FH>) {
+	chomp;
+	my($userid,$fullname,$email) =
+	    /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+	next unless $userid && $fullname && $email;
+
+	# instantiate an author object
+ 	my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
+	$userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
+	return if $CPAN::Signal;
+    }
+}
+
+sub userid {
+  my($self,$dist) = @_;
+  $dist = $self->{'id'} unless defined $dist;
+  my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
+  $ret;
+}
+
+#-> sub CPAN::Index::rd_modpacks ;
+sub rd_modpacks {
+    my($cl,$index_target) = @_;
+    return unless defined $index_target;
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
+    my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+    local($/) = "\n";
+    while ($_ = $fh->READLINE) {
+	last if /^\s*$/;
+    }
+    while ($_ = $fh->READLINE) {
+	chomp;
+	my($mod,$version,$dist) = split;
+###	$version =~ s/^\+//;
+
+	# if it is a bundle, instatiate a bundle object
+	my($bundle,$id,$userid);
+	
+	if ($mod eq 'CPAN' &&
+	    ! (
+	       $CPAN::META->exists('CPAN::Queue','Bundle::CPAN') ||
+	       $CPAN::META->exists('CPAN::Queue','CPAN')
+	      )
+	   ) {
+	    local($^W)= 0;
+	    if ($version > $CPAN::VERSION){
+		$CPAN::Frontend->myprint(qq{
+  There\'s a new CPAN.pm version (v$version) available!
+  You might want to try
+    install Bundle::CPAN
+    reload cpan
+  without quitting the current session. It should be a seamless upgrade
+  while we are running...
+});
+		sleep 2;
+		$CPAN::Frontend->myprint(qq{\n});
+	    }
+	    last if $CPAN::Signal;
+	} elsif ($mod =~ /^Bundle::(.*)/) {
+	    $bundle = $1;
+	}
+
+	if ($bundle){
+	    $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
+	    # Let's make it a module too, because bundles have so much
+	    # in common with modules
+	    $CPAN::META->instance('CPAN::Module',$mod);
+
+# This "next" makes us faster but if the job is running long, we ignore
+# rereads which is bad. So we have to be a bit slower again.
+#	} elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
+#	    next;
+
+	}
+	else {
+	    # instantiate a module object
+	    $id = $CPAN::META->instance('CPAN::Module',$mod);
+	}
+
+	if ($id->cpan_file ne $dist){
+	    $userid = $cl->userid($dist);
+	    $id->set(
+		     'CPAN_USERID' => $userid,
+		     'CPAN_VERSION' => $version,
+		     'CPAN_FILE' => $dist
+		    );
+	}
+
+	# instantiate a distribution object
+	unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
+	    $CPAN::META->instance(
+				  'CPAN::Distribution' => $dist
+				 )->set(
+					'CPAN_USERID' => $userid
+				       );
+	}
+
+	return if $CPAN::Signal;
+    }
+    undef $fh;
+}
+
+#-> sub CPAN::Index::rd_modlist ;
+sub rd_modlist {
+    my($cl,$index_target) = @_;
+    return unless defined $index_target;
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
+    my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+    my @eval;
+    local($/) = "\n";
+    while ($_ = $fh->READLINE) {
+	if (/^Date:\s+(.*)/){
+	    return if $date_of_03 eq $1;
+	    ($date_of_03) = $1;
+	}
+	last if /^\s*$/;
+    }
+    push @eval, $_ while $_ = $fh->READLINE;
+    undef $fh;
+    push @eval, q{CPAN::Modulelist->data;};
+    local($^W) = 0;
+    my($comp) = Safe->new("CPAN::Safe1");
+    my($eval) = join("", @eval);
+    my $ret = $comp->reval($eval);
+    Carp::confess($@) if $@;
+    return if $CPAN::Signal;
+    for (keys %$ret) {
+	my $obj = $CPAN::META->instance(CPAN::Module,$_);
+	$obj->set(%{$ret->{$_}});
+	return if $CPAN::Signal;
+    }
+}
+
+package CPAN::InfoObj;
+
+#-> sub CPAN::InfoObj::new ;
+sub new { my $this = bless {}, shift; %$this = @_; $this }
+
+#-> sub CPAN::InfoObj::set ;
+sub set {
+    my($self,%att) = @_;
+    my(%oldatt) = %$self;
+    %$self = (%oldatt, %att);
+}
+
+#-> sub CPAN::InfoObj::id ;
+sub id { shift->{'ID'} }
+
+#-> sub CPAN::InfoObj::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s\n", $class, $self->{ID};
+    join "", @m;
+}
+
+#-> sub CPAN::InfoObj::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, $class, " id = $self->{ID}\n";
+    for (sort keys %$self) {
+	next if $_ eq 'ID';
+	my $extra = "";
+	if ($_ eq "CPAN_USERID") {
+	  $extra .= " (".$self->author;
+	  my $email; # old perls!
+	  if ($email = $CPAN::META->instance(CPAN::Author,
+						$self->{$_}
+					       )->email) {
+	    $extra .= " <$email>";
+	  } else {
+	    $extra .= " <no email>";
+	  }
+	  $extra .= ")";
+	}
+	if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
+	    push @m, sprintf "    %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
+	} else {
+	    push @m, sprintf "    %-12s %s%s\n", $_, $self->{$_}, $extra;
+	}
+    }
+    join "", @m, "\n";
+}
+
+#-> sub CPAN::InfoObj::author ;
+sub author {
+    my($self) = @_;
+    $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
+}
+
+package CPAN::Author;
+
+#-> sub CPAN::Author::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
+    join "", @m;
+}
+
+# Dead code, I would have liked to have,,, but it was never reached,,,
+#sub make {
+#    my($self) = @_;
+#    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
+#}
+
+#-> sub CPAN::Author::fullname ;
+sub fullname { shift->{'FULLNAME'} }
+*name = \&fullname;
+#-> sub CPAN::Author::email ;
+sub email    { shift->{'EMAIL'} }
+
+package CPAN::Distribution;
+
+#-> sub CPAN::Distribution::called_for ;
+sub called_for {
+    my($self,$id) = @_;
+    $self->{'CALLED_FOR'} = $id if defined $id;
+    return $self->{'CALLED_FOR'};
+}
+
+#-> sub CPAN::Distribution::get ;
+sub get {
+    my($self) = @_;
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} and push @e,
+	    "Unwrapped into directory $self->{'build_dir'}";
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    my($local_file);
+    my($local_wanted) =
+	 MM->catfile(
+			$CPAN::Config->{keep_source_where},
+			"authors",
+			"id",
+			split("/",$self->{ID})
+		       );
+
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file =
+	CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
+	    or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+    $self->{localfile} = $local_file;
+    my $builddir = $CPAN::META->{cachemgr}->dir;
+    $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    my $packagedir;
+
+    $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
+    if ($CPAN::META->has_inst('MD5')) {
+	$self->debug("MD5 is installed, verifying");
+	$self->verifyMD5;
+    } else {
+	$self->debug("MD5 is NOT installed");
+    }
+    $self->debug("Removing tmp") if $CPAN::DEBUG;
+    File::Path::rmtree("tmp");
+    mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
+    chdir "tmp";
+    $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
+    if (! $local_file) {
+	Carp::croak "bad download, can't do anything :-(\n";
+    } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
+	$self->untar_me($local_file);
+    } elsif ( $local_file =~ /\.zip$/i ) {
+	$self->unzip_me($local_file);
+    } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
+	$self->pm2dir_me($local_file);
+    } else {
+	$self->{archived} = "NO";
+    }
+    chdir "..";
+    if ($self->{archived} ne 'NO') {
+	chdir "tmp";
+	# Let's check if the package has its own directory.
+	my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
+	my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
+	$dh->close;
+	my ($distdir,$packagedir);
+	if (@readdir == 1 && -d $readdir[0]) {
+	    $distdir = $readdir[0];
+	    $packagedir = MM->catdir($builddir,$distdir);
+	    -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
+	    File::Path::rmtree($packagedir);
+	    rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
+	} else {
+	    my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
+	    $pragmatic_dir =~ s/\W_//g;
+	    $pragmatic_dir++ while -d "../$pragmatic_dir";
+	    $packagedir = MM->catdir($builddir,$pragmatic_dir);
+	    File::Path::mkpath($packagedir);
+	    my($f);
+	    for $f (@readdir) { # is already without "." and ".."
+		my $to = MM->catdir($packagedir,$f);
+		rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+	    }
+	}
+	$self->{'build_dir'} = $packagedir;
+	chdir "..";
+
+	$self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
+	    if $CPAN::DEBUG;
+	File::Path::rmtree("tmp");
+	if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
+	    $CPAN::Frontend->myprint("Going to unlink $local_file\n");
+	    unlink $local_file or Carp::carp "Couldn't unlink $local_file";
+	}
+	my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
+	unless (-f $makefilepl) {
+	  my($configure) = MM->catfile($packagedir,"Configure");
+	  if (-f $configure) {
+	    # do we have anything to do?
+	    $self->{'configure'} = $configure;
+	  } elsif (-f MM->catfile($packagedir,"Makefile")) {
+	    $CPAN::Frontend->myprint(qq{
+Package comes with a Makefile and without a Makefile.PL.
+We\'ll try to build it with that Makefile then.
+});
+	    $self->{writemakefile} = "YES";
+	    sleep 2;
+	  } else {
+	    my $fh = FileHandle->new(">$makefilepl")
+		or Carp::croak("Could not open >$makefilepl");
+	    my $cf = $self->called_for || "unknown";
+	    $fh->print(
+qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
+# because there was no Makefile.PL supplied.
+# Autogenerated on: }.scalar localtime().qq{
+
+use ExtUtils::MakeMaker;
+WriteMakefile(NAME => q[$cf]);
+
+});
+	    $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
+  Writing one on our own (calling it $cf)\n});
+	    }
+	}
+    }
+    return $self;
+}
+
+sub untar_me {
+    my($self,$local_file) = @_;
+    $self->{archived} = "tar";
+    if (CPAN::Tarzip->untar($local_file)) {
+	$self->{unwrapped} = "YES";
+    } else {
+	$self->{unwrapped} = "NO";
+    }
+}
+
+sub unzip_me {
+    my($self,$local_file) = @_;
+    $self->{archived} = "zip";
+    my $system = "$CPAN::Config->{unzip} $local_file";
+    if (system($system) == 0) {
+	$self->{unwrapped} = "YES";
+    } else {
+	$self->{unwrapped} = "NO";
+    }
+}
+
+sub pm2dir_me {
+    my($self,$local_file) = @_;
+    $self->{archived} = "pm";
+    my $to = File::Basename::basename($local_file);
+    $to =~ s/\.(gz|Z)$//;
+    if (CPAN::Tarzip->gunzip($local_file,$to)) {
+	$self->{unwrapped} = "YES";
+    } else {
+	$self->{unwrapped} = "NO";
+    }
+}
+
+#-> sub CPAN::Distribution::new ;
+sub new {
+    my($class,%att) = @_;
+
+    $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
+
+    my $this = { %att };
+    return bless $this, $class;
+}
+
+#-> sub CPAN::Distribution::look ;
+sub look {
+    my($self) = @_;
+    if (  $CPAN::Config->{'shell'} ) {
+	$CPAN::Frontend->myprint(qq{
+Trying to open a subshell in the build directory...
+});
+    } else {
+	$CPAN::Frontend->myprint(qq{
+Your configuration does not define a value for subshells.
+Please define it with "o conf shell <your shell>"
+});
+	return;
+    }
+    my $dist = $self->id;
+    my $dir  = $self->dir or $self->get;
+    $dir = $self->dir;
+    my $getcwd;
+    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $pwd  = CPAN->$getcwd();
+    chdir($dir);
+    $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
+    system($CPAN::Config->{'shell'}) == 0
+	or $CPAN::Frontend->mydie("Subprocess shell error");
+    chdir($pwd);
+}
+
+#-> sub CPAN::Distribution::readme ;
+sub readme {
+    my($self) = @_;
+    my($dist) = $self->id;
+    my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
+    $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
+    my($local_file);
+    my($local_wanted) =
+	 MM->catfile(
+			$CPAN::Config->{keep_source_where},
+			"authors",
+			"id",
+			split("/","$sans.readme"),
+		       );
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
+				      $local_wanted)
+	or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
+    my $fh_pager = FileHandle->new;
+    local($SIG{PIPE}) = "IGNORE";
+    $fh_pager->open("|$CPAN::Config->{'pager'}")
+	or die "Could not open pager $CPAN::Config->{'pager'}: $!";
+    my $fh_readme = FileHandle->new;
+    $fh_readme->open($local_file)
+	or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
+    $CPAN::Frontend->myprint(qq{
+Displaying file
+  $local_file
+with pager "$CPAN::Config->{'pager'}"
+});
+    sleep 2;
+    $fh_pager->print(<$fh_readme>);
+}
+
+#-> sub CPAN::Distribution::verifyMD5 ;
+sub verifyMD5 {
+    my($self) = @_;
+  EXCUSE: {
+	my @e;
+	$self->{MD5_STATUS} ||= "";
+	$self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    my($lc_want,$lc_file,@local,$basename);
+    @local = split("/",$self->{ID});
+    pop @local;
+    push @local, "CHECKSUMS";
+    $lc_want =
+	MM->catfile($CPAN::Config->{keep_source_where},
+		      "authors", "id", @local);
+    local($") = "/";
+    if (
+	-s $lc_want
+	&&
+	$self->MD5_check_file($lc_want)
+       ) {
+	return $self->{MD5_STATUS} = "OK";
+    }
+    $lc_file = CPAN::FTP->localize("authors/id/@local",
+				   $lc_want,1);
+    unless ($lc_file) {
+	$local[-1] .= ".gz";
+	$lc_file = CPAN::FTP->localize("authors/id/@local",
+				       "$lc_want.gz",1);
+	if ($lc_file) {
+	    $lc_file =~ s/\.gz$//;
+	    CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
+	} else {
+	    return;
+	}
+    }
+    $self->MD5_check_file($lc_file);
+}
+
+#-> sub CPAN::Distribution::MD5_check_file ;
+sub MD5_check_file {
+    my($self,$chk_file) = @_;
+    my($cksum,$file,$basename);
+    $file = $self->{localfile};
+    $basename = File::Basename::basename($file);
+    my $fh = FileHandle->new;
+    if (open $fh, $chk_file){
+	local($/);
+	my $eval = <$fh>;
+	close $fh;
+	my($comp) = Safe->new();
+	$cksum = $comp->reval($eval);
+	if ($@) {
+	    rename $chk_file, "$chk_file.bad";
+	    Carp::confess($@) if $@;
+	}
+    } else {
+	Carp::carp "Could not open $chk_file for reading";
+    }
+
+    if (exists $cksum->{$basename}{md5}) {
+	$self->debug("Found checksum for $basename:" .
+		     "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
+
+	open($fh, $file);
+	binmode $fh;
+	my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
+	$fh->close;
+	$fh = CPAN::Tarzip->TIEHANDLE($file);
+
+	unless ($eq) {
+	  # had to inline it, when I tied it, the tiedness got lost on
+	  # the call to eq_MD5. (Jan 1998)
+	  my $md5 = MD5->new;
+	  my($data,$ref);
+	  $ref = \$data;
+	  while ($fh->READ($ref, 4096)){
+	    $md5->add($data);
+	  }
+	  my $hexdigest = $md5->hexdigest;
+	  $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
+	}
+
+	if ($eq) {
+	  $CPAN::Frontend->myprint("Checksum for $file ok\n");
+	  return $self->{MD5_STATUS} = "OK";
+	} else {
+	    $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
+				     qq{distribution file. }.
+				     qq{Please investigate.\n\n}.
+				     $self->as_string,
+				     $CPAN::META->instance(
+							   'CPAN::Author',
+							   $self->{CPAN_USERID}
+							  )->as_string);
+	    my $wrap = qq{I\'d recommend removing $file. It seems to
+be a bogus file. Maybe you have configured your \`urllist\' with a
+bad URL. Please check this array with \`o conf urllist\', and
+retry.};
+	    $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
+	    $CPAN::Frontend->myprint("\n\n");
+	    sleep 3;
+	    return;
+	}
+	# close $fh if fileno($fh);
+    } else {
+	$self->{MD5_STATUS} ||= "";
+	if ($self->{MD5_STATUS} eq "NIL") {
+	    $CPAN::Frontend->myprint(qq{
+No md5 checksum for $basename in local $chk_file.
+Removing $chk_file
+});
+	    unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
+	    sleep 1;
+	}
+	$self->{MD5_STATUS} = "NIL";
+	return;
+    }
+}
+
+#-> sub CPAN::Distribution::eq_MD5 ;
+sub eq_MD5 {
+    my($self,$fh,$expectMD5) = @_;
+    my $md5 = MD5->new;
+    my($data);
+    while (read($fh, $data, 4096)){
+      $md5->add($data);
+    }
+    # $md5->addfile($fh);
+    my $hexdigest = $md5->hexdigest;
+    # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
+    $hexdigest eq $expectMD5;
+}
+
+#-> sub CPAN::Distribution::force ;
+sub force {
+    my($self) = @_;
+    $self->{'force_update'}++;
+    delete $self->{'MD5_STATUS'};
+    delete $self->{'archived'};
+    delete $self->{'build_dir'};
+    delete $self->{'localfile'};
+    delete $self->{'make'};
+    delete $self->{'install'};
+    delete $self->{'unwrapped'};
+    delete $self->{'writemakefile'};
+}
+
+sub isa_perl {
+  my($self) = @_;
+  my $file = File::Basename::basename($self->id);
+  return unless $file =~ m{ ^ perl
+			    (5)
+			    ([._-])
+			    (\d{3}(_[0-4][0-9])?)
+			    \.tar[._-]gz
+			    $
+			  }x;
+  "$1.$3";
+}
+
+#-> sub CPAN::Distribution::perl ;
+sub perl {
+    my($self) = @_;
+    my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
+    my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $pwd  = CPAN->$getcwd();
+    my $candidate = MM->catfile($pwd,$^X);
+    $perl ||= $candidate if MM->maybe_command($candidate);
+    unless ($perl) {
+	my ($component,$perl_name);
+      DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
+	    PATH_COMPONENT: foreach $component (MM->path(),
+						$Config::Config{'binexp'}) {
+		  next unless defined($component) && $component;
+		  my($abs) = MM->catfile($component,$perl_name);
+		  if (MM->maybe_command($abs)) {
+		      $perl = $abs;
+		      last DIST_PERLNAME;
+		  }
+	      }
+	  }
+    }
+    $perl;
+}
+
+#-> sub CPAN::Distribution::make ;
+sub make {
+    my($self) = @_;
+    $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
+    # Emergency brake if they said install Pippi and get newest perl
+    if ($self->isa_perl) {
+      if (
+	  $self->called_for ne $self->id && ! $self->{'force_update'}
+	 ) {
+	$CPAN::Frontend->mydie(sprintf qq{
+The most recent version "%s" of the module "%s"
+comes with the current version of perl (%s).
+I\'ll build that only if you ask for something like
+    force install %s
+or
+    install %s
+},
+			       $CPAN::META->instance(
+						     'CPAN::Module',
+						     $self->called_for
+						    )->cpan_version,
+			       $self->called_for,
+			       $self->isa_perl,
+			       $self->called_for,
+			       $self->id);
+      }
+    }
+    $self->get;
+  EXCUSE: {
+	my @e;
+	$self->{archived} eq "NO" and push @e,
+	"Is neither a tar nor a zip archive.";
+
+	$self->{unwrapped} eq "NO" and push @e,
+	"had problems unarchiving. Please build manually";
+
+	exists $self->{writemakefile} &&
+	    $self->{writemakefile} eq "NO" and push @e,
+	    "Had some problem writing Makefile";
+
+	defined $self->{'make'} and push @e,
+	"Has already been processed within this session";
+
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    $CPAN::Frontend->myprint("\n  CPAN.pm: Going to build ".$self->id."\n\n");
+    my $builddir = $self->dir;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+
+    my $system;
+    if ($self->{'configure'}) {
+      $system = $self->{'configure'};
+    } else {
+	my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
+	my $switch = "";
+# This needs a handler that can be turned on or off:
+#	$switch = "-MExtUtils::MakeMaker ".
+#	    "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
+#	    if $] > 5.00310;
+	$system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
+    }
+    unless (exists $self->{writemakefile}) {
+	local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
+	my($ret,$pid);
+	$@ = "";
+	if ($CPAN::Config->{inactivity_timeout}) {
+	    eval {
+		alarm $CPAN::Config->{inactivity_timeout};
+		local $SIG{CHLD} = sub { wait };
+		if (defined($pid = fork)) {
+		    if ($pid) { #parent
+			wait;
+		    } else {    #child
+		      # note, this exec isn't necessary if
+		      # inactivity_timeout is 0. On the Mac I'd
+		      # suggest, we set it always to 0.
+		      exec $system;
+		    }
+		} else {
+		    $CPAN::Frontend->myprint("Cannot fork: $!");
+		    return;
+		}
+	    };
+	    alarm 0;
+	    if ($@){
+		kill 9, $pid;
+		waitpid $pid, 0;
+		$CPAN::Frontend->myprint($@);
+		$self->{writemakefile} = "NO - $@";
+		$@ = "";
+		return;
+	    }
+	} else {
+	  if (0) {
+	    warn "Trying to intercept the output of 'perl Makefile.PL'";
+	    require IO::File;
+	    # my $fh = FileHandle->new("$system 2>&1 |") or
+	    my $fh = IO::File->new("$system 2>&1 |") or
+		die "Couldn't run '$system': $!";
+	    local($|) = 1;
+	    while (length($_ = getc($fh))) {
+	      print $_; # we want to parse that some day!
+	      # unfortunately we have Makefile.PLs that want to talk
+	      # and we can't emulate that reliably. I think, we have
+	      # to parse Makefile.PL directly
+	    }
+	    $ret = $fh->close;
+	    unless ($ret) {
+	      warn $! ? "Error during 'perl Makefile.PL' subprocess: $!" :
+		  "Exit status of 'perl Makefile.PL': $?";
+	      $self->{writemakefile} = "NO";
+	      return;
+	    }
+	  } else {
+	    $ret = system($system);
+	    if ($ret != 0) {
+	      $self->{writemakefile} = "NO";
+	      return;
+	    }
+	  }
+	}
+	$self->{writemakefile} = "YES";
+    }
+    return if $CPAN::Signal;
+    $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
+    if (system($system) == 0) {
+	 $CPAN::Frontend->myprint("  $system -- OK\n");
+	 $self->{'make'} = "YES";
+    } else {
+	 $self->{writemakefile} = "YES";
+	 $self->{'make'} = "NO";
+	 $CPAN::Frontend->myprint("  $system -- NOT OK\n");
+    }
+}
+
+#-> sub CPAN::Distribution::test ;
+sub test {
+    my($self) = @_;
+    $self->make;
+    return if $CPAN::Signal;
+    $CPAN::Frontend->myprint("Running make test\n");
+  EXCUSE: {
+	my @e;
+	exists $self->{'make'} or push @e,
+	"Make had some problems, maybe interrupted? Won't test";
+
+	exists $self->{'make'} and
+	    $self->{'make'} eq 'NO' and
+		push @e, "Oops, make had returned bad status";
+
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    chdir $self->{'build_dir'} or
+	Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}")
+	if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "test";
+    if (system($system) == 0) {
+	 $CPAN::Frontend->myprint("  $system -- OK\n");
+	 $self->{'make_test'} = "YES";
+    } else {
+	 $self->{'make_test'} = "NO";
+	 $CPAN::Frontend->myprint("  $system -- NOT OK\n");
+    }
+}
+
+#-> sub CPAN::Distribution::clean ;
+sub clean {
+    my($self) = @_;
+    $CPAN::Frontend->myprint("Running make clean\n");
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    chdir $self->{'build_dir'} or
+	Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "clean";
+    if (system($system) == 0) {
+	$CPAN::Frontend->myprint("  $system -- OK\n");
+	$self->force;
+    } else {
+	# Hmmm, what to do if make clean failed?
+    }
+}
+
+#-> sub CPAN::Distribution::install ;
+sub install {
+    my($self) = @_;
+    $self->test;
+    return if $CPAN::Signal;
+    $CPAN::Frontend->myprint("Running make install\n");
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+
+	exists $self->{'make'} or push @e,
+	"Make had some problems, maybe interrupted? Won't install";
+
+	exists $self->{'make'} and
+	    $self->{'make'} eq 'NO' and
+		push @e, "Oops, make had returned bad status";
+
+	push @e, "make test had returned bad status, ".
+	    "won't install without force"
+	    if exists $self->{'make_test'} and
+	    $self->{'make_test'} eq 'NO' and
+	    ! $self->{'force_update'};
+
+	exists $self->{'install'} and push @e,
+	$self->{'install'} eq "YES" ?
+	    "Already done" : "Already tried without success";
+
+	$CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
+    }
+    chdir $self->{'build_dir'} or
+	Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}")
+	if $CPAN::DEBUG;
+    my $system = join(" ", $CPAN::Config->{'make'},
+		      "install", $CPAN::Config->{make_install_arg});
+    my($pipe) = FileHandle->new("$system 2>&1 |");
+    my($makeout) = "";
+    while (<$pipe>){
+	$CPAN::Frontend->myprint($_);
+	$makeout .= $_;
+    }
+    $pipe->close;
+    if ($?==0) {
+	 $CPAN::Frontend->myprint("  $system -- OK\n");
+	 $self->{'install'} = "YES";
+    } else {
+	 $self->{'install'} = "NO";
+	 $CPAN::Frontend->myprint("  $system -- NOT OK\n");
+	 if ($makeout =~ /permission/s && $> > 0) {
+	     $CPAN::Frontend->myprint(qq{    You may have to su }.
+				      qq{to root to install the package\n});
+	 }
+    }
+}
+
+#-> sub CPAN::Distribution::dir ;
+sub dir {
+    shift->{'build_dir'};
+}
+
+package CPAN::Bundle;
+
+#-> sub CPAN::Bundle::as_string ;
+sub as_string {
+    my($self) = @_;
+    $self->contains;
+    $self->{INST_VERSION} = $self->inst_version;
+    return $self->SUPER::as_string;
+}
+
+#-> sub CPAN::Bundle::contains ;
+sub contains {
+    my($self) = @_;
+    my($parsefile) = $self->inst_file;
+    my($id) = $self->id;
+    $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
+    unless ($parsefile) {
+	# Try to get at it in the cpan directory
+	$self->debug("no parsefile") if $CPAN::DEBUG;
+	Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
+	my $dist = $CPAN::META->instance('CPAN::Distribution',
+					 $self->{CPAN_FILE});
+	$dist->get;
+	$self->debug($dist->as_string) if $CPAN::DEBUG;
+	my($todir) = $CPAN::Config->{'cpan_home'};
+	my(@me,$from,$to,$me);
+	@me = split /::/, $self->id;
+	$me[-1] .= ".pm";
+	$me = MM->catfile(@me);
+	$from = $self->find_bundle_file($dist->{'build_dir'},$me);
+	$to = MM->catfile($todir,$me);
+	File::Path::mkpath(File::Basename::dirname($to));
+	File::Copy::copy($from, $to)
+	    or Carp::confess("Couldn't copy $from to $to: $!");
+	$parsefile = $to;
+    }
+    my @result;
+    my $fh = FileHandle->new;
+    local $/ = "\n";
+    open($fh,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
+    while (<$fh>) {
+	$inpod = /^=(?!head1\s+CONTENTS)/ ? 0 :
+	    /^=head1\s+CONTENTS/ ? 1 : $inpod;
+	next unless $inpod;
+	next if /^=/;
+	next if /^\s+$/;
+	chomp;
+	push @result, (split " ", $_, 2)[0];
+    }
+    close $fh;
+    delete $self->{STATUS};
+    $self->{CONTAINS} = join ", ", @result;
+    $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
+    @result;
+}
+
+#-> sub CPAN::Bundle::find_bundle_file
+sub find_bundle_file {
+    my($self,$where,$what) = @_;
+    $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
+    my $bu = MM->catfile($where,$what);
+    return $bu if -f $bu;
+    my $manifest = MM->catfile($where,"MANIFEST");
+    unless (-f $manifest) {
+	require ExtUtils::Manifest;
+	my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+	my $cwd = CPAN->$getcwd();
+	chdir $where;
+	ExtUtils::Manifest::mkmanifest();
+	chdir $cwd;
+    }
+    my $fh = FileHandle->new($manifest)
+	or Carp::croak("Couldn't open $manifest: $!");
+    local($/) = "\n";
+    while (<$fh>) {
+	next if /^\s*\#/;
+	my($file) = /(\S+)/;
+	if ($file =~ m|\Q$what\E$|) {
+	    $bu = $file;
+	    return MM->catfile($where,$bu);
+	} elsif ($what =~ s|Bundle/||) { # retry if she managed to
+                                         # have no Bundle directory
+	    if ($file =~ m|\Q$what\E$|) {
+		$bu = $file;
+		return MM->catfile($where,$bu);
+	    }
+	}
+    }
+    Carp::croak("Couldn't find a Bundle file in $where");
+}
+
+#-> sub CPAN::Bundle::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($me,$inst_file);
+    ($me = $self->id) =~ s/.*://;
+##    my(@me,$inst_file);
+##    @me = split /::/, $self->id;
+##    $me[-1] .= ".pm";
+    $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
+				      "Bundle", "$me.pm");
+##				      "Bundle", @me);
+    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+#    $inst_file =
+    $self->SUPER::inst_file;
+#    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+#    return $self->{'INST_FILE'}; # even if undefined?
+}
+
+#-> sub CPAN::Bundle::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
+    my($id) = $self->id;
+    Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
+	unless $self->inst_file || $self->{CPAN_FILE};
+    my($s);
+    for $s ($self->contains) {
+	my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
+	    $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
+	if ($type eq 'CPAN::Distribution') {
+	    $CPAN::Frontend->mywarn(qq{
+The Bundle }.$self->id.qq{ contains
+explicitly a file $s.
+});
+	    sleep 3;
+	}
+	$CPAN::META->instance($type,$s)->$meth();
+    }
+}
+
+#sub CPAN::Bundle::xs_file
+sub xs_file {
+    # If a bundle contains another that contains an xs_file we have
+    # here, we just don't bother I suppose
+    return 0;
+}
+
+#-> sub CPAN::Bundle::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Bundle::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Bundle::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Bundle::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Bundle::install ;
+sub install {
+  my $self = shift;
+  $self->rematein('install',@_);
+  $CPAN::META->delete('CPAN::Queue',$self->id);
+}
+#-> sub CPAN::Bundle::clean ;
+sub clean   { shift->rematein('clean',@_); }
+
+#-> sub CPAN::Bundle::readme ;
+sub readme  {
+    my($self) = @_;
+    my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
+No File found for bundle } . $self->id . qq{\n}), return;
+    $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
+    $CPAN::META->instance('CPAN::Distribution',$file)->readme;
+}
+
+package CPAN::Module;
+
+#-> sub CPAN::Module::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
+		     $self->cpan_file);
+    join "", @m;
+}
+
+#-> sub CPAN::Module::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    CPAN->debug($self) if $CPAN::DEBUG;
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    local($^W) = 0;
+    push @m, $class, " id = $self->{ID}\n";
+    my $sprintf = "    %-12s %s\n";
+    push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
+	if $self->{description};
+    my $sprintf2 = "    %-12s %s (%s)\n";
+    my($userid);
+    if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
+	my $author;
+	if ($author = CPAN::Shell->expand('Author',$userid)) {
+	  my $email = "";
+	  my $m; # old perls
+	  if ($m = $author->email) {
+            $email = " <$m>";
+          }
+	  push @m, sprintf(
+			   $sprintf2,
+			   'CPAN_USERID',
+			   $userid,
+			   $author->fullname . $email
+			  );
+	}
+    }
+    push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
+	if $self->{CPAN_VERSION};
+    push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
+	if $self->{CPAN_FILE};
+    my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
+    my(%statd,%stats,%statl,%stati);
+    @statd{qw,? i c a b R M S,} = qw,unknown idea
+	pre-alpha alpha beta released mature standard,;
+    @stats{qw,? m d u n,}       = qw,unknown mailing-list
+	developer comp.lang.perl.* none,;
+    @statl{qw,? p c + o,}       = qw,unknown perl C C++ other,;
+    @stati{qw,? f r O,}         = qw,unknown functions
+	references+ties object-oriented,;
+    $statd{' '} = 'unknown';
+    $stats{' '} = 'unknown';
+    $statl{' '} = 'unknown';
+    $stati{' '} = 'unknown';
+    push @m, sprintf(
+		     $sprintf3,
+		     'DSLI_STATUS',
+		     $self->{statd},
+		     $self->{stats},
+		     $self->{statl},
+		     $self->{stati},
+		     $statd{$self->{statd}},
+		     $stats{$self->{stats}},
+		     $statl{$self->{statl}},
+		     $stati{$self->{stati}}
+		    ) if $self->{statd};
+    my $local_file = $self->inst_file;
+    if ($local_file) {
+      $self->{MANPAGE} ||= $self->manpage_headline($local_file);
+    }
+    my($item);
+    for $item (qw/MANPAGE CONTAINS/) {
+	push @m, sprintf($sprintf, $item, $self->{$item})
+	    if exists $self->{$item};
+    }
+    push @m, sprintf($sprintf, 'INST_FILE',
+		     $local_file || "(not installed)");
+    push @m, sprintf($sprintf, 'INST_VERSION',
+		     $self->inst_version) if $local_file;
+    join "", @m, "\n";
+}
+
+sub manpage_headline {
+  my($self,$local_file) = @_;
+  my(@local_file) = $local_file;
+  $local_file =~ s/\.pm$/.pod/;
+  push @local_file, $local_file;
+  my(@result,$locf);
+  for $locf (@local_file) {
+    next unless -f $locf;
+    my $fh = FileHandle->new($locf)
+	or $Carp::Frontend->mydie("Couldn't open $locf: $!");
+    my $inpod = 0;
+    local $/ = "\n";
+    while (<$fh>) {
+      $inpod = /^=(?!head1\s+NAME)/ ? 0 :
+	  /^=head1\s+NAME/ ? 1 : $inpod;
+      next unless $inpod;
+      next if /^=/;
+      next if /^\s+$/;
+      chomp;
+      push @result, $_;
+    }
+    close $fh;
+    last if @result;
+  }
+  join " ", @result;
+}
+
+#-> sub CPAN::Module::cpan_file ;
+sub cpan_file    {
+    my $self = shift;
+    CPAN->debug($self->id) if $CPAN::DEBUG;
+    unless (defined $self->{'CPAN_FILE'}) {
+	CPAN::Index->reload;
+    }
+    if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
+	return $self->{'CPAN_FILE'};
+    } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
+	my $fullname = $CPAN::META->instance(CPAN::Author,
+				      $self->{'userid'})->fullname;
+	my $email = $CPAN::META->instance(CPAN::Author,
+				      $self->{'userid'})->email;
+	unless (defined $fullname && defined $email) {
+	    return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
+	}
+	return "Contact Author $fullname <$email>";
+    } else {
+	return "N/A";
+    }
+}
+
+*name = \&cpan_file;
+
+#-> sub CPAN::Module::cpan_version ;
+sub cpan_version {
+    my $self = shift;
+    $self->{'CPAN_VERSION'} = 'undef' 
+	unless defined $self->{'CPAN_VERSION'}; # I believe this is
+                                                # always a bug in the
+                                                # index and should be
+                                                # reported as such,
+                                                # but usually I find
+                                                # out such an error
+                                                # and do not want to
+                                                # provoke too many
+                                                # bugreports
+    $self->{'CPAN_VERSION'};
+}
+
+#-> sub CPAN::Module::force ;
+sub force {
+    my($self) = @_;
+    $self->{'force_update'}++;
+}
+
+#-> sub CPAN::Module::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug($self->id) if $CPAN::DEBUG;
+    my $cpan_file = $self->cpan_file;
+    if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
+      $CPAN::Frontend->mywarn(sprintf qq{
+  The module %s isn\'t available on CPAN.
+
+  Either the module has not yet been uploaded to CPAN, or it is
+  temporary unavailable. Please contact the author to find out
+  more about the status. Try ``i %s''.
+},
+			      $self->id,
+			      $self->id,
+			     );
+      return;
+    }
+    my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+    $pack->called_for($self->id);
+    $pack->force if exists $self->{'force_update'};
+    $pack->$meth();
+    delete $self->{'force_update'};
+}
+
+#-> sub CPAN::Module::readme ;
+sub readme { shift->rematein('readme') }
+#-> sub CPAN::Module::look ;
+sub look { shift->rematein('look') }
+#-> sub CPAN::Module::get ;
+sub get    { shift->rematein('get',@_); }
+#-> sub CPAN::Module::make ;
+sub make   { shift->rematein('make') }
+#-> sub CPAN::Module::test ;
+sub test   { shift->rematein('test') }
+#-> sub CPAN::Module::install ;
+sub install {
+    my($self) = @_;
+    my($doit) = 0;
+    my($latest) = $self->cpan_version;
+    $latest ||= 0;
+    my($inst_file) = $self->inst_file;
+    my($have) = 0;
+    if (defined $inst_file) {
+	$have = $self->inst_version;
+    }
+    if (1){ # A block for scoping $^W, the if is just for the visual
+            # appeal
+	local($^W)=0;
+	if ($inst_file
+	    &&
+	    $have >= $latest
+	    &&
+	    not exists $self->{'force_update'}
+	   ) {
+	    $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
+	} else {
+	    $doit = 1;
+	}
+    }
+    $self->rematein('install') if $doit;
+    $CPAN::META->delete('CPAN::Queue',$self->id);
+}
+#-> sub CPAN::Module::clean ;
+sub clean  { shift->rematein('clean') }
+
+#-> sub CPAN::Module::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    $packpath[-1] .= ".pm";
+    foreach $dir (@INC) {
+	my $pmfile = MM->catfile($dir,@packpath);
+	if (-f $pmfile){
+	    return $pmfile;
+	}
+    }
+    return;
+}
+
+#-> sub CPAN::Module::xs_file ;
+sub xs_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    push @packpath, $packpath[-1];
+    $packpath[-1] .= "." . $Config::Config{'dlext'};
+    foreach $dir (@INC) {
+	my $xsfile = MM->catfile($dir,'auto',@packpath);
+	if (-f $xsfile){
+	    return $xsfile;
+	}
+    }
+    return;
+}
+
+#-> sub CPAN::Module::inst_version ;
+sub inst_version {
+    my($self) = @_;
+    my $parsefile = $self->inst_file or return;
+    local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
+    my $have = MM->parse_version($parsefile) || "undef";
+    $have =~ s/\s+//g;
+    $have;
+}
+
+package CPAN::Tarzip;
+
+sub gzip {
+  my($class,$read,$write) = @_;
+  if ($CPAN::META->has_inst("Compress::Zlib")) {
+    my($buffer,$fhw);
+    $fhw = FileHandle->new($read)
+	or $CPAN::Frontend->mydie("Could not open $read: $!");
+    my $gz = Compress::Zlib::gzopen($write, "wb")
+	or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
+    $gz->gzwrite($buffer)
+	while read($fhw,$buffer,4096) > 0 ;
+    $gz->gzclose() ;
+    $fhw->close;
+    return 1;
+  } else {
+    system("$CPAN::Config->{'gzip'} -c $read > $write")==0;  
+  }
+}
+
+sub gunzip {
+  my($class,$read,$write) = @_;
+  if ($CPAN::META->has_inst("Compress::Zlib")) {
+    my($buffer,$fhw);
+    $fhw = FileHandle->new(">$write")
+	or $CPAN::Frontend->mydie("Could not open >$write: $!");
+    my $gz = Compress::Zlib::gzopen($read, "rb")
+	or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
+    $fhw->print($buffer)
+	while $gz->gzread($buffer) > 0 ;
+    $CPAN::Frontend->mydie("Error reading from $read: $!\n")
+	if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
+    $gz->gzclose() ;
+    $fhw->close;
+    return 1;
+  } else {
+    system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
+  }
+}
+
+sub gtest {
+  my($class,$read) = @_;
+  if ($CPAN::META->has_inst("Compress::Zlib")) {
+    my($buffer);
+    my $gz = Compress::Zlib::gzopen($read, "rb")
+	or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
+    1 while $gz->gzread($buffer) > 0 ;
+    $CPAN::Frontend->mydie("Error reading from $read: $!\n")
+	if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
+    $gz->gzclose() ;
+    return 1;
+  } else {
+    return system("$CPAN::Config->{'gzip'} -dt $read")==0;
+  }
+}
+
+sub TIEHANDLE {
+  my($class,$file) = @_;
+  my $ret;
+  $class->debug("file[$file]");
+  if ($CPAN::META->has_inst("Compress::Zlib")) {
+    my $gz = Compress::Zlib::gzopen($file,"rb") or
+	die "Could not gzopen $file";
+    $ret = bless {GZ => $gz}, $class;
+  } else {
+    my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
+    my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
+    binmode $fh;
+    $ret = bless {FH => $fh}, $class;
+  }
+  $ret;
+}
+
+sub READLINE {
+  my($self) = @_;
+  if (exists $self->{GZ}) {
+    my $gz = $self->{GZ};
+    my($line,$bytesread);
+    $bytesread = $gz->gzreadline($line);
+    return undef if $bytesread == 0;
+    return $line;
+  } else {
+    my $fh = $self->{FH};
+    return scalar <$fh>;
+  }
+}
+
+sub READ {
+  my($self,$ref,$length,$offset) = @_;
+  die "read with offset not implemented" if defined $offset;
+  if (exists $self->{GZ}) {
+    my $gz = $self->{GZ};
+    my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
+    return $byteread;
+  } else {
+    my $fh = $self->{FH};
+    return read($fh,$$ref,$length);
+  }
+}
+
+sub DESTROY {
+  my($self) = @_;
+  if (exists $self->{GZ}) {
+    my $gz = $self->{GZ};
+    $gz->gzclose();
+  } else {
+    my $fh = $self->{FH};
+    $fh->close;
+  }
+  undef $self;
+}
+
+sub untar {
+  my($class,$file) = @_;
+  # had to disable, because version 0.07 seems to be buggy
+  if (MM->maybe_command($CPAN::Config->{'gzip'})
+      &&
+      MM->maybe_command($CPAN::Config->{'tar'})) {
+    my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
+	"$file | $CPAN::Config->{tar} xvf -";
+    return system($system) == 0;
+  } elsif ($CPAN::META->has_inst("Archive::Tar")
+      &&
+      $CPAN::META->has_inst("Compress::Zlib") ) {
+    my $tar = Archive::Tar->new($file,1);
+    $tar->extract($tar->list_files); # I'm pretty sure we have nothing
+                                     # that isn't compressed
+    return 1;
+  } else {
+    $CPAN::Frontend->mydie(qq{
+CPAN.pm needs either both external programs tar and gzip installed or
+both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
+is available. Can\'t continue.
+});
+  }
+}
+
+package CPAN;
+
+1;
+
+__END__
+
+=head1 NAME
+
+CPAN - query, download and build perl modules from CPAN sites
+
+=head1 SYNOPSIS
+
+Interactive mode:
+
+  perl -MCPAN -e shell;
+
+Batch mode:
+
+  use CPAN;
+
+  autobundle, clean, install, make, recompile, test
+
+=head1 DESCRIPTION
+
+The CPAN module is designed to automate the make and install of perl
+modules and extensions. It includes some searching capabilities and
+knows how to use Net::FTP or LWP (or lynx or an external ftp client)
+to fetch the raw data from the net.
+
+Modules are fetched from one or more of the mirrored CPAN
+(Comprehensive Perl Archive Network) sites and unpacked in a dedicated
+directory.
+
+The CPAN module also supports the concept of named and versioned
+'bundles' of modules. Bundles simplify the handling of sets of
+related modules. See BUNDLES below.
+
+The package contains a session manager and a cache manager. There is
+no status retained between sessions. The session manager keeps track
+of what has been fetched, built and installed in the current
+session. The cache manager keeps track of the disk space occupied by
+the make processes and deletes excess space according to a simple FIFO
+mechanism.
+
+All methods provided are accessible in a programmer style and in an
+interactive shell style.
+
+=head2 Interactive Mode
+
+The interactive mode is entered by running
+
+    perl -MCPAN -e shell
+
+which puts you into a readline interface. You will have the most fun if
+you install Term::ReadKey and Term::ReadLine to enjoy both history and
+command completion.
+
+Once you are on the command line, type 'h' and the rest should be
+self-explanatory.
+
+The most common uses of the interactive modes are
+
+=over 2
+
+=item Searching for authors, bundles, distribution files and modules
+
+There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
+for each of the four categories and another, C<i> for any of the
+mentioned four. Each of the four entities is implemented as a class
+with slightly differing methods for displaying an object.
+
+Arguments you pass to these commands are either strings exactly matching
+the identification string of an object or regular expressions that are
+then matched case-insensitively against various attributes of the
+objects. The parser recognizes a regular expression only if you
+enclose it between two slashes.
+
+The principle is that the number of found objects influences how an
+item is displayed. If the search finds one item, the result is displayed
+as object-E<gt>as_string, but if we find more than one, we display
+each as object-E<gt>as_glimpse. E.g.
+
+    cpan> a ANDK
+    Author id = ANDK
+	EMAIL        a.koenig@franz.ww.TU-Berlin.DE
+	FULLNAME     Andreas König
+
+
+    cpan> a /andk/
+    Author id = ANDK
+	EMAIL        a.koenig@franz.ww.TU-Berlin.DE
+	FULLNAME     Andreas König
+
+
+    cpan> a /and.*rt/
+    Author          ANDYD (Andy Dougherty)
+    Author          MERLYN (Randal L. Schwartz)
+
+=item make, test, install, clean  modules or distributions
+
+These commands take any number of arguments and investigate what is
+necessary to perform the action. If the argument is a distribution
+file name (recognized by embedded slashes), it is processed. If it is a
+module, CPAN determines the distribution file in which this module is
+included and processes that.
+
+Any C<make> or C<test> are run unconditionally. An
+
+  install <distribution_file>
+
+also is run unconditionally. But for
+
+  install <module>
+
+CPAN checks if an install is actually needed for it and prints
+I<module up to date> in the case that the distribution file containing
+the module doesnE<39>t need to be updated.
+
+CPAN also keeps track of what it has done within the current session
+and doesnE<39>t try to build a package a second time regardless if it
+succeeded or not. The C<force> command takes as a first argument the
+method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
+command from scratch.
+
+Example:
+
+    cpan> install OpenGL
+    OpenGL is up to date.
+    cpan> force install OpenGL
+    Running make
+    OpenGL-0.4/
+    OpenGL-0.4/COPYRIGHT
+    [...]
+
+A C<clean> command results in a 
+
+  make clean
+
+being executed within the distribution file's working directory.
+
+=item readme, look module or distribution
+
+These two commands take only one argument, be it a module or a
+distribution file. C<readme> unconditionally runs, displaying the
+README of the associated distribution file. C<Look> gets and
+untars (if not yet done) the distribution file, changes to the
+appropriate directory and opens a subshell process in that directory.
+
+=item Signals
+
+CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
+in the cpan-shell it is intended that you can press C<^C> anytime and
+return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
+to clean up and leave the shell loop. You can emulate the effect of a
+SIGTERM by sending two consecutive SIGINTs, which usually means by
+pressing C<^C> twice.
+
+CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
+SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
+
+=back
+
+=head2 CPAN::Shell
+
+The commands that are available in the shell interface are methods in
+the package CPAN::Shell. If you enter the shell command, all your
+input is split by the Text::ParseWords::shellwords() routine which
+acts like most shells do. The first word is being interpreted as the
+method to be called and the rest of the words are treated as arguments
+to this method. Continuation lines are supported if a line ends with a
+literal backslash.
+
+=head2 autobundle
+
+C<autobundle> writes a bundle file into the
+C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
+a list of all modules that are both available from CPAN and currently
+installed within @INC. The name of the bundle file is based on the
+current date and a counter.
+
+=head2 recompile
+
+recompile() is a very special command in that it takes no argument and
+runs the make/test/install cycle with brute force over all installed
+dynamically loadable extensions (aka XS modules) with 'force' in
+effect. The primary purpose of this command is to finish a network
+installation. Imagine, you have a common source tree for two different
+architectures. You decide to do a completely independent fresh
+installation. You start on one architecture with the help of a Bundle
+file produced earlier. CPAN installs the whole Bundle for you, but
+when you try to repeat the job on the second architecture, CPAN
+responds with a C<"Foo up to date"> message for all modules. So you
+invoke CPAN's recompile on the second architecture and youE<39>re done.
+
+Another popular use for C<recompile> is to act as a rescue in case your
+perl breaks binary compatibility. If one of the modules that CPAN uses
+is in turn depending on binary compatibility (so you cannot run CPAN
+commands), then you should try the CPAN::Nox module for recovery.
+
+=head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
+
+Although it may be considered internal, the class hierarchy does matter
+for both users and programmer. CPAN.pm deals with above mentioned four
+classes, and all those classes share a set of methods. A classical
+single polymorphism is in effect. A metaclass object registers all
+objects of all kinds and indexes them with a string. The strings
+referencing objects have a separated namespace (well, not completely
+separated):
+
+         Namespace                         Class
+
+   words containing a "/" (slash)      Distribution
+    words starting with Bundle::          Bundle
+          everything else            Module or Author
+
+Modules know their associated Distribution objects. They always refer
+to the most recent official release. Developers may mark their releases
+as unstable development versions (by inserting an underbar into the
+visible version number), so the really hottest and newest distribution
+file is not always the default.  If a module Foo circulates on CPAN in
+both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
+install version 1.23 by saying
+
+    install Foo
+
+This would install the complete distribution file (say
+BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
+like to install version 1.23_90, you need to know where the
+distribution file resides on CPAN relative to the authors/id/
+directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
+so you would have to say
+
+    install BAR/Foo-1.23_90.tar.gz
+
+The first example will be driven by an object of the class
+CPAN::Module, the second by an object of class CPAN::Distribution.
+
+=head2 ProgrammerE<39>s interface
+
+If you do not enter the shell, the available shell commands are both
+available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
+functions in the calling package (C<install(...)>).
+
+There's currently only one class that has a stable interface -
+CPAN::Shell. All commands that are available in the CPAN shell are
+methods of the class CPAN::Shell. Each of the commands that produce
+listings of modules (C<r>, C<autobundle>, C<u>) returns a list of the
+IDs of all modules within the list.
+
+=over 2
+
+=item expand($type,@things)
+
+The IDs of all objects available within a program are strings that can
+be expanded to the corresponding real objects with the
+C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
+list of CPAN::Module objects according to the C<@things> arguments
+given. In scalar context it only returns the first element of the
+list.
+
+=item Programming Examples
+
+This enables the programmer to do operations that combine
+functionalities that are available in the shell.
+
+    # install everything that is outdated on my disk:
+    perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
+
+    # install my favorite programs if necessary:
+    for $mod (qw(Net::FTP MD5 Data::Dumper)){
+        my $obj = CPAN::Shell->expand('Module',$mod);
+        $obj->install;
+    }
+
+    # list all modules on my disk that have no VERSION number
+    for $mod (CPAN::Shell->expand("Module","/./")){
+	next unless $mod->inst_file;
+        # MakeMaker convention for undefined $VERSION:
+	next unless $mod->inst_version eq "undef";
+	print "No VERSION in ", $mod->id, "\n";
+    }
+
+=back
+
+=head2 Methods in the four
+
+=head2 Cache Manager
+
+Currently the cache manager only keeps track of the build directory
+($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
+deletes complete directories below C<build_dir> as soon as the size of
+all directories there gets bigger than $CPAN::Config->{build_cache}
+(in MB). The contents of this cache may be used for later
+re-installations that you intend to do manually, but will never be
+trusted by CPAN itself. This is due to the fact that the user might
+use these directories for building modules on different architectures.
+
+There is another directory ($CPAN::Config->{keep_source_where}) where
+the original distribution files are kept. This directory is not
+covered by the cache manager and must be controlled by the user. If
+you choose to have the same directory as build_dir and as
+keep_source_where directory, then your sources will be deleted with
+the same fifo mechanism.
+
+=head2 Bundles
+
+A bundle is just a perl module in the namespace Bundle:: that does not
+define any functions or methods. It usually only contains documentation.
+
+It starts like a perl module with a package declaration and a $VERSION
+variable. After that the pod section looks like any other pod with the
+only difference being that I<one special pod section> exists starting with
+(verbatim):
+
+	=head1 CONTENTS
+
+In this pod section each line obeys the format
+
+        Module_Name [Version_String] [- optional text]
+
+The only required part is the first field, the name of a module
+(e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
+of the line is optional. The comment part is delimited by a dash just
+as in the man page header.
+
+The distribution of a bundle should follow the same convention as
+other distributions.
+
+Bundles are treated specially in the CPAN package. If you say 'install
+Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
+the modules in the CONTENTS section of the pod. You can install your
+own Bundles locally by placing a conformant Bundle file somewhere into
+your @INC path. The autobundle() command which is available in the
+shell interface does that for you by including all currently installed
+modules in a snapshot bundle file.
+
+=head2 Prerequisites
+
+If you have a local mirror of CPAN and can access all files with
+"file:" URLs, then you only need a perl better than perl5.003 to run
+this module. Otherwise Net::FTP is strongly recommended. LWP may be
+required for non-UNIX systems or if your nearest CPAN site is
+associated with an URL that is not C<ftp:>.
+
+If you have neither Net::FTP nor LWP, there is a fallback mechanism
+implemented for an external ftp command or for an external lynx
+command.
+
+=head2 Finding packages and VERSION
+
+This module presumes that all packages on CPAN
+
+=over 2
+
+=item *
+
+declare their $VERSION variable in an easy to parse manner. This
+prerequisite can hardly be relaxed because it consumes far too much
+memory to load all packages into the running program just to determine
+the $VERSION variable. Currently all programs that are dealing with
+version use something like this
+
+    perl -MExtUtils::MakeMaker -le \
+        'print MM->parse_version($ARGV[0])' filename
+
+If you are author of a package and wonder if your $VERSION can be
+parsed, please try the above method.
+
+=item *
+
+come as compressed or gzipped tarfiles or as zip files and contain a
+Makefile.PL (well, we try to handle a bit more, but without much
+enthusiasm).
+
+=back
+
+=head2 Debugging
+
+The debugging of this module is pretty difficult, because we have
+interferences of the software producing the indices on CPAN, of the
+mirroring process on CPAN, of packaging, of configuration, of
+synchronicity, and of bugs within CPAN.pm.
+
+In interactive mode you can try "o debug" which will list options for
+debugging the various parts of the package. The output may not be very
+useful for you as it's just a by-product of my own testing, but if you
+have an idea which part of the package may have a bug, it's sometimes
+worth to give it a try and send me more specific output. You should
+know that "o debug" has built-in completion support.
+
+=head2 Floppy, Zip, and all that Jazz
+
+CPAN.pm works nicely without network too. If you maintain machines
+that are not networked at all, you should consider working with file:
+URLs. Of course, you have to collect your modules somewhere first. So
+you might use CPAN.pm to put together all you need on a networked
+machine. Then copy the $CPAN::Config->{keep_source_where} (but not
+$CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
+of a personal CPAN. CPAN.pm on the non-networked machines works nicely
+with this floppy.
+
+=head1 CONFIGURATION
+
+When the CPAN module is installed, a site wide configuration file is
+created as CPAN/Config.pm. The default values defined there can be
+overridden in another configuration file: CPAN/MyConfig.pm. You can
+store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
+$HOME/.cpan is added to the search path of the CPAN module before the
+use() or require() statements.
+
+Currently the following keys in the hash reference $CPAN::Config are
+defined:
+
+  build_cache        size of cache for directories to build modules
+  build_dir          locally accessible directory to build modules
+  index_expire       after this many days refetch index files
+  cpan_home          local directory reserved for this package
+  gzip		     location of external program gzip
+  inactivity_timeout breaks interactive Makefile.PLs after this
+                     many seconds inactivity. Set to 0 to never break.
+  inhibit_startup_message
+                     if true, does not print the startup message
+  keep_source        keep the source in a local directory?
+  keep_source_where  directory in which to keep the source (if we do)
+  make               location of external make program
+  make_arg	     arguments that should always be passed to 'make'
+  make_install_arg   same as make_arg for 'make install'
+  makepl_arg	     arguments passed to 'perl Makefile.PL'
+  pager              location of external program more (or any pager)
+  tar                location of external program tar
+  unzip              location of external program unzip
+  urllist	     arrayref to nearby CPAN sites (or equivalent locations)
+  wait_list          arrayref to a wait server to try (See CPAN::WAIT)
+
+You can set and query each of these options interactively in the cpan
+shell with the command set defined within the C<o conf> command:
+
+=over 2
+
+=item o conf E<lt>scalar optionE<gt>
+
+prints the current value of the I<scalar option>
+
+=item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
+
+Sets the value of the I<scalar option> to I<value>
+
+=item o conf E<lt>list optionE<gt>
+
+prints the current value of the I<list option> in MakeMaker's
+neatvalue format.
+
+=item o conf E<lt>list optionE<gt> [shift|pop]
+
+shifts or pops the array in the I<list option> variable
+
+=item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
+
+works like the corresponding perl commands.
+
+=back
+
+=head2 CD-ROM support
+
+The C<urllist> parameter of the configuration table contains a list of
+URLs that are to be used for downloading. If the list contains any
+C<file> URLs, CPAN always tries to get files from there first. This
+feature is disabled for index files. So the recommendation for the
+owner of a CD-ROM with CPAN contents is: include your local, possibly
+outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
+
+  o conf urllist push file://localhost/CDROM/CPAN
+
+CPAN.pm will then fetch the index files from one of the CPAN sites
+that come at the beginning of urllist. It will later check for each
+module if there is a local copy of the most recent version.
+
+=head1 SECURITY
+
+There's no strong security layer in CPAN.pm. CPAN.pm helps you to
+install foreign, unmasked, unsigned code on your machine. We compare
+to a checksum that comes from the net just as the distribution file
+itself. If somebody has managed to tamper with the distribution file,
+they may have as well tampered with the CHECKSUMS file. Future
+development will go towards strong authentification.
+
+=head1 EXPORT
+
+Most functions in package CPAN are exported per default. The reason
+for this is that the primary use is intended for the cpan shell or for
+oneliners.
+
+=head1 BUGS
+
+We should give coverage for _all_ of the CPAN and not just the PAUSE
+part, right? In this discussion CPAN and PAUSE have become equal --
+but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
+the clpa/, doc/, misc/, ports/, src/, scripts/.
+
+Future development should be directed towards a better integration of
+the other parts.
+
+If a Makefile.PL requires special customization of libraries, prompts
+the user for special input, etc. then you may find CPAN is not able to
+build the distribution. In that case, you should attempt the
+traditional method of building a Perl module package from a shell.
+
+=head1 AUTHOR
+
+Andreas König E<lt>a.koenig@mind.deE<gt>
+
+=head1 SEE ALSO
+
+perl(1), CPAN::Nox(3)
+
+=cut
+
diff --git a/contrib/perl5/lib/CPAN/FirstTime.pm b/contrib/perl5/lib/CPAN/FirstTime.pm
new file mode 100644
index 000000000000..aa7a55d195bc
--- /dev/null
+++ b/contrib/perl5/lib/CPAN/FirstTime.pm
@@ -0,0 +1,439 @@
+package CPAN::Mirrored::By;
+
+sub new { 
+    my($self,@arg) = @_;
+    bless [@arg], $self;
+}
+sub continent { shift->[0] }
+sub country { shift->[1] }
+sub url { shift->[2] }
+
+package CPAN::FirstTime;
+
+use strict;
+use ExtUtils::MakeMaker qw(prompt);
+use FileHandle ();
+use File::Basename ();
+use File::Path ();
+use vars qw($VERSION);
+$VERSION = substr q$Revision: 1.29 $, 10;
+
+=head1 NAME
+
+CPAN::FirstTime - Utility for CPAN::Config file Initialization
+
+=head1 SYNOPSIS
+
+CPAN::FirstTime::init()
+
+=head1 DESCRIPTION
+
+The init routine asks a few questions and writes a CPAN::Config
+file. Nothing special.
+
+=cut
+
+
+sub init {
+    my($configpm) = @_;
+    use Config;
+    require CPAN::Nox;
+    eval {require CPAN::Config;};
+    $CPAN::Config ||= {};
+    local($/) = "\n";
+    local($\) = "";
+    local($|) = 1;
+
+    my($ans,$default,$local,$cont,$url,$expected_size);
+    
+    #
+    # Files, directories
+    #
+
+    print qq{
+
+CPAN is the world-wide archive of perl resources. It consists of about
+100 sites that all replicate the same contents all around the globe.
+Many countries have at least one CPAN site already. The resources
+found on CPAN are easily accessible with the CPAN.pm module. If you
+want to use CPAN.pm, you have to configure it properly.
+
+If you do not want to enter a dialog now, you can answer 'no' to this
+question and I\'ll try to autoconfigure. (Note: you can revisit this
+dialog anytime later by typing 'o conf init' at the cpan prompt.)
+
+};
+
+    my $manual_conf =
+	ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
+				    "yes");
+    my $fastread;
+    {
+      local $^W;
+      if ($manual_conf =~ /^\s*y/i) {
+	$fastread = 0;
+	*prompt = \&ExtUtils::MakeMaker::prompt;
+      } else {
+	$fastread = 1;
+	*prompt = sub {
+	  my($q,$a) = @_;
+	  my($ret) = defined $a ? $a : "";
+	  printf qq{%s [%s]\n\n}, $q, $ret;
+	  $ret;
+	};
+      }
+    }
+    print qq{
+
+The following questions are intended to help you with the
+configuration. The CPAN module needs a directory of its own to cache
+important index files and maybe keep a temporary mirror of CPAN files.
+This may be a site-wide directory or a personal directory.
+
+};
+
+    my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
+    if (-d $cpan_home) {
+	print qq{
+
+I see you already have a  directory
+    $cpan_home
+Shall we use it as the general CPAN build and cache directory?
+
+};
+    } else {
+	print qq{
+
+First of all, I\'d like to create this directory. Where?
+
+};
+    }
+
+    $default = $cpan_home;
+    while ($ans = prompt("CPAN build and cache directory?",$default)) {
+	File::Path::mkpath($ans); # dies if it can't
+	if (-d $ans && -w _) {
+	    last;
+	} else {
+	    warn "Couldn't find directory $ans
+  or directory is not writable. Please retry.\n";
+	}
+    }
+    $CPAN::Config->{cpan_home} = $ans;
+    
+    print qq{
+
+If you want, I can keep the source files after a build in the cpan
+home directory. If you choose so then future builds will take the
+files from there. If you don\'t want to keep them, answer 0 to the
+next question.
+
+};
+
+    $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
+    $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
+
+    #
+    # Cache size, Index expire
+    #
+
+    print qq{
+
+How big should the disk cache be for keeping the build directories
+with all the intermediate files?
+
+};
+
+    $default = $CPAN::Config->{build_cache} || 10;
+    $ans = prompt("Cache size for build directory (in MB)?", $default);
+    $CPAN::Config->{build_cache} = $ans;
+
+    # XXX This the time when we refetch the index files (in days)
+    $CPAN::Config->{'index_expire'} = 1;
+
+    #
+    # External programs
+    #
+
+    print qq{
+
+The CPAN module will need a few external programs to work
+properly. Please correct me, if I guess the wrong path for a program.
+Don\'t panic if you do not have some of them, just press ENTER for
+those.
+
+};
+
+    my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
+    my $progname;
+    for $progname (qw/gzip tar unzip make lynx ncftp ftp/){
+      my $progcall = $progname;
+	my $path = $CPAN::Config->{$progname} 
+	        || $Config::Config{$progname}
+		|| "";
+	if (MM->file_name_is_absolute($path)) {
+	  # testing existence is not good enough, some have these exe
+	  # extensions
+
+	  # warn "Warning: configured $path does not exist\n" unless -e $path;
+	  # $path = "";
+	} else {
+	    $path = '';
+	}
+	unless ($path) {
+	  # e.g. make -> nmake
+	  $progcall = $Config::Config{$progname} if $Config::Config{$progname};
+	}
+
+	$path ||= find_exe($progcall,[@path]);
+	warn "Warning: $progcall not found in PATH\n" unless
+	    $path; # not -e $path, because find_exe already checked that
+	$ans = prompt("Where is your $progname program?",$path) || $path;
+	$CPAN::Config->{$progname} = $ans;
+    }
+    my $path = $CPAN::Config->{'pager'} || 
+	$ENV{PAGER} || find_exe("less",[@path]) || 
+	    find_exe("more",[@path]) || "more";
+    $ans = prompt("What is your favorite pager program?",$path);
+    $CPAN::Config->{'pager'} = $ans;
+    $path = $CPAN::Config->{'shell'};
+    if (MM->file_name_is_absolute($path)) {
+	warn "Warning: configured $path does not exist\n" unless -e $path;
+	$path = "";
+    }
+    $path ||= $ENV{SHELL};
+    $path =~ s,\\,/,g if $^O eq 'os2';	# Cosmetic only
+    $ans = prompt("What is your favorite shell?",$path);
+    $CPAN::Config->{'shell'} = $ans;
+
+    #
+    # Arguments to make etc.
+    #
+
+    print qq{
+
+Every Makefile.PL is run by perl in a separate process. Likewise we
+run \'make\' and \'make install\' in processes. If you have any parameters
+\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
+the calls, please specify them here.
+
+If you don\'t understand this question, just press ENTER.
+
+};
+
+    $default = $CPAN::Config->{makepl_arg} || "";
+    $CPAN::Config->{makepl_arg} =
+	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
+    $default = $CPAN::Config->{make_arg} || "";
+    $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
+
+    $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
+    $CPAN::Config->{make_install_arg} =
+	prompt("Parameters for the 'make install' command?",$default);
+
+    #
+    # Alarm period
+    #
+
+    print qq{
+
+Sometimes you may wish to leave the processes run by CPAN alone
+without caring about them. As sometimes the Makefile.PL contains
+question you\'re expected to answer, you can set a timer that will
+kill a 'perl Makefile.PL' process after the specified time in seconds.
+
+If you set this value to 0, these processes will wait forever. This is
+the default and recommended setting.
+
+};
+
+    $default = $CPAN::Config->{inactivity_timeout} || 0;
+    $CPAN::Config->{inactivity_timeout} =
+	prompt("Timeout for inactivity during Makefile.PL?",$default);
+
+    # Proxies
+
+    print qq{
+
+If you\'re accessing the net via proxies, you can specify them in the
+CPAN configuration or via environment variables. The variable in
+the \$CPAN::Config takes precedence.
+
+};
+
+    for (qw/ftp_proxy http_proxy no_proxy/) {
+	$default = $CPAN::Config->{$_} || $ENV{$_};
+	$CPAN::Config->{$_} = prompt("Your $_?",$default);
+    }
+
+    #
+    # MIRRORED.BY
+    #
+
+    conf_sites() unless $fastread;
+
+    unless (@{$CPAN::Config->{'wait_list'}||[]}) {
+	print qq{
+
+WAIT support is available as a Plugin. You need the CPAN::WAIT module
+to actually use it.  But we need to know your favorite WAIT server. If
+you don\'t know a WAIT server near you, just press ENTER.
+
+};
+	$default = "wait://ls6.informatik.uni-dortmund.de:1404";
+	$ans = prompt("Your favorite WAIT server?\n  ",$default);
+	push @{$CPAN::Config->{'wait_list'}}, $ans;
+    }
+
+    # We don't ask that now, it will be noticed in time, won't it?
+    $CPAN::Config->{'inhibit_startup_message'} = 0;
+    $CPAN::Config->{'getcwd'} = 'cwd';
+
+    print "\n\n";
+    CPAN::Config->commit($configpm);
+}
+
+sub conf_sites {
+  my $m = 'MIRRORED.BY';
+  my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
+  File::Path::mkpath(File::Basename::dirname($mby));
+  if (-f $mby && -f $m && -M $m < -M $mby) {
+    require File::Copy;
+    File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
+  }
+  if ( ! -f $mby ){
+    print qq{You have no $mby
+  I\'m trying to fetch one
+};
+    $mby = CPAN::FTP->localize($m,$mby,3);
+  } elsif (-M $mby > 30 ) {
+    print qq{Your $mby is older than 30 days,
+  I\'m trying to fetch one
+};
+    $mby = CPAN::FTP->localize($m,$mby,3);
+  }
+  read_mirrored_by($mby);
+}
+
+sub find_exe {
+    my($exe,$path) = @_;
+    my($dir);
+    #warn "in find_exe exe[$exe] path[@$path]";
+    for $dir (@$path) {
+	my $abs = MM->catfile($dir,$exe);
+	if (($abs = MM->maybe_command($abs))) {
+	    return $abs;
+	}
+    }
+}
+
+sub read_mirrored_by {
+    my($local) = @_;
+    my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
+    my $fh = FileHandle->new;
+    $fh->open($local) or die "Couldn't open $local: $!";
+    while (<$fh>) {
+	($host) = /^([\w\.\-]+)/ unless defined $host;
+	next unless defined $host;
+	next unless /\s+dst_(dst|location)/;
+	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
+	    ($continent, $country) = @location[-1,-2];
+	$continent =~ s/\s\(.*//;
+	/dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
+	next unless $host && $dst && $continent && $country;
+	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
+	undef $host;
+	$dst=$continent=$country="";
+    }
+    $fh->close;
+    $CPAN::Config->{urllist} ||= [];
+    if ($expected_size = @{$CPAN::Config->{urllist}}) {
+	for $url (@{$CPAN::Config->{urllist}}) {
+	    # sanity check, scheme+colon, not "q" there:
+	    next unless $url =~ /^\w+:\/./;
+	    $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
+	}
+	$CPAN::Config->{urllist} = [];
+    } else {
+	$expected_size = 6;
+    }
+    
+    print qq{
+
+Now we need to know, where your favorite CPAN sites are located. Push
+a few sites onto the array (just in case the first on the array won\'t
+work). If you are mirroring CPAN to your local workstation, specify a
+file: URL.
+
+You can enter the number in front of the URL on the next screen, a
+file:, ftp: or http: URL, or "q" to finish selecting.
+
+};
+
+    $ans = prompt("Press RETURN to continue");
+    my $other;
+    $ans = $other = "";
+    my(%seen);
+    
+    my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
+    while () {
+	my(@valid,$previous_best);
+	my $fh = FileHandle->new;
+	$fh->open($pipe);
+	{
+	    my($cont,$country,$url,$item);
+	    my(@cont) = sort keys %all;
+	    for $cont (@cont) {
+		$fh->print("  $cont\n");
+		for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
+		    for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
+			my $t = sprintf(
+					"    %-16s (%2d) %s\n",
+					$country,
+					++$item,
+					$url
+				       );
+			if ($cont =~ /^\[/) {
+			    $previous_best ||= $item;
+			}
+			push @valid, $all{$cont}{$country}{$url};
+			$fh->print($t);
+		    }
+		}
+	    }
+	}
+	$fh->close;
+	$previous_best ||= "";
+	$default =
+	    @{$CPAN::Config->{urllist}} >=
+		$expected_size ? "q" : $previous_best;
+	$ans = prompt(
+		      "\nSelect an$other ftp or file URL or a number (q to finish)",
+		      $default
+		     );
+	my $sel;
+	if ($ans =~ /^\d/) {
+	    my $this = $valid[$ans-1];
+	    my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
+	    push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
+	    delete $all{$con}{$cou}{$url};
+	    #	    print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
+	} elsif ($ans =~ /^q/i) {
+	    last;
+	} else {
+	    $ans =~ s|/?$|/|; # has to end with one slash
+	    $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
+	    if ($ans =~ /^\w+:\/./) {
+		push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
+	    } else {
+		print qq{"$ans" doesn\'t look like an URL at first sight.
+I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
+later and report a bug in my Makefile.PL to me (andreas koenig).
+Thanks.\n};
+	    }
+	}
+	$other ||= "other";
+    }
+}
+
+1;
diff --git a/contrib/perl5/lib/CPAN/Nox.pm b/contrib/perl5/lib/CPAN/Nox.pm
new file mode 100644
index 000000000000..c4016a44ac08
--- /dev/null
+++ b/contrib/perl5/lib/CPAN/Nox.pm
@@ -0,0 +1,34 @@
+BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;}
+
+use CPAN;
+
+$CPAN::META->has_inst('MD5','no');
+$CPAN::META->has_inst('LWP','no');
+$CPAN::META->has_inst('Compress::Zlib','no');
+@EXPORT = @CPAN::EXPORT;
+
+*AUTOLOAD = \&CPAN::AUTOLOAD;
+
+=head1 NAME
+
+CPAN::Nox - Wrapper around CPAN.pm without using any XS module
+
+=head1 SYNOPSIS
+
+Interactive mode:
+
+  perl -MCPAN::Nox -e shell;
+
+=head1 DESCRIPTION
+
+This package has the same functionality as CPAN.pm, but tries to
+prevent the usage of compiled extensions during it's own
+execution. It's primary purpose is a rescue in case you upgraded perl
+and broke binary compatibility somehow.
+
+=head1  SEE ALSO
+
+CPAN(3)
+
+=cut
+
diff --git a/contrib/perl5/lib/Carp.pm b/contrib/perl5/lib/Carp.pm
new file mode 100644
index 000000000000..6bac36446a7d
--- /dev/null
+++ b/contrib/perl5/lib/Carp.pm
@@ -0,0 +1,276 @@
+package Carp;
+
+=head1 NAME
+
+carp    - warn of errors (from perspective of caller)
+
+cluck   - warn of errors with stack backtrace
+          (not exported by default)
+
+croak   - die of errors (from perspective of caller)
+
+confess - die of errors with stack backtrace
+
+=head1 SYNOPSIS
+
+    use Carp;
+    croak "We're outta here!";
+
+    use Carp qw(cluck);
+    cluck "This is how we got 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.
+
+=head2 Forcing a Stack Trace
+
+As a debugging aid, you can force Carp to treat a croak as a confess
+and a carp as a cluck across I<all> modules. In other words, force a
+detailed stack trace to be given.  This can be very helpful when trying
+to understand why, or from where, a warning or error is being generated.
+
+This feature is enabled by 'importing' the non-existant symbol
+'verbose'. You would typically enable it by saying
+
+    perl -MCarp=verbose script.pl
+
+or by including the string C<MCarp=verbose> in the L<PERL5OPT>
+environment variable.
+
+=cut
+
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package.  Corrections and
+# comments are welcome.
+
+# The $CarpLevel variable can be set to "strip off" extra caller levels for
+# those times when Carp calls are buried inside other functions.  The
+# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
+# text and function arguments should be formatted when printed.
+
+$CarpLevel = 0;		# How many extra package levels to skip on carp.
+$MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64;        # How much of each argument to print. 0 = all.
+$MaxArgNums = 8;        # How many arguments to print. 0 = all.
+$Verbose = 0;		# If true then make shortmess call longmess instead
+
+require Exporter;
+@ISA = ('Exporter');
+@EXPORT = qw(confess croak carp);
+@EXPORT_OK = qw(cluck verbose);
+@EXPORT_FAIL = qw(verbose);	# hook to enable verbose mode
+
+
+# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
+# then the following method will be called by the Exporter which knows
+# to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
+# 'verbose'.
+
+sub export_fail {
+    shift;
+    $Verbose = shift if $_[0] eq 'verbose';
+    return @_;
+}
+
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made.  The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess {
+    my $error = join '', @_;
+    my $mess = "";
+    my $i = 1 + $CarpLevel;
+    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+    my (@a);
+    #
+    # crawl up the stack....
+    #
+    while (do { { package DB; @a = caller($i++) } } ) {
+	# get copies of the variables returned from caller()
+	($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+	#
+	# if the $error error string is newline terminated then it
+	# is copied into $mess.  Otherwise, $mess gets set (at the end of
+	# the 'else {' section below) to one of two things.  The first time
+	# through, it is set to the "$error at $file line $line" message.
+	# $error is then set to 'called' which triggers subsequent loop
+	# iterations to append $sub to $mess before appending the "$error
+	# at $file line $line" which now actually reads "called at $file line
+	# $line".  Thus, the stack trace message is constructed:
+	#
+	#        first time: $mess  = $error at $file line $line
+	#  subsequent times: $mess .= $sub $error at $file line $line
+	#                                  ^^^^^^
+	#                                 "called"
+	if ($error =~ m/\n$/) {
+	    $mess .= $error;
+	} else {
+	    # Build a string, $sub, which names the sub-routine called.
+	    # This may also be "require ...", "eval '...' or "eval {...}"
+	    if (defined $eval) {
+		if ($require) {
+		    $sub = "require $eval";
+		} else {
+		    $eval =~ s/([\\\'])/\\$1/g;
+		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+			substr($eval,$MaxEvalLen) = '...';
+		    }
+		    $sub = "eval '$eval'";
+		}
+	    } elsif ($sub eq '(eval)') {
+		$sub = 'eval {...}';
+	    }
+	    # if there are any arguments in the sub-routine call, format
+	    # them according to the format variables defined earlier in
+	    # this file and join them onto the $sub sub-routine string
+	    if ($hargs) {
+		# we may trash some of the args so we take a copy
+		@a = @DB::args;	# must get local copy of args
+		# don't print any more than $MaxArgNums
+		if ($MaxArgNums and @a > $MaxArgNums) {
+		    # cap the length of $#a and set the last element to '...'
+		    $#a = $MaxArgNums;
+		    $a[$#a] = "...";
+		}
+		for (@a) {
+		    # set args to the string "undef" if undefined
+		    $_ = "undef", next unless defined $_;
+		    if (ref $_) {
+			# dunno what this is for...
+			$_ .= '';
+			s/'/\\'/g;
+		    }
+		    else {
+			s/'/\\'/g;
+			# terminate the string early with '...' if too long
+			substr($_,$MaxArgLen) = '...'
+			    if $MaxArgLen and $MaxArgLen < length;
+		    }
+		    # 'quote' arg unless it looks like a number
+		    $_ = "'$_'" unless /^-?[\d.]+$/;
+		    # print high-end chars as 'M-<char>' or '^<char>'
+		    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+		}
+		# append ('all', 'the', 'arguments') to the $sub string
+		$sub .= '(' . join(', ', @a) . ')';
+	    }
+	    # here's where the error message, $mess, gets constructed
+	    $mess .= "\t$sub " if $error eq "called";
+	    $mess .= "$error at $file line $line\n";
+	}
+	# we don't need to print the actual error message again so we can
+	# change this to "called" so that the string "$error at $file line
+	# $line" makes sense as "called at $file line $line".
+	$error = "called";
+    }
+    # this kludge circumvents die's incorrect handling of NUL
+    my $msg = \($mess || $error);
+    $$msg =~ tr/\0//d;
+    $$msg;
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there.  confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that.  In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess {	# Short-circuit &longmess if called via multiple packages
+    goto &longmess if $Verbose;
+    my $error = join '', @_;
+    my ($prevpack) = caller(1);
+    my $extra = $CarpLevel;
+    my $i = 2;
+    my ($pack,$file,$line);
+    # when reporting an error, we want to report it from the context of the
+    # calling package.  So what is the calling package?  Within a module,
+    # there may be many calls between methods and perhaps between sub-classes
+    # and super-classes, but the user isn't interested in what happens
+    # inside the package.  We start by building a hash array which keeps
+    # track of all the packages to which the calling package belongs.  We
+    # do this by examining its @ISA variable.  Any call from a base class
+    # method (one of our caller's @ISA packages) can be ignored
+    my %isa = ($prevpack,1);
+
+    # merge all the caller's @ISA packages into %isa.
+    @isa{@{"${prevpack}::ISA"}} = ()
+	if(defined @{"${prevpack}::ISA"});
+
+    # now we crawl up the calling stack and look at all the packages in
+    # there.  For each package, we look to see if it has an @ISA and then
+    # we see if our caller features in that list.  That would imply that
+    # our caller is a derived class of that package and its calls can also
+    # be ignored
+    while (($pack,$file,$line) = caller($i++)) {
+	if(defined @{$pack . "::ISA"}) {
+	    my @i = @{$pack . "::ISA"};
+	    my %i;
+	    @i{@i} = ();
+	    # merge any relevant packages into %isa
+	    @isa{@i,$pack} = ()
+		if(exists $i{$prevpack} || exists $isa{$pack});
+	}
+
+	# and here's where we do the ignoring... if the package in
+	# question is one of our caller's base or derived packages then
+	# we can ignore it (skip it) and go onto the next (but note that
+	# the continue { } block below gets called every time)
+	next
+	    if(exists $isa{$pack});
+
+	# Hey!  We've found a package that isn't one of our caller's
+	# clan....but wait, $extra refers to the number of 'extra' levels
+	# we should skip up.  If $extra > 0 then this is a false alarm.
+	# We must merge the package into the %isa hash (so we can ignore it
+	# if it pops up again), decrement $extra, and continue.
+	if ($extra-- > 0) {
+	    %isa = ($pack,1);
+	    @isa{@{$pack . "::ISA"}} = ()
+		if(defined @{$pack . "::ISA"});
+	}
+	else {
+	    # OK!  We've got a candidate package.  Time to construct the
+	    # relevant error message and return it.   die() doesn't like
+	    # to be given NUL characters (which $msg may contain) so we
+	    # remove them first.
+	    (my $msg = "$error at $file line $line\n") =~ tr/\0//d;
+	    return $msg;
+	}
+    }
+    continue {
+	$prevpack = $pack;
+    }
+
+    # uh-oh!  It looks like we crawled all the way up the stack and
+    # never found a candidate package.  Oh well, let's call longmess
+    # to generate a full stack trace.  We use the magical form of 'goto'
+    # so that this shortmess() function doesn't appear on the stack
+    # to further confuse longmess() about it's calling package.
+    goto &longmess;
+}
+
+
+# the following four functions call longmess() or shortmess() depending on
+# whether they should generate a full stack trace (confess() and cluck())
+# or simply report the caller's package (croak() and carp()), respectively.
+# confess() and croak() die, carp() and cluck() warn.
+
+sub croak   { die  shortmess @_ }
+sub confess { die  longmess  @_ }
+sub carp    { warn shortmess @_ }
+sub cluck   { warn longmess  @_ }
+
+1;
diff --git a/contrib/perl5/lib/Class/Struct.pm b/contrib/perl5/lib/Class/Struct.pm
new file mode 100644
index 000000000000..8fddfbf68ef3
--- /dev/null
+++ b/contrib/perl5/lib/Class/Struct.pm
@@ -0,0 +1,484 @@
+package Class::Struct;
+
+## See POD after __END__
+
+require 5.002;
+
+use strict;
+use vars qw(@ISA @EXPORT);
+
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(struct);
+
+## Tested on 5.002 and 5.003 without class membership tests:
+my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
+
+my $print = 0;
+sub printem {
+    if (@_) { $print = shift }
+    else    { $print++ }
+}
+
+{
+    package Class::Struct::Tie_ISA;
+
+    sub TIEARRAY {
+        my $class = shift;
+        return bless [], $class;
+    }
+
+    sub STORE {
+        my ($self, $index, $value) = @_;
+        Class::Struct::_subclass_error();
+    }
+
+    sub FETCH {
+        my ($self, $index) = @_;
+        $self->[$index];
+    }
+
+    sub FETCHSIZE {
+        my $self = shift;
+        return scalar(@$self);
+    }
+
+    sub DESTROY { }
+}
+
+sub struct {
+
+    # Determine parameter list structure, one of:
+    #   struct( class => [ element-list ])
+    #   struct( class => { element-list })
+    #   struct( element-list )
+    # Latter form assumes current package name as struct name.
+
+    my ($class, @decls);
+    my $base_type = ref $_[1];
+    if ( $base_type eq 'HASH' ) {
+        $class = shift;
+        @decls = %{shift()};
+        _usage_error() if @_;
+    }
+    elsif ( $base_type eq 'ARRAY' ) {
+        $class = shift;
+        @decls = @{shift()};
+        _usage_error() if @_;
+    }
+    else {
+        $base_type = 'ARRAY';
+        $class = (caller())[0];
+        @decls = @_;
+    }
+    _usage_error() if @decls % 2 == 1;
+
+    # Ensure we are not, and will not be, a subclass.
+
+    my $isa = do {
+        no strict 'refs';
+        \@{$class . '::ISA'};
+    };
+    _subclass_error() if @$isa;
+    tie @$isa, 'Class::Struct::Tie_ISA';
+
+    # Create constructor.
+
+    croak "function 'new' already defined in package $class"
+        if do { no strict 'refs'; defined &{$class . "::new"} };
+
+    my @methods = ();
+    my %refs = ();
+    my %arrays = ();
+    my %hashes = ();
+    my %classes = ();
+    my $got_class = 0;
+    my $out = '';
+
+    $out = "{\n  package $class;\n  use Carp;\n  sub new {\n";
+
+    my $cnt = 0;
+    my $idx = 0;
+    my( $cmt, $name, $type, $elem );
+
+    if( $base_type eq 'HASH' ){
+        $out .= "    my(\$r) = {};\n";
+        $cmt = '';
+    }
+    elsif( $base_type eq 'ARRAY' ){
+        $out .= "    my(\$r) = [];\n";
+    }
+    while( $idx < @decls ){
+        $name = $decls[$idx];
+        $type = $decls[$idx+1];
+        push( @methods, $name );
+        if( $base_type eq 'HASH' ){
+            $elem = "{'$name'}";
+        }
+        elsif( $base_type eq 'ARRAY' ){
+            $elem = "[$cnt]";
+            ++$cnt;
+            $cmt = " # $name";
+        }
+        if( $type =~ /^\*(.)/ ){
+            $refs{$name}++;
+            $type = $1;
+        }
+        if( $type eq '@' ){
+            $out .= "    \$r->$elem = [];$cmt\n";
+            $arrays{$name}++;
+        }
+        elsif( $type eq '%' ){
+            $out .= "    \$r->$elem = {};$cmt\n";
+            $hashes{$name}++;
+        }
+        elsif ( $type eq '$') {
+            $out .= "    \$r->$elem = undef;$cmt\n";
+        }
+        elsif( $type =~ /^\w+(?:::\w+)*$/ ){
+            $out .= "    \$r->$elem = '${type}'->new();$cmt\n";
+            $classes{$name} = $type;
+            $got_class = 1;
+        }
+        else{
+            croak "'$type' is not a valid struct element type";
+        }
+        $idx += 2;
+    }
+    $out .= "    bless \$r;\n  }\n";
+
+    # Create accessor methods.
+
+    my( $pre, $pst, $sel );
+    $cnt = 0;
+    foreach $name (@methods){
+        if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
+            carp "function '$name' already defined, overrides struct accessor method"
+                if $^W;
+        }
+        else {
+            $pre = $pst = $cmt = $sel = '';
+            if( defined $refs{$name} ){
+                $pre = "\\(";
+                $pst = ")";
+                $cmt = " # returns ref";
+            }
+            $out .= "  sub $name {$cmt\n    my \$r = shift;\n";
+            if( $base_type eq 'ARRAY' ){
+                $elem = "[$cnt]";
+                ++$cnt;
+            }
+            elsif( $base_type eq 'HASH' ){
+                $elem = "{'$name'}";
+            }
+            if( defined $arrays{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
+                $sel = "->[\$i]";
+            }
+            elsif( defined $hashes{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
+                $sel = "->{\$i}";
+            }
+            elsif( defined $classes{$name} ){
+                if ( $CHECK_CLASS_MEMBERSHIP ) {
+                    $out .= "    croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
+                }
+            }
+            $out .= "    croak 'Too many args to $name' if \@_ > 1;\n";
+            $out .= "    \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
+            $out .= "  }\n";
+        }
+    }
+    $out .= "}\n1;\n";
+
+    print $out if $print;
+    my $result = eval $out;
+    carp $@ if $@;
+}
+
+sub _usage_error {
+    confess "struct usage error";
+}
+
+sub _subclass_error {
+    croak 'struct class cannot be a subclass (@ISA not allowed)';
+}
+
+1; # for require
+
+
+__END__
+
+=head1 NAME
+
+Class::Struct - declare struct-like datatypes as Perl classes
+
+=head1 SYNOPSIS
+
+    use Class::Struct;
+            # declare struct, based on array:
+    struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
+            # declare struct, based on hash:
+    struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
+
+    package CLASS_NAME;
+    use Class::Struct;
+            # declare struct, based on array, implicit class name:
+    struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
+
+
+    package Myobj;
+    use Class::Struct;
+            # declare struct with four types of elements:
+    struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
+
+    $obj = new Myobj;               # constructor
+
+                                    # scalar type accessor:
+    $element_value = $obj->s;           # element value
+    $obj->s('new value');               # assign to element
+
+                                    # array type accessor:
+    $ary_ref = $obj->a;                 # reference to whole array
+    $ary_element_value = $obj->a(2);    # array element value
+    $obj->a(2, 'new value');            # assign to array element
+
+                                    # hash type accessor:
+    $hash_ref = $obj->h;                # reference to whole hash
+    $hash_element_value = $obj->h('x'); # hash element value
+    $obj->h('x', 'new value');        # assign to hash element
+
+                                    # class type accessor:
+    $element_value = $obj->c;           # object reference
+    $obj->c->method(...);               # call method of object
+    $obj->c(new My_Other_Class);        # assign a new object
+
+
+=head1 DESCRIPTION
+
+C<Class::Struct> exports a single function, C<struct>.
+Given a list of element names and types, and optionally
+a class name, C<struct> creates a Perl 5 class that implements
+a "struct-like" data structure.
+
+The new class is given a constructor method, C<new>, for creating
+struct objects.
+
+Each element in the struct data has an accessor method, which is
+used to assign to the element and to fetch its value.  The
+default accessor can be overridden by declaring a C<sub> of the
+same name in the package.  (See Example 2.)
+
+Each element's type can be scalar, array, hash, or class.
+
+
+=head2 The C<struct()> function
+
+The C<struct> function has three forms of parameter-list.
+
+    struct( CLASS_NAME => [ ELEMENT_LIST ]);
+    struct( CLASS_NAME => { ELEMENT_LIST });
+    struct( ELEMENT_LIST );
+
+The first and second forms explicitly identify the name of the
+class being created.  The third form assumes the current package
+name as the class name.
+
+An object of a class created by the first and third forms is
+based on an array, whereas an object of a class created by the
+second form is based on a hash. The array-based forms will be
+somewhat faster and smaller; the hash-based forms are more
+flexible.
+
+The class created by C<struct> must not be a subclass of another
+class other than C<UNIVERSAL>.
+
+A function named C<new> must not be explicitly defined in a class
+created by C<struct>.
+
+The I<ELEMENT_LIST> has the form
+
+    NAME => TYPE, ...
+
+Each name-type pair declares one element of the struct. Each
+element name will be defined as an accessor method unless a
+method by that name is explicitly defined; in the latter case, a
+warning is issued if the warning flag (B<-w>) is set.
+
+
+=head2 Element Types and Accessor Methods
+
+The four element types -- scalar, array, hash, and class -- are
+represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
+optionally preceded by a C<'*'>.
+
+The accessor method provided by C<struct> for an element depends
+on the declared type of the element.
+
+=over
+
+=item Scalar (C<'$'> or C<'*$'>)
+
+The element is a scalar, and is initialized to C<undef>.
+
+The accessor's argument, if any, is assigned to the element.
+
+If the element type is C<'$'>, the value of the element (after
+assignment) is returned. If the element type is C<'*$'>, a reference
+to the element is returned.
+
+=item Array (C<'@'> or C<'*@'>)
+
+The element is an array, initialized to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole array.
+
+With one or two arguments, the first argument is an index
+specifying one element of the array; the second argument, if
+present, is assigned to the array element.  If the element type
+is C<'@'>, the accessor returns the array element value.  If the
+element type is C<'*@'>, a reference to the array element is
+returned.
+
+=item Hash (C<'%'> or C<'*%'>)
+
+The element is a hash, initialized to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole hash.
+
+With one or two arguments, the first argument is a key specifying
+one element of the hash; the second argument, if present, is
+assigned to the hash element.  If the element type is C<'%'>, the
+accessor returns the hash element value.  If the element type is
+C<'*%'>, a reference to the hash element is returned.
+
+=item Class (C<'Class_Name'> or C<'*Class_Name'>)
+
+The element's value must be a reference blessed to the named
+class or to one of its subclasses. The element is initialized to
+the result of calling the C<new> constructor of the named class.
+
+The accessor's argument, if any, is assigned to the element. The
+accessor will C<croak> if this is not an appropriate object
+reference.
+
+If the element type does not start with a C<'*'>, the accessor
+returns the element value (after assignment). If the element type
+starts with a C<'*'>, a reference to the element itself is returned.
+
+=back
+
+=head1 EXAMPLES
+
+=over
+
+=item Example 1
+
+Giving a struct element a class type that is also a struct is how
+structs are nested.  Here, C<timeval> represents a time (seconds and
+microseconds), and C<rusage> has two elements, each of which is of
+type C<timeval>.
+
+    use Class::Struct;
+
+    struct( rusage => {
+        ru_utime => timeval,  # seconds
+        ru_stime => timeval,  # microseconds
+    });
+
+    struct( timeval => [
+        tv_secs  => '$',
+        tv_usecs => '$',
+    ]);
+
+        # create an object:
+    my $t = new rusage;
+    	# $t->ru_utime and $t->ru_stime are objects of type timeval.
+
+        # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
+    $t->ru_utime->tv_secs(100);
+    $t->ru_utime->tv_usecs(0);
+    $t->ru_stime->tv_secs(5);
+    $t->ru_stime->tv_usecs(0);
+
+
+=item Example 2
+
+An accessor function can be redefined in order to provide
+additional checking of values, etc.  Here, we want the C<count>
+element always to be nonnegative, so we redefine the C<count>
+accessor accordingly.
+
+    package MyObj;
+    use Class::Struct;
+
+    		# declare the struct
+    struct ( 'MyObj', { count => '$', stuff => '%' } );
+
+    		# override the default accessor method for 'count'
+    sub count {
+        my $self = shift;
+        if ( @_ ) {
+            die 'count must be nonnegative' if $_[0] < 0;
+            $self->{'count'} = shift;
+            warn "Too many args to count" if @_;
+        }
+        return $self->{'count'};
+    }
+
+    package main;
+    $x = new MyObj;
+    print "\$x->count(5) = ", $x->count(5), "\n";
+                            # prints '$x->count(5) = 5'
+
+    print "\$x->count = ", $x->count, "\n";
+                            # prints '$x->count = 5'
+
+    print "\$x->count(-5) = ", $x->count(-5), "\n";
+                            # dies due to negative argument!
+
+
+=head1 Author and Modification History
+
+
+Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
+
+    members() function removed.
+    Documentation corrected and extended.
+    Use of struct() in a subclass prohibited.
+    User definition of accessor allowed.
+    Treatment of '*' in element types corrected.
+    Treatment of classes as element types corrected.
+    Class name to struct() made optional.
+    Diagnostic checks added.
+
+
+Originally C<Class::Template> by Dean Roehrich.
+
+    # Template.pm   --- struct/member template builder
+    #   12mar95
+    #   Dean Roehrich
+    #
+    # changes/bugs fixed since 28nov94 version:
+    #  - podified
+    # changes/bugs fixed since 21nov94 version:
+    #  - Fixed examples.
+    # changes/bugs fixed since 02sep94 version:
+    #  - Moved to Class::Template.
+    # changes/bugs fixed since 20feb94 version:
+    #  - Updated to be a more proper module.
+    #  - Added "use strict".
+    #  - Bug in build_methods, was using @var when @$var needed.
+    #  - Now using my() rather than local().
+    #
+    # Uses perl5 classes to create nested data types.
+    # This is offered as one implementation of Tom Christiansen's "structs.pl"
+    # idea.
+
+=cut
diff --git a/contrib/perl5/lib/Cwd.pm b/contrib/perl5/lib/Cwd.pm
new file mode 100644
index 000000000000..7febb0dde298
--- /dev/null
+++ b/contrib/perl5/lib/Cwd.pm
@@ -0,0 +1,385 @@
+package Cwd;
+require 5.000;
+
+=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'};
+
+    use Cwd 'abs_path';
+    print abs_path($ENV{'PWD'});
+
+    use Cwd 'fast_abs_path';
+    print fast_abs_path($ENV{'PWD'});
+
+=head1 DESCRIPTION
+
+The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
+in Perl.
+
+The abs_path() function takes a single argument and returns the
+absolute pathname for that argument. It uses the same algoritm as
+getcwd(). (actually getcwd() is abs_path("."))
+
+The fastcwd() function looks the same as getcwd(), but runs faster.
+It's also more dangerous because it might conceivably chdir() you out
+of a directory that it can't chdir() you back into.  If fastcwd
+encounters a problem it will return undef but will probably leave you
+in a different directory.  For a measure of extra security, if
+everything appears to have worked, the fastcwd() function will check
+that it leaves you in the same directory that it started in. If it has
+changed it will C<die> with the message "Unstable directory path,
+current directory changed unexpectedly". That should never happen.
+
+The fast_abs_path() function looks the same as abs_path(), but runs faster.
+And like fastcwd() is more dangerous.
+
+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 if all packages which use chdir import it from Cwd.
+
+=cut
+
+## use strict;
+
+use Carp;
+
+$VERSION = '2.01';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path);
+
+
+# The 'natural and safe form' for UNIX (pwd may be setuid root)
+
+sub _backtick_pwd {
+    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
+{
+    abs_path('.');
+}
+
+# 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.
+    
+# List of metachars taken from do_exec() in doio.c
+my $quoted_shell_meta = quotemeta('$&*(){}[]";\\|?<>~`'."'\n");
+
+sub fastcwd {
+    my($odev, $oino, $cdev, $cino, $tdev, $tino);
+    my(@path, $path);
+    local(*DIR);
+
+    my($orig_cdev, $orig_cino) = stat('.');
+    ($cdev, $cino) = ($orig_cdev, $orig_cino);
+    for (;;) {
+	my $direntry;
+	($odev, $oino) = ($cdev, $cino);
+	CORE::chdir('..') || return undef;
+	($cdev, $cino) = stat('.');
+	last if $odev == $cdev && $oino == $cino;
+	opendir(DIR, '.') || return undef;
+	for (;;) {
+	    $direntry = readdir(DIR);
+	    last unless defined $direntry;
+	    next if $direntry eq '.';
+	    next if $direntry eq '..';
+
+	    ($tdev, $tino) = lstat($direntry);
+	    last unless $tdev != $odev || $tino != $oino;
+	}
+	closedir(DIR);
+	return undef unless defined $direntry; # should never happen
+	unshift(@path, $direntry);
+    }
+    $path = '/' . join('/', @path);
+    # At this point $path may be tainted (if tainting) and chdir would fail.
+    # To be more useful we untaint it then check that we landed where we started.
+    $path = $1 if $path =~ /^(.*)$/;	# untaint
+    CORE::chdir($path) || return undef;
+    ($cdev, $cino) = stat('.');
+    die "Unstable directory path, current directory changed unexpectedly"
+	if $cdev != $orig_cdev || $cino != $orig_cino;
+    $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' and $^O ne 'dos') {
+	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;
+}
+
+# Taken from Cwd.pm It is really getcwd with an optional
+# parameter instead of '.'
+#
+
+sub abs_path
+{
+    my $start = @_ ? shift : '.';
+    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat( $start ))
+    {
+	carp "stat($start): $!";
+	return '';
+    }
+    $cwd = '';
+    $dotdots = $start;
+    do
+    {
+	$dotdots .= '/..';
+	@pst = @cst;
+	unless (opendir(PARENT, $dotdots))
+	{
+	    carp "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    carp "stat($dotdots): $!";
+	    closedir(PARENT);
+	    return '';
+	}
+	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+	{
+	    $dir = undef;
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(PARENT)))
+	        {
+		    carp "readdir($dotdots): $!";
+		    closedir(PARENT);
+		    return '';
+		}
+		$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+		   $tst[1] != $pst[1]);
+	}
+	$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
+	closedir(PARENT);
+    } while (defined $dir);
+    chop($cwd) unless $cwd eq '/'; # drop the trailing /
+    $cwd;
+}
+
+sub fast_abs_path {
+    my $cwd = getcwd();
+    my $path = shift || '.';
+    CORE::chdir($path) || croak "Cannot chdir to $path:$!";
+    my $realpath = getcwd();
+    CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
+    $realpath;
+}
+
+
+# --- 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 _vms_abs_path {
+    return $ENV{'DEFAULT'} unless @_;
+    my $path = VMS::Filespec::pathify($_[0]);
+    croak("Invalid path name $_[0]") unless defined $path;
+    return VMS::Filespec::rmsexpand($path);
+}
+
+sub _os2_cwd {
+    $ENV{'PWD'} = `cmd /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+sub _win32_cwd {
+    $ENV{'PWD'} = Win32::GetCwd();
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 
+                            defined &Win32::GetCwd);
+
+*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
+
+sub _dos_cwd {
+    if (!defined &Dos::GetCwd) {
+        $ENV{'PWD'} = `command /c cd`;
+        chop $ENV{'PWD'};
+        $ENV{'PWD'} =~ s:\\:/:g ;
+    } else {
+        $ENV{'PWD'} = Dos::GetCwd();
+    }
+    return $ENV{'PWD'};
+}
+
+sub _qnx_cwd {
+    $ENV{'PWD'} = `/usr/bin/fullpath -t`;
+    chop $ENV{'PWD'};
+    return $ENV{'PWD'};
+}
+
+sub _qnx_abs_path {
+    my $path = shift || '.';
+    my $realpath=`/usr/bin/fullpath -t $path`;
+    chop $realpath;
+    return $realpath;
+}
+
+{
+    local $^W = 0;	# assignments trigger 'subroutine redefined' warning
+
+    if ($^O eq 'VMS') {
+        *cwd		= \&_vms_cwd;
+        *getcwd		= \&_vms_cwd;
+        *fastcwd	= \&_vms_cwd;
+        *fastgetcwd	= \&_vms_cwd;
+        *abs_path	= \&_vms_abs_path;
+        *fast_abs_path	= \&_vms_abs_path;
+    }
+    elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
+        # We assume that &_NT_cwd is defined as an XSUB or in the core.
+        *cwd		= \&_NT_cwd;
+        *getcwd		= \&_NT_cwd;
+        *fastcwd	= \&_NT_cwd;
+        *fastgetcwd	= \&_NT_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'os2') {
+        # sys_cwd may keep the builtin command
+        *cwd		= defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+        *getcwd		= \&cwd;
+        *fastgetcwd	= \&cwd;
+        *fastcwd	= \&cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'dos') {
+        *cwd		= \&_dos_cwd;
+        *getcwd		= \&_dos_cwd;
+        *fastgetcwd	= \&_dos_cwd;
+        *fastcwd	= \&_dos_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'qnx') {
+        *cwd		= \&_qnx_cwd;
+        *getcwd		= \&_qnx_cwd;
+        *fastgetcwd	= \&_qnx_cwd;
+        *fastcwd	= \&_qnx_cwd;
+        *abs_path	= \&_qnx_abs_path;
+        *fast_abs_path	= \&_qnx_abs_path;
+    }
+}
+
+# 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/contrib/perl5/lib/Devel/SelfStubber.pm b/contrib/perl5/lib/Devel/SelfStubber.pm
new file mode 100644
index 000000000000..4c2d03958033
--- /dev/null
+++ b/contrib/perl5/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(defined ($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(defined($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-E<gt>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/contrib/perl5/lib/DirHandle.pm b/contrib/perl5/lib/DirHandle.pm
new file mode 100644
index 000000000000..047755dc17d2
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/English.pm b/contrib/perl5/lib/English.pm
new file mode 100644
index 000000000000..bbb6bd7b280c
--- /dev/null
+++ b/contrib/perl5/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 is deprecated (5.005 makes @_ lexical)
+
+	*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				= *!	;
+	    *ERRNO				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
+	*EVAL_ERROR				= *@	;
+
+# Process info.
+
+	*PROCESS_ID				= *$	;
+	    *PID				= *$	;
+	*REAL_USER_ID				= *<	;
+	    *UID				= *<	;
+	*EFFECTIVE_USER_ID			= *>	;
+	    *EUID				= *>	;
+	*REAL_GROUP_ID				= *(	;
+	    *GID				= *(	;
+	*EFFECTIVE_GROUP_ID			= *)	;
+	    *EGID				= *)	;
+	*PROGRAM_NAME				= *0	;
+
+# 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/contrib/perl5/lib/Env.pm b/contrib/perl5/lib/Env.pm
new file mode 100644
index 000000000000..b0afc3b2dbf5
--- /dev/null
+++ b/contrib/perl5/lib/Env.pm
@@ -0,0 +1,77 @@
+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-hash 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 E<lt>F<chip@fin.uucp>E<gt>
+
+=cut
+
+sub import {
+    my ($callpack) = caller(0);
+    my $pack = shift;
+    my @vars = grep /^[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
+    return unless @vars;
+
+    eval "package $callpack; use vars qw("
+	 . join(' ', map { '$'.$_ } @vars) . ")";
+    die $@ if $@;
+    foreach (@vars) {
+	tie ${"${callpack}::$_"}, Env, $_;
+    }
+}
+
+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/contrib/perl5/lib/Exporter.pm b/contrib/perl5/lib/Exporter.pm
new file mode 100644
index 000000000000..3f42e407e0bb
--- /dev/null
+++ b/contrib/perl5/lib/Exporter.pm
@@ -0,0 +1,467 @@
+package Exporter;
+
+require 5.001;
+
+#
+# We go to a lot of trouble not to 'require Carp' at file scope,
+#  because Carp requires Exporter, and something has to give.
+#
+
+$ExportLevel = 0;
+$Verbose = 0 unless $Verbose;
+
+sub export {
+
+    # First make import warnings look like they're coming from the "use".
+    local $SIG{__WARN__} = sub {
+	my $text = shift;
+	if ($text =~ s/ at \S*Exporter.pm line \d+.*\n//) {
+	    require Carp;
+	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	    Carp::carp($text);
+	}
+	else {
+	    warn $text;
+	}
+    };
+    local $SIG{__DIE__} = sub {
+	require Carp;
+	local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	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;
+		    }
+		    # We need a way to emulate 'use Foo ()' but still
+		    # allow an easy version check: "use Foo 1.23, ''";
+		    if (@imports == 2 and !$imports[1]) {
+			@imports = ();
+			last;
+		    }
+		} elsif ($sym !~ s/^&// || !$exports{$sym}) {
+                    require Carp;
+		    Carp::carp(qq["$sym" is not exported by the $pkg module]);
+		    $oops++;
+		}
+	    }
+	}
+	if ($oops) {
+	    require Carp;
+	    Carp::croak("Can't continue after import errors");
+	}
+    }
+    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) {
+                require Carp;
+		Carp::carp(qq["$sym" is not implemented by the $pkg module ],
+			"on this architecture");
+	    }
+	    if (@failed) {
+		require Carp;
+		Carp::croak("Can't continue after import errors");
+	    }
+	}
+    }
+
+    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"} :
+	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
+    }
+}
+
+sub export_to_level
+{
+      my $pkg = shift;
+      my ($level, $junk) = (shift, shift);  # need to get rid of first arg
+                                            # we know it already.
+      my $callpkg = caller($level);
+      $pkg->export($callpkg, @_);
+}
+
+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);
+    if ($nontag and $^W) {
+	# This may change to a die one day
+	require Carp;
+	Carp::carp("Some names are not tags");
+    }
+}
+
+sub export_tags    { _push_tags((caller)[0], "EXPORT",    \@_) }
+sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
+
+
+# Default methods
+
+sub export_fail {
+    my $self = shift;
+    @_;
+}
+
+sub require_version {
+    my($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = ${"${pkg}::VERSION"};
+    if (!$version or $version < $wanted) {
+	$version ||= "(undef)";
+	my $file = $INC{"$pkg.pm"};
+	$file &&= " ($file)";
+	require Carp;
+	Carp::croak("$pkg $wanted required--this is only version $version$file")
+    }
+    $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 to 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-E<gt>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 Exporting without using Export's import method
+
+Exporter has a special method, 'export_to_level' which is used in situations
+where you can't directly call Export's import method. The export_to_level
+method looks like:
+
+MyPackage->export_to_level($where_to_export, @what_to_export);
+
+where $where_to_export is an integer telling how far up the calling stack
+to export your symbols, and @what_to_export is an array telling what
+symbols *to* export (usually this is @_).
+
+For example, suppose that you have a module, A, which already has an
+import function:
+
+package A;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw ($b);
+
+sub import
+{
+    $A::b = 1;     # not a very useful import method
+}
+
+and you want to Export symbol $A::b back to the module that called 
+package A. Since Exporter relies on the import method to work, via 
+inheritance, as it stands Exporter::import() will never get called. 
+Instead, say the following:
+
+package A;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw ($b);
+
+sub import
+{
+    $A::b = 1;
+    A->export_to_level(1, @_);
+}
+
+This will export the symbols one level 'above' the current package - ie: to 
+the program or module that used package A. 
+
+Note: Be careful not to modify '@_' at all before you call export_to_level
+- or people using your package will get very unexplained results!
+
+
+=head2 Module Version Checking
+
+The Exporter module will convert an attempt to import a number from a
+module into a call to $module_name-E<gt>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 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/contrib/perl5/lib/ExtUtils/Command.pm b/contrib/perl5/lib/ExtUtils/Command.pm
new file mode 100644
index 000000000000..2f5f1e168998
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Command.pm
@@ -0,0 +1,211 @@
+package ExtUtils::Command;
+use strict;
+# use AutoLoader;
+use Carp;
+use File::Copy;
+use File::Compare;
+use File::Basename;
+use File::Path qw(rmtree);
+require Exporter;
+use vars qw(@ISA @EXPORT $VERSION);
+@ISA     = qw(Exporter);
+@EXPORT  = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f);
+$VERSION = '1.01';
+
+=head1 NAME
+
+ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
+
+=head1 SYNOPSIS
+
+  perl -MExtUtils::Command -e cat files... > destination
+  perl -MExtUtils::Command -e mv source... destination
+  perl -MExtUtils::Command -e cp source... destination
+  perl -MExtUtils::Command -e touch files...
+  perl -MExtUtils::Command -e rm_f file...
+  perl -MExtUtils::Command -e rm_rf directories...
+  perl -MExtUtils::Command -e mkpath directories...
+  perl -MExtUtils::Command -e eqtime source destination
+  perl -MExtUtils::Command -e chmod mode files...
+  perl -MExtUtils::Command -e test_f file
+
+=head1 DESCRIPTION
+
+The module is used in Win32 port to replace common UNIX commands.
+Most commands are wrapers on generic modules File::Path and File::Basename.
+
+=over 4
+
+=cut
+
+sub expand_wildcards
+{
+ @ARGV = map(/[\*\?]/ ? glob($_) : $_,@ARGV);
+}
+
+=item cat 
+
+Concatenates all files mentioned on command line to STDOUT.
+
+=cut 
+
+sub cat ()
+{
+ expand_wildcards();
+ print while (<>);
+}
+
+=item eqtime src dst
+
+Sets modified time of dst to that of src
+
+=cut 
+
+sub eqtime
+{
+ my ($src,$dst) = @ARGV;
+ open(F,">$dst");
+ close(F);
+ utime((stat($src))[8,9],$dst);
+}
+
+=item rm_f files....
+
+Removes directories - recursively (even if readonly)
+
+=cut 
+
+sub rm_rf
+{
+ rmtree([grep -e $_,expand_wildcards()],0,0);
+}
+
+=item rm_f files....
+
+Removes files (even if readonly)
+
+=cut 
+
+sub rm_f
+{
+ foreach (expand_wildcards())
+  {
+   next unless -f $_;        
+   next if unlink($_);
+   chmod(0777,$_);           
+   next if unlink($_);
+   carp "Cannot delete $_:$!";
+  }
+}
+
+=item touch files ...
+
+Makes files exist, with current timestamp 
+
+=cut 
+
+sub touch
+{
+ expand_wildcards();
+ my $t    = time;
+ while (@ARGV)
+  {
+   my $file = shift(@ARGV);               
+   open(FILE,">>$file") || die "Cannot write $file:$!";
+   close(FILE);
+   utime($t,$t,$file);
+  }
+}
+
+=item mv source... destination
+
+Moves source to destination.
+Multiple sources are allowed if destination is an existing directory.
+
+=cut 
+
+sub mv
+{
+ my $dst = pop(@ARGV);
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
+  {
+   my $src = shift(@ARGV);               
+   move($src,$dst);
+  }
+}
+
+=item cp source... destination
+
+Copies source to destination.
+Multiple sources are allowed if destination is an existing directory.
+
+=cut 
+
+sub cp
+{
+ my $dst = pop(@ARGV);
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
+  {
+   my $src = shift(@ARGV);               
+   copy($src,$dst);
+  }
+}
+
+=item chmod mode files...
+
+Sets UNIX like permissions 'mode' on all the files.
+
+=cut 
+
+sub chmod
+{
+ my $mode = shift(@ARGV);
+ chmod($mode,expand_wildcards()) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
+}
+
+=item mkpath directory...
+
+Creates directory, including any parent directories.
+
+=cut 
+
+sub mkpath
+{
+ File::Path::mkpath([expand_wildcards()],1,0777);
+}
+
+=item test_f file
+
+Tests if a file exists
+
+=cut 
+
+sub test_f
+{
+ exit !-f shift(@ARGV);
+}
+
+
+1;
+__END__ 
+
+=back
+
+=head1 BUGS
+
+Should probably be Auto/Self loaded.
+
+=head1 SEE ALSO 
+
+ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
+
+=head1 AUTHOR
+
+Nick Ing-Simmons <F<nick@ni-s.u-net.com>>.
+
+=cut
+
diff --git a/contrib/perl5/lib/ExtUtils/Embed.pm b/contrib/perl5/lib/ExtUtils/Embed.pm
new file mode 100644
index 000000000000..e41ca40e66d6
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Embed.pm
@@ -0,0 +1,502 @@
+# $Id: Embed.pm,v 1.2501 $
+require 5.002;
+
+package ExtUtils::Embed;
+require Exporter;
+require FileHandle;
+use Config;
+use Getopt::Std;
+
+#Only when we need them
+#require ExtUtils::MakeMaker;
+#require ExtUtils::Liblist;
+
+use vars qw(@ISA @EXPORT $VERSION
+	    @Extensions $Verbose $lib_ext
+	    $opt_o $opt_s 
+	    );
+use strict;
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.2505 $ =~ /(\d+)\.(\d+)/);
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&xsinit &ldopts 
+	     &ccopts &ccflags &ccdlflags &perl_inc
+	     &xsi_header &xsi_protos &xsi_body);
+
+#let's have Miniperl borrow from us instead
+#require ExtUtils::Miniperl;
+#*canon = \&ExtUtils::Miniperl::canon;
+
+$Verbose = 0;
+$lib_ext = $Config{lib_ext} || '.a';
+
+sub is_cmd { $0 eq '-e' }
+
+sub my_return {
+    my $val = shift;
+    if(is_cmd) {
+	print $val;
+    }
+    else {
+	return $val;
+    }
+}
+
+sub is_perl_object {
+    $Config{ccflags} =~ /-DPERL_OBJECT/;  
+}
+
+sub xsinit { 
+    my($file, $std, $mods) = @_;
+    my($fh,@mods,%seen);
+    $file ||= "perlxsi.c";
+    my $xsinit_proto = is_perl_object() ? "CPERLarg" : "void";
+
+    if (@_) {
+       @mods = @$mods if $mods;
+    }
+    else {
+       getopts('o:s:');
+       $file = $opt_o if defined $opt_o;
+       $std  = $opt_s  if defined $opt_s;
+       @mods = @ARGV;
+    }
+    $std = 1 unless scalar @mods;
+
+    if ($file eq "STDOUT") {
+	$fh = \*STDOUT;
+    }
+    else {
+	$fh = new FileHandle "> $file";
+    }
+
+    push(@mods, static_ext()) if defined $std;
+    @mods = grep(!$seen{$_}++, @mods);
+
+    print $fh &xsi_header();
+    print $fh "EXTERN_C void xs_init _(($xsinit_proto));\n\n";     
+    print $fh &xsi_protos(@mods);
+
+    print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n";
+    print $fh &xsi_body(@mods);
+    print $fh "}\n";
+
+}
+
+sub xsi_header {
+    return <<EOF;
+#if defined(__cplusplus) && !defined(PERL_OBJECT)
+#define is_cplusplus
+#endif
+
+#ifdef is_cplusplus
+extern "C" {
+#endif
+
+#include <EXTERN.h>
+#include <perl.h>
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include <XSUB.h>
+#include "win32iop.h"
+#include <fcntl.h>
+#include <perlhost.h>
+#endif
+#ifdef is_cplusplus
+}
+#  ifndef EXTERN_C
+#    define EXTERN_C extern "C"
+#  endif
+#else
+#  ifndef EXTERN_C
+#    define EXTERN_C extern
+#  endif
+#endif
+
+EOF
+}    
+
+sub xsi_protos {
+    my(@exts) = @_;
+    my(@retval,%seen);
+    my $boot_proto = is_perl_object() ? 
+	"CV* cv _CPERLarg" : "CV* cv";
+    foreach $_ (@exts){
+        my($pname) = canon('/', $_);
+        my($mname, $cname);
+        ($mname = $pname) =~ s!/!::!g;
+        ($cname = $pname) =~ s!/!__!g;
+	my($ccode) = "EXTERN_C void boot_${cname} _(($boot_proto));\n";
+	next if $seen{$ccode}++;
+        push(@retval, $ccode);
+    }
+    return join '', @retval;
+}
+
+sub xsi_body {
+    my(@exts) = @_;
+    my($pname,@retval,%seen);
+    my($dl) = canon('/','DynaLoader');
+    push(@retval, "\tchar *file = __FILE__;\n");
+    push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002;
+    push(@retval, "\n");
+
+    foreach $_ (@exts){
+        my($pname) = canon('/', $_);
+        my($mname, $cname, $ccode);
+        ($mname = $pname) =~ s!/!::!g;
+        ($cname = $pname) =~ s!/!__!g;
+        if ($pname eq $dl){
+            # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+            # boot_DynaLoader is called directly in DynaLoader.pm
+            $ccode = "\t/* DynaLoader is a special case */\n\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
+            push(@retval, $ccode) unless $seen{$ccode}++;
+        } else {
+            $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
+            push(@retval, $ccode) unless $seen{$ccode}++;
+        }
+    }
+    return join '', @retval;
+}
+
+sub static_ext {
+    unless (scalar @Extensions) {
+	@Extensions = sort split /\s+/, $Config{static_ext};
+	unshift @Extensions, qw(DynaLoader);
+    }
+    @Extensions;
+}
+
+sub ldopts {
+    require ExtUtils::MakeMaker;
+    require ExtUtils::Liblist;
+    my($std,$mods,$link_args,$path) = @_;
+    my(@mods,@link_args,@argv);
+    my($dllib,$config_libs,@potential_libs,@path);
+    local($") = ' ' unless $" eq ' ';
+    my $MM = bless {} => 'MY';
+    if (scalar @_) {
+       @link_args = @$link_args if $link_args;
+       @mods = @$mods if $mods;
+    }
+    else {
+       @argv = @ARGV;
+       #hmm
+       while($_ = shift @argv) {
+	   /^-std$/  && do { $std = 1; next; };
+	   /^--$/    && do { @link_args = @argv; last; };
+	   /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
+	   push(@mods, $_); 
+       }
+    }
+    $std = 1 unless scalar @link_args;
+    @path = $path ? split(/:/, $path) : @INC;
+
+    push(@potential_libs, @link_args)    if scalar @link_args;
+    push(@potential_libs, $Config{libs}) if defined $std;
+
+    push(@mods, static_ext()) if $std;
+
+    my($mod,@ns,$root,$sub,$extra,$archive,@archives);
+    print STDERR "Searching (@path) for archives\n" if $Verbose;
+    foreach $mod (@mods) {
+	@ns = split(/::|\/|\\/, $mod);
+	$sub = $ns[-1];
+	$root = $MM->catdir(@ns);
+	
+	print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose;
+	foreach (@path) {
+	    next unless -e ($archive = $MM->catdir($_,"auto",$root,"$sub$lib_ext"));
+	    push @archives, $archive;
+	    if(-e ($extra = $MM->catdir($_,"auto",$root,"extralibs.ld"))) {
+		local(*FH); 
+		if(open(FH, $extra)) {
+		    my($libs) = <FH>; chomp $libs;
+		    push @potential_libs, split /\s+/, $libs;
+		}
+		else {  
+		    warn "Couldn't open '$extra'"; 
+		}
+	    }
+	    last;
+	}
+    }
+    #print STDERR "\@potential_libs = @potential_libs\n";
+
+    my $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl";
+
+    my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
+	$MM->ext(join ' ', 
+		 $MM->catdir("-L$Config{archlibexp}", "CORE"), " $libperl", 
+		 @potential_libs);
+
+    my $ld_or_bs = $bsloadlibs || $ldloadlibs;
+    print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
+    my $linkage = "$Config{ccdlflags} $Config{ldflags} @archives $ld_or_bs";
+    print STDERR "ldopts: '$linkage'\n" if $Verbose;
+
+    return $linkage if scalar @_;
+    my_return("$linkage\n");
+}
+
+sub ccflags {
+    my_return(" $Config{ccflags} ");
+}
+
+sub ccdlflags {
+    my_return(" $Config{ccdlflags} ");
+}
+
+sub perl_inc {
+    my_return(" -I$Config{archlibexp}/CORE ");
+}
+
+sub ccopts {
+   ccflags . perl_inc;
+}
+
+sub canon {
+    my($as, @ext) = @_;
+    foreach(@ext) {
+       # might be X::Y or lib/auto/X/Y/Y.a
+       next if s!::!/!g;
+       s:^(lib|ext)/(auto/)?::;
+       s:/\w+\.\w+$::;
+    }
+    grep(s:/:$as:, @ext) if ($as ne '/');
+    @ext;
+}
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
+
+=head1 SYNOPSIS
+
+
+ perl -MExtUtils::Embed -e xsinit 
+ perl -MExtUtils::Embed -e ldopts 
+
+=head1 DESCRIPTION
+
+ExtUtils::Embed provides utility functions for embedding a Perl interpreter
+and extensions in your C/C++ applications.  
+Typically, an application B<Makefile> will invoke ExtUtils::Embed
+functions while building your application.  
+
+=head1 @EXPORT
+
+ExtUtils::Embed exports the following functions:
+
+xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(), 
+ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
+
+=head1 FUNCTIONS
+
+=over
+
+=item xsinit()
+
+Generate C/C++ code for the XS initializer function.
+
+When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
+the following options are recognized:
+
+B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
+
+B<-o STDOUT> will print to STDOUT.
+
+B<-std> (Write code for extensions that are linked with the current Perl.)
+
+Any additional arguments are expected to be names of modules
+to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<xsinit($filename,$std,[@modules])>
+
+Where,
+
+B<$filename> is equivalent to the B<-o> option.
+
+B<$std> is boolean, equivalent to the B<-std> option.  
+
+B<[@modules]> is an array ref, same as additional arguments mentioned above.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
+
+
+This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function 
+to the C B<boot_Socket> function and writes it to a file named "xsinit.c".
+
+Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
+
+ perl -MExtUtils::Embed -e xsinit
+
+
+This will generate code for linking with B<DynaLoader> and 
+each static extension found in B<$Config{static_ext}>.
+The code is written to the default file name B<perlxsi.c>.
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
+
+
+Here, code is written for all the currently linked extensions along with code
+for B<DBI> and B<DBD::Oracle>.
+
+If you have a working B<DynaLoader> then there is rarely any need to statically link in any 
+other extensions.
+
+=item ldopts()
+
+Output arguments for linking the Perl library and extensions to your
+application.
+
+When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
+the following options are recognized:
+
+B<-std> 
+
+Output arguments for linking the Perl library and any extensions linked
+with the current Perl.
+
+B<-I> E<lt>path1:path2E<gt>
+
+Search path for ModuleName.a archives.  
+Default path is B<@INC>.
+Library archives are expected to be found as 
+B</some/path/auto/ModuleName/ModuleName.a>
+For example, when looking for B<Socket.a> relative to a search path, 
+we should find B<auto/Socket/Socket.a>  
+
+When looking for B<DBD::Oracle> relative to a search path,
+we should find B<auto/DBD/Oracle/Oracle.a>
+
+Keep in mind, you can always supply B</my/own/path/ModuleName.a>
+as an additional linker argument.
+
+B<-->  E<lt>list of linker argsE<gt>
+
+Additional linker arguments to be considered.
+
+Any additional arguments found before the B<--> token 
+are expected to be names of modules to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<ldopts($std,[@modules],[@link_args],$path)>
+
+Where,
+
+B<$std> is boolean, equivalent to the B<-std> option.  
+
+B<[@modules]> is equivalent to additional arguments found before the B<--> token.
+
+B<[@link_args]> is equivalent to arguments found after the B<--> token.
+
+B<$path> is equivalent to the B<-I> option.
+
+In addition, when ldopts is called with parameters, it will return the argument string
+rather than print it to STDOUT.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e ldopts
+
+
+This will print arguments for linking with B<libperl.a>, B<DynaLoader> and 
+extensions found in B<$Config{static_ext}>.  This includes libraries
+found in B<$Config{libs}> and the first ModuleName.a library
+for each extension that is found by searching B<@INC> or the path 
+specifed by the B<-I> option.  
+In addition, when ModuleName.a is found, additional linker arguments
+are picked up from the B<extralibs.ld> file in the same directory.
+
+
+ perl -MExtUtils::Embed -e ldopts -- -std Socket
+
+
+This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
+
+
+ perl -MExtUtils::Embed -e ldopts -- DynaLoader
+
+
+This will print arguments for linking with just the B<DynaLoader> extension
+and B<libperl.a>.
+
+
+ perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
+
+
+Any arguments after the second '--' token are additional linker
+arguments that will be examined for potential conflict.  If there is no
+conflict, the additional arguments will be part of the output.  
+
+
+=item perl_inc()
+
+For including perl header files this function simply prints:
+
+ -I$Config{archlibexp}/CORE  
+
+So, rather than having to say:
+
+ perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
+
+Just say:
+
+ perl -MExtUtils::Embed -e perl_inc
+
+=item ccflags(), ccdlflags()
+
+These functions simply print $Config{ccflags} and $Config{ccdlflags}
+
+=item ccopts()
+
+This function combines perl_inc(), ccflags() and ccdlflags() into one.
+
+=item xsi_header()
+
+This function simply returns a string defining the same B<EXTERN_C> macro as
+B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.  
+
+=item xsi_protos(@modules)
+
+This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
+
+=item xsi_body(@modules)
+
+This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
+function to B<boot_ModuleName> for each @modules.
+
+B<xsinit()> uses the xsi_* functions to generate most of it's code.
+
+=back
+
+=head1 EXAMPLES
+
+For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
+with embedded perl, see the eg/ directory and L<perlembed>.
+
+=head1 SEE ALSO
+
+L<perlembed>
+
+=head1 AUTHOR
+
+Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
+
+Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
+B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
+
+=cut
+
diff --git a/contrib/perl5/lib/ExtUtils/Install.pm b/contrib/perl5/lib/ExtUtils/Install.pm
new file mode 100644
index 000000000000..6a5c1847accc
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Install.pm
@@ -0,0 +1,374 @@
+package ExtUtils::Install;
+
+$VERSION = substr q$Revision: 1.28 $, 10;
+# $Date: 1998/01/25 07:08:24 $
+
+use Exporter;
+use Carp ();
+use Config qw(%Config);
+use vars qw(@ISA @EXPORT $VERSION);
+@ISA = ('Exporter');
+@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
+$Is_VMS = $^O eq 'VMS';
+
+my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
+my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
+my $Inc_uninstall_warn_handler;
+
+#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 ExtUtils::Packlist;
+    use File::Basename qw(dirname);
+    use File::Copy qw(copy);
+    use File::Find qw(find);
+    use File::Path qw(mkpath);
+    use File::Compare qw(compare);
+
+    my(%hash) = %$hash;
+    my(%pack, $dir, $warn_permissions);
+    my($packlist) = ExtUtils::Packlist->new();
+    # -w doesn't work reliably on FAT dirs
+    $warn_permissions++ if $^O eq 'MSWin32';
+    local(*DIR);
+    for (qw/read write/) {
+	$pack{$_}=$hash{$_};
+	delete $hash{$_};
+    }
+    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 {
+		warn "Warning: You do not have permissions to " .
+		    "install into $hash{$source_dir_or_file}"
+		    unless $warn_permissions++;
+	    }
+	}
+	closedir DIR;
+    }
+    $packlist->read($pack{"read"}) if (-f $pack{"read"});
+    my $cwd = cwd();
+    my $umask = umask 0 unless $Is_VMS;
+
+    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.
+
+	#October 1997: we want to install .pm files into archlib if
+	#there are any files in arch. So we depend on having ./blib/arch
+	#hardcoded here.
+	my $targetroot = $hash{$source};
+	if ($source eq "blib/lib" and
+	    exists $hash{"blib/arch"} and
+	    directory_not_empty("blib/arch")) {
+	    $targetroot = $hash{"blib/arch"};
+            print "Files found in blib/arch --> Installing files in " 
+	        . "blib/lib into architecture dependend library tree!\n"
+		; #if $verbose>1;
+	}
+	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($targetroot,$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 = compare($_,$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
+	    }
+	    $packlist->{$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";
+	$packlist->write($pack{'write'});
+    }
+}
+
+sub directory_not_empty ($) {
+  my($dir) = @_;
+  my $files = 0;
+  find(sub {
+	   return if $_ eq ".exists";
+	   if (-f) {
+	     $File::Find::prune++;
+	     $files = 1;
+	   }
+       }, $dir);
+  return $files;
+}
+
+sub install_default {
+  @_ < 2 or die "install_default should be called with 0 or 1 argument";
+  my $FULLEXT = @_ ? shift : $ARGV[0];
+  defined $FULLEXT or die "Do not know to where to write install log";
+  my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
+  my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
+  my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
+  my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
+  my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
+  my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
+  install({
+	   read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
+	   write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
+	   $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
+			 $Config{installsitearch} :
+			 $Config{installsitelib},
+	   $INST_ARCHLIB => $Config{installsitearch},
+	   $INST_BIN => $Config{installbin} ,
+	   $INST_SCRIPT => $Config{installscript},
+	   $INST_MAN1DIR => $Config{installman1dir},
+	   $INST_MAN3DIR => $Config{installman3dir},
+	  },1,0,0);
+}
+
+sub uninstall {
+    use ExtUtils::Packlist;
+    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
+    my ($packlist) = ExtUtils::Packlist->new($fil);
+    foreach (sort(keys(%$packlist))) {
+	chomp;
+	print "unlink $_\n" if $verbose;
+	forceunlink($_) unless $nonono;
+    }
+    print "unlink $fil\n" if $verbose;
+    close P;
+    forceunlink($fil) unless $nonono;
+}
+
+sub inc_uninstall {
+    my($file,$libdir,$verbose,$nonono) = @_;
+    my($dir);
+    my %seen_dir = ();
+    foreach $dir (@INC, @PERL_ENV_LIB, @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 = compare($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 File::Compare qw(compare);
+    use AutoSplit;
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+
+    if (!ref($fromto) && -r $fromto)
+     {
+      # Win32 has severe command line length limitations, but
+      # can generate temporary files on-the-fly
+      # so we pass name of file here - eval it to get hash 
+      open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
+      my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
+      eval $str;
+      close(FROMTO);
+     }
+
+    my $umask = umask 0022 unless $Is_VMS;
+    mkpath($autodir,0,0755);
+    foreach (keys %$fromto) {
+	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
+	unless (compare($_,$fromto->{$_})){
+	    print "Skip $fromto->{$_} (unchanged)\n";
+	    next;
+	}
+	if (-f $fromto->{$_}){
+	    forceunlink($fromto->{$_});
+	} else {
+	    mkpath(dirname($fromto->{$_}),0,0755);
+	}
+	copy($_,$fromto->{$_});
+	my($mode,$atime,$mtime) = (stat)[2,8,9];
+	utime($atime,$mtime+$Is_VMS,$fromto->{$_});
+	chmod(0444 | ( $mode & 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 C<$hashref-E<gt>{write}>. If there is
+another file named by C<$hashref-E<gt>{read}>, the contents of this file will
+be merged into the written file. The read and the written file may be
+identical, but on AFS it is quite likely, people are installing to a
+different directory than the one where the files later appear.
+
+install_default() takes one or less arguments.  If no arguments are 
+specified, it takes $ARGV[0] as if it was specified as an argument.  
+The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.  
+This function calls install() with the same arguments as the defaults 
+the MakeMaker would use.
+
+The argumement-less form is convenient for install scripts like
+
+  perl -MExtUtils::Install -e install_default Tk/Canvas
+
+Assuming this command is executed in a directory with populated F<blib> 
+directory, it will proceed as if the F<blib> was build by MakeMaker on 
+this machine.  This is useful for binary distributions.
+
+uninstall() takes as first argument a file containing filenames to be
+unlinked. The second argument is a verbose switch, the third is a
+no-don't-really-do-it-now switch.
+
+pm_to_blib() takes a hashref as the first argument and copies all keys
+of the hash to the corresponding values efficiently. Filenames with
+the extension pm are autosplit. Second argument is the autosplit
+directory.
+
+=cut
diff --git a/contrib/perl5/lib/ExtUtils/Installed.pm b/contrib/perl5/lib/ExtUtils/Installed.pm
new file mode 100644
index 000000000000..dda594e78432
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Installed.pm
@@ -0,0 +1,272 @@
+package ExtUtils::Installed;
+use strict;
+use Carp qw();
+use ExtUtils::Packlist;
+use ExtUtils::MakeMaker;
+use Config;
+use File::Find;
+use File::Basename;
+use vars qw($VERSION);
+$VERSION = '0.02';
+
+sub _is_type($$$)
+{
+my ($self, $path, $type) = @_;
+return(1) if ($type eq "all");
+if ($type eq "doc")
+   {
+   return(substr($path, 0, length($Config{installman1dir}))
+              eq $Config{installman1dir}
+          ||
+          substr($path, 0, length($Config{installman3dir}))
+              eq $Config{installman3dir}
+          ? 1 : 0)
+   }
+if ($type eq "prog")
+   {
+   return(substr($path, 0, length($Config{prefix})) eq $Config{prefix}
+          &&
+          substr($path, 0, length($Config{installman1dir}))
+             ne $Config{installman1dir}
+          &&
+          substr($path, 0, length($Config{installman3dir}))
+              ne $Config{installman3dir}
+          ? 1 : 0);
+   }
+return(0);
+}
+
+sub _is_under($$;)
+{
+my ($self, $path, @under) = @_;
+$under[0] = "" if (! @under);
+foreach my $dir (@under)
+   {
+   return(1) if (substr($path, 0, length($dir)) eq $dir);
+   }
+return(0);
+}
+
+sub new($)
+{
+my ($class) = @_;
+$class = ref($class) || $class;
+my $self = {};
+
+# Read the core packlist
+$self->{Perl}{packlist} =
+   ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
+$self->{Perl}{version} = $];
+
+# Read the module packlists
+my $sub = sub
+   {
+   # Only process module .packlists
+   return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib};
+
+   # Hack of the leading bits of the paths & convert to a module name
+   my $module = $File::Find::name;
+   $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!;
+   $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!;
+   my $modfile = "$module.pm";
+   $module =~ s!/!::!g;
+
+   # Find the top-level module file in @INC
+   $self->{$module}{version} = '';
+   foreach my $dir (@INC)
+      {
+      my $p = MM->catfile($dir, $modfile);
+      if (-f $p)
+         {
+         $self->{$module}{version} = MM->parse_version($p);
+         last;
+         }
+      }
+
+   # Read the .packlist
+   $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name);
+   };
+find($sub, $Config{archlib}, $Config{sitearch});
+
+return(bless($self, $class));
+}
+
+sub modules($)
+{
+my ($self) = @_;
+return(sort(keys(%$self)));
+}
+
+sub files($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+
+# Validate arguments
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+$type = "all" if (! defined($type));
+Carp::croak('type must be "all", "prog" or "doc"')
+   if ($type ne "all" && $type ne "prog" && $type ne "doc");
+
+my (@files);
+foreach my $file (keys(%{$self->{$module}{packlist}}))
+   {
+   push(@files, $file)
+      if ($self->_is_type($file, $type) && $self->_is_under($file, @under));
+   }
+return(@files);
+}
+
+sub directories($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+my (%dirs);
+foreach my $file ($self->files($module, $type, @under))
+   {
+   $dirs{dirname($file)}++;
+   }
+return(sort(keys(%dirs)));
+}
+
+sub directory_tree($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+my (%dirs);
+foreach my $dir ($self->directories($module, $type, @under))
+   {
+   $dirs{$dir}++;
+   my ($last) = ("");
+   while ($last ne $dir)
+      {
+      $last = $dir;
+      $dir = dirname($dir);
+      last if (! $self->_is_under($dir, @under));
+      $dirs{$dir}++;
+      }
+   }
+return(sort(keys(%dirs)));
+}
+
+sub validate($;$)
+{
+my ($self, $module, $remove) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{packlist}->validate($remove));
+}
+
+sub packlist($$)
+{
+my ($self, $module) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{packlist});
+}
+
+sub version($$)
+{
+my ($self, $module) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{version});
+}
+
+sub DESTROY
+{
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Installed - Inventory management of installed modules
+
+=head1 SYNOPSIS
+
+   use ExtUtils::Installed;
+   my ($inst) = ExtUtils::Installed->new();
+   my (@modules) = $inst->modules();
+   my (@missing) = $inst->validate("DBI");
+   my $all_files = $inst->files("DBI");
+   my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
+   my $all_dirs = $inst->directories("DBI");
+   my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
+   my $packlist = $inst->packlist("DBI");
+
+=head1 DESCRIPTION
+
+ExtUtils::Installed  provides a standard way to find out what core and module
+files have been installed.  It uses the information stored in .packlist files
+created during installation to provide this information.  In addition it
+provides facilities to classify the installed files and to extract directory
+information from the .packlist files.
+
+=head1 USAGE
+
+The new() function searches for all the installed .packlists on the system, and
+stores their contents. The .packlists can be queried with the functions
+described below.
+
+=head1 FUNCTIONS
+
+=over
+
+=item new()
+
+This takes no parameters, and searches for all the installed .packlists on the
+system.  The packlists are read using the ExtUtils::packlist module.
+
+=item modules()
+
+This returns a list of the names of all the installed modules.  The perl 'core'
+is given the special name 'Perl'.
+
+=item files()
+
+This takes one mandatory parameter, the name of a module.  It returns a list of
+all the filenames from the package.  To obtain a list of core perl files, use
+the module name 'Perl'.  Additional parameters are allowed.  The first is one
+of the strings "prog", "man" or "all", to select either just program files,
+just manual files or all files.  The remaining parameters are a list of
+directories. The filenames returned will be restricted to those under the
+specified directories.
+
+=item directories()
+
+This takes one mandatory parameter, the name of a module.  It returns a list of
+all the directories from the package.  Additional parameters are allowed.  The
+first is one of the strings "prog", "man" or "all", to select either just
+program directories, just manual directories or all directories.  The remaining
+parameters are a list of directories. The directories returned will be
+restricted to those under the specified directories.  This method returns only
+the leaf directories that contain files from the specified module.
+
+=item directory_tree()
+
+This is identical in operation to directory(), except that it includes all the
+intermediate directories back up to the specified directories.
+
+=item validate()
+
+This takes one mandatory parameter, the name of a module.  It checks that all
+the files listed in the modules .packlist actually exist, and returns a list of
+any missing files.  If an optional second argument which evaluates to true is
+given any missing files will be removed from the .packlist
+
+=item packlist()
+
+This returns the ExtUtils::Packlist object for the specified module.
+
+=item version()
+
+This returns the version number for the specified module.
+
+=back
+
+=head1 EXAMPLE
+
+See the example in L<ExtUtils::Packlist>.
+
+=head1 AUTHOR
+
+Alan Burlison <Alan.Burlison@uk.sun.com>
+
+=cut
diff --git a/contrib/perl5/lib/ExtUtils/Liblist.pm b/contrib/perl5/lib/ExtUtils/Liblist.pm
new file mode 100644
index 000000000000..b072c1292c7f
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Liblist.pm
@@ -0,0 +1,750 @@
+package ExtUtils::Liblist;
+use vars qw($VERSION);
+# Broken out of MakeMaker from version 4.11
+
+$VERSION = substr q$Revision: 1.25 $, 10;
+
+use Config;
+use Cwd 'cwd';
+use File::Basename;
+
+sub ext {
+  if   ($^O eq 'VMS')     { return &_vms_ext;      }
+  elsif($^O eq 'MSWin32') { return &_win32_ext;    }
+  else                    { return &_unix_os2_ext; }
+}
+
+sub _unix_os2_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;
+    warn "Potential libraries are '$potential_libs':\n" if $verbose;
+
+    my($so)   = $Config{'so'};
+    my($libs) = $Config{'libs'};
+    my $Config_libext = $Config{lib_ext} || ".a";
+
+
+    # compute $extralibs, $bsloadlibs and $ldloadlibs from
+    # $potential_libs
+    # this is a rewrite of Andy Dougherty's extliblist in perl
+
+    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){
+		warn "$ptype$thislib ignored, directory does not exist\n"
+			if $verbose;
+		next;
+	    }
+	    unless ($self->file_name_is_absolute($thislib)) {
+	      warn "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//){
+	  warn "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,"^\Qlib$thislib.$so.\E[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 {
+		warn "$thislib not found in $thispth\n" if $verbose;
+		next;
+	    }
+	    warn "'-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 math and ndbm 
+	    # are both in libsys_s
+	    unless ($in_perl || 
+		($Config{'osname'} eq 'next' &&
+		    ($thislib eq 'm' || $thislib eq 'ndbm')) ){
+		push(@extralibs, "-l$thislib");
+	    }
+
+	    # We might be able to load this archive file dynamically
+	    if ( ($Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0')
+	    ||   ($Config{'dlsrc'} =~ /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
+	}
+	warn "Note (probably harmless): "
+		     ."No library found for -l$thislib\n"
+	    unless $found_lib>0;
+    }
+    return ('','','','') unless $found;
+    ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
+}
+
+sub _win32_ext {
+
+    require Text::ParseWords;
+
+    my($self, $potential_libs, $verbose) = @_;
+
+    # If user did not supply a list, we punt.
+    # (caller should probably use the list in $Config{libs})
+    return ("", "", "", "") unless $potential_libs;
+
+    my $cc		= $Config{cc};
+    my $VC		= 1 if $cc =~ /^cl/i;
+    my $BC		= 1 if $cc =~ /^bcc/i;
+    my $GC		= 1 if $cc =~ /^gcc/i;
+    my $so		= $Config{'so'};
+    my $libs		= $Config{'libs'};
+    my $libpth		= $Config{'libpth'};
+    my $libext		= $Config{'lib_ext'} || ".lib";
+
+    if ($libs and $potential_libs !~ /:nodefault/i) { 
+	# If Config.pm defines a set of default libs, we always
+	# tack them on to the user-supplied list, unless the user
+	# specified :nodefault
+
+	$potential_libs .= " " if $potential_libs;
+	$potential_libs .= $libs;
+    }
+    warn "Potential libraries are '$potential_libs':\n" if $verbose;
+
+    # normalize to forward slashes
+    $libpth =~ s,\\,/,g;
+    $potential_libs =~ s,\\,/,g;
+
+    # compute $extralibs from $potential_libs
+
+    my @searchpath;		    # from "-L/path" in $potential_libs
+    my @libpath		= Text::ParseWords::quotewords('\s+', 0, $libpth);
+    my @extralibs;
+    my $pwd		= cwd();    # from Cwd.pm
+    my $lib		= '';
+    my $found		= 0;
+    my $search		= 1;
+    my($fullname, $thislib, $thispth);
+
+    foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
+
+	$thislib = $_;
+
+        # see if entry is a flag
+	if (/^:\w+$/) {
+	    $search	= 0 if lc eq ':nosearch';
+	    $search	= 1 if lc eq ':search';
+	    warn "Ignoring unknown flag '$thislib'\n"
+		if $verbose and !/^:(no)?(search|default)$/i;
+	    next;
+	}
+
+	# if searching is disabled, do compiler-specific translations
+	unless ($search) {
+	    s/^-L/-libpath:/ if $VC;
+	    s/^-l(.+)$/$1.lib/ unless $GC;
+	    push(@extralibs, $_);
+	    $found++;
+	    next;
+	}
+
+	# handle possible linker path arguments
+	if (s/^-L// and not -d) {
+	    warn "$thislib ignored, directory does not exist\n"
+		if $verbose;
+	    next;
+	}
+	elsif (-d) {
+	    unless ($self->file_name_is_absolute($_)) {
+	      warn "Warning: '$thislib' changed to '-L$pwd/$_'\n";
+	      $_ = $self->catdir($pwd,$_);
+	    }
+	    push(@searchpath, $_);
+	    next;
+	}
+
+	# handle possible library arguments
+	if (s/^-l// and $GC and !/^lib/i) {
+	    $_ = "lib$_";
+	}
+	$_ .= $libext if !/\Q$libext\E$/i;
+
+	my $secondpass = 0;
+    LOOKAGAIN:
+
+        # look for the file itself
+	if (-f) {
+	    warn "'$thislib' found as '$_'\n" if $verbose;
+	    $found++;
+	    push(@extralibs, $_);
+	    next;
+	}
+
+	my $found_lib = 0;
+	foreach $thispth (@searchpath, @libpath){
+	    unless (-f ($fullname="$thispth\\$_")) {
+		warn "'$thislib' not found as '$fullname'\n" if $verbose;
+		next;
+	    }
+	    warn "'$thislib' found as '$fullname'\n" if $verbose;
+	    $found++;
+	    $found_lib++;
+	    push(@extralibs, $fullname);
+	    last;
+	}
+
+	# do another pass with (or without) leading 'lib' if they used -l
+	if (!$found_lib and $thislib =~ /^-l/ and !$secondpass++) {
+	    if ($GC) {
+		goto LOOKAGAIN if s/^lib//i;
+	    }
+	    elsif (!/^lib/i) {
+		$_ = "lib$_";
+		goto LOOKAGAIN;
+	    }
+	}
+
+	# give up
+	warn "Note (probably harmless): "
+		     ."No library found for '$thislib'\n"
+	    unless $found_lib>0;
+
+    }
+
+    return ('','','','') unless $found;
+
+    # make sure paths with spaces are properly quoted
+    @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs;
+    $lib = join(' ',@extralibs);
+
+    # normalize back to backward slashes (to help braindead tools)
+    # XXX this may break equally braindead GNU tools that don't understand
+    # backslashes, either.  Seems like one can't win here.  Cursed be CP/M.
+    $lib =~ s,/,\\,g;
+
+    warn "Result: $lib\n" if $verbose;
+    wantarray ? ($lib, '', $lib, '') : $lib;
+}
+
+
+sub _vms_ext {
+  my($self, $potential_libs,$verbose) = @_;
+  my(@crtls,$crtlstr);
+  my($dbgqual) = $self->{OPTIMIZE} || $Config{'optimize'} ||
+                 $self->{CCFLAS}   || $Config{'ccflags'};
+  @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '')
+              . 'PerlShr/Share' );
+  push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'});
+  push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'});
+  # In general, we pass through the basic libraries from %Config unchanged.
+  # The one exception is that if we're building in the Perl source tree, and
+  # a library spec could be resolved via a logical name, we go to some trouble
+  # to insure that the copy in the local tree is used, rather than one to
+  # which a system-wide logical may point.
+  if ($self->{PERL_SRC}) {
+    my($lib,$locspec,$type);
+    foreach $lib (@crtls) { 
+      if (($locspec,$type) = $lib =~ m-^([\w$\-]+)(/\w+)?- and $locspec =~ /perl/i) {
+        if    (lc $type eq '/share')   { $locspec .= $Config{'exe_ext'}; }
+        elsif (lc $type eq '/library') { $locspec .= $Config{'lib_ext'}; }
+        else                           { $locspec .= $Config{'obj_ext'}; }
+        $locspec = $self->catfile($self->{PERL_SRC},$locspec);
+        $lib = "$locspec$type" if -e $locspec;
+      }
+    }
+  }
+  $crtlstr = @crtls ? join(' ',@crtls) : '';
+
+  unless ($potential_libs) {
+    warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
+    return ('', '', $crtlstr, '');
+  }
+
+  my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj,$ldlib);
+  my $cwd = cwd();
+  my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'};
+  # List of common Unix library names and there VMS equivalents
+  # (VMS equivalent of '' indicates that the library is automatially
+  # searched by the linker, and should be skipped here.)
+  my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
+                 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
+                 'socket' => '', 'X11' => 'DECW$XLIBSHR',
+                 'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
+                 'Xmu' => 'DECW$XMULIBSHR');
+  if ($Config{'vms_cc_type'} ne 'decc') { $libmap{'curses'} = 'VAXCCURSE'; }
+
+  warn "Potential libraries are '$potential_libs'\n" if $verbose;
+
+  # First, sort out directories and library names in the input
+  foreach $lib (split ' ',$potential_libs) {
+    push(@dirs,$1),   next if $lib =~ /^-L(.*)/;
+    push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
+    push(@dirs,$lib), next if -d $lib;
+    push(@libs,$1),   next if $lib =~ /^-l(.*)/;
+    push(@libs,$lib);
+  }
+  push(@dirs,split(' ',$Config{'libpth'}));
+
+  # Now make sure we've got VMS-syntax absolute directory specs
+  # (We don't, however, check whether someone's hidden a relative
+  # path in a logical name.)
+  foreach $dir (@dirs) {
+    unless (-d $dir) {
+      warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
+      $dir = '';
+      next;
+    }
+    warn "Resolving directory $dir\n" if $verbose;
+    if ($self->file_name_is_absolute($dir)) { $dir = $self->fixpath($dir,1); }
+    else                                    { $dir = $self->catdir($cwd,$dir); }
+  }
+  @dirs = grep { length($_) } @dirs;
+  unshift(@dirs,''); # Check each $lib without additions first
+
+  LIB: foreach $lib (@libs) {
+    if (exists $libmap{$lib}) {
+      next unless length $libmap{$lib};
+      $lib = $libmap{$lib};
+    }
+
+    my(@variants,$variant,$name,$test,$cand);
+    my($ctype) = '';
+
+    # If we don't have a file type, consider it a possibly abbreviated name and
+    # check for common variants.  We try these first to grab libraries before
+    # a like-named executable image (e.g. -lperl resolves to perlshr.exe
+    # before perl.exe).
+    if ($lib !~ /\.[^:>\]]*$/) {
+      push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
+      push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
+    }
+    push(@variants,$lib);
+    warn "Looking for $lib\n" if $verbose;
+    foreach $variant (@variants) {
+      foreach $dir (@dirs) {
+        my($type);
+
+        $name = "$dir$variant";
+        warn "\tChecking $name\n" if $verbose > 2;
+        if (-f ($test = VMS::Filespec::rmsexpand($name))) {
+          # It's got its own suffix, so we'll have to figure out the type
+          if    ($test =~ /(?:$so|exe)$/i)      { $type = 'sh'; }
+          elsif ($test =~ /(?:$lib_ext|olb)$/i) { $type = 'olb'; }
+          elsif ($test =~ /(?:$obj_ext|obj)$/i) {
+            warn "Note (probably harmless): "
+			 ."Plain object file $test found in library list\n";
+            $type = 'obj';
+          }
+          else {
+            warn "Note (probably harmless): "
+			 ."Unknown library type for $test; assuming shared\n";
+            $type = 'sh';
+          }
+        }
+        elsif (-f ($test = VMS::Filespec::rmsexpand($name,$so))      or
+               -f ($test = VMS::Filespec::rmsexpand($name,'.exe')))     {
+          $type = 'sh';
+          $name = $test unless $test =~ /exe;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$lib_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.olb'))))  {
+          $type = 'olb';
+          $name = $test unless $test =~ /olb;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$obj_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.obj'))))  {
+          warn "Note (probably harmless): "
+		       ."Plain object file $test found in library list\n";
+          $type = 'obj';
+          $name = $test unless $test =~ /obj;?\d*$/i;
+        }
+        if (defined $type) {
+          $ctype = $type; $cand = $name;
+          last if $ctype eq 'sh';
+        }
+      }
+      if ($ctype) { 
+        eval '$' . $ctype . "{'$cand'}++";
+        die "Error recording library: $@" if $@;
+        warn "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1;
+        next LIB;
+      }
+    }
+    warn "Note (probably harmless): "
+		 ."No library found for $lib\n";
+  }
+
+  @libs = sort keys %obj;
+  # This has to precede any other CRTLs, so just make it first
+  if ($olb{VAXCCURSE}) {
+    push(@libs,"$olb{VAXCCURSE}/Library");
+    delete $olb{VAXCCURSE};
+  }
+  push(@libs, map { "$_/Library" } sort keys %olb);
+  push(@libs, map { "$_/Share"   } sort keys %sh);
+  $lib = join(' ',@libs);
+
+  $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
+  warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
+  wantarray ? ($lib, '', $ldlib, '') : $lib;
+}
+
+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($self, $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.  Some of these don't mean anything
+on VMS and Win32.  See the details about those platform specifics
+below.
+
+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.
+
+=head2 VMS implementation
+
+The version of ext() which is executed under VMS differs from the
+Unix-OS/2 version in several respects:
+
+=over 2
+
+=item *
+
+Input library and path specifications are accepted with or without the
+C<-l> and C<-L> prefices used by Unix linkers.  If neither prefix is
+present, a token is considered a directory to search if it is in fact
+a directory, and a library to search for otherwise.  Authors who wish
+their extensions to be portable to Unix or OS/2 should use the Unix
+prefixes, since the Unix-OS/2 version of ext() requires them.
+
+=item *
+
+Wherever possible, shareable images are preferred to object libraries,
+and object libraries to plain object files.  In accordance with VMS
+naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
+it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
+used in some ported software.
+
+=item *
+
+For each library that is found, an appropriate directive for a linker options
+file is generated.  The return values are space-separated strings of
+these directives, rather than elements used on the linker command line.
+
+=item *
+
+LDLOADLIBS contains both the libraries found based on C<$potential_libs> and
+the CRTLs, if any, specified in Config.pm.  EXTRALIBS contains just those
+libraries found based on C<$potential_libs>.  BSLOADLIBS and LD_RUN_PATH
+are always empty.
+
+=back
+
+In addition, an attempt is made to recognize several common Unix library
+names, and filter them out or convert them to their VMS equivalents, as
+appropriate.
+
+In general, the VMS version of ext() should properly handle input from
+extensions originally designed for a Unix or VMS environment.  If you
+encounter problems, or discover cases where the search could be improved,
+please let us know.
+
+=head2 Win32 implementation
+
+The version of ext() which is executed under Win32 differs from the
+Unix-OS/2 version in several respects:
+
+=over 2
+
+=item *
+
+If C<$potential_libs> is empty, the return value will be empty.
+Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm)
+will be appended to the list of C<$potential_libs>.  The libraries
+will be searched for in the directories specified in C<$potential_libs>
+as well as in C<$Config{libpth}>. For each library that is found,  a
+space-separated list of fully qualified library pathnames is generated.
+
+=item *
+
+Input library and path specifications are accepted with or without the
+C<-l> and C<-L> prefices used by Unix linkers.
+
+An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
+for the libraries that follow.
+
+An entry of the form C<-lfoo> specifies the library C<foo>, which may be
+spelled differently depending on what kind of compiler you are using.  If
+you are using GCC, it gets translated to C<libfoo.a>, but for other win32
+compilers, it becomes C<foo.lib>.  If no files are found by those translated
+names, one more attempt is made to find them using either C<foo.a> or
+C<libfoo.lib>, depending on whether GCC or some other win32 compiler is
+being used, respectively.
+
+If neither the C<-L> or C<-l> prefix is present in an entry, the entry is
+considered a directory to search if it is in fact a directory, and a
+library to search for otherwise.  The C<$Config{lib_ext}> suffix will
+be appended to any entries that are not directories and don't already have
+the suffix.
+
+Note that the C<-L> and <-l> prefixes are B<not required>, but authors
+who wish their extensions to be portable to Unix or OS/2 should use the
+prefixes, since the Unix-OS/2 version of ext() requires them.
+
+=item *
+
+Entries cannot be plain object files, as many Win32 compilers will
+not handle object files in the place of libraries.
+
+=item *
+
+Entries in C<$potential_libs> beginning with a colon and followed by
+alphanumeric characters are treated as flags.  Unknown flags will be ignored.
+
+An entry that matches C</:nodefault/i> disables the appending of default
+libraries found in C<$Config{libs}> (this should be only needed very rarely).
+
+An entry that matches C</:nosearch/i> disables all searching for
+the libraries specified after it.  Translation of C<-Lfoo> and
+C<-lfoo> still happens as appropriate (depending on compiler being used,
+as reflected by C<$Config{cc}>), but the entries are not verified to be
+valid files or directories.
+
+An entry that matches C</:search/i> reenables searching for
+the libraries specified after it.  You can put it at the end to
+enable searching for default libraries specified by C<$Config{libs}>.
+
+=item *
+
+The libraries specified may be a mixture of static libraries and
+import libraries (to link with DLLs).  Since both kinds are used
+pretty transparently on the win32 platform, we do not attempt to
+distinguish between them.
+
+=item *
+
+LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS
+and LD_RUN_PATH are always empty (this may change in future).
+
+=item *
+
+You must make sure that any paths and path components are properly
+surrounded with double-quotes if they contain spaces. For example,
+C<$potential_libs> could be (literally):
+
+	"-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib"
+
+Note how the first and last entries are protected by quotes in order
+to protect the spaces.
+
+=item *
+
+Since this module is most often used only indirectly from extension
+C<Makefile.PL> files, here is an example C<Makefile.PL> entry to add
+a library to the build process for an extension:
+
+        LIBS => ['-lgl']
+
+When using GCC, that entry specifies that MakeMaker should first look
+for C<libgl.a> (followed by C<gl.a>) in all the locations specified by
+C<$Config{libpth}>.
+
+When using a compiler other than GCC, the above entry will search for
+C<gl.lib> (followed by C<libgl.lib>).
+
+If the library happens to be in a location not in C<$Config{libpth}>,
+you need:
+
+        LIBS => ['-Lc:\gllibs -lgl']
+
+Here is a less often used example:
+
+        LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32']
+
+This specifies a search for library C<gl> as before.  If that search
+fails to find the library, it looks at the next item in the list. The
+C<:nosearch> flag will prevent searching for the libraries that follow,
+so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>,
+since GCC can use that value as is with its linker.
+
+When using the Visual C compiler, the second item is returned as
+C<-libpath:d:\mesalibs mesa.lib user32.lib>.
+
+When using the Borland compiler, the second item is returned as
+C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of
+moving the C<-Ld:\mesalibs> to the correct place in the linker
+command line.
+
+=back
+
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
diff --git a/contrib/perl5/lib/ExtUtils/MM_OS2.pm b/contrib/perl5/lib/ExtUtils/MM_OS2.pm
new file mode 100644
index 000000000000..8bddb42c6dd6
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/MM_OS2.pm
@@ -0,0 +1,85 @@
+package ExtUtils::MM_OS2;
+
+#use Config;
+#use Cwd;
+#use File::Basename;
+require Exporter;
+
+Exporter::import('ExtUtils::MakeMaker',
+       qw( $Verbose &neatvalue));
+
+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),
+     ', "VERSION" => "',$self->{VERSION},
+     '", "DL_VARS" => ', neatvalue($vars), ');\'
+');
+    }
+    join('',@m);
+}
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,.,g;
+    $man;
+}
+
+sub maybe_command {
+    my($self,$file) = @_;
+    $file =~ s,[/\\]+,/,g;
+    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 ;
+}
+
+sub perl_archive
+{
+ return "\$(PERL_INC)/libperl\$(LIB_EXT)";
+}
+
+sub export_list
+{
+ my ($self) = @_;
+ return "$self->{BASEEXT}.def";
+}
+
+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/contrib/perl5/lib/ExtUtils/MM_Unix.pm b/contrib/perl5/lib/ExtUtils/MM_Unix.pm
new file mode 100644
index 000000000000..9a96504b75ab
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/MM_Unix.pm
@@ -0,0 +1,3539 @@
+package ExtUtils::MM_Unix;
+
+use Exporter ();
+use Config;
+use File::Basename qw(basename dirname fileparse);
+use DirHandle;
+use strict;
+use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
+	    $Verbose %pm %static $Xsubpp_Version);
+
+$VERSION = substr q$Revision: 1.12601 $, 10;
+# $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $
+
+Exporter::import('ExtUtils::MakeMaker',
+	qw( $Verbose &neatvalue));
+
+$Is_OS2 = $^O eq 'os2';
+$Is_Mac = $^O eq 'MacOS';
+$Is_Win32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
+
+$Is_PERL_OBJECT   = 1 if $Config{'ccflags'} =~ /-DPERL_OBJECT/;
+
+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 primitive methods, and if it is not
+possible to do so, let's work 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) = @_;
+    my $node = '';
+    if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) {
+      $node = $1;
+    }
+    $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
+    "$node$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 {
+    my $self = shift @_;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
+    }
+    $self->canonpath(join('', @args));
+}
+
+=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 $self->canonpath($file) unless @_;
+    my $dir = $self->catdir(@_);
+    for ($dir) {
+	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+    }
+    return $self->canonpath($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::export_list ;
+sub ExtUtils::MM_Unix::extliblist ;
+sub ExtUtils::MM_Unix::file_name_is_absolute ;
+sub ExtUtils::MM_Unix::find_perl ;
+sub ExtUtils::MM_Unix::fixin ;
+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_archive;
+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::ppd ;
+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__
+
+=back
+
+=head2 SelfLoaded methods
+
+=over 2
+
+=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
+';
+    push @m, '
+.C$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific
+    push @m, '
+.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{$_}
+    }
+
+    if ($self->{CAPI} && $Is_PERL_OBJECT == 1) {
+        $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
+        $self->{CCFLAGS} .= '-DPERL_CAPI';
+        if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
+            # Turn off C++ mode of the MSC compiler
+            $self->{CCFLAGS} =~ s/-TP(\s|$)//;
+            $self->{OPTIMIZE} =~ s/-TP(\s|$)//;
+        }
+    }
+    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 \$(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";
+    }
+
+    for $tmp (qw(
+		PERM_RW PERM_RWX
+		)
+	     ) {
+        my $method = lc($tmp);
+	# warn "self[$self] method[$method]";
+        push @m, "$tmp = ", $self->$method(), "\n";
+    }
+
+    push @m, q{
+.NO_CONFIG_REC: Makefile
+} if $ENV{CLEARCASE_ROOT};
+
+    # why not q{} ? -- emacs
+    push @m, qq{
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
+
+.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    =
+';
+    }
+
+    $tmp = $self->export_list;
+    push @m, "
+EXPORT_LIST = $tmp
+";
+    $tmp = $self->perl_archive;
+    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,$targdir);
+    foreach $dir (@dirs) {
+	my($src) = $self->catfile($self->{PERL_INC},'perl.h');
+	my($targ) = $self->catfile($dir,'.exists');
+	# catfile may have adapted syntax of $dir to target OS, so...
+	if ($Is_VMS) { # Just remove file name; dirspec is often in macro
+	    ($targdir = $targ) =~ s:/?\.exists$::;
+	}
+	else { # while elsewhere we expect to see the dir separator in $targ
+	    $targdir = dirname($targ);
+	}
+	next if $self->{DIR_TARGET}{$self}{$targdir}++;
+	push @m, qq{
+$targ :: $src
+	$self->{NOECHO}\$(MKPATH) $targdir
+	$self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ
+};
+	push(@m, qq{
+	-$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $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} || 'gzip --best';
+    my($suffix)   = $attribs{SUFFIX}   || '.gz';          # 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) -MExtUtils::Manifest=fullcheck \\
+		-e fullcheck
+};
+
+    push @m, q{
+skipcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \\
+		-e skipcheck
+};
+
+    push @m, q{
+manifest :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::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) -MExtUtils::Manifest=maniread \\
+		-e "@all = keys %{ maniread() };" \\
+		-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\
+		-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+};
+    join "", @m;
+}
+
+=item dist_core (o)
+
+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)" \
+		-MExtUtils::Mkbootstrap \
+		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
+	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
+	$(CHMOD) $(PERM_RW) $@
+
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
+	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
+	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
+	$(CHMOD) $(PERM_RW) $@
+';
+}
+
+=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');
+
+    # Brain dead solaris linker does not use LD_RUN_PATH?
+    # This fixes dynamic extensions which need shared libs
+    my $ldrun = '';
+    $ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}
+       if ($^O eq 'solaris');
+
+    # The IRIX linker also doesn't use LD_RUN_PATH
+    $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"}
+	if ($^O eq 'irix' && $self->{LD_RUN_PATH});
+
+    push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
+		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
+    push @m, '
+	$(CHMOD) $(PERM_RWX) $@
+';
+
+    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, if it is an absolute path.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    if ($Is_Dos){
+        $file =~ m{^([a-z]:)?[\\/]}i ;
+    }
+    else {
+        $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, $val);
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->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);
+	    $val = `$abs -e 'require $ver; print "VER_OK\n" ' 2>&1`;
+	    if ($val =~ /VER_OK/) {
+	        print "Using PERL=$abs\n" if $trace;
+	        return $abs;
+	    } elsif ($trace >= 2) {
+		print "Result: `$val'\n";
+	    }
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+=back
+
+=head2 Methods to actually produce chunks of text for the Makefile
+
+The methods here are called for each MakeMaker object in the order
+specified by @ExtUtils::MakeMaker::MM_Sections.
+
+=over 2
+
+=item fixin
+
+Inserts the sharpbang or equivalent magic number to a script
+
+=cut
+
+sub fixin { # stolen from the pink Camel book, more or less
+    my($self,@files) = @_;
+    my($does_shbang) = $Config::Config{'sharpbang'} =~ /^\s*\#\!/;
+    my($file,$interpreter);
+    for $file (@files) {
+	local(*FIXIN);
+	local(*FIXOUT);
+	open(FIXIN, $file) or Carp::croak "Can't process '$file': $!";
+	local $/ = "\n";
+	chomp(my $line = <FIXIN>);
+	next unless $line =~ s/^\s*\#!\s*//;     # Not a shbang file.
+	# Now figure out the interpreter name.
+	my($cmd,$arg) = split ' ', $line, 2;
+	$cmd =~ s!^.*/!!;
+
+	# Now look (in reverse) for interpreter in absolute PATH (unless perl).
+	if ($cmd eq "perl") {
+            if ($Config{startperl} =~ m,^\#!.*/perl,) {
+                $interpreter = $Config{startperl};
+                $interpreter =~ s,^\#!,,;
+            } else {
+                $interpreter = $Config{perlpath};
+            }
+	} else {
+	    my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path;
+	    $interpreter = '';
+	    my($dir);
+	    foreach $dir (@absdirs) {
+		if ($self->maybe_command($cmd)) {
+		    warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter;
+		    $interpreter = $self->catfile($dir,$cmd);
+		}
+	    }
+	}
+	# Figure out how to invoke interpreter on this machine.
+
+	my($shb) = "";
+	if ($interpreter) {
+	    print STDOUT "Changing sharpbang in $file to $interpreter" if $Verbose;
+	    # this is probably value-free on DOSISH platforms
+	    if ($does_shbang) {
+		$shb .= "$Config{'sharpbang'}$interpreter";
+		$shb .= ' ' . $arg if defined $arg;
+		$shb .= "\n";
+	    }
+	    $shb .= qq{
+eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
+    if 0; # not running under some shell
+} unless $Is_Win32; # this won't work on win32, so don't
+	} else {
+	    warn "Can't find $cmd in PATH, $file unchanged"
+		if $Verbose;
+	    next;
+	}
+
+	unless ( open(FIXOUT,">$file.new") ) {
+	    warn "Can't create new $file: $!\n";
+	    next;
+	}
+	my($dev,$ino,$mode) = stat FIXIN;
+	# If they override perm_rwx, we won't notice it during fixin,
+	# because fixin is run through a new instance of MakeMaker.
+	# That is why we must run another CHMOD later.
+	$mode = oct($self->perm_rwx) unless $dev;
+	chmod $mode, $file;
+	
+	# Print out the new #! line (or equivalent).
+	local $\;
+	undef $/;
+	print FIXOUT $shb, <FIXIN>;
+	close FIXIN;
+	close FIXOUT;
+	# can't rename open files on some DOSISH platforms
+	unless ( rename($file, "$file.bak") ) {	
+	    warn "Can't rename $file to $file.bak: $!";
+	    next;
+	}
+	unless ( rename("$file.new", $file) ) {	
+	    warn "Can't rename $file.new to $file: $!";
+	    unless ( rename("$file.bak", $file) ) {
+	        warn "Can't rename $file.bak back to $file either: $!";
+		warn "Leaving $file renamed as $file.bak\n";
+	    }
+	    next;
+	}
+	unlink "$file.bak";
+    } continue {
+	chmod oct($self->perm_rwx), $file or
+	  die "Can't reset permissions for $file: $!\n";
+	system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';;
+    }
+}
+
+=item force (o)
+
+Just writes FORCE:
+
+=cut
+
+sub force {
+    my($self) = shift;
+    '# Phony target to force checking subdirectories.
+FORCE:
+	'.$self->{NOECHO}.'$(NOOP)
+';
+}
+
+=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{qw(Makefile.PL test.pl)} = (1,1);
+    $ignore{'makefile.pl'} = 1 if $Is_VMS;
+    foreach $name ($self->lsdir($self->curdir)){
+	next if $name =~ /\#/;
+	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 =~ /\.PL$/) {
+	    ($pl_files{$name} = $name) =~ s/\.PL$// ;
+	} elsif ($Is_VMS && $name =~ /\.pl$/) {  # case-insensitive filesystem
+	    local($/); open(PL,$name); my $txt = <PL>; close PL;
+	    if ($txt =~ /Extracting \S+ \(with variable substitutions/) {
+		($pl_files{$name} = $name) =~ s/\.pl$// ;
+	    }
+	    else { $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); }
+	} elsif ($name =~ /\.(p[ml]|pod)$/){
+	    $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name);
+	}
+    }
+
+    # 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;
+	    }
+	    return if /\#/;
+	    my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)');
+	    my($striplibpath,$striplibname);
+	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:i);
+	    ($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;
+#		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, EXE_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);
+    }
+
+    ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)$! ;
+
+    if (defined &DynaLoader::mod2fname) {
+	# 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}     = ($Is_Win32) ? $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC};
+
+	# catch a situation that has occurred a few times in the past:
+	unless (
+		-s $self->catfile($self->{PERL_SRC},'cflags')
+		or
+		$Is_VMS
+		&&
+		-s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt')
+		or
+		$Is_Mac
+		or
+		$Is_Win32
+	       ){
+	    warn qq{
+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.
+};
+	}
+    } 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;
+	unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))){
+	    die qq{
+Error: Unable to locate installed Perl libraries or Perl source code.
+
+It is recommended that you install perl in a standard location before
+building extensions. Some precompiled versions of perl do not contain
+these header files, so you cannot build extensions. In such a case,
+please build and install your perl from a fresh perl distribution. It
+usually solves this kind of problem.
+
+\(You get this message, because MakeMaker could not find "$perl_h"\)
+};
+	}
+#	 print STDOUT "Using header files found in $self->{PERL_INC}\n"
+#	     if $Verbose && $self->needs_linking();
+
+    }
+
+    # We get SITELIBEXP and SITEARCHEXP directly via
+    # 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');
+
+    # We need to set up INST_LIBDIR before init_libscan() for VMS
+    my @parentdir = split(/::/, $self->{PARENT_NAME});
+    $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)',@parentdir);
+    $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)',@parentdir);
+    $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)','auto','$(FULLEXT)');
+    $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)');
+
+    # 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($configure_prefix) = $Config{'prefix'};
+    $configure_prefix = VMS::Filespec::unixify($configure_prefix) if $Is_VMS;
+    $self->{PREFIX} ||= $configure_prefix;
+
+
+    my($install_variable,$search_prefix,$replace_prefix);
+
+    # The rule, taken from Configure, is that if prefix contains perl,
+    # we shape the tree
+    #    perlprefix/lib/                INSTALLPRIVLIB
+    #    perlprefix/lib/pod/
+    #    perlprefix/lib/site_perl/	INSTALLSITELIB
+    #    perlprefix/bin/		INSTALLBIN
+    #    perlprefix/man/		INSTALLMAN1DIR
+    # else
+    #    prefix/lib/perl5/		INSTALLPRIVLIB
+    #    prefix/lib/perl5/pod/
+    #    prefix/lib/perl5/site_perl/	INSTALLSITELIB
+    #    prefix/bin/			INSTALLBIN
+    #    prefix/lib/perl5/man/		INSTALLMAN1DIR
+
+    $replace_prefix = qq[\$\(PREFIX\)];
+    for $install_variable (qw/
+			   INSTALLBIN
+			   INSTALLSCRIPT
+			   /) {
+	$self->prefixify($install_variable,$configure_prefix,$replace_prefix);
+    }
+    $search_prefix = $configure_prefix =~ /perl/ ?
+	$self->catdir($configure_prefix,"lib") :
+	$self->catdir($configure_prefix,"lib","perl5");
+    if ($self->{LIB}) {
+	$self->{INSTALLPRIVLIB} = $self->{INSTALLSITELIB} = $self->{LIB};
+	$self->{INSTALLARCHLIB} = $self->{INSTALLSITEARCH} = 
+	    $self->catdir($self->{LIB},$Config{'archname'});
+    } else {
+	$replace_prefix = $self->{PREFIX} =~ /perl/ ? 
+	    $self->catdir(qq[\$\(PREFIX\)],"lib") :
+		$self->catdir(qq[\$\(PREFIX\)],"lib","perl5");
+	for $install_variable (qw/
+			       INSTALLPRIVLIB
+			       INSTALLARCHLIB
+			       INSTALLSITELIB
+			       INSTALLSITEARCH
+			       /) {
+	    $self->prefixify($install_variable,$search_prefix,$replace_prefix);
+	}
+    }
+    $search_prefix = $configure_prefix =~ /perl/ ?
+	$self->catdir($configure_prefix,"man") :
+	    $self->catdir($configure_prefix,"lib","perl5","man");
+    $replace_prefix = $self->{PREFIX} =~ /perl/ ? 
+	$self->catdir(qq[\$\(PREFIX\)],"man") :
+	    $self->catdir(qq[\$\(PREFIX\)],"lib","perl5","man");
+    for $install_variable (qw/
+			   INSTALLMAN1DIR
+			   INSTALLMAN3DIR
+			   /) {
+	$self->prefixify($install_variable,$search_prefix,$replace_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 );
+    # 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, TEST_F, 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}  ||= '$(SHELL) -c true';
+    $self->{FIRST_MAKEFILE} ||= "Makefile";
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
+    $self->{NOECHO} = '@' unless defined $self->{NOECHO};
+    $self->{RM_F}  ||= "rm -f";
+    $self->{RM_RF} ||= "rm -rf";
+    $self->{TOUCH} ||= "touch";
+    $self->{TEST_F} ||= "test -f";
+    $self->{CP} ||= "cp";
+    $self->{MV} ||= "mv";
+    $self->{CHMOD} ||= "chmod";
+    $self->{UMASK_NULL} ||= "umask 0";
+    $self->{DEV_NULL} ||= "> /dev/null 2>&1";
+}
+
+=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) \
+		"Module" "$(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, qq{
+EXE_FILES = @{$self->{EXE_FILES}}
+
+} . ($Is_Win32
+  ? q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+    -e "system qq[pl2bat.bat ].shift"
+} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \
+    -e "MY->fixin(shift)"
+}).qq{
+all :: @to
+	$self->{NOECHO}\$(NOOP)
+
+realclean ::
+	$self->{RM_F} @to
+});
+
+    while (($from,$to) = each %fromto) {
+	last unless defined $from;
+	my $todir = dirname($to);
+	push @m, "
+$to: $from $self->{MAKEFILE} " . $self->catdir($todir,'.exists') . "
+	$self->{NOECHO}$self->{RM_F} $to
+	$self->{CP} $from $to
+	\$(FIXIN) $to
+	-$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $to
+";
+    }
+    join "", @m;
+}
+
+=item libscan (o)
+
+Takes a path to a file that is found by init_dirscan and returns false
+if we don't want to include this file in the library. Mainly used to
+exclude RCS, CVS, and SCCS directories from installation.
+
+=cut
+
+# ';
+
+sub libscan {
+    my($self,$path) = @_;
+    return '' if $path =~ m:\b(RCS|CVS|SCCS)\b: ;
+    $path;
+}
+
+=item linkext (o)
+
+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.
+
+By default the Makefile produced includes all the static extensions in
+the perl library. (Purified versions of library files, e.g.,
+DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.)
+
+=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{useshrplib} eq 'true');
+    $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
+
+    # The front matter of the linkcommand...
+    $linkcmd = join ' ', "\$(CC)",
+	    grep($_, @Config{qw(large split ldflags ccdlflags)});
+    $linkcmd =~ s/\s+/ /g;
+    $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
+
+    # 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/;
+	# Skip purified versions of libraries (e.g., DynaLoader_pure_p1_c0_032.a)
+	return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
+
+	if( exists $self->{INCLUDE_EXT} ){
+		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";
+
+        if (! -f $libperl and ! -f $lperl) {
+          # We did not find a static libperl. Maybe there is a shared one?
+          if ($^O eq 'solaris' or $^O eq 'sunos') {
+            $lperl  = $libperl = "$dir/$Config::Config{libperl}";
+            # SUNOS ld does not take the full path to a shared library
+            $libperl = '' if $^O eq 'sunos';
+          }
+        }
+
+	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";
+    }
+    # SUNOS ld does not take the full path to a shared library
+    my $llibperl = ($libperl)?'$(MAP_LIBPERL)':'-lperl';
+
+    # Brain dead solaris linker does not use LD_RUN_PATH?
+    # This fixes dynamic extensions which need shared libs
+    my $ldfrom = ($^O eq 'solaris')?
+           join(' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}):'';
+
+push @m, "
+\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
+	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) $ldfrom \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
+	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
+	$self->{NOECHO}echo 'To remove the intermediate files say'
+	$self->{NOECHO}echo '    make -f $makefilename map_clean'
+
+$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) -MExtUtils::Miniperl \\
+		-e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
+
+};
+    push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
+} if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
+
+
+    push @m, q{
+doc_inst_perl:
+	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+	-}.$self->{NOECHO}.q{$(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{$(RM_F) }."$self->{MAKEFILE}.old".q{
+	-}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
+	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP)
+	$(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 : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless
+	%{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = $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],
+qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n],
+q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "],
+ $self->{MAKEFILE}, q[";' \\
+-e 'print "Manifying $$m{$$_}\n";' \\
+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
+-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
+];
+    push @m, "\nmanifypods : pure_all ";
+    push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
+
+    push(@m,"\n");
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t";
+	push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}};
+    }
+    join('', @m);
+}
+
+=item maybe_command
+
+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.*\=/;
+	next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
+	my $eval = qq{
+	    package ExtUtils::MakeMaker::_version;
+	    no strict;
+
+	    local $1$2;
+	    \$$2=undef; do {
+		$_
+	    }; \$$2
+	};
+	local($^W) = 0;
+	$result = eval($eval);
+	die "Could not eval '$eval' in $parsefile: $@" if $@;
+	$result = "undef" unless defined $result;
+	last;
+    }
+    close FH;
+    return $result;
+}
+
+=item parse_abstract
+
+parse a file and return what you think is the ABSTRACT
+
+=cut
+
+sub parse_abstract {
+    my($self,$parsefile) = @_;
+    my $result;
+    local *FH;
+    local $/ = "\n";
+    open(FH,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    my $package = $self->{DISTNAME};
+    $package =~ s/-/::/;
+    while (<FH>) {
+        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+        next if !$inpod;
+        chop;
+        next unless /^($package\s-\s)(.*)/;
+        $result = $2;
+        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);
+    my($sep) = $Is_VMS ? ',' : '';
+    $sep .= "\\\n\t";
+
+    foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){
+	push @pasthru, "$key=\"\$($key)\"";
+    }
+
+    push @m, "\nPASTHRU = ", join ($sep, @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 || $Is_Dos) ? ";" : ":";
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g if $Is_OS2;
+    my @path = split $path_sep, $path;
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @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)/iperlsys.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 ppd
+
+Defines target that creates a PPD (Perl Package Description) file
+for a binary distribution.
+
+=cut
+
+sub ppd {
+    my($self) = @_;
+    my(@m);
+    if ($self->{ABSTRACT_FROM}){
+        $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
+            Carp::carp "WARNING: Setting ABSTRACT via file '$self->{ABSTRACT_FROM}' failed\n";
+    }
+    my ($pack_ver) = join ",", (split (/\./, $self->{VERSION}), (0) x 4) [0 .. 3];
+    push(@m, "# Creates a PPD (Perl Package Description) for a binary distribution.\n");
+    push(@m, "ppd:\n");
+    push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}");
+    push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}");
+    my $abstract = $self->{ABSTRACT};
+    $abstract =~ s/</&lt;/g;
+    $abstract =~ s/>/&gt;/g;
+    push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}");
+    my ($author) = $self->{AUTHOR};
+    $author =~ s/@/\\@/g;
+    push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}");
+    push(@m, ". qq{\\t<IMPLEMENTATION>\\n}");
+    my ($prereq);
+    foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
+        my $pre_req = $prereq;
+        $pre_req =~ s/::/-/g;
+        push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" />\\n}");
+    }
+    push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}");
+    my ($bin_location) = $self->{BINARY_LOCATION};
+    $bin_location =~ s/\\/\\\\/g;
+    if ($self->{PPM_INSTALL_SCRIPT}) {
+        if ($self->{PPM_INSTALL_EXEC}) {
+            push(@m, " . qq{\\t\\t<INSTALL EXEC=\\\"$self->{PPM_INSTALL_EXEC}\\\">$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}");
+        }
+        else {
+            push(@m, " . qq{\\t\\t<INSTALL>$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}");
+        }
+    }
+    push(@m, ". qq{\\t\\t<CODEBASE HREF=\\\"$bin_location\\\" />\\n}");
+    push(@m, ". qq{\\t</IMPLEMENTATION>\\n}");
+    push(@m, ". qq{</SOFTPKG>\\n}\" > $self->{DISTNAME}.ppd");
+
+    join("", @m);   
+}
+
+=item perm_rw (o)
+
+Returns the attribute C<PERM_RW> or the string C<644>.
+Used as the string that is passed
+to the C<chmod> command to set the permissions for read/writeable files.
+MakeMaker chooses C<644> because it has turned out in the past that
+relying on the umask provokes hard-to-track bugreports.
+When the return value is used by the perl function C<chmod>, it is
+interpreted as an octal value.
+
+=cut
+
+sub perm_rw {
+    shift->{PERM_RW} || "644";
+}
+
+=item perm_rwx (o)
+
+Returns the attribute C<PERM_RWX> or the string C<755>,
+i.e. the string that is passed
+to the C<chmod> command to set the permissions for executable files.
+See also perl_rw.
+
+=cut
+
+sub perm_rwx {
+    shift->{PERM_RWX} || "755";
+}
+
+=item pm_to_blib
+
+Defines target that copies all files in the hash PM to their
+destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+    my($autodir) = $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 empty 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->{NOECHO}\$(NOOP)
+
+$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")
+	if keys %{$self->{PM}};
+    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) $@
+	$(CHMOD) $(PERM_RWX) $@
+	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+};
+    # Old mechanism - still available:
+    push @m,
+"\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
+}	if $self->{PERL_SRC} && $self->{EXTRALIBS};
+    push @m, "\n";
+
+    push @m, $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};
+    if (!$tests && -d 't') {
+	$tests = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t';
+    }
+    # note: 'test.pl' name is also hardcoded in init_dirscan()
+    my(@m);
+    push(@m,"
+TEST_VERBOSE=0
+TEST_TYPE=test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = $tests
+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)', '$(TEST_FILES)')) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', '$(TEST_FILE)')) 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)', '$(TEST_FILES)')) if $tests;
+	push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) 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) = @_;
+    $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32;
+    "\t$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) = @_;
+    $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32;
+    qq{\t$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 TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
+	push @m, "$_ = $self->{$_}\n";
+    }
+
+    push @m, q{
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
+};
+
+
+    return join "", @m if $self->{PARENT};
+
+    push @m, q{
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\
+-e 'print "WARNING: I have found an old package in\n";' \\
+-e 'print "\t$$ARGV[0].\n";' \\
+-e 'print "Please make sure the two installations are not conflicting\n";'
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
+
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
+-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", 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,1); print "\nUninstall is deprecated. Please check the";' \
+-e 'print " packlist above carefully.\n  There may be errors. Remove the";' \
+-e 'print " appropriate files manually.\n  Sorry for the inconveniences.\n"'
+};
+
+    return join "", @m;
+}
+
+=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} = "";
+	}
+    }
+
+    $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
+
+    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
+';
+
+    push @m, '
+all :: pure_all manifypods
+	'.$self->{NOECHO}.'$(NOOP)
+' 
+	  unless $self->{SKIPHASH}{'all'};
+    
+    push @m, '
+pure_all :: config pm_to_blib subdirs linkext
+	'.$self->{NOECHO}.'$(NOOP)
+
+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
+';
+}
+
+=item perl_archive
+
+This is internal method that returns path to libperl.a equivalent
+to be linked to dynamic extensions. UNIX does not have one but OS2
+and Win32 do.
+
+=cut 
+
+sub perl_archive
+{
+ return "";
+}
+
+=item export_list
+
+This is internal method that returns name of a file that is
+passed to linker to define symbols to be exported.
+UNIX does not have one but OS2 and Win32 do.
+
+=cut 
+
+sub export_list
+{
+ return "";
+}
+
+
+1;
+
+=back
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+__END__
diff --git a/contrib/perl5/lib/ExtUtils/MM_VMS.pm b/contrib/perl5/lib/ExtUtils/MM_VMS.pm
new file mode 100644
index 000000000000..d7e59c2b8e73
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/MM_VMS.pm
@@ -0,0 +1,2391 @@
+#   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;
+
+use Carp qw( &carp );
+use Config;
+require Exporter;
+use VMS::Filespec;
+use File::Basename;
+
+use vars qw($Revision);
+$Revision = '5.42 (31-Mar-1997)';
+
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
+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
+
+=over
+
+=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($complex) = 0;
+    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);
+            if (ref $self->{$macro}) {
+                if (ref $self->{$macro} eq 'ARRAY') {
+                    print "Note: expanded array macro \$($macro) in $path\n" if $Verbose;
+                    $macro = join ' ', @{$self->{$macro}};
+                }
+                else {
+                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                    $macro = "\cB$macro\cB";
+                    $complex = 1;
+                }
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
+            $npath = "$head$macro$tail";
+        }
+    }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; }
+    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, if it is FALSE, the return string
+is a VMS-syntax file specification, and if it is not specified, fixpath()
+checks to see whether it matches the name of a directory in the current
+default directory, and returns a directory or file specification accordingly.
+
+=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) = $self->eliminate_macros("\$($prefix)");
+        # is it a dir or just a name?
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : '';
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # No hints, so we try to guess
+    if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+        $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+    }
+    # Trim off root dirname if it's had other dirs inserted in front of it.
+    $fixedpath =~ s/\.000000([\]>])/$1/;
+    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 = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+    }
+    else { 
+      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
+      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 wraplist
+
+Converts a list into a string wrapped at approximately 80 columns.
+
+=cut
+
+sub wraplist {
+    my($self) = shift;
+    my($line,$hlen) = ('',0);
+    my($word);
+
+    foreach $word (@_) {
+      # Perl bug -- seems to occasionally insert extra elements when
+      # traversing array (scalar(@array) doesn't show them, but
+      # foreach(@array) does) (5.00307)
+      next unless $word =~ /\w/;
+      $line .= ' ' if length($line);
+      if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
+      $line .= $word;
+      $hlen += length($word) + 2;
+    }
+    $line;
+}
+
+=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::ext;
+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::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__
+
+
+# This isn't really an override.  It's just here because ExtUtils::MM_VMS
+# appears in @MM::ISA before ExtUtils::Liblist, so if there isn't an ext()
+# in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
+# mimic inheritance here and hand off to ExtUtils::Liblist.
+sub ext {
+  ExtUtils::Liblist::ext(@_);
+}
+
+=back
+
+=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.
+
+=over
+
+=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,@pm,%xs,$pm);
+    local *PM;
+
+    $defname = basename(fileify($ENV{'DEFAULT'}));
+    $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
+    $defpm = $defname;
+    # Fallback in case for some reason a user has copied the files for an
+    # extension into a working directory whose name doesn't reflect the
+    # extension's name.  We'll use the name of a unique .pm file, or the
+    # first .pm file with a matching .xs file.
+    if (not -e "${defpm}.pm") {
+      @pm = map { s/.pm$//; $_ } glob('*.pm');
+      if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
+      elsif (@pm) {
+        %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
+        if (%xs) { foreach $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } }
+      }
+    }
+    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);
+    my($inabs) = 0;
+    # Check in relative directories first, so we pick up the current
+    # version of Perl if we're running MakeMaker as part of the main build.
+    @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
+                    my($absb) = $self->file_name_is_absolute($b);
+                    if ($absa && $absb) { return $a cmp $b }
+                    else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
+                  } @$dirs;
+    # Check miniperl before perl, and check names likely to contain
+    # version numbers before "generic" names, so we pick up an
+    # executable that's less likely to be from an old installation.
+    @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
+                     my($bb) = $b =~ m!([^:>\]/]+)$!;
+                     my($ahasdir) = (length($a) - length($ba) > 0);
+                     my($bhasdir) = (length($b) - length($bb) > 0);
+                     if    ($ahasdir and not $bhasdir) { return 1; }
+                     elsif ($bhasdir and not $ahasdir) { return -1; }
+                     else { $bb =~ /\d/ <=> $ba =~ /\d/
+                            or substr($ba,0,1) cmp substr($bb,0,1)
+                            or length($bb) <=> length($ba) } } @$names;
+    # Image names containing Perl version use '_' instead of '.' under VMS
+    foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
+    if ($trace >= 2){
+	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
+	$inabs++ if $self->file_name_is_absolute($dir);
+	if ($inabs == 1) {
+	    # We've covered relative dirs; everything else is an absolute
+	    # dir (probably an installed location).  First, we'll try potential
+	    # command names, to see whether we can avoid a long MCR expression.
+	    foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
+	    $inabs++; # Should happen above in next $dir, but just in case . . .
+	}
+	foreach $name (@snames){
+	    if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
+	    else                     { push(@cand,$self->fixpath($name,0));    }
+	}
+    }
+    foreach $name (@cand) {
+	print "Checking $name\n" if ($trace >= 2);
+	# If it looks like a potential command, try it without the MCR
+	if ($name =~ /^[\w\-\$]+$/ &&
+	    `$name -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+	    print "Using PERL=$name\n" if $trace;
+	    return $name;
+	}
+	next unless $vmsfile = $self->maybe_command($name);
+	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
+	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> (or equivalent) to check for executable image, and F<.Com>
+to check for DCL procedure.  If this fails, checks directories in DCL$PATH
+and finally F<Sys$System:> for an executable file having the name specified,
+with or without the F<.Exe>-equivalent suffix.
+
+=cut
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d _;
+    my(@dirs) = ('');
+    my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
+    my($dir,$ext);
+    if ($file !~ m![/:>\]]!) {
+	for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
+	    $dir = $ENV{"DCL\$PATH;$i"};
+	    $dir .= ':' unless $dir =~ m%[\]:]$%;
+	    push(@dirs,$dir);
+	}
+	push(@dirs,'Sys$System:');
+	foreach $dir (@dirs) {
+	    my $sysfile = "$dir$file";
+	    foreach $ext (@exts) {
+		return $file if -x "$sysfile$ext" && ! -d _;
+	    }
+	}
+    }
+    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 $abs\n" if $trace;
+		    return $abs;
+		}
+	    } else { # Do not look for perl
+		return $abs;
+	    }
+	}
+    }
+}
+
+=item perl_script (override)
+
+If name passed in doesn't specify a readable file, appends F<.com> or
+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.com" if -r "$file.com";
+    return "$file.pl" if -r "$file.pl";
+    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) = @_;
+    # If it's a logical name, expand it.
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
+    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
+}
+
+=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} = '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} = '! ';  
+    &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;
+	    if ($def =~ s/^-D//) {       # If it was a Unix-style definition
+		$def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
+		$def =~ s/^'(.*)'$/$1/;   # from entire term or argument
+	    }
+	    if ($def =~ /=/) {
+		$def =~ s/"/""/g;  # Protect existing " from DCL
+		$def = qq["$def"]; # and quote to prevent parsing of =
+	    }
+	}
+	$self->{DEFINE} = join ',',@defs;
+    }
+
+    if ($self->{OBJECT} =~ /\s/) {
+	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
+	$self->{OBJECT} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{OBJECT})));
+    }
+    $self->{LDFROM} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{LDFROM})));
+
+
+    # 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},0);
+    }
+
+    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 VERSION_FROM OBJECT LDFROM
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n";
+    }
+
+    for $tmp (qw/
+	      BASEEXT PARENT_NAME DLBASE INC DEFINE 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,0)} = $self->fixpath($self->{$tmp}{$key},0);
+	}
+	$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,0));
+	}
+	$self->{$tmp} = \@tmp;
+    }
+
+    push @m,'
+
+# Handy lists of source code files:
+XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),'
+C_FILES  = ',$self->wraplist(@{$self->{C}}),'
+O_FILES  = ',$self->wraplist(@{$self->{O_FILES}} ),'
+H_FILES  = ',$self->wraplist(@{$self->{H}}),'
+MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),'
+
+';
+
+    for $tmp (qw/
+	      INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+	      /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+push @m,"
+.SUFFIXES :
+.SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
+
+# Here is the Config.pm that we are using/depend on
+CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
+
+# Where to put things:
+INST_LIBDIR      = $self->{INST_LIBDIR}
+INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
+
+INST_AUTODIR     = $self->{INST_AUTODIR}
+INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
+";
+
+    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 {
+	my $shr = $Config{'dbgprefix'} . 'PERLSHR';
+	push @m,'
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+EXPORT_LIST = $(BASEEXT).opt
+PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),'
+';
+    }
+
+    $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
+    $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
+    push @m,'
+TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),'
+
+PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),'
+';
+
+    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, since some C compilers pay attention to only one
+instance of this qualifier on the command line.
+
+=cut
+
+sub cflags {
+    my($self,$libperl) = @_;
+    my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
+    my($definestr,$undefstr,$flagoptstr) = ('','','');
+    my($incstr) = '/Include=($(PERL_INC)';
+    my($name,$sys,@m);
+
+    ( $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});
+
+    if ($quals =~ / -[DIUOg]/) {
+	while ($quals =~ / -([Og])(\d*)\b/) {
+	    my($type,$lvl) = ($1,$2);
+	    $quals =~ s/ -$type$lvl\b\s*//;
+	    if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
+	    else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
+	}
+	while ($quals =~ / -([DIU])(\S+)/) {
+	    my($type,$def) = ($1,$2);
+	    $quals =~ s/ -$type$def\s*//;
+	    $def =~ s/"/""/g;
+	    if    ($type eq 'D') { $definestr .= qq["$def",]; }
+	    elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); }
+	    else                 { $undefstr  .= qq["$def",]; }
+	}
+    }
+    if (length $quals and $quals !~ m!/!) {
+	warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
+	$quals = '';
+    }
+    if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
+    if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
+    # 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{'ccflags'} 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";
+# This whole section is commented out, since I don't think it's necessary (or applicable)
+#    if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; }
+#    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' );
+#	my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type}));
+#	$quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add;
+#	$self->{PERLTYPE} ||= $type;
+#    }
+
+    # Likewise with $self->{INC} and /Include
+    if ($self->{'INC'}) {
+	my(@includes) = split(/\s+/,$self->{INC});
+	foreach (@includes) {
+	    s/^-I//;
+	    $incstr .= ', '.$self->fixpath($_,1);
+	}
+    }
+    $quals .= "$incstr)";
+    $self->{CCFLAGS} = $quals;
+
+    $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
+    if ($self->{OPTIMIZE} !~ m!/!) {
+	if    ($self->{OPTIMIZE} =~ m!\b-g\b!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
+	elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
+	    $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
+	}
+	else {
+	    warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
+	    $self->{OPTIMIZE} = '/Optimize';
+	}
+    }
+
+    return $self->{CFLAGS} = qq{
+CCFLAGS = $self->{CCFLAGS}
+OPTIMIZE = $self->{OPTIMIZE}
+PERLTYPE = $self->{PERLTYPE}
+SPLIT =
+LARGE =
+};
+}
+
+=item const_cccmd (override)
+
+Adds directives to point C preprocessor to the right place when
+handling #include E<lt>sys/foo.hE<gt> 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{
+
+# Dummy target to match Unix target name; we use pm_to_blib.ts as
+# timestamp file to avoid repeated invocations under VMS
+pm_to_blib : pm_to_blib.ts
+	$(NOECHO) $(NOOP)
+
+# As always, keep under DCL's 255-char limit
+pm_to_blib.ts : $(TO_INST_PM)
+	$(NOECHO) $(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\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
+	    $line = '';
+	}
+    }
+    push(@m,"\t\$(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[
+	\$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	\$(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,0));
+		}
+	}
+    }
+    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 ==E<gt> good)
+rather than Unix rules ($sts == 0 ==E<gt> 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` ;
+    if ($?) {
+	use vmsish 'status';
+	warn "Running '$command' exits with status $?";
+    }
+    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` ;
+    if ($?) {
+	use vmsish 'status';
+	warn "Running '$command' exits with status $?";
+    }
+    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}
+SAY = Write Sys\$Output
+UMASK_NULL = $self->{UMASK_NULL}
+NOOP = $self->{NOOP}
+NOECHO = $self->{NOECHO}
+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 '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
+UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
+!);
+}
+
+=item dist (override)
+
+Provide VMSish defaults for some values, then hand off to
+default MM_Unix method.
+
+=cut
+
+sub dist {
+    my($self, %attribs) = @_;
+    $attribs{VERSION}      ||= $self->{VERSION_SYM};
+    $attribs{NAME}         ||= $self->{DISTNAME};
+    $attribs{ZIPFLAGS}     ||= '-Vu';
+    $attribs{COMPRESS}     ||= 'gzip';
+    $attribs{SUFFIX}       ||= '-gz';
+    $attribs{SHAR}         ||= 'vms_share';
+    $attribs{DIST_DEFAULT} ||= 'zipdist';
+
+    # Sanitize these for use in $(DISTVNAME) filespec
+    $attribs{VERSION} =~ s/[^\w\$]/_/g;
+    $attribs{NAME} =~ s/[^\w\$]/_/g;
+
+    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
+	$(NOECHO) $(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+	$(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	$(NOECHO) $(NOOP)
+
+config :: $(MAKEFILE) $(INST_LIBDIR).exists
+	$(NOECHO) $(NOOP)
+
+config :: $(INST_ARCHAUTODIR).exists
+	$(NOECHO) $(NOOP)
+
+config :: $(INST_AUTODIR).exists
+	$(NOECHO) $(NOOP)
+';
+
+    push @m, q{
+config :: Version_check
+	$(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, q[
+config :: $(INST_MAN1DIR).exists
+	$(NOECHO) $(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    }
+    if (%{$self->{MAN3PODS}}) {
+	push @m, q[
+config :: $(INST_MAN3DIR).exists
+	$(NOECHO) $(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
+    }
+
+    push @m, '
+$(O_FILES) : $(H_FILES)
+' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
+
+    push @m, q{
+help :
+	perldoc ExtUtils::MakeMaker
+};
+
+    push @m, q{
+Version_check :
+	$(NOECHO) $(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(@m);
+
+    unless ($self->{SKIPHASH}{'dynamic'}) {
+	push(@m,'
+dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOECHO) $(NOOP)
+');
+    }
+
+    push(@m,'
+static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOECHO) $(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)
+');
+
+    if (length $self->{LDLOADLIBS}) {
+	my($lib); my($line) = '';
+	foreach $lib (split ' ', $self->{LDLOADLIBS}) {
+	    $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
+	    if (length($line) + length($lib) > 160) {
+		push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
+		$line = $lib . '\n';
+	    }
+	    else { $line .= $lib . '\n'; }
+	}
+	push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
+    }
+
+    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 $shr = $Config{'dbgprefix'} . 'PerlShr';
+    my(@m);
+    push @m,"
+
+OTHERLDFLAGS = $otherldflags
+INST_DYNAMIC_DEP = $inst_dynamic_dep
+
+";
+    push @m, '
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+	$(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
+	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+=item dynamic_bs (override)
+
+Use VMS-style quoting on Mkbootstrap command line.
+
+=cut
+
+sub dynamic_bs {
+    my($self, %attribs) = @_;
+    return '
+BOOTSTRAP =
+' unless $self->has_link_code();
+    '
+BOOTSTRAP = '."$self->{BASEEXT}.bs".'
+
+# As MakeMaker mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
+	$(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	$(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
+	$(NOECHO) $(TOUCH) $(MMS$TARGET)
+
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
+	$(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) :
+	$(NOECHO) $(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, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+
+    push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
+
+    # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
+    # 'cause it's a library and you can't stick them in other libraries.
+    # In that case, we use $OBJECT instead and hope for the best
+    if ($self->{MYEXTLIB}) {
+      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); 
+    } else {
+      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
+    }
+    
+    push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n");
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    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\$(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');
+    }
+    if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
+	# No pod2man but some MAN3PODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program.  As a last choice,
+         I will look for the file to which the logical name POD2MAN
+         points when MMK is invoked.
+
+END
+        $pod2man_exe = "pod2man";
+    }
+    my(@m);
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
+q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
+-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
+];
+    push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	my($pod);
+	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN1PODS}{$pod}\n";
+	}
+	foreach $pod (sort keys %{$self->{MAN3PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN3PODS}{$pod}\n";
+	}
+    }
+    join('', @m);
+}
+
+=item processPL (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub processPL {
+    my($self) = @_;
+    return "" unless $self->{PL_FILES};
+    my(@m, $plfile);
+    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+	my $vmsplfile = vmsify($plfile);
+	my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
+	push @m, "
+all :: $vmsfile
+	\$(NOECHO) \$(NOOP)
+
+$vmsfile :: $vmsplfile
+",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
+";
+    }
+    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);
+    my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
+    for $from (@exefiles) {
+	my($path) = '$(INST_SCRIPT)' . basename($from);
+	local($_) = $path;  # backward compatibility
+	$to = $self->libscan($path);
+	print "libscan($from) => '$to'\n" if ($Verbose >=2);
+	$fromto{$from} = vmsify($to);
+    }
+    @to = values %fromto;
+    push @m, "
+EXE_FILES = @exefiles
+
+all :: @to
+	\$(NOECHO) \$(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)$(MMSQUALIFIERS) 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)").nes."" Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
+    }
+    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
+';
+
+    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
+    # Unlink realclean, $attribs{FILES} is a string here; it may contain
+    # a list or a macro that expands to a list.
+    if ($attribs{FILES}) {
+	my($word,$key,@filist);
+	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+	else { @filist = split /\s+/, $attribs{FILES}; }
+	foreach $word (@filist) {
+	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+		push(@otherfiles, @{$self->{$key}});
+	    }
+	    else { push(@otherfiles, $word); }
+	}
+    }
+    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
+    # Occasionally files are repeated several times from different sources
+    { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
+    
+    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)$(MMSQUALIFIERS) 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
+    # Occasionally files are repeated several times from different sources
+    { my(%f) = map { ($_,1) } @files; @files = keys %f; }
+    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}) {
+	my($word,$key,@filist,@allfiles);
+	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+	else { @filist = split /\s+/, $attribs{FILES}; }
+	foreach $word (@filist) {
+	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+		push(@allfiles, @{$self->{$key}});
+	    }
+	    else { push(@allfiles, $word); }
+	}
+	$line = '';
+	# Occasionally files are repeated several times from different sources
+	{ my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
+	foreach $file (@allfiles) {
+	    $file = $self->fixpath($file);
+	    if (length($line) + length($file) > 80) {
+		push @m, "\t\$(RM_RF) $line\n";
+		$line = "$file";
+	    }
+	    else { $line .= " $file"; }
+	}
+	push @m, "\t\$(RM_RF) $line\n" if $line;
+    }
+    push(@m, "	$attribs{POSTOP}\n")                     if $attribs{POSTOP};
+    join('', @m);
+}
+
+=item dist_basics (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub dist_basics {
+    my($self) = @_;
+'
+distclean :: realclean distcheck
+	$(NOECHO) $(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 \'&skipcheck\'; 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)
+	$(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
+
+zipdist : $(DISTVNAME).zip
+	$(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+shdist : distdir
+	$(PREOP)
+	$(SHAR) [.$(DISTVNAME...]*.*; $(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)$(MMSQUALIFIERS)
+	$(MMS)$(MMSQUALIFIERS) 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
+	$(NOECHO) $(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+	$(NOECHO) $(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+	$(NOECHO) $(NOOP)
+
+install_ :: install_site
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+pure_install :: pure_$(INSTALLDIRS)_install
+	$(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	$(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
+
+pure__install : pure_site_install
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+doc__install : doc_site_install
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+# This hack brought to you by DCL's 255-character command line limit
+pure_perl_install ::
+	$(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
+
+# Likewise
+pure_site_install ::
+	$(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+# Ditto
+doc_perl_install ::
+	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
+],@docfiles,
+q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
+
+# And again
+doc_site_install ::
+	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
+],@docfiles,
+q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
+
+];
+
+    push @m, q[
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+	$(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+	$(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
+
+uninstall_from_sitedirs ::
+	$(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[
+	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
+];
+
+    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, 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
+$(OBJECT) : $(PERL_INC)iperlsys.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_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
+	$(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
+	olddef = F$Environment("Default")
+	Set Default $(PERL_SRC)
+	$(MMS)],$mmsquals,);
+	if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
+	    my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
+	    $target =~ s/\Q$prefix/[/;
+	    push(@m," $target");
+	}
+	else { push(@m,' $(MMS$TARGET)'); }
+	push(@m,q[
+	Set Default 'olddef'
+]);
+    }
+
+    push(@m, join(" ", map($self->fixpath($_,0),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)
+	$(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
+	$(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
+	- $(MV) $(MAKEFILE) $(MAKEFILE)_old
+	- $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
+	$(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
+	$(NOECHO) $(SAY) "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)
+	\$(NOECHO) \$(NOOP)
+
+testdb :: testdb_\$(LINKTYPE)
+	\$(NOECHO) \$(NOOP)
+
+";
+    foreach(@{$self->{DIR}}){
+      my($vmsdir) = $self->fixpath($_,1);
+      push(@m, '	If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
+           '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
+    }
+    push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
+        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, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
+    push(@m, "\n");
+
+    push(@m, "testdb_dynamic :: pure_all\n");
+    push(@m, $self->test_via_script('$(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\$(NOECHO) \$(NOOP)\n\n";
+	push @m, "testdb_static :: testdb_dynamic\n\t\$(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)
+	$(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
+	$(NOECHO) $(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)$(MMSQUALIFIERS)$(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,$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$Config{'exe_ext'}" 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,0),'
+MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
+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,0),'
+';
+
+
+    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
+	$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
+	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+	$(NOECHO) $(SAY) "To remove the intermediate files, say
+	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+';
+    push @m,'
+',"${tmp}perlmain.c",' : $(MAKEFILE)
+	$(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 :
+	$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
+	$(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
+	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+];
+
+    push @m, "
+inst_perl : pure_inst_perl doc_inst_perl
+	\$(NOECHO) \$(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
+	\$(NOECHO) \$(NOOP)
+
+map_clean :
+	\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
+	\$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
+";
+
+    join '', @m;
+}
+  
+# --- 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;
+
+=back
+
+=cut
+
+__END__
+
diff --git a/contrib/perl5/lib/ExtUtils/MM_Win32.pm b/contrib/perl5/lib/ExtUtils/MM_Win32.pm
new file mode 100644
index 000000000000..a1226b54638b
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/MM_Win32.pm
@@ -0,0 +1,823 @@
+package ExtUtils::MM_Win32;
+
+=head1 NAME
+
+ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_Win32; # 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.
+
+=over
+
+=cut 
+
+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_Win32';
+
+$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
+$GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
+$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
+$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
+$OBJ   = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+
+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
+",
+     q!	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\
+     -e "Mksymlists('NAME' => '!, $self->{NAME},
+     q!', 'DLBASE' => '!,$self->{DLBASE},
+     q!', 'DL_FUNCS' => !,neatvalue($funcs),
+     q!, 'IMPORTS' => !,neatvalue($imports),
+     q!, 'DL_VARS' => !, neatvalue($vars), q!);"
+!);
+    }
+    join('',@m);
+}
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,.,g;
+    $man;
+}
+
+sub maybe_command {
+    my($self,$file) = @_;
+    my @e = exists($ENV{'PATHEXT'})
+          ? split(/;/, $ENV{PATHEXT})
+	  : qw(.com .exe .bat .cmd);
+    my $e = '';
+    for (@e) { $e .= "\Q$_\E|" }
+    chop $e;
+    # see if file ends in one of the known extensions
+    if ($file =~ /($e)$/i) {
+	return $file if -e $file;
+    }
+    else {
+	for (@e) {
+	    return "$file$_" if -e "$file$_";
+	}
+    }
+    return;
+}
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+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, $val);
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->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);
+	    $val = `$abs -e "require $ver;" 2>&1`;
+	    if ($? == 0) {
+	        print "Using PERL=$abs\n" if $trace;
+	        return $abs;
+	    } elsif ($trace >= 2) {
+		print "Result: `$val'\n";
+	    }
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+sub catdir {
+    my $self = shift;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
+    }
+    my $result = $self->canonpath(join('', @args));
+    $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(@_);
+    $dir =~ s/(\\\.)$//;
+    $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
+    return $dir.$file;
+}
+
+sub init_others
+{
+ my ($self) = @_;
+ &ExtUtils::MM_Unix::init_others;
+ $self->{'TOUCH'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch';
+ $self->{'CHMOD'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; 
+ $self->{'CP'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp';
+ $self->{'RM_F'}   = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f';
+ $self->{'RM_RF'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf';
+ $self->{'MV'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv';
+ $self->{'NOOP'}   = 'rem';
+ $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f';
+ $self->{'LD'}     = $Config{'ld'} || 'link';
+ $self->{'AR'}     = $Config{'ar'} || 'lib';
+ $self->{'LDLOADLIBS'} ||= $Config{'libs'};
+ # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
+ if ($BORLAND) {
+     my $libs = $self->{'LDLOADLIBS'};
+     my $libpath = '';
+     while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
+         $libpath .= ' ' if length $libpath;
+         $libpath .= $1;
+     }
+     $self->{'LDLOADLIBS'} = $libs;
+     $self->{'LDDLFLAGS'} ||= $Config{'lddlflags'};
+     $self->{'LDDLFLAGS'} .= " $libpath";
+ }
+ $self->{'DEV_NULL'} = '> NUL';
+ # $self->{'NOECHO'} = ''; # till we have it working
+}
+
+
+=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, qq{
+.USESHELL :
+} if $DMAKE;
+
+    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    =
+';
+    }
+
+    $tmp = $self->export_list;
+    push @m, "
+EXPORT_LIST = $tmp
+";
+    $tmp = $self->perl_archive;
+    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);
+}
+
+
+sub path {
+    local $^W = 1;
+    my($self) = @_;
+    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
+    my @path = split(';',$path);
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
+}
+
+=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) }.($BORLAND ? '$@ $(OBJECT:^"+")'
+			  : ($GCC ? '-ru $@ $(OBJECT)'
+			          : '-out:$@ $(OBJECT)')).q{
+	}.$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 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)" \
+		-MExtUtils::Mkbootstrap \
+		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
+	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
+	$(CHMOD) 644 $@
+
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists
+	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
+	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
+	$(CHMOD) 644 $@
+';
+}
+
+=item dynamic_lib (o)
+
+Defines how to produce the *.so (or equivalent) files.
+
+=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} || ($BORLAND ? 'c0d32.obj': '');
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my($ldfrom) = '$(LDFROM)';
+    my(@m);
+    push(@m,'
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+OTHERLDFLAGS = '.$otherldflags.'
+INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+');
+    if ($GCC) {
+      push(@m,  
+       q{	dlltool --def $(EXPORT_LIST) --output-exp dll.exp
+	$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
+	dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
+	$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
+    } else {
+      push(@m, $BORLAND ?
+       q{	$(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} :
+       q{	$(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}
+	);
+    }
+    push @m, '
+	$(CHMOD) 755 $@
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+sub perl_archive
+{
+    my ($self) = @_;
+    if($OBJ) {
+        if ($self->{CAPI} eq 'TRUE') {
+            return '$(PERL_INC)\perlCAPI$(LIB_EXT)';
+        }
+    }
+    return '$(PERL_INC)\\'.$Config{'libperl'};
+}
+
+sub export_list
+{
+ my ($self) = @_;
+ return "$self->{BASEEXT}.def";
+}
+
+=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/^([a-z]:)/\u$1/;
+    $path =~ s|/|\\|g;
+    $path =~ s|(.)\\+|$1\\|g ;                     # xx////xx  -> xx/xx
+    $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
+    $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
+    $path =~ s|\\$|| 
+             unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
+    $path .= '.' if $path =~ m#\\$#;
+    $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.pl" if -r "$file.pl" && -f _;
+    return;
+}
+
+=item pm_to_blib
+
+Defines target that copies all files in the hash PM to their
+destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+    my($autodir) = $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[ }.
+	($NMAKE ? '<<pmfiles.dat'
+		: '$(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n)').
+	q{ ],'}.$autodir.q{')"
+	}. ($NMAKE ? q{
+$(PM_TO_BLIB)
+<<
+	} : '') . $self->{NOECHO}.q{$(TOUCH) $@
+};
+}
+
+=item test_via_harness (o)
+
+Helper method to write the test targets
+
+=cut
+
+sub test_via_harness {
+    my($self, $perl, $tests) = @_;
+    "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n";
+}
+
+
+=item tool_autosplit (override)
+
+Use Win32 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)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);"
+};
+}
+
+=item tools_other (o)
+
+Win32 overrides.
+
+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} || 'cmd /c';
+    push @m, qq{
+SHELL = $bin_sh
+} unless $DMAKE;  # dmake determines its own shell 
+
+    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
+	push @m, "$_ = $self->{$_}\n";
+    }
+
+    push @m, q{
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
+};
+
+
+    return join "", @m if $self->{PARENT};
+
+    push @m, q{
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\
+-e "print 'WARNING: I have found an old package in';" \\
+-e "print '	', $$ARGV[0], '.';" \\
+-e "print 'Please make sure the two installations are not conflicting';"
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e "install({ @ARGV },'$(VERBINST)',0,'$(UNINST)');"
+
+DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \
+-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', 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,1); print \"\nUninstall is deprecated. Please check the";" \
+-e "print \" packlist above carefully.\n  There may be errors. Remove the\";" \
+-e "print \" appropriate files manually.\n  Sorry for the inconveniences.\n\""
+};
+
+    return join "", @m;
+}
+
+=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 ''
+}
+
+=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
+';
+
+    push @m, '
+all :: pure_all manifypods
+	'.$self->{NOECHO}.'$(NOOP)
+' 
+	  unless $self->{SKIPHASH}{'all'};
+    
+    push @m, '
+pure_all :: config pm_to_blib subdirs linkext
+	'.$self->{NOECHO}.'$(NOOP)
+
+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 manifypods (o)
+
+We don't want manpage process.  XXX add pod2html support later.
+
+=cut
+
+sub manifypods {
+    my($self) = shift;
+    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
+}
+
+=item dist_ci (o)
+
+Same as MM_Unix version (changes command-line quoting).
+
+=cut
+
+sub dist_ci {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+ci :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\
+		-e "@all = keys %{ maniread() };" \\
+		-e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\
+		-e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");"
+};
+    join "", @m;
+}
+
+=item dist_core (o)
+
+Same as MM_Unix version (changes command-line quoting).
+
+=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 pasthru (o)
+
+Defines the string that is passed to recursive make calls in
+subdirectories.
+
+=cut
+
+sub pasthru {
+    my($self) = shift;
+    return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
+}
+
+
+
+1;
+__END__
+
+=back
+
+=cut 
+
+
diff --git a/contrib/perl5/lib/ExtUtils/MakeMaker.pm b/contrib/perl5/lib/ExtUtils/MakeMaker.pm
new file mode 100644
index 000000000000..5b7bb0b6da04
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/MakeMaker.pm
@@ -0,0 +1,1933 @@
+BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatible with perl5.001m
+
+package ExtUtils::MakeMaker;
+
+$Version = $VERSION = "5.4301";
+$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.222 $, 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;
+
+# &DynaLoader::mod2fname should be available to miniperl, thus 
+# should be a pseudo-builtin (cmp. os2.c).
+#eval {require DynaLoader;};
+
+#
+# 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 pull in the friends
+#
+$Is_VMS   = $^O eq 'VMS';
+$Is_OS2   = $^O eq 'os2';
+$Is_Mac   = $^O eq 'MacOS';
+$Is_Win32 = $^O eq 'MSWin32';
+
+# This is for module authors to query, so they can enable 'CAPI' => 'TRUE'
+# in their Makefile.pl
+$CAPI_support = 1;
+
+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;
+}
+if ($Is_Win32) {
+    require ExtUtils::MM_Win32;
+}
+
+# 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 || !(-f STDOUT || -c STDOUT)) ;	# Pipe?
+    Carp::confess("prompt function called without an argument") unless defined $mess;
+    my $dispdef = defined $def ? "[$def] " : " ";
+    $def = defined $def ? $def : "";
+    my $ans;
+    local $|=1;
+    print "$mess $dispdef";
+    if ($ISA_TTY) {
+	chomp($ans = <STDIN>);
+    } else {
+	print "$def\n";
+    }
+    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/
+
+    AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF CAPI
+    C CCFLAGS 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 LIB LIBS
+    LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
+    NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
+    PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX
+    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 PPM_INSTALL_SCRIPT PPM_INSTALL_EXEC
+
+    IMPORTS
+
+    installpm
+	/;
+
+    # IMPORTS is used under OS/2
+
+    # ^^^ 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 ppd
+
+	  ); # loses section ordering
+
+    @Overridable = @MM_Sections;
+    push @Overridable, qw[
+
+ dir_target libscan makeaperl needs_linking perm_rw perm_rwx
+ 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 osname osvers ranlib sitelibexp sitearchexp so exe_ext
+	  );
+
+    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";
+# Why is/was this 'delete' here?  We need PREREQ_PM later to make PPDs.
+#	} 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 ){
+	Carp::carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
+    }
+
+    my $newclass = ++$PACKNAME;
+    {
+#	no strict;
+	print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
+	mv_all_methods("MY",$newclass);
+	bless $self, $newclass;
+	push @Parent, $self;
+	@{"$newclass\:\: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};
+		# PERL and FULLPERL may be command verbs instead of full
+		# file specifications under VMS.  If so, don't turn them
+		# into a filespec.
+	    $self->{$key} = $self->catdir("..",$self->{$key})
+		unless $self->file_name_is_absolute($self->{$key})
+		|| ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/));
+	}
+	$self->{PARENT}->{CHILDREN}->{$newclass} = $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) = $self->canonpath($INC{'Config.pm'});
+	my($cthinks) = $self->catfile($Config{'archlibexp'},'Config.pm');
+	$pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS;
+	if ($pthinks ne $cthinks &&
+	    !($Is_Win32 and lc($pthinks) eq lc($cthinks))) {
+            print "Have $pthinks expected $cthinks\n";
+	    if ($Is_Win32) {
+		$pthinks =~ s![/\\]Config\.pm$!!i; $pthinks =~ s!.*[/\\]!!;
+	    }
+	    else {
+		$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 WriteEmptyMakefile {
+  if (-f 'Makefile.old') {
+    chmod 0666, 'Makefile.old';
+    unlink 'Makefile.old' or warn "unlink Makefile.old: $!";
+  }
+  rename 'Makefile', 'Makefile.old' or warn "rename Makefile Makefile.old: $!"
+    if -f 'Makefile';
+  open MF, '> Makefile' or die "open Makefile for write: $!";
+  print MF <<'EOP';
+all:
+
+clean:
+
+install:
+
+makemakerdflt:
+
+test:
+
+EOP
+  close MF or die "close Makefile for write: $!";
+}
+
+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;
+	}
+	$self->{uc($name)} = $value;
+    }
+
+    # 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.
+
+        Always begin with h2xs.
+        Always begin with h2xs!
+        ALWAYS BEGIN WITH H2XS!
+
+even if you're not building around a header file, and even if you
+don't have an XS component.
+
+Run h2xs(1) before you start thinking about writing a module. For so
+called pm-only modules that consist of C<*.pm> files only, h2xs has
+the C<-X> switch. This will generate dummy files of all kinds that are
+useful for the module developer.
+
+The medium answer is:
+
+    use ExtUtils::MakeMaker;
+    WriteMakefile( NAME => "Foo::Bar" );
+
+The long answer is the rest of the manpage :-)
+
+=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 F<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 testdb
+
+A useful variation of the above is the target C<testdb>. It runs the
+test under the Perl debugger (see L<perldebug>). If the file
+F<test.pl> exists in the current directory, it is used for the test.
+
+If you want to debug some other testfile, set C<TEST_FILE> variable
+thusly:
+
+  make testdb TEST_FILE=t/mytest.t
+
+By default the debugger is called using C<-d> option to perl. If you
+want to specify some other option, set C<TESTDB_SW> variable:
+
+  make testdb TESTDB_SW=-Dx
+
+=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 '-V:install.*'
+
+And to check the sequence in which the library directories are
+searched by perl, run
+
+    perl -le 'print join $/, @INC'
+
+
+=head2 PREFIX and LIB attribute
+
+PREFIX and LIB can be used to set several INSTALL* attributes in one
+go. The quickest way to install a module in a non-standard place might
+be
+
+    perl Makefile.PL LIB=~/lib
+
+This will install the module's architecture-independent files into
+~/lib, the architecture-dependent files into ~/lib/$archname/auto.
+
+Another way to specify many INSTALL directories with a single
+parameter is PREFIX.
+
+    perl Makefile.PL PREFIX=~
+
+This will replace the string specified by $Config{prefix} in all
+$Config{install*} values.
+
+Note, that in both cases the tilde expansion is done by MakeMaker, not
+by perl by default, nor by make. Conflicts between parmeters LIB,
+PREFIX and the various INSTALL* arguments are resolved so that 
+XXX
+
+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 CCFLAGS
+
+String that will be included in the compiler call command line between
+the arguments INC and OPTIMIZE.
+
+=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 =E<gt> ...}, 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 IMPORTS
+
+IMPORTS is only used on OS/2.
+
+=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 LIB
+
+LIB can only be set at C<perl Makefile.PL> time. It has the effect of
+setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
+
+=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 PERM_RW
+
+Desired Permission for read/writable files. Defaults to C<644>.
+See also L<MM_Unix/perm_rw>.
+
+=item PERM_RWX
+
+Desired permission for executable files. Defaults to C<755>.
+See also L<MM_Unix/perm_rwx>.
+
+=item PL_FILES
+
+Ref to hash of files to be processed as perl programs. MakeMaker
+will default to any found *.PL file (except Makefile.PL) being keys
+and the basename of the file being the value. E.g.
+
+  {'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 and the files found in
+the PMLIBDIRS directories.  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 I<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 = \'1.01';
+    ( $VERSION ) = '$Revision: 1.222 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    $FOO::VERSION = '1.10';
+    *FOO::VERSION = \'1.11';
+
+but these will fail:
+
+    my $VERSION = '1.01';
+    local $VERSION = '1.02';
+    local $FOO::VERSION = '1.30';
+
+The file named in VERSION_FROM is not added as a dependency to
+Makefile. This is not really correct, but it would be a major pain
+during development to have to rewrite the Makefile for any smallish
+change in that file. If you want to make sure that the Makefile
+contains the correct VERSION macro after any change of the file, you
+would have to do something like
+
+    depend => { Makefile => '$(VERSION_FROM)' }
+
+See attribute C<depend> below.
+
+=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 {
+	    package MY;	# so that "SUPER" works right
+	    my $inherited = shift->SUPER::c_o(@_);
+	    $inherited =~ s/old text/new text/;
+	    $inherited;
+	}
+
+If you are running experiments with embedding perl as a library into
+other applications, you might find MakeMaker is 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@perl.org> or F<comp.lang.perl.moderated> 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     ('gzip --best')
+    POSTOP       ('@ :')
+    PREOP        ('@ :')
+    TO_UNIX      (depends on the system)
+    RCS_LABEL    ('rcs -q -Nv$(VERSION_SYM):')
+    SHAR         ('shar')
+    SUFFIX       ('.gz')
+    TAR          ('tar')
+    TARFLAGS     ('cvf')
+    ZIP          ('zip')
+    ZIPFLAGS     ('-r')
+
+An example:
+
+    WriteMakefile( 'dist' => { COMPRESS=>"bzip2", SUFFIX=>".bz2" })
+
+=head2 Disabling an extension
+
+If some events detected in F<Makefile.PL> imply that there is no way
+to create the Module, but this is a normal state of things, then you
+can create a F<Makefile> which does nothing, but succeeds on all the
+"usual" build targets.  To do so, use
+
+   ExtUtils::MakeMaker::WriteEmptyMakefile();
+
+instead of WriteMakefile().
+
+This may be useful if other modules expect this module to be I<built>
+OK, as opposed to I<work> OK (say, this system-dependent module builds
+in a subdirectory of some other distribution, or is listed as a
+dependency in a CPAN::Bundle, but the functionality is supported by
+different means on the current architecture).
+
+=head1 SEE ALSO
+
+ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
+ExtUtils::Install, ExtUtils::Embed
+
+=head1 AUTHORS
+
+Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
+<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>.
+VMS support by Charles Bailey <F<bailey@genetics.upenn.edu>>.  OS/2
+support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>.  Contact the
+makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
+you have any questions.
+
+=cut
diff --git a/contrib/perl5/lib/ExtUtils/Manifest.pm b/contrib/perl5/lib/ExtUtils/Manifest.pm
new file mode 100644
index 000000000000..55570892f851
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Manifest.pm
@@ -0,0 +1,408 @@
+package ExtUtils::Manifest;
+
+require Exporter;
+use Config;
+use File::Find;
+use File::Copy 'copy';
+use Carp;
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT_OK
+	    $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
+
+$VERSION = substr(q$Revision: 1.33 $, 10);
+@ISA=('Exporter');
+@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
+	      'skipcheck', 'maniread', 'manicopy');
+
+$Is_VMS = $^O eq 'VMS';
+if ($Is_VMS) { require File::Basename }
+
+$Debug = 0;
+$Verbose = 1;
+$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 $found = manifind();
+    my $file;
+    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
+    my(@missfile,@missentry);
+    if ($arg & 1){
+	foreach $file (sort keys %$read){
+	    warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+            if ($dosnames){
+                $file = lc $file;
+                $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
+                $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
+            }
+	    unless ( exists $found->{$file} ) {
+		warn "No such file: $file\n" unless $Quiet;
+		push @missfile, $file;
+	    }
+	}
+    }
+    if ($arg & 2){
+	$read ||= {};
+	my $matches = _maniskip();
+	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;
+    my $read = {};
+    local *M;
+    unless (open M, $mfile){
+	warn "$mfile: $!";
+	return $read;
+    }
+    while (<M>){
+	chomp;
+	next if /^#/;
+	if ($Is_VMS) {
+	    my($file)= /^(\S+)/;
+	    next unless $file;
+	    my($base,$dir) = File::Basename::fileparse($file);
+	    # Resolve illegal file specifications in the same way as tar
+	    $dir =~ tr/./_/;
+	    my(@pieces) = split(/\./,$base);
+	    if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
+	    my $okfile = "$dir$base";
+	    warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+	    $read->{"\L$okfile"}=$_;
+	}
+	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";
+    local *M;
+    return $matches unless -f $mfile;
+    open M, $mfile or return $matches;
+    while (<M>){
+	chomp;
+	next if /^#/;
+	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';
+    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);
+	}
+	cp_if_diff($file, "$target/$file", $how);
+    }
+}
+
+sub cp_if_diff {
+    my($from, $to, $how)=@_;
+    -f $from or 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: $!";
+	}
+      STRICT_SWITCH: {
+	    best($from,$to), last STRICT_SWITCH if $how eq 'best';
+	    cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
+	    ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
+	    croak("ExtUtils::Manifest::cp_if_diff " .
+		  "called with illegal how argument [$how]. " .
+		  "Legal values are 'best', 'cp', and 'ln'.");
+	}
+    }
+}
+
+sub cp {
+    my ($srcFile, $dstFile) = @_;
+    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+    copy($srcFile,$dstFile);
+    utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
+    # chmod a+rX-w,go-w
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
+}
+
+sub ln {
+    my ($srcFile, $dstFile) = @_;
+    return &cp if $Is_VMS;
+    link($srcFile, $dstFile);
+    local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
+    my $mode= 0444 | (stat)[2] & 0700;
+    if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
+       unlink $dstFile;
+       return;
+    }
+    1;
+}
+
+sub best {
+    my ($srcFile, $dstFile) = @_;
+    if (-l $srcFile) {
+	cp($srcFile, $dstFile);
+    } else {
+	ln($srcFile, $dstFile) or cp($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.
+Blank lines and lines which start with C<#> in the C<MANIFEST> file
+are discarded.
+
+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. Blank lines and lines
+which start with C<#> are skipped.  Use C<\#> if you need a regular
+expression to start with a sharp character. A typical example:
+
+    \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).
+
+C<$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<koenig@franz.ww.TU-Berlin.DE>>
+
+=cut
diff --git a/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm
new file mode 100644
index 000000000000..35d5236072f4
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Mkbootstrap.pm
@@ -0,0 +1,103 @@
+package ExtUtils::Mkbootstrap;
+
+$VERSION = substr q$Revision: 1.13 $, 10;
+# $Date: 1996/09/03 17:04:43 $
+
+use Config;
+use Exporter;
+@ISA=('Exporter');
+@EXPORT='&Mkbootstrap';
+
+sub Mkbootstrap {
+    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
+	local($osname, $dlsrc) = (); # avoid warnings
+	($osname, $dlsrc) = @Config::Config{qw(osname dlsrc)};
+	$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;
+    }
+}
+
+1;
+
+__END__
+
+=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
diff --git a/contrib/perl5/lib/ExtUtils/Mksymlists.pm b/contrib/perl5/lib/ExtUtils/Mksymlists.pm
new file mode 100644
index 000000000000..0b92ca09b7ea
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Mksymlists.pm
@@ -0,0 +1,276 @@
+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 = substr q$Revision: 1.17 $, 10;
+
+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
+#    not as pseudo-builtin.
+#    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 eq 'os2') { _write_os2(\%spec) }
+    elsif ($osname eq 'MSWin32') { _write_win32(\%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) = @_;
+    require Config;
+    my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
+
+    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 "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\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_win32 {
+    my($data) = @_;
+
+    require Config;
+    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");
+    # put library name in quotes (it could be a keyword, like 'Alias')
+    if ($Config::Config{'cc'} !~ /^gcc/i) {
+      print DEF "LIBRARY \"$data->{DLBASE}\"\n";
+    }
+    print DEF "EXPORTS\n  ";
+    my @syms;
+    # Export public symbols both with and without underscores to
+    # ensure compatibility between DLLs from different compilers
+    # NOTE: DynaLoader itself only uses the names without underscores,
+    # so this is only to cover the case when the extension DLL may be
+    # linked to directly from C. GSAR 97-07-10
+    if ($Config::Config{'cc'} =~ /^bcc/i) {
+	for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
+	    push @syms, "_$_", "$_ = _$_";
+	}
+    }
+    else {
+	for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
+	    push @syms, "$_", "_$_ = $_";
+	}
+    }
+    print DEF join("\n  ",@syms, "\n") if @syms;
+    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
+    require ExtUtils::XSSymSet;
+
+    my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
+    my($set) = new ExtUtils::XSSymSet;
+    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}}) {
+        my $safe = $set->addsym($sym);
+        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
+        else        { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
+    }
+    foreach $sym (@{$data->{DL_VARS}}) {
+        my $safe = $set->addsym($sym);
+        print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
+        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
+        else        { print OPT "SYMBOL_VECTOR=($safe=DATA)\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 dynamic 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:
+
+=over
+
+=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.
+
+=back
+
+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/contrib/perl5/lib/ExtUtils/Packlist.pm b/contrib/perl5/lib/ExtUtils/Packlist.pm
new file mode 100644
index 000000000000..eeb0a5b0c1c4
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Packlist.pm
@@ -0,0 +1,288 @@
+package ExtUtils::Packlist;
+use strict;
+use Carp qw();
+use vars qw($VERSION);
+$VERSION = '0.03';
+
+# Used for generating filehandle globs.  IO::File might not be available!
+my $fhname = "FH1";
+
+sub mkfh()
+{
+no strict;
+my $fh = \*{$fhname++};
+use strict;
+return($fh);
+}
+
+sub new($$)
+{
+my ($class, $packfile) = @_;
+$class = ref($class) || $class;
+my %self;
+tie(%self, $class, $packfile);
+return(bless(\%self, $class));
+}
+
+sub TIEHASH
+{
+my ($class, $packfile) = @_;
+my $self = { packfile => $packfile };
+bless($self, $class);
+$self->read($packfile) if (defined($packfile) && -f $packfile);
+return($self);
+}
+
+sub STORE
+{
+$_[0]->{data}->{$_[1]} = $_[2];
+}
+
+sub FETCH
+{
+return($_[0]->{data}->{$_[1]});
+}
+
+sub FIRSTKEY
+{
+my $reset = scalar(keys(%{$_[0]->{data}}));
+return(each(%{$_[0]->{data}}));
+}
+
+sub NEXTKEY
+{
+return(each(%{$_[0]->{data}}));
+}
+
+sub EXISTS
+{
+return(exists($_[0]->{data}->{$_[1]}));
+}
+
+sub DELETE
+{
+return(delete($_[0]->{data}->{$_[1]}));
+}
+
+sub CLEAR
+{
+%{$_[0]->{data}} = ();
+}
+
+sub DESTROY
+{
+}
+
+sub read($;$)
+{
+my ($self, $packfile) = @_;
+$self = tied(%$self) || $self;
+
+if (defined($packfile)) { $self->{packfile} = $packfile; }
+else { $packfile = $self->{packfile}; }
+Carp::croak("No packlist filename specified") if (! defined($packfile));
+my $fh = mkfh();
+open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
+$self->{data} = {};
+my ($line);
+while (defined($line = <$fh>))
+   {
+   chomp $line;
+   my ($key, @kvs) = split(' ', $line);
+   $key =~ s!/\./!/!g;   # Some .packlists have spurious '/./' bits in the paths
+   if (! @kvs)
+      {
+      $self->{data}->{$key} = undef;
+      }
+   else
+      {
+      my ($data) = {};
+      foreach my $kv (@kvs)
+         {
+         my ($k, $v) = split('=', $kv);
+         $data->{$k} = $v;
+         }
+      $self->{data}->{$key} = $data;
+      }
+   }
+close($fh);
+}
+
+sub write($;$)
+{
+my ($self, $packfile) = @_;
+$self = tied(%$self) || $self;
+if (defined($packfile)) { $self->{packfile} = $packfile; }
+else { $packfile = $self->{packfile}; }
+Carp::croak("No packlist filename specified") if (! defined($packfile));
+my $fh = mkfh();
+open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
+foreach my $key (sort(keys(%{$self->{data}})))
+   {
+   print $fh ("$key");
+   if (ref($self->{data}->{$key}))
+      {
+      my $data = $self->{data}->{$key};
+      foreach my $k (sort(keys(%$data)))
+         {
+         print $fh (" $k=$data->{$k}");
+         }
+      }
+   print $fh ("\n");
+   }
+close($fh);
+}
+
+sub validate($;$)
+{
+my ($self, $remove) = @_;
+$self = tied(%$self) || $self;
+my @missing;
+foreach my $key (sort(keys(%{$self->{data}})))
+   {
+   if (! -e $key)
+      {
+      push(@missing, $key);
+      delete($self->{data}{$key}) if ($remove);
+      }
+   }
+return(@missing);
+}
+
+sub packlist_file($)
+{
+my ($self) = @_;
+$self = tied(%$self) || $self;
+return($self->{packfile});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Packlist - manage .packlist files
+
+=head1 SYNOPSIS
+
+   use ExtUtils::Packlist;
+   my ($pl) = ExtUtils::Packlist->new('.packlist');
+   $pl->read('/an/old/.packlist');
+   my @missing_files = $pl->validate();
+   $pl->write('/a/new/.packlist');
+
+   $pl->{'/some/file/name'}++;
+      or
+   $pl->{'/some/other/file/name'} = { type => 'file',
+                                      from => '/some/file' };
+
+=head1 DESCRIPTION
+
+ExtUtils::Packlist provides a standard way to manage .packlist files.
+Functions are provided to read and write .packlist files.  The original
+.packlist format is a simple list of absolute pathnames, one per line.  In
+addition, this package supports an extended format, where as well as a filename
+each line may contain a list of attributes in the form of a space separated
+list of key=value pairs.  This is used by the installperl script to
+differentiate between files and links, for example.
+
+=head1 USAGE
+
+The hash reference returned by the new() function can be used to examine and
+modify the contents of the .packlist.  Items may be added/deleted from the
+.packlist by modifying the hash.  If the value associated with a hash key is a
+scalar, the entry written to the .packlist by any subsequent write() will be a
+simple filename.  If the value is a hash, the entry written will be the
+filename followed by the key=value pairs from the hash.  Reading back the
+.packlist will recreate the original entries.
+
+=head1 FUNCTIONS
+
+=over
+
+=item new()
+
+This takes an optional parameter, the name of a .packlist.  If the file exists,
+it will be opened and the contents of the file will be read.  The new() method
+returns a reference to a hash.  This hash holds an entry for each line in the
+.packlist.  In the case of old-style .packlists, the value associated with each
+key is undef.  In the case of new-style .packlists, the value associated with
+each key is a hash containing the key=value pairs following the filename in the
+.packlist.
+
+=item read()
+
+This takes an optional parameter, the name of the .packlist to be read.  If
+no file is specified, the .packlist specified to new() will be read.  If the
+.packlist does not exist, Carp::croak will be called.
+
+=item write()
+
+This takes an optional parameter, the name of the .packlist to be written.  If
+no file is specified, the .packlist specified to new() will be overwritten.
+
+=item validate()
+
+This checks that every file listed in the .packlist actually exists.  If an
+argument which evaluates to true is given, any missing files will be removed
+from the internal hash.  The return value is a list of the missing files, which
+will be empty if they all exist.
+
+=item packlist_file()
+
+This returns the name of the associated .packlist file
+
+=back
+
+=head1 EXAMPLE
+
+Here's C<modrm>, a little utility to cleanly remove an installed module.
+
+    #!/usr/local/bin/perl -w
+
+    use strict;
+    use IO::Dir;
+    use ExtUtils::Packlist;
+    use ExtUtils::Installed;
+
+    sub emptydir($) {
+	my ($dir) = @_;
+	my $dh = IO::Dir->new($dir) || return(0);
+	my @count = $dh->read();
+	$dh->close();
+	return(@count == 2 ? 1 : 0);
+    }
+
+    # Find all the installed packages
+    print("Finding all installed modules...\n");
+    my $installed = ExtUtils::Installed->new();
+
+    foreach my $module (grep(!/^Perl$/, $installed->modules())) {
+       my $version = $installed->version($module) || "???";
+       print("Found module $module Version $version\n");
+       print("Do you want to delete $module? [n] ");
+       my $r = <STDIN>; chomp($r);
+       if ($r && $r =~ /^y/i) {
+	  # Remove all the files
+	  foreach my $file (sort($installed->files($module))) {
+	     print("rm $file\n");
+	     unlink($file);
+	  }
+	  my $pf = $installed->packlist($module)->packlist_file();
+	  print("rm $pf\n");
+	  unlink($pf);
+	  foreach my $dir (sort($installed->directory_tree($module))) {
+	     if (emptydir($dir)) {
+		print("rmdir $dir\n");
+		rmdir($dir);
+	     }
+	  }
+       }
+    }
+
+=head1 AUTHOR
+
+Alan Burlison <Alan.Burlison@uk.sun.com>
+
+=cut
diff --git a/contrib/perl5/lib/ExtUtils/inst b/contrib/perl5/lib/ExtUtils/inst
new file mode 100755
index 000000000000..cbf2d01194a0
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/inst
@@ -0,0 +1,139 @@
+#!/usr/local/bin/perl -w
+
+use strict;
+use IO::File;
+use ExtUtils::Packlist;
+use ExtUtils::Installed;
+
+use vars qw($Inst @Modules);
+
+################################################################################
+
+sub do_module($)
+{
+my ($module) = @_;
+my $help = <<EOF;
+Available commands are:
+   f [all|prog|doc]   - List installed files of a given type
+   d [all|prog|doc]   - List the directories used by a module
+   v                  - Validate the .packlist - check for missing files
+   t <tarfile>        - Create a tar archive of the module
+   q                  - Quit the module
+EOF
+print($help);
+while (1)
+   {
+   print("$module cmd? ");
+   my $reply = <STDIN>; chomp($reply);
+   CASE:
+      {
+      $reply =~ /^f\s*/ and do
+         {
+         my $class = (split(' ', $reply))[1];
+         $class = 'all' if (! $class);
+         my @files;
+         if (eval { @files = $Inst->files($module, $class); })
+            {
+            print("$class files in $module are:\n   ",
+                  join("\n   ", @files), "\n");
+            last CASE;
+            }
+         else
+            { print($@); }
+         };
+      $reply =~ /^d\s*/ and do
+         {
+         my $class = (split(' ', $reply))[1];
+         $class = 'all' if (! $class);
+         my @dirs;
+         if (eval { @dirs = $Inst->directories($module, $class); })
+            {
+            print("$class directories in $module are:\n   ",
+                  join("\n   ", @dirs), "\n");
+            last CASE;
+            }
+         else
+            { print($@); }
+         };
+      $reply =~ /^t\s*/ and do
+         {
+         my $file = (split(' ', $reply))[1];
+         my $tmp = "/tmp/inst.$$";
+         if (my $fh = IO::File->new($tmp, "w"))
+            {
+            $fh->print(join("\n", $Inst->files($module)));
+            $fh->close();
+            system("tar cvf $file -I $tmp");
+            unlink($tmp);
+            last CASE;
+            }
+         else { print("Can't open $file: $!\n"); }
+         last CASE;
+         };
+      $reply eq 'v' and do
+         {
+         if (my @missing = $Inst->validate($module))
+            {
+            print("Files missing from $module are:\n   ",
+                  join("\n   ", @missing), "\n");
+            }
+         else
+            {
+            print("$module has no missing files\n");
+            }
+         last CASE;
+         };
+      $reply eq 'q' and do
+         {
+         return;
+         };
+      # Default
+         print($help);
+      }
+   }
+}
+
+################################################################################
+
+sub toplevel()
+{
+my $help = <<EOF;
+Available commands are:
+   l            - List all installed modules
+   m <module>   - Select a module
+   q            - Quit the program
+EOF
+print($help);
+while (1)
+   {
+   print("cmd? ");
+   my $reply = <STDIN>; chomp($reply);
+   CASE:
+      {
+      $reply eq 'l' and do
+         {
+         print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
+         last CASE;
+         };
+      $reply =~ /^m\s+/ and do
+         {
+         do_module((split(' ', $reply))[1]);
+         last CASE;
+         };
+      $reply eq 'q' and do
+         {
+         exit(0);
+         };
+      # Default
+         print($help);
+      }
+   }
+}
+
+################################################################################
+
+$Inst = ExtUtils::Installed->new();
+@Modules = $Inst->modules();
+toplevel();
+
+################################################################################
diff --git a/contrib/perl5/lib/ExtUtils/testlib.pm b/contrib/perl5/lib/ExtUtils/testlib.pm
new file mode 100644
index 000000000000..d80f2a296b4d
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/testlib.pm
@@ -0,0 +1,26 @@
+package ExtUtils::testlib;
+$VERSION = substr q$Revision: 1.11 $, 10;
+# $Id: testlib.pm,v 1.11 1996/05/31 08:27:07 k Exp $
+
+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/contrib/perl5/lib/ExtUtils/typemap b/contrib/perl5/lib/ExtUtils/typemap
new file mode 100644
index 000000000000..28fd99c00b92
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/typemap
@@ -0,0 +1,289 @@
+# $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
+bool			T_BOOL
+
+#############################################################################
+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_BOOL
+	$var = (int)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,PL_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,PL_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_derived_from($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,PL_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_BOOL
+	$arg = boolSV($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 = &PL_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 = &PL_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 = &PL_sv_undef;
+	}
diff --git a/contrib/perl5/lib/ExtUtils/xsubpp b/contrib/perl5/lib/ExtUtils/xsubpp
new file mode 100755
index 000000000000..523dabcecac9
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/xsubpp
@@ -0,0 +1,1512 @@
+#!./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<-nolinenumbers>] [B<-typemap typemap>] [B<-object_capi>]... 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.
+
+=item B<-nolinenumbers>
+
+Prevents the inclusion of `#line' directives in the output.
+
+=item B<-object_capi>
+
+Compile code as C in a PERL_OBJECT environment.
+
+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)
+
+=cut
+
+require 5.002;
+use Cwd;
+use vars '$cplusplus';
+use vars '%v';
+
+use Config;
+
+sub Q ;
+
+# Global Constants
+
+$XSUBPP_version = "1.9507";
+
+my ($Is_VMS, $SymSet);
+if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    # Establish set of global symbols with max length 28, since xsubpp
+    # will later add the 'XS_' prefix.
+    require ExtUtils::XSSymSet;
+    $SymSet = new ExtUtils::XSSymSet 28;
+}
+
+$FH = 'File0000' ;
+
+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n";
+
+$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
+# mjn
+$OBJ   = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+
+$except = "";
+$WantPrototypes = -1 ;
+$WantVersionChk = 1 ;
+$ProtoUsed = 0 ;
+$WantLineNumbers = 1 ;
+SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
+    $flag = shift @ARGV;
+    $flag =~ s/^-// ;
+    $spat = quotemeta shift,	next SWITCH	if $flag eq 's';
+    $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
+    $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';
+    $WantCAPI = 1, next SWITCH    if $flag eq 'object_capi';
+    $except = " TRY",	next SWITCH	if $flag eq 'except';
+    push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
+    $WantLineNumbers = 0, next SWITCH	if $flag eq 'nolinenumbers';
+    $WantLineNumbers = 1, next SWITCH	if $flag eq 'linenumbers';
+    (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] =~ m#(.*[>\]])(.*)#
+	or ($dir, $filename) = ('.', $ARGV[0]);
+chdir($dir);
+$pwd = cwd();
+
+++ $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*#/;
+        my $line_no = $. + 1; 
+	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
+	SCOPE INTERFACE INTERFACE_MACRO C_ARGS
+	)) . "|$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;
+}
+
+
+if ($WantLineNumbers) {
+    {
+	package xsubpp::counter;
+	sub TIEHANDLE {
+	    my ($class, $cfile) = @_;
+	    my $buf = "";
+	    $SECTION_END_MARKER = "#line --- \"$cfile\"";
+	    $line_no = 1;
+	    bless \$buf;
+	}
+
+	sub PRINT {
+	    my $self = shift;
+	    for (@_) {
+		$$self .= $_;
+		while ($$self =~ s/^([^\n]*\n)//) {
+		    my $line = $1;
+		    ++ $line_no;
+		    $line =~ s|^\#line\s+---(?=\s)|#line $line_no|;
+		    print STDOUT $line;
+		}
+	    }
+	}
+
+	sub PRINTF {
+	    my $self = shift;
+	    my $fmt = shift;
+	    $self->PRINT(sprintf($fmt, @_));
+	}
+
+	sub DESTROY {
+	    # Not necessary if we're careful to end with a "\n"
+	    my $self = shift;
+	    print STDOUT $$self;
+	}
+    }
+
+    my $cfile = $filename;
+    $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+    tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile);
+    select PSEUDO_STDOUT;
+}
+
+sub print_section {
+    # the "do" is required for right semantics
+    do { $_ = shift(@line) } while !/\S/ && @line;
+    
+    print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n")
+	if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	print "$_\n";
+    }
+    print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
+}
+
+sub merge_section {
+    my $in = '';
+  
+    while (!/\S/ && @line) {
+        $_ = shift(@line);
+    }
+    
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	$in .= "$_\n";
+    }
+    chomp $in;
+    return $in;
+}
+
+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 /[=;+].*\S/ ;
+
+	# 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/;
+	if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
+	    $DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
+	    next;
+	}
+	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} ;
+	$var_num = $args_match{$outarg};
+	if ($outcode) {
+	    print "\t$outcode\n";
+	    print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic;
+	} else {
+	    &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
+	}
+    }
+}
+
+sub C_ARGS_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    $func_args = $in;
+} 
+
+sub INTERFACE_MACRO_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    if ($in =~ /\s/) {		# two
+        ($interface_macro, $interface_macro_set) = split ' ', $in;
+    } else {
+        $interface_macro = $in;
+	$interface_macro_set = 'UNKNOWN_CVT'; # catch later
+    }
+    $interface = 1;		# local
+    $Interfaces = 1;		# global
+}
+
+sub INTERFACE_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    
+    foreach (split /[\s,]+/, $in) {
+        $Interfaces{$_} = $_;
+    }
+    print Q<<"EOF";
+#	XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
+EOF
+    $interface = 1;		# local
+    $Interfaces = 1;		# global
+}
+
+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 SCOPE_handler ()
+{
+    death("Error: Only 1 SCOPE declaration allowed per xsub") 
+        if $scope_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+		next unless /\S/;
+		TrimWhitespace($_) ;
+        if ($_ =~ /^DISABLE/i) {
+		   $ScopeThisXSUB = 0 
+        }
+        elsif ($_ =~ /^ENABLE/i) {
+		   $ScopeThisXSUB = 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. Do not edit this file, edit $filename instead.
+ *
+ *	ANY CHANGES MADE HERE WILL BE LOST! 
+ *
+ */
+
+EOM
+ 
+
+print("#line 1 \"$filename\"\n")
+    if $WantLineNumbers;
+
+while (<$FH>) {
+    last if ($Module, $Package, $Prefix) =
+	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+
+    if ($OBJ) {
+        s/#if(?:def|\s+defined)\s+(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/;
+    }
+    print $_;
+}
+&Exit unless defined $_;
+
+print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
+
+$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
+	$Prefix = quotemeta $Prefix ;
+	($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"
+	   ." (maybe last function was ended by a blank line "
+	   ." followed by a a statement on column one?)")
+	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) ;
+    undef($scope_in_this_xsub) ;
+    undef($interface);
+    $interface_macro = 'XSINTERFACE_FUNC' ;
+    $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
+    $ProtoThisXSUB = $WantPrototypes ;
+    $ScopeThisXSUB = 0;
+
+    $_ = 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 $line_no[@line_no - @line] \"$filename\"")
+	  if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
+        push (@BootCode, @line, "") ;
+        next PARAGRAPH ;
+    }
+
+
+    # extract return type, function name and arguments
+    ($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*(const)?\s*$/s;
+
+    ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
+    $class = "$4 $class" if $4;
+    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+    ($clean_func_name = $func_name) =~ s/^$Prefix//;
+    $Full_func_name = "${Packid}_$clean_func_name";
+    if ($Is_VMS) { $Full_func_name = $SymSet->addsym($Full_func_name); }
+
+    # Check for duplicate function definition
+    for $tmp (@XSStack) {
+	next unless defined $tmp->{functions}{$Full_func_name};
+	Warn("Warning: duplicate function definition '$clean_func_name' detected");
+	last;
+    }
+    $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+    %XsubAliases = %XsubAliasValues = %Interfaces = ();
+    $DoSetMagic = 1;
+
+    @args = split(/\s*,\s*/, $orig_args);
+    if (defined($class)) {
+	my $arg0 = ((defined($static) or $func_name eq '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);
+    $CODE = grep(/^\s*CODE\s*:/, @line);
+    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
+    #   to set explicit return values.
+    $EXPLICIT_RETURN = ($CODE &&
+		("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
+    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
+    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);
+
+    # print function header
+    print Q<<"EOF";
+#XS(XS_${Full_func_name})
+#[[
+#    dXSARGS;
+EOF
+    print Q<<"EOF" if $ALIAS ;
+#    dXSI32;
+EOF
+    print Q<<"EOF" if $INTERFACE ;
+#    dXSFUNCTION($ret_type);
+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|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ;
+
+	print Q<<"EOF" if $ScopeThisXSUB;
+#   ENTER;
+#   [[
+EOF
+	
+	if (!$thisdone && defined($class)) {
+	    if (defined($static) or $func_name eq '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|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
+
+		if (check_keyword("PPCODE")) {
+			print_section();
+			death ("PPCODE must be last thing") if @line;
+			print "\tLEAVE;\n" if $ScopeThisXSUB;
+			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 eq 'new') {
+				$func_name = "$class";
+			    } else {
+				print "${class}::";
+			    }
+			} elsif (defined($class)) {
+			    if ($func_name eq 'new') {
+				$func_name .= " $class";
+			    } else {
+				print "THIS->";
+			    }
+			}
+			$func_name =~ s/^($spat)//
+			    if defined($spat);
+			$func_name = 'XSFUNCTION' if $interface;
+			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) {
+	    # RETVAL almost never needs SvSETMAGIC()
+	    &generate_output($ret_type, 0, 'RETVAL', 0);
+	}
+
+	# do cleanup
+	process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
+
+	print Q<<"EOF" if $ScopeThisXSUB;
+#   ]]
+EOF
+	print Q<<"EOF" if $ScopeThisXSUB and not $PPCODE;
+#   LEAVE;
+EOF
+
+	# 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
+
+    if ($ret_type ne "void" or $EXPLICIT_RETURN) {
+        print Q<<EOF unless $PPCODE;
+#    XSRETURN(1);
+EOF
+    } else {
+        print Q<<EOF unless $PPCODE;
+#    XSRETURN_EMPTY;
+EOF
+    }
+
+    print Q<<EOF;
+#]]
+#
+EOF
+
+    my $newXS = "newXS" ;
+    my $proto = "" ;
+
+    # Build the prototype string for the xsub
+    if ($ProtoThisXSUB) {
+	$newXS = "newXSproto";
+
+	if ($ProtoThisXSUB eq 2) {
+	    # User has specified empty prototype
+	    $proto = ', ""' ;
+	}
+        elsif ($ProtoThisXSUB ne 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
+        }
+    } 
+    elsif ($interface) {
+	while ( ($name, $value) = each %Interfaces) {
+	    $name = "$Package\::$name" unless $name =~ /::/;
+	    push(@InitFileCode, Q<<"EOF");
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        $interface_macro_set(cv,$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
+if ($WantCAPI) {
+print Q<<"EOF";
+#
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XS(boot__CAPI_entry)
+#[[
+#    dXSARGS;
+#    char* file = __FILE__;
+#
+EOF
+} else {
+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 or defined $Interfaces ;
+#    {
+#        CV * cv ;
+#
+EOF
+
+print @InitFileCode;
+
+print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
+#    }
+EOF
+
+if (@BootCode)
+{
+    print "\n    /* Initialisation Section */\n\n" ;
+    @line = @BootCode;
+    print_section();
+    print "\n    /* End of Initialisation Section */\n\n" ;
+}
+
+print Q<<"EOF";;
+#    XSRETURN_YES;
+#]]
+#
+EOF
+
+if ($WantCAPI) { 
+print Q<<"EOF";
+#
+##define XSCAPI(name) void name(CV* cv, void* pPerl)
+#
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XSCAPI(boot_$Module_cname)
+#[[
+#    SetCPerlObj(pPerl);
+#    boot__CAPI_entry(cv);
+#]]
+#
+EOF
+}
+
+warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
+    unless $ProtoUsed ;
+&Exit;
+
+sub output_init {
+    local($type, $num, $var, $init) = @_;
+    local($arg) = "ST(" . ($num - 1) . ")";
+
+    if(  $init =~ /^=/  ) {
+	eval qq/print "\\t$var $init\\n"/;
+	warn $@   if  $@;
+    } else {
+	if(  $init =~ s/^\+//  &&  $num  ) {
+	    &generate_init($type, $num, $var);
+	} else {
+	    eval qq/print "\\t$var;\\n"/;
+	    warn $@   if  $@;
+	    $init =~ s/^;//;
+	}
+	$deferred .= eval qq/"\\n\\t$init\\n"/;
+	warn $@   if  $@;
+    }
+}
+
+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 ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
+    	$ScopeThisXSUB = 1;
+    }
+    if (defined($defaults{$var})) {
+	    $expr =~ s/(\t+)/$1    /g;
+	    $expr =~ s/        /\t/g;
+	    eval qq/print "\\t$var;\\n"/;
+	    warn $@   if  $@;
+	    $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+	    warn $@   if  $@;
+    } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) {
+	    eval qq/print "\\t$var;\\n"/;
+	    warn $@   if  $@;
+	    $deferred .= eval qq/"\\n$expr;\\n"/;
+	    warn $@   if  $@;
+    } else {
+	    eval qq/print "$expr;\\n"/;
+	    warn $@   if  $@;
+    }
+}
+
+sub generate_output {
+    local($type, $num, $var, $do_setmagic) = @_;
+    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";
+	    print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+    } 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";
+		warn $@   if  $@;
+		print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
+	    }
+	    elsif ($var eq 'RETVAL') {
+		if ($expr =~ /^\t\$arg = new/) {
+		    # We expect that $arg has refcnt 1, so we need to
+		    # mortalize it.
+		    eval "print qq\a$expr\a";
+		    warn $@   if  $@;
+		    print "\tsv_2mortal(ST(0));\n";
+		    print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
+		}
+		elsif ($expr =~ /^\s*\$arg\s*=/) {
+		    # We expect that $arg has refcnt >=1, so we need
+		    # to mortalize it!
+		    eval "print qq\a$expr\a";
+		    warn $@   if  $@;
+		    print "\tsv_2mortal(ST(0));\n";
+		    print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
+		}
+		else {
+		    # Just hope that the entry would safely write it
+		    # over an already mortalized value. By
+		    # coincidence, something like $arg = &sv_undef
+		    # works too.
+		    print "\tST(0) = sv_newmortal();\n";
+		    eval "print qq\a$expr\a";
+		    warn $@   if  $@;
+		    # new mortals don't have set magic
+		}
+	    }
+	    elsif ($arg =~ /^ST\(\d+\)$/) {
+		eval "print qq\a$expr\a";
+		warn $@   if  $@;
+		print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+	    }
+    }
+}
+
+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) ;
+    exit ($errors ? 1 : 0);
+}
diff --git a/contrib/perl5/lib/Fatal.pm b/contrib/perl5/lib/Fatal.pm
new file mode 100644
index 000000000000..a1e5cffcf406
--- /dev/null
+++ b/contrib/perl5/lib/Fatal.pm
@@ -0,0 +1,157 @@
+package Fatal;
+
+use Carp;
+use strict;
+use vars qw( $AUTOLOAD $Debug $VERSION);
+
+$VERSION = 1.02;
+
+$Debug = 0 unless defined $Debug;
+
+sub import {
+    my $self = shift(@_);
+    my($sym, $pkg);
+    $pkg = (caller)[0];
+    foreach $sym (@_) {
+	&_make_fatal($sym, $pkg);
+    }
+};
+
+sub AUTOLOAD {
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/.*:://;
+    &_make_fatal($cmd, (caller)[0]);
+    goto &$AUTOLOAD;
+}
+
+sub fill_protos {
+  my $proto = shift;
+  my ($n, $isref, @out, @out1, $seen_semi) = -1;
+  while ($proto =~ /\S/) {
+    $n++;
+    push(@out1,[$n,@out]) if $seen_semi;
+    push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//;
+    push(@out, "\$_[$n]"), next if $proto =~ s/^\s*([*\$&])//;
+    push(@out, "\@_[$n..\$#_]"), last if $proto =~ s/^\s*(;\s*)?\@//;
+    $seen_semi = 1, $n--, next if $proto =~ s/^\s*;//; # XXXX ????
+    die "Unknown prototype letters: \"$proto\"";
+  }
+  push(@out1,[$n+1,@out]);
+  @out1;
+}
+
+sub write_invocation {
+  my ($core, $call, $name, @argvs) = @_;
+  if (@argvs == 1) {		# No optional arguments
+    my @argv = @{$argvs[0]};
+    shift @argv;
+    return "\t" . one_invocation($core, $call, $name, @argv) . ";\n";
+  } else {
+    my $else = "\t";
+    my (@out, @argv, $n);
+    while (@argvs) {
+      @argv = @{shift @argvs};
+      $n = shift @argv;
+      push @out, "$ {else}if (\@_ == $n) {\n";
+      $else = "\t} els";
+      push @out, 
+          "\t\treturn " . one_invocation($core, $call, $name, @argv) . ";\n";
+    }
+    push @out, <<EOC;
+	}
+	die "$name(\@_): Do not expect to get ", scalar \@_, " arguments";
+EOC
+    return join '', @out;
+  }
+}
+
+sub one_invocation {
+  my ($core, $call, $name, @argv) = @_;
+  local $" = ', ';
+  return qq{$call(@argv) || croak "Can't $name(\@_)} . 
+    ($core ? ': $!' : ', \$! is \"$!\"') . '"';
+}
+
+sub _make_fatal {
+    my($sub, $pkg) = @_;
+    my($name, $code, $sref, $real_proto, $proto, $core, $call);
+    my $ini = $sub;
+
+    $sub = "${pkg}::$sub" unless $sub =~ /::/;
+    $name = $sub;
+    $name =~ s/.*::// or $name =~ s/^&//;
+    print "# _make_fatal: sub=$sub pkg=$pkg name=$name\n" if $Debug;
+    croak "Bad subroutine name for Fatal: $name" unless $name =~ /^\w+$/;
+    if (defined(&$sub)) {	# user subroutine
+	$sref = \&$sub;
+	$proto = prototype $sref;
+	$call = '&$sref';
+    } elsif ($sub eq $ini) {	# Stray user subroutine
+	die "$sub is not a Perl subroutine" 
+    } else {			# CORE subroutine
+        $proto = eval { prototype "CORE::$name" };
+	die "$name is neither a builtin, nor a Perl subroutine" 
+	  if $@;
+	die "Cannot make a non-overridable builtin fatal"
+	  if not defined $proto;
+	$core = 1;
+	$call = "CORE::$name";
+    }
+    if (defined $proto) {
+      $real_proto = " ($proto)";
+    } else {
+      $real_proto = '';
+      $proto = '@';
+    }
+    $code = <<EOS;
+sub$real_proto {
+	local(\$", \$!) = (', ', 0);
+EOS
+    my @protos = fill_protos($proto);
+    $code .= write_invocation($core, $call, $name, @protos);
+    $code .= "}\n";
+    print $code if $Debug;
+    $code = eval($code);
+    die if $@;
+    local($^W) = 0;   # to avoid: Subroutine foo redefined ...
+    no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ...
+    *{$sub} = $code;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Fatal - replace functions with equivalents which succeed or die
+
+=head1 SYNOPSIS
+
+    use Fatal qw(open close);
+
+    sub juggle { . . . }
+    import Fatal 'juggle';
+
+=head1 DESCRIPTION
+
+C<Fatal> provides a way to conveniently replace functions which normally
+return a false value when they fail with equivalents which halt execution
+if they are not successful.  This lets you use these functions without
+having to test their return values explicitly on each call.   Errors are
+reported via C<die>, so you can trap them using C<$SIG{__DIE__}> if you
+wish to take some action before the program exits.
+
+The do-or-die equivalents are set up simply by calling Fatal's
+C<import> routine, passing it the names of the functions to be
+replaced.  You may wrap both user-defined functions and overridable
+CORE operators (except C<exec>, C<system> which cannot be expressed
+via prototypes) in this way.
+
+=head1 AUTHOR
+
+Lionel.Cons@cern.ch
+
+prototype updates by Ilya Zakharevich ilya@math.ohio-state.edu
+
+=cut
diff --git a/contrib/perl5/lib/File/Basename.pm b/contrib/perl5/lib/File/Basename.pm
new file mode 100644
index 000000000000..69bb1fa5fdcf
--- /dev/null
+++ b/contrib/perl5/lib/File/Basename.pm
@@ -0,0 +1,263 @@
+package File::Basename;
+
+=head1 NAME
+
+fileparse - split a pathname into pieces
+
+basename - extract just the filename from a path
+
+dirname - extract just the directory from a path
+
+=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", "MacOS", "AmigaOS" or "MSWin32", the file specification 
+syntax of that operating system is used in future calls to 
+fileparse(), basename(), and dirname().  If it contains none of
+these substrings, UNIX syntax is used.  This pattern matching is
+case-insensitive.  If you've selected VMS syntax, and the file
+specification you pass to one of these routines contains a "/",
+they assume you are using UNIX emulation and apply the UNIX syntax
+rules instead, for that function call only.
+
+If the argument passed to it contains one of the substrings "VMS",
+"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
+matching for suffix removal is performed without regard for case,
+since those systems are not case-sensitive when opening existing files
+(though some of them preserve case on file creation).
+
+If you haven't called fileparse_set_fstype(), the syntax is chosen
+by examining the builtin variable C<$^O> according to these rules.
+
+=item fileparse
+
+The fileparse() routine divides a file specification into three
+parts: a leading B<path>, a file B<name>, and a B<suffix>.  The
+B<path> contains everything up to and including the last directory
+separator in the input file specification.  The remainder of the input
+file specification is then divided into B<name> and B<suffix> based on
+the optional patterns you specify in C<@suffixlist>.  Each element of
+this list is interpreted as a regular expression, and is matched
+against the end of B<name>.  If this succeeds, the matching portion of
+B<name> is removed and prepended to B<suffix>.  By proper use of
+C<@suffixlist>, you can remove file types or versions for examination.
+
+You are guaranteed that if you concatenate B<path>, B<name>, and
+B<suffix> together in that order, the result will denote the same
+file as the input file specification.
+
+=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/',
+    $type 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'
+
+=over
+
+=item C<basename>
+
+The basename() routine returns the first element of the list produced
+by calling fileparse() with the same arguments, except that it always
+quotes metacharacters in the given suffixes.  It is provided for
+programmer compatibility with the UNIX shell command basename(1).
+
+=item C<dirname>
+
+The dirname() routine returns the directory portion of the input file
+specification.  When using VMS or MacOS syntax, this is identical to the
+second element of the list produced by calling fileparse() with the same
+input file specification.  (Under VMS, if there is no directory information
+in the input file specification, then the current default device and
+directory are returned.)  When using UNIX or MSDOS syntax, the return
+value conforms to the behavior of the UNIX shell command dirname(1).  This
+is usually the same as the behavior of fileparse(), but differs in some
+cases.  For example, for the input file specification F<lib/>, fileparse()
+considers the directory name to be F<lib/>, while dirname() considers the
+directory name to be F<.>).
+
+=back
+
+=cut
+
+
+## use strict;
+use re 'taint';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
+$VERSION = "2.6";
+
+
+#   fileparse_set_fstype() - specify OS-based rules used in future
+#                            calls to routines in this package
+#
+#   Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
+#       Any other name uses Unix-style rules and is case-sensitive
+
+sub fileparse_set_fstype {
+  my @old = ($Fileparse_fstype, $Fileparse_igncase);
+  if (@_) {
+    $Fileparse_fstype = $_[0];
+    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
+  }
+  wantarray ? @old : $old[0];
+}
+
+#   fileparse() - parse file specification
+#
+#   Version 2.4  27-Sep-1996  Charles Bailey  bailey@genetics.upenn.edu
+
+
+sub fileparse {
+  my($fullname,@suffices) = @_;
+  my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
+  my($dirpath,$tail,$suffix,$basename);
+  my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
+
+  if ($fstype =~ /^VMS/i) {
+    if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
+    else {
+      ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
+      $dirpath ||= '';  # should always be defined
+    }
+  }
+  if ($fstype =~ /^MS(DOS|Win32)/i) {
+    ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/);
+    $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
+  }
+  elsif ($fstype =~ /^MacOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
+  }
+  elsif ($fstype =~ /^AmigaOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
+    $dirpath = './' unless $dirpath;
+  }
+  elsif ($fstype !~ /^VMS/i) {  # default to Unix
+    ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
+    if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {
+      # dev:[000000] is top of VMS tree, similar to Unix '/'
+      ($basename,$dirpath) = ('',$fullname);
+    }
+    $dirpath = './' unless $dirpath;
+  }
+
+  if (@suffices) {
+    $tail = '';
+    foreach $suffix (@suffices) {
+      my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
+      if ($basename =~ s/$pat//) {
+        $taint .= substr($suffix,0,0);
+        $tail = $1 . $tail;
+      }
+    }
+  }
+
+  $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+  wantarray ? ($basename . $taint, $dirpath . $taint, $tail)
+            : $basename . $taint;
+}
+
+
+#   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 || $ENV{DEFAULT} }
+    }
+    if ($fstype =~ /MacOS/i) { return $dirname }
+    elsif ($fstype =~ /MSDOS/i) { 
+        $dirname =~ s/([^:])[\\\/]*$/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*$/$1/;
+	}
+    }
+    elsif ($fstype =~ /MSWin32/i) { 
+        $dirname =~ s/([^:])[\\\/]*$/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*$/$1/;
+	}
+    }
+    elsif ($fstype =~ /AmigaOS/i) {
+        if ( $dirname =~ /:$/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s#[^:/]+$## unless length($basename);
+    }
+    else { 
+        $dirname =~ s:(.)/*$:$1:;
+        unless( length($basename) ) {
+	    local($File::Basename::Fileparse_fstype) = $fstype;
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s:(.)/*$:$1:;
+	}
+    }
+
+    $dirname;
+}
+
+fileparse_set_fstype $^O;
+
+1;
diff --git a/contrib/perl5/lib/File/CheckTree.pm b/contrib/perl5/lib/File/CheckTree.pm
new file mode 100644
index 000000000000..dca7f6aff31a
--- /dev/null
+++ b/contrib/perl5/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 / /;
+	}
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	$mess = "Can't do $this.\n";
+    }
+    die "$mess\n" if $disposition eq 'die';
+    warn "$mess\n";
+    ++$warnings;
+}
+
+1;
+
diff --git a/contrib/perl5/lib/File/Compare.pm b/contrib/perl5/lib/File/Compare.pm
new file mode 100644
index 000000000000..2f9c45c4c60d
--- /dev/null
+++ b/contrib/perl5/lib/File/Compare.pm
@@ -0,0 +1,143 @@
+package File::Compare;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
+
+require Exporter;
+use Carp;
+
+$VERSION = '1.1001';
+@ISA = qw(Exporter);
+@EXPORT = qw(compare);
+@EXPORT_OK = qw(cmp);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Compare
+    return $File::Compare::VERSION;
+}
+
+sub compare {
+    croak("Usage: compare( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+    my $closefrom=0;
+    my $closeto=0;
+    my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
+    local(*FROM, *TO);
+    local($\) = '';
+
+    croak("from undefined") unless (defined $from);
+    croak("to undefined") unless (defined $to);
+
+    if (ref($from) && 
+        (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) {
+	*FROM = *$from;
+    } elsif (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } else {
+	open(FROM,"<$from") or goto fail_open1;
+	binmode FROM;
+	$closefrom = 1;
+	$fromsize = -s FROM;
+    }
+
+    if (ref($to) &&
+        (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) {
+	*TO = *$to;
+    } elsif (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } else {
+	open(TO,"<$to") or goto fail_open2;
+	binmode TO;
+	$closeto = 1;
+    }
+
+    if ($closefrom && $closeto) {
+	# If both are opened files we know they differ if their size differ
+	goto fail_inner if $fromsize != -s TO;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for compare: $size\n") unless ($size > 0);
+    } else {
+	$size = $fromsize;
+	$size = 1024 if ($size < 512);
+	$size = $Too_Big if ($size > $Too_Big);
+    }
+
+    $fbuf = '';
+    $tbuf = '';
+    while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
+	unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
+            goto fail_inner;
+	}
+    }
+    goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
+
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 0;
+    
+  # All of these contortions try to preserve error messages...
+  fail_inner:
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 1;
+
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return -1;
+}
+
+*cmp = \&compare;
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Compare - Compare files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Compare;
+
+	if (compare("file1","file2") == 0) {
+	    print "They're equal\n";
+	}
+
+=head1 DESCRIPTION
+
+The File::Compare::compare function compares the contents of two
+sources, each of which can be a file or a file handle.  It is exported
+from File::Compare by default.
+
+File::Compare::cmp is a synonym for File::Compare::compare.  It is
+exported from File::Compare only by request.
+
+=head1 RETURN
+
+File::Compare::compare return 0 if the files are equal, 1 if the
+files are unequal, or -1 if an error was encountered.
+
+=head1 AUTHOR
+
+File::Compare was written by Nick Ing-Simmons.
+Its original documentation was written by Chip Salzenberg.
+
+=cut
+
diff --git a/contrib/perl5/lib/File/Copy.pm b/contrib/perl5/lib/File/Copy.pm
new file mode 100644
index 000000000000..d0b3c8977ef0
--- /dev/null
+++ b/contrib/perl5/lib/File/Copy.pm
@@ -0,0 +1,342 @@
+# 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.
+#
+# Additions copyright 1996 by Charles Bailey.  Permission is granted
+# to distribute the revised code under the same terms as Perl itself.
+
+package File::Copy;
+
+use strict;
+use Carp;
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big
+	    &copy &syscopy &cp &mv);
+
+# Note that this module implements only *part* of the API defined by
+# the File/Copy.pm module of the File-Tools-2.0 package.  However, that
+# package has not yet been updated to work with Perl 5.004, and so it
+# would be a Bad Thing for the CPAN module to grab it and replace this
+# module.  Therefore, we set this module's version higher than 2.0.
+$VERSION = '2.02';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(copy move);
+@EXPORT_OK = qw(cp mv);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub _catname { #  Will be replaced by File::Spec when it arrives
+    my($from, $to) = @_;
+    if (not defined &basename) {
+	require File::Basename;
+	import  File::Basename 'basename';
+    }
+    if ($^O eq 'VMS')  { $to = VMS::Filespec::vmspath($to) . basename($from); }
+    elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); }
+    elsif ($to =~ m|\\|)   { $to .= '\\' . basename($from); }
+    else                   { $to .= '/' . basename($from); }
+}
+
+sub copy {
+    croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+
+    my $from_a_handle = (ref($from)
+			 ? (ref($from) eq 'GLOB'
+			    || UNIVERSAL::isa($from, 'GLOB')
+                            || UNIVERSAL::isa($from, 'IO::Handle'))
+			 : (ref(\$from) eq 'GLOB'));
+    my $to_a_handle =   (ref($to)
+			 ? (ref($to) eq 'GLOB'
+			    || UNIVERSAL::isa($to, 'GLOB')
+                            || UNIVERSAL::isa($to, 'IO::Handle'))
+			 : (ref(\$to) eq 'GLOB'));
+
+    if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    if (defined &syscopy && \&syscopy != \&copy
+	&& !$to_a_handle
+	&& !($from_a_handle && $^O eq 'os2' )	# OS/2 cannot handle handles
+	&& !($from_a_handle && $^O eq 'mpeix')	# and neither can MPE/iX.
+       )	
+    {
+	return syscopy($from, $to);
+    }
+
+    my $closefrom = 0;
+    my $closeto = 0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+    local($\) = '';
+
+    if ($from_a_handle) {
+	*FROM = *$from{FILEHANDLE};
+    } else {
+	$from = "./$from" if $from =~ /^\s/;
+	open(FROM, "< $from\0") or goto fail_open1;
+	binmode FROM or die "($!,$^E)";
+	$closefrom = 1;
+    } 
+ 
+    if ($to_a_handle) {
+	*TO = *$to{FILEHANDLE};
+    } else {        
+	$to = "./$to" if $to =~ /^\s/;
+	open(TO,"> $to\0") or goto fail_open2;
+	binmode TO or die "($!,$^E)";
+	$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 = $Too_Big if ($size > $Too_Big);
+    }
+
+    $! = 0;
+    for (;;) {
+	my ($r, $w, $t);
+	defined($r = sysread(FROM, $buf, $size))
+	    or goto fail_inner;
+	last unless $r;
+	for ($w = 0; $w < $r; $w += $t) {
+	    $t = syswrite(TO, $buf, $r - $w, $w)
+		or goto fail_inner;
+	}
+    }
+
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    # Use this idiom to avoid uninitialized value warning.
+    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:
+    return 0;
+}
+
+sub move {
+    my($from,$to) = @_;
+    my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
+
+    if (-d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    ($tosz1,$tomt1) = (stat($to))[7,9];
+    $fromsz = -s $from;
+    if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
+      # will not rename with overwrite
+      unlink $to;
+    }
+    return 1 if rename $from, $to;
+
+    ($sts,$ossts) = ($! + 0, $^E + 0);
+    # Did rename return an error even though it succeeded, because $to
+    # is on a remote NFS file system, and NFS lost the server's ack?
+    return 1 if defined($fromsz) && !-e $from &&           # $from disappeared
+                (($tosz2,$tomt2) = (stat($to))[7,9]) &&    # $to's there
+                ($tosz1 != $tosz2 or $tomt1 != $tomt2) &&  #   and changed
+                $tosz2 == $fromsz;                         # it's all there
+ 
+    ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
+    return 1 if ($copied = copy($from,$to)) && unlink($from);
+  
+    ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
+    unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
+    ($!,$^E) = ($sts,$ossts);
+    return 0;
+}
+
+*cp = \&copy;
+*mv = \&move;
+
+# &syscopy is an XSUB under OS/2
+unless (defined &syscopy) {
+    if ($^O eq 'VMS') {
+	*syscopy = \&rmscopy;
+    } elsif ($^O eq 'mpeix') {
+	*syscopy = sub {
+	    return 0 unless @_ == 2;
+	    # Use the MPE cp program in order to
+	    # preserve MPE file attributes.
+	    return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
+	};
+    } else {
+	*syscopy = \&copy;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Copy;
+
+	copy("file1","file2");
+  	copy("Copy.pm",\*STDOUT);'
+	move("/dev1/fileA","/dev2/fileB");
+
+  	use POSIX;
+	use File::Copy cp;
+
+	$n=FileHandle->new("/dev/null","r");
+	cp($n,"x");'
+
+=head1 DESCRIPTION
+
+The File::Copy module provides two basic functions, C<copy> and
+C<move>, which are useful for getting the contents of a file from
+one place to another.
+
+=over 4
+
+=item *
+
+The C<copy> function 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).
+
+B<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.>  Files are opened in binary mode where
+applicable.  To get a consistent behavour when copying from a
+filehandle to a file, use C<binmode> on the filehandle.
+
+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.
+
+=item *
+
+The C<move> function also takes two parameters: the current name
+and the intended name of the file to be moved.  If the destination
+already exists and is a directory, and the source is not a
+directory, then the source file will be renamed into the directory
+specified by the destination.
+
+If possible, move() will simply rename the file.  Otherwise, it copies
+the file to the new location and deletes the original.  If an error occurs
+during this copy-and-delete process, you may be left with a (possibly partial)
+copy of the file under the destination name.
+
+You may use the "mv" alias for this function in the same way that
+you may use the "cp" alias for C<copy>.
+
+=back
+
+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 if C<syscopy> is defined (VMS and OS/2)
+
+If both arguments to C<copy> are not file handles,
+then C<copy> will perform a "system 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 either argument to C<copy> is a
+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 system copy routine may also be called directly under VMS and OS/2
+as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
+is the routine that does the actual work for syscopy).
+
+=over 4
+
+=item rmscopy($from,$to[,$date_flag])
+
+The first and second arguments may be strings, typeglobs, typeglob
+references, or objects inheriting from IO::Handle;
+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 E<lt> 0, none of the input file's
+timestamps are propagated to the output file.  If it is E<gt> 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.
+
+=back
+
+=head1 RETURN
+
+All functions return 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,
+and updated by Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> in 1996.
+
+=cut
+
diff --git a/contrib/perl5/lib/File/DosGlob.pm b/contrib/perl5/lib/File/DosGlob.pm
new file mode 100644
index 000000000000..594ee2ec8432
--- /dev/null
+++ b/contrib/perl5/lib/File/DosGlob.pm
@@ -0,0 +1,249 @@
+#!perl -w
+
+#
+# Documentation at the __END__
+#
+
+package File::DosGlob;
+
+sub doglob {
+    my $cond = shift;
+    my @retval = ();
+    #print "doglob: ", join('|', @_), "\n";
+  OUTER:
+    for my $arg (@_) {
+        local $_ = $arg;
+	my @matched = ();
+	my @globdirs = ();
+	my $head = '.';
+	my $sepchr = '/';
+	next OUTER unless defined $_ and $_ ne '';
+	# if arg is within quotes strip em and do no globbing
+	if (/^"(.*)"$/) {
+	    $_ = $1;
+	    if ($cond eq 'd') { push(@retval, $_) if -d $_ }
+	    else              { push(@retval, $_) if -e $_ }
+	    next OUTER;
+	}
+	if (m|^(.*)([\\/])([^\\/]*)$|) {
+	    my $tail;
+	    ($head, $sepchr, $tail) = ($1,$2,$3);
+	    #print "div: |$head|$sepchr|$tail|\n";
+	    push (@retval, $_), next OUTER if $tail eq '';
+	    if ($head =~ /[*?]/) {
+		@globdirs = doglob('d', $head);
+		push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
+		    next OUTER if @globdirs;
+	    }
+	    $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:$/;
+	    $_ = $tail;
+	}
+	#
+	# If file component has no wildcards, we can avoid opendir
+	unless (/[*?]/) {
+	    $head = '' if $head eq '.';
+	    $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
+	    $head .= $_;
+	    if ($cond eq 'd') { push(@retval,$head) if -d $head }
+	    else              { push(@retval,$head) if -e $head }
+	    next OUTER;
+	}
+	opendir(D, $head) or next OUTER;
+	my @leaves = readdir D;
+	closedir D;
+	$head = '' if $head eq '.';
+	$head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
+
+	# escape regex metachars but not glob chars
+	s:([].+^\-\${}[|]):\\$1:g;
+	# and convert DOS-style wildcards to regex
+	s/\*/.*/g;
+	s/\?/.?/g;
+
+	#print "regex: '$_', head: '$head'\n";
+	my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '$|io }';
+	warn($@), next OUTER if $@;
+      INNER:
+	for my $e (@leaves) {
+	    next INNER if $e eq '.' or $e eq '..';
+	    next INNER if $cond eq 'd' and ! -d "$head$e";
+	    push(@matched, "$head$e"), next INNER if &$matchsub($e);
+	    #
+	    # [DOS compatibility special case]
+	    # Failed, add a trailing dot and try again, but only
+	    # if name does not have a dot in it *and* pattern
+	    # has a dot *and* name is shorter than 9 chars.
+	    #
+	    if (index($e,'.') == -1 and length($e) < 9
+	        and index($_,'\\.') != -1) {
+		push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
+	    }
+	}
+	push @retval, @matched if @matched;
+    }
+    return @retval;
+}
+
+#
+# this can be used to override CORE::glob in a specific
+# package by saying C<use File::DosGlob 'glob';> in that
+# namespace.
+#
+
+# context (keyed by second cxix arg provided by core)
+my %iter;
+my %entries;
+
+sub glob {
+    my $pat = shift;
+    my $cxix = shift;
+    my @pat;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # extract patterns
+    if ($pat =~ /\s/) {
+	require Text::ParseWords;
+	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
+    }
+    else {
+	push @pat, $pat;
+    }
+
+    # assume global context if not provided one
+    $cxix = '_G_' unless defined $cxix;
+    $iter{$cxix} = 0 unless exists $iter{$cxix};
+
+    # if we're just beginning, do it all first
+    if ($iter{$cxix} == 0) {
+	$entries{$cxix} = [doglob(1,@pat)];
+    }
+
+    # chuck it all out, quick or slow
+    if (wantarray) {
+	delete $iter{$cxix};
+	return @{delete $entries{$cxix}};
+    }
+    else {
+	if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
+	    return shift @{$entries{$cxix}};
+	}
+	else {
+	    # return undef for EOL
+	    delete $iter{$cxix};
+	    delete $entries{$cxix};
+	    return undef;
+	}
+    }
+}
+
+sub import {
+    my $pkg = shift;
+    return unless @_;
+    my $sym = shift;
+    my $callpkg = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::DosGlob - DOS like globbing and then some
+
+=head1 SYNOPSIS
+
+    require 5.004;
+    
+    # override CORE::glob in current package
+    use File::DosGlob 'glob';
+    
+    # override CORE::glob in ALL packages (use with extreme caution!)
+    use File::DosGlob 'GLOBAL_glob';
+
+    @perlfiles = glob  "..\\pe?l/*.p?";
+    print <..\\pe?l/*.p?>;
+    
+    # from the command line (overrides only in main::)
+    > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
+
+=head1 DESCRIPTION
+
+A module that implements DOS-like globbing with a few enhancements.
+It is largely compatible with perlglob.exe (the M$ setargv.obj
+version) in all but one respect--it understands wildcards in
+directory components.
+
+For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in
+that it will find something like '..\lib\File/DosGlob.pm' alright).
+Note that all path components are case-insensitive, and that
+backslashes and forward slashes are both accepted, and preserved.
+You may have to double the backslashes if you are putting them in
+literally, due to double-quotish parsing of the pattern by perl.
+
+Spaces in the argument delimit distinct patterns, so
+C<glob('*.exe *.dll')> globs all filenames that end in C<.exe>
+or C<.dll>.  If you want to put in literal spaces in the glob
+pattern, you can escape them with either double quotes, or backslashes.
+e.g. C<glob('c:/"Program Files"/*/*.dll')>, or
+C<glob('c:/Program\ Files/*/*.dll')>.  The argument is tokenized using
+C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details
+of the quoting rules used.
+
+Extending it to csh patterns is left as an exercise to the reader.
+
+=head1 EXPORTS (by request only)
+
+glob()
+
+=head1 BUGS
+
+Should probably be built into the core, and needs to stop
+pandering to DOS habits.  Needs a dose of optimizium too.
+
+=head1 AUTHOR
+
+Gurusamy Sarathy <gsar@umich.edu>
+
+=head1 HISTORY
+
+=over 4
+
+=item *
+
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
+Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
+
+=item *
+
+A few dir-vs-file optimizations result in glob importation being
+10 times faster than using perlglob.exe, and using perlglob.bat is
+only twice as slow as perlglob.exe (GSAR 28-MAY-97)
+
+=item *
+
+Several cleanups prompted by lack of compatible perlglob.exe
+under Borland (GSAR 27-MAY-97)
+
+=item *
+
+Initial version (GSAR 20-FEB-97)
+
+=back
+
+=head1 SEE ALSO
+
+perl
+
+perlglob.bat
+
+Text::ParseWords
+
+=cut
+
diff --git a/contrib/perl5/lib/File/Find.pm b/contrib/perl5/lib/File/Find.pm
new file mode 100644
index 000000000000..1305d21e6b27
--- /dev/null
+++ b/contrib/perl5/lib/File/Find.pm
@@ -0,0 +1,230 @@
+package File::Find;
+require 5.000;
+require Exporter;
+require Cwd;
+
+=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 first argument to find() is either a hash reference describing the
+operations to be performed for each file, or a code reference.  If it
+is a hash reference, then the value for the key C<wanted> should be a
+code reference.  This code reference is called I<the wanted()
+function> below.
+
+Currently the only other supported key for the above hash is
+C<bydepth>, in presense of which the walk over directories is
+performed depth-first.  Entry point finddepth() is a shortcut for
+specifying C<{ bydepth => 1}> in the first argument of find().
+
+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.
+
+File::Find assumes that you don't alter the $_ variable.  If you do then
+make sure you return it to its original value before exiting your function.
+
+This library is useful 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";
+    }
+
+=head1 BUGS
+
+There is no way to make find or finddepth follow symlinks.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(find finddepth);
+
+
+sub find_opt {
+    my $wanted = shift;
+    my $bydepth = $wanted->{bydepth};
+    my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd();
+    # Localize these rather than lexicalizing them for backwards
+    # compatibility.
+    local($topdir,$topdev,$topino,$topmode,$topnlink);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) =
+	  ($Is_VMS ? stat($topdir) : lstat($topdir)))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		$prune = 0;
+		unless ($bydepth) {
+		  ($dir,$_) = ($topdir,'.');
+		  $name = $topdir;
+		  $wanted->{wanted}->();
+		}
+		next if $prune;
+		my $fixtopdir = $topdir;
+		$fixtopdir =~ s,/$,, ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS;
+		&finddir($wanted,$fixtopdir,$topnlink, $bydepth);
+		if ($bydepth) {
+		  ($dir,$_) = ($fixtopdir,'.');
+		  $name = $fixtopdir;
+		  $wanted->{wanted}->();
+		}
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    require File::Basename;
+	    unless (($_,$dir) = File::Basename::fileparse($topdir)) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    if (chdir($dir)) {
+		$name = $topdir;
+		$wanted->{wanted}->();
+	    }
+	    else {
+		warn "Can't cd to $dir: $!\n";
+	    }
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddir {
+    my($wanted, $nlink, $bydepth);
+    local($dir, $name);
+    ($wanted, $dir, $nlink, $bydepth) = @_;
+
+    my($dev, $ino, $mode, $subcount);
+
+    # Get the list of files in the current directory.
+    opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || 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->{wanted}->();
+	}
+    }
+    else {		      # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = 0;
+	    $prune = 0 unless $bydepth;
+	    $name = "$dir/$_";
+	    $wanted->{wanted}->() unless $bydepth;
+	    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.
+
+		    --$subcount;
+		    next if $prune;
+		    if (chdir $_) {
+			$name =~ s/\.dir$// if $Is_VMS;
+			&finddir($wanted,$name,$nlink, $bydepth);
+			chdir '..';
+		    }
+		    else {
+			warn "Can't cd to $_: $!\n";
+		    }
+		}
+	    }
+	    $wanted->{wanted}->() if $bydepth;
+	}
+    }
+}
+
+sub wrap_wanted {
+  my $wanted = shift;
+  defined &$wanted ? {wanted => $wanted} : $wanted;
+}
+
+sub find {
+  my $wanted = shift;
+  find_opt(wrap_wanted($wanted), @_);
+}
+
+sub finddepth {
+  my $wanted = wrap_wanted(shift);
+  $wanted->{bydepth} = 1;
+  find_opt($wanted, @_);
+}
+
+# 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' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
+
+# 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.
+unless ($dont_use_nlink) {
+  require Config;
+  $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+}
+
+1;
+
diff --git a/contrib/perl5/lib/File/Path.pm b/contrib/perl5/lib/File/Path.pm
new file mode 100644
index 000000000000..39f1ba17713e
--- /dev/null
+++ b/contrib/perl5/lib/File/Path.pm
@@ -0,0 +1,228 @@
+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.
+
+B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
+in the face of failure or interruption.  Files and directories which
+were not deleted may be left with permissions reset to allow world
+read and write access.  Note also that the occurrence of errors in
+rmtree can be determined I<only> by trapping diagnostic messages
+using C<$SIG{__WARN__}>; it is not apparent from the return value.
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+in situations where security is an issue.
+
+=head1 AUTHORS
+
+Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
+Charles Bailey <F<bailey@genetics.upenn.edu>>
+
+=head1 REVISION
+
+Current $VERSION is 1.0401.
+
+=cut
+
+use Carp;
+use File::Basename ();
+use DirHandle ();
+use Exporter ();
+use strict;
+
+use vars qw( $VERSION @ISA @EXPORT );
+$VERSION = "1.0401";
+@ISA = qw( Exporter );
+@EXPORT = qw( mkpath rmtree );
+
+my $Is_VMS = $^O eq 'VMS';
+
+# These OSes complain if you want to remove a file that you have no
+# write permission to:
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
+		       || $^O eq 'amigaos');
+
+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,$path);
+    foreach $path (@$paths) {
+	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT 
+	next if -d $path;
+	# Logic wants Unix paths, so go with the flow.
+	$path = VMS::Filespec::unixify($path) if $Is_VMS;
+	my $parent = File::Basename::dirname($path);
+	# Allow for creation of new logical filesystems under VMS
+	if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
+	    push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+	}
+	print "mkdir $path\n" if $verbose;
+	unless (mkdir($path,$mode)) {
+	    # allow for another process to have created it meanwhile
+	    croak "mkdir $path: $!" unless -d $path;
+	}
+	push(@created, $path);
+    }
+    @created;
+}
+
+sub rmtree {
+    my($roots, $verbose, $safe) = @_;
+    my(@files);
+    my($count) = 0;
+    $roots = [$roots] unless ref $roots;
+    $verbose ||= 0;
+    $safe ||= 0;
+
+    my($root);
+    foreach $root (@{$roots}) {
+	$root =~ s#/$##;
+	(undef, undef, my $rp) = lstat $root or next;
+	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
+	if ( -d _ ) {
+	    # notabene: 0777 is for making readable in the first place,
+	    # it's also intended to change it to writable in case we have
+	    # to recurse in which case we are better than rm -rf for 
+	    # subtrees with strange permissions
+	    chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+	      or carp "Can't make directory $root read+writeable: $!"
+		unless $safe;
+
+	    my $d = DirHandle->new($root)
+	      or carp "Can't read $root: $!";
+	    @files = $d->read;
+	    $d->close;
+
+	    # Deleting large numbers of files from VMS Files-11 filesystems
+	    # is faster if done in reverse ASCIIbetical order 
+	    @files = reverse @files if $Is_VMS;
+	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
+	    @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@files);
+	    $count += rmtree(\@files,$verbose,$safe);
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0777, $root
+	      or carp "Can't make directory $root writeable: $!"
+		if $force_writeable;
+	    print "rmdir $root\n" if $verbose;
+	    if (rmdir $root) {
+		++$count;
+	    }
+	    else {
+		carp "Can't remove directory $root: $!";
+		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+		    or carp("and can't restore permissions to "
+		            . sprintf("0%o",$rp) . "\n");
+	    }
+	}
+	else { 
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0666, $root
+	      or carp "Can't make file $root writeable: $!"
+		if $force_writeable;
+	    print "unlink $root\n" if $verbose;
+	    # delete all versions under VMS
+	    for (;;) {
+		unless (unlink $root) {
+		    carp "Can't unlink file $root: $!";
+		    if ($force_writeable) {
+			chmod $rp, $root
+			    or carp("and can't restore permissions to "
+			            . sprintf("0%o",$rp) . "\n");
+		    }
+		    last;
+		}
+		++$count;
+		last unless $Is_VMS && lstat $root;
+	    }
+	}
+    }
+
+    $count;
+}
+
+1;
diff --git a/contrib/perl5/lib/File/Spec.pm b/contrib/perl5/lib/File/Spec.pm
new file mode 100644
index 000000000000..5f3dbf5fce76
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec.pm
@@ -0,0 +1,116 @@
+package File::Spec;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
+	
+);
+@EXPORT_OK = qw($Verbose);
+
+use strict;
+use vars qw(@ISA $VERSION $Verbose);
+
+$VERSION = '0.6';
+
+$Verbose = 0;
+
+require File::Spec::Unix;
+
+
+sub load {
+	my($class,$OS) = @_;
+	if ($OS eq 'VMS') {
+		require File::Spec::VMS;
+		require VMS::Filespec;
+		'File::Spec::VMS'
+	} elsif ($OS eq 'os2') {
+		require File::Spec::OS2;
+		'File::Spec::OS2'
+	} elsif ($OS eq 'MacOS') {
+		require File::Spec::Mac;
+		'File::Spec::Mac'
+	} elsif ($OS eq 'MSWin32') {
+		require File::Spec::Win32;
+		'File::Spec::Win32'
+	} else {
+		'File::Spec::Unix'
+	}
+}
+
+@ISA = load('File::Spec', $^O);
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec - portably perform operations on file names
+
+=head1 SYNOPSIS
+
+C<use File::Spec;>
+
+C<$x=File::Spec-E<gt>catfile('a','b','c');>
+
+which returns 'a/b/c' under Unix.
+
+=head1 DESCRIPTION
+
+This module is designed to support operations commonly performed on file
+specifications (usually called "file names", but not to be confused with the
+contents of a file, or Perl's file handles), such as concatenating several
+directory and file names into a single path, or determining whether a path
+is rooted. It is based on code directly taken from MakeMaker 5.17, code
+written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya
+Zakharevich, Paul Schinder, and others.
+
+Since these functions are different for most operating systems, each set of
+OS specific routines is available in a separate module, including:
+
+	File::Spec::Unix
+	File::Spec::Mac
+	File::Spec::OS2
+	File::Spec::Win32
+	File::Spec::VMS
+
+The module appropriate for the current OS is automatically loaded by
+File::Spec. Since some modules (like VMS) make use of OS specific
+facilities, it may not be possible to load all modules under all operating
+systems.
+
+Since File::Spec is object oriented, subroutines should not called directly,
+as in:
+
+	File::Spec::catfile('a','b');
+	
+but rather as class methods:
+
+	File::Spec->catfile('a','b');
+
+For a reference of available functions, pleaes consult L<File::Spec::Unix>,
+which contains the entire set, and inherited by the modules for other
+platforms. For further information, please see L<File::Spec::Mac>,
+L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
+
+=head1 SEE ALSO
+
+File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32,
+File::Spec::VMS, ExtUtils::MakeMaker
+
+=head1 AUTHORS
+
+Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
+<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
+<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS
+support by Charles Bailey <F<bailey@genetics.upenn.edu>>.  OS/2 support by
+Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
+<F<schinder@pobox.com>>.
+
+=cut
+
+
+1;
diff --git a/contrib/perl5/lib/File/Spec/Mac.pm b/contrib/perl5/lib/File/Spec/Mac.pm
new file mode 100644
index 000000000000..4968e24abca0
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec/Mac.pm
@@ -0,0 +1,230 @@
+package File::Spec::Mac;
+
+use Exporter ();
+use Config;
+use strict;
+use File::Spec;
+use vars qw(@ISA $VERSION $Is_Mac);
+
+$VERSION = '1.0';
+
+@ISA = qw(File::Spec::Unix);
+$Is_Mac = $^O eq 'MacOS';
+
+Exporter::import('File::Spec', '$Verbose');
+
+
+=head1 NAME
+
+File::Spec::Mac - File::Spec for MacOS
+
+=head1 SYNOPSIS
+
+C<require File::Spec::Mac;>
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+On MacOS, there's nothing to be done.  Returns what it's given.
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+    $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending with 
+a directory.  Put a trailing : on the end of the complete path if there 
+isn't one, because that's what's done in MacPerl's environment.
+
+The fundamental requirement of this routine is that
+
+	  File::Spec->catdir(split(":",$path)) eq $path
+
+But because of the nature of Macintosh paths, some additional 
+possibilities are allowed to make using this routine give resonable results 
+for some common situations.  Here are the rules that are used.  Each 
+argument has its trailing ":" removed.  Each argument, except the first,
+has its leading ":" removed.  They are then joined together by a ":".
+
+So
+
+	  File::Spec->catdir("a","b") = "a:b:"
+	  File::Spec->catdir("a:",":b") = "a:b:"
+	  File::Spec->catdir("a:","b") = "a:b:"
+	  File::Spec->catdir("a",":b") = "a:b"
+	  File::Spec->catdir("a","","b") = "a::b"
+
+etc.
+
+To get a relative path (one beginning with :), begin the first argument with :
+or put a "" as the first argument.
+
+If you don't want to worry about these rules, never allow a ":" on the ends 
+of any of the arguments except at the beginning of the first.
+
+Under MacPerl, there is an additional ambiguity.  Does the user intend that
+
+	  File::Spec->catfile("LWP","Protocol","http.pm")
+
+be relative or absolute?  There's no way of telling except by checking for the
+existance of LWP: or :LWP, and even there he may mean a dismounted volume or
+a relative path in a different directory (like in @INC).   So those checks
+aren't done here. This routine will treat this as absolute.
+
+=cut
+
+# ';
+
+sub catdir {
+    shift;
+    my @args = @_;
+	$args[0] =~ s/:$//;
+	my $result = shift @args;
+	for (@args) {
+		s/:$//;
+		s/^://;
+		$result .= ":$_";
+    }
+    $result .= ":";
+	$result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename.  Since this uses catdir, the
+same caveats apply.  Note that the leading : is removed from the filename,
+so that 
+
+	  File::Spec->catfile($ENV{HOME},"file");
+
+and
+
+	  File::Spec->catfile($ENV{HOME},":file");
+
+give the same answer, as one might expect.
+
+=cut
+
+sub catfile {
+    my $self = shift @_;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+	$file =~ s/^://;
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representing of the current directory.
+
+=cut
+
+sub curdir {
+    return ":" ;
+}
+
+=item rootdir
+
+Returns a string representing the root directory.  Under MacPerl,
+returns the name of the startup volume, since that's the closest in
+concept, although other volumes aren't rooted there.  On any other
+platform returns '', since there's no common way to indicate "root
+directory" across all Macs.
+
+=cut
+
+sub rootdir {
+#
+#  There's no real root directory on MacOS.  If you're using MacPerl,
+#  the name of the startup volume is returned, since that's the closest in
+#  concept.  On other platforms, simply return '', because nothing better
+#  can be done.
+#
+	if($Is_Mac) {
+        require Mac::Files;
+		my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+		        &Mac::Files::kSystemFolderType);
+		$system =~ s/:.*$/:/;
+		return $system;
+	} else {
+		return '';
+    }
+}
+
+=item updir
+
+Returns a string representing the parent directory.
+
+=cut
+
+sub updir {
+    return "::";
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, if it is an absolute path.  In 
+the case where a name can be either relative or absolute (for example, a 
+folder named "HD" in the current working directory on a drive named "HD"), 
+relative wins.  Use ":" in the appropriate place in the path if you want to
+distinguish unambiguously.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+	if ($file =~ /:/) {
+		return ($file !~ m/^:/);
+	} else {
+		return (! -e ":$file");
+    }
+}
+
+=item path
+
+Returns the null list for the MacPerl application, since the concept is 
+usually meaningless under MacOS. But if you're using the MacPerl tool under 
+MPW, it gives back $ENV{Commands} suitably split, as is done in 
+:lib:ExtUtils:MM_Mac.pm.
+
+=cut
+
+sub path {
+#
+#  The concept is meaningless under the MacPerl application.
+#  Under MPW, it has a meaning.
+#
+    my($self) = @_;
+	my @path;
+	if(exists $ENV{Commands}) {
+		@path = split /,/,$ENV{Commands};
+	} else {
+	    @path = ();
+	}
+    @path;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
+__END__
+
diff --git a/contrib/perl5/lib/File/Spec/OS2.pm b/contrib/perl5/lib/File/Spec/OS2.pm
new file mode 100644
index 000000000000..d60261770281
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec/OS2.pm
@@ -0,0 +1,51 @@
+package File::Spec::OS2;
+
+#use Config;
+#use Cwd;
+#use File::Basename;
+use strict;
+require Exporter;
+
+use File::Spec;
+use vars qw(@ISA);
+
+Exporter::import('File::Spec',
+       qw( $Verbose));
+
+@ISA = qw(File::Spec::Unix);
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+sub path {
+    my($self) = @_;
+    my $path_sep = ";";
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g;
+    my @path = split $path_sep, $path;
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec::OS2 - methods for OS/2 file specs
+
+=head1 SYNOPSIS
+
+ use File::Spec::OS2; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=cut
diff --git a/contrib/perl5/lib/File/Spec/Unix.pm b/contrib/perl5/lib/File/Spec/Unix.pm
new file mode 100644
index 000000000000..77de73a216a3
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec/Unix.pm
@@ -0,0 +1,197 @@
+package File::Spec::Unix;
+
+use Exporter ();
+use Config;
+use File::Basename qw(basename dirname fileparse);
+use DirHandle;
+use strict;
+use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32);
+use File::Spec;
+
+Exporter::import('File::Spec', '$Verbose');
+
+$Is_OS2 = $^O eq 'os2';
+$Is_Mac = $^O eq 'MacOS';
+$Is_Win32 = $^O eq 'MSWin32';
+
+if ($Is_VMS = $^O eq 'VMS') {
+    require VMS::Filespec;
+    import VMS::Filespec qw( &vmsify );
+}
+
+=head1 NAME
+
+File::Spec::Unix - methods used by File::Spec
+
+=head1 SYNOPSIS
+
+C<require File::Spec::Unix;>
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 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
+	$_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
+    }
+    my $result = join('', @args);
+    # remove a trailing slash unless we are root
+    substr($result,-1) = ""
+	if length($result) > 1 && substr($result,-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 "..";
+}
+
+=item no_upwards
+
+Given a list of file names, strip out those that refer to a parent
+directory. (Does not strip symlinks, only '.', '..', and equivalents.)
+
+=cut
+
+sub no_upwards {
+    my($self) = shift;
+    return grep(!/^\.{1,2}$/, @_);
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, if it is an absolute path.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m:^/: ;
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+    my($self) = @_;
+    my $path_sep = ":";
+    my $path = $ENV{PATH};
+    my @path = split $path_sep, $path;
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
+}
+
+=item join
+
+join is the same as catfile.
+
+=cut
+
+sub join {
+	my($self) = shift @_;
+	$self->catfile(@_);
+}
+
+=item nativename
+
+TBW.
+
+=cut
+
+sub nativename {
+	my($self,$name) = shift @_;
+	$name;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
+__END__
diff --git a/contrib/perl5/lib/File/Spec/VMS.pm b/contrib/perl5/lib/File/Spec/VMS.pm
new file mode 100644
index 000000000000..c5269fd10c7a
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec/VMS.pm
@@ -0,0 +1,148 @@
+
+package File::Spec::VMS;
+
+use Carp qw( &carp );
+use Config;
+require Exporter;
+use VMS::Filespec;
+use File::Basename;
+
+use File::Spec;
+use vars qw($Revision);
+$Revision = '5.3901 (6-Mar-1997)';
+
+@ISA = qw(File::Spec::Unix);
+
+Exporter::import('File::Spec', '$Verbose');
+
+=head1 NAME
+
+File::Spec::VMS - methods for VMS file specs
+
+=head1 SYNOPSIS
+
+ use File::Spec::VMS; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=head2 Methods always loaded
+
+=over
+
+=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 = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+    }
+    else { 
+      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
+      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 '[-]';
+}
+
+=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 file_name_is_absolute (override)
+
+Checks for VMS directory spec as well as Unix separators.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    # If it's a logical name, expand it.
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
+    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
+}
+
+1;
+__END__
+
diff --git a/contrib/perl5/lib/File/Spec/Win32.pm b/contrib/perl5/lib/File/Spec/Win32.pm
new file mode 100644
index 000000000000..034a0cbc2e69
--- /dev/null
+++ b/contrib/perl5/lib/File/Spec/Win32.pm
@@ -0,0 +1,104 @@
+package File::Spec::Win32;
+
+=head1 NAME
+
+File::Spec::Win32 - methods for Win32 file specs
+
+=head1 SYNOPSIS
+
+ use File::Spec::Win32; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=over
+
+=cut 
+
+#use Config;
+#use Cwd;
+use File::Basename;
+require Exporter;
+use strict;
+
+use vars qw(@ISA);
+
+use File::Spec;
+Exporter::import('File::Spec', qw( $Verbose));
+
+@ISA = qw(File::Spec::Unix);
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+sub catdir {
+    my $self = shift;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
+    }
+    my $result = $self->canonpath(join('', @args));
+    $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(@_);
+    $dir =~ s/(\\\.)$//;
+    $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
+    return $dir.$file;
+}
+
+sub path {
+    local $^W = 1;
+    my($self) = @_;
+    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
+    my @path = split(';',$path);
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
+}
+
+=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/^([a-z]:)/\u$1/;
+    $path =~ s|/|\\|g;
+    $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 =~ m#^([a-z]:)?\\#;      # xx/       -> xx
+    $path .= '.' if $path =~ m#\\$#;
+    $path;
+}
+
+1;
+__END__
+
+=back
+
+=cut 
+
diff --git a/contrib/perl5/lib/File/stat.pm b/contrib/perl5/lib/File/stat.pm
new file mode 100644
index 000000000000..f5d17f7da443
--- /dev/null
+++ b/contrib/perl5/lib/File/stat.pm
@@ -0,0 +1,113 @@
+package File::stat;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(stat lstat);
+    @EXPORT_OK   = qw( $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
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'File::stat' => [
+     map { $_ => '$' } qw{
+	 dev ino mode nlink uid gid rdev size
+	 atime mtime ctime blksize blocks
+     }
+];
+
+sub populate (@) {
+    return unless @_;
+    my $stob = new();
+    @$stob = (
+	$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 ) 
+	    = @_;
+    return $stob;
+} 
+
+sub lstat ($)  { populate(CORE::lstat(shift)) }
+
+sub stat ($) {
+    my $arg = shift;
+    my $st = populate(CORE::stat $arg);
+    return $st if $st;
+    no strict 'refs';
+    require Symbol;
+    return populate(CORE::stat \*{Symbol::qualify($arg)});
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::stat - by-name interface to Perl's built-in stat() functions
+
+=head1 SYNOPSIS
+
+ use File::stat;
+ $st = stat($file) or die "No $file: $!";
+ if ( ($st->mode & 0111) && $st->nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+ use File::stat qw(:FIELDS);
+ stat($file) or die "No $file: $!";
+ if ( ($st_mode & 0111) && $st_nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+=head1 DESCRIPTION
+
+This module's default exports override the core stat() 
+and lstat() functions, replacing them with versions that return 
+"File::stat" objects.  This object has methods that
+return the similarly named structure field name from the
+stat(2) function; namely,
+dev,
+ino,
+mode,
+nlink,
+uid,
+gid,
+rdev,
+size,
+atime,
+mtime,
+ctime,
+blksize,
+and
+blocks.  
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your stat() and lstat() functions.)  Access these fields as
+variables named with a preceding C<st_> in front their method names.
+Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
+the fields.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/FileCache.pm b/contrib/perl5/lib/FileCache.pm
new file mode 100644
index 000000000000..e1c5ec4c8a88
--- /dev/null
+++ b/contrib/perl5/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 $FileCache::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/contrib/perl5/lib/FileHandle.pm b/contrib/perl5/lib/FileHandle.pm
new file mode 100644
index 000000000000..eec9b61f31bb
--- /dev/null
+++ b/contrib/perl5/lib/FileHandle.pm
@@ -0,0 +1,262 @@
+package FileHandle;
+
+use 5.003_11;
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = "2.00";
+
+require IO::File;
+@ISA = qw(IO::File);
+
+@EXPORT = qw(_IOFBF _IOLBF _IONBF);
+
+@EXPORT_OK = qw(
+    pipe
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+    print
+    printf
+    getline
+    getlines
+);
+
+#
+# Everything we're willing to export, we must first import.
+#
+import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK;
+
+#
+# Some people call "FileHandle::function", so all the functions
+# that were in the old FileHandle class must be imported, too.
+#
+{
+    no strict 'refs';
+
+    my %import = (
+	'IO::Handle' =>
+	    [qw(DESTROY new_from_fd fdopen close fileno getc ungetc gets
+		eof flush error clearerr setbuf setvbuf _open_mode_string)],
+	'IO::Seekable' =>
+	    [qw(seek tell getpos setpos)],
+	'IO::File' =>
+	    [qw(new new_tmpfile open)]
+    );
+    for my $pkg (keys %import) {
+	for my $func (@{$import{$pkg}}) {
+	    my $c = *{"${pkg}::$func"}{CODE}
+		or die "${pkg}::$func missing";
+	    *$func = $c;
+	}
+    }
+}
+
+#
+# Specialized importer for Fcntl magic.
+#
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    require Exporter;
+    Exporter::export($pkg, $callpkg, @_);
+
+    #
+    # If the Fcntl extension is available,
+    #  export its constants.
+    #
+    eval {
+	require Fcntl;
+	Exporter::export('Fcntl', $callpkg);
+    };
+}
+
+################################################
+# This is the only exported function we define;
+# the rest come from other classes.
+#
+
+sub pipe {
+    my $r = new IO::Handle;
+    my $w = new IO::Handle;
+    CORE::pipe($r, $w) or return undef;
+    ($r, $w);
+}
+
+# Rebless standard file handles
+bless *STDIN{IO},  "FileHandle" if ref *STDIN{IO}  eq "IO::Handle";
+bless *STDOUT{IO}, "FileHandle" if ref *STDOUT{IO} eq "IO::Handle";
+bless *STDERR{IO}, "FileHandle" if ref *STDERR{IO} eq "IO::Handle";
+
+1;
+
+__END__
+
+=head1 NAME
+
+FileHandle - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use FileHandle;
+
+    $fh = new FileHandle;
+    if ($fh->open("< file")) {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new FileHandle "> FOO";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new FileHandle "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new FileHandle "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+        undef $fh;       # automatically closes the file
+    }
+
+    $pos = $fh->getpos;
+    $fh->setpos($pos);
+
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
+    ($readfh, $writefh) = FileHandle::pipe;
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+NOTE: This class is now a front-end to the IO::* classes.
+
+C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
+newly created symbol (see the C<Symbol> package).  If it receives any
+parameters, they are passed to C<FileHandle::open>; if the open fails,
+the C<FileHandle> object is destroyed.  Otherwise, it is returned to
+the caller.
+
+C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
+It requires two parameters, which are passed to C<FileHandle::fdopen>;
+if the fdopen fails, the C<FileHandle> object is destroyed.
+Otherwise, it is returned to the caller.
+
+C<FileHandle::open> accepts one parameter or two.  With one parameter,
+it is just a front end for the built-in C<open> function.  With two
+parameters, the first parameter is a filename that may include
+whitespace or other special characters, and the second parameter is
+the open mode, optionally followed by a file permission value.
+
+If C<FileHandle::open> receives a Perl mode string (">", "+<", etc.)
+or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator.
+
+If C<FileHandle::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+For convenience, C<FileHandle::import> tries to import the O_XXX
+constants from the Fcntl module.  If dynamic loading is not available,
+this may fail, but the rest of FileHandle will still work.
+
+C<FileHandle::fdopen> is like C<open> except that its first parameter
+is not a filename but rather a file handle name, a FileHandle object,
+or a file descriptor number.
+
+If the C functions fgetpos() and fsetpos() are available, then
+C<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+sets the buffering policy for the FileHandle.  The calling sequence
+for the Perl function is the same as its C counterpart, including the
+macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
+parameter specifies a scalar variable to use as a buffer.  WARNING: A
+variable used as a buffer by C<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<FileHandle> methods, which are just front ends for the
+corresponding built-in functions:
+
+    close
+    fileno
+    getc
+    gets
+    eof
+    clearerr
+    seek
+    tell
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<FileHandle> methods:
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $fh->print
+
+See L<perlfunc/print>.
+
+=item $fh->printf
+
+See L<perlfunc/printf>.
+
+=item $fh->getline
+
+This works like <$fh> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in an
+array context but still returns just one line.
+
+=item $fh->getlines
+
+This works like <$fh> when called in an array context to
+read all the remaining lines in a file, except that it's more readable.
+It will also croak() if accidentally called in a scalar context.
+
+=back
+
+There are many other functions available since FileHandle is descended
+from IO::File, IO::Seekable, and IO::Handle.  Please see those
+respective pages for documentation on more functions.
+
+=head1 SEE ALSO
+
+The B<IO> extension,
+L<perlfunc>, 
+L<perlop/"I/O Operators">.
+
+=cut
diff --git a/contrib/perl5/lib/FindBin.pm b/contrib/perl5/lib/FindBin.pm
new file mode 100644
index 000000000000..d6bd7b777e20
--- /dev/null
+++ b/contrib/perl5/lib/FindBin.pm
@@ -0,0 +1,188 @@
+# FindBin.pm
+#
+# Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+=head1 NAME
+
+FindBin - Locate directory of original perl script
+
+=head1 SYNOPSIS
+
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+
+ or
+
+ use FindBin qw($Bin);
+ use lib "$Bin/../lib";
+
+=head1 DESCRIPTION
+
+Locates the full path to the script bin directory to allow the use
+of paths relative to the bin directory.
+
+This allows a user to setup a directory tree for some software with
+directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
+the use of modules in the lib directory without knowing where the software
+tree is installed.
+
+If perl is invoked using the B<-e> option or the perl script is read from
+C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
+directory.
+
+=head1 EXPORTABLE VARIABLES
+
+ $Bin         - path to bin directory from where script was invoked
+ $Script      - basename of script from which perl was invoked
+ $RealBin     - $Bin with all links resolved
+ $RealScript  - $Script with all links resolved
+
+=head1 KNOWN BUGS
+
+if perl is invoked as
+
+   perl filename
+
+and I<filename> does not have executable rights and a program called I<filename>
+exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
+assumes that it was invoked via the C<$ENV{PATH}>.
+
+Workaround is to invoke perl as
+
+ perl ./filename
+
+=head1 AUTHORS
+
+Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 REVISION
+
+$Revision: 1.4 $
+
+=cut
+
+package FindBin;
+use Carp;
+require 5.000;
+require Exporter;
+use Cwd qw(getcwd abs_path);
+use Config;
+use File::Basename;
+
+@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
+%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
+@ISA = qw(Exporter);
+
+$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.41 $ =~ /(\d+)\.(\d+)/);
+
+sub is_abs_path
+{
+ local $_ = shift if (@_);
+ if ($^O eq 'MSWin32' || $^O eq 'dos')
+  {
+   return m#^[a-z]:[\\/]#i;
+  }
+ elsif ($^O eq 'VMS')
+  {
+    # If it's a logical name, expand it.
+    $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_};
+    return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/;
+  }
+ else
+  {
+   return m#^/#;
+  }
+}
+
+BEGIN
+{
+ *Dir = \$Bin;
+ *RealDir = \$RealBin;
+
+ if($0 eq '-e' || $0 eq '-')
+  {
+   # perl invoked with -e or script is on C<STDIN>
+
+   $Script = $RealScript = $0;
+   $Bin    = $RealBin    = getcwd();
+  }
+ else
+  {
+   my $script = $0;
+
+   if ($^O eq 'VMS')
+    {
+     ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/;
+     ($RealBin,$RealScript) = ($Bin,$Script);
+    }
+   else
+    {
+     my $IsWin32 = $^O eq 'MSWin32';
+     unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#))
+            && -f $script)
+      {
+       my $dir;
+       my $pathvar = 'PATH';
+
+       foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar}))
+	{
+	if(-r "$dir/$script" && (!$IsWin32 || -x _))
+         {
+          $script = "$dir/$script";
+
+	  if (-f $0)
+           {
+	    # $script has been found via PATH but perl could have
+	    # been invoked as 'perl file'. Do a dumb check to see
+	    # if $script is a perl program, if not then $script = $0
+            #
+            # well we actually only check that it is an ASCII file
+            # we know its executable so it is probably a script
+            # of some sort.
+
+            $script = $0 unless(-T $script);
+           }
+          last;
+         }
+       }
+     }
+
+     croak("Cannot find current script '$0'") unless(-f $script);
+
+     # Ensure $script contains the complete path incase we C<chdir>
+
+     $script = getcwd() . "/" . $script unless is_abs_path($script);
+
+     ($Script,$Bin) = fileparse($script);
+
+     # Resolve $script if it is a link
+     while(1)
+      {
+       my $linktext = readlink($script);
+
+       ($RealScript,$RealBin) = fileparse($script);
+       last unless defined $linktext;
+
+       $script = (is_abs_path($linktext))
+                  ? $linktext
+                  : $RealBin . "/" . $linktext;
+      }
+
+     # Get absolute paths to directories
+     $Bin     = abs_path($Bin)     if($Bin);
+     $RealBin = abs_path($RealBin) if($RealBin);
+    }
+  }
+}
+
+1; # Keep require happy
+
diff --git a/contrib/perl5/lib/Getopt/Long.pm b/contrib/perl5/lib/Getopt/Long.pm
new file mode 100644
index 000000000000..1966ef3c9117
--- /dev/null
+++ b/contrib/perl5/lib/Getopt/Long.pm
@@ -0,0 +1,1381 @@
+# GetOpt::Long.pm -- Universal options parsing
+
+package Getopt::Long;
+
+# RCS Status      : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Sun Jun 14 13:17:22 1998
+# Update Count    : 705
+# Status          : Released
+
+################ Copyright ################
+
+# This program is Copyright 1990,1998 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.
+
+################ Module Preamble ################
+
+use strict;
+
+BEGIN {
+    require 5.004;
+    use Exporter ();
+    use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+    $VERSION     = "2.17";
+
+    @ISA         = qw(Exporter);
+    @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    %EXPORT_TAGS = qw();
+    @EXPORT_OK   = qw();
+    use AutoLoader qw(AUTOLOAD);
+}
+
+# User visible variables.
+use vars @EXPORT, @EXPORT_OK;
+use vars qw($error $debug $major_version $minor_version);
+# Deprecated visible variables.
+use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
+	    $passthrough);
+# Official invisible variables.
+use vars qw($genprefix);
+
+# Public subroutines. 
+sub Configure (@);
+sub config (@);			# deprecated name
+sub GetOptions;
+
+# Private subroutines. 
+sub ConfigDefaults ();
+sub FindOption ($$$$$$$);
+sub Croak (@);			# demand loading the real Croak
+
+################ Local Variables ################
+
+################ Resident subroutines ################
+
+sub ConfigDefaults () {
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$genprefix = "(--|-)";
+	$autoabbrev = 0;		# no automatic abbrev of options
+	$bundling = 0;			# no bundling of single letter switches
+	$getopt_compat = 0;		# disallow '+' to start options
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$genprefix = "(--|-|\\+)";
+	$autoabbrev = 1;		# automatic abbrev of options
+	$bundling = 0;			# bundling off by default
+	$getopt_compat = 1;		# allow '+' to start options
+	$order = $PERMUTE;
+    }
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $error = 0;			# error tally
+    $ignorecase = 1;		# ignore case when matching options
+    $passthrough = 0;		# leave unrecognized options alone
+}
+
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+# Set defaults.
+ConfigDefaults ();
+
+################ Package return ################
+
+1;
+
+__END__
+
+################ AutoLoading subroutines ################
+
+# RCS Status      : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $
+# Author          : Johan Vromans
+# Created On      : Fri Mar 27 11:50:30 1998
+# Last Modified By: Johan Vromans
+# Last Modified On: Sun Jun 14 13:54:35 1998
+# Update Count    : 24
+# Status          : Released
+
+sub GetOptions {
+
+    my @optionlist = @_;	# local copy of the option descriptions
+    my $argend = '--';		# option list terminator
+    my %opctl = ();		# table of arg.specs (long and abbrevs)
+    my %bopctl = ();		# table of arg.specs (bundles)
+    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 $opt;			# current option
+    my $genprefix = $genprefix;	# so we can call the same module many times
+    my @opctl;			# the possible long option names
+
+    $error = '';
+
+    print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
+		  "called from package \"$pkg\".",
+		  "\n  ",
+		  'GetOptionsAl $Revision: 2.20 $ ',
+		  "\n  ",
+		  "ARGV: (@ARGV)",
+		  "\n  ",
+		  "autoabbrev=$autoabbrev,".
+		  "bundling=$bundling,",
+		  "getopt_compat=$getopt_compat,",
+		  "order=$order,",
+		  "\n  ",
+		  "ignorecase=$ignorecase,",
+		  "passthrough=$passthrough,",
+		  "genprefix=\"$genprefix\".",
+		  "\n")
+	if $debug;
+
+    # Check for ref HASH as first argument. 
+    # First argument may be an object. It's OK to use this as long
+    # as it is really a hash underneath. 
+    $userlinkage = undef;
+    if ( ref($optionlist[0]) and
+	 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
+	$userlinkage = shift (@optionlist);
+	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
+    }
+
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    if ( $optionlist[0] =~ /^\W+$/ ) {
+	$genprefix = shift (@optionlist);
+	# Turn into regexp. Needs to be parenthesized!
+	$genprefix =~ s/(\W)/\\$1/g;
+	$genprefix = "([" . $genprefix . "])";
+    }
+
+    # Verify correctness of optionlist.
+    %opctl = ();
+    %bopctl = ();
+    while ( @optionlist > 0 ) {
+	my $opt = shift (@optionlist);
+
+	# Strip leading prefix so people can specify "--foo=i" if they like.
+	$opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
+
+	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' ) {
+		$error .= "Option spec <> requires a reference to a subroutine\n";
+		next;
+	    }
+	    $linkage{'<>'} = shift (@optionlist);
+	    next;
+	}
+
+	# Match option spec. Allow '?' as an alias.
+	if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
+	    $error .= "Error in option spec: \"$opt\"\n";
+	    next;
+	}
+	my ($o, $c, $a) = ($1, $5);
+	$c = '' unless defined $c;
+
+	if ( ! defined $o ) {
+	    # empty -> '-' option
+	    $opctl{$o = ''} = $c;
+	}
+	else {
+	    # Handle alias names
+	    my @o =  split (/\|/, $o);
+	    my $linko = $o = $o[0];
+	    # Force an alias if the option name is not locase.
+	    $a = $o unless $o eq lc($o);
+	    $o = lc ($o)
+		if $ignorecase > 1 
+		    || ($ignorecase
+			&& ($bundling ? length($o) > 1  : 1));
+
+	    foreach ( @o ) {
+		if ( $bundling && length($_) == 1 ) {
+		    $_ = lc ($_) if $ignorecase > 1;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			warn ("Ignoring '!' modifier for short option $_\n");
+			$c = '';
+		    }
+		    $opctl{$_} = $bopctl{$_} = $c;
+		}
+		else {
+		    $_ = lc ($_) if $ignorecase;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			$c = '';
+		    }
+		    $opctl{$_} = $c;
+		}
+		if ( defined $a ) {
+		    # Note alias.
+		    $aliases{$_} = $a;
+		}
+		else {
+		    # Set primary name.
+		    $a = $_;
+		}
+	    }
+	    $o = $linko;
+	}
+
+	# 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]) =~ /^(SCALAR|CODE)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+	    }
+	    elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '@'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
+		$bopctl{$o} .= '@'
+		  if $bundling and defined $bopctl{$o} and 
+		    $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
+	    }
+	    elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '%'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
+		$bopctl{$o} .= '%'
+		  if $bundling and defined $bopctl{$o} and 
+		    $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
+	    }
+	    else {
+		$error .= "Invalid option linkage for \"$opt\"\n";
+	    }
+	}
+	else {
+	    # Link to global $opt_XXX variable.
+	    # Make sure a valid perl identifier results.
+	    my $ov = $o;
+	    $ov =~ s/\W/_/g;
+	    if ( $c =~ /@/ ) {
+		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
+	    }
+	    elsif ( $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.
+    die ($error) if $error;
+    $error = 0;
+
+    # Sort the possible long option names.
+    @opctl = sort(keys (%opctl)) if $autoabbrev;
+
+    # Show the options tables if debugging.
+    if ( $debug ) {
+	my ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%bopctl) ) {
+	    print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+    }
+
+    # Process argument list
+    while ( @ARGV > 0 ) {
+
+	#### Get next argument ####
+
+	$opt = shift (@ARGV);
+	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 $order == $PERMUTE;
+	    return ($error == 0);
+	}
+
+	my $tryopt = $opt;
+	my $found;		# success status
+	my $dsttype;		# destination type ('@' or '%')
+	my $incr;		# destination increment 
+	my $key;		# key (if hash type)
+	my $arg;		# option argument
+
+	($found, $opt, $arg, $dsttype, $incr, $key) = 
+	  FindOption ($genprefix, $argend, $opt, 
+		      \%opctl, \%bopctl, \@opctl, \%aliases);
+
+	if ( $found ) {
+	    
+	    # FindOption undefines $opt in case of errors.
+	    next unless defined $opt;
+
+	    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' ) {
+			if ( $incr ) {
+			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
+			      if $debug;
+			    if ( defined ${$linkage{$opt}} ) {
+			        ${$linkage{$opt}} += $arg;
+			    }
+		            else {
+			        ${$linkage{$opt}} = $arg;
+			    }
+			}
+			else {
+			    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 'HASH' ) {
+			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$linkage{$opt}->{$key} = $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");
+			Croak ("Getopt::Long -- internal error!\n");
+		    }
+		}
+		# No entry in linkage means entry in userlinkage.
+		elsif ( $dsttype eq '@' ) {
+		    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];
+		    }
+		}
+		elsif ( $dsttype eq '%' ) {
+		    if ( defined $userlinkage->{$opt} ) {
+			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$userlinkage->{$opt}->{$key} = $arg;
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
+			    if $debug;
+			$userlinkage->{$opt} = {$key => $arg};
+		    }
+		}
+		else {
+		    if ( $incr ) {
+			print STDERR ("=> \$L{$opt} += \"$arg\"\n")
+			  if $debug;
+			if ( defined $userlinkage->{$opt} ) {
+			    $userlinkage->{$opt} += $arg;
+			}
+			else {
+			    $userlinkage->{$opt} = $arg;
+			}
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+			$userlinkage->{$opt} = $arg;
+		    }
+		}
+	    }
+	}
+
+	# Not an option. Save it if we $PERMUTE and don't have a <>.
+	elsif ( $order == $PERMUTE ) {
+	    # Try non-options call-back.
+	    my $cb;
+	    if ( (defined ($cb = $linkage{'<>'})) ) {
+		&$cb ($tryopt);
+	    }
+	    else {
+		print STDERR ("=> saving \"$tryopt\" ",
+			      "(not an option, may permute)\n") if $debug;
+		push (@ret, $tryopt);
+	    }
+	    next;
+	}
+
+	# ...otherwise, terminate.
+	else {
+	    # Push this one back and exit.
+	    unshift (@ARGV, $tryopt);
+	    return ($error == 0);
+	}
+
+    }
+
+    # Finish.
+    if ( $order == $PERMUTE ) {
+	#  Push back accumulated arguments
+	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
+	    if $debug && @ret > 0;
+	unshift (@ARGV, @ret) if @ret > 0;
+    }
+
+    return ($error == 0);
+}
+
+# Option lookup.
+sub FindOption ($$$$$$$) {
+
+    # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
+    # returns (0) otherwise.
+
+    my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
+    my $key;			# hash key for a hash option
+    my $arg;
+
+    print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
+
+    return (0) unless $opt =~ /^$prefix(.*)$/s;
+
+    $opt = $+;
+    my ($starter) = $1;
+
+    print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
+
+    my $optarg = undef;	# value supplied with --opt=value
+    my $rest = undef;	# remainder from unbundling
+
+    # If it is a long option, it may include the value.
+    if (($starter eq "--" || ($getopt_compat && !$bundling))
+	&& $opt =~ /^([^=]+)=(.*)$/s ) {
+	$opt = $1;
+	$optarg = $2;
+	print STDERR ("=> option \"", $opt, 
+		      "\", optarg = \"$optarg\"\n") if $debug;
+    }
+
+    #### Look it up ###
+
+    my $tryopt = $opt;		# option to try
+    my $optbl = $opctl;		# table to look it up (long names)
+    my $type;
+    my $dsttype = '';
+    my $incr = 0;
+
+    if ( $bundling && $starter eq '-' ) {
+	# Unbundle single letter option.
+	$rest = substr ($tryopt, 1);
+	$tryopt = substr ($tryopt, 0, 1);
+	$tryopt = lc ($tryopt) if $ignorecase > 1;
+	print STDERR ("=> $starter$tryopt unbundled from ",
+		      "$starter$tryopt$rest\n") if $debug;
+	$rest = undef unless $rest ne '';
+	$optbl = $bopctl;	# look it up in the short names table
+
+	# If bundling == 2, long options can override bundles.
+	if ( $bundling == 2 and
+	     defined ($type = $opctl->{$tryopt.$rest}) ) {
+	    print STDERR ("=> $starter$tryopt rebundled to ",
+			  "$starter$tryopt$rest\n") if $debug;
+	    $tryopt .= $rest;
+	    undef $rest;
+	}
+    } 
+
+    # Try auto-abbreviation.
+    elsif ( $autoabbrev ) {
+	# Downcase if allowed.
+	$tryopt = $opt = lc ($opt) if $ignorecase;
+	# Turn option name into pattern.
+	my $pat = quotemeta ($opt);
+	# Look up in option names.
+	my @hits = grep (/^$pat/, @{$names});
+	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
+		      "out of ", scalar(@{$names}), "\n") if $debug;
+
+	# Check for ambiguous results.
+	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
+	    # See if all matches are for the same option.
+	    my %hit;
+	    foreach ( @hits ) {
+		$_ = $aliases->{$_} if defined $aliases->{$_};
+		$hit{$_} = 1;
+	    }
+	    # Now see if it really is ambiguous.
+	    unless ( keys(%hit) == 1 ) {
+		return (0) if $passthrough;
+		warn ("Option ", $opt, " is ambiguous (",
+		      join(", ", @hits), ")\n");
+		$error++;
+		undef $opt;
+		return (1, $opt,$arg,$dsttype,$incr,$key);
+	    }
+	    @hits = keys(%hit);
+	}
+
+	# Complete the option name, if appropriate.
+	if ( @hits == 1 && $hits[0] ne $opt ) {
+	    $tryopt = $hits[0];
+	    $tryopt = lc ($tryopt) if $ignorecase;
+	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
+		if $debug;
+	}
+    }
+
+    # Map to all lowercase if ignoring case.
+    elsif ( $ignorecase ) {
+	$tryopt = lc ($opt);
+    }
+
+    # Check validity by fetching the info.
+    $type = $optbl->{$tryopt} unless defined $type;
+    unless  ( defined $type ) {
+	return (0) if $passthrough;
+	warn ("Unknown option: ", $opt, "\n");
+	$error++;
+	return (1, $opt,$arg,$dsttype,$incr,$key);
+    }
+    # Apparently valid.
+    $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 '!' || $type eq '+' ) {
+	if ( defined $optarg ) {
+	    return (0) if $passthrough;
+	    warn ("Option ", $opt, " does not take an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	elsif ( $type eq '' || $type eq '+' ) {
+	    $arg = 1;		# supply explicit value
+	    $incr = $type eq '+';
+	}
+	else {
+	    substr ($opt, 0, 2) = ''; # strip NO prefix
+	    $arg = 0;		# supply explicit value
+	}
+	unshift (@ARGV, $starter.$rest) if defined $rest;
+	return (1, $opt,$arg,$dsttype,$incr,$key);
+    }
+
+    # Get mandatory status and type info.
+    my $mand;
+    ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
+
+    # Check if there is an option argument available.
+    if ( defined $optarg ? ($optarg eq '') 
+	 : !(defined $rest || @ARGV > 0) ) {
+	# Complain if this option needs an argument.
+	if ( $mand eq "=" ) {
+	    return (0) if $passthrough;
+	    warn ("Option ", $opt, " requires an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	if ( $mand eq ":" ) {
+	    $arg = $type eq "s" ? '' : 0;
+	}
+	return (1, $opt,$arg,$dsttype,$incr,$key);
+    }
+
+    # Get (possibly optional) argument.
+    $arg = (defined $rest ? $rest
+	    : (defined $optarg ? $optarg : shift (@ARGV)));
+
+    # Get key if this is a "name=value" pair for a hash option.
+    $key = undef;
+    if ($dsttype eq '%' && defined $arg) {
+	($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
+    }
+
+    #### Check if the argument is valid for this option ####
+
+    if ( $type eq "s" ) {	# string
+	# A mandatory string takes anything. 
+	return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
+
+	# An optional string takes almost anything. 
+	return (1, $opt,$arg,$dsttype,$incr,$key) 
+	  if defined $optarg || defined $rest;
+	return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
+
+	# Check for option or option list terminator.
+	if ($arg eq $argend ||
+	    $arg =~ /^$prefix.+/) {
+	    # Push back.
+	    unshift (@ARGV, $arg);
+	    # Supply empty value.
+	    $arg = '';
+	}
+    }
+
+    elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
+	    $arg = $1;
+	    $rest = $2;
+	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg !~ /^-?[0-9]+$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		if ( $passthrough ) {
+		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
+		      unless defined $optarg;
+		    return (0);
+		}
+		warn ("Value \"", $arg, "\" invalid for option ",
+		      $opt, " (number expected)\n");
+		$error++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
+	    }
+	    else {
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0;
+	    }
+	}
+    }
+
+    elsif ( $type eq "f" ) { # real number, int is also ok
+	# We require at least one digit before a point or 'e',
+	# and at least one digit following the point and 'e'.
+	# [-]NN[.NN][eNN]
+	if ( $bundling && defined $rest &&
+	     $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
+	    $arg = $1;
+	    $rest = $+;
+	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		if ( $passthrough ) {
+		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
+		      unless defined $optarg;
+		    return (0);
+		}
+		warn ("Value \"", $arg, "\" invalid for option ",
+		      $opt, " (real number expected)\n");
+		$error++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
+	    }
+	    else {
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0.0;
+	    }
+	}
+    }
+    else {
+	Croak ("GetOpt::Long internal error (Can't happen)\n");
+    }
+    return (1, $opt, $arg, $dsttype, $incr, $key);
+}
+
+# Getopt::Long Configuration.
+sub Configure (@) {
+    my (@options) = @_;
+    my $opt;
+    foreach $opt ( @options ) {
+	my $try = lc ($opt);
+	my $action = 1;
+	if ( $try =~ /^no_?(.*)$/s ) {
+	    $action = 0;
+	    $try = $+;
+	}
+	if ( $try eq 'default' or $try eq 'defaults' ) {
+	    ConfigDefaults () if $action;
+	}
+	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+	    $autoabbrev = $action;
+	}
+	elsif ( $try eq 'getopt_compat' ) {
+	    $getopt_compat = $action;
+	}
+	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+	    $ignorecase = $action;
+	}
+	elsif ( $try eq 'ignore_case_always' ) {
+	    $ignorecase = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'bundling' ) {
+	    $bundling = $action;
+	}
+	elsif ( $try eq 'bundling_override' ) {
+	    $bundling = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'require_order' ) {
+	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+	}
+	elsif ( $try eq 'permute' ) {
+	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+	}
+	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+	    $passthrough = $action;
+	}
+	elsif ( $try =~ /^prefix=(.+)$/ ) {
+	    $genprefix = $1;
+	    # Turn into regexp. Needs to be parenthesized!
+	    $genprefix = "(" . quotemeta($genprefix) . ")";
+	    eval { '' =~ /$genprefix/; };
+	    Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+	}
+	elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
+	    $genprefix = $1;
+	    # Parenthesize if needed.
+	    $genprefix = "(" . $genprefix . ")" 
+	      unless $genprefix =~ /^\(.*\)$/;
+	    eval { '' =~ /$genprefix/; };
+	    Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+	}
+	elsif ( $try eq 'debug' ) {
+	    $debug = $action;
+	}
+	else {
+	    Croak ("Getopt::Long: unknown config parameter \"$opt\"")
+	}
+    }
+}
+
+# Deprecated name.
+sub config (@) {
+    Configure (@_);
+}
+
+# To prevent Carp from being loaded unnecessarily.
+sub Croak (@) {
+    require 'Carp.pm';
+    $Carp::CarpLevel = 1;
+    Carp::croak(@_);
+};
+
+################ Documentation ################
+
+=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 "--". Support for bundling of command line options, as was
+the case with the more traditional single-letter approach, is provided
+but not enabled by default. 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, or an object whose
+class is based on a HASH. 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.
+
+Options that do not take arguments will have no argument specifier. 
+The option variable will be set to 1 if the option is used.
+
+For the other options, the values for argument specifiers are:
+
+=over 8
+
+=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 +
+
+Option does not take an argument and will be incremented by 1 every
+time it appears on the command line. E.g. "more+", when used with
+B<--more --more --more>, will set the option variable to 3 (provided
+it was 0 or undefined at first).
+
+The B<+> specifier is ignored if the option destination is not a SCALAR.
+
+=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];
+
+For hash options (an option whose argument looks like "name=value"),
+a reference to a hash is used, e.g.:
+
+  %optctl = ();
+  GetOptions (\%optctl, "define=s%");
+
+with command line "--define foo=hello --define bar=world" will perform the
+equivalent of the assignment
+
+  $optctl{"define"} = {foo=>'hello', bar=>'world')
+
+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, a reference to a hash or a reference to a subroutine.
+
+Note that, if your code is running under the recommended C<use strict
+'vars'> pragma, it may be helpful to declare these package variables
+via C<use vars> perhaps something like this:
+
+  use vars qw/ $opt_size @opt_sizes $opt_bar /;
+
+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 HASH is supplied, the option value should look like "key" or
+"key=value" (if the "=value" is omitted then a value of 1 is implied).
+In this case, the element of the referenced hash with the key "key"
+is assigned "value". 
+
+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
+of this option. If no linkage is specified, options "foo", "bar" and
+"blech" all will set $opt_foo. For convenience, the single character
+"?" is allowed as an alias, e.g. "help|?".
+
+Option names may be abbreviated to uniqueness, depending on
+configuration option B<auto_abbrev>.
+
+=head2 Non-option call-back routine
+
+A special option specifier, E<lt>E<gt>, 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 configuration option B<permute>, see section
+CONFIGURATION OPTIONS.
+
+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 values and Errors
+
+Configuration errors and errors in the option definitions are
+signalled using C<die()> and will terminate the calling
+program unless the call to C<Getopt::Long::GetOptions()> was embedded
+in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>.
+
+A return value of 1 (true) indicates success.
+
+A return status of 0 (false) indicates that the function detected one
+or more errors during option parsing. These errors are signalled using
+C<warn()> and can be trapped with C<$SIG{__WARN__}>.
+
+Errors that can't happen are signalled using C<Carp::croak()>.
+
+=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. If explicit linkage is supplied, this must be a reference
+to an ARRAY.
+
+If an "%" sign is appended to the argument specifier, the option is
+treated as a hash. Value(s) of the form "name=value" are set by
+setting the element of the hash %opt_name with key "name" to "value"
+(if the "=value" portion is omitted it defaults to 1). If explicit
+linkage is supplied, this must be a reference to a HASH.
+
+If configuration option B<getopt_compat> is set (see section
+CONFIGURATION OPTIONS), options that start with "+" or "-" 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 variable 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:
+
+   $foo = 'blech'
+   $opt_bar = 24
+   @ar = ('xx','yy')
+
+Example of using the E<lt>E<gt> 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 OPTIONS
+
+B<GetOptions> can be configured by calling subroutine
+B<Getopt::Long::Configure>. This subroutine takes a list of quoted
+strings, each specifying a configuration option to be set, e.g.
+B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
+B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
+are possible.
+
+Previous versions of Getopt::Long used variables for the purpose of
+configuring. Although manipulating these variables still work, it
+is strongly encouraged to use the new B<config> routine. Besides, it
+is much easier.
+
+The following options are available:
+
+=over 12
+
+=item default
+
+This option causes all configuration options to be reset to their
+default values.
+
+=item auto_abbrev
+
+Allow option names to be abbreviated to uniqueness.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
+
+=item getopt_compat   
+
+Allow '+' to start options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
+
+=item require_order
+
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
+
+See also B<permute>, which is the opposite of B<require_order>.
+
+=item permute
+
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<permute> is reset.
+Note that B<permute> is the opposite of B<require_order>.
+
+If B<permute> is set, this 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 B<require_order> is set, options processing
+terminates when the first non-option is encountered.
+
+    -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+    -foo -- arg1 -bar arg2 arg3
+
+=item bundling (default: reset)
+
+Setting this variable to a non-zero value will allow single-character
+options to be bundled. To distinguish bundles from long option names,
+long options must be introduced with B<--> and single-character
+options (and bundles) with B<->. For example,
+
+    ps -vax --vax
+
+would be equivalent to
+
+    ps -v -a -x --vax
+
+provided "vax", "v", "a" and "x" have been defined to be valid
+options. 
+
+Bundled options can also include a value in the bundle; for strings
+this value is the rest of the bundle, but integer and floating values
+may be combined in the bundle, e.g.
+
+    scale -h24w80
+
+is equivalent to
+
+    scale -h 24 -w 80
+
+Note: resetting B<bundling> also resets B<bundling_override>.
+
+=item bundling_override (default: reset)
+
+If B<bundling_override> is set, bundling is enabled as with
+B<bundling> but now long option names override option bundles. In the
+above example, B<-vax> would be interpreted as the option "vax", not
+the bundle "v", "a", "x".
+
+Note: resetting B<bundling_override> also resets B<bundling>.
+
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
+
+=item ignore_case  (default: set)
+
+If set, case is ignored when matching options.
+
+Note: resetting B<ignore_case> also resets B<ignore_case_always>.
+
+=item ignore_case_always (default: reset)
+
+When bundling is in effect, case is ignored on single-character
+options also. 
+
+Note: resetting B<ignore_case_always> also resets B<ignore_case>.
+
+=item pass_through (default: reset)
+
+Unknown options are passed through in @ARGV instead of being flagged
+as errors. This makes it possible to write wrapper scripts that
+process only part of the user supplied options, and passes the
+remaining options to some other program.
+
+This can be very confusing, especially when B<permute> is also set.
+
+=item prefix
+
+The string that starts options. See also B<prefix_pattern>.
+
+=item prefix_pattern
+
+A Perl pattern that identifies the strings that introduce options.
+Default is C<(--|-|\+)> unless environment variable
+POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
+
+=item debug (default: reset)
+
+Enable copious debugging output.
+
+=back
+
+=head1 OTHER USEFUL VARIABLES
+
+=over 12
+
+=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 3.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.
+
+=back
+
+=head1 AUTHOR
+
+Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+This program is Copyright 1990,1998 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.
+
+=cut
diff --git a/contrib/perl5/lib/Getopt/Std.pm b/contrib/perl5/lib/Getopt/Std.pm
new file mode 100644
index 000000000000..c2cd1234f4cf
--- /dev/null
+++ b/contrib/perl5/lib/Getopt/Std.pm
@@ -0,0 +1,166 @@
+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.
+    getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
+    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
+		      # Sets opt_* as a side effect.
+    getopts('oif:', \%opts);  # options as above. Values in %opts
+
+=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.
+
+Note that, if your code is running under the recommended C<use strict
+'vars'> pragma, it may be helpful to declare these package variables
+via C<use vars> perhaps something like this:
+
+    use vars qw/ $opt_foo $opt_bar /;
+
+For those of you who don't like additional variables being created, getopt()
+and getopts() will also accept a hash reference as an optional second argument. 
+Hash keys will be x (where x is the switch name) with key values the value of
+the argument or 1 if no argument is specified.
+
+=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, $hash) = @_;
+    local($_,$first,$rest);
+    local @EXPORT;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	if (index($argumentative,$first) >= 0) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+          if (ref $hash) {
+              $$hash{$first} = $rest;
+          }
+          else {
+              ${"opt_$first"} = $rest;
+              push( @EXPORT, "\$opt_$first" );
+          }
+	}
+	else {
+          if (ref $hash) {
+              $$hash{$first} = 1;
+          }
+          else {
+              ${"opt_$first"} = 1;
+              push( @EXPORT, "\$opt_$first" );
+          }
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    unless (ref $hash) { 
+	local $Exporter::ExportLevel = 1;
+	import Getopt::Std;
+    }
+}
+
+# Usage:
+#   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
+#			#  side effect.
+
+sub getopts ($;$) {
+    local($argumentative, $hash) = @_;
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local @EXPORT;
+
+    @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);
+		}
+              if (ref $hash) {
+                  $$hash{$first} = $rest;
+              }
+              else {
+                  ${"opt_$first"} = $rest;
+                  push( @EXPORT, "\$opt_$first" );
+              }
+	    }
+	    else {
+              if (ref $hash) {
+                  $$hash{$first} = 1;
+              }
+              else {
+                  ${"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);
+	    }
+	}
+    }
+    unless (ref $hash) { 
+	local $Exporter::ExportLevel = 1;
+	import Getopt::Std;
+    }
+    $errs == 0;
+}
+
+1;
+
diff --git a/contrib/perl5/lib/I18N/Collate.pm b/contrib/perl5/lib/I18N/Collate.pm
new file mode 100644
index 000000000000..580ca39785cd
--- /dev/null
+++ b/contrib/perl5/lib/I18N/Collate.pm
@@ -0,0 +1,189 @@
+package I18N::Collate;
+
+=head1 NAME
+
+I18N::Collate - compare 8-bit scalar data according to the current locale
+
+  ***
+
+  WARNING: starting from the Perl version 5.003_06
+  the I18N::Collate interface for comparing 8-bit scalar data
+  according to the current locale
+
+	HAS BEEN DEPRECATED
+
+  That is, please do not use it anymore for any new applications
+  and please migrate the old applications away from it because its
+  functionality was integrated into the Perl core language in the
+  release 5.003_06.
+
+  See the perllocale manual page for further information.
+
+  ***
+
+=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 module 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.
+
+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> or
+C<ls /usr/lib/locale>.  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 <F<jhi@iki.fi>>
+#		Helsinki University of Technology, Finland
+#
+# Acks:		Guy Decoux <F<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:	19961005
+#
+# ---
+
+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];
+
+  if ($^W && $] >= 5.003_06) {
+    unless ($please_use_I18N_Collate_even_if_deprecated) {
+      warn <<___EOD___;
+***
+
+  WARNING: starting from the Perl version 5.003_06
+  the I18N::Collate interface for comparing 8-bit scalar data
+  according to the current locale
+
+	HAS BEEN DEPRECATED
+
+  That is, please do not use it anymore for any new applications
+  and please migrate the old applications away from it because its
+  functionality was integrated into the Perl core language in the
+  release 5.003_06.
+
+  See the perllocale manual page for further information.
+
+***
+___EOD___
+      $please_use_I18N_Collate_even_if_deprecated++;
+    }
+  }
+
+  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/contrib/perl5/lib/IPC/Open2.pm b/contrib/perl5/lib/IPC/Open2.pm
new file mode 100644
index 000000000000..32282d62b39a
--- /dev/null
+++ b/contrib/perl5/lib/IPC/Open2.pm
@@ -0,0 +1,95 @@
+package IPC::Open2;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
+require 5.000;
+require Exporter;
+
+$VERSION	= 1.01;
+@ISA		= qw(Exporter);
+@EXPORT		= qw(open2);
+
+=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|");
+
+The write filehandle will have autoflush turned on.
+
+If $rdr is a string (that is, a bareword filehandle rather than a glob
+or a reference) and it begins with ">&", then the child will send output
+directly to that file handle.  If $wtr is a string that begins with
+"<&", then WTR will be closed in the parent, and the child will read
+from it directly.  In both cases, there will be a dup(2) instead of a
+pipe(2) made.
+
+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 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<IPC::Open3> for an alternative that handles STDERR as well.  This
+function is really just a wrapper around open3().
+
+=cut
+
+# &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
+# 	a system call fails
+
+require IPC::Open3;
+
+sub open2 {
+    my ($read, $write, @cmd) = @_;
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+    return IPC::Open3::_open3('open2', scalar caller,
+				$write, $read, '>&STDERR', @cmd);
+}
+
+1
diff --git a/contrib/perl5/lib/IPC/Open3.pm b/contrib/perl5/lib/IPC/Open3.pm
new file mode 100644
index 000000000000..f1415e3ad674
--- /dev/null
+++ b/contrib/perl5/lib/IPC/Open3.pm
@@ -0,0 +1,292 @@
+package IPC::Open3;
+
+use strict;
+no strict 'refs'; # because users pass me bareword filehandles
+use vars qw($VERSION @ISA @EXPORT $Fh $Me);
+
+require 5.001;
+require Exporter;
+
+use Carp;
+use Symbol 'qualify';
+
+$VERSION	= 1.0102;
+@ISA		= qw(Exporter);
+@EXPORT		= qw(open3);
+
+=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.  The WTRFH will have autoflush turned on.
+
+If WTRFH begins with "E<lt>&", then WTRFH will be closed in the parent, and
+the child will read from it directly.  If RDRFH or ERRFH begins with
+"E<gt>&", 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.
+
+open3() returns the process ID of the child process.  It doesn't return on
+failure: it just raises an exception matching C</^open3:/>.
+
+=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 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.
+
+=cut
+
+# &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>
+# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
+#
+# $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 dies 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
+#   a system call fails
+
+$Fh = 'FHOPEN000';	# package static in case called more than once
+$Me = 'open3 (bug)';	# you should never see this, it's always localized
+
+# Fatal.pm needs to be fixed WRT prototypes.
+
+sub xfork {
+    my $pid = fork;
+    defined $pid or croak "$Me: fork failed: $!";
+    return $pid;
+}
+
+sub xpipe {
+    pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
+}
+
+# I tried using a * prototype character for the filehandle but it still
+# disallows a bearword while compiling under strict subs.
+
+sub xopen {
+    open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
+}
+
+sub xclose {
+    close $_[0] or croak "$Me: close($_[0]) failed: $!";
+}
+
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
+
+sub _open3 {
+    local $Me = shift;
+    my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
+
+    $dad_wtr			or croak "$Me: wtr should not be null";
+    $dad_rdr			or croak "$Me: 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
+    $dad_wtr = qualify $dad_wtr, $package;
+    $dad_rdr = qualify $dad_rdr, $package;
+    $dad_err = qualify $dad_err, $package;
+
+    my $kid_rdr = ++$Fh;
+    my $kid_wtr = ++$Fh;
+    my $kid_err = ++$Fh;
+
+    xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
+    xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
+    xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
+
+    $kidpid = $do_spawn ? -1 : xfork;
+    if ($kidpid == 0) {		# Kid
+	# If she wants to dup the kid's stderr onto her stdout I need to
+	# save a copy of her stdout before I put something else there.
+	if ($dad_rdr ne $dad_err && $dup_err
+		&& fileno($dad_err) == fileno(STDOUT)) {
+	    my $tmp = ++$Fh;
+	    xopen($tmp, ">&$dad_err");
+	    $dad_err = $tmp;
+	}
+
+	if ($dup_wtr) {
+	    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
+	} else {
+	    xclose $dad_wtr;
+	    xopen \*STDIN,  "<&$kid_rdr";
+	    xclose $kid_rdr;
+	}
+	if ($dup_rdr) {
+	    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
+	} else {
+	    xclose $dad_rdr;
+	    xopen \*STDOUT, ">&$kid_wtr";
+	    xclose $kid_wtr;
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+		xopen \*STDERR, ">&$dad_err"
+		    if fileno(STDERR) != fileno($dad_err);
+	    } else {
+		xclose $dad_err;
+		xopen \*STDERR, ">&$kid_err";
+		xclose $kid_err;
+	    }
+	} else {
+	    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
+	}
+	local($")=(" ");
+	exec @cmd
+	    or croak "$Me: exec of @cmd failed";
+    } elsif ($do_spawn) {
+	# All the bookkeeping of coincidence between handles is
+	# handled in spawn_with_handles.
+
+	my @close;
+	if ($dup_wtr) {
+	  $kid_rdr = $dad_wtr;
+	  push @close, \*{$kid_rdr};
+	} else {
+	  push @close, \*{$dad_wtr}, \*{$kid_rdr};
+	}
+	if ($dup_rdr) {
+	  $kid_wtr = $dad_rdr;
+	  push @close, \*{$kid_wtr};
+	} else {
+	  push @close, \*{$dad_rdr}, \*{$kid_wtr};
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+	      $kid_err = $dad_err ;
+	      push @close, \*{$kid_err};
+	    } else {
+	      push @close, \*{$dad_err}, \*{$kid_err};
+	    }
+	} else {
+	  $kid_err = $kid_wtr;
+	}
+	require IO::Pipe;
+	$kidpid = eval {
+	    spawn_with_handles( [ { mode => 'r',
+				    open_as => \*{$kid_rdr},
+				    handle => \*STDIN },
+				  { mode => 'w',
+				    open_as => \*{$kid_wtr},
+				    handle => \*STDOUT },
+				  { mode => 'w',
+				    open_as => \*{$kid_err},
+				    handle => \*STDERR },
+				], \@close, @cmd);
+	};
+	die "$Me: $@" if $@;
+    }
+
+    xclose $kid_rdr if !$dup_wtr;
+    xclose $kid_wtr if !$dup_rdr;
+    xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err;
+    # If the write handle is a dup give it away entirely, close my copy
+    # of it.
+    xclose $dad_wtr if $dup_wtr;
+
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+
+sub open3 {
+    if (@_ < 4) {
+	local $" = ', ';
+	croak "open3(@_): not enough arguments";
+    }
+    return _open3 'open3', scalar caller, @_
+}
+
+sub spawn_with_handles {
+    my $fds = shift;		# Fields: handle, mode, open_as
+    my $close_in_child = shift;
+    my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
+    require Fcntl;
+
+    foreach $fd (@$fds) {
+	$fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
+	$saved{fileno $fd->{handle}} = $fd->{tmp_copy};
+    }
+    foreach $fd (@$fds) {
+	bless $fd->{handle}, 'IO::Handle'
+	    unless eval { $fd->{handle}->isa('IO::Handle') } ;
+	# If some of handles to redirect-to coincide with handles to
+	# redirect, we need to use saved variants:
+	$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
+			      $fd->{mode});
+    }
+    unless ($^O eq 'MSWin32') {
+	# Stderr may be redirected below, so we save the err text:
+	foreach $fd (@$close_in_child) {
+	    fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
+		unless $saved{fileno $fd}; # Do not close what we redirect!
+	}
+    }
+
+    unless (@errs) {
+	$pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+	push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
+    }
+
+    foreach $fd (@$fds) {
+	$fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
+	$fd->{tmp_copy}->close or croak "Can't close: $!";
+    }
+    croak join "\n", @errs if @errs;
+    return $pid;
+}
+
+1; # so require is happy
diff --git a/contrib/perl5/lib/Math/BigFloat.pm b/contrib/perl5/lib/Math/BigFloat.pm
new file mode 100644
index 000000000000..576f3410c78b
--- /dev/null
+++ b/contrib/perl5/lib/Math/BigFloat.pm
@@ -0,0 +1,327 @@
+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]};
+
+    my $minus = ($n =~ s/^([+-])// && $1 eq '-');
+    $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;
+    }
+    $n = "-$n" if $minus;
+
+    # 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::BigFloat;
+  $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/contrib/perl5/lib/Math/BigInt.pm b/contrib/perl5/lib/Math/BigInt.pm
new file mode 100644
index 000000000000..ef4af613c31f
--- /dev/null
+++ b/contrib/perl5/lib/Math/BigInt.pm
@@ -0,0 +1,415 @@
+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
+sub import {
+  shift;
+  return unless @_;
+  die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+  overload::constant integer => sub {Math::BigInt->new(shift)};
+}
+
+$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(@_);
+    return $_ if $_ eq '+0' or $_ eq 'NaN';
+    vec($_,0,8) ^= ord('+') ^ ord('-');
+    $_;
+}
+
+# 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) <=> 0;
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    
+    return 0 if ($cx eq $cy);
+
+    local($sx, $sy) = (substr($cx, 0, 1), substr($cy, 0, 1));
+    local($ld);
+
+    if ($sx eq '+') {
+      return  1 if ($sy eq '-' || $cy eq '+0');
+      $ld = length($cx) - length($cy);
+      return $ld if ($ld);
+      return $cx cmp $cy;
+    } else { # $sx eq '-'
+      return -1 if ($sy eq '+');
+      $ld = length($cy) - length($cx);
+      return $ld if ($ld);
+      return $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 += (@y ? shift(@y) : 0) + $car) >= 1e5) ? 1 : 0;
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
+    }
+    (@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 @sy || $bar;
+	$sx += 1e5 if $bar = (($sx -= (@sy ? shift(@sy) : 0) + $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] || 0) + $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 Autocreating constants
+
+After C<use Math::BigInt ':constant'> all the integer decimal constants
+in the given scope are converted to C<Math::BigInt>.  This conversion
+happens at compile time.
+
+In particular
+
+  perl -MMath::BigInt=:constant -e 'print 2**100'
+
+print the integer value of C<2**100>.  Note that without convertion of 
+constants the expression 2**100 will be calculatted as floating point number.
+
+=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/contrib/perl5/lib/Math/Complex.pm b/contrib/perl5/lib/Math/Complex.pm
new file mode 100644
index 000000000000..e711c1483d9e
--- /dev/null
+++ b/contrib/perl5/lib/Math/Complex.pm
@@ -0,0 +1,1775 @@
+#
+# Complex numbers and associated mathematical functions
+# -- Raphael Manfredi	Since Sep 1996
+# -- Jarkko Hietaniemi	Since Mar 1997
+# -- Daniel S. Lewart	Since Sep 1997
+#
+
+require Exporter;
+package Math::Complex;
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
+
+my ( $i, $ip2, %logn );
+
+$VERSION = sprintf("%s", q$Id: Complex.pm,v 1.25 1998/02/05 16:07:37 jhi Exp $ =~ /(\d+\.\d+)/);
+
+@ISA = qw(Exporter);
+
+my @trig = qw(
+	      pi
+	      tan
+	      csc cosec sec cot cotan
+	      asin acos atan
+	      acsc acosec asec acot acotan
+	      sinh cosh tanh
+	      csch cosech sech coth cotanh
+	      asinh acosh atanh
+	      acsch acosech asech acoth acotanh
+	     );
+
+@EXPORT = (qw(
+	     i Re Im rho theta arg
+	     sqrt log ln
+	     log10 logn cbrt root
+	     cplx cplxe
+	     ),
+	   @trig);
+
+%EXPORT_TAGS = (
+    'trig' => [@trig],
+);
+
+use overload
+	'+'	=> \&plus,
+	'-'	=> \&minus,
+	'*'	=> \&multiply,
+	'/'	=> \&divide,
+	'**'	=> \&power,
+	'<=>'	=> \&spaceship,
+	'neg'	=> \&negate,
+	'~'	=> \&conjugate,
+	'abs'	=> \&abs,
+	'sqrt'	=> \&sqrt,
+	'exp'	=> \&exp,
+	'log'	=> \&log,
+	'sin'	=> \&sin,
+	'cos'	=> \&cos,
+	'tan'	=> \&tan,
+	'atan2'	=> \&atan2,
+	qw("" stringify);
+
+#
+# Package "privates"
+#
+
+my $package = 'Math::Complex';		# Package name
+my $display = 'cartesian';		# Default display format
+my $eps     = 1e-14;			# Epsilon
+
+#
+# Object attributes (internal):
+#	cartesian	[real, imaginary] -- cartesian form
+#	polar		[rho, theta] -- polar form
+#	c_dirty		cartesian form not up-to-date
+#	p_dirty		polar form not up-to-date
+#	display		display format (package's global when not set)
+#
+
+# Die on bad *make() arguments.
+
+sub _cannot_make {
+    die "@{[(caller(1))[3]]}: Cannot take $_[0] of $_[1].\n";
+}
+
+#
+# ->make
+#
+# Create a new complex number (cartesian form)
+#
+sub make {
+	my $self = bless {}, shift;
+	my ($re, $im) = @_;
+	my $rre = ref $re;
+	if ( $rre ) {
+	    if ( $rre eq ref $self ) {
+		$re = Re($re);
+	    } else {
+		_cannot_make("real part", $rre);
+	    }
+	}
+	my $rim = ref $im;
+	if ( $rim ) {
+	    if ( $rim eq ref $self ) {
+		$im = Im($im);
+	    } else {
+		_cannot_make("imaginary part", $rim);
+	    }
+	}
+	$self->{'cartesian'} = [ $re, $im ];
+	$self->{c_dirty} = 0;
+	$self->{p_dirty} = 1;
+	$self->display_format('cartesian');
+	return $self;
+}
+
+#
+# ->emake
+#
+# Create a new complex number (exponential form)
+#
+sub emake {
+	my $self = bless {}, shift;
+	my ($rho, $theta) = @_;
+	my $rrh = ref $rho;
+	if ( $rrh ) {
+	    if ( $rrh eq ref $self ) {
+		$rho = rho($rho);
+	    } else {
+		_cannot_make("rho", $rrh);
+	    }
+	}
+	my $rth = ref $theta;
+	if ( $rth ) {
+	    if ( $rth eq ref $self ) {
+		$theta = theta($theta);
+	    } else {
+		_cannot_make("theta", $rth);
+	    }
+	}
+	if ($rho < 0) {
+	    $rho   = -$rho;
+	    $theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
+	}
+	$self->{'polar'} = [$rho, $theta];
+	$self->{p_dirty} = 0;
+	$self->{c_dirty} = 1;
+	$self->display_format('polar');
+	return $self;
+}
+
+sub new { &make }		# For backward compatibility only.
+
+#
+# cplx
+#
+# Creates a complex number from a (re, im) tuple.
+# This avoids the burden of writing Math::Complex->make(re, im).
+#
+sub cplx {
+	my ($re, $im) = @_;
+	return $package->make($re, defined $im ? $im : 0);
+}
+
+#
+# cplxe
+#
+# Creates a complex number from a (rho, theta) tuple.
+# This avoids the burden of writing Math::Complex->emake(rho, theta).
+#
+sub cplxe {
+	my ($rho, $theta) = @_;
+	return $package->emake($rho, defined $theta ? $theta : 0);
+}
+
+#
+# pi
+#
+# The number defined as pi = 180 degrees
+#
+use constant pi => 4 * CORE::atan2(1, 1);
+
+#
+# pit2
+#
+# The full circle
+#
+use constant pit2 => 2 * pi;
+
+#
+# pip2
+#
+# The quarter circle
+#
+use constant pip2 => pi / 2;
+
+#
+# deg1
+#
+# One degree in radians, used in stringify_polar.
+#
+
+use constant deg1 => pi / 180;
+
+#
+# uplog10
+#
+# Used in log10().
+#
+use constant uplog10 => 1 / CORE::log(10);
+
+#
+# i
+#
+# The number defined as i*i = -1;
+#
+sub i () {
+        return $i if ($i);
+	$i = bless {};
+	$i->{'cartesian'} = [0, 1];
+	$i->{'polar'}     = [1, pip2];
+	$i->{c_dirty} = 0;
+	$i->{p_dirty} = 0;
+	return $i;
+}
+
+#
+# Attribute access/set routines
+#
+
+sub cartesian {$_[0]->{c_dirty} ?
+		   $_[0]->update_cartesian : $_[0]->{'cartesian'}}
+sub polar     {$_[0]->{p_dirty} ?
+		   $_[0]->update_polar : $_[0]->{'polar'}}
+
+sub set_cartesian { $_[0]->{p_dirty}++; $_[0]->{'cartesian'} = $_[1] }
+sub set_polar     { $_[0]->{c_dirty}++; $_[0]->{'polar'} = $_[1] }
+
+#
+# ->update_cartesian
+#
+# Recompute and return the cartesian form, given accurate polar form.
+#
+sub update_cartesian {
+	my $self = shift;
+	my ($r, $t) = @{$self->{'polar'}};
+	$self->{c_dirty} = 0;
+	return $self->{'cartesian'} = [$r * CORE::cos($t), $r * CORE::sin($t)];
+}
+
+#
+#
+# ->update_polar
+#
+# Recompute and return the polar form, given accurate cartesian form.
+#
+sub update_polar {
+	my $self = shift;
+	my ($x, $y) = @{$self->{'cartesian'}};
+	$self->{p_dirty} = 0;
+	return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0;
+	return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y), CORE::atan2($y, $x)];
+}
+
+#
+# (plus)
+#
+# Computes z1+z2.
+#
+sub plus {
+	my ($z1, $z2, $regular) = @_;
+	my ($re1, $im1) = @{$z1->cartesian};
+	$z2 = cplx($z2) unless ref $z2;
+	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	unless (defined $regular) {
+		$z1->set_cartesian([$re1 + $re2, $im1 + $im2]);
+		return $z1;
+	}
+	return (ref $z1)->make($re1 + $re2, $im1 + $im2);
+}
+
+#
+# (minus)
+#
+# Computes z1-z2.
+#
+sub minus {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1) = @{$z1->cartesian};
+	$z2 = cplx($z2) unless ref $z2;
+	my ($re2, $im2) = @{$z2->cartesian};
+	unless (defined $inverted) {
+		$z1->set_cartesian([$re1 - $re2, $im1 - $im2]);
+		return $z1;
+	}
+	return $inverted ?
+		(ref $z1)->make($re2 - $re1, $im2 - $im1) :
+		(ref $z1)->make($re1 - $re2, $im1 - $im2);
+
+}
+
+#
+# (multiply)
+#
+# Computes z1*z2.
+#
+sub multiply {
+        my ($z1, $z2, $regular) = @_;
+	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
+	    # if both polar better use polar to avoid rounding errors
+	    my ($r1, $t1) = @{$z1->polar};
+	    my ($r2, $t2) = @{$z2->polar};
+	    my $t = $t1 + $t2;
+	    if    ($t >   pi()) { $t -= pit2 }
+	    elsif ($t <= -pi()) { $t += pit2 }
+	    unless (defined $regular) {
+		$z1->set_polar([$r1 * $r2, $t]);
+		return $z1;
+	    }
+	    return (ref $z1)->emake($r1 * $r2, $t);
+	} else {
+	    my ($x1, $y1) = @{$z1->cartesian};
+	    if (ref $z2) {
+		my ($x2, $y2) = @{$z2->cartesian};
+		return (ref $z1)->make($x1*$x2-$y1*$y2, $x1*$y2+$y1*$x2);
+	    } else {
+		return (ref $z1)->make($x1*$z2, $y1*$z2);
+	    }
+	}
+}
+
+#
+# _divbyzero
+#
+# Die on division by zero.
+#
+sub _divbyzero {
+    my $mess = "$_[0]: Division by zero.\n";
+
+    if (defined $_[1]) {
+	$mess .= "(Because in the definition of $_[0], the divisor ";
+	$mess .= "$_[1] " unless ($_[1] eq '0');
+	$mess .= "is 0)\n";
+    }
+
+    my @up = caller(1);
+
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# (divide)
+#
+# Computes z1/z2.
+#
+sub divide {
+	my ($z1, $z2, $inverted) = @_;
+	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
+	    # if both polar better use polar to avoid rounding errors
+	    my ($r1, $t1) = @{$z1->polar};
+	    my ($r2, $t2) = @{$z2->polar};
+	    my $t;
+	    if ($inverted) {
+		_divbyzero "$z2/0" if ($r1 == 0);
+		$t = $t2 - $t1;
+		if    ($t >   pi()) { $t -= pit2 }
+		elsif ($t <= -pi()) { $t += pit2 }
+		return (ref $z1)->emake($r2 / $r1, $t);
+	    } else {
+		_divbyzero "$z1/0" if ($r2 == 0);
+		$t = $t1 - $t2;
+		if    ($t >   pi()) { $t -= pit2 }
+		elsif ($t <= -pi()) { $t += pit2 }
+		return (ref $z1)->emake($r1 / $r2, $t);
+	    }
+	} else {
+	    my ($d, $x2, $y2);
+	    if ($inverted) {
+		($x2, $y2) = @{$z1->cartesian};
+		$d = $x2*$x2 + $y2*$y2;
+		_divbyzero "$z2/0" if $d == 0;
+		return (ref $z1)->make(($x2*$z2)/$d, -($y2*$z2)/$d);
+	    } else {
+		my ($x1, $y1) = @{$z1->cartesian};
+		if (ref $z2) {
+		    ($x2, $y2) = @{$z2->cartesian};
+		    $d = $x2*$x2 + $y2*$y2;
+		    _divbyzero "$z1/0" if $d == 0;
+		    my $u = ($x1*$x2 + $y1*$y2)/$d;
+		    my $v = ($y1*$x2 - $x1*$y2)/$d;
+		    return (ref $z1)->make($u, $v);
+		} else {
+		    _divbyzero "$z1/0" if $z2 == 0;
+		    return (ref $z1)->make($x1/$z2, $y1/$z2);
+		}
+	    }
+	}
+}
+
+#
+# _zerotozero
+#
+# Die on zero raised to the zeroth.
+#
+sub _zerotozero {
+    my $mess = "The zero raised to the zeroth power is not defined.\n";
+
+    my @up = caller(1);
+
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# (power)
+#
+# Computes z1**z2 = exp(z2 * log z1)).
+#
+sub power {
+	my ($z1, $z2, $inverted) = @_;
+	my $z1z = $z1 == 0;
+	my $z2z = $z2 == 0;
+	_zerotozero if ($z1z and $z2z);
+	if ($inverted) {
+	    return 0 if ($z2z);
+	    return 1 if ($z1z or $z2 == 1);
+	} else {
+	    return 0 if ($z1z);
+	    return 1 if ($z2z or $z1 == 1);
+	}
+	my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) : CORE::exp($z2 * CORE::log($z1));
+	# If both arguments cartesian, return cartesian, else polar.
+	return $z1->{c_dirty} == 0 &&
+	       (not ref $z2 or $z2->{c_dirty} == 0) ?
+	       cplx(@{$w->cartesian}) : $w;
+}
+
+#
+# (spaceship)
+#
+# Computes z1 <=> z2.
+# Sorts on the real part first, then on the imaginary part. Thus 2-4i > 3+8i.
+#
+sub spaceship {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	my $sgn = $inverted ? -1 : 1;
+	return $sgn * ($re1 <=> $re2) if $re1 != $re2;
+	return $sgn * ($im1 <=> $im2);
+}
+
+#
+# (negate)
+#
+# Computes -z.
+#
+sub negate {
+	my ($z) = @_;
+	if ($z->{c_dirty}) {
+		my ($r, $t) = @{$z->polar};
+		$t = ($t <= 0) ? $t + pi : $t - pi;
+		return (ref $z)->emake($r, $t);
+	}
+	my ($re, $im) = @{$z->cartesian};
+	return (ref $z)->make(-$re, -$im);
+}
+
+#
+# (conjugate)
+#
+# Compute complex's conjugate.
+#
+sub conjugate {
+	my ($z) = @_;
+	if ($z->{c_dirty}) {
+		my ($r, $t) = @{$z->polar};
+		return (ref $z)->emake($r, -$t);
+	}
+	my ($re, $im) = @{$z->cartesian};
+	return (ref $z)->make($re, -$im);
+}
+
+#
+# (abs)
+#
+# Compute or set complex's norm (rho).
+#
+sub abs {
+	my ($z, $rho) = @_;
+	return $z unless ref $z;
+	if (defined $rho) {
+	    $z->{'polar'} = [ $rho, ${$z->polar}[1] ];
+	    $z->{p_dirty} = 0;
+	    $z->{c_dirty} = 1;
+	    return $rho;
+	} else {
+	    return ${$z->polar}[0];
+	}
+}
+
+sub _theta {
+    my $theta = $_[0];
+
+    if    ($$theta >   pi()) { $$theta -= pit2 }
+    elsif ($$theta <= -pi()) { $$theta += pit2 }
+}
+
+#
+# arg
+#
+# Compute or set complex's argument (theta).
+#
+sub arg {
+	my ($z, $theta) = @_;
+	return $z unless ref $z;
+	if (defined $theta) {
+	    _theta(\$theta);
+	    $z->{'polar'} = [ ${$z->polar}[0], $theta ];
+	    $z->{p_dirty} = 0;
+	    $z->{c_dirty} = 1;
+	} else {
+	    $theta = ${$z->polar}[1];
+	    _theta(\$theta);
+	}
+	return $theta;
+}
+
+#
+# (sqrt)
+#
+# Compute sqrt(z).
+#
+# It is quite tempting to use wantarray here so that in list context
+# sqrt() would return the two solutions.  This, however, would
+# break things like
+#
+#	print "sqrt(z) = ", sqrt($z), "\n";
+#
+# The two values would be printed side by side without no intervening
+# whitespace, quite confusing.
+# Therefore if you want the two solutions use the root().
+#
+sub sqrt {
+	my ($z) = @_;
+	my ($re, $im) = ref $z ? @{$z->cartesian} : ($z, 0);
+	return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) if $im == 0;
+	my ($r, $t) = @{$z->polar};
+	return (ref $z)->emake(CORE::sqrt($r), $t/2);
+}
+
+#
+# cbrt
+#
+# Compute cbrt(z) (cubic root).
+#
+# Why are we not returning three values?  The same answer as for sqrt().
+#
+sub cbrt {
+	my ($z) = @_;
+	return $z < 0 ? -CORE::exp(CORE::log(-$z)/3) : ($z > 0 ? CORE::exp(CORE::log($z)/3): 0)
+	    unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return (ref $z)->emake(CORE::exp(CORE::log($r)/3), $t/3);
+}
+
+#
+# _rootbad
+#
+# Die on bad root.
+#
+sub _rootbad {
+    my $mess = "Root $_[0] not defined, root must be positive integer.\n";
+
+    my @up = caller(1);
+
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# root
+#
+# Computes all nth root for z, returning an array whose size is n.
+# `n' must be a positive integer.
+#
+# The roots are given by (for k = 0..n-1):
+#
+# z^(1/n) = r^(1/n) (cos ((t+2 k pi)/n) + i sin ((t+2 k pi)/n))
+#
+sub root {
+	my ($z, $n) = @_;
+	_rootbad($n) if ($n < 1 or int($n) != $n);
+	my ($r, $t) = ref $z ? @{$z->polar} : (CORE::abs($z), $z >= 0 ? 0 : pi);
+	my @root;
+	my $k;
+	my $theta_inc = pit2 / $n;
+	my $rho = $r ** (1/$n);
+	my $theta;
+	my $cartesian = ref $z && $z->{c_dirty} == 0;
+	for ($k = 0, $theta = $t / $n; $k < $n; $k++, $theta += $theta_inc) {
+	    my $w = cplxe($rho, $theta);
+	    # Yes, $cartesian is loop invariant.
+	    push @root, $cartesian ? cplx(@{$w->cartesian}) : $w;
+	}
+	return @root;
+}
+
+#
+# Re
+#
+# Return or set Re(z).
+#
+sub Re {
+	my ($z, $Re) = @_;
+	return $z unless ref $z;
+	if (defined $Re) {
+	    $z->{'cartesian'} = [ $Re, ${$z->cartesian}[1] ];
+	    $z->{c_dirty} = 0;
+	    $z->{p_dirty} = 1;
+	} else {
+	    return ${$z->cartesian}[0];
+	}
+}
+
+#
+# Im
+#
+# Return or set Im(z).
+#
+sub Im {
+	my ($z, $Im) = @_;
+	return $z unless ref $z;
+	if (defined $Im) {
+	    $z->{'cartesian'} = [ ${$z->cartesian}[0], $Im ];
+	    $z->{c_dirty} = 0;
+	    $z->{p_dirty} = 1;
+	} else {
+	    return ${$z->cartesian}[1];
+	}
+}
+
+#
+# rho
+#
+# Return or set rho(w).
+#
+sub rho {
+    Math::Complex::abs(@_);
+}
+
+#
+# theta
+#
+# Return or set theta(w).
+#
+sub theta {
+    Math::Complex::arg(@_);
+}
+
+#
+# (exp)
+#
+# Computes exp(z).
+#
+sub exp {
+	my ($z) = @_;
+	my ($x, $y) = @{$z->cartesian};
+	return (ref $z)->emake(CORE::exp($x), $y);
+}
+
+#
+# _logofzero
+#
+# Die on logarithm of zero.
+#
+sub _logofzero {
+    my $mess = "$_[0]: Logarithm of zero.\n";
+
+    if (defined $_[1]) {
+	$mess .= "(Because in the definition of $_[0], the argument ";
+	$mess .= "$_[1] " unless ($_[1] eq '0');
+	$mess .= "is 0)\n";
+    }
+
+    my @up = caller(1);
+
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# (log)
+#
+# Compute log(z).
+#
+sub log {
+	my ($z) = @_;
+	unless (ref $z) {
+	    _logofzero("log") if $z == 0;
+	    return $z > 0 ? CORE::log($z) : cplx(CORE::log(-$z), pi);
+	}
+	my ($r, $t) = @{$z->polar};
+	_logofzero("log") if $r == 0;
+	if    ($t >   pi()) { $t -= pit2 }
+	elsif ($t <= -pi()) { $t += pit2 }
+	return (ref $z)->make(CORE::log($r), $t);
+}
+
+#
+# ln
+#
+# Alias for log().
+#
+sub ln { Math::Complex::log(@_) }
+
+#
+# log10
+#
+# Compute log10(z).
+#
+
+sub log10 {
+	return Math::Complex::log($_[0]) * uplog10;
+}
+
+#
+# logn
+#
+# Compute logn(z,n) = log(z) / log(n)
+#
+sub logn {
+	my ($z, $n) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my $logn = $logn{$n};
+	$logn = $logn{$n} = CORE::log($n) unless defined $logn;	# Cache log(n)
+	return CORE::log($z) / $logn;
+}
+
+#
+# (cos)
+#
+# Compute cos(z) = (exp(iz) + exp(-iz))/2.
+#
+sub cos {
+	my ($z) = @_;
+	my ($x, $y) = @{$z->cartesian};
+	my $ey = CORE::exp($y);
+	my $ey_1 = 1 / $ey;
+	return (ref $z)->make(CORE::cos($x) * ($ey + $ey_1)/2,
+			      CORE::sin($x) * ($ey_1 - $ey)/2);
+}
+
+#
+# (sin)
+#
+# Compute sin(z) = (exp(iz) - exp(-iz))/2.
+#
+sub sin {
+	my ($z) = @_;
+	my ($x, $y) = @{$z->cartesian};
+	my $ey = CORE::exp($y);
+	my $ey_1 = 1 / $ey;
+	return (ref $z)->make(CORE::sin($x) * ($ey + $ey_1)/2,
+			      CORE::cos($x) * ($ey - $ey_1)/2);
+}
+
+#
+# tan
+#
+# Compute tan(z) = sin(z) / cos(z).
+#
+sub tan {
+	my ($z) = @_;
+	my $cz = CORE::cos($z);
+	_divbyzero "tan($z)", "cos($z)" if (CORE::abs($cz) < $eps);
+	return CORE::sin($z) / $cz;
+}
+
+#
+# sec
+#
+# Computes the secant sec(z) = 1 / cos(z).
+#
+sub sec {
+	my ($z) = @_;
+	my $cz = CORE::cos($z);
+	_divbyzero "sec($z)", "cos($z)" if ($cz == 0);
+	return 1 / $cz;
+}
+
+#
+# csc
+#
+# Computes the cosecant csc(z) = 1 / sin(z).
+#
+sub csc {
+	my ($z) = @_;
+	my $sz = CORE::sin($z);
+	_divbyzero "csc($z)", "sin($z)" if ($sz == 0);
+	return 1 / $sz;
+}
+
+#
+# cosec
+#
+# Alias for csc().
+#
+sub cosec { Math::Complex::csc(@_) }
+
+#
+# cot
+#
+# Computes cot(z) = cos(z) / sin(z).
+#
+sub cot {
+	my ($z) = @_;
+	my $sz = CORE::sin($z);
+	_divbyzero "cot($z)", "sin($z)" if ($sz == 0);
+	return CORE::cos($z) / $sz;
+}
+
+#
+# cotan
+#
+# Alias for cot().
+#
+sub cotan { Math::Complex::cot(@_) }
+
+#
+# acos
+#
+# Computes the arc cosine acos(z) = -i log(z + sqrt(z*z-1)).
+#
+sub acos {
+	my $z = $_[0];
+	return CORE::atan2(CORE::sqrt(1-$z*$z), $z) if (! ref $z) && CORE::abs($z) <= 1;
+	my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+	my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y);
+	my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y);
+	my $alpha = ($t1 + $t2)/2;
+	my $beta  = ($t1 - $t2)/2;
+	$alpha = 1 if $alpha < 1;
+	if    ($beta >  1) { $beta =  1 }
+	elsif ($beta < -1) { $beta = -1 }
+	my $u = CORE::atan2(CORE::sqrt(1-$beta*$beta), $beta);
+	my $v = CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
+	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
+	return $package->make($u, $v);
+}
+
+#
+# asin
+#
+# Computes the arc sine asin(z) = -i log(iz + sqrt(1-z*z)).
+#
+sub asin {
+	my $z = $_[0];
+	return CORE::atan2($z, CORE::sqrt(1-$z*$z)) if (! ref $z) && CORE::abs($z) <= 1;
+	my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+	my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y);
+	my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y);
+	my $alpha = ($t1 + $t2)/2;
+	my $beta  = ($t1 - $t2)/2;
+	$alpha = 1 if $alpha < 1;
+	if    ($beta >  1) { $beta =  1 }
+	elsif ($beta < -1) { $beta = -1 }
+	my $u =  CORE::atan2($beta, CORE::sqrt(1-$beta*$beta));
+	my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
+	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
+	return $package->make($u, $v);
+}
+
+#
+# atan
+#
+# Computes the arc tangent atan(z) = i/2 log((i+z) / (i-z)).
+#
+sub atan {
+	my ($z) = @_;
+	return CORE::atan2($z, 1) unless ref $z;
+	_divbyzero "atan(i)"  if ( $z == i);
+	_divbyzero "atan(-i)" if (-$z == i);
+	my $log = CORE::log((i + $z) / (i - $z));
+	$ip2 = 0.5 * i unless defined $ip2;
+	return $ip2 * $log;
+}
+
+#
+# asec
+#
+# Computes the arc secant asec(z) = acos(1 / z).
+#
+sub asec {
+	my ($z) = @_;
+	_divbyzero "asec($z)", $z if ($z == 0);
+	return acos(1 / $z);
+}
+
+#
+# acsc
+#
+# Computes the arc cosecant acsc(z) = asin(1 / z).
+#
+sub acsc {
+	my ($z) = @_;
+	_divbyzero "acsc($z)", $z if ($z == 0);
+	return asin(1 / $z);
+}
+
+#
+# acosec
+#
+# Alias for acsc().
+#
+sub acosec { Math::Complex::acsc(@_) }
+
+#
+# acot
+#
+# Computes the arc cotangent acot(z) = atan(1 / z)
+#
+sub acot {
+	my ($z) = @_;
+	_divbyzero "acot(0)"  if (CORE::abs($z)     < $eps);
+	return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z) unless ref $z;
+	_divbyzero "acot(i)"  if (CORE::abs($z - i) < $eps);
+	_logofzero "acot(-i)" if (CORE::abs($z + i) < $eps);
+	return atan(1 / $z);
+}
+
+#
+# acotan
+#
+# Alias for acot().
+#
+sub acotan { Math::Complex::acot(@_) }
+
+#
+# cosh
+#
+# Computes the hyperbolic cosine cosh(z) = (exp(z) + exp(-z))/2.
+#
+sub cosh {
+	my ($z) = @_;
+	my $ex;
+	unless (ref $z) {
+	    $ex = CORE::exp($z);
+	    return ($ex + 1/$ex)/2;
+	}
+	my ($x, $y) = @{$z->cartesian};
+	$ex = CORE::exp($x);
+	my $ex_1 = 1 / $ex;
+	return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2,
+			      CORE::sin($y) * ($ex - $ex_1)/2);
+}
+
+#
+# sinh
+#
+# Computes the hyperbolic sine sinh(z) = (exp(z) - exp(-z))/2.
+#
+sub sinh {
+	my ($z) = @_;
+	my $ex;
+	unless (ref $z) {
+	    $ex = CORE::exp($z);
+	    return ($ex - 1/$ex)/2;
+	}
+	my ($x, $y) = @{$z->cartesian};
+	$ex = CORE::exp($x);
+	my $ex_1 = 1 / $ex;
+	return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2,
+			      CORE::sin($y) * ($ex + $ex_1)/2);
+}
+
+#
+# tanh
+#
+# Computes the hyperbolic tangent tanh(z) = sinh(z) / cosh(z).
+#
+sub tanh {
+	my ($z) = @_;
+	my $cz = cosh($z);
+	_divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
+	return sinh($z) / $cz;
+}
+
+#
+# sech
+#
+# Computes the hyperbolic secant sech(z) = 1 / cosh(z).
+#
+sub sech {
+	my ($z) = @_;
+	my $cz = cosh($z);
+	_divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
+	return 1 / $cz;
+}
+
+#
+# csch
+#
+# Computes the hyperbolic cosecant csch(z) = 1 / sinh(z).
+#
+sub csch {
+	my ($z) = @_;
+	my $sz = sinh($z);
+	_divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
+	return 1 / $sz;
+}
+
+#
+# cosech
+#
+# Alias for csch().
+#
+sub cosech { Math::Complex::csch(@_) }
+
+#
+# coth
+#
+# Computes the hyperbolic cotangent coth(z) = cosh(z) / sinh(z).
+#
+sub coth {
+	my ($z) = @_;
+	my $sz = sinh($z);
+	_divbyzero "coth($z)", "sinh($z)" if ($sz == 0);
+	return cosh($z) / $sz;
+}
+
+#
+# cotanh
+#
+# Alias for coth().
+#
+sub cotanh { Math::Complex::coth(@_) }
+
+#
+# acosh
+#
+# Computes the arc hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)).
+#
+sub acosh {
+	my ($z) = @_;
+	unless (ref $z) {
+	    return CORE::log($z + CORE::sqrt($z*$z-1)) if $z >= 1;
+	    $z = cplx($z, 0);
+	}
+	my ($re, $im) = @{$z->cartesian};
+	if ($im == 0) {
+	    return cplx(CORE::log($re + CORE::sqrt($re*$re - 1)), 0) if $re >= 1;
+	    return cplx(0, CORE::atan2(CORE::sqrt(1-$re*$re), $re)) if CORE::abs($re) <= 1;
+	}
+	return CORE::log($z + CORE::sqrt($z*$z - 1));
+}
+
+#
+# asinh
+#
+# Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z-1))
+#
+sub asinh {
+	my ($z) = @_;
+	return CORE::log($z + CORE::sqrt($z*$z + 1));
+}
+
+#
+# atanh
+#
+# Computes the arc hyperbolic tangent atanh(z) = 1/2 log((1+z) / (1-z)).
+#
+sub atanh {
+	my ($z) = @_;
+	unless (ref $z) {
+	    return CORE::log((1 + $z)/(1 - $z))/2 if CORE::abs($z) < 1;
+	    $z = cplx($z, 0);
+	}
+	_divbyzero 'atanh(1)',  "1 - $z" if ($z ==  1);
+	_logofzero 'atanh(-1)'           if ($z == -1);
+	return 0.5 * CORE::log((1 + $z) / (1 - $z));
+}
+
+#
+# asech
+#
+# Computes the hyperbolic arc secant asech(z) = acosh(1 / z).
+#
+sub asech {
+	my ($z) = @_;
+	_divbyzero 'asech(0)', $z if ($z == 0);
+	return acosh(1 / $z);
+}
+
+#
+# acsch
+#
+# Computes the hyperbolic arc cosecant acsch(z) = asinh(1 / z).
+#
+sub acsch {
+	my ($z) = @_;
+	_divbyzero 'acsch(0)', $z if ($z == 0);
+	return asinh(1 / $z);
+}
+
+#
+# acosech
+#
+# Alias for acosh().
+#
+sub acosech { Math::Complex::acsch(@_) }
+
+#
+# acoth
+#
+# Computes the arc hyperbolic cotangent acoth(z) = 1/2 log((1+z) / (z-1)).
+#
+sub acoth {
+	my ($z) = @_;
+	_divbyzero 'acoth(0)'            if (CORE::abs($z)     < $eps);
+	unless (ref $z) {
+	    return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1;
+	    $z = cplx($z, 0);
+	}
+	_divbyzero 'acoth(1)',  "$z - 1" if (CORE::abs($z - 1) < $eps);
+	_logofzero 'acoth(-1)', "1 / $z" if (CORE::abs($z + 1) < $eps);
+	return CORE::log((1 + $z) / ($z - 1)) / 2;
+}
+
+#
+# acotanh
+#
+# Alias for acot().
+#
+sub acotanh { Math::Complex::acoth(@_) }
+
+#
+# (atan2)
+#
+# Compute atan(z1/z2).
+#
+sub atan2 {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1, $re2, $im2);
+	if ($inverted) {
+	    ($re1, $im1) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	    ($re2, $im2) = @{$z1->cartesian};
+	} else {
+	    ($re1, $im1) = @{$z1->cartesian};
+	    ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	}
+	if ($im2 == 0) {
+	    return cplx(CORE::atan2($re1, $re2), 0) if $im1 == 0;
+	    return cplx(($im1<=>0) * pip2, 0) if $re2 == 0;
+	}
+	my $w = atan($z1/$z2);
+	my ($u, $v) = ref $w ? @{$w->cartesian} : ($w, 0);
+	$u += pi   if $re2 < 0;
+	$u -= pit2 if $u > pi;
+	return cplx($u, $v);
+}
+
+#
+# display_format
+# ->display_format
+#
+# Set (fetch if no argument) display format for all complex numbers that
+# don't happen to have overridden it via ->display_format
+#
+# When called as a method, this actually sets the display format for
+# the current object.
+#
+# Valid object formats are 'c' and 'p' for cartesian and polar. The first
+# letter is used actually, so the type can be fully spelled out for clarity.
+#
+sub display_format {
+	my $self = shift;
+	my $format = undef;
+
+	if (ref $self) {			# Called as a method
+		$format = shift;
+	} else {				# Regular procedure call
+		$format = $self;
+		undef $self;
+	}
+
+	if (defined $self) {
+		return defined $self->{display} ? $self->{display} : $display
+			unless defined $format;
+		return $self->{display} = $format;
+	}
+
+	return $display unless defined $format;
+	return $display = $format;
+}
+
+#
+# (stringify)
+#
+# Show nicely formatted complex number under its cartesian or polar form,
+# depending on the current display format:
+#
+# . If a specific display format has been recorded for this object, use it.
+# . Otherwise, use the generic current default for all complex numbers,
+#   which is a package global variable.
+#
+sub stringify {
+	my ($z) = shift;
+	my $format;
+
+	$format = $display;
+	$format = $z->{display} if defined $z->{display};
+
+	return $z->stringify_polar if $format =~ /^p/i;
+	return $z->stringify_cartesian;
+}
+
+#
+# ->stringify_cartesian
+#
+# Stringify as a cartesian representation 'a+bi'.
+#
+sub stringify_cartesian {
+	my $z  = shift;
+	my ($x, $y) = @{$z->cartesian};
+	my ($re, $im);
+
+	$x = int($x + ($x < 0 ? -1 : 1) * $eps)
+		if int(CORE::abs($x)) != int(CORE::abs($x) + $eps);
+	$y = int($y + ($y < 0 ? -1 : 1) * $eps)
+		if int(CORE::abs($y)) != int(CORE::abs($y) + $eps);
+
+	$re = "$x" if CORE::abs($x) >= $eps;
+        if ($y == 1)                           { $im = 'i' }
+        elsif ($y == -1)                       { $im = '-i' }
+        elsif (CORE::abs($y) >= $eps)                { $im = $y . "i" }
+
+	my $str = '';
+	$str = $re if defined $re;
+	$str .= "+$im" if defined $im;
+	$str =~ s/\+-/-/;
+	$str =~ s/^\+//;
+	$str =~ s/([-+])1i/$1i/; # Not redundant with the above 1/-1 tests.
+	$str = '0' unless $str;
+
+	return $str;
+}
+
+
+# Helper for stringify_polar, a Greatest Common Divisor with a memory.
+
+sub _gcd {
+    my ($a, $b) = @_;
+
+    use integer;
+
+    # Loops forever if given negative inputs.
+
+    if    ($b and $a > $b) { return gcd($a % $b, $b) }
+    elsif ($a and $b > $a) { return gcd($b % $a, $a) }
+    else                   { return $a ? $a : $b     }
+}
+
+my %gcd;
+
+sub gcd {
+    my ($a, $b) = @_;
+
+    my $id = "$a $b";
+    
+    unless (exists $gcd{$id}) {
+	$gcd{$id} = _gcd($a, $b);
+	$gcd{"$b $a"} = $gcd{$id};
+    }
+
+    return $gcd{$id};
+}
+
+#
+# ->stringify_polar
+#
+# Stringify as a polar representation '[r,t]'.
+#
+sub stringify_polar {
+	my $z  = shift;
+	my ($r, $t) = @{$z->polar};
+	my $theta;
+
+	return '[0,0]' if $r <= $eps;
+
+	my $nt = $t / pit2;
+	$nt = ($nt - int($nt)) * pit2;
+	$nt += pit2 if $nt < 0;			# Range [0, 2pi]
+
+	if (CORE::abs($nt) <= $eps)		{ $theta = 0 }
+	elsif (CORE::abs(pi-$nt) <= $eps)	{ $theta = 'pi' }
+
+	if (defined $theta) {
+		$r = int($r + ($r < 0 ? -1 : 1) * $eps)
+			if int(CORE::abs($r)) != int(CORE::abs($r) + $eps);
+		$theta = int($theta + ($theta < 0 ? -1 : 1) * $eps)
+			if ($theta ne 'pi' and
+			    int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps));
+		return "\[$r,$theta\]";
+	}
+
+	#
+	# Okay, number is not a real. Try to identify pi/n and friends...
+	#
+
+	$nt -= pit2 if $nt > pi;
+
+	if (CORE::abs($nt) >= deg1) {
+	    my ($n, $k, $kpi);
+
+	    for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) {
+		$n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5);
+		if (CORE::abs($kpi/$n - $nt) <= $eps) {
+		    $n = CORE::abs($n);
+		    my $gcd = gcd($k, $n);
+		    if ($gcd > 1) {
+			$k /= $gcd;
+			$n /= $gcd;
+		    }
+		    next if $n > 360;
+		    $theta = ($nt < 0 ? '-':'').
+			     ($k == 1 ? 'pi':"${k}pi");
+		    $theta .= '/'.$n if $n > 1;
+		    last;
+		}
+	    }
+	}
+
+	$theta = $nt unless defined $theta;
+
+	$r = int($r + ($r < 0 ? -1 : 1) * $eps)
+		if int(CORE::abs($r)) != int(CORE::abs($r) + $eps);
+	$theta = int($theta + ($theta < 0 ? -1 : 1) * $eps)
+		if ($theta !~ m(^-?\d*pi/\d+$) and
+		    int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps));
+
+	return "\[$r,$theta\]";
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::Complex - complex numbers and associated mathematical functions
+
+=head1 SYNOPSIS
+
+	use Math::Complex;
+
+	$z = Math::Complex->make(5, 6);
+	$t = 4 - 3*i + $z;
+	$j = cplxe(1, 2*pi/3);
+
+=head1 DESCRIPTION
+
+This package lets you create and manipulate complex numbers. By default,
+I<Perl> limits itself to real numbers, but an extra C<use> statement brings
+full complex support, along with a full set of mathematical functions
+typically associated with and/or extended to complex numbers.
+
+If you wonder what complex numbers are, they were invented to be able to solve
+the following equation:
+
+	x*x = -1
+
+and by definition, the solution is noted I<i> (engineers use I<j> instead since
+I<i> usually denotes an intensity, but the name does not matter). The number
+I<i> is a pure I<imaginary> number.
+
+The arithmetics with pure imaginary numbers works just like you would expect
+it with real numbers... you just have to remember that
+
+	i*i = -1
+
+so you have:
+
+	5i + 7i = i * (5 + 7) = 12i
+	4i - 3i = i * (4 - 3) = i
+	4i * 2i = -8
+	6i / 2i = 3
+	1 / i = -i
+
+Complex numbers are numbers that have both a real part and an imaginary
+part, and are usually noted:
+
+	a + bi
+
+where C<a> is the I<real> part and C<b> is the I<imaginary> part. The
+arithmetic with complex numbers is straightforward. You have to
+keep track of the real and the imaginary parts, but otherwise the
+rules used for real numbers just apply:
+
+	(4 + 3i) + (5 - 2i) = (4 + 5) + i(3 - 2) = 9 + i
+	(2 + i) * (4 - i) = 2*4 + 4i -2i -i*i = 8 + 2i + 1 = 9 + 2i
+
+A graphical representation of complex numbers is possible in a plane
+(also called the I<complex plane>, but it's really a 2D plane).
+The number
+
+	z = a + bi
+
+is the point whose coordinates are (a, b). Actually, it would
+be the vector originating from (0, 0) to (a, b). It follows that the addition
+of two complex numbers is a vectorial addition.
+
+Since there is a bijection between a point in the 2D plane and a complex
+number (i.e. the mapping is unique and reciprocal), a complex number
+can also be uniquely identified with polar coordinates:
+
+	[rho, theta]
+
+where C<rho> is the distance to the origin, and C<theta> the angle between
+the vector and the I<x> axis. There is a notation for this using the
+exponential form, which is:
+
+	rho * exp(i * theta)
+
+where I<i> is the famous imaginary number introduced above. Conversion
+between this form and the cartesian form C<a + bi> is immediate:
+
+	a = rho * cos(theta)
+	b = rho * sin(theta)
+
+which is also expressed by this formula:
+
+	z = rho * exp(i * theta) = rho * (cos theta + i * sin theta)
+
+In other words, it's the projection of the vector onto the I<x> and I<y>
+axes. Mathematicians call I<rho> the I<norm> or I<modulus> and I<theta>
+the I<argument> of the complex number. The I<norm> of C<z> will be
+noted C<abs(z)>.
+
+The polar notation (also known as the trigonometric
+representation) is much more handy for performing multiplications and
+divisions of complex numbers, whilst the cartesian notation is better
+suited for additions and subtractions. Real numbers are on the I<x>
+axis, and therefore I<theta> is zero or I<pi>.
+
+All the common operations that can be performed on a real number have
+been defined to work on complex numbers as well, and are merely
+I<extensions> of the operations defined on real numbers. This means
+they keep their natural meaning when there is no imaginary part, provided
+the number is within their definition set.
+
+For instance, the C<sqrt> routine which computes the square root of
+its argument is only defined for non-negative real numbers and yields a
+non-negative real number (it is an application from B<R+> to B<R+>).
+If we allow it to return a complex number, then it can be extended to
+negative real numbers to become an application from B<R> to B<C> (the
+set of complex numbers):
+
+	sqrt(x) = x >= 0 ? sqrt(x) : sqrt(-x)*i
+
+It can also be extended to be an application from B<C> to B<C>,
+whilst its restriction to B<R> behaves as defined above by using
+the following definition:
+
+	sqrt(z = [r,t]) = sqrt(r) * exp(i * t/2)
+
+Indeed, a negative real number can be noted C<[x,pi]> (the modulus
+I<x> is always non-negative, so C<[x,pi]> is really C<-x>, a negative
+number) and the above definition states that
+
+	sqrt([x,pi]) = sqrt(x) * exp(i*pi/2) = [sqrt(x),pi/2] = sqrt(x)*i
+
+which is exactly what we had defined for negative real numbers above.
+The C<sqrt> returns only one of the solutions: if you want the both,
+use the C<root> function.
+
+All the common mathematical functions defined on real numbers that
+are extended to complex numbers share that same property of working
+I<as usual> when the imaginary part is zero (otherwise, it would not
+be called an extension, would it?).
+
+A I<new> operation possible on a complex number that is
+the identity for real numbers is called the I<conjugate>, and is noted
+with an horizontal bar above the number, or C<~z> here.
+
+	 z = a + bi
+	~z = a - bi
+
+Simple... Now look:
+
+	z * ~z = (a + bi) * (a - bi) = a*a + b*b
+
+We saw that the norm of C<z> was noted C<abs(z)> and was defined as the
+distance to the origin, also known as:
+
+	rho = abs(z) = sqrt(a*a + b*b)
+
+so
+
+	z * ~z = abs(z) ** 2
+
+If z is a pure real number (i.e. C<b == 0>), then the above yields:
+
+	a * a = abs(a) ** 2
+
+which is true (C<abs> has the regular meaning for real number, i.e. stands
+for the absolute value). This example explains why the norm of C<z> is
+noted C<abs(z)>: it extends the C<abs> function to complex numbers, yet
+is the regular C<abs> we know when the complex number actually has no
+imaginary part... This justifies I<a posteriori> our use of the C<abs>
+notation for the norm.
+
+=head1 OPERATIONS
+
+Given the following notations:
+
+	z1 = a + bi = r1 * exp(i * t1)
+	z2 = c + di = r2 * exp(i * t2)
+	z = <any complex or real number>
+
+the following (overloaded) operations are supported on complex numbers:
+
+	z1 + z2 = (a + c) + i(b + d)
+	z1 - z2 = (a - c) + i(b - d)
+	z1 * z2 = (r1 * r2) * exp(i * (t1 + t2))
+	z1 / z2 = (r1 / r2) * exp(i * (t1 - t2))
+	z1 ** z2 = exp(z2 * log z1)
+	~z = a - bi
+	abs(z) = r1 = sqrt(a*a + b*b)
+	sqrt(z) = sqrt(r1) * exp(i * t/2)
+	exp(z) = exp(a) * exp(i * b)
+	log(z) = log(r1) + i*t
+	sin(z) = 1/2i (exp(i * z1) - exp(-i * z))
+	cos(z) = 1/2 (exp(i * z1) + exp(-i * z))
+	atan2(z1, z2) = atan(z1/z2)
+
+The following extra operations are supported on both real and complex
+numbers:
+
+	Re(z) = a
+	Im(z) = b
+	arg(z) = t
+	abs(z) = r
+
+	cbrt(z) = z ** (1/3)
+	log10(z) = log(z) / log(10)
+	logn(z, n) = log(z) / log(n)
+
+	tan(z) = sin(z) / cos(z)
+
+	csc(z) = 1 / sin(z)
+	sec(z) = 1 / cos(z)
+	cot(z) = 1 / tan(z)
+
+	asin(z) = -i * log(i*z + sqrt(1-z*z))
+	acos(z) = -i * log(z + i*sqrt(1-z*z))
+	atan(z) = i/2 * log((i+z) / (i-z))
+
+	acsc(z) = asin(1 / z)
+	asec(z) = acos(1 / z)
+	acot(z) = atan(1 / z) = -i/2 * log((i+z) / (z-i))
+
+	sinh(z) = 1/2 (exp(z) - exp(-z))
+	cosh(z) = 1/2 (exp(z) + exp(-z))
+	tanh(z) = sinh(z) / cosh(z) = (exp(z) - exp(-z)) / (exp(z) + exp(-z))
+
+	csch(z) = 1 / sinh(z)
+	sech(z) = 1 / cosh(z)
+	coth(z) = 1 / tanh(z)
+
+	asinh(z) = log(z + sqrt(z*z+1))
+	acosh(z) = log(z + sqrt(z*z-1))
+	atanh(z) = 1/2 * log((1+z) / (1-z))
+
+	acsch(z) = asinh(1 / z)
+	asech(z) = acosh(1 / z)
+	acoth(z) = atanh(1 / z) = 1/2 * log((1+z) / (z-1))
+
+I<arg>, I<abs>, I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>,
+I<coth>, I<acosech>, I<acotanh>, have aliases I<rho>, I<theta>, I<ln>,
+I<cosec>, I<cotan>, I<acosec>, I<acotan>, I<cosech>, I<cotanh>,
+I<acosech>, I<acotanh>, respectively.  C<Re>, C<Im>, C<arg>, C<abs>,
+C<rho>, and C<theta> can be used also also mutators.  The C<cbrt>
+returns only one of the solutions: if you want all three, use the
+C<root> function.
+
+The I<root> function is available to compute all the I<n>
+roots of some complex, where I<n> is a strictly positive integer.
+There are exactly I<n> such roots, returned as a list. Getting the
+number mathematicians call C<j> such that:
+
+	1 + j + j*j = 0;
+
+is a simple matter of writing:
+
+	$j = ((root(1, 3))[1];
+
+The I<k>th root for C<z = [r,t]> is given by:
+
+	(root(z, n))[k] = r**(1/n) * exp(i * (t + 2*k*pi)/n)
+
+The I<spaceship> comparison operator, E<lt>=E<gt>, is also defined. In
+order to ensure its restriction to real numbers is conform to what you
+would expect, the comparison is run on the real part of the complex
+number first, and imaginary parts are compared only when the real
+parts match.
+
+=head1 CREATION
+
+To create a complex number, use either:
+
+	$z = Math::Complex->make(3, 4);
+	$z = cplx(3, 4);
+
+if you know the cartesian form of the number, or
+
+	$z = 3 + 4*i;
+
+if you like. To create a number using the polar form, use either:
+
+	$z = Math::Complex->emake(5, pi/3);
+	$x = cplxe(5, pi/3);
+
+instead. The first argument is the modulus, the second is the angle
+(in radians, the full circle is 2*pi).  (Mnemonic: C<e> is used as a
+notation for complex numbers in the polar form).
+
+It is possible to write:
+
+	$x = cplxe(-3, pi/4);
+
+but that will be silently converted into C<[3,-3pi/4]>, since the modulus
+must be non-negative (it represents the distance to the origin in the complex
+plane).
+
+It is also possible to have a complex number as either argument of
+either the C<make> or C<emake>: the appropriate component of
+the argument will be used.
+
+	$z1 = cplx(-2,  1);
+	$z2 = cplx($z1, 4);
+
+=head1 STRINGIFICATION
+
+When printed, a complex number is usually shown under its cartesian
+form I<a+bi>, but there are legitimate cases where the polar format
+I<[r,t]> is more appropriate.
+
+By calling the routine C<Math::Complex::display_format> and supplying either
+C<"polar"> or C<"cartesian">, you override the default display format,
+which is C<"cartesian">. Not supplying any argument returns the current
+setting.
+
+This default can be overridden on a per-number basis by calling the
+C<display_format> method instead. As before, not supplying any argument
+returns the current display format for this number. Otherwise whatever you
+specify will be the new display format for I<this> particular number.
+
+For instance:
+
+	use Math::Complex;
+
+	Math::Complex::display_format('polar');
+	$j = ((root(1, 3))[1];
+	print "j = $j\n";		# Prints "j = [1,2pi/3]
+	$j->display_format('cartesian');
+	print "j = $j\n";		# Prints "j = -0.5+0.866025403784439i"
+
+The polar format attempts to emphasize arguments like I<k*pi/n>
+(where I<n> is a positive integer and I<k> an integer within [-9,+9]).
+
+=head1 USAGE
+
+Thanks to overloading, the handling of arithmetics with complex numbers
+is simple and almost transparent.
+
+Here are some examples:
+
+	use Math::Complex;
+
+	$j = cplxe(1, 2*pi/3);	# $j ** 3 == 1
+	print "j = $j, j**3 = ", $j ** 3, "\n";
+	print "1 + j + j**2 = ", 1 + $j + $j**2, "\n";
+
+	$z = -16 + 0*i;			# Force it to be a complex
+	print "sqrt($z) = ", sqrt($z), "\n";
+
+	$k = exp(i * 2*pi/3);
+	print "$j - $k = ", $j - $k, "\n";
+
+	$z->Re(3);			# Re, Im, arg, abs,
+	$j->arg(2);			# (the last two aka rho, theta)
+					# can be used also as mutators.
+
+=head1 ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO
+
+The division (/) and the following functions
+
+	log	ln	log10	logn
+	tan	sec 	csc	cot
+	atan	asec	acsc	acot
+	tanh	sech	csch	coth
+	atanh	asech	acsch	acoth
+
+cannot be computed for all arguments because that would mean dividing
+by zero or taking logarithm of zero. These situations cause fatal
+runtime errors looking like this
+
+	cot(0): Division by zero.
+	(Because in the definition of cot(0), the divisor sin(0) is 0)
+	Died at ...
+
+or
+
+	atanh(-1): Logarithm of zero.
+	Died at...
+
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<acot>, C<csch>, C<coth>,
+C<asech>, C<acsch>, the argument cannot be C<0> (zero).  For the the
+logarithmic functions and the C<atanh>, C<acoth>, the argument cannot
+be C<1> (one).  For the C<atanh>, C<acoth>, the argument cannot be
+C<-1> (minus one).  For the C<atan>, C<acot>, the argument cannot be
+C<i> (the imaginary unit).  For the C<atan>, C<acoth>, the argument
+cannot be C<-i> (the negative imaginary unit).  For the C<tan>,
+C<sec>, C<tanh>, the argument cannot be I<pi/2 + k * pi>, where I<k>
+is any integer.
+
+Note that because we are operating on approximations of real numbers,
+these errors can happen when merely `too close' to the singularities
+listed above.  For example C<tan(2*atan2(1,1)+1e-15)> will die of
+division by zero.
+
+=head1 ERRORS DUE TO INDIGESTIBLE ARGUMENTS
+
+The C<make> and C<emake> accept both real and complex arguments.
+When they cannot recognize the arguments they will die with error
+messages like the following
+
+    Math::Complex::make: Cannot take real part of ...
+    Math::Complex::make: Cannot take real part of ...
+    Math::Complex::emake: Cannot take rho of ...
+    Math::Complex::emake: Cannot take theta of ...
+
+=head1 BUGS
+
+Saying C<use Math::Complex;> exports many mathematical routines in the
+caller environment and even overrides some (C<sqrt>, C<log>).
+This is construed as a feature by the Authors, actually... ;-)
+
+All routines expect to be given real or complex numbers. Don't attempt to
+use BigFloat, since Perl has currently no rule to disambiguate a '+'
+operation (for instance) between two overloaded entities.
+
+In Cray UNICOS there is some strange numerical instability that results
+in root(), cos(), sin(), cosh(), sinh(), losing accuracy fast.  Beware.
+The bug may be in UNICOS math libs, in UNICOS C compiler, in Math::Complex.
+Whatever it is, it does not manifest itself anywhere else where Perl runs.
+
+=head1 AUTHORS
+
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
+Jarkko Hietaniemi <F<jhi@iki.fi>>.
+
+Extensive patches by Daniel S. Lewart <F<d-lewart@uiuc.edu>>.
+
+=cut
+
+1;
+
+# eof
diff --git a/contrib/perl5/lib/Math/Trig.pm b/contrib/perl5/lib/Math/Trig.pm
new file mode 100644
index 000000000000..b7b5d5d8f2bd
--- /dev/null
+++ b/contrib/perl5/lib/Math/Trig.pm
@@ -0,0 +1,419 @@
+#
+# Trigonometric functions, mostly inherited from Math::Complex.
+# -- Jarkko Hietaniemi, since April 1997
+# -- Raphael Manfredi, September 1996 (indirectly: because of Math::Complex)
+#
+
+require Exporter;
+package Math::Trig;
+
+use strict;
+
+use Math::Complex qw(:trig);
+
+use vars qw($VERSION $PACKAGE
+	    @ISA
+	    @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+@ISA = qw(Exporter);
+
+$VERSION = 1.00;
+
+my @angcnv = qw(rad2deg rad2grad
+	     deg2rad deg2grad
+	     grad2rad grad2deg);
+
+@EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}},
+	   @angcnv);
+
+my @rdlcnv = qw(cartesian_to_cylindrical
+		cartesian_to_spherical
+		cylindrical_to_cartesian
+		cylindrical_to_spherical
+		spherical_to_cartesian
+		spherical_to_cylindrical);
+
+@EXPORT_OK = (@rdlcnv, 'great_circle_distance');
+
+%EXPORT_TAGS = ('radial' => [ @rdlcnv ]);
+
+use constant pi2  => 2 * pi;
+use constant pip2 => pi / 2;
+use constant DR   => pi2/360;
+use constant RD   => 360/pi2;
+use constant DG   => 400/360;
+use constant GD   => 360/400;
+use constant RG   => 400/pi2;
+use constant GR   => pi2/400;
+
+#
+# Truncating remainder.
+#
+
+sub remt ($$) {
+    # Oh yes, POSIX::fmod() would be faster. Possibly. If it is available.
+    $_[0] - $_[1] * int($_[0] / $_[1]);
+}
+
+#
+# Angle conversions.
+#
+
+sub rad2deg ($)  { remt(RD * $_[0], 360) }
+
+sub deg2rad ($)  { remt(DR * $_[0], pi2) }
+
+sub grad2deg ($) { remt(GD * $_[0], 360) }
+
+sub deg2grad ($) { remt(DG * $_[0], 400) }
+
+sub rad2grad ($) { remt(RG * $_[0], 400) }
+
+sub grad2rad ($) { remt(GR * $_[0], pi2) }
+
+sub cartesian_to_spherical {
+    my ( $x, $y, $z ) = @_;
+
+    my $rho = sqrt( $x * $x + $y * $y + $z * $z );
+
+    return ( $rho,
+             atan2( $y, $x ),
+             $rho ? acos( $z / $rho ) : 0 );
+}
+
+sub spherical_to_cartesian {
+    my ( $rho, $theta, $phi ) = @_;
+
+    return ( $rho * cos( $theta ) * sin( $phi ),
+             $rho * sin( $theta ) * sin( $phi ),
+             $rho * cos( $phi   ) );
+}
+
+sub spherical_to_cylindrical {
+    my ( $x, $y, $z ) = spherical_to_cartesian( @_ );
+
+    return ( sqrt( $x * $x + $y * $y ), $_[1], $z );
+}
+
+sub cartesian_to_cylindrical {
+    my ( $x, $y, $z ) = @_;
+
+    return ( sqrt( $x * $x + $y * $y ), atan2( $y, $x ), $z );
+}
+
+sub cylindrical_to_cartesian {
+    my ( $rho, $theta, $z ) = @_;
+
+    return ( $rho * cos( $theta ), $rho * sin( $theta ), $z );
+}
+
+sub cylindrical_to_spherical {
+    return ( cartesian_to_spherical( cylindrical_to_cartesian( @_ ) ) );
+}
+
+sub great_circle_distance {
+    my ( $theta0, $phi0, $theta1, $phi1, $rho ) = @_;
+
+    $rho = 1 unless defined $rho; # Default to the unit sphere.
+
+    my $lat0 = pip2 - $phi0;
+    my $lat1 = pip2 - $phi1;
+
+    return $rho *
+        acos(cos( $lat0 ) * cos( $lat1 ) * cos( $theta0 - $theta1 ) +
+             sin( $lat0 ) * sin( $lat1 ) );
+}
+
+=pod
+
+=head1 NAME
+
+Math::Trig - trigonometric functions
+
+=head1 SYNOPSIS
+
+	use Math::Trig;
+	
+	$x = tan(0.9);
+	$y = acos(3.7);
+	$z = asin(2.4);
+	
+	$halfpi = pi/2;
+
+	$rad = deg2rad(120);
+
+=head1 DESCRIPTION
+
+C<Math::Trig> defines many trigonometric functions not defined by the
+core Perl which defines only the C<sin()> and C<cos()>.  The constant
+B<pi> is also defined as are a few convenience functions for angle
+conversions.
+
+=head1 TRIGONOMETRIC FUNCTIONS
+
+The tangent
+
+=over 4
+
+=item B<tan>
+
+=back
+
+The cofunctions of the sine, cosine, and tangent (cosec/csc and cotan/cot
+are aliases)
+
+B<csc>, B<cosec>, B<sec>, B<sec>, B<cot>, B<cotan>
+
+The arcus (also known as the inverse) functions of the sine, cosine,
+and tangent
+
+B<asin>, B<acos>, B<atan>
+
+The principal value of the arc tangent of y/x
+
+B<atan2>(y, x)
+
+The arcus cofunctions of the sine, cosine, and tangent (acosec/acsc
+and acotan/acot are aliases)
+
+B<acsc>, B<acosec>, B<asec>, B<acot>, B<acotan>
+
+The hyperbolic sine, cosine, and tangent
+
+B<sinh>, B<cosh>, B<tanh>
+
+The cofunctions of the hyperbolic sine, cosine, and tangent (cosech/csch
+and cotanh/coth are aliases)
+
+B<csch>, B<cosech>, B<sech>, B<coth>, B<cotanh>
+
+The arcus (also known as the inverse) functions of the hyperbolic
+sine, cosine, and tangent
+
+B<asinh>, B<acosh>, B<atanh>
+
+The arcus cofunctions of the hyperbolic sine, cosine, and tangent
+(acsch/acosech and acoth/acotanh are aliases)
+
+B<acsch>, B<acosech>, B<asech>, B<acoth>, B<acotanh>
+
+The trigonometric constant B<pi> is also defined.
+
+$pi2 = 2 * B<pi>;
+
+=head2 ERRORS DUE TO DIVISION BY ZERO
+
+The following functions
+
+	acoth
+	acsc
+	acsch
+	asec
+	asech
+	atanh
+	cot
+	coth
+	csc
+	csch
+	sec
+	sech
+	tan
+	tanh
+
+cannot be computed for all arguments because that would mean dividing
+by zero or taking logarithm of zero. These situations cause fatal
+runtime errors looking like this
+
+	cot(0): Division by zero.
+	(Because in the definition of cot(0), the divisor sin(0) is 0)
+	Died at ...
+
+or
+
+	atanh(-1): Logarithm of zero.
+	Died at...
+
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<acot>, C<csch>, C<coth>,
+C<asech>, C<acsch>, the argument cannot be C<0> (zero).  For the
+C<atanh>, C<acoth>, the argument cannot be C<1> (one).  For the
+C<atanh>, C<acoth>, the argument cannot be C<-1> (minus one).  For the
+C<tan>, C<sec>, C<tanh>, C<sech>, the argument cannot be I<pi/2 + k *
+pi>, where I<k> is any integer.
+
+=head2 SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS
+
+Please note that some of the trigonometric functions can break out
+from the B<real axis> into the B<complex plane>. For example
+C<asin(2)> has no definition for plain real numbers but it has
+definition for complex numbers.
+
+In Perl terms this means that supplying the usual Perl numbers (also
+known as scalars, please see L<perldata>) as input for the
+trigonometric functions might produce as output results that no more
+are simple real numbers: instead they are complex numbers.
+
+The C<Math::Trig> handles this by using the C<Math::Complex> package
+which knows how to handle complex numbers, please see L<Math::Complex>
+for more information. In practice you need not to worry about getting
+complex numbers as results because the C<Math::Complex> takes care of
+details like for example how to display complex numbers. For example:
+
+	print asin(2), "\n";
+    
+should produce something like this (take or leave few last decimals):
+
+	1.5707963267949-1.31695789692482i
+
+That is, a complex number with the real part of approximately C<1.571>
+and the imaginary part of approximately C<-1.317>.
+
+=head1 PLANE ANGLE CONVERSIONS
+
+(Plane, 2-dimensional) angles may be converted with the following functions.
+
+	$radians  = deg2rad($degrees);
+	$radians  = grad2rad($gradians);
+	
+	$degrees  = rad2deg($radians);
+	$degrees  = grad2deg($gradians);
+	
+	$gradians = deg2grad($degrees);
+	$gradians = rad2grad($radians);
+
+The full circle is 2 I<pi> radians or I<360> degrees or I<400> gradians.
+
+=head1 RADIAL COORDINATE CONVERSIONS
+
+B<Radial coordinate systems> are the B<spherical> and the B<cylindrical>
+systems, explained shortly in more detail.
+
+You can import radial coordinate conversion functions by using the
+C<:radial> tag:
+
+    use Math::Trig ':radial';
+
+    ($rho, $theta, $z)     = cartesian_to_cylindrical($x, $y, $z);
+    ($rho, $theta, $phi)   = cartesian_to_spherical($x, $y, $z);
+    ($x, $y, $z)           = cylindrical_to_cartesian($rho, $theta, $z);
+    ($rho_s, $theta, $phi) = cylindrical_to_spherical($rho_c, $theta, $z);
+    ($x, $y, $z)           = spherical_to_cartesian($rho, $theta, $phi);
+    ($rho_c, $theta, $z)   = spherical_to_cylindrical($rho_s, $theta, $phi);
+
+B<All angles are in radians>.
+
+=head2 COORDINATE SYSTEMS
+
+B<Cartesian> coordinates are the usual rectangular I<(x, y,
+z)>-coordinates.
+
+Spherical coordinates, I<(rho, theta, pi)>, are three-dimensional
+coordinates which define a point in three-dimensional space.  They are
+based on a sphere surface.  The radius of the sphere is B<rho>, also
+known as the I<radial> coordinate.  The angle in the I<xy>-plane
+(around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
+coordinate.  The angle from the I<z>-axis is B<phi>, also known as the
+I<polar> coordinate.  The `North Pole' is therefore I<0, 0, rho>, and
+the `Bay of Guinea' (think of the missing big chunk of Africa) I<0,
+pi/2, rho>.
+
+B<Beware>: some texts define I<theta> and I<phi> the other way round,
+some texts define the I<phi> to start from the horizontal plane, some
+texts use I<r> in place of I<rho>.
+
+Cylindrical coordinates, I<(rho, theta, z)>, are three-dimensional
+coordinates which define a point in three-dimensional space.  They are
+based on a cylinder surface.  The radius of the cylinder is B<rho>,
+also known as the I<radial> coordinate.  The angle in the I<xy>-plane
+(around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
+coordinate.  The third coordinate is the I<z>, pointing up from the
+B<theta>-plane.
+
+=head2 3-D ANGLE CONVERSIONS
+
+Conversions to and from spherical and cylindrical coordinates are
+available.  Please notice that the conversions are not necessarily
+reversible because of the equalities like I<pi> angles being equal to
+I<-pi> angles.
+
+=over 4
+
+=item cartesian_to_cylindrical
+
+        ($rho, $theta, $z) = cartesian_to_cylindrical($x, $y, $z);
+
+=item cartesian_to_spherical
+
+        ($rho, $theta, $phi) = cartesian_to_spherical($x, $y, $z);
+
+=item cylindrical_to_cartesian
+
+        ($x, $y, $z) = cylindrical_to_cartesian($rho, $theta, $z);
+
+=item cylindrical_to_spherical
+
+        ($rho_s, $theta, $phi) = cylindrical_to_spherical($rho_c, $theta, $z);
+
+Notice that when C<$z> is not 0 C<$rho_s> is not equal to C<$rho_c>.
+
+=item spherical_to_cartesian
+
+        ($x, $y, $z) = spherical_to_cartesian($rho, $theta, $phi);
+
+=item spherical_to_cylindrical
+
+        ($rho_c, $theta, $z) = spherical_to_cylindrical($rho_s, $theta, $phi);
+
+Notice that when C<$z> is not 0 C<$rho_c> is not equal to C<$rho_s>.
+
+=back
+
+=head1 GREAT CIRCLE DISTANCES
+
+You can compute spherical distances, called B<great circle distances>,
+by importing the C<great_circle_distance> function:
+
+	use Math::Trig 'great_circle_distance'
+
+    $distance = great_circle_distance($theta0, $phi0, $theta1, $phi, [, $rho]);
+
+The I<great circle distance> is the shortest distance between two
+points on a sphere.  The distance is in C<$rho> units.  The C<$rho> is
+optional, it defaults to 1 (the unit sphere), therefore the distance
+defaults to radians.
+
+=head1 EXAMPLES
+
+To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N
+139.8E) in kilometers:
+
+        use Math::Trig qw(great_circle_distance deg2rad);
+
+        # Notice the 90 - latitude: phi zero is at the North Pole.
+	@L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+        @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+        $km = great_circle_distance(@L, @T, 6378);
+
+The answer may be off by up to 0.3% because of the irregular (slightly
+aspherical) form of the Earth.
+
+=head1 BUGS
+
+Saying C<use Math::Trig;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>).  This is
+construed as a feature by the Authors, actually... ;-)
+
+The code is not optimized for speed, especially because we use
+C<Math::Complex> and thus go quite near complex numbers while doing
+the computations even when the arguments are not. This, however,
+cannot be completely avoided if we want things like C<asin(2)> to give
+an answer instead of giving a fatal runtime error.
+
+=head1 AUTHORS
+
+Jarkko Hietaniemi <F<jhi@iki.fi>> and 
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>.
+
+=cut
+
+# eof
diff --git a/contrib/perl5/lib/Net/Ping.pm b/contrib/perl5/lib/Net/Ping.pm
new file mode 100644
index 000000000000..495b82f95bb4
--- /dev/null
+++ b/contrib/perl5/lib/Net/Ping.pm
@@ -0,0 +1,550 @@
+package Net::Ping;
+
+# Author:   mose@ccsn.edu (Russell Mosemann)
+#
+# Authors of the original pingecho():
+#           karrer@bernina.ethz.ch (Andreas Karrer)
+#           pmarquess@bfsec.bt.co.uk (Paul Marquess)
+#
+# Copyright (c) 1996 Russell Mosemann.  All rights reserved.  This
+# program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+require 5.002;
+require Exporter;
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION
+            $def_timeout $def_proto $max_datasize);
+use FileHandle;
+use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
+               inet_aton sockaddr_in );
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(pingecho);
+$VERSION = 2.02;
+
+# Constants
+
+$def_timeout = 5;           # Default timeout to wait for a reply
+$def_proto = "udp";         # Default protocol to use for pinging
+$max_datasize = 1024;       # Maximum data bytes in a packet
+
+# Description:  The pingecho() subroutine is provided for backward
+# compatibility with the original Net::Ping.  It accepts a host
+# name/IP and an optional timeout in seconds.  Create a tcp ping
+# object and try pinging the host.  The result of the ping is returned.
+
+sub pingecho
+{
+    my ($host,              # Name or IP number of host to ping
+        $timeout            # Optional timeout in seconds
+        ) = @_;
+    my ($p);                # A ping object
+
+    $p = Net::Ping->new("tcp", $timeout);
+    $p->ping($host);        # Going out of scope closes the connection
+}
+
+# Description:  The new() method creates a new ping object.  Optional
+# parameters may be specified for the protocol to use, the timeout in
+# seconds and the size in bytes of additional data which should be
+# included in the packet.
+#   After the optional parameters are checked, the data is constructed
+# and a socket is opened if appropriate.  The object is returned.
+
+sub new
+{
+    my ($this,
+        $proto,             # Optional protocol to use for pinging
+        $timeout,           # Optional timeout in seconds
+        $data_size          # Optional additional bytes of data
+        ) = @_;
+    my  $class = ref($this) || $this;
+    my  $self = {};
+    my ($cnt,               # Count through data bytes
+        $min_datasize       # Minimum data bytes required
+        );
+
+    bless($self, $class);
+
+    $proto = $def_proto unless $proto;          # Determine the protocol
+    croak("Protocol for ping must be \"tcp\", \"udp\" or \"icmp\"")
+        unless $proto =~ m/^(tcp|udp|icmp)$/;
+    $self->{"proto"} = $proto;
+
+    $timeout = $def_timeout unless $timeout;    # Determine the timeout
+    croak("Default timeout for ping must be greater than 0 seconds")
+        if $timeout <= 0;
+    $self->{"timeout"} = $timeout;
+
+    $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
+    $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
+    croak("Data for ping must be from $min_datasize to $max_datasize bytes")
+        if ($data_size < $min_datasize) || ($data_size > $max_datasize);
+    $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
+    $self->{"data_size"} = $data_size;
+
+    $self->{"data"} = "";                       # Construct data bytes
+    for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
+    {
+        $self->{"data"} .= chr($cnt % 256);
+    }
+
+    $self->{"seq"} = 0;                         # For counting packets
+    if ($self->{"proto"} eq "udp")              # Open a socket
+    {
+        $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
+            croak("Can't udp protocol by name");
+        $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
+            croak("Can't get udp echo port by name");
+        $self->{"fh"} = FileHandle->new();
+        socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
+               $self->{"proto_num"}) ||
+            croak("udp socket error - $!");
+    }
+    elsif ($self->{"proto"} eq "icmp")
+    {
+        croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
+        $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
+                    croak("Can't get icmp protocol by name");
+        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
+        $self->{"fh"} = FileHandle->new();
+        socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
+            croak("icmp socket error - $!");
+    }
+    elsif ($self->{"proto"} eq "tcp")           # Just a file handle for now
+    {
+        $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+            croak("Can't get tcp protocol by name");
+        $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
+            croak("Can't get tcp echo port by name");
+        $self->{"fh"} = FileHandle->new();
+    }
+
+
+    return($self);
+}
+
+# Description: Ping a host name or IP number with an optional timeout.
+# First lookup the host, and return undef if it is not found.  Otherwise
+# perform the specific ping method based on the protocol.  Return the 
+# result of the ping.
+
+sub ping
+{
+    my ($self,
+        $host,              # Name or IP number of host to ping
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+    my ($ip,                # Packed IP number of $host
+        $ret                # The return value
+        );
+
+    croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
+    $timeout = $self->{"timeout"} unless $timeout;
+    croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
+
+    $ip = inet_aton($host);
+    return(undef) unless defined($ip);      # Does host exist?
+
+    if ($self->{"proto"} eq "udp")
+    {
+        $ret = $self->ping_udp($ip, $timeout);
+    }
+    elsif ($self->{"proto"} eq "icmp")
+    {
+        $ret = $self->ping_icmp($ip, $timeout);
+    }
+    elsif ($self->{"proto"} eq "tcp")
+    {
+        $ret = $self->ping_tcp($ip, $timeout);
+    }
+    else
+    {
+        croak("Unknown protocol \"$self->{proto}\" in ping()");
+    }
+    return($ret);
+}
+
+sub ping_icmp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+
+    my $ICMP_ECHOREPLY = 0; # ICMP packet types
+    my $ICMP_ECHO = 8;
+    my $icmp_struct = "C2 S3 A";  # Structure of a minimal ICMP packet
+    my $subcode = 0;        # No ICMP subcode for ECHO and ECHOREPLY
+    my $flags = 0;          # No special flags when opening a socket
+    my $port = 0;           # No port with ICMP
+
+    my ($saddr,             # sockaddr_in with port and ip
+        $checksum,          # Checksum of ICMP packet
+        $msg,               # ICMP packet to send
+        $len_msg,           # Length of $msg
+        $rbits,             # Read bits, filehandles for reading
+        $nfound,            # Number of ready filehandles found
+        $finish_time,       # Time ping should be finished
+        $done,              # set to 1 when we are done
+        $ret,               # Return value
+        $recv_msg,          # Received message including IP header
+        $from_saddr,        # sockaddr_in of sender
+        $from_port,         # Port packet was sent from
+        $from_ip,           # Packed IP of sender
+        $from_type,         # ICMP type
+        $from_subcode,      # ICMP subcode
+        $from_chk,          # ICMP packet checksum
+        $from_pid,          # ICMP packet id
+        $from_seq,          # ICMP packet sequence
+        $from_msg           # ICMP message
+        );
+
+    $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
+    $checksum = 0;                          # No checksum for starters
+    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+    $checksum = Net::Ping->checksum($msg);
+    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+    $len_msg = length($msg);
+    $saddr = sockaddr_in($port, $ip);
+    send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
+
+    $rbits = "";
+    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
+    $ret = 0;
+    $done = 0;
+    $finish_time = time() + $timeout;       # Must be done by this time
+    while (!$done && $timeout > 0)          # Keep trying if we have time
+    {
+        $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
+        $timeout = $finish_time - time();   # Get remaining time
+        if (!defined($nfound))              # Hmm, a strange error
+        {
+            $ret = undef;
+            $done = 1;
+        }
+        elsif ($nfound)                     # Got a packet from somewhere
+        {
+            $recv_msg = "";
+            $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
+            ($from_port, $from_ip) = sockaddr_in($from_saddr);
+            ($from_type, $from_subcode, $from_chk,
+             $from_pid, $from_seq, $from_msg) =
+                unpack($icmp_struct . $self->{"data_size"},
+                       substr($recv_msg, length($recv_msg) - $len_msg,
+                              $len_msg));
+            if (($from_type == $ICMP_ECHOREPLY) &&
+                ($from_ip eq $ip) &&
+                ($from_pid == $self->{"pid"}) && # Does the packet check out?
+                ($from_seq == $self->{"seq"}))
+            {
+                $ret = 1;                   # It's a winner
+                $done = 1;
+            }
+        }
+        else                                # Oops, timed out
+        {
+            $done = 1;
+        }
+    }
+    return($ret)
+}
+
+# Description:  Do a checksum on the message.  Basically sum all of
+# the short words and fold the high order bits into the low order bits.
+
+sub checksum
+{
+    my ($class,
+        $msg            # The message to checksum
+        ) = @_;
+    my ($len_msg,       # Length of the message
+        $num_short,     # The number of short words in the message
+        $short,         # One short word
+        $chk            # The checksum
+        );
+
+    $len_msg = length($msg);
+    $num_short = $len_msg / 2;
+    $chk = 0;
+    foreach $short (unpack("S$num_short", $msg))
+    {
+        $chk += $short;
+    }                                           # Add the odd byte in
+    $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
+    $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
+    return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
+}
+
+# Description:  Perform a tcp echo ping.  Since a tcp connection is
+# host specific, we have to open and close each connection here.  We
+# can't just leave a socket open.  Because of the robust nature of
+# tcp, it will take a while before it gives up trying to establish a
+# connection.  Therefore, we have to set the alarm to break out of the
+# connection sooner if the timeout expires.  No data bytes are actually
+# sent since the successful establishment of a connection is proof
+# enough of the reachability of the remote host.  Also, tcp is
+# expensive and doesn't need our help to add to the overhead.
+
+sub ping_tcp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+    my ($saddr,             # sockaddr_in with port and ip
+        $ret                # The return value
+        );
+                            
+    socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
+        croak("tcp socket error - $!");
+    $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+    $SIG{'ALRM'} = sub { die };
+    alarm($timeout);        # Interrupt connect() if we have to
+            
+    $ret = 0;               # Default to unreachable
+    eval <<'EOM' ;
+        return unless connect($self->{"fh"}, $saddr);
+        $ret = 1;
+EOM
+    alarm(0);
+    $self->{"fh"}->close();
+    return($ret);
+}
+
+# Description:  Perform a udp echo ping.  Construct a message of
+# at least the one-byte sequence number and any additional data bytes.
+# Send the message out and wait for a message to come back.  If we
+# get a message, make sure all of its parts match.  If they do, we are
+# done.  Otherwise go back and wait for the message until we run out
+# of time.  Return the result of our efforts.
+
+sub ping_udp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+
+    my $flags = 0;          # Nothing special on open
+
+    my ($saddr,             # sockaddr_in with port and ip
+        $ret,               # The return value
+        $msg,               # Message to be echoed
+        $finish_time,       # Time ping should be finished
+        $done,              # Set to 1 when we are done pinging
+        $rbits,             # Read bits, filehandles for reading
+        $nfound,            # Number of ready filehandles found
+        $from_saddr,        # sockaddr_in of sender
+        $from_msg,          # Characters echoed by $host
+        $from_port,         # Port message was echoed from
+        $from_ip            # Packed IP number of sender
+        );
+
+    $saddr = sockaddr_in($self->{"port_num"}, $ip);
+    $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
+    $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
+    send($self->{"fh"}, $msg, $flags, $saddr);      # Send it
+
+    $rbits = "";
+    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
+    $ret = 0;                   # Default to unreachable
+    $done = 0;
+    $finish_time = time() + $timeout;       # Ping needs to be done by then
+    while (!$done && $timeout > 0)
+    {
+        $nfound = select($rbits, undef, undef, $timeout); # Wait for response
+        $timeout = $finish_time - time();   # Get remaining time
+
+        if (!defined($nfound))  # Hmm, a strange error
+        {
+            $ret = undef;
+            $done = 1;
+        }
+        elsif ($nfound)         # A packet is waiting
+        {
+            $from_msg = "";
+            $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags);
+            ($from_port, $from_ip) = sockaddr_in($from_saddr);
+            if (($from_ip eq $ip) &&        # Does the packet check out?
+                ($from_port == $self->{"port_num"}) &&
+                ($from_msg eq $msg))
+            {
+                $ret = 1;       # It's a winner
+                $done = 1;
+            }
+        }
+        else                    # Oops, timed out
+        {
+            $done = 1;
+        }
+    }
+    return($ret);
+}   
+
+# Description:  Close the connection unless we are using the tcp
+# protocol, since it will already be closed.
+
+sub close
+{
+    my ($self) = @_;
+
+    $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Net::Ping - check a remote host for reachability
+
+=head1 SYNOPSIS
+
+    use Net::Ping;
+
+    $p = Net::Ping->new();
+    print "$host is alive.\n" if $p->ping($host);
+    $p->close();
+
+    $p = Net::Ping->new("icmp");
+    foreach $host (@host_array)
+    {
+        print "$host is ";
+        print "NOT " unless $p->ping($host, 2);
+        print "reachable.\n";
+        sleep(1);
+    }
+    $p->close();
+    
+    $p = Net::Ping->new("tcp", 2);
+    while ($stop_time > time())
+    {
+        print "$host not reachable ", scalar(localtime()), "\n"
+            unless $p->ping($host);
+        sleep(300);
+    }
+    undef($p);
+    
+    # For backward compatibility
+    print "$host is alive.\n" if pingecho($host);
+
+=head1 DESCRIPTION
+
+This module contains methods to test the reachability of remote
+hosts on a network.  A ping object is first created with optional
+parameters, a variable number of hosts may be pinged multiple
+times and then the connection is closed.
+
+You may choose one of three different protocols to use for the ping.
+With the "tcp" protocol the ping() method attempts to establish a
+connection to the remote host's echo port.  If the connection is
+successfully established, the remote host is considered reachable.  No
+data is actually echoed.  This protocol does not require any special
+privileges but has higher overhead than the other two protocols.
+
+Specifying the "udp" protocol causes the ping() method to send a udp
+packet to the remote host's echo port.  If the echoed packet is
+received from the remote host and the received packet contains the
+same data as the packet that was sent, the remote host is considered
+reachable.  This protocol does not require any special privileges.
+
+If the "icmp" protocol is specified, the ping() method sends an icmp
+echo message to the remote host, which is what the UNIX ping program
+does.  If the echoed message is received from the remote host and
+the echoed information is correct, the remote host is considered
+reachable.  Specifying the "icmp" protocol requires that the program
+be run as root or that the program be setuid to root.
+
+=head2 Functions
+
+=over 4
+
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
+
+Create a new ping object.  All of the parameters are optional.  $proto
+specifies the protocol to use when doing a ping.  The current choices
+are "tcp", "udp" or "icmp".  The default is "udp".
+
+If a default timeout ($def_timeout) in seconds is provided, it is used
+when a timeout is not given to the ping() method (below).  The timeout
+must be greater than 0 and the default, if not specified, is 5 seconds.
+
+If the number of data bytes ($bytes) is given, that many data bytes
+are included in the ping packet sent to the remote host. The number of
+data bytes is ignored if the protocol is "tcp".  The minimum (and
+default) number of data bytes is 1 if the protocol is "udp" and 0
+otherwise.  The maximum number of data bytes that can be specified is
+1024.
+
+=item $p->ping($host [, $timeout]);
+
+Ping the remote host and wait for a response.  $host can be either the
+hostname or the IP number of the remote host.  The optional timeout
+must be greater than 0 seconds and defaults to whatever was specified
+when the ping object was created.  If the hostname cannot be found or
+there is a problem with the IP number, undef is returned.  Otherwise,
+1 is returned if the host is reachable and 0 if it is not.  For all
+practical purposes, undef and 0 and can be treated as the same case.
+
+=item $p->close();
+
+Close the network connection for this ping object.  The network
+connection is also closed by "undef $p".  The network connection is
+automatically closed if the ping object goes out of scope (e.g. $p is
+local to a subroutine and you leave the subroutine).
+
+=item pingecho($host [, $timeout]);
+
+To provide backward compatibility with the previous version of
+Net::Ping, a pingecho() subroutine is available with the same
+functionality as before.  pingecho() uses the tcp protocol.  The
+return values and parameters are the same as described for the ping()
+method.  This subroutine is obsolete and may be removed in a future
+version of Net::Ping.
+
+=back
+
+=head1 WARNING
+
+pingecho() or a ping object with the tcp protocol use alarm() to
+implement the timeout.  So, don't use alarm() in your program while
+you are using pingecho() or a ping object with the tcp protocol.  The
+udp and icmp protocols do not use alarm() to implement the timeout.
+
+=head1 NOTES
+
+There will be less network overhead (and some efficiency in your
+program) if you specify either the udp or the icmp protocol.  The tcp
+protocol will generate 2.5 times or more traffic for each ping than
+either udp or icmp.  If many hosts are pinged frequently, you may wish
+to implement a small wait (e.g. 25ms or more) between each ping to
+avoid flooding your network with packets.
+
+The icmp protocol requires that the program be run as root or that it
+be setuid to root.  The tcp and udp protocols do not require special
+privileges, but not all network devices implement the echo protocol
+for tcp or udp.
+
+Local hosts should normally respond to pings within milliseconds.
+However, on a very congested network it may take up to 3 seconds or
+longer to receive an echo packet from the remote host.  If the timeout
+is set too low under these conditions, it will appear that the remote
+host is not reachable (which is almost the truth).
+
+Reachability doesn't necessarily mean that the remote host is actually
+functioning beyond its ability to echo packets.
+
+Because of a lack of anything better, this module uses its own
+routines to pack and unpack ICMP packets.  It would be better for a
+separate module to be written which understands all of the different
+kinds of ICMP packets.
+
+=cut
diff --git a/contrib/perl5/lib/Net/hostent.pm b/contrib/perl5/lib/Net/hostent.pm
new file mode 100644
index 000000000000..96b090dae5a0
--- /dev/null
+++ b/contrib/perl5/lib/Net/hostent.pm
@@ -0,0 +1,149 @@
+package Net::hostent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
+    @EXPORT_OK   = qw(
+			$h_name	    	@h_aliases
+			$h_addrtype 	$h_length
+			@h_addr_list 	$h_addr
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::hostent' => [
+   name		=> '$',
+   aliases	=> '@',
+   addrtype	=> '$',
+   'length'	=> '$',
+   addr_list	=> '@',
+];
+
+sub addr { shift->addr_list->[0] }
+
+sub populate (@) {
+    return unless @_;
+    my $hob = new();
+    $h_name 	 =    $hob->[0]     	     = $_[0];
+    @h_aliases	 = @{ $hob->[1] } = split ' ', $_[1];
+    $h_addrtype  =    $hob->[2] 	     = $_[2];
+    $h_length	 =    $hob->[3] 	     = $_[3];
+    $h_addr 	 =                             $_[4];
+    @h_addr_list = @{ $hob->[4] } =          @_[ (4 .. $#_) ];
+    return $hob;
+} 
+
+sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) } 
+
+sub gethostbyaddr ($;$) { 
+    my ($addr, $addrtype);
+    $addr = shift;
+    require Socket unless @_;
+    $addrtype = @_ ? shift : Socket::AF_INET();
+    populate(CORE::gethostbyaddr($addr, $addrtype)) 
+} 
+
+sub gethost($) {
+    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
+	require Socket;
+	&gethostbyaddr(Socket::inet_aton(shift));
+    } else {
+	&gethostbyname;
+    } 
+} 
+
+1;
+__END__
+
+=head1 NAME
+
+Net::hostent - by-name interface to Perl's built-in gethost*() functions
+
+=head1 SYNOPSIS
+
+ use Net::hostnet;
+
+=head1 DESCRIPTION
+
+This module's default exports override the core gethostbyname() and
+gethostbyaddr() functions, replacing them with versions that return
+"Net::hostent" objects.  This object has methods that return the similarly
+named structure field name from the C's hostent structure from F<netdb.h>;
+namely name, aliases, addrtype, length, and addr_list.  The aliases and
+addr_list methods return array reference, the rest scalars.  The addr
+method is equivalent to the zeroth element in the addr_list array
+reference.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
+$h_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
+}> would be simply @h_aliases.
+
+The gethost() funtion is a simple front-end that forwards a numeric
+argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
+to gethostbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+ use Net::hostent;
+ use Socket;
+
+ @ARGV = ('netscape.com') unless @ARGV;
+
+ for $host ( @ARGV ) {
+
+    unless ($h = gethost($host)) {
+	warn "$0: no such host: $host\n";
+	next;
+    }
+
+    printf "\n%s is %s%s\n", 
+	    $host, 
+	    lc($h->name) eq lc($host) ? "" : "*really* ",
+	    $h->name;
+
+    print "\taliases are ", join(", ", @{$h->aliases}), "\n"
+		if @{$h->aliases};     
+
+    if ( @{$h->addr_list} > 1 ) { 
+	my $i;
+	for $addr ( @{$h->addr_list} ) {
+	    printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
+	} 
+    } else {
+	printf "\taddress is [%s]\n", inet_ntoa($h->addr);
+    } 
+
+    if ($h = gethostbyaddr($h->addr)) {
+	if (lc($h->name) ne lc($host)) {
+	    printf "\tThat addr reverses to host %s!\n", $h->name;
+	    $host = $h->name;
+	    redo;
+	} 
+    }
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Net/netent.pm b/contrib/perl5/lib/Net/netent.pm
new file mode 100644
index 000000000000..b82447cad71a
--- /dev/null
+++ b/contrib/perl5/lib/Net/netent.pm
@@ -0,0 +1,167 @@
+package Net::netent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getnetbyname getnetbyaddr getnet);
+    @EXPORT_OK   = qw(
+			$n_name	    	@n_aliases
+			$n_addrtype 	$n_net
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::netent' => [
+   name		=> '$',
+   aliases	=> '@',
+   addrtype	=> '$',
+   net		=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $nob = new();
+    $n_name 	 =    $nob->[0]     	     = $_[0];
+    @n_aliases	 = @{ $nob->[1] } = split ' ', $_[1];
+    $n_addrtype  =    $nob->[2] 	     = $_[2];
+    $n_net	 =    $nob->[3] 	     = $_[3];
+    return $nob;
+} 
+
+sub getnetbyname ($)  { populate(CORE::getnetbyname(shift)) } 
+
+sub getnetbyaddr ($;$) { 
+    my ($net, $addrtype);
+    $net = shift;
+    require Socket if @_;
+    $addrtype = @_ ? shift : Socket::AF_INET();
+    populate(CORE::getnetbyaddr($net, $addrtype)) 
+} 
+
+sub getnet($) {
+    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
+	require Socket;
+	&getnetbyaddr(Socket::inet_aton(shift));
+    } else {
+	&getnetbyname;
+    } 
+} 
+
+1;
+__END__
+
+=head1 NAME
+
+Net::netent - by-name interface to Perl's built-in getnet*() functions
+
+=head1 SYNOPSIS
+
+ use Net::netent qw(:FIELDS);
+ getnetbyname("loopback") 		or die "bad net";
+ printf "%s is %08X\n", $n_name, $n_net;
+
+ use Net::netent;
+
+ $n = getnetbyname("loopback") 		or die "bad net";
+ { # there's gotta be a better way, eh?
+     @bytes = unpack("C4", pack("N", $n->net));
+     shift @bytes while @bytes && $bytes[0] == 0;
+ }
+ printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes;
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getnetbyname() and
+getnetbyaddr() functions, replacing them with versions that return
+"Net::netent" objects.  This object has methods that return the similarly
+named structure field name from the C's netent structure from F<netdb.h>;
+namely name, aliases, addrtype, and net.  The aliases 
+method returns an array reference, the rest scalars.  
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<n_>.  Thus, C<$net_obj-E<gt>name()> corresponds to
+$n_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
+}> would be simply @n_aliases.
+
+The getnet() funtion is a simple front-end that forwards a numeric
+argument to getnetbyaddr(), and the rest
+to getnetbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+The getnet() functions do this in the Perl core:
+
+    sv_setiv(sv, (I32)nent->n_net);
+
+The gethost() functions do this in the Perl core:
+
+    sv_setpvn(sv, hent->h_addr, len);
+
+That means that the address comes back in binary for the
+host functions, and as a regular perl integer for the net ones.
+This seems a bug, but here's how to deal with it:
+
+ use strict;
+ use Socket;
+ use Net::netent;
+ 
+ @ARGV = ('loopback') unless @ARGV;
+ 
+ my($n, $net);
+ 
+ for $net ( @ARGV ) {
+ 
+     unless ($n = getnetbyname($net)) {
+ 	warn "$0: no such net: $net\n";
+ 	next;
+     }
+ 
+     printf "\n%s is %s%s\n", 
+ 	    $net, 
+ 	    lc($n->name) eq lc($net) ? "" : "*really* ",
+ 	    $n->name;
+ 
+     print "\taliases are ", join(", ", @{$n->aliases}), "\n"
+ 		if @{$n->aliases};     
+ 
+     # this is stupid; first, why is this not in binary?
+     # second, why am i going through these convolutions
+     # to make it looks right
+     {
+ 	my @a = unpack("C4", pack("N", $n->net));
+ 	shift @a while @a && $a[0] == 0;
+ 	printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a;
+     }
+ 
+     if ($n = getnetbyaddr($n->net)) {
+ 	if (lc($n->name) ne lc($net)) {
+ 	    printf "\tThat addr reverses to net %s!\n", $n->name;
+ 	    $net = $n->name;
+ 	    redo;
+ 	} 
+     }
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Net/protoent.pm b/contrib/perl5/lib/Net/protoent.pm
new file mode 100644
index 000000000000..737ff5a33bcd
--- /dev/null
+++ b/contrib/perl5/lib/Net/protoent.pm
@@ -0,0 +1,94 @@
+package Net::protoent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getprotobyname getprotobynumber getprotoent);
+    @EXPORT_OK   = qw( $p_name @p_aliases $p_proto );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::protoent' => [
+   name		=> '$',
+   aliases	=> '@',
+   proto	=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $pob = new();
+    $p_name 	 =    $pob->[0]     	     = $_[0];
+    @p_aliases	 = @{ $pob->[1] } = split ' ', $_[1];
+    $p_proto	 =    $pob->[2] 	     = $_[2];
+    return $pob;
+} 
+
+sub getprotoent      ( )  { populate(CORE::getprotoent()) } 
+sub getprotobyname   ($)  { populate(CORE::getprotobyname(shift)) } 
+sub getprotobynumber ($)  { populate(CORE::getprotobynumber(shift)) } 
+
+sub getproto ($;$) {
+    no strict 'refs';
+    return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::protoent - by-name interface to Perl's built-in getproto*() functions
+
+=head1 SYNOPSIS
+
+ use Net::protoent;
+ $p = getprotobyname(shift || 'tcp') || die "no proto";
+ printf "proto for %s is %d, aliases are %s\n",
+    $p->name, $p->proto, "@{$p->aliases}";
+
+ use Net::protoent qw(:FIELDS);
+ getprotobyname(shift || 'tcp') || die "no proto";
+ print "proto for $p_name is $p_proto, aliases are @p_aliases\n";
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getprotoent(),
+getprotobyname(), and getnetbyport() functions, replacing them with
+versions that return "Net::protoent" objects.  They take default
+second arguments of "tcp".  This object has methods that return the
+similarly named structure field name from the C's protoent structure
+from F<netdb.h>; namely name, aliases, and proto.  The aliases method
+returns an array reference, the rest scalars.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<p_>.  Thus, C<$proto_obj-E<gt>name()> corresponds to
+$p_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $proto_obj-E<gt>aliases()
+}> would be simply @p_aliases.
+
+The getproto() function is a simple front-end that forwards a numeric
+argument to getprotobyport(), and the rest to getprotobyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Net/servent.pm b/contrib/perl5/lib/Net/servent.pm
new file mode 100644
index 000000000000..fb85dd04bfa6
--- /dev/null
+++ b/contrib/perl5/lib/Net/servent.pm
@@ -0,0 +1,111 @@
+package Net::servent;
+use strict;
+
+BEGIN {
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getservbyname getservbyport getservent getserv);
+    @EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::servent' => [
+   name		=> '$',
+   aliases	=> '@',
+   port		=> '$',
+   proto	=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $sob = new();
+    $s_name 	 =    $sob->[0]     	     = $_[0];
+    @s_aliases	 = @{ $sob->[1] } = split ' ', $_[1];
+    $s_port	 =    $sob->[2] 	     = $_[2];
+    $s_proto	 =    $sob->[3] 	     = $_[3];
+    return $sob;
+}
+
+sub getservent    (   ) { populate(CORE::getservent()) }
+sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) }
+sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) }
+
+sub getserv ($;$) {
+    no strict 'refs';
+    return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::servent - by-name interface to Perl's built-in getserv*() functions
+
+=head1 SYNOPSIS
+
+ use Net::servent;
+ $s = getservbyname(shift || 'ftp') || die "no service";
+ printf "port for %s is %s, aliases are %s\n",
+    $s->name, $s->port, "@{$s->aliases}";
+
+ use Net::servent qw(:FIELDS);
+ getservbyname(shift || 'ftp') || die "no service";
+ print "port for $s_name is $s_port, aliases are @s_aliases\n";
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getservent(),
+getservbyname(), and
+getnetbyport() functions, replacing them with versions that return
+"Net::servent" objects.  They take default second arguments of "tcp".  This object has methods that return the similarly
+named structure field name from the C's servent structure from F<netdb.h>;
+namely name, aliases, port, and proto.  The aliases
+method returns an array reference, the rest scalars.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<n_>.  Thus, C<$serv_obj-E<gt>name()> corresponds to
+$s_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $serv_obj-E<gt>aliases()
+}> would be simply @s_aliases.
+
+The getserv() function is a simple front-end that forwards a numeric
+argument to getservbyport(), and the rest to getservbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+ use Net::servent qw(:FIELDS);
+
+ while (@ARGV) {
+     my ($service, $proto) = ((split m!/!, shift), 'tcp');
+     my $valet = getserv($service, $proto);
+     unless ($valet) {
+         warn "$0: No service: $service/$proto\n"
+         next;
+     }
+     printf "service $service/$proto is port %d\n", $valet->port;
+     print "alias are @s_aliases\n" if @s_aliases;
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Pod/Functions.pm b/contrib/perl5/lib/Pod/Functions.pm
new file mode 100644
index 000000000000..3cc9b385a004
--- /dev/null
+++ b/contrib/perl5/lib/Pod/Functions.pm
@@ -0,0 +1,296 @@
+package Pod::Functions;
+
+#:vi:set ts=20
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(%Kinds %Type %Flavor %Type_Description @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
+prototype	Flow,Misc	get the prototype (if any) of a subroutine
+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/contrib/perl5/lib/Pod/Html.pm b/contrib/perl5/lib/Pod/Html.pm
new file mode 100644
index 000000000000..5d2e07b2af01
--- /dev/null
+++ b/contrib/perl5/lib/Pod/Html.pm
@@ -0,0 +1,1571 @@
+package Pod::Html;
+
+use Pod::Functions;
+use Getopt::Long;	# package for handling command-line parameters
+require Exporter;
+use vars qw($VERSION);
+$VERSION = 1.01;
+@ISA = Exporter;
+@EXPORT = qw(pod2html htmlify);
+use Cwd;
+
+use Carp;
+
+use strict;
+
+use Config;
+
+=head1 NAME
+
+Pod::Html - module to convert pod files to HTML
+
+=head1 SYNOPSIS
+
+    use Pod::Html;
+    pod2html([options]);
+
+=head1 DESCRIPTION
+
+Converts files from pod format (see L<perlpod>) to HTML format.  It
+can automatically generate indexes and cross-references, and it keeps
+a cache of things it knows how to cross-reference.
+
+=head1 ARGUMENTS
+
+Pod::Html takes the following arguments:
+
+=over 4
+
+=item help
+
+    --help
+
+Displays the usage message.
+
+=item htmlroot
+
+    --htmlroot=name
+
+Sets the base URL for the HTML files.  When cross-references are made,
+the HTML root is prepended to the URL.
+
+=item infile
+
+    --infile=name
+
+Specify the pod file to convert.  Input is taken from STDIN if no
+infile is specified.
+
+=item outfile
+
+    --outfile=name
+
+Specify the HTML file to create.  Output goes to STDOUT if no outfile
+is specified.
+
+=item podroot
+
+    --podroot=name
+
+Specify the base directory for finding library pods.
+
+=item podpath
+
+    --podpath=name:...:name
+
+Specify which subdirectories of the podroot contain pod files whose
+HTML converted forms can be linked-to in cross-references.
+
+=item libpods
+
+    --libpods=name:...:name
+
+List of page names (eg, "perlfunc") which contain linkable C<=item>s.
+
+=item netscape
+
+    --netscape
+
+Use Netscape HTML directives when applicable.
+
+=item nonetscape
+
+    --nonetscape
+
+Do not use Netscape HTML directives (default).
+
+=item index
+
+    --index
+
+Generate an index at the top of the HTML file (default behaviour).
+
+=item noindex
+
+    --noindex
+
+Do not generate an index at the top of the HTML file.
+
+
+=item recurse
+
+    --recurse
+
+Recurse into subdirectories specified in podpath (default behaviour).
+
+=item norecurse
+
+    --norecurse
+
+Do not recurse into subdirectories specified in podpath.
+
+=item title
+
+    --title=title
+
+Specify the title of the resulting HTML file.
+
+=item verbose
+
+    --verbose
+
+Display progress messages.
+
+=back
+
+=head1 EXAMPLE
+
+    pod2html("pod2html",
+	     "--podpath=lib:ext:pod:vms", 
+	     "--podroot=/usr/src/perl",
+	     "--htmlroot=/perl/nmanual",
+	     "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
+	     "--recurse",
+	     "--infile=foo.pod",
+	     "--outfile=/perl/nmanual/foo.html");
+
+=head1 AUTHOR
+
+Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
+
+=head1 BUGS
+
+Has trouble with C<> etc in = commands.
+
+=head1 SEE ALSO
+
+L<perlpod>
+
+=head1 COPYRIGHT
+
+This program is distributed under the Artistic License.
+
+=cut
+
+my $dircache = "pod2html-dircache";
+my $itemcache = "pod2html-itemcache";
+
+my @begin_stack = ();		# begin/end stack
+
+my @libpods = ();	    	# files to search for links from C<> directives
+my $htmlroot = "/";	    	# http-server base directory from which all
+				#   relative paths in $podpath stem.
+my $htmlfile = "";		# write to stdout by default
+my $podfile = "";		# read from stdin by default
+my @podpath = ();		# list of directories containing library pods.
+my $podroot = ".";		# filesystem base directory from which all
+				#   relative paths in $podpath stem.
+my $recurse = 1;		# recurse on subdirectories in $podpath.
+my $verbose = 0;		# not verbose by default
+my $doindex = 1;   	    	# non-zero if we should generate an index
+my $listlevel = 0;		# current list depth
+my @listitem = ();		# stack of HTML commands to use when a =item is
+				#   encountered.  the top of the stack is the
+				#   current list.
+my @listdata = ();		# similar to @listitem, but for the text after
+				#   an =item
+my @listend = ();		# similar to @listitem, but the text to use to
+				#   end the list.
+my $ignore = 1;			# whether or not to format text.  we don't
+				#   format text until we hit our first pod
+				#   directive.
+
+my %items_named = ();		# for the multiples of the same item in perlfunc
+my @items_seen = ();
+my $netscape = 0;		# whether or not to use netscape directives.
+my $title;			# title to give the pod(s)
+my $top = 1;			# true if we are at the top of the doc.  used
+				#   to prevent the first <HR> directive.
+my $paragraph;			# which paragraph we're processing (used
+				#   for error messages)
+my %pages = ();			# associative array used to find the location
+				#   of pages referenced by L<> links.
+my %sections = ();		# sections within this page
+my %items = ();			# associative array used to find the location
+				#   of =item directives referenced by C<> links
+my $Is83;                       # is dos with short filenames (8.3)
+
+sub init_globals {
+$dircache = "pod2html-dircache";
+$itemcache = "pod2html-itemcache";
+
+@begin_stack = ();		# begin/end stack
+
+@libpods = ();	    	# files to search for links from C<> directives
+$htmlroot = "/";	    	# http-server base directory from which all
+				#   relative paths in $podpath stem.
+$htmlfile = "";		# write to stdout by default
+$podfile = "";		# read from stdin by default
+@podpath = ();		# list of directories containing library pods.
+$podroot = ".";		# filesystem base directory from which all
+				#   relative paths in $podpath stem.
+$recurse = 1;		# recurse on subdirectories in $podpath.
+$verbose = 0;		# not verbose by default
+$doindex = 1;   	    	# non-zero if we should generate an index
+$listlevel = 0;		# current list depth
+@listitem = ();		# stack of HTML commands to use when a =item is
+				#   encountered.  the top of the stack is the
+				#   current list.
+@listdata = ();		# similar to @listitem, but for the text after
+				#   an =item
+@listend = ();		# similar to @listitem, but the text to use to
+				#   end the list.
+$ignore = 1;			# whether or not to format text.  we don't
+				#   format text until we hit our first pod
+				#   directive.
+
+@items_seen = ();
+%items_named = ();
+$netscape = 0;		# whether or not to use netscape directives.
+$title = '';			# title to give the pod(s)
+$top = 1;			# true if we are at the top of the doc.  used
+				#   to prevent the first <HR> directive.
+$paragraph = '';			# which paragraph we're processing (used
+				#   for error messages)
+%sections = ();		# sections within this page
+
+# These are not reinitialised here but are kept as a cache.
+# See get_cache and related cache management code.
+#%pages = ();			# associative array used to find the location
+				#   of pages referenced by L<> links.
+#%items = ();			# associative array used to find the location
+				#   of =item directives referenced by C<> links
+$Is83=$^O eq 'dos';
+}
+
+sub pod2html {
+    local(@ARGV) = @_;
+    local($/);
+    local $_;
+
+    init_globals();
+
+    $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
+
+    # cache of %pages and %items from last time we ran pod2html
+
+    #undef $opt_help if defined $opt_help;
+
+    # parse the command-line parameters
+    parse_command_line();
+
+    # set some variables to their default values if necessary
+    local *POD;
+    unless (@ARGV && $ARGV[0]) { 
+	$podfile  = "-" unless $podfile;	# stdin
+	open(POD, "<$podfile")
+		|| die "$0: cannot open $podfile file for input: $!\n";
+    } else {
+	$podfile = $ARGV[0];  # XXX: might be more filenames
+	*POD = *ARGV;
+    } 
+    $htmlfile = "-" unless $htmlfile;	# stdout
+    $htmlroot = "" if $htmlroot eq "/";	# so we don't get a //
+
+    # read the pod a paragraph at a time
+    warn "Scanning for sections in input file(s)\n" if $verbose;
+    $/ = "";
+    my @poddata  = <POD>;
+    close(POD);
+
+    # scan the pod for =head[1-6] directives and build an index
+    my $index = scan_headings(\%sections, @poddata);
+
+    unless($index) {
+	warn "No pod in $podfile\n" if $verbose;
+	return;
+    }
+
+    # open the output file
+    open(HTML, ">$htmlfile")
+	    || die "$0: cannot open $htmlfile file for output: $!\n";
+
+    # put a title in the HTML file
+    $title = '';
+    TITLE_SEARCH: {
+	for (my $i = 0; $i < @poddata; $i++) { 
+	    if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
+		for my $para ( @poddata[$i, $i+1] ) { 
+		    last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
+		}
+	    } 
+
+	} 
+    } 
+    if (!$title and $podfile =~ /\.pod$/) {
+	# probably a split pod so take first =head[12] as title
+	for (my $i = 0; $i < @poddata; $i++) { 
+	    last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
+	} 
+	warn "adopted '$title' as title for $podfile\n"
+	    if $verbose and $title;
+    } 
+    if ($title) {
+	$title =~ s/\s*\(.*\)//;
+    } else {
+	warn "$0: no title for $podfile";
+	$podfile =~ /^(.*)(\.[^.\/]+)?$/;
+	$title = ($podfile eq "-" ? 'No Title' : $1);
+	warn "using $title" if $verbose;
+    }
+    print HTML <<END_OF_HEAD;
+<HTML>
+<HEAD>
+<TITLE>$title</TITLE>
+<LINK REV="made" HREF="mailto:$Config{perladmin}">
+</HEAD>
+
+<BODY>
+
+END_OF_HEAD
+
+    # load/reload/validate/cache %pages and %items
+    get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
+
+    # scan the pod for =item directives
+    scan_items("", \%items, @poddata);
+
+    # put an index at the top of the file.  note, if $doindex is 0 we
+    # still generate an index, but surround it with an html comment.
+    # that way some other program can extract it if desired.
+    $index =~ s/--+/-/g;
+    print HTML "<!-- INDEX BEGIN -->\n";
+    print HTML "<!--\n" unless $doindex;
+    print HTML $index;
+    print HTML "-->\n" unless $doindex;
+    print HTML "<!-- INDEX END -->\n\n";
+    print HTML "<HR>\n" if $doindex;
+
+    # now convert this file
+    warn "Converting input file\n" if $verbose;
+    foreach my $i (0..$#poddata) {
+	$_ = $poddata[$i];
+	$paragraph = $i+1;
+	if (/^(=.*)/s) {	# is it a pod directive?
+	    $ignore = 0;
+	    $_ = $1;
+	    if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
+		process_begin($1, $2);
+	    } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
+		process_end($1, $2);
+	    } elsif (/^=cut/) {			# =cut
+		process_cut();
+	    } elsif (/^=pod/) {			# =pod
+		process_pod();
+	    } else {
+		next if @begin_stack && $begin_stack[-1] ne 'html';
+
+		if (/^=(head[1-6])\s+(.*\S)/s) {	# =head[1-6] heading
+		    process_head($1, $2);
+		} elsif (/^=item\s*(.*\S)/sm) {	# =item text
+		    process_item($1);
+		} elsif (/^=over\s*(.*)/) {		# =over N
+		    process_over();
+		} elsif (/^=back/) {		# =back
+		    process_back();
+		} elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
+		    process_for($1,$2);
+		} else {
+		    /^=(\S*)\s*/;
+		    warn "$0: $podfile: unknown pod directive '$1' in "
+		       . "paragraph $paragraph.  ignoring.\n";
+		}
+	    }
+	    $top = 0;
+	}
+	else {
+	    next if $ignore;
+	    next if @begin_stack && $begin_stack[-1] ne 'html';
+	    my $text = $_;
+	    process_text(\$text, 1);
+	    print HTML "<P>\n$text";
+	}
+    }
+
+    # finish off any pending directives
+    finish_list();
+    print HTML <<END_OF_TAIL;
+</BODY>
+
+</HTML>
+END_OF_TAIL
+
+    # close the html file
+    close(HTML);
+
+    warn "Finished\n" if $verbose;
+}
+
+##############################################################################
+
+my $usage;			# see below
+sub usage {
+    my $podfile = shift;
+    warn "$0: $podfile: @_\n" if @_;
+    die $usage;
+}
+
+$usage =<<END_OF_USAGE;
+Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
+           --podpath=<name>:...:<name> --podroot=<name>
+           --libpods=<name>:...:<name> --recurse --verbose --index
+           --netscape --norecurse --noindex
+
+  --flush      - flushes the item and directory caches.
+  --help       - prints this message.
+  --htmlroot   - http-server base directory from which all relative paths
+                 in podpath stem (default is /).
+  --index      - generate an index at the top of the resulting html
+                 (default).
+  --infile     - filename for the pod to convert (input taken from stdin
+                 by default).
+  --libpods    - colon-separated list of pages to search for =item pod
+                 directives in as targets of C<> and implicit links (empty
+                 by default).  note, these are not filenames, but rather
+                 page names like those that appear in L<> links.
+  --netscape   - will use netscape html directives when applicable.
+  --nonetscape - will not use netscape directives (default).
+  --outfile    - filename for the resulting html file (output sent to
+                 stdout by default).
+  --podpath    - colon-separated list of directories containing library
+                 pods.  empty by default.
+  --podroot    - filesystem base directory from which all relative paths
+                 in podpath stem (default is .).
+  --noindex    - don't generate an index at the top of the resulting html.
+  --norecurse  - don't recurse on those subdirectories listed in podpath.
+  --recurse    - recurse on those subdirectories listed in podpath
+                 (default behavior).
+  --title      - title that will appear in resulting html file.
+  --verbose    - self-explanatory
+
+END_OF_USAGE
+
+sub parse_command_line {
+    my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose);
+    my $result = GetOptions(
+			    'flush'      => \$opt_flush,
+			    'help'       => \$opt_help,
+			    'htmlroot=s' => \$opt_htmlroot,
+			    'index!'     => \$opt_index,
+			    'infile=s'   => \$opt_infile,
+			    'libpods=s'  => \$opt_libpods,
+			    'netscape!'  => \$opt_netscape,
+			    'outfile=s'  => \$opt_outfile,
+			    'podpath=s'  => \$opt_podpath,
+			    'podroot=s'  => \$opt_podroot,
+			    'norecurse'  => \$opt_norecurse,
+			    'recurse!'   => \$opt_recurse,
+			    'title=s'    => \$opt_title,
+			    'verbose'    => \$opt_verbose,
+			   );
+    usage("-", "invalid parameters") if not $result;
+
+    usage("-") if defined $opt_help;	# see if the user asked for help
+    $opt_help = "";			# just to make -w shut-up.
+
+    $podfile  = $opt_infile if defined $opt_infile;
+    $htmlfile = $opt_outfile if defined $opt_outfile;
+
+    @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
+    @libpods  = split(":", $opt_libpods) if defined $opt_libpods;
+
+    warn "Flushing item and directory caches\n"
+	if $opt_verbose && defined $opt_flush;
+    unlink($dircache, $itemcache) if defined $opt_flush;
+
+    $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
+    $podroot  = $opt_podroot if defined $opt_podroot;
+
+    $doindex  = $opt_index if defined $opt_index;
+    $recurse  = $opt_recurse if defined $opt_recurse;
+    $title    = $opt_title if defined $opt_title;
+    $verbose  = defined $opt_verbose ? 1 : 0;
+    $netscape = $opt_netscape if defined $opt_netscape;
+}
+
+
+my $saved_cache_key;
+
+sub get_cache {
+    my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
+    my @cache_key_args = @_;
+
+    # A first-level cache:
+    # Don't bother reading the cache files if they still apply
+    # and haven't changed since we last read them.
+
+    my $this_cache_key = cache_key(@cache_key_args);
+
+    return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
+
+    # load the cache of %pages and %items if possible.  $tests will be
+    # non-zero if successful.
+    my $tests = 0;
+    if (-f $dircache && -f $itemcache) {
+	warn "scanning for item cache\n" if $verbose;
+	$tests = load_cache($dircache, $itemcache, $podpath, $podroot);
+    }
+
+    # if we didn't succeed in loading the cache then we must (re)build
+    #  %pages and %items.
+    if (!$tests) {
+	warn "scanning directories in pod-path\n" if $verbose;
+	scan_podpath($podroot, $recurse, 0);
+    }
+    $saved_cache_key = cache_key(@cache_key_args);
+}
+
+sub cache_key {
+    my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
+    return join('!', $dircache, $itemcache, $recurse,
+		@$podpath, $podroot, stat($dircache), stat($itemcache));
+}
+
+#
+# load_cache - tries to find if the caches stored in $dircache and $itemcache
+#  are valid caches of %pages and %items.  if they are valid then it loads
+#  them and returns a non-zero value.
+#
+
+sub load_cache {
+    my($dircache, $itemcache, $podpath, $podroot) = @_;
+    my($tests);
+    local $_;
+
+    $tests = 0;
+
+    open(CACHE, "<$itemcache") ||
+	die "$0: error opening $itemcache for reading: $!\n";
+    $/ = "\n";
+
+    # is it the same podpath?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if (join(":", @$podpath) eq $_);
+
+    # is it the same podroot?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if ($podroot eq $_);
+
+    # load the cache if its good
+    if ($tests != 2) {
+	close(CACHE);
+	return 0;
+    }
+
+    warn "loading item cache\n" if $verbose;
+    while (<CACHE>) {
+	/(.*?) (.*)$/;
+	$items{$1} = $2;
+    }
+    close(CACHE);
+
+    warn "scanning for directory cache\n" if $verbose;
+    open(CACHE, "<$dircache") ||
+	die "$0: error opening $dircache for reading: $!\n";
+    $/ = "\n";
+    $tests = 0;
+
+    # is it the same podpath?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if (join(":", @$podpath) eq $_);
+
+    # is it the same podroot?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if ($podroot eq $_);
+
+    # load the cache if its good
+    if ($tests != 2) {
+	close(CACHE);
+	return 0;
+    }
+
+    warn "loading directory cache\n" if $verbose;
+    while (<CACHE>) {
+	/(.*?) (.*)$/;
+	$pages{$1} = $2;
+    }
+
+    close(CACHE);
+
+    return 1;
+}
+
+#
+# scan_podpath - scans the directories specified in @podpath for directories,
+#  .pod files, and .pm files.  it also scans the pod files specified in
+#  @libpods for =item directives.
+#
+sub scan_podpath {
+    my($podroot, $recurse, $append) = @_;
+    my($pwd, $dir);
+    my($libpod, $dirname, $pod, @files, @poddata);
+
+    unless($append) {
+	%items = ();
+	%pages = ();
+    }
+
+    # scan each directory listed in @podpath
+    $pwd = getcwd();
+    chdir($podroot)
+	|| die "$0: error changing to directory $podroot: $!\n";
+    foreach $dir (@podpath) {
+	scan_dir($dir, $recurse);
+    }
+
+    # scan the pods listed in @libpods for =item directives
+    foreach $libpod (@libpods) {
+	# if the page isn't defined then we won't know where to find it
+	# on the system.
+	next unless defined $pages{$libpod} && $pages{$libpod};
+
+	# if there is a directory then use the .pod and .pm files within it.
+	if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	    #  find all the .pod and .pm files within the directory
+	    $dirname = $1;
+	    opendir(DIR, $dirname) ||
+		die "$0: error opening directory $dirname: $!\n";
+	    @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
+	    closedir(DIR);
+
+	    # scan each .pod and .pm file for =item directives
+	    foreach $pod (@files) {
+		open(POD, "<$dirname/$pod") ||
+		    die "$0: error opening $dirname/$pod for input: $!\n";
+		@poddata = <POD>;
+		close(POD);
+
+		scan_items("$dirname/$pod", @poddata);
+	    }
+
+	    # use the names of files as =item directives too.
+	    foreach $pod (@files) {
+		$pod =~ /^(.*)(\.pod|\.pm)$/;
+		$items{$1} = "$dirname/$1.html" if $1;
+	    }
+	} elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
+		 $pages{$libpod} =~ /([^:]*\.pm):/) {
+	    # scan the .pod or .pm file for =item directives
+	    $pod = $1;
+	    open(POD, "<$pod") ||
+		die "$0: error opening $pod for input: $!\n";
+	    @poddata = <POD>;
+	    close(POD);
+
+	    scan_items("$pod", @poddata);
+	} else {
+	    warn "$0: shouldn't be here (line ".__LINE__."\n";
+	}
+    }
+    @poddata = ();	# clean-up a bit
+
+    chdir($pwd)
+	|| die "$0: error changing to directory $pwd: $!\n";
+
+    # cache the item list for later use
+    warn "caching items for later use\n" if $verbose;
+    open(CACHE, ">$itemcache") ||
+	die "$0: error open $itemcache for writing: $!\n";
+
+    print CACHE join(":", @podpath) . "\n$podroot\n";
+    foreach my $key (keys %items) {
+	print CACHE "$key $items{$key}\n";
+    }
+
+    close(CACHE);
+
+    # cache the directory list for later use
+    warn "caching directories for later use\n" if $verbose;
+    open(CACHE, ">$dircache") ||
+	die "$0: error open $dircache for writing: $!\n";
+
+    print CACHE join(":", @podpath) . "\n$podroot\n";
+    foreach my $key (keys %pages) {
+	print CACHE "$key $pages{$key}\n";
+    }
+
+    close(CACHE);
+}
+
+#
+# scan_dir - scans the directory specified in $dir for subdirectories, .pod
+#  files, and .pm files.  notes those that it finds.  this information will
+#  be used later in order to figure out where the pages specified in L<>
+#  links are on the filesystem.
+#
+sub scan_dir {
+    my($dir, $recurse) = @_;
+    my($t, @subdirs, @pods, $pod, $dirname, @dirs);
+    local $_;
+
+    @subdirs = ();
+    @pods = ();
+
+    opendir(DIR, $dir) ||
+	die "$0: error opening directory $dir: $!\n";
+    while (defined($_ = readdir(DIR))) {
+	if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {	    # directory
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_:";
+	    push(@subdirs, $_);
+	} elsif (/\.pod$/) {	    	    	    	    # .pod
+	    s/\.pod$//;
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_.pod:";
+	    push(@pods, "$dir/$_.pod");
+	} elsif (/\.pm$/) { 	    	    	    	    # .pm
+	    s/\.pm$//;
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_.pm:";
+	    push(@pods, "$dir/$_.pm");
+	}
+    }
+    closedir(DIR);
+
+    # recurse on the subdirectories if necessary
+    if ($recurse) {
+	foreach my $subdir (@subdirs) {
+	    scan_dir("$dir/$subdir", $recurse);
+	}
+    }
+}
+
+#
+# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
+#  build an index.
+#
+sub scan_headings {
+    my($sections, @data) = @_;
+    my($tag, $which_head, $title, $listdepth, $index);
+
+    # here we need	local $ignore = 0;
+    #  unfortunately, we can't have it, because $ignore is lexical
+    $ignore = 0;
+
+    $listdepth = 0;
+    $index = "";
+
+    # scan for =head directives, note their name, and build an index
+    #  pointing to each of them.
+    foreach my $line (@data) {
+	if ($line =~ /^=(head)([1-6])\s+(.*)/) {
+	    ($tag,$which_head, $title) = ($1,$2,$3);
+	    chomp($title);
+	    $$sections{htmlify(0,$title)} = 1;
+
+	    while ($which_head != $listdepth) {
+		if ($which_head > $listdepth) {
+		    $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+		    $listdepth++;
+		} elsif ($which_head < $listdepth) {
+		    $listdepth--;
+		    $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+		}
+	    }
+
+	    $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
+	              "<A HREF=\"#" . htmlify(0,$title) . "\">" .
+		      html_escape(process_text(\$title, 0)) . "</A>";
+	}
+    }
+
+    # finish off the lists
+    while ($listdepth--) {
+	$index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+    }
+
+    # get rid of bogus lists
+    $index =~ s,\t*<UL>\s*</UL>\n,,g;
+
+    $ignore = 1;	# restore old value;
+
+    return $index;
+}
+
+#
+# scan_items - scans the pod specified by $pod for =item directives.  we
+#  will use this information later on in resolving C<> links.
+#
+sub scan_items {
+    my($pod, @poddata) = @_;
+    my($i, $item);
+    local $_;
+
+    $pod =~ s/\.pod$//;
+    $pod .= ".html" if $pod;
+
+    foreach $i (0..$#poddata) {
+	$_ = $poddata[$i];
+
+	# remove any formatting instructions
+	s,[A-Z]<([^<>]*)>,$1,g;
+
+	# figure out what kind of item it is and get the first word of
+	#  it's name.
+	if (/^=item\s+(\w*)\s*.*$/s) {
+	    if ($1 eq "*") {		# bullet list
+		/\A=item\s+\*\s*(.*?)\s*\Z/s;
+		$item = $1;
+	    } elsif ($1 =~ /^\d+/) {	# numbered list
+		/\A=item\s+\d+\.?(.*?)\s*\Z/s;
+		$item = $1;
+	    } else {
+#		/\A=item\s+(.*?)\s*\Z/s;
+		/\A=item\s+(\w*)/s;
+		$item = $1;
+	    }
+
+	    $items{$item} = "$pod" if $item;
+	}
+    }
+}
+
+#
+# process_head - convert a pod head[1-6] tag and convert it to HTML format.
+#
+sub process_head {
+    my($tag, $heading) = @_;
+    my $firstword;
+
+    # figure out the level of the =head
+    $tag =~ /head([1-6])/;
+    my $level = $1;
+
+    # can't have a heading full of spaces and speechmarks and so on
+    $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/;
+
+    print HTML "<P>\n" unless $listlevel;
+    print HTML "<HR>\n" unless $listlevel || $top;
+    print HTML "<H$level>"; # unless $listlevel;
+    #print HTML "<H$level>" unless $listlevel;
+    my $convert = $heading; process_text(\$convert, 0);
+    $convert = html_escape($convert);
+    print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
+    print HTML "</H$level>"; # unless $listlevel;
+    print HTML "\n";
+}
+
+#
+# process_item - convert a pod item tag and convert it to HTML format.
+#
+sub process_item {
+    my $text = $_[0];
+    my($i, $quote, $name);
+
+    my $need_preamble = 0;
+    my $this_entry;
+
+
+    # lots of documents start a list without doing an =over.  this is
+    # bad!  but, the proper thing to do seems to be to just assume
+    # they did do an =over.  so warn them once and then continue.
+    warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n"
+	unless $listlevel;
+    process_over() unless $listlevel;
+
+    return unless $listlevel;
+
+    # remove formatting instructions from the text
+    1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g;
+    pre_escape(\$text);
+
+    $need_preamble = $items_seen[$listlevel]++ == 0;
+
+    # check if this is the first =item after an =over
+    $i = $listlevel - 1;
+    my $need_new = $listlevel >= @listitem;
+
+    if ($text =~ /\A\*/) {		# bullet
+
+	if ($need_preamble) {
+	    push(@listend,  "</UL>");
+	    print HTML "<UL>\n";
+	}
+
+	print HTML '<LI>';
+	if ($text =~ /\A\*\s*(.+)\Z/s) {
+	    print HTML '<STRONG>';
+	    if ($items_named{$1}++) {
+		print HTML html_escape($1);
+	    } else {
+		my $name = 'item_' . htmlify(1,$1);
+		print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+	    }
+	    print HTML '</STRONG>';
+	}
+
+    } elsif ($text =~ /\A[\d#]+/) {	# numbered list
+
+	if ($need_preamble) {
+	    push(@listend,  "</OL>");
+	    print HTML "<OL>\n";
+	}
+
+	print HTML '<LI>';
+	if ($text =~ /\A\d+\.?\s*(.+)\Z/s) {
+	    print HTML '<STRONG>';
+	    if ($items_named{$1}++) {
+		print HTML html_escape($1);
+	    } else {
+		my $name = 'item_' . htmlify(0,$1);
+		print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+	    }
+	    print HTML '</STRONG>';
+	}
+
+    } else {			# all others
+
+	if ($need_preamble) {
+	    push(@listend,  '</DL>');
+	    print HTML "<DL>\n";
+	}
+
+	print HTML '<DT>';
+	if ($text =~ /(\S+)/) {
+	    print HTML '<STRONG>';
+	    if ($items_named{$1}++) {
+		print HTML html_escape($text);
+	    } else {
+		my $name = 'item_' . htmlify(1,$text);
+		print HTML qq(<A NAME="$name">), html_escape($text), '</A>';
+	    }
+	    print HTML '</STRONG>';
+	}
+       print HTML '<DD>';
+    }
+
+    print HTML "\n";
+}
+
+#
+# process_over - process a pod over tag and start a corresponding HTML
+# list.
+#
+sub process_over {
+    # start a new list
+    $listlevel++;
+}
+
+#
+# process_back - process a pod back tag and convert it to HTML format.
+#
+sub process_back {
+    warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignoring.\n"
+	unless $listlevel;
+    return unless $listlevel;
+
+    # close off the list.  note, I check to see if $listend[$listlevel] is
+    # defined because an =item directive may have never appeared and thus
+    # $listend[$listlevel] may have never been initialized.
+    $listlevel--;
+    print HTML $listend[$listlevel] if defined $listend[$listlevel];
+    print HTML "\n";
+
+    # don't need the corresponding perl code anymore
+    pop(@listitem);
+    pop(@listdata);
+    pop(@listend);
+
+    pop(@items_seen);
+}
+
+#
+# process_cut - process a pod cut tag, thus stop ignoring pod directives.
+#
+sub process_cut {
+    $ignore = 1;
+}
+
+#
+# process_pod - process a pod pod tag, thus ignore pod directives until we see a
+# corresponding cut.
+#
+sub process_pod {
+    # no need to set $ignore to 0 cause the main loop did it
+}
+
+#
+# process_for - process a =for pod tag.  if it's for html, split
+# it out verbatim, if illustration, center it, otherwise ignore it.
+#
+sub process_for {
+    my($whom, $text) = @_;
+    if ( $whom =~ /^(pod2)?html$/i) {
+	print HTML $text;
+    } elsif ($whom =~ /^illustration$/i) {
+        1 while chomp $text;
+	for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
+	  $text .= $ext, last if -r "$text$ext";
+	}
+        print HTML qq{<p align = "center"><img src = "$text" alt = "$text illustration"></p>};
+    }
+}
+
+#
+# process_begin - process a =begin pod tag.  this pushes
+# whom we're beginning on the begin stack.  if there's a
+# begin stack, we only print if it us.
+#
+sub process_begin {
+    my($whom, $text) = @_;
+    $whom = lc($whom);
+    push (@begin_stack, $whom);
+    if ( $whom =~ /^(pod2)?html$/) {
+	print HTML $text if $text;
+    }
+}
+
+#
+# process_end - process a =end pod tag.  pop the
+# begin stack.  die if we're mismatched.
+#
+sub process_end {
+    my($whom, $text) = @_;
+    $whom = lc($whom);
+    if ($begin_stack[-1] ne $whom ) {
+	die "Unmatched begin/end at chunk $paragraph\n"
+    } 
+    pop @begin_stack;
+}
+
+#
+# process_text - handles plaintext that appears in the input pod file.
+# there may be pod commands embedded within the text so those must be
+# converted to html commands.
+#
+sub process_text {
+    my($text, $escapeQuotes) = @_;
+    my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf);
+    my($podcommand, $params, $tag, $quote);
+
+    return if $ignore;
+
+    $quote  = 0;    	    	# status of double-quote conversion
+    $result = "";
+    $rest = $$text;
+
+    if ($rest =~ /^\s+/) {	# preformatted text, no pod directives
+	$rest =~ s/\n+\Z//;
+	$rest =~ s#.*#
+	    my $line = $&;
+	    1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
+	    $line;
+	#eg;
+
+	$rest   =~ s/&/&amp;/g;
+	$rest   =~ s/</&lt;/g;
+	$rest   =~ s/>/&gt;/g;
+	$rest   =~ s/"/&quot;/g;
+
+	# try and create links for all occurrences of perl.* within
+	# the preformatted text.
+	$rest =~ s{
+		    (\s*)(perl\w+)
+		  }{
+		    if (defined $pages{$2}) {	# is a link
+			qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
+		    } elsif (defined $pages{dosify($2)}) {	# is a link
+			qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
+		    } else {
+			"$1$2";
+		    }
+		  }xeg;
+	$rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
+
+  my $urls = '(' . join ('|', qw{
+                http
+                telnet
+		mailto
+		news
+                gopher
+                file
+                wais
+                ftp
+            } ) 
+        . ')';
+  
+  my $ltrs = '\w';
+  my $gunk = '/#~:.?+=&%@!\-';
+  my $punc = '.:?\-';
+  my $any  = "${ltrs}${gunk}${punc}";
+
+  $rest =~ s{
+        \b                          # start at word boundary
+        (                           # begin $1  {
+          $urls     :               # need resource and a colon
+          [$any] +?                 # followed by on or more
+                                    #  of any valid character, but
+                                    #  be conservative and take only
+                                    #  what you need to....
+        )                           # end   $1  }
+        (?=                         # look-ahead non-consumptive assertion
+                [$punc]*            # either 0 or more puntuation
+                [^$any]             #   followed by a non-url char
+            |                       # or else
+                $                   #   then end of the string
+        )
+      }{<A HREF="$1">$1</A>}igox;
+
+	$result =   "<PRE>"	# text should be as it is (verbatim)
+		  . "$rest\n"
+		  . "</PRE>\n";
+    } else {			# formatted text
+	# parse through the string, stopping each time we find a
+	# pod-escape.  once the string has been throughly processed
+	# we can output it.
+	while (length $rest) {
+	    # check to see if there are any possible pod directives in
+	    # the remaining part of the text.
+	    if ($rest =~ m/[BCEIFLSZ]</) {
+		warn "\$rest\t= $rest\n" unless
+		    $rest =~ /\A
+			   ([^<]*?)
+			   ([BCEIFLSZ]?)
+			   <
+			   (.*)\Z/xs;
+
+		$s1 = $1;	# pure text
+		$s2 = $2;	# the type of pod-escape that follows
+		$s3 = '<';	# '<'
+		$s4 = $3;	# the rest of the string
+	    } else {
+		$s1 = $rest;
+		$s2 = "";
+		$s3 = "";
+		$s4 = "";
+	    }
+
+	    if ($s3 eq '<' && $s2) {	# a pod-escape
+		$result    .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1);
+		$podcommand = "$s2<";
+		$rest       = $s4;
+
+		# find the matching '>'
+		$match = 1;
+		$bf = 0;
+		while ($match && !$bf) {
+		    $bf = 1;
+		    if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) {
+			$bf = 0;
+			$match++;
+			$podcommand .= $1;
+			$rest        = $2;
+		    } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) {
+			$bf = 0;
+			$match--;
+			$podcommand .= $1;
+			$rest        = $2;
+		    }
+		}
+
+		if ($match != 0) {
+		    warn <<WARN;
+$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph.
+WARN
+		    $result .= substr $podcommand, 0, 2;
+		    $rest = substr($podcommand, 2) . $rest;
+		    next;
+		}
+
+		# pull out the parameters to the pod-escape
+		$podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s;
+		$tag    = $1;
+		$params = $2;
+
+		# process the text within the pod-escape so that any escapes
+		# which must occur do.
+		process_text(\$params, 0) unless $tag eq 'L';
+
+		$s1 = $params;
+		if (!$tag || $tag eq " ") {	#  <> : no tag
+		    $s1 = "&lt;$params&gt;";
+		} elsif ($tag eq "L") {		# L<> : link 
+		    $s1 = process_L($params);
+		} elsif ($tag eq "I" ||		# I<> : italicize text
+			 $tag eq "B" ||		# B<> : bold text
+			 $tag eq "F") {		# F<> : file specification
+		    $s1 = process_BFI($tag, $params);
+		} elsif ($tag eq "C") {		# C<> : literal code
+		    $s1 = process_C($params, 1);
+		} elsif ($tag eq "E") {		# E<> : escape
+		    $s1 = process_E($params);
+		} elsif ($tag eq "Z") {		# Z<> : zero-width character
+		    $s1 = process_Z($params);
+		} elsif ($tag eq "S") {		# S<> : non-breaking space
+		    $s1 = process_S($params);
+		} elsif ($tag eq "X") {		# S<> : non-breaking space
+		    $s1 = process_X($params);
+		} else {
+		    warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n";
+		}
+
+		$result .= "$s1";
+	    } else {
+		# for pure text we must deal with implicit links and
+		# double-quotes among other things.
+		$result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3");
+		$rest    = $s4;
+	    }
+	}
+    }
+    $$text = $result;
+}
+
+sub html_escape {
+    my $rest = $_[0];
+    $rest   =~ s/&/&amp;/g;
+    $rest   =~ s/</&lt;/g;
+    $rest   =~ s/>/&gt;/g;
+    $rest   =~ s/"/&quot;/g;
+    return $rest;
+} 
+
+#
+# process_puretext - process pure text (without pod-escapes) converting
+#  double-quotes and handling implicit C<> links.
+#
+sub process_puretext {
+    my($text, $quote) = @_;
+    my(@words, $result, $rest, $lead, $trail);
+
+    # convert double-quotes to single-quotes
+    $text =~ s/\A([^"]*)"/$1''/s if $$quote;
+    while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {}
+
+    $$quote = ($text =~ m/"/ ? 1 : 0);
+    $text =~ s/\A([^"]*)"/$1``/s if $$quote;
+
+    # keep track of leading and trailing white-space
+    $lead  = ($text =~ /\A(\s*)/s ? $1 : "");
+    $trail = ($text =~ /(\s*)\Z/s ? $1 : "");
+
+    # collapse all white space into a single space
+    $text =~ s/\s+/ /g;
+    @words = split(" ", $text);
+
+    # process each word individually
+    foreach my $word (@words) {
+	# see if we can infer a link
+	if ($word =~ /^\w+\(/) {
+	    # has parenthesis so should have been a C<> ref
+	    $word = process_C($word);
+#	    $word =~ /^[^()]*]\(/;
+#	    if (defined $items{$1} && $items{$1}) {
+#		$word =   "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    } elsif (defined $items{$word} && $items{$word}) {
+#		$word =   "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    } else {
+#		$word =   "\n<CODE><A HREF=\"#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    }
+	} elsif ($word =~ /^[\$\@%&*]+\w+$/) {
+	    # perl variables, should be a C<> ref
+	    $word = process_C($word, 1);
+	} elsif ($word =~ m,^\w+://\w,) {
+	    # looks like a URL
+	    $word = qq(<A HREF="$word">$word</A>);
+	} elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
+	    # looks like an e-mail address
+	    my ($w1, $w2, $w3) = ("", $word, "");
+	    ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
+	    ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
+	    $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
+	} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) {  # all uppercase?
+	    $word = html_escape($word) if $word =~ /["&<>]/;
+	    $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
+	} else { 
+	    $word = html_escape($word) if $word =~ /["&<>]/;
+	}
+    }
+
+    # build a new string based upon our conversion
+    $result = "";
+    $rest   = join(" ", @words);
+    while (length($rest) > 75) {
+	if ( $rest =~ m/^(.{0,75})\s(.*?)$/o ||
+	     $rest =~ m/^(\S*)\s(.*?)$/o) {
+
+	    $result .= "$1\n";
+	    $rest    = $2;
+	} else {
+	    $result .= "$rest\n";
+	    $rest    = "";
+	}
+    }
+    $result .= $rest if $rest;
+
+    # restore the leading and trailing white-space
+    $result = "$lead$result$trail";
+
+    return $result;
+}
+
+#
+# pre_escape - convert & in text to $amp;
+#
+sub pre_escape {
+    my($str) = @_;
+
+    $$str =~ s,&,&amp;,g;
+}
+
+#
+# dosify - convert filenames to 8.3
+#
+sub dosify {
+    my($str) = @_;
+    if ($Is83) {
+        $str = lc $str;
+        $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
+        $str =~ s/(\w+)/substr ($1,0,8)/ge;
+    }
+    return $str;
+}
+
+#
+# process_L - convert a pod L<> directive to a corresponding HTML link.
+#  most of the links made are inferred rather than known about directly
+#  (i.e it's not known whether the =head\d section exists in the target file,
+#   or whether a .pod file exists in the case of split files).  however, the
+#  guessing usually works.
+#
+# Unlike the other directives, this should be called with an unprocessed
+# string, else tags in the link won't be matched.
+#
+sub process_L {
+    my($str) = @_;
+    my($s1, $s2, $linktext, $page, $page83, $section, $link);	# work strings
+
+    $str =~ s/\n/ /g;			# undo word-wrapped tags
+    $s1 = $str;
+    for ($s1) {
+	# LREF: a la HREF L<show this text|man/section>
+	$linktext = $1 if s:^([^|]+)\|::;
+
+	# a :: acts like a /
+	s,::,/,;
+
+	# make sure sections start with a /
+	s,^",/",g;
+	s,^,/,g if (!m,/, && / /);
+
+	# check if there's a section specified
+	if (m,^(.*?)/"?(.*?)"?$,) {	# yes
+	    ($page, $section) = ($1, $2);
+	} else {			# no
+	    ($page, $section) = ($str, "");
+	}
+
+	# check if we know that this is a section in this page
+	if (!defined $pages{$page} && defined $sections{$page}) {
+	    $section = $page;
+	    $page = "";
+	}
+    }
+
+    $page83=dosify($page);
+    $page=$page83 if (defined $pages{$page83});
+    if ($page eq "") {
+	$link = "#" . htmlify(0,$section);
+	$linktext = $section unless defined($linktext);
+    } elsif (!defined $pages{$page}) {
+	warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
+	$link = "";
+	$linktext = $page unless defined($linktext);
+    } else {
+	$linktext  = ($section ? "$section" : "the $page manpage") unless defined($linktext);
+	$section = htmlify(0,$section) if $section ne "";
+
+	# if there is a directory by the name of the page, then assume that an
+	# appropriate section will exist in the subdirectory
+	if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	    $link = "$htmlroot/$1/$section.html";
+
+	# since there is no directory by the name of the page, the section will
+	# have to exist within a .html of the same name.  thus, make sure there
+	# is a .pod or .pm that might become that .html
+	} else {
+	    $section = "#$section";
+	    # check if there is a .pod with the page name
+	    if ($pages{$page} =~ /([^:]*)\.pod:/) {
+		$link = "$htmlroot/$1.html$section";
+	    } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
+		$link = "$htmlroot/$1.html$section";
+	    } else {
+		warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
+			     "no .pod or .pm found\n";
+		$link = "";
+		$linktext = $section unless defined($linktext);
+	    }
+	}
+    }
+
+    process_text(\$linktext, 0);
+    if ($link) {
+	$s1 = "<A HREF=\"$link\">$linktext</A>";
+    } else {
+	$s1 = "<EM>$linktext</EM>";
+    }
+    return $s1;
+}
+
+#
+# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
+# convert them to corresponding HTML directives.
+#
+sub process_BFI {
+    my($tag, $str) = @_;
+    my($s1);			# work string
+    my(%repltext) = (	'B' => 'STRONG',
+			'F' => 'EM',
+			'I' => 'EM');
+
+    # extract the modified text and convert to HTML
+    $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>";
+    return $s1;
+}
+
+#
+# process_C - process the C<> pod-escape.
+#
+sub process_C {
+    my($str, $doref) = @_;
+    my($s1, $s2);
+
+    $s1 = $str;
+    $s1 =~ s/\([^()]*\)//g;	# delete parentheses
+    $s2 = $s1;
+    $s1 =~ s/\W//g;		# delete bogus characters
+    $str = html_escape($str);
+
+    # if there was a pod file that we found earlier with an appropriate
+    # =item directive, then create a link to that page.
+    if ($doref && defined $items{$s1}) {
+	$s1 = ($items{$s1} ?
+	       "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) .  "\">$str</A>" :
+	       "<A HREF=\"#item_" . htmlify(0,$s2) .  "\">$str</A>");
+	$s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; 
+	confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/;
+    } else {
+	$s1 = "<CODE>$str</CODE>";
+	# warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose
+    }
+
+
+    return $s1;
+}
+
+#
+# process_E - process the E<> pod directive which seems to escape a character.
+#
+sub process_E {
+    my($str) = @_;
+
+    for ($str) {
+	s,([^/].*),\&$1\;,g;
+    }
+
+    return $str;
+}
+
+#
+# process_Z - process the Z<> pod directive which really just amounts to
+# ignoring it.  this allows someone to start a paragraph with an =
+#
+sub process_Z {
+    my($str) = @_;
+
+    # there is no equivalent in HTML for this so just ignore it.
+    $str = "";
+    return $str;
+}
+
+#
+# process_S - process the S<> pod directive which means to convert all
+# spaces in the string to non-breaking spaces (in HTML-eze).
+#
+sub process_S {
+    my($str) = @_;
+
+    # convert all spaces in the text to non-breaking spaces in HTML.
+    $str =~ s/ /&nbsp;/g;
+    return $str;
+}
+
+#
+# process_X - this is supposed to make an index entry.  we'll just 
+# ignore it.
+#
+sub process_X {
+    return '';
+}
+
+
+#
+# finish_list - finish off any pending HTML lists.  this should be called
+# after the entire pod file has been read and converted.
+#
+sub finish_list {
+    while ($listlevel > 0) {
+	print HTML "</DL>\n";
+	$listlevel--;
+    }
+}
+
+#
+# htmlify - converts a pod section specification to a suitable section
+# specification for HTML.  if first arg is 1, only takes 1st word.
+#
+sub htmlify {
+    my($compact, $heading) = @_;
+
+    if ($compact) {
+      $heading =~ /^(\w+)/;
+      $heading = $1;
+    } 
+
+  # $heading = lc($heading);
+  $heading =~ s/[^\w\s]/_/g;
+  $heading =~ s/(\s+)/ /g;
+  $heading =~ s/^\s*(.*?)\s*$/$1/s;
+  $heading =~ s/ /_/g;
+  $heading =~ s/\A(.{32}).*\Z/$1/s;
+  $heading =~ s/\s+\Z//;
+  $heading =~ s/_{2,}/_/g;
+
+  return $heading;
+}
+
+BEGIN {
+}
+
+1;
diff --git a/contrib/perl5/lib/Pod/Text.pm b/contrib/perl5/lib/Pod/Text.pm
new file mode 100644
index 000000000000..67993db3f51e
--- /dev/null
+++ b/contrib/perl5/lib/Pod/Text.pm
@@ -0,0 +1,549 @@
+package Pod::Text;
+
+=head1 NAME
+
+Pod::Text - convert POD data to formatted ASCII text
+
+=head1 SYNOPSIS
+
+	use Pod::Text;
+
+	pod2text("perlfunc.pod");
+
+Also:
+
+	pod2text [B<-a>] [B<->I<width>] < 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 the optional options B<-a>
+for an alternative output format, then a B<->I<width> option with the
+max terminal width, followed by one or two arguments. The first
+should be the name of a file to read the pod from, or "E<lt>&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>F<tchrist@mox.perl.com>E<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);
+
+use vars qw($VERSION);
+$VERSION = "1.0203";
+
+$termcap=0;
+
+$opt_alt_format = 0;
+
+#$use_format=1;
+
+$UNDL = "\x1b[4m";
+$INV = "\x1b[7m";
+$BOLD = "\x1b[1m";
+$NORM = "\x1b[0m";
+
+sub pod2text {
+shift if $opt_alt_format = ($_[0] eq '-a');
+
+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{COLUMNS}
+       || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
+       || ($^O ne 'MSWin32' && $^O ne 'dos' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
+       || 72;
+
+@_ = ("<&STDIN") unless @_;
+local($file,*OUTPUT) = @_;
+*OUTPUT = *STDOUT if @_<2;
+
+local $: = $:;
+$: = " \n" if $opt_alt_format;	# Do not break ``-L/lib/'' into ``- L/lib/''.
+
+$/ = "";
+
+$FANCY = 0;
+
+$cutting = 1;
+$DEF_INDENT = 4;
+$indent = $DEF_INDENT;
+$needspace = 0;
+$begun = "";
+
+open(IN, $file) || die "Couldn't open $file: $!";
+
+POD_DIRECTIVE: while (<IN>) {
+    if ($cutting) {
+	next unless /^=/;
+	$cutting = 0;
+    }
+    if ($begun) {
+        if (/^=end\s+$begun/) {
+             $begun = "";
+        }
+        elsif ($begun eq "text") {
+            print OUTPUT $_;
+        }
+        next;
+    }
+    1 while s{^(.*?)(\t+)(.*)$}{
+	$1
+	. (' ' x (length($2) * 8 - length($1) % 8))
+	. $3
+    }me;
+    # Translate verbatim paragraph
+    if (/^\s/) {
+	output($_);
+	next;
+    }
+
+    if (/^=for\s+(\S+)\s*(.*)/s) {
+        if ($1 eq "text") {
+            print OUTPUT $2,"";
+        } else {
+            # ignore unknown for
+        }
+        next;
+    }
+    elsif (/^=begin\s+(\S+)\s*(.*)/s) {
+        $begun = $1;
+        if ($1 eq "text") {
+            print OUTPUT $2."";
+        }
+        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) {
+	    if ($opt_alt_format) {
+		s/[BC]<(.*?)>/``$1''/sg;
+		s/F<(.*?)>/"$1"/sg;
+	    } else {
+		s/C<(.*?)>/`$1'/sg;
+	    }
+	} else {
+	    s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/sge;
+	}
+        # s/[IF]<(.*?)>/italic($1)/ge;
+        s/I<(.*?)>/*$1*/sg;
+        # s/[CB]<(.*?)>/bold($1)/ge;
+	s/X<.*?>//sg;
+
+	# LREF: a la HREF L<show this text|man/section>
+	s:L<([^|>]+)\|[^>]+>:$1: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\""
+	    }
+	}sgex;
+
+        s/[A-Z]<(.*?)>/$1/sg;
+    }
+    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 'pod') {
+	    $cutting = 0;
+	}
+	elsif ($Cmd eq 'head1') {
+	    makespace();
+	    if ($opt_alt_format) {
+		print OUTPUT "\n";
+		s/^(.+?)[ \t]*$/==== $1 ====/;
+	    }
+	    print OUTPUT;
+	    # print OUTPUT uc($_);
+	    $needspace = $opt_alt_format;
+	}
+	elsif ($Cmd eq 'head2') {
+	    makespace();
+	    # s/(\w+)/\u\L$1/g;
+	    #print ' ' x $DEF_INDENT, $_;
+	    # print "\xA7";
+	    s/(\w)/\xA7 $1/ if $FANCY;
+	    if ($opt_alt_format) {
+		s/^(.+?)[ \t]*$/==   $1   ==/;
+		print OUTPUT "\n", $_;
+	    } else {
+		print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
+	    }
+	    $needspace = $opt_alt_format;
+	}
+	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;
+	}
+	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($_, 0);
+		}
+	    }
+	}
+	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"
+	. (($opt_alt_format && $tag_indent > 1)
+	   ? ":" . " " x ($tag_indent - 1)
+	   : " " 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;
+	s/^  /: /s if defined($reformat) && $opt_alt_format;
+	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++;
+    #mask off high bit characters in input stream
+    s/([\200-\377])/"E<".ord($1).">"/ge;
+}
+
+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<
+	    (
+	    	( \d+ )
+	    	| ( [A-Za-z]+ )
+	    )
+	    >	
+    } {
+	 do {
+	 	defined $2
+	 	? chr($2)
+	 	:
+	     defined $HTML_Escapes{$3}
+		? do { $HTML_Escapes{$3} }
+		: do {
+		    warn "Unknown escape: E<$1> 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/contrib/perl5/lib/Search/Dict.pm b/contrib/perl5/lib/Search/Dict.pm
new file mode 100644
index 000000000000..9a229a7bc020
--- /dev/null
+++ b/contrib/perl5/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 = lc $key 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;
+	$_ = lc $_ 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);
+	defined($_ = <FH>)
+	    or last;
+	chop;
+	s/[^\w\s]//g if $dict;
+	$_ = lc $_ if $fold;
+	last if $_ ge $key;
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/contrib/perl5/lib/SelectSaver.pm b/contrib/perl5/lib/SelectSaver.pm
new file mode 100644
index 000000000000..5f569222fcc5
--- /dev/null
+++ b/contrib/perl5/lib/SelectSaver.pm
@@ -0,0 +1,52 @@
+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 = select;
+    my $self = bless [$fh], $_[0];
+    select qualify($_[1], caller) if @_ > 1;
+    $self;
+}
+
+sub DESTROY {
+    my $this = $_[0];
+    select $$this[0];
+}
+
+1;
diff --git a/contrib/perl5/lib/SelfLoader.pm b/contrib/perl5/lib/SelfLoader.pm
new file mode 100644
index 000000000000..a73f68a8c4d7
--- /dev/null
+++ b/contrib/perl5/lib/SelfLoader.pm
@@ -0,0 +1,295 @@
+package SelfLoader;
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(AUTOLOAD);
+$VERSION = "1.08";
+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 $SL_code = $Cache{$AUTOLOAD};
+    unless ($SL_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"};
+        $SL_code = $Cache{$AUTOLOAD};
+        $SL_code = "sub $AUTOLOAD { }"
+            if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
+    }
+    print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
+    eval $SL_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
+
+    local($/) = "\n";
+    while(defined($line = <$fh>) and $line !~ m/^__END__/) {
+        if ($line =~ m/^sub\s+([\w:]+)\s*(\([\\\$\@\%\&\*\;]*\))?/) {
+            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 C<__DATA__> token.  See also
+L<perlsub/"Autoloading">.
+
+=head2 The __DATA__ token
+
+The C<__DATA__> token tells the perl compiler that the perl code
+for compilation is finished. Everything after the C<__DATA__> token
+is available for reading via the filehandle FOOBAR::DATA,
+where FOOBAR is the name of the current package when the C<__DATA__>
+token is reached. This works just the same as C<__END__> does in
+package 'main', but for other modules data after C<__END__> is not
+automatically retreivable , whereas data after C<__DATA__> is.
+The C<__DATA__> token is not recognized in versions of perl prior to
+5.001m.
+
+Note that it is possible to have C<__DATA__> tokens in the same package
+in multiple files, and that the last C<__DATA__> token in a given
+package that is encountered by the compiler is the one accessible
+by the filehandle. This also applies to C<__END__> and main, i.e. if
+the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an 'C<__DATA__>',
+then the C<DATA> filehandle is set to access the data after the C<__DATA__>
+in the module, _not_ the data after the C<__END__> token in the 'main'
+program, since the compiler encounters the 'require'd file later.
+
+=head2 SelfLoader autoloading
+
+The B<SelfLoader> works by the user placing the C<__DATA__>
+token I<after> perl code which needs to be compiled and
+run at 'require' time, but I<before> subroutine declarations
+that can be loaded in later - usually because they may never
+be called.
+
+The B<SelfLoader> will read from the FOOBAR::DATA filehandle to
+load in the data after C<__DATA__>, and load in any subroutine
+when it is called. The costs are the one-time parsing of the
+data after C<__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 B<SelfLoader> will stop reading from C<__DATA__> if
+it encounters the C<__END__> token - just as you would expect.
+If the C<__END__> token is present, and is followed by the
+token DATA, then the B<SelfLoader> leaves the FOOBAR::DATA
+filehandle open on the line after that token.
+
+The B<SelfLoader> exports the C<AUTOLOAD> subroutine to the
+package using the B<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 C<__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 C<__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 B<SelfLoader> and the Autoloader).
+The C<vars> pragma provides an alternative to defining package-level
+globals that will be visible to autoloaded routines. See the documentation
+on B<vars> in the pragma section of L<perlmod>.
+
+=head2 SelfLoader and AutoLoader
+
+The B<SelfLoader> can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the B<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 C<__END__> token to C<__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 B<SelfLoader>.
+
+The B<SelfLoader> works similarly to the AutoLoader, but picks up the
+subs from after the C<__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 C<__DATA__>. Details of the B<AutoLoader> and
+another view of these distinctions can be found in that module's
+documentation.
+
+=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+This section is only relevant if you want to use
+the C<FOOBAR::DATA> together with the B<SelfLoader>.
+
+Data after the C<__DATA__> token in a module is read using the
+FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end
+of the C<__DATA__> section if followed by the token DATA - this is supported
+by the B<SelfLoader>. The C<FOOBAR::DATA> filehandle is left open if an
+C<__END__> followed by a DATA is found, with the filehandle positioned at
+the start of the line after the C<__END__> token. If no C<__END__> token is
+present, or an C<__END__> token with no DATA token on the same line, then
+the filehandle is closed.
+
+The B<SelfLoader> reads from wherever the current
+position of the C<FOOBAR::DATA> filehandle is, until the
+EOF or C<__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 C<__DATA__> token and put your own data after those
+declarations, using the C<__END__> token to mark the end
+of subroutine declarations. You must also ensure that the B<SelfLoader>
+reads first by  calling 'SelfLoader-E<gt>load_stubs();', or by using a
+function which is selfloaded;
+
+or
+
+2. You should read the C<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-E<gt>load_stubs();' to the module to do
+this.
+
+The alternative is to put the stubs in before the C<__DATA__> token BEFORE
+releasing the module, and for this purpose the C<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 C<SelfLoader::AUTOLOAD> to
+every package which requires it. This is done automatically by the
+B<SelfLoader> when it first loads the subs into the cache, but you should
+really specify it in the initialization before the C<__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 B<SelfLoader>, and the B<SelfLoader>
+will ensure that the packages 'foo' and 'baz' correctly have the
+B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
+parsed.
+
+=cut
diff --git a/contrib/perl5/lib/Shell.pm b/contrib/perl5/lib/Shell.pm
new file mode 100644
index 000000000000..f4ef431cc54e
--- /dev/null
+++ b/contrib/perl5/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 {
+	*$AUTOLOAD = sub {
+	    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/contrib/perl5/lib/Symbol.pm b/contrib/perl5/lib/Symbol.pm
new file mode 100644
index 000000000000..5ed6b2667bf2
--- /dev/null
+++ b/contrib/perl5/lib/Symbol.pm
@@ -0,0 +1,139 @@
+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
+
+    use strict refs;
+    print { qualify_to_ref $fh } "foo!\n";
+    $ref = qualify_to_ref $name, $pkg;
+
+    use Symbol qw(delete_package);
+    delete_package('Foo::Bar');
+    print "deleted\n" unless exists $Foo::{'Bar::'};
+
+
+=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" -E<gt> "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.
+
+C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
+returns a glob ref rather than a symbol name, so you can use the result
+even if C<use strict 'refs'> is in effect.
+
+C<Symbol::delete_package> wipes out a whole package namespace.  Note
+this routine is not exported by default--you may want to import it
+explicitly.
+
+=cut
+
+BEGIN { require 5.002; }
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
+@EXPORT_OK = qw(delete_package);
+
+$VERSION = 1.02;
+
+my $genpkg = "Symbol::";
+my $genseq = 0;
+
+my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
+
+#
+# Note that we never _copy_ the glob; we just make a ref to it.
+# If we did copy it, then SVf_FAKE would be set on the copy, and
+# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
+#
+sub gensym () {
+    my $name = "GEN" . $genseq++;
+    my $ref = \*{$genpkg . $name};
+    delete $$genpkg{$name};
+    $ref;
+}
+
+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;
+}
+
+sub qualify_to_ref ($;$) {
+    return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
+}
+
+#
+# of Safe.pm lineage
+#
+sub delete_package ($) {
+    my $pkg = shift;
+
+    # expand to full symbol table name if needed
+
+    unless ($pkg =~ /^main::.*::$/) {
+        $pkg = "main$pkg"	if	$pkg =~ /^::/;
+        $pkg = "main::$pkg"	unless	$pkg =~ /^main::/;
+        $pkg .= '::'		unless	$pkg =~ /::$/;
+    }
+
+    my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
+    my $stem_symtab = *{$stem}{HASH};
+    return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
+
+    my $leaf_glob   = $stem_symtab->{$leaf};
+    my $leaf_symtab = *{$leaf_glob}{HASH};
+
+    %$leaf_symtab = ();
+    delete $stem_symtab->{$leaf};
+}
+
+1;
diff --git a/contrib/perl5/lib/Sys/Hostname.pm b/contrib/perl5/lib/Sys/Hostname.pm
new file mode 100644
index 000000000000..95f9a99a7abf
--- /dev/null
+++ b/contrib/perl5/lib/Sys/Hostname.pm
@@ -0,0 +1,121 @@
+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 E<lt>F<sunds@asictest.sc.ti.com>E<gt>
+
+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 { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] };
+    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";  
+
+  }
+  elsif ($^O eq 'MSWin32') {
+    ($host) = gethostbyname('localhost');
+    chomp($host = `hostname 2> NUL`) unless defined $host;
+    return $host;
+  }
+  else {  # Unix
+
+    # method 2 - syscall is preferred since it avoids tainting problems
+    eval {
+	local $SIG{__DIE__};
+	{
+	    package main;
+	    require "syscall.ph";
+	}
+	$host = "\0" x 65; ## preload scalar
+	syscall(&main::SYS_gethostname, $host, 65) == 0;
+    }
+
+    # method 2a - syscall using systeminfo instead of gethostname
+    #           -- needed on systems like Solaris
+    || eval {
+	local $SIG{__DIE__};
+	{
+	    package main;
+	    require "sys/syscall.ph";
+	    require "sys/systeminfo.ph";
+	}
+	$host = "\0" x 65; ## preload scalar
+	syscall(&main::SYS_systeminfo, &main::SI_HOSTNAME, $host, 65) != -1;
+    }
+
+    # method 3 - trusty old hostname command
+    || eval {
+	local $SIG{__DIE__};
+	$host = `(hostname) 2>/dev/null`; # bsdish
+    }
+
+    # method 4 - sysV uname command (may truncate)
+    || eval {
+	local $SIG{__DIE__};
+	$host = `uname -n 2>/dev/null`; ## sysVish
+    }
+
+    # method 5 - Apollo pre-SR10
+    || eval {
+	local $SIG{__DIE__};
+	($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/contrib/perl5/lib/Sys/Syslog.pm b/contrib/perl5/lib/Sys/Syslog.pm
new file mode 100644
index 000000000000..e8faac71262e
--- /dev/null
+++ b/contrib/perl5/lib/Sys/Syslog.pm
@@ -0,0 +1,276 @@
+package Sys::Syslog;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(openlog closelog setlogmask syslog);
+@EXPORT_OK = qw(setlogsock);
+
+use Socket;
+use Sys::Hostname;
+
+# 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)
+# Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
+#  with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
+
+# Todo: enable connect to try all three types before failing (auto setlogsock)?
+
+=head1 NAME
+
+Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
+
+=head1 SYNOPSIS
+
+    use Sys::Syslog;                          # all except setlogsock, or:
+    use Sys::Syslog qw(:DEFAULT setlogsock);  # default set, plus setlogsock
+
+    setlogsock $sock_type;
+    openlog $ident, $logopt, $facility;
+    syslog $priority, $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 zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
+I<$facility> specifies the part of the system
+
+=item syslog $priority, $format, @args
+
+If I<$priority> permits, 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 setlogsock $sock_type (added in 5.004_02)
+
+Sets the socket type to be used for the next call to
+C<openlog()> or C<syslog()> and returns TRUE on success,
+undef on failure.
+
+A value of 'unix' will connect to the UNIX domain socket returned by
+C<_PATH_LOG> in F<syslog.ph>.  A value of 'inet' will connect to an
+INET socket returned by getservbyname().  Any other value croaks.
+
+The default is for the INET socket to be used.
+
+=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');
+
+    setlogsock('unix');
+    openlog("$program $$", 'ndelay', 'user');
+    syslog('notice', 'fooprogram: this is really done');
+
+    setlogsock('inet');
+    $! = 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<larry@wall.org>E<gt>.
+UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
+with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
+
+=cut
+
+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 setlogsock {
+    local($setsock) = shift;
+    &disconnect if $connected;
+    if (lc($setsock) eq 'unix') {
+        if (defined &_PATH_LOG) {
+            $sock_type = 1;
+        } else {
+            return undef;
+        }
+    } elsif (lc($setsock) eq 'inet') {
+        if (getservbyname('syslog','udp')) {
+            undef($sock_type);
+        } else {
+            return undef;
+        }
+    } else {
+        croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
+    }
+    return 1;
+}
+
+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 (!$whoami && $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",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 = uc $name;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "Sys::Syslog::$name";
+    defined &$name ? &$name : -1;
+}
+
+sub connect {
+    unless ($host) {
+	require Sys::Hostname;
+	my($host_uniq) = Sys::Hostname::hostname();
+	($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
+    }
+    unless ( $sock_type ) {
+        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: $!";
+    } else {
+        my $syslog = &_PATH_LOG                          || croak "_PATH_LOG not found in syslog.ph";
+        my $that = sockaddr_un($syslog)                  || croak "Can't locate $syslog";
+        socket(SYSLOG,AF_UNIX,SOCK_STREAM,0)             || croak "socket: $!";
+        if (!connect(SYSLOG,$that)) {
+            socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0)          || croak "socket: $!";
+            connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
+        }
+    }
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/contrib/perl5/lib/Term/Cap.pm b/contrib/perl5/lib/Term/Cap.pm
new file mode 100644
index 000000000000..1e95ec33b69f
--- /dev/null
+++ b/contrib/perl5/lib/Term/Cap.pm
@@ -0,0 +1,410 @@
+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}) &&
+	    (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos')
+	     ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/i
+	     : $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/\\\\$//) {
+		    defined(my $x = <TERMCAP>) or last;
+		    $_ .= $x; chomp;
+		}
+		last;
+	    }
+	}
+	defined $entry or $entry = '';
+	$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/contrib/perl5/lib/Term/Complete.pm b/contrib/perl5/lib/Term/Complete.pm
new file mode 100644
index 000000000000..275aadeb6514
--- /dev/null
+++ b/contrib/perl5/lib/Term/Complete.pm
@@ -0,0 +1,150 @@
+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 E<lt>tabE<gt>
+
+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 E<lt>delE<gt>, E<lt>bsE<gt>
+
+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 E<lt>tabE<gt> cannot be changed.
+
+=head1 AUTHOR
+
+Wayne Thompson
+
+=cut
+
+CONFIG: {
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
+sub Complete {
+    my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+
+    $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;
+			undef $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/contrib/perl5/lib/Term/ReadLine.pm b/contrib/perl5/lib/Term/ReadLine.pm
new file mode 100644
index 000000000000..470226da910a
--- /dev/null
+++ b/contrib/perl5/lib/Term/ReadLine.pm
@@ -0,0 +1,365 @@
+=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-E<gt>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<"E<lt>$in">, C<"E<gt>out">.
+
+=item Attribs
+
+returns a reference to a hash which describes internal configuration
+of the package. Names of keys in this hash conform to standard
+conventions with the leading C<rl_> stripped.
+
+=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.
+
+If C<Features> method reports a feature C<attribs> as present, the
+method C<Attribs> is not dummy.
+
+=back
+
+=head1 Additional supported functions
+
+Actually C<Term::ReadLine> can use some other package, that will
+support reacher set of commands.
+
+All these commands are callable via method interface and have names
+which conform to standard conventions with the leading C<rl_> stripped.
+
+The stub package included with the perl distribution allows some
+additional methods: 
+
+=over 12
+
+=item C<tkRunning>
+
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method).
+
+=item C<ornaments>
+
+makes the command line stand out by using termcap data.  The argument
+to C<ornaments> should be 0, 1, or a string of a form
+C<"aa,bb,cc,dd">.  Four components of this string should be names of
+I<terminal capacities>, first two will be issued to make the prompt
+standout, last two to make the input line standout.
+
+=item C<newTTY>
+
+takes two arguments which are input filehandle and output filehandle.
+Switches to use these filehandles.
+
+=back
+
+One can check whether the currently loaded ReadLine package supports
+these methods by checking for corresponding C<Features>.
+
+=head1 EXPORTS
+
+None
+
+=head1 ENVIRONMENT
+
+The envrironment variable C<PERL_RL> governs which ReadLine clone is
+loaded. If the value is false, a dummy interface is used. If the value
+is true, it should be tail of the name of the package to use, such as
+C<Perl> or C<Gnu>.  
+
+As a special case, if the value of this variable is space-separated,
+the tail might be used to disable the ornaments by setting the tail to
+be C<o=0> or C<ornaments=0>.  The head should be as described above, say
+
+If the variable is not set, or if the head of space-separated list is
+empty, the best available package is loaded.
+
+  export "PERL_RL=Perl o=0"	# Use Perl ReadLine without ornaments
+  export "PERL_RL= o=0"		# Use best available ReadLine without ornaments
+
+(Note that processing of C<PERL_RL> for ornaments is in the discretion of the 
+particular used C<Term::ReadLine::*> package).
+
+=cut
+
+package Term::ReadLine::Stub;
+@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
+
+$DB::emacs = $DB::emacs;	# To peacify -w
+*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
+
+sub ReadLine {'Term::ReadLine::Stub'}
+sub readline {
+  my $self = shift;
+  my ($in,$out,$str) = @$self;
+  print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2]; 
+  $self->register_Tk 
+     if not $Term::ReadLine::registered and $Term::ReadLine::toloop
+	and defined &Tk::DoOneEvent;
+  #$str = scalar <$in>;
+  $str = $self->get_line;
+  print $out $rl_term_set[3]; 
+  # 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" or $^O eq 'MSWin32') {
+	$console = "con";
+    } else {
+	$console = "sys\$command";
+    }
+
+    if (($^O eq 'amigaos') || ($^O eq 'beos')) {
+	$console = undef;
+    }
+    elsif ($^O eq 'os2') {
+      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, $ret);
+  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);
+    $ret = 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);
+    $ret = bless [$FIN, $FOUT];
+  }
+  if ($ret->Features->{ornaments} 
+      and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
+    local $Term::ReadLine::termcap_nowarn = 1;
+    $ret->ornaments(1);
+  }
+  return $ret;
+}
+
+sub newTTY {
+  my ($self, $in, $out) = @_;
+  $self->[0] = $in;
+  $self->[1] = $out;
+  my $sel = select($out);
+  $| = 1;				# for DB::OUT
+  select($sel);
+}
+
+sub IN { shift->[0] }
+sub OUT { shift->[1] }
+sub MinLine { undef }
+sub Attribs { {} }
+
+my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
+sub Features { \%features }
+
+package Term::ReadLine;		# So late to allow the above code be defined?
+
+my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
+if ($which) {
+  if ($which =~ /\bgnu\b/i){
+    eval "use Term::ReadLine::Gnu;";
+  } elsif ($which =~ /\bperl\b/i) {
+    eval "use Term::ReadLine::Perl;";
+  } else {
+    eval "use Term::ReadLine::$which;";
+  }
+} elsif (defined $which and $which ne '') {	# Defined but false
+  # Do nothing fancy
+} else {
+  eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
+}
+
+#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);
+}
+
+package Term::ReadLine::TermCap;
+
+# Prompt-start, prompt-end, command-line-start, command-line-end
+#     -- zero-width beautifies to emit around prompt and the command line.
+@rl_term_set = ("","","","");
+# string encoded:
+$rl_term_set = ',,,';
+
+sub LoadTermCap {
+  return if defined $terminal;
+  
+  require Term::Cap;
+  $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
+}
+
+sub ornaments {
+  shift;
+  return $rl_term_set unless @_;
+  $rl_term_set = shift;
+  $rl_term_set ||= ',,,';
+  $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
+  my @ts = split /,/, $rl_term_set, 4;
+  eval { LoadTermCap };
+  unless (defined $terminal) {
+    warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
+    $rl_term_set = ',,,';
+    return;
+  }
+  @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
+  return $rl_term_set;
+}
+
+
+package Term::ReadLine::Tk;
+
+$count_handle = $count_DoOne = $count_loop = 0;
+
+sub handle {$giveup = 1; $count_handle++}
+
+sub Tk_loop {
+  # Tk->tkwait('variable',\$giveup);	# needs Widget
+  $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
+  $count_loop++;
+  $giveup = 0;
+}
+
+sub register_Tk {
+  my $self = shift;
+  $Term::ReadLine::registered++ 
+    or Tk->fileevent($self->IN,'readable',\&handle);
+}
+
+sub tkRunning {
+  $Term::ReadLine::toloop = $_[1] if @_ > 1;
+  $Term::ReadLine::toloop;
+}
+
+sub get_c {
+  my $self = shift;
+  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  return getc $self->IN;
+}
+
+sub get_line {
+  my $self = shift;
+  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  my $in = $self->IN;
+  local ($/) = "\n";
+  return scalar <$in>;
+}
+
+1;
+
diff --git a/contrib/perl5/lib/Test.pm b/contrib/perl5/lib/Test.pm
new file mode 100644
index 000000000000..6f57415efdc1
--- /dev/null
+++ b/contrib/perl5/lib/Test.pm
@@ -0,0 +1,235 @@
+use strict;
+package Test;
+use Test::Harness 1.1601 ();
+use Carp;
+use vars (qw($VERSION @ISA @EXPORT $ntest $TestLevel), #public-ish
+	  qw($ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish
+$VERSION = '1.04';
+require Exporter;
+@ISA=('Exporter');
+@EXPORT= qw(&plan &ok &skip $ntest);
+
+$TestLevel = 0;		# how many extra stack frames to skip
+$|=1;
+#$^W=1;  ?
+$ntest=1;
+
+# Use of this variable is strongly discouraged.  It is set mainly to
+# help test coverage analyzers know which test is running.
+$ENV{REGRESSION_TEST} = $0;
+
+sub plan {
+    croak "Test::plan(%args): odd number of arguments" if @_ & 1;
+    croak "Test::plan(): should not be called more than once" if $planned;
+    my $max=0;
+    for (my $x=0; $x < @_; $x+=2) {
+	my ($k,$v) = @_[$x,$x+1];
+	if ($k =~ /^test(s)?$/) { $max = $v; }
+	elsif ($k eq 'todo' or 
+	       $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
+	elsif ($k eq 'onfail') { 
+	    ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
+	    $ONFAIL = $v; 
+	}
+	else { carp "Test::plan(): skipping unrecognized directive '$k'" }
+    }
+    my @todo = sort { $a <=> $b } keys %todo;
+    if (@todo) {
+	print "1..$max todo ".join(' ', @todo).";\n";
+    } else {
+	print "1..$max\n";
+    }
+    ++$planned;
+}
+
+sub to_value {
+    my ($v) = @_;
+    (ref $v or '') eq 'CODE' ? $v->() : $v;
+}
+
+# STDERR is NOT used for diagnostic output which should have been
+# fixed before release.  Is this appropriate?
+
+sub ok ($;$$) {
+    croak "ok: plan before you test!" if !$planned;
+    my ($pkg,$file,$line) = caller($TestLevel);
+    my $repetition = ++$history{"$file:$line"};
+    my $context = ("$file at line $line".
+		   ($repetition > 1 ? " fail \#$repetition" : ''));
+    my $ok=0;
+    my $result = to_value(shift);
+    my ($expected,$diag);
+    if (@_ == 0) {
+	$ok = $result;
+    } else {
+	$expected = to_value(shift);
+	# until regex can be manipulated like objects...
+	my ($regex,$ignore);
+	if (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
+	    ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
+	    $ok = $result =~ /$regex/;
+	} else {
+	    $ok = $result eq $expected;
+	}
+    }
+    if ($todo{$ntest}) {
+	if ($ok) { 
+	    print "ok $ntest # Wow! ($context)\n";
+	} else {
+	    $diag = to_value(shift) if @_;
+	    if (!$diag) {
+		print "not ok $ntest # (failure expected in $context)\n";
+	    } else {
+		print "not ok $ntest # (failure expected: $diag)\n";
+	    }
+	}
+    } else {
+	print "not " if !$ok;
+	print "ok $ntest\n";
+	
+	if (!$ok) {
+	    my $detail = { 'repetition' => $repetition, 'package' => $pkg,
+			   'result' => $result };
+	    $$detail{expected} = $expected if defined $expected;
+	    $diag = $$detail{diagnostic} = to_value(shift) if @_;
+	    if (!defined $expected) {
+		if (!$diag) {
+		    print STDERR "# Failed test $ntest in $context\n";
+		} else {
+		    print STDERR "# Failed test $ntest in $context: $diag\n";
+		}
+	    } else {
+		my $prefix = "Test $ntest";
+		print STDERR "# $prefix got: '$result' ($context)\n";
+		$prefix = ' ' x (length($prefix) - 5);
+		if (!$diag) {
+		    print STDERR "# $prefix Expected: '$expected'\n";
+		} else {
+		    print STDERR "# $prefix Expected: '$expected' ($diag)\n";
+		}
+	    }
+	    push @FAILDETAIL, $detail;
+	}
+    }
+    ++ $ntest;
+    $ok;
+}
+
+sub skip ($$;$$) {
+    if (to_value(shift)) {
+	print "ok $ntest # skip\n";
+	++ $ntest;
+	1;
+    } else {
+	local($TestLevel) = $TestLevel+1;  #ignore this stack frame
+	&ok;
+    }
+}
+
+END {
+    $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+  Test - provides a simple framework for writing test scripts
+
+=head1 SYNOPSIS
+
+  use strict;
+  use Test;
+  BEGIN { plan tests => 13, todo => [3,4] }
+
+  ok(0); # failure
+  ok(1); # success
+
+  ok(0); # ok, expected failure (see todo list, above)
+  ok(1); # surprise success!
+
+  ok(0,1);             # failure: '0' ne '1'
+  ok('broke','fixed'); # failure: 'broke' ne 'fixed'
+  ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
+
+  ok(sub { 1+1 }, 2);  # success: '2' eq '2'
+  ok(sub { 1+1 }, 3);  # failure: '2' ne '3'
+  ok(0, int(rand(2));  # (just kidding! :-)
+
+  my @list = (0,0);
+  ok @list, 3, "\@list=".join(',',@list);      #extra diagnostics
+  ok 'segmentation fault', '/(?i)success/';    #regex match
+
+  skip($feature_is_missing, ...);    #do platform specific test
+
+=head1 DESCRIPTION
+
+Test::Harness expects to see particular output when it executes tests.
+This module aims to make writing proper test scripts just a little bit
+easier (and less error prone :-).
+
+=head1 TEST TYPES
+
+=over 4
+
+=item * NORMAL TESTS
+
+These tests are expected to succeed.  If they don't, something's
+screwed up!
+
+=item * SKIPPED TESTS
+
+Skip tests need a platform specific feature that might or might not be
+available.  The first argument should evaluate to true if the required
+feature is NOT available.  After the first argument, skip tests work
+exactly the same way as do normal tests.
+
+=item * TODO TESTS
+
+TODO tests are designed for maintaining an executable TODO list.
+These tests are expected NOT to succeed (otherwise the feature they
+test would be on the new feature list, not the TODO list).
+
+Packages should NOT be released with successful TODO tests.  As soon
+as a TODO test starts working, it should be promoted to a normal test
+and the newly minted feature should be documented in the release
+notes.
+
+=back
+
+=head1 ONFAIL
+
+  BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
+
+The test failures can trigger extra diagnostics at the end of the test
+run.  C<onfail> is passed an array ref of hash refs that describe each
+test failure.  Each hash will contain at least the following fields:
+package, repetition, and result.  (The file, line, and test number are
+not included because their correspondance to a particular test is
+fairly weak.)  If the test had an expected value or a diagnostic
+string, these will also be included.
+
+This optional feature might be used simply to print out the version of
+your package and/or how to report problems.  It might also be used to
+generate extremely sophisticated diagnostics for a particular test
+failure.  It's not a panacea, however.  Core dumps or other
+unrecoverable errors will prevent the C<onfail> hook from running.
+(It is run inside an END block.)  Besides, C<onfail> is probably
+over-kill in the majority of cases.  (Your test code should be simpler
+than the code it is testing, yes?)
+
+=head1 SEE ALSO
+
+L<Test::Harness> and various test coverage analysis tools.
+
+=head1 AUTHOR
+
+Copyright (C) 1998 Joshua Nathaniel Pritikin.  All rights reserved.
+
+This package is free software and is provided "as is" without express
+or implied warranty.  It may be used, redistributed and/or modified
+under the terms of the Perl Artistic License (see
+http://www.perl.com/perl/misc/Artistic.html)
+
+=cut
diff --git a/contrib/perl5/lib/Test/Harness.pm b/contrib/perl5/lib/Test/Harness.pm
new file mode 100644
index 000000000000..9c61d3a9ddde
--- /dev/null
+++ b/contrib/perl5/lib/Test/Harness.pm
@@ -0,0 +1,473 @@
+package Test::Harness;
+
+BEGIN {require 5.002;}
+use Exporter;
+use Benchmark;
+use Config;
+use FileHandle;
+use strict;
+
+use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
+	    @ISA @EXPORT @EXPORT_OK);
+$have_devel_corestack = 0;
+
+$VERSION = "1.1602";
+
+# Some experimental versions of OS/2 build have broken $?
+my $ignore_exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
+
+my $files_in_dir = $ENV{HARNESS_FILELEAK_IN_DIR};
+
+my $tests_skipped = 0;
+my $subtests_skipped = 0;
+
+@ISA=('Exporter');
+@EXPORT= qw(&runtests);
+@EXPORT_OK= qw($verbose $switches);
+
+format STDOUT_TOP =
+Failed Test  Status Wstat Total Fail  Failed  List of failed
+-------------------------------------------------------------------------------
+.
+
+format STDOUT =
+@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##%  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+{ $curtest->{name},
+                $curtest->{estat},
+                    $curtest->{wstat},
+                          $curtest->{max},
+                                $curtest->{failed},
+                                     $curtest->{percent},
+                                              $curtest->{canon}
+}
+~~                                            ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                              $curtest->{canon}
+.
+
+
+$verbose = 0;
+$switches = "-w";
+
+sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f }
+
+sub runtests {
+    my(@tests) = @_;
+    local($|) = 1;
+    my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests);
+    my $totmax = 0;
+    my $files = 0;
+    my $bad = 0;
+    my $good = 0;
+    my $total = @tests;
+
+    # pass -I flags to children
+    my $old5lib = $ENV{PERL5LIB};
+    local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC);
+
+    if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g }
+
+    my @dir_files = globdir $files_in_dir if defined $files_in_dir;
+    my $t_start = new Benchmark;
+    while ($test = shift(@tests)) {
+	$te = $test;
+	chop($te);
+	if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
+	print "$te" . '.' x (20 - length($te));
+	my $fh = new FileHandle;
+	$fh->open($test) or print "can't open $test. $!\n";
+	my $first = <$fh>;
+	my $s = $switches;
+	$s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
+	$fh->close or print "can't close $test. $!\n";
+	my $cmd = ($ENV{'COMPILE_TEST'})? 
+"./perl -I../lib ../utils/perlcc $test -run -verbose dcf -log ./compilelog |" 
+															:  "$^X $s $test|";
+	$cmd = "MCR $cmd" if $^O eq 'VMS';
+	$fh->open($cmd) or print "can't run $test. $!\n";
+	$ok = $next = $max = 0;
+	@failed = ();
+	my %todo = ();
+        my $bonus = 0;
+	my $skipped = 0;
+	while (<$fh>) {
+	    if( $verbose ){
+		print $_;
+	    }
+	    if (/^1\.\.([0-9]+) todo([\d\s]+)\;/) {
+		$max = $1;
+		for (split(/\s+/, $2)) { $todo{$_} = 1; }
+		$totmax += $max;
+		$files++;
+		$next = 1;
+	    } elsif (/^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;
+		    if (!$todo{$this}) {
+			push @failed, $this;
+		    } else {
+			$ok++;
+			$totok++;
+		    }
+		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
+		    $this = $1 if $1 > 0;
+		    $ok++;
+		    $totok++;
+		    $skipped++ if defined $2;
+		    $bonus++, $totbonus++ if $todo{$this};
+		}
+		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 "Confused test output: test $this answered after test ", $next-1, "\n";
+		    $next = $this;
+		}
+		$next = $this + 1;
+	    }
+	}
+	$fh->close; # must close to reap child resource values
+	my $wstatus = $ignore_exitcode ? 0 : $?;	# Can trust $? ?
+	my $estatus;
+	$estatus = ($^O eq 'VMS'
+		       ? eval 'use vmsish "status"; $estatus = $?'
+		       : $wstatus >> 8);
+	if ($wstatus) {
+	    my ($failed, $canon, $percent) = ('??', '??');
+	    printf "dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
+		    $wstatus,$wstatus;
+	    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
+	    if (corestatus($wstatus)) { # until we have a wait module
+		if ($have_devel_corestack) {
+		    Devel::CoreStack::stack($^X);
+		} else {
+		    print "\ttest program seems to have generated a core\n";
+		}
+	    }
+	    $bad++;
+	    if ($max) {
+	      if ($next == $max + 1 and not @failed) {
+		print "\tafter all the subtests completed successfully\n";
+		$percent = 0;
+		$failed = 0;	# But we do not set $canon!
+	      } else {
+		push @failed, $next..$max;
+		$failed = @failed;
+		(my $txt, $canon) = canonfailed($max,@failed);
+		$percent = 100*(scalar @failed)/$max;
+		print "DIED. ",$txt;
+	      }
+	    }
+	    $failedtests{$test} = { canon => $canon,  max => $max || '??',
+				    failed => $failed, 
+				    name => $test, percent => $percent,
+				    estat => $estatus, wstat => $wstatus,
+				  };
+	} elsif ($ok == $max && $next == $max+1) {
+	    if ($max and $skipped + $bonus) {
+		my @msg;
+		push(@msg, "$skipped subtest".($skipped>1?'s':'')." skipped")
+		    if $skipped;
+		push(@msg, "$bonus subtest".($bonus>1?'s':'').
+		     " unexpectedly succeeded")
+		    if $bonus;
+		print "ok, ".join(', ', @msg)."\n";
+	    } elsif ($max) {
+		print "ok\n";
+	    } else {
+		print "skipping test on this platform\n";
+		$tests_skipped++;
+	    }
+	    $good++;
+	} elsif ($max) {
+	    if ($next <= $max) {
+		push @failed, $next..$max;
+	    }
+	    if (@failed) {
+		my ($txt, $canon) = canonfailed($max,@failed);
+		print $txt;
+		$failedtests{$test} = { canon => $canon,  max => $max,
+					failed => scalar @failed,
+					name => $test, percent => 100*(scalar @failed)/$max,
+					estat => '', wstat => '',
+				      };
+	    } else {
+		print "Don't know which tests failed: got $ok ok, expected $max\n";
+		$failedtests{$test} = { canon => '??',  max => $max,
+					failed => '??', 
+					name => $test, percent => undef,
+					estat => '', wstat => '',
+				      };
+	    }
+	    $bad++;
+	} elsif ($next == 0) {
+	    print "FAILED before any test output arrived\n";
+	    $bad++;
+	    $failedtests{$test} = { canon => '??',  max => '??',
+				    failed => '??',
+				    name => $test, percent => undef,
+				    estat => '', wstat => '',
+				  };
+	}
+	$subtests_skipped += $skipped;
+	if (defined $files_in_dir) {
+	    my @new_dir_files = globdir $files_in_dir;
+	    if (@new_dir_files != @dir_files) {
+		my %f;
+		@f{@new_dir_files} = (1) x @new_dir_files;
+		delete @f{@dir_files};
+		my @f = sort keys %f;
+		print "LEAKED FILES: @f\n";
+		@dir_files = @new_dir_files;
+	    }
+	}
+    }
+    my $t_total = timediff(new Benchmark, $t_start);
+    
+    if ($^O eq 'VMS') {
+	if (defined $old5lib) {
+	    $ENV{PERL5LIB} = $old5lib;
+	} else {
+	    delete $ENV{PERL5LIB};
+	}
+    }
+    my $bonusmsg = '';
+    $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':'').
+	       " UNEXPECTEDLY SUCCEEDED)")
+	if $totbonus;
+    if ($tests_skipped) {
+	$bonusmsg .= ", $tests_skipped test" . ($tests_skipped != 1 ? 's' : '') .
+			' skipped';
+    }
+    if ($subtests_skipped) {
+	$bonusmsg .= ($tests_skipped ? ', plus ' : ', '). 
+			"$subtests_skipped subtest"
+			. ($subtests_skipped != 1 ? 's' : '') .
+			" skipped";
+    }
+    if ($bad == 0 && $totmax) {
+	print "All tests successful$bonusmsg.\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;
+	my $script;
+	for $script (sort keys %failedtests) {
+	  $curtest = $failedtests{$script};
+	  write;
+	}
+	if ($bad) {
+	    $bonusmsg =~ s/^,\s*//;
+	    print "$bonusmsg.\n" if $bonusmsg;
+	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
+	}
+    }
+    printf("Files=%d,  Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
+
+    return ($bad == 0 && $totmax) ;
+}
+
+my $tried_devel_corestack;
+sub corestatus {
+    my($st) = @_;
+    my($ret);
+
+    eval {require 'wait.ph'};
+    if ($@) {
+      SWITCH: {
+	    $ret = ($st & 0200); # Tim says, this is for 90%
+	}
+    } else {
+	$ret = WCOREDUMP($st);
+    }
+
+    eval { require Devel::CoreStack; $have_devel_corestack++ } 
+      unless $tried_devel_corestack++;
+
+    $ret;
+}
+
+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;
+    my $canon;
+    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";
+	$canon = "@canon";
+    } else {
+	push @result, "FAILED test $last\n";
+	$canon = $last;
+    }
+
+    push @result, "\tFailed $failed/$max tests, ";
+    push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
+    my $txt = join "", @result;
+    ($txt, $canon);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Test::Harness - run perl standard test scripts with statistics
+
+=head1 SYNOPSIS
+
+use Test::Harness;
+
+runtests(@tests);
+
+=head1 DESCRIPTION
+
+(By using the L<Test> module, you can write test scripts without
+knowing the exact output this module expects.  However, if you need to
+know the specifics, read on!)
+
+Perl test scripts print to standard output C<"ok N"> for each single
+test, where C<N> is an increasing sequence of integers. The first line
+output by a standard test script is C<"1..M"> with C<M> being the
+number of tests that should be run within the test
+script. Test::Harness::runtests(@tests) runs all the testscripts
+named as arguments and checks standard output for the expected
+C<"ok N"> strings.
+
+After all tests have been performed, runtests() prints some
+performance statistics that are computed by the Benchmark module.
+
+=head2 The test script output
+
+Any output from the testscript to standard error is ignored and
+bypassed, thus will be seen by the user. Lines written to standard
+output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
+runtests().  All other lines are discarded.
+
+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 runtests() display the standard output of the script
+without altering the behavior otherwise.
+
+The global variable $Test::Harness::switches is exportable and can be
+used to set perl command line options used for running the test
+script(s). The default value is C<-w>.
+
+If the standard output line contains substring C< # Skip> (with
+variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
+counted as a skipped test.  If the whole testscript succeeds, the
+count of skipped tests is included in the generated output.
+
+=head1 EXPORT
+
+C<&runtests> 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 C<$? E<gt>E<gt> 8> and C<$?> 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 ENVIRONMENT
+
+Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status
+of child processes.
+
+If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness
+will check after each test whether new files appeared in that directory,
+and report them as
+
+  LEAKED FILES: scr.tmp 0 my.db
+
+If relative, directory name is with respect to the current directory at
+the moment runtests() was called.  Putting absolute path into 
+C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
+
+=head1 SEE ALSO
+
+L<Test> for writing test scripts and also 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. Numerous anonymous contributors
+exist. 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/contrib/perl5/lib/Text/Abbrev.pm b/contrib/perl5/lib/Text/Abbrev.pm
new file mode 100644
index 000000000000..ae6797c81ac8
--- /dev/null
+++ b/contrib/perl5/lib/Text/Abbrev.pm
@@ -0,0 +1,87 @@
+package Text::Abbrev;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+abbrev - create an abbreviation table from a list
+
+=head1 SYNOPSIS
+
+    use Text::Abbrev;
+    abbrev $hashref, LIST
+
+
+=head1 DESCRIPTION
+
+Stores all unambiguous truncations of each element of LIST
+as keys key in the associative array referenced to by C<$hashref>.
+The values are the original list elements.
+
+=head1 EXAMPLE
+
+    $hashref = abbrev qw(list edit send abort gripe);
+
+    %hash = abbrev qw(list edit send abort gripe);
+
+    abbrev $hashref, qw(list edit send abort gripe);
+
+    abbrev(*hash, qw(list edit send abort gripe));
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(abbrev);
+
+# Usage:
+#	&abbrev(*foo,LIST);
+#	...
+#	$long = $foo{$short};
+
+sub abbrev {
+    my (%domain);
+    my ($name, $ref, $glob);
+
+    if (ref($_[0])) {           # hash reference preferably
+      $ref = shift;
+    } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
+      $glob = shift;
+    } 
+    my @cmp = @_;
+
+    foreach $name (@_) {
+	my @extra = split(//,$name);
+	my $abbrev = shift(@extra);
+	my $len = 1;
+        my $cmp;
+	WORD: foreach $cmp (@cmp) {
+	    next if $cmp eq $name;
+	    while (substr($cmp,0,$len) eq $abbrev) {
+                last WORD unless @extra;
+                $abbrev .= shift(@extra);
+		++$len;
+	    }
+	}
+	$domain{$abbrev} = $name;
+	while (@extra) {
+	    $abbrev .= shift(@extra);
+	    $domain{$abbrev} = $name;
+	}
+    }
+    if ($ref) {
+      %$ref = %domain;
+      return;
+    } elsif ($glob) {           # old style
+      local (*hash) = $glob;
+      %hash = %domain;
+      return;
+    }
+    if (wantarray) {
+      %domain;
+    } else {
+      \%domain;
+    }
+}
+
+1;
+
diff --git a/contrib/perl5/lib/Text/ParseWords.pm b/contrib/perl5/lib/Text/ParseWords.pm
new file mode 100644
index 000000000000..2414f805b569
--- /dev/null
+++ b/contrib/perl5/lib/Text/ParseWords.pm
@@ -0,0 +1,256 @@
+package Text::ParseWords;
+
+use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
+$VERSION = "3.1";
+
+require 5.000;
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
+@EXPORT_OK = qw(old_shellwords);
+
+
+sub shellwords {
+    local(@lines) = @_;
+    $lines[$#lines] =~ s/\s+$//;
+    return(quotewords('\s+', 0, @lines));
+}
+
+
+
+sub quotewords {
+    my($delim, $keep, @lines) = @_;
+    my($line, @words, @allwords);
+    
+
+    foreach $line (@lines) {
+	@words = parse_line($delim, $keep, $line);
+	return() unless (@words || !length($line));
+	push(@allwords, @words);
+    }
+    return(@allwords);
+}
+
+
+
+sub nested_quotewords {
+    my($delim, $keep, @lines) = @_;
+    my($i, @allwords);
+    
+    for ($i = 0; $i < @lines; $i++) {
+	@{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
+	return() unless (@{$allwords[$i]} || !length($lines[$i]));
+    }
+    return(@allwords);
+}
+
+
+
+sub parse_line {
+	# We will be testing undef strings
+	local($^W) = 0;
+
+    my($delimiter, $keep, $line) = @_;
+    my($quote, $quoted, $unquoted, $delim, $word, @pieces);
+
+    while (length($line)) {
+
+	($quote, $quoted, undef, $unquoted, $delim, undef) =
+	    $line =~ m/^(["'])                 # a $quote
+                        ((?:\\.|(?!\1)[^\\])*)    # and $quoted text
+                        \1 		       # followed by the same quote
+                        ([\000-\377]*)	       # and the rest
+		       |                       # --OR--
+                       ^((?:\\.|[^\\"'])*?)    # an $unquoted text
+		      (\Z(?!\n)|$delimiter|(?!^)(?=["']))  
+                                               # plus EOL, delimiter, or quote
+                      ([\000-\377]*)	       # the rest
+		      /x;		       # extended layout
+	return() unless( $quote || length($unquoted) || length($delim));
+
+	$line = $+;
+
+        if ($keep) {
+	    $quoted = "$quote$quoted$quote";
+	}
+        else {
+	    $unquoted =~ s/\\(.)/$1/g;
+	    if (defined $quote) {
+		$quoted =~ s/\\(.)/$1/g if ($quote eq '"');
+		$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
+            }
+	}
+        $word .= defined $quote ? $quoted : $unquoted;
+ 
+        if (length($delim)) {
+            push(@pieces, $word);
+            push(@pieces, $delim) if ($keep eq 'delimiters');
+            undef $word;
+        }
+        if (!length($line)) {
+            push(@pieces, $word);
+	}
+    }
+    return(@pieces);
+}
+
+
+
+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 (/^"/) {
+		return();
+	    }
+	    elsif (s/^'(([^'\\]|\\.)*)'//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^'/) {
+		return();
+	    }
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+	    }
+	    elsif (s/^([^\s\\'"]+)//) {
+		$snippet = $1;
+	    }
+	    else {
+		s/^\s+//;
+		last;
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens or array of arrays
+
+=head1 SYNOPSIS
+
+  use Text::ParseWords;
+  @lists = &nested_quotewords($delim, $keep, @lines);
+  @words = &quotewords($delim, $keep, @lines);
+  @words = &shellwords(@lines);
+  @words = &parse_line($delim, $keep, $line);
+  @words = &old_shellwords(@lines); # DEPRECATED!
+
+=head1 DESCRIPTION
+
+The &nested_quotewords() and &quotewords() functions accept 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.  &quotewords()
+returns all of the tokens in a single long list, while &nested_quotewords()
+returns a list of token lists corresponding to the elements of @lines.
+&parse_line() does tokenizing on a single string.  The &*quotewords()
+functions simply call &parse_lines(), so if you're only splitting
+one line you can call &parse_lines() directly and save a function
+call.
+
+The $keep argument is a boolean flag.  If true, then the tokens are
+split on the specified delimiter, but all other characters (quotes,
+backslashes, etc.) are kept in the tokens.  If $keep is false then the
+&*quotewords() functions remove all quotes and backslashes that are
+not themselves backslash-escaped or inside of single quotes (i.e.,
+&quotewords() tries to interpret these characters just like the Bourne
+shell).  NB: these semantics are significantly different from the
+original version of this module shipped with Perl 5.000 through 5.004.
+As an additional feature, $keep may be the keyword "delimiters" which
+causes the functions to preserve the delimiters in each string as
+tokens in the token lists, in addition to preserving quote and
+backslash characters.
+
+&shellwords() is written as a special case of &quotewords(), and it
+does token parsing with whitespace as a delimiter-- similar to most
+Unix shells.
+
+=head1 EXAMPLES
+
+The sample program:
+
+  use Text::ParseWords;
+  @words = &quotewords('\s+', 0, q{this   is "a test" of\ quotewords \"for you});
+  $i = 0;
+  foreach (@words) {
+      print "$i: <$_>\n";
+      $i++;
+  }
+
+produces:
+
+  0: <this>
+  1: <is>
+  2: <a test>
+  3: <of quotewords>
+  4: <"for>
+  5: <you>
+
+demonstrating:
+
+=over 4
+
+=item 0
+a simple word
+
+=item 1
+multiple spaces are skipped because of our $delim
+
+=item 2
+use of quotes to include a space in a word
+
+=item 3
+use of a backslash to include a space in a word
+
+=item 4
+use of a backslash to remove the special meaning of a double-quote
+
+=item 5
+another simple word (note the lack of effect of the
+backslashed double-quote)
+
+=back
+
+Replacing C<&quotewords('\s+', 0, q{this   is...})>
+with C<&shellwords(q{this   is...})>
+is a simpler way to accomplish the same thing.
+
+=head1 AUTHORS
+
+Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original
+author unknown).  Much of the code for &parse_line() (including the
+primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>.
+
+Examples section another documentation provided by John Heidemann 
+<johnh@ISI.EDU>
+
+Bug reports, patches, and nagging provided by lots of folks-- thanks
+everybody!  Special thanks to Michael Schwern <schwern@envirolink.org>
+for assuring me that a &nested_quotewords() would be useful, and to 
+Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about
+error-checking (sort of-- you had to be there).
+
+=cut
diff --git a/contrib/perl5/lib/Text/Soundex.pm b/contrib/perl5/lib/Text/Soundex.pm
new file mode 100644
index 000000000000..ddc758c94eb7
--- /dev/null
+++ b/contrib/perl5/lib/Text/Soundex.pm
@@ -0,0 +1,148 @@
+package Text::Soundex;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&soundex $soundex_nocode);
+
+# $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike 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.pl,v $
+# 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)
+  {
+    $_ = uc $_;
+    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/contrib/perl5/lib/Text/Tabs.pm b/contrib/perl5/lib/Text/Tabs.pm
new file mode 100644
index 000000000000..acd7afb7d6fe
--- /dev/null
+++ b/contrib/perl5/lib/Text/Tabs.pm
@@ -0,0 +1,97 @@
+
+package Text::Tabs;
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(expand unexpand $tabstop);
+
+use vars qw($VERSION $tabstop $debug);
+$VERSION = 96.121201;
+
+use strict;
+
+BEGIN	{
+	$tabstop = 8;
+	$debug = 0;
+}
+
+sub expand
+{
+	my @l = @_;
+	for $_ (@l) {
+		1 while s/(^|\n)([^\t\n]*)(\t+)/
+			$1. $2 . (" " x 
+				($tabstop * length($3)
+				- (length($2) % $tabstop)))
+			/sex;
+	}
+	return @l if wantarray;
+	return $l[0];
+}
+
+sub unexpand
+{
+	my @l = @_;
+	my @e;
+	my $x;
+	my $line;
+	my @lines;
+	my $lastbit;
+	for $x (@l) {
+		@lines = split("\n", $x, -1);
+		for $line (@lines) {
+			$line = expand($line);
+			@e = split(/(.{$tabstop})/,$line,-1);
+			$lastbit = pop(@e);
+			$lastbit = '' unless defined $lastbit;
+			$lastbit = "\t"
+				if $lastbit eq " "x$tabstop;
+			for $_ (@e) {
+				if ($debug) {
+					my $x = $_;
+					$x =~ s/\t/^I\t/gs;
+					print "sub on '$x'\n";
+				}
+				s/  +$/\t/;
+			}
+			$line = join('',@e, $lastbit);
+		}
+		$x = join("\n", @lines);
+	}
+	return @l if wantarray;
+	return $l[0];
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1)
+
+=head1 SYNOPSIS
+
+use Text::Tabs;
+
+$tabstop = 4;
+@lines_without_tabs = expand(@lines_with_tabs);
+@lines_with_tabs = unexpand(@lines_without_tabs);
+
+=head1 DESCRIPTION
+
+Text::Tabs does about what the unix utilities expand(1) and unexpand(1)
+do.  Given a line with tabs in it, expand will replace the tabs with
+the appropriate number of spaces.  Given a line with or without tabs in
+it, unexpand will add tabs when it can save bytes by doing so.  Invisible
+compression with plain ascii!
+
+=head1 BUGS
+
+expand doesn't handle newlines very quickly -- do not feed it an
+entire document in one string.  Instead feed it an array of lines.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
diff --git a/contrib/perl5/lib/Text/Wrap.pm b/contrib/perl5/lib/Text/Wrap.pm
new file mode 100644
index 000000000000..0fe7fb93c215
--- /dev/null
+++ b/contrib/perl5/lib/Text/Wrap.pm
@@ -0,0 +1,125 @@
+package Text::Wrap;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $columns $debug);
+use strict;
+use Exporter;
+
+$VERSION = "97.02";
+@ISA = qw(Exporter);
+@EXPORT = qw(wrap);
+@EXPORT_OK = qw($columns $tabstop fill);
+
+use Text::Tabs qw(expand unexpand $tabstop);
+
+
+BEGIN	{
+    $columns = 76;  # <= screen width
+    $debug = 0;
+}
+
+sub wrap
+{
+    my ($ip, $xp, @t) = @_;
+
+    my @rv;
+    my $t = expand(join(" ",@t));
+
+    my $lead = $ip;
+    my $ll = $columns - length(expand($lead)) - 1;
+    my $nl = "";
+
+    $t =~ s/^\s+//;
+    while(length($t) > $ll) {
+	# remove up to a line length of things that
+	# aren't new lines and tabs.
+	if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//) {
+	    my ($l,$r) = ($1,$2);
+	    $l =~ s/\s+$//;
+	    print "WRAP  $lead$l..($r)\n" if $debug;
+	    push @rv, unexpand($lead . $l), "\n";
+		
+	} elsif ($t =~ s/^([^\n]{$ll})//) {
+	    print "SPLIT $lead$1..\n" if $debug;
+	    push @rv, unexpand($lead . $1),"\n";
+	}
+	# recompute the leader
+	$lead = $xp;
+	$ll = $columns - length(expand($lead)) - 1;
+	$t =~ s/^\s+//;
+    } 
+    print "TAIL  $lead$t\n" if $debug;
+    push @rv, $lead.$t if $t ne "";
+    return join '', @rv;
+}
+
+
+sub fill 
+{
+	my ($ip, $xp, @raw) = @_;
+	my @para;
+	my $pp;
+
+	for $pp (split(/\n\s+/, join("\n",@raw))) {
+		$pp =~ s/\s+/ /g;
+		my $x = wrap($ip, $xp, $pp);
+		push(@para, $x);
+	}
+
+	# if paragraph_indent is the same as line_indent, 
+	# separate paragraphs with blank lines
+
+	return join ($ip eq $xp ? "\n\n" : "\n", @para);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Text::Wrap - line wrapping to form simple paragraphs
+
+=head1 SYNOPSIS 
+
+	use Text::Wrap
+
+	print wrap($initial_tab, $subsequent_tab, @text);
+
+	use Text::Wrap qw(wrap $columns $tabstop fill);
+
+	$columns = 132;
+	$tabstop = 4;
+
+	print fill($initial_tab, $subsequent_tab, @text);
+	print fill("", "", `cat book`);
+
+=head1 DESCRIPTION
+
+Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line ($initial_tab) and
+all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
+should be set to the full width of your output device.
+
+Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
+each paragraph separately and then joins them together when it's done.  It
+will destory any whitespace in the original text.  It breaks text into
+paragraphs by looking for whitespace after a newline.  In other respects
+it acts like wrap().
+
+=head1 EXAMPLE
+
+	print wrap("\t","","This is a bit of text that forms 
+		a normal book-style paragraph");
+
+=head1 BUGS
+
+It's not clear what the correct behavior should be when Wrap() is
+presented with a word that is longer than a line.  The previous 
+behavior was to die.  Now the word is now split at line-length.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
+others. Updated by Jacqui Caren.
+
+=cut
diff --git a/contrib/perl5/lib/Tie/Array.pm b/contrib/perl5/lib/Tie/Array.pm
new file mode 100644
index 000000000000..4041b00e8603
--- /dev/null
+++ b/contrib/perl5/lib/Tie/Array.pm
@@ -0,0 +1,262 @@
+package Tie::Array;
+use vars qw($VERSION); 
+use strict;
+$VERSION = '1.00';
+
+# Pod documentation after __END__ below.
+
+sub DESTROY { }
+sub EXTEND  { }          
+sub UNSHIFT { shift->SPLICE(0,0,@_) }                 
+sub SHIFT   { shift->SPLICE(0,1) }                 
+sub CLEAR   { shift->STORESIZE(0) }
+
+sub PUSH 
+{  
+ my $obj = shift;
+ my $i   = $obj->FETCHSIZE;
+ $obj->STORE($i++, shift) while (@_);
+}
+
+sub POP 
+{
+ my $obj = shift;
+ my $newsize = $obj->FETCHSIZE - 1;
+ my $val;
+ if ($newsize >= 0) 
+  {
+   $val = $obj->FETCH($newsize);
+   $obj->STORESIZE($newsize);
+  }
+ $val;
+}          
+
+sub SPLICE
+{
+ my $obj = shift;
+ my $sz  = $obj->FETCHSIZE;
+ my $off = (@_) ? shift : 0;
+ $off += $sz if ($off < 0);
+ my $len = (@_) ? shift : $sz - $off;
+ my @result;
+ for (my $i = 0; $i < $len; $i++)
+  {
+   push(@result,$obj->FETCH($off+$i));
+  }
+ if (@_ > $len)
+  {                          
+   # Move items up to make room
+   my $d = @_ - $len;
+   my $e = $off+$len;
+   $obj->EXTEND($sz+$d);
+   for (my $i=$sz-1; $i >= $e; $i--)
+    {
+     my $val = $obj->FETCH($i);
+     $obj->STORE($i+$d,$val);
+    }
+  }
+ elsif (@_ < $len)
+  {
+   # Move items down to close the gap 
+   my $d = $len - @_;
+   my $e = $off+$len;
+   for (my $i=$off+$len; $i < $sz; $i++)
+    {
+     my $val = $obj->FETCH($i);
+     $obj->STORE($i-$d,$val);
+    }
+   $obj->STORESIZE($sz-$d);
+  }
+ for (my $i=0; $i < @_; $i++)
+  {
+   $obj->STORE($off+$i,$_[$i]);
+  }
+ return @result;
+} 
+
+package Tie::StdArray;
+use vars qw(@ISA);
+@ISA = 'Tie::Array';
+
+sub TIEARRAY  { bless [], $_[0] }
+sub FETCHSIZE { scalar @{$_[0]} }             
+sub STORESIZE { $#{$_[0]} = $_[1]-1 }  
+sub STORE     { $_[0]->[$_[1]] = $_[2] }
+sub FETCH     { $_[0]->[$_[1]] }
+sub CLEAR     { @{$_[0]} = () }
+sub POP       { pop(@{$_[0]}) } 
+sub PUSH      { my $o = shift; push(@$o,@_) }
+sub SHIFT     { shift(@{$_[0]}) } 
+sub UNSHIFT   { my $o = shift; unshift(@$o,@_) } 
+
+sub SPLICE
+{
+ my $ob  = shift;                    
+ my $sz  = $ob->FETCHSIZE;
+ my $off = @_ ? shift : 0;
+ $off   += $sz if $off < 0;
+ my $len = @_ ? shift : $sz-$off;
+ return splice(@$ob,$off,$len,@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Tie::Array - base class for tied arrays
+
+=head1 SYNOPSIS  
+
+    package NewArray;
+    use Tie::Array;
+    @ISA = ('Tie::Array');
+                       
+    # mandatory methods
+    sub TIEARRAY { ... }  
+    sub FETCH { ... }     
+    sub FETCHSIZE { ... } 
+        
+    sub STORE { ... }        # mandatory if elements writeable
+    sub STORESIZE { ... }    # mandatory if elements can be added/deleted
+                               
+    # optional methods - for efficiency
+    sub CLEAR { ... }  
+    sub PUSH { ... } 
+    sub POP { ... } 
+    sub SHIFT { ... } 
+    sub UNSHIFT { ... } 
+    sub SPLICE { ... } 
+    sub EXTEND { ... } 
+    sub DESTROY { ... }
+
+    package NewStdArray;
+    use Tie::Array;
+    
+    @ISA = ('Tie::StdArray');
+
+    # all methods provided by default
+
+    package main;
+
+    $object = tie @somearray,Tie::NewArray;
+    $object = tie @somearray,Tie::StdArray;
+    $object = tie @somearray,Tie::NewStdArray;
+
+
+
+=head1 DESCRIPTION       
+
+This module provides methods for array-tying classes. See
+L<perltie> for a list of the functions required in order to tie an array
+to a package. The basic B<Tie::Array> package provides stub C<DELETE> 
+and C<EXTEND> methods, and implementations of C<PUSH>, C<POP>, C<SHIFT>, 
+C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>, 
+C<FETCHSIZE>, C<STORESIZE>.
+
+The B<Tie::StdArray> package provides efficient methods required for tied arrays 
+which are implemented as blessed references to an "inner" perl array.
+It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly 
+like standard arrays, allowing for selective overloading of methods. 
+
+For developers wishing to write their own tied arrays, the required methods
+are briefly defined below. See the L<perltie> section for more detailed
+descriptive, as well as example code:
+
+=over 
+
+=item TIEARRAY classname, LIST
+
+The class method is invoked by the command C<tie @array, classname>. Associates
+an array 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. The method should return an object of a class which
+provides the methods below. 
+
+=item STORE this, index, value
+
+Store datum I<value> into I<index> for the tied array assoicated with
+object I<this>. If this makes the array larger then
+class's mapping of C<undef> should be returned for new positions.
+
+=item FETCH this, index
+
+Retrieve the datum in I<index> for the tied array assoicated with
+object I<this>.
+
+=item FETCHSIZE this
+
+Returns the total number of items in the tied array assoicated with
+object I<this>. (Equivalent to C<scalar(@array)>).
+
+=item STORESIZE this, count
+
+Sets the total number of items in the tied array assoicated with
+object I<this> to be I<count>. If this makes the array larger then
+class's mapping of C<undef> should be returned for new positions.
+If the array becomes smaller then entries beyond count should be
+deleted. 
+
+=item EXTEND this, count
+
+Informative call that array is likely to grow to have I<count> entries.
+Can be used to optimize allocation. This method need do nothing.
+
+=item CLEAR this
+
+Clear (remove, delete, ...) all values from the tied array assoicated with
+object I<this>.
+
+=item DESTROY this
+
+Normal object destructor method.
+
+=item PUSH this, LIST 
+
+Append elements of LIST to the array.
+
+=item POP this
+
+Remove last element of the array and return it.
+
+=item SHIFT this
+
+Remove the first element of the array (shifting other elements down)
+and return it.
+
+=item UNSHIFT this, LIST 
+
+Insert LIST elements at the begining of the array, moving existing elements
+up to make room.
+
+=item SPLICE this, offset, length, LIST
+
+Perform the equivalent of C<splice> on the array. 
+
+I<offset> is optional and defaults to zero, negative values count back 
+from the end of the array. 
+
+I<length> is optional and defaults to rest of the array.
+
+I<LIST> may be empty.
+
+Returns a list of the original I<length> elements at I<offset>.
+
+=back
+
+=head1 CAVEATS
+
+There is no support at present for tied @ISA. There is a potential conflict 
+between magic entries needed to notice setting of @ISA, and those needed to
+implement 'tie'.   
+
+Very little consideration has been given to the behaviour of tied arrays
+when C<$[> is not default value of zero.
+
+=head1 AUTHOR 
+
+Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
+
+=cut 
+
diff --git a/contrib/perl5/lib/Tie/Handle.pm b/contrib/perl5/lib/Tie/Handle.pm
new file mode 100644
index 000000000000..c7550530b87e
--- /dev/null
+++ b/contrib/perl5/lib/Tie/Handle.pm
@@ -0,0 +1,161 @@
+package Tie::Handle;
+
+=head1 NAME
+
+Tie::Handle - base class definitions for tied handles
+
+=head1 SYNOPSIS
+
+    package NewHandle;
+    require Tie::Handle;
+     
+    @ISA = (Tie::Handle);
+     
+    sub READ { ... }		# Provide a needed method
+    sub TIEHANDLE { ... }	# Overrides inherited method
+         
+     
+    package main;
+    
+    tie *FH, 'NewHandle';
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for handle-tying classes. See
+L<perltie> for a list of the functions required in tying a handle to a package.
+The basic B<Tie::Handle> package provides a C<new> method, as well as methods
+C<TIESCALAR>, C<FETCH> and C<STORE>. 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-handle classes, the methods
+are summarized below. The L<perltie> section not only documents these, but
+has sample code as well:
+
+=over
+
+=item TIEHANDLE classname, LIST
+
+The method invoked by the command C<tie *glob, classname>. Associates a new
+glob 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 WRITE this, scalar, length, offset
+
+Write I<length> bytes of data from I<scalar> starting at I<offset>.
+
+=item PRINT this, LIST
+
+Print the values in I<LIST>
+
+=item PRINTF this, format, LIST
+
+Print the values in I<LIST> using I<format>
+
+=item READ this, scalar, length, offset
+
+Read I<length> bytes of data into I<scalar> starting at I<offset>.
+
+=item READLINE this
+
+Read a single line
+
+=item GETC this
+
+Get a single character
+
+=item DESTROY this
+
+Free the storage associated with the tied handle 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 contains an example of tying handles.
+
+=cut
+
+use Carp;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIEHANDLE(@_);
+}
+
+# "Grandfather" the new, a la Tie::Hash
+
+sub TIEHANDLE {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
+	    if $^W;
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIEHANDLE method";
+    }
+}
+
+sub PRINT {
+    my $self = shift;
+    if($self->can('WRITE') != \&WRITE) {
+	my $buf = join(defined $, ? $, : "",@_);
+	$buf .= $\ if defined $\;
+	$self->WRITE($buf,length($buf),0);
+    }
+    else {
+	croak ref($self)," doesn't define a PRINT method";
+    }
+}
+
+sub PRINTF {
+    my $self = shift;
+    
+    if($self->can('WRITE') != \&WRITE) {
+	my $buf = sprintf(@_);
+	$self->WRITE($buf,length($buf),0);
+    }
+    else {
+	croak ref($self)," doesn't define a PRINTF method";
+    }
+}
+
+sub READLINE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a READLINE method";
+}
+
+sub GETC {
+    my $self = shift;
+    
+    if($self->can('READ') != \&READ) {
+	my $buf;
+	$self->READ($buf,1);
+	return $buf;
+    }
+    else {
+	croak ref($self)," doesn't define a GETC method";
+    }
+}
+
+sub READ {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a READ method";
+}
+
+sub WRITE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a WRITE method";
+}
+
+sub CLOSE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a CLOSE method";
+}
+
+1;
diff --git a/contrib/perl5/lib/Tie/Hash.pm b/contrib/perl5/lib/Tie/Hash.pm
new file mode 100644
index 000000000000..7ed18962e9e7
--- /dev/null
+++ b/contrib/perl5/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 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/contrib/perl5/lib/Tie/RefHash.pm b/contrib/perl5/lib/Tie/RefHash.pm
new file mode 100644
index 000000000000..66de2572fcd4
--- /dev/null
+++ b/contrib/perl5/lib/Tie/RefHash.pm
@@ -0,0 +1,123 @@
+package Tie::RefHash;
+
+=head1 NAME
+
+Tie::RefHash - use references as hash keys
+
+=head1 SYNOPSIS
+
+    require 5.004;
+    use Tie::RefHash;
+    tie HASHVARIABLE, 'Tie::RefHash', LIST;
+
+    untie HASHVARIABLE;
+
+=head1 DESCRIPTION
+
+This module provides the ability to use references as hash keys if
+you first C<tie> the hash variable to this module.
+
+It is implemented using the standard perl TIEHASH interface.  Please
+see the C<tie> entry in perlfunc(1) and perltie(1) for more information.
+
+=head1 EXAMPLE
+
+    use Tie::RefHash;
+    tie %h, 'Tie::RefHash';
+    $a = [];
+    $b = {};
+    $c = \*main;
+    $d = \"gunk";
+    $e = sub { 'foo' };
+    %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
+    $a->[0] = 'foo';
+    $b->{foo} = 'bar';
+    for (keys %h) {
+       print ref($_), "\n";
+    }
+
+
+=head1 AUTHOR
+
+Gurusamy Sarathy        gsar@umich.edu
+
+=head1 VERSION
+
+Version 1.2    15 Dec 1996
+
+=head1 SEE ALSO
+
+perl(1), perlfunc(1), perltie(1)
+
+=cut
+
+require 5.003_11;
+use Tie::Hash;
+@ISA = qw(Tie::Hash);
+use strict;
+
+sub TIEHASH {
+  my $c = shift;
+  my $s = [];
+  bless $s, $c;
+  while (@_) {
+    $s->STORE(shift, shift);
+  }
+  return $s;
+}
+
+sub FETCH {
+  my($s, $k) = @_;
+  (ref $k) ? $s->[0]{"$k"}[1] : $s->[1]{$k};
+}
+
+sub STORE {
+  my($s, $k, $v) = @_;
+  if (ref $k) {
+    $s->[0]{"$k"} = [$k, $v];
+  }
+  else {
+    $s->[1]{$k} = $v;
+  }
+  $v;
+}
+
+sub DELETE {
+  my($s, $k) = @_;
+  (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
+}
+
+sub EXISTS {
+  my($s, $k) = @_;
+  (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
+}
+
+sub FIRSTKEY {
+  my $s = shift;
+  my $a = scalar(keys %{$s->[0]}) + scalar(keys %{$s->[1]});
+  $s->[2] = 0;
+  $s->NEXTKEY;
+}
+
+sub NEXTKEY {
+  my $s = shift;
+  my ($k, $v);
+  if (!$s->[2]) {
+    if (($k, $v) = each %{$s->[0]}) {
+      return $s->[0]{"$k"}[0];
+    }
+    else {
+      $s->[2] = 1;
+    }
+  }
+  return each %{$s->[1]};
+}
+
+sub CLEAR {
+  my $s = shift;
+  $s->[2] = 0;
+  %{$s->[0]} = ();
+  %{$s->[1]} = ();
+}
+
+1;
diff --git a/contrib/perl5/lib/Tie/Scalar.pm b/contrib/perl5/lib/Tie/Scalar.pm
new file mode 100644
index 000000000000..ef27dc1398c8
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/Tie/SubstrHash.pm b/contrib/perl5/lib/Tie/SubstrHash.pm
new file mode 100644
index 000000000000..44c2140c7beb
--- /dev/null
+++ b/contrib/perl5/lib/Tie/SubstrHash.pm
@@ -0,0 +1,180 @@
+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 + $_;
+	&_hashwrap if $hash >= 1e13;
+    }
+    &_hashwrap if $hash >= $tsize;
+    $hash = 1 unless $hash;
+    $hashbase = $hash;
+}
+
+sub _hashwrap {
+    $hash -= int($hash / $tsize) * $tsize;
+}
+
+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/contrib/perl5/lib/Time/Local.pm b/contrib/perl5/lib/Time/Local.pm
new file mode 100644
index 000000000000..eef412d46d71
--- /dev/null
+++ b/contrib/perl5/lib/Time/Local.pm
@@ -0,0 +1,138 @@
+package Time::Local;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(timegm timelocal);
+
+=head1 NAME
+
+Time::Local - efficiently compute time 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
+
+BEGIN {
+    $SEC  = 1;
+    $MIN  = 60 * $SEC;
+    $HR   = 60 * $MIN;
+    $DAY  = 24 * $HR;
+    $epoch = (localtime(2*$DAY))[5];	# Allow for bugs near localtime == 0.
+
+    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+
+}
+
+sub timegm {
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    return -1 if $cheat<0 and $^O ne 'VMS';
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
+}
+
+sub timelocal {
+    my $t = &timegm;
+    my $tt = $t;
+
+    my (@lt) = localtime($t);
+    my (@gt) = gmtime($t);
+    if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
+      # Wrap error, too early a date
+      # Try a safer date
+      $tt = $DAY;
+      @lt = localtime($tt);
+      @gt = gmtime($tt);
+    }
+
+    my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
+
+    my($lday,$gday) = ($lt[7],$gt[7]);
+    if($lt[5] > $gt[5]) {
+	$tzsec -= $DAY;
+    }
+    elsif($gt[5] > $lt[5]) {
+	$tzsec += $DAY;
+    }
+    else {
+	$tzsec += ($gt[7] - $lt[7]) * $DAY;
+    }
+
+    $tzsec += $HR if($lt[8]);
+    
+    $time = $t + $tzsec;
+    return -1 if $cheat<0 and $^O ne 'VMS';
+    @test = localtime($time + ($tt - $t));
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+sub cheat {
+    $year = $_[5];
+    $year -= 1900
+    	if $year > 1900;
+    $month = $_[4];
+    croak "Month '$month' out of range 0..11"	if $month > 11 || $month < 0;
+    croak "Day '$_[3]' out of range 1..31"	if $_[3] > 31 || $_[3] < 1;
+    croak "Hour '$_[2]' out of range 0..23"	if $_[2] > 23 || $_[2] < 0;
+    croak "Minute '$_[1]' out of range 0..59"	if $_[1] > 59 || $_[1] < 0;
+    croak "Second '$_[0]' out of range 0..59"	if $_[0] > 59 || $_[0] < 0;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch;
+    $lastguess = "";
+    $counter = 0;
+    while ($diff = $year - $g[5]) {
+	croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+	$guess += $diff * (363 * $DAY);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+	$guess += $diff * (27 * $DAY);
+	@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] * $DAY;
+    $cheat{$ym} = $guess;
+}
+
+1;
diff --git a/contrib/perl5/lib/Time/gmtime.pm b/contrib/perl5/lib/Time/gmtime.pm
new file mode 100644
index 000000000000..c1d11d74dbb0
--- /dev/null
+++ b/contrib/perl5/lib/Time/gmtime.pm
@@ -0,0 +1,88 @@
+package Time::gmtime;
+use strict;
+use Time::tm;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(gmtime gmctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub gmtime (;$)    { populate CORE::gmtime(@_ ? shift : time)}
+sub gmctime (;$)   { scalar   CORE::gmtime(@_ ? shift : time)} 
+
+1;
+__END__
+
+=head1 NAME
+
+Time::gmtime - by-name interface to Perl's built-in gmtime() function
+
+=head1 SYNOPSIS
+
+ use Time::gmtime;
+ $gm = gmtime();
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ];
+
+ use Time::gmtime w(:FIELDS;
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ];
+
+ $now = gmctime();
+
+ use Time::gmtime;
+ use File::stat;
+ $date_string = gmctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core gmtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this
+still overrides your core functions.)  Access these fields as variables
+named with a preceding C<tm_> in front their method names.  Thus,
+C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
+
+The gmctime() funtion provides a way of getting at the 
+scalar sense of the original CORE::gmtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Time/localtime.pm b/contrib/perl5/lib/Time/localtime.pm
new file mode 100644
index 000000000000..94377525973c
--- /dev/null
+++ b/contrib/perl5/lib/Time/localtime.pm
@@ -0,0 +1,84 @@
+package Time::localtime;
+use strict;
+use Time::tm;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(localtime ctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub localtime (;$) { populate CORE::localtime(@_ ? shift : time)}
+sub ctime (;$)     { scalar   CORE::localtime(@_ ? shift : time) } 
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::localtime - by-name interface to Perl's built-in localtime() function
+
+=head1 SYNOPSIS
+
+ use Time::localtime;
+ printf "Year is %d\n", localtime->year() + 1900;
+
+ $now = ctime();
+
+ use Time::localtime;
+ use File::stat;
+ $date_string = ctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core localtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as
+variables named with a preceding C<tm_> in front their method names.
+Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
+the fields.
+
+The ctime() funtion provides a way of getting at the 
+scalar sense of the original CORE::localtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/Time/tm.pm b/contrib/perl5/lib/Time/tm.pm
new file mode 100644
index 000000000000..fd47ad19a954
--- /dev/null
+++ b/contrib/perl5/lib/Time/tm.pm
@@ -0,0 +1,31 @@
+package Time::tm;
+use strict;
+
+use Class::Struct qw(struct);
+struct('Time::tm' => [
+     map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst }
+]);
+
+1;
+__END__
+
+=head1 NAME
+
+Time::tm - internal object used by Time::gmtime and Time::localtime
+
+=head1 SYNOPSIS
+
+Don't use this module directly.
+
+=head1 DESCRIPTION
+
+This module is used internally as a base class by Time::localtime And
+Time::gmtime functions.  It creates a Time::tm struct object which is
+addressable just like's C's tm structure from F<time.h>; namely with sec,
+min, hour, mday, mon, year, wday, yday, and isdst.
+
+This class is an internal interface only. 
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/UNIVERSAL.pm b/contrib/perl5/lib/UNIVERSAL.pm
new file mode 100644
index 000000000000..dc02423029ed
--- /dev/null
+++ b/contrib/perl5/lib/UNIVERSAL.pm
@@ -0,0 +1,97 @@
+package UNIVERSAL;
+
+# UNIVERSAL should not contain any extra subs/methods beyond those
+# that it exists to define. The use of Exporter below is a historical
+# accident that should be fixed sometime.
+require Exporter;
+*import = \&Exporter::import;
+@EXPORT_OK = qw(isa can);
+
+1;
+__END__
+
+=head1 NAME
+
+UNIVERSAL - base class for ALL classes (blessed references)
+
+=head1 SYNOPSIS
+
+    $io = $fd->isa("IO::Handle");
+    $sub = $obj->can('print');
+
+    $yes = UNIVERSAL::isa($ref, "HASH");
+
+=head1 DESCRIPTION
+
+C<UNIVERSAL> is the base class which all bless references will inherit from,
+see L<perlobj>
+
+C<UNIVERSAL> provides the following methods
+
+=over 4
+
+=item isa ( TYPE )
+
+C<isa> returns I<true> if C<REF> is blessed into package C<TYPE>
+or inherits from package C<TYPE>.
+
+C<isa> can be called as either a static or object method call.
+
+=item can ( METHOD )
+
+C<can> checks if the object has a method called C<METHOD>. If it does
+then a reference to the sub is returned. If it does not then I<undef>
+is returned.
+
+C<can> can be called as either a static or object method call.
+
+=item VERSION ( [ REQUIRE ] )
+
+C<VERSION> will return the value of the variable C<$VERSION> in the
+package the object is blessed into. If C<REQUIRE> is given then
+it will do a comparison and die if the package version is not
+greater than or equal to C<REQUIRE>.
+
+C<VERSION> can be called as either a static or object method call.
+
+=back
+
+The C<isa> and C<can> methods can also be called as subroutines
+
+=over 4
+
+=item UNIVERSAL::isa ( VAL, TYPE )
+
+C<isa> returns I<true> if the first argument is a reference and either
+of the following statements is true.
+
+=over 8
+
+=item
+
+C<VAL> is a blessed reference and is blessed into package C<TYPE>
+or inherits from package C<TYPE>
+
+=item
+
+C<VAL> is a reference to a C<TYPE> of perl variable (er 'HASH')
+
+=back
+
+=item UNIVERSAL::can ( VAL, METHOD )
+
+If C<VAL> is a blessed reference which has a method called C<METHOD>,
+C<can> returns a reference to the subroutine.   If C<VAL> is not
+a blessed reference, or if it does not have a method C<METHOD>,
+I<undef> is returned.
+
+=back
+
+These subroutines should I<not> be imported via S<C<use UNIVERSAL qw(...)>>.
+If you want simple local access to them you can do
+
+  *isa = \&UNIVERSAL::isa;
+
+to import isa into your package.
+
+=cut
diff --git a/contrib/perl5/lib/User/grent.pm b/contrib/perl5/lib/User/grent.pm
new file mode 100644
index 000000000000..deb0a8d1be91
--- /dev/null
+++ b/contrib/perl5/lib/User/grent.pm
@@ -0,0 +1,93 @@
+package User::grent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getgrent getgrgid getgrnam getgr);
+    @EXPORT_OK   = qw($gr_name $gr_gid $gr_passwd $gr_mem @gr_members);
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'User::grent' => [
+    name    => '$',
+    passwd  => '$',
+    gid	    => '$',
+    members => '@',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $gob = new();
+    ($gr_name, $gr_passwd, $gr_gid) = @$gob[0,1,2] = @_[0,1,2];
+    @gr_members = @{$gob->[3]} = split ' ', $_[3];
+    return $gob;
+} 
+
+sub getgrent ( ) { populate(CORE::getgrent()) } 
+sub getgrnam ($) { populate(CORE::getgrnam(shift)) } 
+sub getgrgid ($) { populate(CORE::getgrgid(shift)) } 
+sub getgr    ($) { ($_[0] =~ /^\d+/) ? &getgrgid : &getgrnam } 
+
+1;
+__END__
+
+=head1 NAME
+
+User::grent - by-name interface to Perl's built-in getgr*() functions
+
+=head1 SYNOPSIS
+
+ use User::grent;
+ $gr = getgrgid(0) or die "No group zero";
+ if ( $gr->name eq 'wheel' && @{$gr->members} > 1 ) {
+     print "gid zero name wheel, with other members";
+ } 
+
+ use User::grent qw(:FIELDS;
+ getgrgid(0) or die "No group zero";
+ if ( $gr_name eq 'wheel' && @gr_members > 1 ) {
+     print "gid zero name wheel, with other members";
+ } 
+
+ $gr = getgr($whoever);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getgrent(), getgruid(),
+and getgrnam() functions, replacing them with versions that return
+"User::grent" objects.  This object has methods that return the similarly
+named structure field name from the C's passwd structure from F<grp.h>; 
+namely name, passwd, gid, and members (not mem).  The first three
+return scalars, the last an array reference.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<gr_>.  Thus, C<$group_obj-E<gt>gid()> corresponds
+to $gr_gid if you import the fields.  Array references are available as
+regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
+simply @gr_members.
+
+The getpw() funtion is a simple front-end that forwards
+a numeric argument to getpwuid() and the rest to getpwnam().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/User/pwent.pm b/contrib/perl5/lib/User/pwent.pm
new file mode 100644
index 000000000000..32301cadfc53
--- /dev/null
+++ b/contrib/perl5/lib/User/pwent.pm
@@ -0,0 +1,103 @@
+package User::pwent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getpwent getpwuid getpwnam getpw);
+    @EXPORT_OK   = qw(
+			$pw_name   $pw_passwd 	$pw_uid	 
+			$pw_gid	   $pw_quota    $pw_comment
+			$pw_gecos  $pw_dir	$pw_shell
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'User::pwent' => [
+    name    => '$',
+    passwd  => '$',
+    uid	    => '$',
+    gid	    => '$',
+    quota   => '$',
+    comment => '$',
+    gecos   => '$',
+    dir	    => '$',
+    shell   => '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $pwob = new();
+
+    ( $pw_name,   $pw_passwd,   $pw_uid,  
+      $pw_gid,    $pw_quota,    $pw_comment,
+      $pw_gecos,  $pw_dir,      $pw_shell,   ) 	= @$pwob = @_;
+
+    return $pwob;
+} 
+
+sub getpwent ( ) { populate(CORE::getpwent()) } 
+sub getpwnam ($) { populate(CORE::getpwnam(shift)) } 
+sub getpwuid ($) { populate(CORE::getpwuid(shift)) } 
+sub getpw    ($) { ($_[0] =~ /^\d+/) ? &getpwuid : &getpwnam } 
+
+1;
+__END__
+
+=head1 NAME
+
+User::pwent - by-name interface to Perl's built-in getpw*() functions
+
+=head1 SYNOPSIS
+
+ use User::pwent;
+ $pw = getpwnam('daemon') or die "No daemon user";
+ if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) {
+     print "gid 1 on root dir";
+ } 
+
+ use User::pwent qw(:FIELDS);
+ getpwnam('daemon') or die "No daemon user";
+ if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) {
+     print "gid 1 on root dir";
+ } 
+
+ $pw = getpw($whoever);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getpwent(), getpwuid(),
+and getpwnam() functions, replacing them with versions that return
+"User::pwent" objects.  This object has methods that return the similarly
+named structure field name from the C's passwd structure from F<pwd.h>; 
+namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as
+variables named with a preceding C<pw_> in front their method names.
+Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
+the fields.
+
+The getpw() funtion is a simple front-end that forwards
+a numeric argument to getpwuid() and the rest to getpwnam().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/contrib/perl5/lib/abbrev.pl b/contrib/perl5/lib/abbrev.pl
new file mode 100644
index 000000000000..62975e66f326
--- /dev/null
+++ b/contrib/perl5/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 (@extra && 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/contrib/perl5/lib/assert.pl b/contrib/perl5/lib/assert.pl
new file mode 100644
index 000000000000..4c9ebf20a0d3
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/autouse.pm b/contrib/perl5/lib/autouse.pm
new file mode 100644
index 000000000000..4445c6c419bd
--- /dev/null
+++ b/contrib/perl5/lib/autouse.pm
@@ -0,0 +1,157 @@
+package autouse;
+
+#use strict;		# debugging only
+use 5.003_90;		# ->can, for my $var
+
+$autouse::VERSION = '1.01';
+
+$autouse::DEBUG ||= 0;
+
+sub vet_import ($);
+
+sub croak {
+    require Carp;
+    Carp::croak(@_);
+}
+
+sub import {
+    my $class = @_ ? shift : 'autouse';
+    croak "usage: use $class MODULE [,SUBS...]" unless @_;
+    my $module = shift;
+
+    (my $pm = $module) =~ s{::}{/}g;
+    $pm .= '.pm';
+    if (exists $INC{$pm}) {
+	vet_import $module;
+	local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
+	# $Exporter::Verbose = 1;
+	return $module->import(map { (my $f = $_) =~ s/\(.*?\)$// } @_);
+    }
+
+    # It is not loaded: need to do real work.
+    my $callpkg = caller(0);
+    print "autouse called from $callpkg\n" if $autouse::DEBUG;
+
+    my $index;
+    for my $f (@_) {
+	my $proto;
+	$proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
+
+	my $closure_import_func = $func;	# Full name
+	my $closure_func = $func;		# Name inside package
+	my $index = index($func, '::');
+	if ($index == -1) {
+	    $closure_import_func = "${callpkg}::$func";
+	} else {
+	    $closure_func = substr $func, $index + 2;
+	    croak "autouse into different package attempted"
+		unless substr($func, 0, $index) eq $module;
+	}
+
+	my $load_sub = sub {
+	    unless ($INC{$pm}) {
+		eval {require $pm};
+		die if $@;
+		vet_import $module;
+	    }
+	    *$closure_import_func = \&{"${module}::$closure_func"};
+	    print "autousing $module; "
+		  ."imported $closure_func as $closure_import_func\n"
+		if $autouse::DEBUG;
+	    goto &$closure_import_func;
+	};
+
+	if (defined $proto) {
+	    *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
+	} else {
+	    *$closure_import_func = $load_sub;
+	}
+    }
+}
+
+sub vet_import ($) {
+    my $module = shift;
+    if (my $import = $module->can('import')) {
+	croak "autoused module has unique import() method"
+	    unless defined(&Exporter::import)
+		   && $import == \&Exporter::import;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+autouse - postpone load of modules until a function is used
+
+=head1 SYNOPSIS
+
+  use autouse 'Carp' => qw(carp croak);
+  carp "this carp was predeclared and autoused ";
+
+=head1 DESCRIPTION
+
+If the module C<Module> is already loaded, then the declaration
+
+  use autouse 'Module' => qw(func1 func2($;$) Module::func3);
+
+is equivalent to
+
+  use Module qw(func1 func2);
+
+if C<Module> defines func2() with prototype C<($;$)>, and func1() and
+func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
+C<import>, otherwise it is a fatal error.)
+
+If the module C<Module> is not loaded yet, then the above declaration
+declares functions func1() and func2() in the current package, and
+declares a function Module::func3().  When these functions are called,
+they load the package C<Module> if needed, and substitute themselves
+with the correct definitions.
+
+=head1 WARNING
+
+Using C<autouse> will move important steps of your program's execution
+from compile time to runtime.  This can
+
+=over
+
+=item *
+
+Break the execution of your program if the module you C<autouse>d has
+some initialization which it expects to be done early.
+
+=item *
+
+hide bugs in your code since important checks (like correctness of
+prototypes) is moved from compile time to runtime.  In particular, if
+the prototype you specified on C<autouse> line is wrong, you will not
+find it out until the corresponding function is executed.  This will be
+very unfortunate for functions which are not always called (note that
+for such functions C<autouse>ing gives biggest win, for a workaround
+see below).
+
+=back
+
+To alleviate the second problem (partially) it is advised to write
+your scripts like this:
+
+  use Module;
+  use autouse Module => qw(carp($) croak(&$));
+  carp "this carp was predeclared and autoused ";
+
+The first line ensures that the errors in your argument specification
+are found early.  When you ship your application you should comment
+out the first line, since it makes the second one useless.
+
+=head1 AUTHOR
+
+Ilya Zakharevich (ilya@math.ohio-state.edu)
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
diff --git a/contrib/perl5/lib/base.pm b/contrib/perl5/lib/base.pm
new file mode 100644
index 000000000000..3500cbfb8985
--- /dev/null
+++ b/contrib/perl5/lib/base.pm
@@ -0,0 +1,77 @@
+=head1 NAME
+
+base - Establish IS-A relationship with base class at compile time
+
+=head1 SYNOPSIS
+
+    package Baz;
+    use base qw(Foo Bar);
+
+=head1 DESCRIPTION
+
+Roughly similar in effect to
+
+    BEGIN {
+	require Foo;
+	require Bar;
+	push @ISA, qw(Foo Bar);
+    }
+
+Will also initialize the %FIELDS hash if one of the base classes has
+it.  Multiple inheritance of %FIELDS is not supported.  The 'base'
+pragma will croak if multiple base classes has a %FIELDS hash.  See
+L<fields> for a description of this feature.
+
+When strict 'vars' is in scope I<base> also let you assign to @ISA
+without having to declare @ISA with the 'vars' pragma first.
+
+This module was introduced with Perl 5.004_04.
+
+=head1 SEE ALSO
+
+L<fields>
+
+=cut
+
+package base;
+
+sub import {
+    my $class = shift;
+    my $fields_base;
+
+    foreach my $base (@_) {
+	unless (defined %{"$base\::"}) {
+	    eval "require $base";
+	    # Only ignore "Can't locate" errors from our eval require.
+	    # Other fatal errors (syntax etc) must be reported.
+	    die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
+	    unless (defined %{"$base\::"}) {
+		require Carp;
+		Carp::croak("Base class package \"$base\" is empty.\n",
+			    "\t(Perhaps you need to 'use' the module ",
+			    "which defines that package first.)");
+	    }
+	}
+
+	# A simple test like (defined %{"$base\::FIELDS"}) will
+	# sometimes produce typo warnings because it would create
+	# the hash if it was not present before.
+	my $fglob;
+	if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
+	    if ($fields_base) {
+		require Carp;
+		Carp::croak("Can't multiply inherit %FIELDS");
+	    } else {
+		$fields_base = $base;
+	    }
+	}
+    }
+    my $pkg = caller(0);
+    push @{"$pkg\::ISA"}, @_;
+    if ($fields_base) {
+	require fields;
+	fields::inherit($pkg, $fields_base);
+    }
+}
+
+1;
diff --git a/contrib/perl5/lib/bigfloat.pl b/contrib/perl5/lib/bigfloat.pl
new file mode 100644
index 000000000000..d687c784f1ca
--- /dev/null
+++ b/contrib/perl5/lib/bigfloat.pl
@@ -0,0 +1,235 @@
+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 ne '' || defined($4))) {
+	my $x = defined($4) ? $4 : '';
+	&norm(($1 ? "$1$2$x" : "+$2$x"), (($x ne '') ? $6-length($x) : $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/contrib/perl5/lib/bigint.pl b/contrib/perl5/lib/bigint.pl
new file mode 100644
index 000000000000..adeb17f28a93
--- /dev/null
+++ b/contrib/perl5/lib/bigint.pl
@@ -0,0 +1,285 @@
+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/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC
+    $_;
+}
+
+# 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) = @_;
+    return 0 if ($cx eq $cy);
+
+    local($sx, $sy) = (substr($cx, 0, 1), substr($cy, 0, 1));
+    local($ld);
+
+    if ($sx eq '+') {
+      return  1 if ($sy eq '-' || $cy eq '+0');
+      $ld = length($cx) - length($cy);
+      return $ld if ($ld);
+      return $cx cmp $cy;
+    } else { # $sx eq '-'
+      return -1 if ($sy eq '+');
+      $ld = length($cy) - length($cx);
+      return $ld if ($ld);
+      return $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) ? 1 : 0;
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
+    }
+    (@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/contrib/perl5/lib/bigrat.pl b/contrib/perl5/lib/bigrat.pl
new file mode 100644
index 000000000000..fb436ce57081
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/blib.pm b/contrib/perl5/lib/blib.pm
new file mode 100644
index 000000000000..1d56a58174e3
--- /dev/null
+++ b/contrib/perl5/lib/blib.pm
@@ -0,0 +1,72 @@
+package blib;
+
+=head1 NAME
+
+blib - Use MakeMaker's uninstalled version of a package
+
+=head1 SYNOPSIS
+
+ perl -Mblib script [args...]
+
+ perl -Mblib=dir script [args...]
+
+=head1 DESCRIPTION
+
+Looks for MakeMaker-like I<'blib'> directory structure starting in 
+I<dir> (or current directory) and working back up to five levels of '..'.
+
+Intended for use on command line with B<-M> option as a way of testing
+arbitary scripts against an uninstalled version of a package.
+
+However it is possible to : 
+
+ use blib; 
+ or 
+ use blib '..';
+
+etc. if you really must.
+
+=head1 BUGS
+
+Pollutes global name space for development only task.
+
+=head1 AUTHOR
+
+Nick Ing-Simmons nik@tiuk.ti.com
+
+=cut 
+
+use Cwd;
+
+use vars qw($VERSION);
+$VERSION = '1.00';
+
+sub import
+{
+ my $package = shift;
+ my $dir = getcwd;
+ if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/$--; }
+ if (@_)
+  {
+   $dir = shift;
+   $dir =~ s/blib$//;
+   $dir =~ s,/+$,,;
+   $dir = '.' unless ($dir);
+   die "$dir is not a directory\n" unless (-d $dir);
+  }
+ my $i   = 5;
+ while ($i--)
+  {
+   my $blib = "${dir}/blib";
+   if (-d $blib && -d "$blib/arch" && -d "$blib/lib")
+    {
+     unshift(@INC,"$blib/arch","$blib/lib");
+     warn "Using $blib\n";
+     return;
+    }
+   $dir .= "/..";
+  }
+ die "Cannot find blib even in $dir\n";
+}
+
+1;
diff --git a/contrib/perl5/lib/cacheout.pl b/contrib/perl5/lib/cacheout.pl
new file mode 100644
index 000000000000..64378cffc6f0
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/chat2.pl b/contrib/perl5/lib/chat2.pl
new file mode 100644
index 000000000000..094d3dff21ab
--- /dev/null
+++ b/contrib/perl5/lib/chat2.pl
@@ -0,0 +1,370 @@
+# 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;
+	}
+
+	local $out = join $, , @_;
+	syswrite(S, $out, length $out);
+	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/contrib/perl5/lib/complete.pl b/contrib/perl5/lib/complete.pl
new file mode 100644
index 000000000000..539f2f779839
--- /dev/null
+++ b/contrib/perl5/lib/complete.pl
@@ -0,0 +1,111 @@
+;#
+;#      @(#)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($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+    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;
+			undef $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/contrib/perl5/lib/constant.pm b/contrib/perl5/lib/constant.pm
new file mode 100644
index 000000000000..464e20cd91d0
--- /dev/null
+++ b/contrib/perl5/lib/constant.pm
@@ -0,0 +1,172 @@
+package constant;
+
+$VERSION = '1.00';
+
+=head1 NAME
+
+constant - Perl pragma to declare constants
+
+=head1 SYNOPSIS
+
+    use constant BUFFER_SIZE	=> 4096;
+    use constant ONE_YEAR	=> 365.2425 * 24 * 60 * 60;
+    use constant PI		=> 4 * atan2 1, 1;
+    use constant DEBUGGING	=> 0;
+    use constant ORACLE		=> 'oracle@cs.indiana.edu';
+    use constant USERNAME	=> scalar getpwuid($<);
+    use constant USERINFO	=> getpwuid($<);
+
+    sub deg2rad { PI * $_[0] / 180 }
+
+    print "This line does nothing"		unless DEBUGGING;
+
+=head1 DESCRIPTION
+
+This will declare a symbol to be a constant with the given scalar
+or list value.
+
+When you declare a constant such as C<PI> using the method shown
+above, each machine your script runs upon can have as many digits
+of accuracy as it can use. Also, your program will be easier to
+read, more likely to be maintained (and maintained correctly), and
+far less likely to send a space probe to the wrong planet because
+nobody noticed the one equation in which you wrote C<3.14195>.
+
+=head1 NOTES
+
+The value or values are evaluated in a list context. You may override
+this with C<scalar> as shown above.
+
+These constants do not directly interpolate into double-quotish
+strings, although you may do so indirectly. (See L<perlref> for
+details about how this works.)
+
+    print "The value of PI is @{[ PI ]}.\n";
+
+List constants are returned as lists, not as arrays.
+
+    $homedir = USERINFO[7];		# WRONG
+    $homedir = (USERINFO)[7];		# Right
+
+The use of all caps for constant names is merely a convention,
+although it is recommended in order to make constants stand out
+and to help avoid collisions with other barewords, keywords, and
+subroutine names. Constant names must begin with a letter.
+
+Constant symbols are package scoped (rather than block scoped, as
+C<use strict> is). That is, you can refer to a constant from package
+Other as C<Other::CONST>.
+
+As with all C<use> directives, defining a constant happens at
+compile time. Thus, it's probably not correct to put a constant
+declaration inside of a conditional statement (like C<if ($foo)
+{ use constant ... }>).
+
+Omitting the value for a symbol gives it the value of C<undef> in
+a scalar context or the empty list, C<()>, in a list context. This
+isn't so nice as it may sound, though, because in this case you
+must either quote the symbol name, or use a big arrow, (C<=E<gt>>),
+with nothing to point to. It is probably best to declare these
+explicitly.
+
+    use constant UNICORNS	=> ();
+    use constant LOGFILE	=> undef;
+
+The result from evaluating a list constant in a scalar context is
+not documented, and is B<not> guaranteed to be any particular value
+in the future. In particular, you should not rely upon it being
+the number of elements in the list, especially since it is not
+B<necessarily> that value in the current implementation.
+
+Magical values, tied values, and references can be made into
+constants at compile time, allowing for way cool stuff like this.
+(These error numbers aren't totally portable, alas.)
+
+    use constant E2BIG => ($! = 7);
+    print   E2BIG, "\n";	# something like "Arg list too long"
+    print 0+E2BIG, "\n";	# "7"
+
+=head1 TECHNICAL NOTE
+
+In the current implementation, scalar constants are actually
+inlinable subroutines. As of version 5.004 of Perl, the appropriate
+scalar constant is inserted directly in place of some subroutine
+calls, thereby saving the overhead of a subroutine call. See
+L<perlsub/"Constant Functions"> for details about how and when this
+happens.
+
+=head1 BUGS
+
+In the current version of Perl, list constants are not inlined
+and some symbols may be redefined without generating a warning.
+
+It is not possible to have a subroutine or keyword with the same
+name as a constant. This is probably a Good Thing.
+
+Unlike constants in some languages, these cannot be overridden
+on the command line or via environment variables.
+
+You can get into trouble if you use constants in a context which
+automatically quotes barewords (as is true for any subroutine call).
+For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
+be interpreted as a string.  Use C<$hash{CONSTANT()}> or
+C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
+kicking in.  Similarly, since the C<=E<gt>> operator quotes a bareword
+immediately to its left you have to say C<CONSTANT() =E<gt> 'value'>
+instead of C<CONSTANT =E<gt> 'value'>.
+
+=head1 AUTHOR
+
+Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from
+many other folks.
+
+=head1 COPYRIGHT
+
+Copyright (C) 1997, Tom Phoenix
+
+This module is free software; you can redistribute it or modify it
+under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use Carp;
+use vars qw($VERSION);
+
+#=======================================================================
+
+# Some of this stuff didn't work in version 5.003, alas.
+require 5.003_96;
+
+#=======================================================================
+# import() - import symbols into user's namespace
+#
+# What we actually do is define a function in the caller's namespace
+# which returns the value. The function we create will normally
+# be inlined as a constant, thereby avoiding further sub calling 
+# overhead.
+#=======================================================================
+sub import {
+    my $class = shift;
+    my $name = shift or return;			# Ignore 'use constant;'
+    croak qq{Can't define "$name" as constant} .
+	    qq{ (name contains invalid characters or is empty)}
+	unless $name =~ /^[^\W_0-9]\w*$/;
+
+    my $pkg = caller;
+    {
+	no strict 'refs';
+	if (@_ == 1) {
+	    my $scalar = $_[0];
+	    *{"${pkg}::$name"} = sub () { $scalar };
+	} elsif (@_) {
+	    my @list = @_;
+	    *{"${pkg}::$name"} = sub () { @list };
+	} else {
+	    *{"${pkg}::$name"} = sub () { };
+	}
+    }
+
+}
+
+1;
diff --git a/contrib/perl5/lib/ctime.pl b/contrib/perl5/lib/ctime.pl
new file mode 100644
index 000000000000..14e122adda0b
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/diagnostics.pm b/contrib/perl5/lib/diagnostics.pm
new file mode 100755
index 000000000000..78bf4457cba9
--- /dev/null
+++ b/contrib/perl5/lib/diagnostics.pm
@@ -0,0 +1,533 @@
+package diagnostics;
+
+=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 with the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects the 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 variable can generate nicer
+escape sequences for pagers.
+
+=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 theoretical 
+
+    (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 diagnostics::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 do 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 Perl 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<tchrist@mox.perl.com>>, 25 June 1995.
+
+=cut
+
+require 5.001;
+use Carp;
+
+use Config;
+($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
+if ($^O eq 'VMS') {
+    require VMS::Filespec;
+    $privlib = VMS::Filespec::unixify($privlib);
+    $archlib = VMS::Filespec::unixify($archlib);
+}
+@trypod = ("$archlib/pod/perldiag.pod",
+	   "$privlib/pod/perldiag-$].pod",
+	   "$privlib/pod/perldiag.pod");
+# handy for development testing of new warnings etc
+unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
+($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$| = 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:')
+	    or 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;
+	}
+
+	# strip formatting directives in =item line
+	($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
+
+	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;
+		$lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "$WHOAMI: Duplicate entry: \"$header\"\n"
+	    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 (defined ($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];
+
+    # See if we are coming from anywhere within an eval. If so we don't
+    # want to explain the exception because it's going to get caught.
+    my $in_eval = 0;
+    my $i = 0;
+    while (1) {
+      my $caller = (caller($i++))[3] or last;
+      if ($caller eq '(eval)') {
+	$in_eval = 1;
+	last;
+      }
+    }
+
+    splainthis($exception) unless $in_eval;
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+
+    # We don't want to unset these if we're coming from an eval because
+    # then we've turned off diagnostics. (Actually what does this next
+    # line do?  -PSeibel)
+    $SIG{__DIE__} = $SIG{__WARN__} = '' unless $in_eval;
+    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;
+    local $\;
+    ### &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: E<$1> in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length($line) > 79 and index($line, "\n") == -1) {
+	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/contrib/perl5/lib/dotsh.pl b/contrib/perl5/lib/dotsh.pl
new file mode 100644
index 000000000000..877467eb9613
--- /dev/null
+++ b/contrib/perl5/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;
+       m/^([^=]*)=(.*)/s;
+       $ENV{$1} = $2;
+   }
+   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/contrib/perl5/lib/dumpvar.pl b/contrib/perl5/lib/dumpvar.pl
new file mode 100644
index 000000000000..32d4692d13ab
--- /dev/null
+++ b/contrib/perl5/lib/dumpvar.pl
@@ -0,0 +1,417 @@
+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;
+$dumpReused = 0 unless defined $dumpReused;
+$bareStringify = 1 unless defined $bareStringify;
+
+sub main::dumpValue {
+  local %address;
+  local $^W=0;
+  (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';
+	$_ = &{'overload::StrVal'}($_) 
+	  if $bareStringify and ref $_ 
+	    and defined %overload:: and defined &{'overload::StrVal'};
+	
+	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,@sortKeys,$more,$shortmore,$short) ;
+    local($tHashDepth,$tArrayDepth) ;
+
+    $sp = " " x $s ;
+    $s += 3 ; 
+
+    # Check for reused addresses
+    if (ref $v) { 
+      my $val = $v;
+      $val = &{'overload::StrVal'}($v) 
+	if defined %overload:: and defined &{'overload::StrVal'};
+      ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; 
+      if (!$dumpReused && defined $address) { 
+	$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 ( UNIVERSAL::isa($v, '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 ( UNIVERSAL::isa($v, '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 (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) { 
+	    print "$sp-> ";
+	    DumpElem $$v, $s;
+    } elsif ( UNIVERSAL::isa($v, 'CODE') ) { 
+	    print "$sp-> ";
+	    dumpsub (0, $v);
+    } elsif ( UNIVERSAL::isa($v, '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] =~ /^([!~])(.)([\x00-\xff]*)/) and 
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
+}
+
+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,$^W);
+    $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/contrib/perl5/lib/exceptions.pl b/contrib/perl5/lib/exceptions.pl
new file mode 100644
index 000000000000..02c4498d3211
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/fastcwd.pl b/contrib/perl5/lib/fastcwd.pl
new file mode 100644
index 000000000000..6b452e8d788c
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/fields.pm b/contrib/perl5/lib/fields.pm
new file mode 100644
index 000000000000..db2eea7a39d4
--- /dev/null
+++ b/contrib/perl5/lib/fields.pm
@@ -0,0 +1,156 @@
+package fields;
+
+=head1 NAME
+
+fields - compile-time class fields
+
+=head1 SYNOPSIS
+
+    {
+        package Foo;
+        use fields qw(foo bar _private);
+    }
+    ...
+    my Foo $var = new Foo;
+    $var->{foo} = 42;
+
+    # This will generate a compile-time error.
+    $var->{zap} = 42;
+
+    {
+        package Bar;
+        use base 'Foo';
+        use fields 'bar';             # hides Foo->{bar}
+        use fields qw(baz _private);  # not shared with Foo
+    }
+
+=head1 DESCRIPTION
+
+The C<fields> pragma enables compile-time verified class fields.  It
+does so by updating the %FIELDS hash in the calling package.
+
+If a typed lexical variable holding a reference is used to access a
+hash element and the %FIELDS hash of the given type exists, then the
+operation is turned into an array access at compile time.  The %FIELDS
+hash map from hash element names to the array indices.  If the hash
+element is not present in the %FIELDS hash, then a compile-time error
+is signaled.
+
+Since the %FIELDS hash is used at compile-time, it must be set up at
+compile-time too.  This is made easier with the help of the 'fields'
+and the 'base' pragma modules.  The 'base' pragma will copy fields
+from base classes and the 'fields' pragma adds new fields.  Field
+names that start with an underscore character are made private to a
+class and are not visible to subclasses.  Inherited fields can be
+overridden but will generate a warning if used together with the C<-w>
+switch.
+
+The effect of all this is that you can have objects with named fields
+which are as compact and as fast arrays to access.  This only works
+as long as the objects are accessed through properly typed variables.
+For untyped access to work you have to make sure that a reference to
+the proper %FIELDS hash is assigned to the 0'th element of the array
+object (so that the objects can be treated like an pseudo-hash).  A
+constructor like this does the job:
+
+  sub new
+  {
+      my $class = shift;
+      no strict 'refs';
+      my $self = bless [\%{"$class\::FIELDS"], $class;
+      $self;
+  }
+
+
+=head1 SEE ALSO
+
+L<base>,
+L<perlref/Pseudo-hashes: Using an array as a hash>
+
+=cut
+
+use strict;
+no strict 'refs';
+use vars qw(%attr $VERSION);
+
+$VERSION = "0.02";
+
+# some constants
+sub _PUBLIC    () { 1 }
+sub _PRIVATE   () { 2 }
+sub _INHERITED () { 4 }
+
+# The %attr hash holds the attributes of the currently assigned fields
+# per class.  The hash is indexed by class names and the hash value is
+# an array reference.  The array is indexed with the field numbers
+# (minus one) and the values are integer bit masks (or undef).  The
+# size of the array also indicate the next field index too assign for
+# additional fields in this class.
+
+sub import {
+    my $class = shift;
+    my $package = caller(0);
+    my $fields = \%{"$package\::FIELDS"};
+    my $fattr = ($attr{$package} ||= []);
+
+    foreach my $f (@_) {
+	if (my $fno = $fields->{$f}) {
+	    require Carp;
+            if ($fattr->[$fno-1] & _INHERITED) {
+                Carp::carp("Hides field '$f' in base class") if $^W;
+            } else {
+                Carp::croak("Field name '$f' already in use");
+            }
+	}
+	$fields->{$f} = @$fattr + 1;
+        push(@$fattr, ($f =~ /^_/) ? _PRIVATE : _PUBLIC);
+    }
+}
+
+sub inherit  # called by base.pm
+{
+    my($derived, $base) = @_;
+
+    if (defined %{"$derived\::FIELDS"}) {
+	 require Carp;
+         Carp::croak("Inherited %FIELDS can't override existing %FIELDS");
+    } else {
+         my $base_fields    = \%{"$base\::FIELDS"};
+	 my $derived_fields = \%{"$derived\::FIELDS"};
+
+         $attr{$derived}[@{$attr{$base}}-1] = undef;
+         while (my($k,$v) = each %$base_fields) {
+            next if $attr{$base}[$v-1] & _PRIVATE;
+            $attr{$derived}[$v-1] = _INHERITED;
+            $derived_fields->{$k} = $v;
+         }
+    }
+    
+}
+
+sub _dump  # sometimes useful for debugging
+{
+   for my $pkg (sort keys %attr) {
+      print "\n$pkg";
+      if (defined @{"$pkg\::ISA"}) {
+         print " (", join(", ", @{"$pkg\::ISA"}), ")";
+      }
+      print "\n";
+      my $fields = \%{"$pkg\::FIELDS"};
+      for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
+         my $no = $fields->{$f};
+         print "   $no: $f";
+         my $fattr = $attr{$pkg}[$no-1];
+         if (defined $fattr) {
+            my @a;
+	    push(@a, "public")    if $fattr & _PUBLIC;
+            push(@a, "private")   if $fattr & _PRIVATE;
+            push(@a, "inherited") if $fattr & _INHERITED;
+            print "\t(", join(", ", @a), ")";
+         }
+         print "\n";
+      }
+   }
+}
+
+1;
diff --git a/contrib/perl5/lib/find.pl b/contrib/perl5/lib/find.pl
new file mode 100644
index 000000000000..ee5dc5d15065
--- /dev/null
+++ b/contrib/perl5/lib/find.pl
@@ -0,0 +1,47 @@
+# 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.
+
+use File::Find ();
+
+*name		= *File::Find::name;
+*prune		= *File::Find::prune;
+*dir		= *File::Find::dir;
+*topdir		= *File::Find::topdir;
+*topdev		= *File::Find::topdev;
+*topino		= *File::Find::topino;
+*topmode	= *File::Find::topmode;
+*topnlink	= *File::Find::topnlink;
+
+sub find {
+    &File::Find::find(\&wanted, @_);
+}
+
+1;
diff --git a/contrib/perl5/lib/finddepth.pl b/contrib/perl5/lib/finddepth.pl
new file mode 100644
index 000000000000..bfa44bb1bc9d
--- /dev/null
+++ b/contrib/perl5/lib/finddepth.pl
@@ -0,0 +1,46 @@
+# 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);
+#	}
+
+
+use File::Find ();
+
+*name		= *File::Find::name;
+*prune		= *File::Find::prune;
+*dir		= *File::Find::dir;
+*topdir		= *File::Find::topdir;
+*topdev		= *File::Find::topdev;
+*topino		= *File::Find::topino;
+*topmode	= *File::Find::topmode;
+*topnlink	= *File::Find::topnlink;
+
+sub finddepth {
+    &File::Find::finddepth(\&wanted, @_);
+}
+
+1;
diff --git a/contrib/perl5/lib/flush.pl b/contrib/perl5/lib/flush.pl
new file mode 100644
index 000000000000..55002b9919c7
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/ftp.pl b/contrib/perl5/lib/ftp.pl
new file mode 100644
index 000000000000..fd78162a404f
--- /dev/null
+++ b/contrib/perl5/lib/ftp.pl
@@ -0,0 +1,1077 @@
+#-*-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: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.17 1993/04/21 10:06:54 lmjm Exp lmjm $
+# $Log: ftp.pl,v $
+# 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';	# into main
+eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
+	|| die "socket.ph missing: $!\n";
+
+
+package ftp;
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+# If the remote ftp daemon doesn't respond within this time presume its dead
+# or something.
+$timeout = 30;
+
+# Timeout a read if I don't get data back within this many seconds
+$timeout_read = 20 * $timeout;
+
+# Timeout an open
+$timeout_open = $timeout;
+
+# This is a "global" it contains the last response from the remote ftp server
+# for use in error messages
+$ftp'response = "";
+# Also ftp'NS is the socket containing the data coming in from the remote ls
+# command.
+
+# The size of block to be read or written when talking to the remote
+# ftp server
+$ftp'ftpbufsize = 4096;
+
+# How often to print a hash out, when debugging
+$ftp'hashevery = 1024;
+# Output a newline after this many hashes to prevent outputing very long lines
+$ftp'hashnl = 70;
+
+# If a proxy connection then who am I really talking to?
+$real_site = "";
+
+# This is just a tracing aid.
+$ftp_show = 0;
+sub ftp'debug
+{
+	$ftp_show = $_[0];
+#	if( $ftp_show ){
+#		print STDERR "ftp debugging on\n";
+#	}
+}
+
+sub ftp'set_timeout
+{
+	$timeout = $_[0];
+	$timeout_open = $timeout;
+	$timeout_read = 20 * $timeout;
+	if( $ftp_show ){
+		print STDERR "ftp timeout set to $timeout\n";
+	}
+}
+
+
+sub ftp'open_alarm
+{
+	die "timeout: open";
+}
+
+sub ftp'timed_open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+	local( $connect_site, $connect_port );
+	local( $res );
+
+	alarm( $timeout_open );
+
+	while( $attempts-- ){
+		if( $ftp_show ){
+			print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
+			print STDERR "Connecting to $site";
+			if( $ftp_port != 21 ){
+				print STDERR " [port $ftp_port]";
+			}
+			print STDERR "\n";
+		}
+		
+		if( $proxy ) {
+			if( ! $proxy_gateway ) {
+				# if not otherwise set
+				$proxy_gateway = "internet-gateway";
+			}
+			if( $debug ) {
+				print STDERR "using proxy services of $proxy_gateway, ";
+				print STDERR "at $proxy_ftp_port\n";
+			}
+			$connect_site = $proxy_gateway;
+			$connect_port = $proxy_ftp_port;
+			$real_site = $site;
+		}
+		else {
+			$connect_site = $site;
+			$connect_port = $ftp_port;
+		}
+		if( ! &chat'open_port( $connect_site, $connect_port ) ){
+			if( $retry_call ){
+				print STDERR "Failed to connect\n" if $ftp_show;
+				next;
+			}
+			else {
+				print STDERR "proxy connection failed " if $proxy;
+				print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
+				return 0;
+			}
+		}
+		$res = &ftp'expect( $timeout,
+				    120, "service unavailable to $site", 0, 
+	                            220, "ready for login to $site", 1,
+				    421, "service unavailable to $site, closing connection", 0);
+		if( ! $res ){
+			&chat'close();
+			next;
+		}
+		return 1;
+	}
+	continue {
+		print STDERR "Pausing between retries\n";
+		sleep( $retry_pause );
+	}
+	return 0;
+}
+
+sub ftp'open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+
+	$SIG{ 'ALRM' } = "ftp\'open_alarm";
+
+	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+sub ftp'login
+{
+	local( $remote_user, $remote_password ) = @_;
+
+	if( $proxy ){
+		&ftp'send( "USER $remote_user\@$site" );
+	}
+	else {
+		&ftp'send( "USER $remote_user" );
+	}
+        local( $val ) =
+               &ftp'expect($timeout,
+	           230, "$remote_user logged in", 1,
+		   331, "send password for $remote_user", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+		   332, "account for login not supported", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $val == 1 ){
+		return 1;
+	}
+	if( $val == 2 ){
+		# A password is needed
+		&ftp'send( "PASS $remote_password" );
+
+		$val = &ftp'expect( $timeout,
+		   230, "$remote_user logged in", 1,
+
+		   202, "command not implemented", 0,
+		   332, "account for login not supported", 0,
+
+		   530, "not logged in", 0,
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   503, "bad sequence of commands", 0, 
+
+		   421, "service unavailable, closing connection", 0);
+		if( $val == 1){
+			# Logged in
+			return 1;
+		}
+	}
+	# If I got here I failed to login
+	return 0;
+}
+
+sub ftp'close
+{
+	&ftp'quit();
+	&chat'close();
+}
+
+# Change directory
+# return 1 if successful
+# 0 on a failure
+sub ftp'cwd
+{
+	local( $dir ) = @_;
+
+	&ftp'send( "CWD $dir" );
+
+	return &ftp'expect( $timeout,
+		200, "working directory = $dir", 1,
+		250, "working directory = $dir", 1,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+                502, "command not implemented", 0,
+		530, "not logged in", 0,
+                550, "cannot change directory", 0,
+		421, "service unavailable, closing connection", 0 );
+}
+
+# Get a full directory listing:
+# &ftp'dir( remote LIST options )
+# Start a list 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/contrib/perl5/lib/getcwd.pl b/contrib/perl5/lib/getcwd.pl
new file mode 100644
index 000000000000..9dd694500c65
--- /dev/null
+++ b/contrib/perl5/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 ne '');
+    chop($cwd);
+    $cwd;
+}
+
+1;
diff --git a/contrib/perl5/lib/getopt.pl b/contrib/perl5/lib/getopt.pl
new file mode 100644
index 000000000000..f871e4185011
--- /dev/null
+++ b/contrib/perl5/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);
+	    }
+	    ${"opt_$first"} = $rest;
+	}
+	else {
+	    ${"opt_$first"} = 1;
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+}
+
+1;
diff --git a/contrib/perl5/lib/getopts.pl b/contrib/perl5/lib/getopts.pl
new file mode 100644
index 000000000000..852aae89b18d
--- /dev/null
+++ b/contrib/perl5/lib/getopts.pl
@@ -0,0 +1,49 @@
+;# 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;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	$pos = index($argumentative,$first);
+	if($pos >= 0) {
+	    if($pos < $#args && $args[$pos+1] eq ':') {
+		shift(@ARGV);
+		if($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		${"opt_$first"} = $rest;
+	    }
+	    else {
+		${"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/contrib/perl5/lib/hostname.pl b/contrib/perl5/lib/hostname.pl
new file mode 100644
index 000000000000..5394c6ec693f
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/importenv.pl b/contrib/perl5/lib/importenv.pl
new file mode 100644
index 000000000000..c28ffd054d4a
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/integer.pm b/contrib/perl5/lib/integer.pm
new file mode 100644
index 000000000000..894931896fc2
--- /dev/null
+++ b/contrib/perl5/lib/integer.pm
@@ -0,0 +1,43 @@
+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 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.
+
+Note that this affects the operations, not the numbers.  If you run this
+code
+
+    use integer;
+    $x = 1.5;
+    $y = $x + 1;
+    $z = -1.5;
+
+you'll be left with C<$x == 1.5>, C<$y == 2> and C<$z == -1>.  The $z
+case happens because unary C<-> counts as an operation.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+sub import {
+    $^H |= 1;
+}
+
+sub unimport {
+    $^H &= ~1;
+}
+
+1;
diff --git a/contrib/perl5/lib/less.pm b/contrib/perl5/lib/less.pm
new file mode 100644
index 000000000000..b3afef0fcdc5
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/lib.pm b/contrib/perl5/lib/lib.pm
new file mode 100644
index 000000000000..6e6e15e4ce95
--- /dev/null
+++ b/contrib/perl5/lib/lib.pm
@@ -0,0 +1,139 @@
+package lib;
+
+use vars qw(@ORIG_INC);
+use Config;
+
+my $archname = $Config{'archname'};
+
+@ORIG_INC = @INC;	# take a handy copy of 'original' value
+
+
+sub import {
+    shift;
+    foreach (reverse @_) {
+	## Ignore this if not defined.
+	next unless defined($_);
+	if ($_ eq '') {
+	    require Carp;
+	    Carp::carp("Empty compile time value given to use lib");
+							# at foo.pl line ...
+	}
+	if (-e && ! -d _) {
+	    require Carp;
+	    Carp::carp("Parameter to use lib must be directory, not file");
+	}
+	unshift(@INC, $_);
+	# Put a corresponding archlib directory infront of $_ if it
+	# looks like $_ has an archlib directory below it.
+	if (-d "$_/$archname") {
+	    unshift(@INC, "$_/$archname")    if -d "$_/$archname/auto";
+	    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
+
+FindBin - optional module which deals with paths relative to the source file.
+
+=head1 AUTHOR
+
+Tim Bunce, 2nd June 1995.
+
+=cut
+
diff --git a/contrib/perl5/lib/locale.pm b/contrib/perl5/lib/locale.pm
new file mode 100644
index 000000000000..48213ab86cef
--- /dev/null
+++ b/contrib/perl5/lib/locale.pm
@@ -0,0 +1,33 @@
+package locale;
+
+=head1 NAME
+
+locale - Perl pragma to use and avoid POSIX locales for built-in operations
+
+=head1 SYNOPSIS
+
+    @x = sort @y;	# ASCII sorting order
+    {
+        use locale;
+        @x = sort @y;   # Locale-defined sorting order
+    }
+    @x = sort @y;	# ASCII sorting order again
+
+=head1 DESCRIPTION
+
+This pragma tells the compiler to enable (or disable) the use of POSIX
+locales for built-in operations (LC_CTYPE for regular expressions, and
+LC_COLLATE for string comparison).  Each "use locale" or "no locale"
+affects statements to the end of the enclosing BLOCK.
+
+=cut
+
+sub import {
+    $^H |= 0x800;
+}
+
+sub unimport {
+    $^H &= ~0x800;
+}
+
+1;
diff --git a/contrib/perl5/lib/look.pl b/contrib/perl5/lib/look.pl
new file mode 100644
index 000000000000..e8dc8aacb6a2
--- /dev/null
+++ b/contrib/perl5/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 = lc $key 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;
+	$_ = lc $_ 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;
+	$_ = lc $_ if $fold;
+	last if $_ ge $key;
+	$min = tell(FH);
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/contrib/perl5/lib/newgetopt.pl b/contrib/perl5/lib/newgetopt.pl
new file mode 100644
index 000000000000..0b7eed8bfe91
--- /dev/null
+++ b/contrib/perl5/lib/newgetopt.pl
@@ -0,0 +1,68 @@
+# newgetopt.pl -- new options parsing.
+# Now just a wrapper around the Getopt::Long module.
+# $Id: newgetopt.pl,v 1.17 1996-10-02 11:17:16+02 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;
+	$bundling = 0;
+	$passthrough = 0;
+    }
+    else {
+	$autoabbrev = 1;	# automatic abbrev of options
+	$getopt_compat = 1;	# allow '+' to start options
+	$option_start = "(--|-|\\+)";
+	$order = $PERMUTE;
+	$bundling = 0;
+	$passthrough = 0;
+    }
+
+    # 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::bundling = $newgetopt::bundling 
+	if defined $newgetopt::bundling;
+    $Getopt::Long::ignorecase = $newgetopt::ignorecase 
+	if defined $newgetopt::ignorecase;
+    $Getopt::Long::ignorecase = $newgetopt::ignorecase 
+	if defined $newgetopt::ignorecase;
+    $Getopt::Long::passthrough = $newgetopt::passthrough 
+	if defined $newgetopt::passthrough;
+
+    &GetOptions;
+}
+
+################ Package return ################
+
+1;
+
+################ End of newgetopt.pl ################
diff --git a/contrib/perl5/lib/open2.pl b/contrib/perl5/lib/open2.pl
new file mode 100644
index 000000000000..8cf08c2e8bd1
--- /dev/null
+++ b/contrib/perl5/lib/open2.pl
@@ -0,0 +1,12 @@
+# This is a compatibility interface to IPC::Open2.  New programs should
+# do
+#
+#     use IPC::Open2;
+#
+# instead of
+#
+#     require 'open2.pl';
+
+package main;
+use IPC::Open2 'open2';
+1
diff --git a/contrib/perl5/lib/open3.pl b/contrib/perl5/lib/open3.pl
new file mode 100644
index 000000000000..7fcc93186106
--- /dev/null
+++ b/contrib/perl5/lib/open3.pl
@@ -0,0 +1,12 @@
+# This is a compatibility interface to IPC::Open3.  New programs should
+# do
+#
+#     use IPC::Open3;
+#
+# instead of
+#
+#     require 'open3.pl';
+
+package main;
+use IPC::Open3 'open3';
+1
diff --git a/contrib/perl5/lib/overload.pm b/contrib/perl5/lib/overload.pm
new file mode 100644
index 000000000000..43fef8ae5e0b
--- /dev/null
+++ b/contrib/perl5/lib/overload.pm
@@ -0,0 +1,1216 @@
+package overload;
+
+sub nil {}
+
+sub OVERLOAD {
+  $package = shift;
+  my %arg = @_;
+  my ($sub, $fb);
+  $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
+  *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
+  for (keys %arg) {
+    if ($_ eq 'fallback') {
+      $fb = $arg{$_};
+    } else {
+      $sub = $arg{$_};
+      if (not ref $sub and $sub !~ /::/) {
+	$ {$package . "::(" . $_} = $sub;
+	$sub = \&nil;
+      }
+      #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
+      *{$package . "::(" . $_} = \&{ $sub };
+    }
+  }
+  ${$package . "::()"} = $fb; # Make it findable too (fallback only).
+}
+
+sub import {
+  $package = (caller())[0];
+  # *{$package . "::OVERLOAD"} = \&OVERLOAD;
+  shift;
+  $package->overload::OVERLOAD(@_);
+}
+
+sub unimport {
+  $package = (caller())[0];
+  ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
+  shift;
+  for (@_) {
+    if ($_ eq 'fallback') {
+      undef $ {$package . "::()"};
+    } else {
+      delete $ {$package . "::"}{"(" . $_};
+    }
+  }
+}
+
+sub Overloaded {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  $package->can('()');
+}
+
+sub ov_method {
+  my $globref = shift;
+  return undef unless $globref;
+  my $sub = \&{*$globref};
+  return $sub if $sub ne \&nil;
+  return shift->can($ {*$globref});
+}
+
+sub OverloadedStringify {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #$package->can('(""')
+  ov_method mycan($package, '(""'), $package
+    or ov_method mycan($package, '(0+'), $package
+    or ov_method mycan($package, '(bool'), $package
+    or ov_method mycan($package, '(nomethod'), $package;
+}
+
+sub Method {
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #my $meth = $package->can('(' . shift);
+  ov_method mycan($package, '(' . shift), $package;
+  #return $meth if $meth ne \&nil;
+  #return $ {*{$meth}};
+}
+
+sub AddrRef {
+  my $package = ref $_[0];
+  return "$_[0]" unless $package;
+  bless $_[0], overload::Fake;	# Non-overloaded package
+  my $str = "$_[0]";
+  bless $_[0], $package;	# Back
+  $package . substr $str, index $str, '=';
+}
+
+sub StrVal {
+  (OverloadedStringify($_[0])) ?
+    (AddrRef(shift)) :
+    "$_[0]";
+}
+
+sub mycan {				# Real can would leave stubs.
+  my ($package, $meth) = @_;
+  return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
+  my $p;
+  foreach $p (@{$package . "::ISA"}) {
+    my $out = mycan($p, $meth);
+    return $out if $out;
+  }
+  return undef;
+}
+
+%constants = (
+	      'integer'	  =>  0x1000, 
+	      'float'	  =>  0x2000,
+	      'binary'	  =>  0x4000,
+	      'q'	  =>  0x8000,
+	      'qr'	  => 0x10000,
+	     );
+
+%ops = ( with_assign	  => "+ - * / % ** << >> x .",
+	 assign		  => "+= -= *= /= %= **= <<= >>= x= .=",
+	 str_comparison	  => "< <= >  >= == !=",
+	 '3way_comparison'=> "<=> cmp",
+	 num_comparison	  => "lt le gt ge eq ne",
+	 binary		  => "& | ^",
+	 unary		  => "neg ! ~",
+	 mutators	  => '++ --',
+	 func		  => "atan2 cos sin exp abs log sqrt",
+	 conversion	  => 'bool "" 0+',
+	 special	  => 'nomethod fallback =');
+
+sub constant {
+  # Arguments: what, sub
+  while (@_) {
+    $^H{$_[0]} = $_[1];
+    $^H |= $constants{$_[0]} | 0x20000;
+    shift, shift;
+  }
+}
+
+sub remove_constant {
+  # Arguments: what, sub
+  while (@_) {
+    delete $^H{$_[0]};
+    $^H &= ~ $constants{$_[0]};
+    shift, shift;
+  }
+}
+
+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.  Note that values specified as strings are
+interpreted as methods, not subroutines.  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.)
+
+Since overloading respects inheritance via the @ISA hierarchy, the
+above declaration would also trigger overloading of C<+> and C<*=> in
+all the packages which inherit from C<Number>.
+
+=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.  Compare
+L<Calling Conventions for Mutators>.
+
+=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 Calling Conventions for Mutators
+
+Two types of mutators have different calling conventions:
+
+=over
+
+=item C<++> and C<-->
+
+The routines which implement these operators are expected to actually
+I<mutate> their arguments.  So, assuming that $obj is a reference to a
+number,
+
+  sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}
+
+is an appropriate implementation of overloaded C<++>.  Note that
+
+  sub incr { ++$ {$_[0]} ; shift }
+
+is OK if used with preincrement and with postincrement. (In the case
+of postincrement a copying will be performed, see L<Copy Constructor>.)
+
+=item C<x=> and other assignment versions
+
+There is nothing special about these methods.  They may change the
+value of their arguments, and may leave it as is.  The result is going
+to be assigned to the value in the left-hand-side if different from
+this value.
+
+This allows for the same method to be used as averloaded C<+=> and
+C<+>.  Note that this is I<allowed>, but not recommended, since by the
+semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
+if C<+=> is not overloaded.
+
+=back
+
+B<Warning.>  Due to the presense of assignment versions of operations,
+routines which may be called in assignment context may create 
+self-referencial structures.  Currently Perl will not free self-referential 
+structures until cycles are C<explicitly> broken.  You may get problems
+when traversing your structures too.
+
+Say, 
+
+  use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
+
+is asking for trouble, since for code C<$obj += $foo> the subroutine
+is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj, 
+\$foo]>.  If using such a subroutine is an important optimization, one
+can overload C<+=> explicitly by a non-"optimized" version, or switch
+to non-optimized version if C<not defined $_[2]> (see 
+L<Calling Conventions for Binary Operations>).
+
+Even if no I<explicit> assignment-variants of operators are present in
+the script, they may be generated by the optimizer.  Say, C<",$obj,"> or
+C<',' . $obj . ','> may be both optimized to
+
+  my $tmp = ',' . $obj;    $tmp .= ',';
+
+=head2 Overloadable Operations
+
+The following symbols can be specified in C<use overload> directive:
+
+=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>.
+
+See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and
+L<"Calling Conventions for Binary Operations">) for details of these
+substitutions.
+
+=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. If the method for "C<!>" is not specified, it can be
+autogenerated using the methods for "C<bool>", or "C<\"\">", or "C<0+>".
+
+=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 "E<lt>" or "E<lt>=E<gt>" 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.
+
+A computer-readable form of the above table is available in the hash
+%overload::ops, with values being space-separated lists of names:
+
+ with_assign	  => '+ - * / % ** << >> x .',
+ assign		  => '+= -= *= /= %= **= <<= >>= x= .=',
+ str_comparison	  => '< <= > >= == !=',
+ '3way_comparison'=> '<=> cmp',
+ num_comparison	  => 'lt le gt ge eq ne',
+ binary		  => '& | ^',
+ unary		  => 'neg ! ~',
+ mutators	  => '++ --',
+ func		  => 'atan2 cos sin exp abs log sqrt',
+ conversion	  => 'bool "" 0+',
+ special	  => 'nomethod fallback ='
+
+=head2 Inheritance and overloading
+
+Inheritance interacts with overloading in two ways.
+
+=over
+
+=item Strings as values of C<use overload> directive
+
+If C<value> in
+
+  use overload key => value;
+
+is a string, it is interpreted as a method name.
+
+=item Overloading of an operation is inherited by derived classes
+
+Any class derived from an overloaded class is also overloaded.  The
+set of overloaded methods is the union of overloaded methods of all
+the ancestors. If some method is overloaded in several ancestor, then
+which description will be used is decided by the usual inheritance
+rules:
+
+If C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
+C<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
+then the subroutine C<D::plus_sub> will be called to implement
+operation C<+> for an object in package C<A>.
+
+=back
+
+Note that since the value of the C<fallback> key is not a subroutine,
+its inheritance is not governed by the above rules.  In the current
+implementation, the value of C<fallback> in the first overloaded
+ancestor is used, but this is accidental and subject to change.
+
+=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
+
+B<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
+yet, see L<"Inheritance and overloading">.
+
+=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<'+='> (or
+C<nomethod>).  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
+
+Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for
+C<$b = $a; ++$a>.
+
+=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<Negation>
+
+C<!> and C<not> can be expressed in terms of boolean conversion, or
+string or numerical conversion.
+
+=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 Losing overloading
+
+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 Overloading constants
+
+For some application Perl parser mangles constants too much.  It is possible
+to hook into this process via overload::constant() and overload::remove_constant()
+functions.
+
+These functions take a hash as an argument.  The recognized keys of this hash
+are
+
+=over 8
+
+=item integer
+
+to overload integer constants,
+
+=item float
+
+to overload floating point constants,
+
+=item binary
+
+to overload octal and hexadecimal constants,
+
+=item q
+
+to overload C<q>-quoted strings, constant pieces of C<qq>- and C<qx>-quoted
+strings and here-documents,
+
+=item qr
+
+to overload constant pieces of regular expressions.
+
+=back
+
+The corresponding values are references to functions which take three arguments:
+the first one is the I<initial> string form of the constant, the second one
+is how Perl interprets this constant, the third one is how the constant is used.  
+Note that the initial string form does not
+contain string delimiters, and has backslashes in backslash-delimiter 
+combinations stripped (thus the value of delimiter is not relevant for
+processing of this string).  The return value of this function is how this 
+constant is going to be interpreted by Perl.  The third argument is undefined
+unless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
+context (comes from strings, regular expressions, and single-quote HERE
+documents), it is C<tr> for arguments of C<tr>/C<y> operators, 
+it is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
+
+Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
+it is expected that overloaded constant strings are equipped with reasonable
+overloaded catenation operator, otherwise absurd results will result.  
+Similarly, negative numbers are considered as negations of positive constants.
+
+Note that it is probably meaningless to call the functions overload::constant()
+and overload::remove_constant() from anywhere but import() and unimport() methods.
+From these methods they may be called as
+
+	sub import {
+	  shift;
+	  return unless @_;
+	  die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+	  overload::constant integer => sub {Math::BigInt->new(shift)};
+	}
+
+B<BUGS> Currently overloaded-ness of constants does not propagate 
+into C<eval '...'>.
+
+=head1 IMPLEMENTATION
+
+What follows is subject to change RSN.
+
+The table of methods for all operations is cached in magic for the
+symbol table hash for the package.  The cache is invalidated during
+processing of C<use overload>, C<no overload>, new function
+definitions, and changes in @ISA. However, this invalidation remains
+unprocessed until the next C<bless>ing into the package. Hence if you
+want to change overloading structure 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. However, the magic which implements overloading is applied to
+the stashes, which are rarely used directly, thus should not slow down
+Perl.)
+
+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 in some package, 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. The only
+size penalty if overload is used in some package is that I<all> the
+packages acquire a magic during the next C<bless>ing into the
+package. This magic is three-words-long for packages without
+overloading, and carries the cache tabel if the package is overloaded.
+
+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 Metaphor clash
+
+One may wonder why the semantic of overloaded C<=> is so counterintuive.
+If it I<looks> counterintuive to you, you are subject to a metaphor 
+clash.  
+
+Here is a Perl object metaphor:
+
+I<  object is a reference to blessed data>
+
+and an arithmetic metaphor:
+
+I<  object is a thing by itself>.
+
+The I<main> problem of overloading C<=> is the fact that these metaphors
+imply different actions on the assignment C<$a = $b> if $a and $b are
+objects.  Perl-think implies that $a becomes a reference to whatever
+$b was referencing.  Arithmetic-think implies that the value of "object"
+$a is changed to become the value of the object $b, preserving the fact
+that $a and $b are separate entities.
+
+The difference is not relevant in the absence of mutators.  After
+a Perl-way assignment an operation which mutates the data referenced by $a
+would change the data referenced by $b too.  Effectively, after 
+C<$a = $b> values of $a and $b become I<indistinguishable>.
+
+On the other hand, anyone who has used algebraic notation knows the 
+expressive power of the arithmetic metaphor.  Overloading works hard
+to enable this metaphor while preserving the Perlian way as far as
+possible.  Since it is not not possible to freely mix two contradicting
+metaphors, overloading allows the arithmetic way to write things I<as
+far as all the mutators are called via overloaded access only>.  The
+way it is done is described in L<Copy Constructor>.
+
+If some mutator methods are directly applied to the overloaded values,
+one may need to I<explicitly unlink> other values which references the 
+same value:
+
+    $a = new Data 23;
+    ...
+    $b = $a;		# $b is "linked" to $a
+    ...
+    $a = $a->clone;	# Unlink $b from $a
+    $a->increment_by(4);
+
+Note that overloaded access makes this transparent:
+
+    $a = new Data 23;
+    $b = $a;		# $b is "linked" to $a
+    $a += 4;		# would unlink $b automagically
+
+However, it would not make
+
+    $a = new Data 23;
+    $a = 4;		# Now $a is a plain 4, not 'Data'
+
+preserve "objectness" of $a.  But Perl I<has> a way to make assignments
+to an object do whatever you want.  It is just not the overload, but
+tie()ing interface (see L<perlfunc/tie>).  Adding a FETCH() method
+which returns the object itself, and STORE() method which changes the 
+value of the object, one can reproduce the arithmetic metaphor in its
+completeness, at least for variables which were tie()d from the start.
+
+(Note that a workaround for a bug may be needed, see L<"BUGS">.)
+
+=head1 Cookbook
+
+Please add examples to what follows!
+
+=head2 Two-face scalars
+
+Put this in F<two_face.pm> in your Perl library directory:
+
+  package two_face;		# Scalars with separate string and
+                                # numeric values.
+  sub new { my $p = shift; bless [@_], $p }
+  use overload '""' => \&str, '0+' => \&num, fallback => 1;
+  sub num {shift->[1]}
+  sub str {shift->[0]}
+
+Use it as follows:
+
+  require two_face;
+  my $seven = new two_face ("vii", 7);
+  printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
+  print "seven contains `i'\n" if $seven =~ /i/;
+
+(The second line creates a scalar which has both a string value, and a
+numeric value.)  This prints:
+
+  seven=vii, seven=7, eight=8
+  seven contains `i'
+
+=head2 Symbolic calculator
+
+Put this in F<symbolic.pm> in your Perl library directory:
+
+  package symbolic;		# Primitive symbolic calculator
+  use overload nomethod => \&wrap;
+
+  sub new { shift; bless ['n', @_] }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+
+This module is very unusual as overloaded modules go: it does not
+provide any usual overloaded operators, instead it provides the L<Last
+Resort> operator C<nomethod>.  In this example the corresponding
+subroutine returns an object which encupsulates operations done over
+the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
+symbolic 3> contains C<['+', 2, ['n', 3]]>.
+
+Here is an example of the script which "calculates" the side of
+circumscribed octagon using the above package:
+
+  require symbolic;
+  my $iter = 1;			# 2**($iter+2) = 8
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  print "OK\n";
+
+The value of $side is
+
+  ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
+	               undef], 1], ['n', 1]]
+
+Note that while we obtained this value using a nice little script,
+there is no simple way to I<use> this value.  In fact this value may
+be inspected in debugger (see L<perldebug>), but ony if
+C<bareStringify> B<O>ption is set, and not via C<p> command.
+
+If one attempts to print this value, then the overloaded operator
+C<""> will be called, which will call C<nomethod> operator.  The
+result of this operator will be stringified again, but this result is
+again of type C<symbolic>, which will lead to an infinite loop.
+
+Add a pretty-printer method to the module F<symbolic.pm>:
+
+  sub pretty {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    $b = 'u' unless defined $b;
+    $a = $a->pretty if ref $a;
+    $b = $b->pretty if ref $b;
+    "[$meth $a $b]";
+  } 
+
+Now one can finish the script by
+
+  print "side = ", $side->pretty, "\n";
+
+The method C<pretty> is doing object-to-string conversion, so it
+is natural to overload the operator C<""> using this method.  However,
+inside such a method it is not necessary to pretty-print the
+I<components> $a and $b of an object.  In the above subroutine
+C<"[$meth $a $b]"> is a catenation of some strings and components $a
+and $b.  If these components use overloading, the catenation operator
+will look for an overloaded operator C<.>, if not present, it will
+look for an overloaded operator C<"">.  Thus it is enough to use
+
+  use overload nomethod => \&wrap, '""' => \&str;
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    $b = 'u' unless defined $b;
+    "[$meth $a $b]";
+  } 
+
+Now one can change the last line of the script to
+
+  print "side = $side\n";
+
+which outputs
+
+  side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
+
+and one can inspect the value in debugger using all the possible
+methods.  
+
+Something is is still amiss: consider the loop variable $cnt of the
+script.  It was a number, not an object.  We cannot make this value of
+type C<symbolic>, since then the loop will not terminate.
+
+Indeed, to terminate the cycle, the $cnt should become false.
+However, the operator C<bool> for checking falsity is overloaded (this
+time via overloaded C<"">), and returns a long string, thus any object
+of type C<symbolic> is true.  To overcome this, we need a way to
+compare an object to 0.  In fact, it is easier to write a numeric
+conversion routine.
+
+Here is the text of F<symbolic.pm> with such a routine added (and
+slightly modifed str()):
+
+  package symbolic;		# Primitive symbolic calculator
+  use overload
+    nomethod => \&wrap, '""' => \&str, '0+' => \&num;
+
+  sub new { shift; bless ['n', @_] }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  } 
+  my %subr = ( n => sub {$_[0]}, 
+	       sqrt => sub {sqrt $_[0]}, 
+	       '-' => sub {shift() - shift()},
+	       '+' => sub {shift() + shift()},
+	       '/' => sub {shift() / shift()},
+	       '*' => sub {shift() * shift()},
+	       '**' => sub {shift() ** shift()},
+	     );
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth} 
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+
+All the work of numeric conversion is done in %subr and num().  Of
+course, %subr is not complete, it contains only operators used in teh
+example below.  Here is the extra-credit question: why do we need an
+explicit recursion in num()?  (Answer is at the end of this section.)
+
+Use this module like this:
+
+  require symbolic;
+  my $iter = new symbolic 2;	# 16-gon
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt) {
+    $cnt = $cnt - 1;		# Mutator `--' not implemented
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  printf "%s=%f\n", $side, $side;
+  printf "pi=%f\n", $side*(2**($iter+2));
+
+It prints (without so many line breaks)
+
+  [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1]
+			  [n 1]] 2]]] 1]
+     [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912
+  pi=3.182598
+
+The above module is very primitive.  It does not implement
+mutator methods (C<++>, C<-=> and so on), does not do deep copying
+(not required without mutators!), and implements only those arithmetic
+operations which are used in the example.
+
+To implement most arithmetic operattions is easy, one should just use
+the tables of operations, and change the code which fills %subr to
+
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    print "defining `$op'\n";
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+
+Due to L<Calling Conventions for Mutators>, we do not need anything
+special to make C<+=> and friends work, except filling C<+=> entry of
+%subr, and defining a copy constructor (needed since Perl has no
+way to know that the implementation of C<'+='> does not mutate
+the argument, compare L<Copy Constructor>).
+
+To implement a copy constructor, add C<'=' => \&cpy> to C<use overload>
+line, and code (this code assumes that mutators change things one level
+deep only, so recursive copying is not needed):
+
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+
+To make C<++> and C<--> work, we need to implement actual mutators, 
+either directly, or in C<nomethod>.  We continue to do things inside
+C<nomethod>, thus add
+
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+
+after the first line of wrap().  This is not a most effective 
+implementation, one may consider
+
+  sub inc { $_[0] = bless ['++', shift, 1]; }
+
+instead.
+
+As a final remark, note that one can fill %subr by
+
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+
+This finishes implementation of a primitive symbolic calculator in 
+50 lines of Perl code.  Since the numeric values of subexpressions 
+are not cached, the calculator is very slow.
+
+Here is the answer for the exercise: In the case of str(), we need no
+explicit recursion since the overloaded C<.>-operator will fall back
+to an existing overloaded operator C<"">.  Overloaded arithmetic
+operators I<do not> fall back to numeric conversion if C<fallback> is
+not explicitly requested.  Thus without an explicit recursion num()
+would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild
+the argument of num().
+
+If you wonder why defaults for conversion are different for str() and
+num(), note how easy it was to write the symbolic calculator.  This
+simplicity is due to an appropriate choice of defaults.  One extra
+note: due to teh explicit recursion num() is more fragile than sym():
+we need to explicitly check for the type of $a and $b.  If componets
+$a and $b happen to be of some related type, this may lead to problems.
+
+=head2 I<Really> symbolic calculator
+
+One may wonder why we call the above calculator symbolic.  The reason
+is that the actual calculation of the value of expression is postponed
+until the value is I<used>.
+
+To see it in action, add a method
+
+  sub STORE { 
+    my $obj = shift; 
+    $#$obj = 1; 
+    @$obj->[0,1] = ('=', shift);
+  }
+
+to the package C<symbolic>.  After this change one can do
+
+  my $a = new symbolic 3;
+  my $b = new symbolic 4;
+  my $c = sqrt($a**2 + $b**2);
+
+and the numeric value of $c becomes 5.  However, after calling
+
+  $a->STORE(12);  $b->STORE(5);
+
+the numeric value of $c becomes 13.  There is no doubt now that the module
+symbolic provides a I<symbolic> calculator indeed.
+
+To hide the rough edges under the hood, provide a tie()d interface to the
+package C<symbolic> (compare with L<Metaphor clash>).  Add methods
+
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }		# Around a bug
+
+(the bug is described in L<"BUGS">).  One can use this new interface as
+
+  tie $a, 'symbolic', 3;
+  tie $b, 'symbolic', 4;
+  $a->nop;  $b->nop;	# Around a bug
+
+  my $c = sqrt($a**2 + $b**2);
+
+Now numeric value of $c is 5.  After C<$a = 12; $b = 5> the numeric value
+of $c becomes 13.  To insulate the user of the module add a method
+
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+
+Now
+
+  my ($a, $b);
+  symbolic->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+
+  $a = 3; $b = 4;
+  printf "c5  %s=%f\n", $c, $c;
+
+  $a = 12; $b = 5;
+  printf "c13  %s=%f\n", $c, $c;
+
+shows that the numeric value of $c follows changes to the values of $a
+and $b.
+
+=head1 AUTHOR
+
+Ilya Zakharevich E<lt>F<ilya@math.mps.ohio-state.edu>E<gt>.
+
+=head1 DIAGNOSTICS
+
+When Perl is run with the B<-Do> switch or its equivalent, overloading
+induces diagnostic messages.
+
+Using the C<m> command of Perl debugger (see L<perldebug>) one can
+deduce which operations are overloaded (and which ancestor triggers
+this overloading). Say, if C<eq> is overloaded, then the method C<(eq>
+is shown by debugger. The method C<()> corresponds to the C<fallback>
+key (in fact a presence of this method shows that this package has
+overloading enabled, and it is what is used by the C<Overloaded>
+function of module C<overload>).
+
+=head1 BUGS
+
+Because it is used for overloading, the per-package hash %OVERLOAD now
+has a special meaning in Perl. The symbol table is filled with names
+looking like line-noise.
+
+For the purpose of inheritance every overloaded package behaves as if
+C<fallback> is present (possibly undefined). This may create
+interesting effects if some package is not overloaded, but inherits
+from two overloaded packages.
+
+Relation between overloading and tie()ing is broken.  Overloading is 
+triggered or not basing on the I<previous> class of tie()d value.
+
+This happens because the presence of overloading is checked too early, 
+before any tie()d access is attempted.  If the FETCH()ed class of the
+tie()d value does not change, a simple workaround is to access the value 
+immediately after tie()ing, so that after this call the I<previous> class
+coincides with the current one.
+
+B<Needed:> a way to fix this without a speed penalty.
+
+Barewords are not covered by overloaded string constants.
+
+This document is confusing.  There are grammos and misleading language
+used in places.  It would seem a total rewrite is needed.
+
+=cut
+
diff --git a/contrib/perl5/lib/perl5db.pl b/contrib/perl5/lib/perl5db.pl
new file mode 100644
index 000000000000..099a49b49f09
--- /dev/null
+++ b/contrib/perl5/lib/perl5db.pl
@@ -0,0 +1,2183 @@
+package DB;
+
+# Debugger for Perl 5.00x; perl5db.pl patch level:
+
+$VERSION = 1.0401;
+$header = "perl5db.pl version $VERSION";
+
+# 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 %sub.  It effectively inserts
+# a &DB'DB(); in front of every place that can have a
+# breakpoint. Instead of a subroutine call it calls &DB::sub with
+# $DB::sub being the called subroutine. It also inserts a BEGIN
+# {require 'perl5db.pl'} before the first line.
+#
+# After each `require'd file is compiled, but before it is executed, a
+# call to DB::postponed($main::{'_<'.$filename}) is emulated. Here the
+# $filename is the expanded name of the `require'd file (as found as
+# value of %INC).
+#
+# Additional services from Perl interpreter:
+#
+# if caller() is called from the package DB, it provides some
+# additional data.
+#
+# The array @{$main::{'_<'.$filename} is the line-by-line contents of
+# $filename.
+#
+# The hash %{'_<'.$filename} contains breakpoints and action (it is
+# keyed by line number), and individual entries are settable (as
+# opposed to the whole hash). Only true/false is important to the
+# interpreter, though the values used by perl5db.pl have the form
+# "$break_condition\0$action". Values are magical in numeric context.
+#
+# The scalar ${'_<'.$filename} contains "_<$filename".
+#
+# Note that no subroutine call is possible until &DB::sub is defined
+# (for subroutines defined outside of the package DB). In fact the same is
+# true if $deep is not defined.
+#
+# $Log:	perldb.pl,v $
+
+#
+# At start reads $rcfile that may set important options.  This file
+# may define a subroutine &afterinit that will be executed after the
+# debugger is initialized.
+#
+# After $rcfile is read reads environment variable PERLDB_OPTS and parses
+# it as a rest of `O ...' line in debugger prompt.
+#
+# The options that can be specified only at startup:
+# [To set in $rcfile, call &parse_options("optionName=new_value").]
+#
+# TTY  - the TTY to use for debugging i/o.
+#
+# noTTY - if set, goes in NonStop mode.  On interrupt if TTY is not set
+# uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
+# Term::Rendezvous.  Current variant is to have the name of TTY in this
+# file.
+#
+# ReadLine - If false, dummy ReadLine is used, so you can debug
+# ReadLine applications.
+#
+# NonStop - if true, no i/o is performed until interrupt.
+#
+# LineInfo - file or pipe to print line number info to.  If it is a
+# pipe, a short "emacs like" message is used.
+#
+# 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"!)
+#
+##################################################################
+# Changelog:
+
+# A lot of things changed after 0.94. First of all, core now informs
+# debugger about entry into XSUBs, overloaded operators, tied operations,
+# BEGIN and END. Handy with `O f=2'.
+
+# This can make debugger a little bit too verbose, please be patient
+# and report your problems promptly.
+
+# Now the option frame has 3 values: 0,1,2.
+
+# Note that if DESTROY returns a reference to the object (or object),
+# the deletion of data may be postponed until the next function call,
+# due to the need to examine the return value.
+
+# Changes: 0.95: `v' command shows versions.
+# Changes: 0.96: `v' command shows version of readline.
+#	primitive completion works (dynamic variables, subs for `b' and `l',
+#		options). Can `p %var'
+#	Better help (`h <' now works). New commands <<, >>, {, {{.
+#	{dump|print}_trace() coded (to be able to do it from <<cmd).
+#	`c sub' documented.
+#	At last enough magic combined to stop after the end of debuggee.
+#	!! should work now (thanks to Emacs bracket matching an extra
+#	`]' in a regexp is caught).
+#	`L', `D' and `A' span files now (as documented).
+#	Breakpoints in `require'd code are possible (used in `R').
+#	Some additional words on internal work of debugger.
+#	`b load filename' implemented.
+#	`b postpone subr' implemented.
+#	now only `q' exits debugger (overwriteable on $inhibit_exit).
+#	When restarting debugger breakpoints/actions persist.
+#     Buglet: When restarting debugger only one breakpoint/action per 
+#		autoloaded function persists.
+# Changes: 0.97: NonStop will not stop in at_exit().
+#	Option AutoTrace implemented.
+#	Trace printed differently if frames are printed too.
+#	new `inhibitExit' option.
+#	printing of a very long statement interruptible.
+# Changes: 0.98: New command `m' for printing possible methods
+#	'l -' is a synonim for `-'.
+#	Cosmetic bugs in printing stack trace.
+#	`frame' & 8 to print "expanded args" in stack trace.
+#	Can list/break in imported subs.
+#	new `maxTraceLen' option.
+#	frame & 4 and frame & 8 granted.
+#	new command `m'
+#	nonstoppable lines do not have `:' near the line number.
+#	`b compile subname' implemented.
+#	Will not use $` any more.
+#	`-' behaves sane now.
+# Changes: 0.99: Completion for `f', `m'.
+#	`m' will remove duplicate names instead of duplicate functions.
+#	`b load' strips trailing whitespace.
+#	completion ignores leading `|'; takes into account current package
+#	when completing a subroutine name (same for `l').
+
+####################################################################
+
+# 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,     
+      $dumpvar::usageOnly,
+      @ARGS,
+      $Carp::CarpLevel,
+      $panic,
+      $second_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!).
+$inhibit_exit = $option{PrintRet} = 1;
+
+@options     = qw(hashDepth arrayDepth DumpDBFiles DumpPackages DumpReused
+		  compactDump veryCompact quote HighBit undefPrint
+		  globPrint PrintRet UsageOnly frame AutoTrace
+		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
+		  recallCommand ShellBang pager tkRunning ornaments
+		  signalLevel warnLevel dieLevel inhibit_exit
+		  ImmediateStop bareStringify);
+
+%optionVars    = (
+		 hashDepth	=> \$dumpvar::hashDepth,
+		 arrayDepth	=> \$dumpvar::arrayDepth,
+		 DumpDBFiles	=> \$dumpvar::dumpDBFiles,
+		 DumpPackages	=> \$dumpvar::dumpPackages,
+		 DumpReused	=> \$dumpvar::dumpReused,
+		 HighBit	=> \$dumpvar::quoteHighBit,
+		 undefPrint	=> \$dumpvar::printUndef,
+		 globPrint	=> \$dumpvar::globPrint,
+		 UsageOnly	=> \$dumpvar::usageOnly,     
+		 bareStringify	=> \$dumpvar::bareStringify,
+		 frame          => \$frame,
+		 AutoTrace      => \$trace,
+		 inhibit_exit   => \$inhibit_exit,
+		 maxTraceLen	=> \$maxtrace,
+		 ImmediateStop	=> \$ImmediateStop,
+);
+
+%optionAction  = (
+		  compactDump	=> \&dumpvar::compactDump,
+		  veryCompact	=> \&dumpvar::veryCompact,
+		  quote		=> \&dumpvar::quote,
+		  TTY		=> \&TTY,
+		  noTTY		=> \&noTTY,
+		  ReadLine	=> \&ReadLine,
+		  NonStop	=> \&NonStop,
+		  LineInfo	=> \&LineInfo,
+		  recallCommand	=> \&recallCommand,
+		  ShellBang	=> \&shellBang,
+		  pager		=> \&pager,
+		  signalLevel	=> \&signalLevel,
+		  warnLevel	=> \&warnLevel,
+		  dieLevel	=> \&dieLevel,
+		  tkRunning	=> \&tkRunning,
+		  ornaments	=> \&ornaments,
+		 );
+
+%optionRequire = (
+		  compactDump	=> 'dumpvar.pl',
+		  veryCompact	=> 'dumpvar.pl',
+		  quote		=> 'dumpvar.pl',
+		 );
+
+# These guys may be defined in $ENV{PERL5DB} :
+$rl = 1 unless defined $rl;
+$warnLevel = 1 unless defined $warnLevel;
+$dieLevel = 1 unless defined $dieLevel;
+$signalLevel = 1 unless defined $signalLevel;
+$pre = [] unless defined $pre;
+$post = [] unless defined $post;
+$pretype = [] unless defined $pretype;
+warnLevel($warnLevel);
+dieLevel($dieLevel);
+signalLevel($signalLevel);
+&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
+&recallCommand("!") unless defined $prc;
+&shellBang("!") unless defined $psh;
+$maxtrace = 400 unless defined $maxtrace;
+
+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');
+  %break_on_load = get_list("PERLDB_ON_LOAD");
+  %postponed = get_list("PERLDB_POSTPONE");
+  my @had_breakpoints= get_list("PERLDB_VISITED");
+  for (0 .. $#had_breakpoints) {
+    my %pf = get_list("PERLDB_FILE_$_");
+    $postponed_file{$had_breakpoints[$_]} = \%pf if %pf;
+  }
+  my %opt = get_list("PERLDB_OPT");
+  my ($opt,$val);
+  while (($opt,$val) = each %opt) {
+    $val =~ s/[\\\']/\\$1/g;
+    parse_options("$opt'$val'");
+  }
+  @INC = get_list("PERLDB_INC");
+  @ini_INC = @INC;
+  $pretype = [get_list("PERLDB_PRETYPE")];
+  $pre = [get_list("PERLDB_PRE")];
+  $post = [get_list("PERLDB_POST")];
+  @typeahead = get_list("PERLDB_TYPEAHEAD", @typeahead);
+}
+
+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 ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
+    $console = "con";
+  } else {
+    $console = "sys\$command";
+  }
+
+  if (($^O eq 'MSWin32') and ($emacs or defined $ENV{EMACS})) {
+    $console = undef;
+  }
+
+  # Around a bug:
+  if (defined $ENV{OS2_SHELL} and ($emacs or $ENV{WINDOWID})) { # 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();
+}
+
+$I_m_init = 1;
+
+############################################################ Subroutines
+
+sub DB {
+    # _After_ the perl program is compiled, $single is set to 1:
+    if ($single and not $second_time++) {
+      if ($runnonstop) {	# Disable until signal
+	for ($i=0; $i <= $#stack; ) {
+	    $stack[$i++] &= ~1;
+	}
+	$single = 0;
+	# return;			# Would not print trace!
+      } elsif ($ImmediateStop) {
+	$ImmediateStop = 0;
+	$signal = 1;
+      }
+    }
+    $runnonstop = 0 if $single or $signal; # Disable it if interactive.
+    &save;
+    ($package, $filename, $line) = caller;
+    $filename_ini = $filename;
+    $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
+      "package $package;";	# this won't let them modify, alas
+    local(*dbline) = $main::{'_<' . $filename};
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	} elsif ($stop) {
+	    $evalarg = "\$DB::signal |= 1 if do {$stop}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    my $was_signal = $signal;
+    if ($trace & 2) {
+      for (my $n = 0; $n <= $#to_watch; $n++) {
+	$evalarg = $to_watch[$n];
+	local $onetimeDump;	# Do not output results
+	my ($val) = &eval;	# Fix context (&eval is doing array)?
+	$val = ( (defined $val) ? "'$val'" : 'undef' );
+	if ($val ne $old_watch[$n]) {
+	  $signal = 1;
+	  print $OUT <<EOP;
+Watchpoint $n:\t$to_watch[$n] changed:
+    old value:\t$old_watch[$n]
+    new value:\t$val
+EOP
+	  $old_watch[$n] = $val;
+	}
+      }
+    }
+    if ($trace & 4) {		# User-installed watch
+      return if watchfunction($package, $filename, $line) 
+	and not $single and not $was_signal and not ($trace & ~4);
+    }
+    $was_signal = $signal;
+    $signal = 0;
+    if ($single || ($trace & 1) || $was_signal) {
+	$term || &setterm;
+	if ($emacs) {
+	    $position = "\032\032$filename:$line:0\n";
+	    print $LINEINFO $position;
+	} elsif ($package eq 'DB::fake') {
+	  print_help(<<EOP);
+Debugged program terminated.  Use B<q> to quit or B<R> to restart,
+  use B<O> I<inhibit_exit> to avoid stopping after program termination,
+  B<h q>, B<h R> or B<h O> to get additional info.  
+EOP
+	  $package = 'main';
+	  $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+	    "package $package;";	# this won't let them modify, alas
+	} else {
+	    $sub =~ s/\'/::/;
+	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
+	    $prefix .= "$sub($filename:";
+	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
+	    if (length($prefix) > 30) {
+	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+		$prefix = "";
+		$infix = ":\t";
+	    } else {
+		$infix = "):\t";
+		$position = "$prefix$line$infix$dbline[$line]$after";
+	    }
+	    if ($frame) {
+		print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
+	    } else {
+		print $LINEINFO $position;
+	    }
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
+		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+		last if $signal;
+		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
+		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
+		$position .= $incr_pos;
+		if ($frame) {
+		    print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
+		} else {
+		    print $LINEINFO $incr_pos;
+		}
+	    }
+	}
+    }
+    $evalarg = $action, &eval if $action;
+    if ($single || $was_signal) {
+	local $level = $level + 1;
+	foreach $evalarg (@$pre) {
+	  &eval;
+	}
+	print $OUT $#stack . " levels deep in subroutine calls!\n"
+	  if $single & 4;
+	$start = $line;
+	$incr = -1;		# for backward motion.
+	@typeahead = @$pretype, @typeahead;
+      CMD:
+	while (($term || &setterm),
+	       ($term_pid == $$ or &resetterm),
+	       defined ($cmd=&readline("  DB" . ('<' x $level) .
+				       ($#hist+1) . ('>' x $level) .
+				       " "))) {
+		$single = 0;
+		$signal = 0;
+		$cmd =~ s/\\$/\n/ && do {
+		    $cmd .= &readline("  cont: ");
+		    redo CMD;
+		};
+		$cmd =~ /^$/ && ($cmd = $laststep);
+		push(@hist,$cmd) if length($cmd) > 1;
+	      PIPE: {
+		    ($i) = split(/\s+/,$cmd);
+		    eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
+		    $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
+		    $cmd =~ /^h$/ && do {
+			print_help($help);
+			next CMD; };
+		    $cmd =~ /^h\s+h$/ && do {
+			print_help($summary);
+			next CMD; };
+		    $cmd =~ /^h\s+(\S)$/ && do {
+			my $asked = "\Q$1";
+			if ($help =~ /^(?:[IB]<)$asked/m) {
+			  while ($help =~ /^((?:[IB]<)$asked([\s\S]*?)\n)(?!\s)/mg) {
+			    print_help($1);
+			  }
+			} else {
+			    print_help("B<$asked> is not a debugger command.\n");
+			}
+			next CMD; };
+		    $cmd =~ /^t$/ && do {
+			($trace & 1) ? ($trace &= ~1) : ($trace |= 1);
+			print $OUT "Trace = " .
+			    (($trace & 1) ? "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 =~ /^v$/ && do {
+			list_versions(); next CMD};
+		    $cmd =~ s/^X\b/V $package/;
+		    $cmd =~ /^V$/ && do {
+			$cmd = "V $package"; };
+		    $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+			local ($savout) = select($OUT);
+			$packname = $1;
+			@vars = split(' ',$2);
+			do 'dumpvar.pl' unless defined &main::dumpvar;
+			if (defined &main::dumpvar) {
+			    local $frame = 0;
+			    local $doret = -2;
+			    &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 = 'dump'; };
+		    $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
+			methods($1); next CMD};
+		    $cmd =~ s/^m\b/ / && do { # So this will be evaled
+			$onetimeDump = 'methods'; };
+		    $cmd =~ /^f\b\s*(.*)/ && do {
+			$file = $1;
+			$file =~ s/\s+$//;
+			if (!$file) {
+			    print $OUT "The old f command is now the r command.\n";
+			    print $OUT "The new f command switches filenames.\n";
+			    next CMD;
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
+					      $try = substr($try,2);
+					      print $OUT "Choosing $try matching `$file':\n";
+					      $file = $try;
+					  }}
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    print $OUT "No file matching `$file' is loaded.\n";
+			    next CMD;
+			} elsif ($file ne $filename) {
+			    *dbline = $main::{'_<' . $file};
+			    $max = $#dbline;
+			    $filename = $file;
+			    $start = 1;
+			    $cmd = "l";
+			  } else {
+			    print $OUT "Already in $file.\n";
+			    next CMD;
+			  }
+		      };
+		    $cmd =~ s/^l\s+-\s*$/-/;
+		    $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*)/ && do {
+			$subname = $1;
+			$subname =~ s/\'/::/;
+			$subname = $package."::".$subname 
+			  unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			@pieces = split(/:/,find_sub($subname));
+			$subrange = pop @pieces;
+			$file = join(':', @pieces);
+			if ($file ne $filename) {
+			    *dbline = $main::{'_<' . $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 {
+			$incr = -1;		# for backward motion.
+			$start = $line;
+			$filename = $filename_ini;
+			*dbline = $main::{'_<' . $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 {
+			$start -= $incr + $window + 1;
+			$start = 1 if $start <= 0;
+			$incr = $window - 1;
+			$cmd = 'l ' . ($start) . '+'; };
+		    $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;
+			$incr = $end - $i;
+			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) 
+				  ?  '==>' 
+				    : ($dbline[$i]+0 ? ':' : ' ') ;
+				$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";
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/^[^\0]+//;
+				if ($dbline{$i} =~ s/^\0?$//) {
+				    delete $dbline{$i};
+				}
+			    }
+			}
+		      }
+		      undef %postponed;
+		      undef %postponed_file;
+		      undef %break_on_load;
+		      undef %had_breakpoints;
+		      next CMD; };
+		    $cmd =~ /^L$/ && do {
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
+			for ($i = 1; $i <= $max; $i++) {
+			    if (defined $dbline{$i}) {
+			        print "$file:\n" unless $was++;
+				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;
+			    }
+			}
+		      }
+		      if (%postponed) {
+			print $OUT "Postponed breakpoints in subroutines:\n";
+			my $subname;
+			for $subname (keys %postponed) {
+			  print $OUT " $subname\t$postponed{$subname}\n";
+			  last if $signal;
+			}
+		      }
+		      my @have = map { # Combined keys
+			keys %{$postponed_file{$_}}
+		      } keys %postponed_file;
+		      if (@have) {
+			print $OUT "Postponed breakpoints in files:\n";
+			my ($file, $line);
+			for $file (keys %postponed_file) {
+			  my $db = $postponed_file{$file};
+			  print $OUT " $file:\n";
+			  for $line (sort {$a <=> $b} keys %$db) {
+				print $OUT "  $line:\n";
+				my ($stop,$action) = split(/\0/, $$db{$line});
+				print $OUT "    break if (", $stop, ")\n"
+				  if $stop;
+				print $OUT "    action:  ", $action, "\n"
+				  if $action;
+				last if $signal;
+			  }
+			  last if $signal;
+			}
+		      }
+		      if (%break_on_load) {
+			print $OUT "Breakpoints on load:\n";
+			my $file;
+			for $file (keys %break_on_load) {
+			  print $OUT " $file\n";
+			  last if $signal;
+			}
+		      }
+		      if ($trace & 2) {
+			print $OUT "Watch-expressions:\n";
+			my $expr;
+			for $expr (@to_watch) {
+			  print $OUT " $expr\n";
+			  last if $signal;
+			}
+		      }
+		      next CMD; };
+		    $cmd =~ /^b\b\s*load\b\s*(.*)/ && do {
+			my $file = $1; $file =~ s/\s+$//;
+			{
+			  $break_on_load{$file} = 1;
+			  $break_on_load{$::INC{$file}} = 1 if $::INC{$file};
+			  $file .= '.pm', redo unless $file =~ /\./;
+			}
+			$had_breakpoints{$file} = 1;
+			print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
+			next CMD; };
+		    $cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+			my $cond = $3 || '1';
+			my ($subname, $break) = ($2, $1 eq 'postpone');
+			$subname =~ s/\'/::/;
+			$subname = "${'package'}::" . $subname
+			  unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			$postponed{$subname} = $break 
+			  ? "break +0 if $cond" : "compile";
+			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) = (find_sub($subname) =~ /^(.*):(.*)$/);
+			$i += 0;
+			if ($i) {
+			    $filename = $file;
+			    *dbline = $main::{'_<' . $filename};
+			    $had_breakpoints{$filename} = 1;
+			    $max = $#dbline;
+			    ++$i while $dbline[$i] == 0 && $i < $max;
+			    $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 {
+			    $had_breakpoints{$filename} = 1;
+			    $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 {
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/\0[^\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 { # \<\< for CPerl sake: not HERE
+			push @$pre, action($1);
+			next CMD; };
+		    $cmd =~ /^>>\s*(.*)/ && do {
+			push @$post, action($1);
+			next CMD; };
+		    $cmd =~ /^<\s*(.*)/ && do {
+		        $pre = [], next CMD unless $1;
+			$pre = [action($1)];
+			next CMD; };
+		    $cmd =~ /^>\s*(.*)/ && do {
+		        $post = [], next CMD unless $1;
+			$post = [action($1)];
+			next CMD; };
+		    $cmd =~ /^\{\{\s*(.*)/ && do {
+			push @$pretype, $1;
+			next CMD; };
+		    $cmd =~ /^\{\s*(.*)/ && do {
+		        $pretype = [], next CMD unless $1;
+			$pretype = [$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 {
+		        end_report(), next CMD if $finished and $level <= 1;
+			$single = 2;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^s$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
+			$single = 1;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
+			$subname = $i = $1;
+			if ($i =~ /\D/) { # subroutine name
+			    $subname = $package."::".$subname 
+			        unless $subname =~ /::/;
+			    ($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
+			    $i += 0;
+			    if ($i) {
+			        $filename = $file;
+				*dbline = $main::{'_<' . $filename};
+				$had_breakpoints{$filename}++;
+				$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 {
+		        end_report(), next CMD if $finished and $level <= 1;
+			$stack[$#stack] |= 1;
+			$doret = $option{PrintRet} ? $#stack - 1 : -2;
+			last CMD; };
+		    $cmd =~ /^R$/ && do {
+		        print $OUT "Warning: some settings and command-line options may be lost!\n";
+			my (@script, @flags, $cl);
+			push @flags, '-w' if $ini_warn;
+			# Put all the old includes at the start to get
+			# the same debugger.
+			for (@ini_INC) {
+			  push @flags, '-I', $_;
+			}
+			# Arrange for setting the old INC:
+			set_list("PERLDB_INC", @ini_INC);
+			if ($0 eq '-e') {
+			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
+			    chomp ($cl =  $ {'::_<-e'}[$_]);
+			    push @script, '-e', $cl;
+			  }
+			} else {
+			  @script = $0;
+			}
+			set_list("PERLDB_HIST", 
+				 $term->Features->{getHistory} 
+				 ? $term->GetHistory : @hist);
+			my @had_breakpoints = keys %had_breakpoints;
+			set_list("PERLDB_VISITED", @had_breakpoints);
+			set_list("PERLDB_OPT", %option);
+			set_list("PERLDB_ON_LOAD", %break_on_load);
+			my @hard;
+			for (0 .. $#had_breakpoints) {
+			  my $file = $had_breakpoints[$_];
+			  *dbline = $main::{'_<' . $file};
+			  next unless %dbline or $postponed_file{$file};
+			  (push @hard, $file), next 
+			    if $file =~ /^\(eval \d+\)$/;
+			  my @add;
+			  @add = %{$postponed_file{$file}}
+			    if $postponed_file{$file};
+			  set_list("PERLDB_FILE_$_", %dbline, @add);
+			}
+			for (@hard) { # Yes, really-really...
+			  # Find the subroutines in this eval
+			  *dbline = $main::{'_<' . $_};
+			  my ($quoted, $sub, %subs, $line) = quotemeta $_;
+			  for $sub (keys %sub) {
+			    next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
+			    $subs{$sub} = [$1, $2];
+			  }
+			  unless (%subs) {
+			    print $OUT
+			      "No subroutines in $_, ignoring breakpoints.\n";
+			    next;
+			  }
+			LINES: for $line (keys %dbline) {
+			    # One breakpoint per sub only:
+			    my ($offset, $sub, $found);
+			  SUBS: for $sub (keys %subs) {
+			      if ($subs{$sub}->[1] >= $line # Not after the subroutine
+				  and (not defined $offset # Not caught
+				       or $offset < 0 )) { # or badly caught
+				$found = $sub;
+				$offset = $line - $subs{$sub}->[0];
+				$offset = "+$offset", last SUBS if $offset >= 0;
+			      }
+			    }
+			    if (defined $offset) {
+			      $postponed{$found} =
+				"break $offset if $dbline{$line}";
+			    } else {
+			      print $OUT "Breakpoint in $_:$line ignored: after all the subroutines.\n";
+			    }
+			  }
+			}
+			set_list("PERLDB_POSTPONE", %postponed);
+			set_list("PERLDB_PRETYPE", @$pretype);
+			set_list("PERLDB_PRE", @$pre);
+			set_list("PERLDB_POST", @$post);
+			set_list("PERLDB_TYPEAHEAD", @typeahead);
+			$ENV{PERLDB_RESTART} = 1;
+			#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 {
+			print_trace($OUT, 1); # skip DB
+			next CMD; };
+		    $cmd =~ /^W\s*$/ && do {
+			$trace &= ~2;
+			@to_watch = @old_watch = ();
+			next CMD; };
+		    $cmd =~ /^W\b\s*(.*)/s && do {
+			push @to_watch, $1;
+			$evalarg = $1;
+			my ($val) = &eval;
+			$val = (defined $val) ? "'$val'" : 'undef' ;
+			push @old_watch, $val;
+			$trace |= 2;
+			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;
+			$incr = -1;
+			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;
+			$incr = -1;
+			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];
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
+			&system($1);
+			next CMD; };
+		    $cmd =~ /^$rc([^$rc].*)$/ && do {
+			$pat = "^$1";
+			pop(@hist) if length($cmd) > 1;
+			for ($i = $#hist; $i; --$i) {
+			    last if $hist[$i] =~ /$pat/;
+			}
+			if (!$i) {
+			    print $OUT "No such command!\n\n";
+			    next CMD;
+			}
+			$cmd = $hist[$i];
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$/ && do {
+			&system($ENV{SHELL}||"/bin/sh");
+			next CMD; };
+		    $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
+			&system($ENV{SHELL}||"/bin/sh","-c",$1);
+			next CMD; };
+		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
+			$end = $2?($#hist-$2):0;
+			$hist = 0 if $hist < 0;
+			for ($i=$#hist; $i>$end; $i--) {
+			    print $OUT "$i: ",$hist[$i],"\n"
+			      unless $hist[$i] =~ /^.?$/;
+			};
+			next CMD; };
+		    $cmd =~ 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:
+	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
+	    if ($onetimeDump) {
+		$onetimeDump = undef;
+	    } elsif ($term_pid == $$) {
+		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:
+	$exiting = 1 unless defined $cmd;
+	foreach $evalarg (@$post) {
+	  &eval;
+	}
+    }				# if ($single || $signal)
+    ($@, $!, $^E, $,, $/, $\, $^W) = @saved;
+    ();
+}
+
+# The following code may be executed now:
+# BEGIN {warn 4}
+
+sub sub {
+    my ($al, $ret, @ret) = "";
+    if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
+	$al = " for $$sub";
+    }
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    ($frame & 4 
+     ? ( (print $LINEINFO ' ' x ($#stack - 1), "in  "), 
+	 # Why -1? But it works! :-(
+	 print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+     : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
+    if (wantarray) {
+	@ret = &$sub;
+	$single |= pop(@stack);
+	($frame & 4 
+	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+	     print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
+	if ($doret eq $#stack or $frame & 16) {
+            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
+	    print $fh ' ' x $#stack if $frame & 16;
+	    print $fh "list context return from $sub:\n"; 
+	    dumpit($fh, \@ret );
+	    $doret = -2;
+	}
+	@ret;
+    } else {
+        if (defined wantarray) {
+	    $ret = &$sub;
+        } else {
+            &$sub; undef $ret;
+        };
+	$single |= pop(@stack);
+	($frame & 4 
+	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+	      print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
+	if ($doret eq $#stack or $frame & 16 and defined wantarray) {
+            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
+	    print $fh (' ' x $#stack) if $frame & 16;
+	    print $fh (defined wantarray 
+			 ? "scalar context return from $sub: " 
+			 : "void context return from $sub\n");
+	    dumpit( $fh, $ret ) if defined wantarray;
+	    $doret = -2;
+	}
+	$ret;
+    }
+}
+
+sub save {
+    @saved = ($@, $!, $^E, $,, $/, $\, $^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 = $@;
+    local $saved[0];		# Preserve the old value of $@
+    eval { &DB::save };
+    if ($at) {
+	print $OUT $at;
+    } elsif ($onetimeDump eq 'dump') {
+	dumpit($OUT, \@res);
+    } elsif ($onetimeDump eq 'methods') {
+	methods($res[0]);
+    }
+    @res;
+}
+
+sub postponed_sub {
+  my $subname = shift;
+  if ($postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s//) {
+    my $offset = $1 || 0;
+    # Filename below can contain ':'
+    my ($file,$i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
+    if ($i) {
+      $i += $offset;
+      local *dbline = $main::{'_<' . $file};
+      local $^W = 0;		# != 0 is magical below
+      $had_breakpoints{$file}++;
+      my $max = $#dbline;
+      ++$i until $dbline[$i] != 0 or $i >= $max;
+      $dbline{$i} = delete $postponed{$subname};
+    } else {
+      print $OUT "Subroutine $subname not found.\n";
+    }
+    return;
+  }
+  elsif ($postponed{$subname} eq 'compile') { $signal = 1 }
+  #print $OUT "In postponed_sub for `$subname'.\n";
+}
+
+sub postponed {
+  if ($ImmediateStop) {
+    $ImmediateStop = 0;
+    $signal = 1;
+  }
+  return &postponed_sub
+    unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
+  # Cannot be done before the file is compiled
+  local *dbline = shift;
+  my $filename = $dbline;
+  $filename =~ s/^_<//;
+  $signal = 1, print $OUT "'$filename' loaded...\n"
+    if $break_on_load{$filename};
+  print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
+  return unless $postponed_file{$filename};
+  $had_breakpoints{$filename}++;
+  #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
+  my $key;
+  for $key (keys %{$postponed_file{$filename}}) {
+    $dbline{$key} = $ {$postponed_file{$filename}}{$key};
+  }
+  delete $postponed_file{$filename};
+}
+
+sub dumpit {
+    local ($savout) = select(shift);
+    my $osingle = $single;
+    my $otrace = $trace;
+    $single = $trace = 0;
+    local $frame = 0;
+    local $doret = -2;
+    unless (defined &main::dumpValue) {
+	do 'dumpvar.pl';
+    }
+    if (defined &main::dumpValue) {
+	&main::dumpValue(shift);
+    } else {
+	print $OUT "dumpvar.pl not available.\n";
+    }
+    $single = $osingle;
+    $trace = $otrace;
+    select ($savout);    
+}
+
+# Tied method do not create a context, so may get wrong message:
+
+sub print_trace {
+  my $fh = shift;
+  my @sub = dump_trace($_[0] + 1, $_[1]);
+  my $short = $_[2];		# Print short report, next one for sub name
+  my $s;
+  for ($i=0; $i <= $#sub; $i++) {
+    last if $signal;
+    local $" = ', ';
+    my $args = defined $sub[$i]{args} 
+    ? "(@{ $sub[$i]{args} })"
+      : '' ;
+    $args = (substr $args, 0, $maxtrace - 3) . '...' 
+      if length $args > $maxtrace;
+    my $file = $sub[$i]{file};
+    $file = $file eq '-e' ? $file : "file `$file'" unless $short;
+    $s = $sub[$i]{sub};
+    $s = (substr $s, 0, $maxtrace - 3) . '...' if length $s > $maxtrace;    
+    if ($short) {
+      my $sub = @_ >= 4 ? $_[3] : $s;
+      print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
+    } else {
+      print $fh "$sub[$i]{context} = $s$args" .
+	" called from $file" . 
+	  " line $sub[$i]{line}\n";
+    }
+  }
+}
+
+sub dump_trace {
+  my $skip = shift;
+  my $count = shift || 1e9;
+  $skip++;
+  $count += $skip;
+  my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context);
+  my $nothard = not $frame & 8;
+  local $frame = 0;		# Do not want to trace this.
+  my $otrace = $trace;
+  $trace = 0;
+  for ($i = $skip; 
+       $i < $count and ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); 
+       $i++) {
+    @a = ();
+    for $arg (@args) {
+      my $type;
+      if (not defined $arg) {
+	push @a, "undef";
+      } elsif ($nothard and tied $arg) {
+	push @a, "tied";
+      } elsif ($nothard and $type = ref $arg) {
+	push @a, "ref($type)";
+      } else {
+	local $_ = "$arg";	# Safe to stringify now - should not call f().
+	s/([\'\\])/\\$1/g;
+	s/(.*)/'$1'/s
+	  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+	s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+	s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	push(@a, $_);
+      }
+    }
+    $context = $context ? '@' : (defined $context ? "\$" : '.');
+    $args = $h ? [@a] : undef;
+    $e =~ s/\n\s*\;\s*\Z// if $e;
+    $e =~ s/([\\\'])/\\$1/g if $e;
+    if ($r) {
+      $sub = "require '$e'";
+    } elsif (defined $r) {
+      $sub = "eval '$e'";
+    } elsif ($sub eq '(eval)') {
+      $sub = "eval {...}";
+    }
+    push(@sub, {context => $context, sub => $sub, args => $args,
+		file => $file, line => $line});
+    last if $signal;
+  }
+  $trace = $otrace;
+  @sub;
+}
+
+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,">&STDOUT") || &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;
+    local $doret = -2;
+    local @stack = @stack;		# Prevent growth by failing `use'.
+    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;
+
+	$rl_attribs = $term->Attribs;
+	$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}' 
+	  if defined $rl_attribs->{basic_word_break_characters} 
+	    and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
+	$rl_attribs->{special_prefixes} = '$@&%';
+	$rl_attribs->{completer_word_break_characters} .= '$@&%';
+	$rl_attribs->{completion_function} = \&db_complete; 
+    }
+    $LINEINFO = $OUT unless defined $LINEINFO;
+    $lineinfo = $console unless defined $lineinfo;
+    $term->MinLine(2);
+    if ($term->Features->{setHistory} and "@hist" ne "?") {
+      $term->SetHistory(@hist);
+    }
+    ornaments($ornaments) if defined $ornaments;
+    $term_pid = $$;
+}
+
+sub resetterm {			# We forked, so we need a different TTY
+    $term_pid = $$;
+    if (defined &get_fork_TTY) {
+      &get_fork_TTY;
+    } elsif (not defined $fork_TTY 
+	     and defined $ENV{TERM} and $ENV{TERM} eq 'xterm' 
+	     and defined $ENV{WINDOWID} and defined $ENV{DISPLAY}) { 
+        # Possibly _inside_ XTERM
+        open XT, q[3>&1 xterm -title 'Forked Perl debugger' -e sh -c 'tty 1>&3;\
+ sleep 10000000' |];
+        $fork_TTY = <XT>;
+        chomp $fork_TTY;
+    }
+    if (defined $fork_TTY) {
+      TTY($fork_TTY);
+      undef $fork_TTY;
+    } else {
+      print_help(<<EOP);
+I<#########> Forked, but do not know how to change a B<TTY>. I<#########>
+  Define B<\$DB::fork_TTY> 
+       - or a function B<DB::get_fork_TTY()> which will set B<\$DB::fork_TTY>.
+  The value of B<\$DB::fork_TTY> should be the name of I<TTY> to use.
+  On I<UNIX>-like systems one can get the name of a I<TTY> for the given window
+  by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
+EOP
+    }
+}
+
+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;
+  local $doret = -2;
+  $term->readline(@_);
+}
+
+sub dump_option {
+    my ($opt, $val)= @_;
+    $val = option_val($opt,'N/A');
+    $val =~ s/([\\\'])/\\$1/g;
+    printf $OUT "%20s = '%s'\n", $opt, $val;
+}
+
+sub option_val {
+    my ($opt, $default)= @_;
+    my $val;
+    if (defined $optionVars{$opt}
+	and defined $ {$optionVars{$opt}}) {
+	$val = $ {$optionVars{$opt}};
+    } elsif (defined $optionAction{$opt}
+	and defined &{$optionAction{$opt}}) {
+	$val = &{$optionAction{$opt}}();
+    } elsif (defined $optionAction{$opt}
+	     and not defined $option{$opt}
+	     or defined $optionVars{$opt}
+	     and not defined $ {$optionVars{$opt}}) {
+	$val = $default;
+    } else {
+	$val = $option{$opt};
+    }
+    $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; local \$doret = -2; 
+	      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',$1)/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;
+    return;			# Put nothing on the stack - malloc/free land!
+}
+
+sub warn {
+    my($msg)= join("",@_);
+    $msg .= ": $!\n" unless $msg =~ /\n$/;
+    print $OUT $msg;
+}
+
+sub TTY {
+    if (@_ and $term and $term->Features->{newTTY}) {
+      my ($in, $out) = shift;
+      if ($in =~ /,/) {
+	($in, $out) = split /,/, $in, 2;
+      } else {
+	$out = $in;
+      }
+      open IN, $in or die "cannot open `$in' for read: $!";
+      open OUT, ">$out" or die "cannot open `$out' for write: $!";
+      $term->newTTY(\*IN, \*OUT);
+      $IN	= \*IN;
+      $OUT	= \*OUT;
+      return $tty = $in;
+    } elsif ($term and @_) {
+	&warn("Too late to set TTY, enabled on next `R'!\n");
+    } 
+    $tty = shift if @_;
+    $tty or $console;
+}
+
+sub noTTY {
+    if ($term) {
+	&warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
+    }
+    $notty = shift if @_;
+    $notty;
+}
+
+sub ReadLine {
+    if ($term) {
+	&warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
+    }
+    $rl = shift if @_;
+    $rl;
+}
+
+sub tkRunning {
+    if ($ {$term->Features}{tkRunning}) {
+        return $term->tkRunning(@_);
+    } else {
+	print $OUT "tkRunning not supported by current ReadLine package.\n";
+	0;
+    }
+}
+
+sub NonStop {
+    if ($term) {
+	&warn("Too late to set up NonStop mode, enabled on next `R'!\n") if @_;
+    }
+    $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 ornaments {
+  if (defined $term) {
+    local ($warnLevel,$dieLevel) = (0, 1);
+    return '' unless $term->Features->{ornaments};
+    eval { $term->ornaments(@_) } || '';
+  } else {
+    $ornaments = shift;
+  }
+}
+
+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 list_versions {
+  my %version;
+  my $file;
+  for (keys %INC) {
+    $file = $_;
+    s,\.p[lm]$,,i ;
+    s,/,::,g ;
+    s/^perl5db$/DB/;
+    s/^Term::ReadLine::readline$/readline/;
+    if (defined $ { $_ . '::VERSION' }) {
+      $version{$file} = "$ { $_ . '::VERSION' } from ";
+    } 
+    $version{$file} .= $INC{$file};
+  }
+  do 'dumpvar.pl' unless defined &main::dumpValue;
+  if (defined &main::dumpValue) {
+    local $frame = 0;
+    &main::dumpValue(\%version);
+  } else {
+    print $OUT "dumpvar.pl not available.\n";
+  }
+}
+
+sub sethelp {
+    $help = "
+B<T>		Stack trace.
+B<s> [I<expr>]	Single step [in I<expr>].
+B<n> [I<expr>]	Next, steps over subroutine calls [in I<expr>].
+<B<CR>>		Repeat last B<n> or B<s> command.
+B<r>		Return from current subroutine.
+B<c> [I<line>|I<sub>]	Continue; optionally inserts a one-time-only breakpoint
+		at the specified position.
+B<l> I<min>B<+>I<incr>	List I<incr>+1 lines starting at I<min>.
+B<l> I<min>B<->I<max>	List lines I<min> through I<max>.
+B<l> I<line>		List single I<line>.
+B<l> I<subname>	List first window of lines from subroutine.
+B<l>		List next window of lines.
+B<->		List previous window of lines.
+B<w> [I<line>]	List window around I<line>.
+B<.>		Return to the executed line.
+B<f> I<filename>	Switch to viewing I<filename>. Must be loaded.
+B</>I<pattern>B</>	Search forwards for I<pattern>; final B</> is optional.
+B<?>I<pattern>B<?>	Search backwards for I<pattern>; final B<?> is optional.
+B<L>		List all breakpoints and actions.
+B<S> [[B<!>]I<pattern>]	List subroutine names [not] matching I<pattern>.
+B<t>		Toggle trace mode.
+B<t> I<expr>		Trace through execution of I<expr>.
+B<b> [I<line>] [I<condition>]
+		Set breakpoint; I<line> defaults to the current execution line;
+		I<condition> breaks if it evaluates to true, defaults to '1'.
+B<b> I<subname> [I<condition>]
+		Set breakpoint at first line of subroutine.
+B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
+B<b> B<postpone> I<subname> [I<condition>]
+		Set breakpoint at first line of subroutine after 
+		it is compiled.
+B<b> B<compile> I<subname>
+		Stop after the subroutine is compiled.
+B<d> [I<line>]	Delete the breakpoint for I<line>.
+B<D>		Delete all breakpoints.
+B<a> [I<line>] I<command>
+		Set an action to be done before the I<line> is executed.
+		Sequence is: check for breakpoint/watchpoint, print line
+		if necessary, do action, prompt user if necessary,
+		execute expression.
+B<A>		Delete all actions.
+B<W> I<expr>		Add a global watch-expression.
+B<W>		Delete all watch-expressions.
+B<V> [I<pkg> [I<vars>]]	List some (default all) variables in package (default current).
+		Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
+B<X> [I<vars>]	Same as \"B<V> I<currentpackage> [I<vars>]\".
+B<x> I<expr>		Evals expression in array context, dumps the result.
+B<m> I<expr>		Evals expression in array context, prints methods callable
+		on the first element of the result.
+B<m> I<class>		Prints methods callable via the given class.
+B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
+		Set or query values of options.  I<val> defaults to 1.  I<opt> can
+		be abbreviated.  Several options can be listed.
+    I<recallCommand>, I<ShellBang>:	chars used to recall command or spawn shell;
+    I<pager>:			program for output of \"|cmd\";
+    I<tkRunning>:			run Tk while prompting (with ReadLine);
+    I<signalLevel> I<warnLevel> I<dieLevel>:	level of verbosity;
+    I<inhibit_exit>		Allows stepping off the end of the script.
+    I<ImmediateStop>		Debugger should stop as early as possible.
+  The following options affect what happens with B<V>, B<X>, and B<x> commands:
+    I<arrayDepth>, I<hashDepth>:	print only first N elements ('' for all);
+    I<compactDump>, I<veryCompact>:	change style of array and hash dump;
+    I<globPrint>:			whether to print contents of globs;
+    I<DumpDBFiles>:		dump arrays holding debugged files;
+    I<DumpPackages>:		dump symbol tables of packages;
+    I<DumpReused>:		dump contents of \"reused\" addresses;
+    I<quote>, I<HighBit>, I<undefPrint>:	change style of string dump;
+    I<bareStringify>:		Do not print the overload-stringified value;
+  Option I<PrintRet> affects printing of return value after B<r> command,
+         I<frame>    affects printing messages on entry and exit from subroutines.
+         I<AutoTrace> affects printing messages on every possible breaking point.
+	 I<maxTraceLen> gives maximal length of evals/args listed in stack trace.
+	 I<ornaments> affects screen appearance of the command line.
+		During startup options are initialized from \$ENV{PERLDB_OPTS}.
+		You can put additional initialization options I<TTY>, I<noTTY>,
+		I<ReadLine>, and I<NonStop> there (or use `B<R>' after you set them).
+B<<> I<expr>		Define Perl command to run before each prompt.
+B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
+B<>> I<expr>		Define Perl command to run after each prompt.
+B<>>B<>> I<expr>	Add to the list of Perl commands to run after each prompt.
+B<{> I<db_command>	Define debugger command to run before each prompt.
+B<{{> I<db_command>	Add to the list of debugger commands to run before each prompt.
+B<$prc> I<number>	Redo a previous command (default previous command).
+B<$prc> I<-number>	Redo number'th-to-last command.
+B<$prc> I<pattern>	Redo last command that started with I<pattern>.
+		See 'B<O> I<recallCommand>' too.
+B<$psh$psh> I<cmd>  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+  . ( $rc eq $sh ? "" : "
+B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+		See 'B<O> I<shellBang>' too.
+B<H> I<-number>	Display last number commands (default all).
+B<p> I<expr>		Same as \"I<print {DB::OUT} expr>\" in current package.
+B<|>I<dbcmd>		Run debugger command, piping DB::OUT to current pager.
+B<||>I<dbcmd>		Same as B<|>I<dbcmd> but DB::OUT is temporarilly select()ed as well.
+B<\=> [I<alias> I<value>]	Define a command alias, or list current aliases.
+I<command>		Execute as a perl statement in current package.
+B<v>		Show versions of loaded modules.
+B<R>		Pure-man-restart of debugger, some of debugger state
+		and command-line options may be lost.
+		Currently the following setting are preserved: 
+		history, breakpoints and actions, debugger B<O>ptions 
+		and the following command-line options: I<-w>, I<-I>, I<-e>.
+B<h> [I<db_command>]	Get help [on a specific debugger command], enter B<|h> to page.
+B<h h>		Summary of debugger commands.
+B<q> or B<^D>		Quit. Set B<\$DB::finished = 0> to debug global destruction.
+
+";
+    $summary = <<"END_SUM";
+I<List/search source lines:>               I<Control script execution:>
+  B<l> [I<ln>|I<sub>]  List source code            B<T>           Stack trace
+  B<-> or B<.>      List previous/current line  B<s> [I<expr>]    Single step [in expr]
+  B<w> [I<line>]    List around line            B<n> [I<expr>]    Next, steps over subs
+  B<f> I<filename>  View source in file         <B<CR>>        Repeat last B<n> or B<s>
+  B</>I<pattern>B</> B<?>I<patt>B<?>   Search forw/backw    B<r>           Return from subroutine
+  B<v>	      Show versions of modules    B<c> [I<ln>|I<sub>]  Continue until position
+I<Debugger controls:>                        B<L>           List break/watch/actions
+  B<O> [...]     Set debugger options        B<t> [I<expr>]    Toggle trace [trace expr]
+  B<<>[B<<>] or B<{>[B<{>] [I<cmd>]   Do before prompt   B<b> [I<ln>|I<event>] [I<cnd>]  Set breakpoint
+  B<>>[B<>>] [I<cmd>]  Do after prompt             B<b> I<sub> [I<cnd>] Set breakpoint for sub
+  B<$prc> [I<N>|I<pat>]   Redo a previous command     B<d> [I<ln>] or B<D> Delete a/all breakpoints
+  B<H> [I<-num>]    Display last num commands   B<a> [I<ln>] I<cmd>  Do cmd before line
+  B<=> [I<a> I<val>]   Define/list an alias        B<W> I<expr>      Add a watch expression
+  B<h> [I<db_cmd>]  Get help on command         B<A> or B<W>      Delete all actions/watch
+  B<|>[B<|>]I<dbcmd>   Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
+  B<q> or B<^D>     Quit			  B<R>	      Attempt a restart
+I<Data Examination:>	      B<expr>     Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
+  B<x>|B<m> I<expr>	Evals expr in array context, dumps the result or lists methods.
+  B<p> I<expr>	Print expression (uses script's current package).
+  B<S> [[B<!>]I<pat>]	List subroutine names [not] matching pattern
+  B<V> [I<Pk> [I<Vars>]]	List Variables in Package.  Vars can be ~pattern or !pattern.
+  B<X> [I<Vars>]	Same as \"B<V> I<current_package> [I<Vars>]\".
+END_SUM
+				# ')}}; # Fix balance of Emacs parsing
+}
+
+sub print_help {
+  my $message = shift;
+  if (@Term::ReadLine::TermCap::rl_term_set) {
+    $message =~ s/B<([^>]+|>)>/$Term::ReadLine::TermCap::rl_term_set[2]$1$Term::ReadLine::TermCap::rl_term_set[3]/g;
+    $message =~ s/I<([^>]+|>)>/$Term::ReadLine::TermCap::rl_term_set[0]$1$Term::ReadLine::TermCap::rl_term_set[1]/g;
+  }
+  print $OUT $message;
+}
+
+sub diesignal {
+    local $frame = 0;
+    local $doret = -2;
+    $SIG{'ABRT'} = 'DEFAULT';
+    kill 'ABRT', $$ if $panic++;
+    if (defined &Carp::longmess) {
+	local $SIG{__WARN__} = '';
+	local $Carp::CarpLevel = 2;		# mydie + confess
+	&warn(Carp::longmess("Signal @_"));
+    }
+    else {
+	print $DB::OUT "Got signal @_\n";
+    }
+    kill 'ABRT', $$;
+}
+
+sub dbwarn { 
+  local $frame = 0;
+  local $doret = -2;
+  local $SIG{__WARN__} = '';
+  local $SIG{__DIE__} = '';
+  eval { require Carp } if defined $^S;	# If error/warning during compilation,
+                                        # require may be broken.
+  warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
+    return unless defined &Carp::longmess;
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  &warn($mess); 
+}
+
+sub dbdie {
+  local $frame = 0;
+  local $doret = -2;
+  local $SIG{__DIE__} = '';
+  local $SIG{__WARN__} = '';
+  my $i = 0; my $ineval = 0; my $sub;
+  if ($dieLevel > 2) {
+      local $SIG{__WARN__} = \&dbwarn;
+      &warn(@_);		# Yell no matter what
+      return;
+  }
+  if ($dieLevel < 2) {
+    die @_ if $^S;		# in eval propagate
+  }
+  eval { require Carp } if defined $^S;	# If error/warning during compilation,
+                                	# require may be broken.
+  die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
+    unless defined &Carp::longmess;
+  # We do not want to debug this chunk (automatic disabling works
+  # inside DB::DB, but not in Carp).
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  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"
+	  if $I_m_init;
+      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;
+}
+
+sub find_sub {
+  my $subr = shift;
+  return unless defined &$subr;
+  $sub{$subr} or do {
+    $subr = \&$subr;		# Hard reference
+    my $s;
+    for (keys %sub) {
+      $s = $_, last if $subr eq \&$_;
+    }
+    $sub{$s} if $s;
+  }
+}
+
+sub methods {
+  my $class = shift;
+  $class = ref $class if ref $class;
+  local %seen;
+  local %packs;
+  methods_via($class, '', 1);
+  methods_via('UNIVERSAL', 'UNIVERSAL', 0);
+}
+
+sub methods_via {
+  my $class = shift;
+  return if $packs{$class}++;
+  my $prefix = shift;
+  my $prepend = $prefix ? "via $prefix: " : '';
+  my $name;
+  for $name (grep {defined &{$ {"$ {class}::"}{$_}}} 
+	     sort keys %{"$ {class}::"}) {
+    next if $seen{ $name }++;
+    print $DB::OUT "$prepend$name\n";
+  }
+  return unless shift;		# Recurse?
+  for $name (@{"$ {class}::ISA"}) {
+    $prepend = $prefix ? $prefix . " -> $name" : $name;
+    methods_via($name, $prepend, 1);
+  }
+}
+
+# The following BEGIN is very handy if debugger goes havoc, debugging debugger?
+
+BEGIN {			# This does not compile, alas.
+  $IN = \*STDIN;		# For bugs before DB::OUT has been opened
+  $OUT = \*STDERR;		# For errors before DB::OUT has been opened
+  $sh = '!';
+  $rc = ',';
+  @hist = ('?');
+  $deep = 100;			# warning if stack gets this deep
+  $window = 10;
+  $preview = 3;
+  $sub = '';
+  $SIG{INT} = \&DB::catch;
+  # This may be enabled to debug debugger:
+  #$warnLevel = 1 unless defined $warnLevel;
+  #$dieLevel = 1 unless defined $dieLevel;
+  #$signalLevel = 1 unless defined $signalLevel;
+
+  $db_stop = 0;			# Compiler warning
+  $db_stop = 1 << 30;
+  $level = 0;			# Level of recursive debugging
+  # @stack and $doret are needed in sub sub, which is called for DB::postponed.
+  # Triggers bug (?) in perl is we postpone this until runtime:
+  @postponed = @stack = (0);
+  $doret = -2;
+  $frame = 0;
+}
+
+BEGIN {$^W = $ini_warn;}	# Switch warnings back
+
+#use Carp;			# This did break, left for debuggin
+
+sub db_complete {
+  # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
+  my($text, $line, $start) = @_;
+  my ($itext, $search, $prefix, $pack) =
+    ($text, "^\Q$ {'package'}::\E([^:]+)\$");
+  
+  return sort grep /^\Q$text/, (keys %sub), qw(postpone load compile), # subroutines
+                               (map { /$search/ ? ($1) : () } keys %sub)
+    if (substr $line, 0, $start) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
+  return sort grep /^\Q$text/, values %INC # files
+    if (substr $line, 0, $start) =~ /^\|*b\s+load\s+$/;
+  return sort map {($_, db_complete($_ . "::", "V ", 2))}
+    grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : ()} keys %:: # top-packages
+      if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ and $text =~ /^\w*$/;
+  return sort map {($_, db_complete($_ . "::", "V ", 2))}
+    grep !/^main::/,
+      grep /^\Q$text/, map { /^(.*)::$/ ? ($prefix . "::$1") : ()} keys %{$prefix . '::'}
+				 # packages
+	if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ 
+	  and $text =~ /^(.*[^:])::?(\w*)$/  and $prefix = $1;
+  if ( $line =~ /^\|*f\s+(.*)/ ) { # Loaded files
+    # We may want to complete to (eval 9), so $text may be wrong
+    $prefix = length($1) - length($text);
+    $text = $1;
+    return sort 
+	map {substr $_, 2 + $prefix} grep /^_<\Q$text/, (keys %main::), $0
+  }
+  if ((substr $text, 0, 1) eq '&') { # subroutines
+    $text = substr $text, 1;
+    $prefix = "&";
+    return sort map "$prefix$_", 
+               grep /^\Q$text/, 
+                 (keys %sub),
+                 (map { /$search/ ? ($1) : () } 
+		    keys %sub);
+  }
+  if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
+    $pack = ($1 eq 'main' ? '' : $1) . '::';
+    $prefix = (substr $text, 0, 1) . $1 . '::';
+    $text = $2;
+    my @out 
+      = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/, keys %$pack ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return sort @out;
+  }
+  if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
+    $pack = ($package eq 'main' ? '' : $package) . '::';
+    $prefix = substr $text, 0, 1;
+    $text = substr $text, 1;
+    my @out = map "$prefix$_", grep /^\Q$text/, 
+       (grep /^_?[a-zA-Z]/, keys %$pack), 
+       ( $pack eq '::' ? () : (grep /::$/, keys %::) ) ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return sort @out;
+  }
+  if ((substr $line, 0, $start) =~ /^\|*O\b.*\s$/) { # Options after a space
+    my @out = grep /^\Q$text/, @options;
+    my $val = option_val($out[0], undef);
+    my $out = '? ';
+    if (not defined $val or $val =~ /[\n\r]/) {
+      # Can do nothing better
+    } elsif ($val =~ /\s/) {
+      my $found;
+      foreach $l (split //, qq/\"\'\#\|/) {
+	$out = "$l$val$l ", last if (index $val, $l) == -1;
+      }
+    } else {
+      $out = "=$val ";
+    }
+    # Default to value if one completion, to question if many
+    $rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
+    return sort @out;
+  }
+  return $term->filename_list($text); # filenames
+}
+
+sub end_report {
+  print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n"
+}
+
+END {
+  $finished = $inhibit_exit;	# So that some keys may be disabled.
+  # Do not stop in at_exit() and destructors on exit:
+  $DB::single = !$exiting && !$runnonstop;
+  DB::fake::at_exit() unless $exiting or $runnonstop;
+}
+
+package DB::fake;
+
+sub at_exit {
+  "Debugged program terminated.  Use `q' to quit or `R' to restart.";
+}
+
+package DB;			# Do not trace this 1; below!
+
+1;
diff --git a/contrib/perl5/lib/pwd.pl b/contrib/perl5/lib/pwd.pl
new file mode 100644
index 000000000000..beb591679e26
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/shellwords.pl b/contrib/perl5/lib/shellwords.pl
new file mode 100644
index 000000000000..1c45a5a09035
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/sigtrap.pm b/contrib/perl5/lib/sigtrap.pm
new file mode 100644
index 000000000000..c081123b6b4c
--- /dev/null
+++ b/contrib/perl5/lib/sigtrap.pm
@@ -0,0 +1,289 @@
+package sigtrap;
+
+=head1 NAME
+
+sigtrap - Perl pragma to enable simple signal handling
+
+=cut
+
+use Carp;
+
+$VERSION = 1.02;
+$Verbose ||= 0;
+
+sub import {
+    my $pkg = shift;
+    my $handler = \&handler_traceback;
+    my $saw_sig = 0;
+    my $untrapped = 0;
+    local $_;
+
+  Arg_loop:
+    while (@_) {
+	$_ = shift;
+	if (/^[A-Z][A-Z0-9]*$/) {
+	    $saw_sig++;
+	    unless ($untrapped and $SIG{$_} and $SIG{$_} ne 'DEFAULT') {
+		print "Installing handler $handler for $_\n" if $Verbose;
+		$SIG{$_} = $handler;
+	    }
+	}
+	elsif ($_ eq 'normal-signals') {
+	    unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
+	}
+	elsif ($_ eq 'error-signals') {
+	    unshift @_, grep(exists $SIG{$_},
+			     qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
+	}
+	elsif ($_ eq 'old-interface-signals') {
+	    unshift @_,
+	    grep(exists $SIG{$_},
+		 qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
+	}
+    	elsif ($_ eq 'stack-trace') {
+	    $handler = \&handler_traceback;
+	}
+	elsif ($_ eq 'die') {
+	    $handler = \&handler_die;
+	}
+	elsif ($_ eq 'handler') {
+	    @_ or croak "No argument specified after 'handler'";
+	    $handler = shift;
+	    unless (ref $handler or $handler eq 'IGNORE'
+			or $handler eq 'DEFAULT') {
+    	    	require Symbol;
+		$handler = Symbol::qualify($handler, (caller)[0]);
+	    }
+	}
+	elsif ($_ eq 'untrapped') {
+	    $untrapped = 1;
+	}
+	elsif ($_ eq 'any') {
+	    $untrapped = 0;
+	}
+	elsif ($_ =~ /^\d/) {
+	    $VERSION >= $_ or croak "sigtrap.pm version $_ required,"
+		    	    	    	. " but this is only version $VERSION";
+	}
+	else {
+	    croak "Unrecognized argument $_";
+	}
+    }
+    unless ($saw_sig) {
+	@_ = qw(old-interface-signals);
+	goto Arg_loop;
+    }
+}
+
+sub handler_die {
+    croak "Caught a SIG$_[0]";
+}
+
+sub handler_traceback {
+    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;
+
+__END__
+
+=head1 SYNOPSIS
+
+    use sigtrap;
+    use sigtrap qw(stack-trace old-interface-signals);	# equivalent
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+    use sigtrap qw(die INT QUIT);
+    use sigtrap qw(die normal-signals);
+    use sigtrap qw(die untrapped normal-signals);
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+    use sigtrap 'handler' => \&my_handler, 'normal-signals';
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=head1 DESCRIPTION
+
+The B<sigtrap> pragma is a simple interface to installing signal
+handlers.  You can have it install one of two handlers supplied by
+B<sigtrap> itself (one which provides a Perl stack trace and one which
+simply C<die()>s), or alternately you can supply your own handler for it
+to install.  It can be told only to install a handler for signals which
+are either untrapped or ignored.  It has a couple of lists of signals to
+trap, plus you can supply your own list of signals.
+
+The arguments passed to the C<use> statement which invokes B<sigtrap>
+are processed in order.  When a signal name or the name of one of
+B<sigtrap>'s signal lists is encountered a handler is immediately
+installed, when an option is encountered it affects subsequently
+installed handlers.
+
+=head1 OPTIONS
+
+=head2 SIGNAL HANDLERS
+
+These options affect which handler will be used for subsequently
+installed signals.
+
+=over 4
+
+=item B<stack-trace>
+
+The handler used for subsequently installed signals outputs a Perl stack
+trace to STDERR and then tries to dump core.  This is the default signal
+handler.
+
+=item B<die>
+
+The handler used for subsequently installed signals calls C<die>
+(actually C<croak>) with a message indicating which signal was caught.
+
+=item B<handler> I<your-handler>
+
+I<your-handler> will be used as the handler for subsequently installed
+signals.  I<your-handler> can be any value which is valid as an
+assignment to an element of C<%SIG>.
+
+=back
+
+=head2 SIGNAL LISTS
+
+B<sigtrap> has a few built-in lists of signals to trap.  They are:
+
+=over 4
+
+=item B<normal-signals>
+
+These are the signals which a program might normally expect to encounter
+and which by default cause it to terminate.  They are HUP, INT, PIPE and
+TERM.
+
+=item B<error-signals>
+
+These signals usually indicate a serious problem with the Perl
+interpreter or with your script.  They are ABRT, BUS, EMT, FPE, ILL,
+QUIT, SEGV, SYS and TRAP.
+
+=item B<old-interface-signals>
+
+These are the signals which were trapped by default by the old
+B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
+SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
+B<sigtrap>, this list is used.
+
+=back
+
+For each of these three lists, the collection of signals set to be
+trapped is checked before trapping; if your architecture does not
+implement a particular signal, it will not be trapped but rather
+silently ignored.
+
+=head2 OTHER
+
+=over 4
+
+=item B<untrapped>
+
+This token tells B<sigtrap> to install handlers only for subsequently
+listed signals which aren't already trapped or ignored.
+
+=item B<any>
+
+This token tells B<sigtrap> to install handlers for all subsequently
+listed signals.  This is the default behavior.
+
+=item I<signal>
+
+Any argument which looks like a signal name (that is,
+C</^[A-Z][A-Z0-9]*$/>) indicates that B<sigtrap> should install a
+handler for that name.
+
+=item I<number>
+
+Require that at least version I<number> of B<sigtrap> is being used.
+
+=back
+
+=head1 EXAMPLES
+
+Provide a stack trace for the old-interface-signals:
+
+    use sigtrap;
+
+Ditto:
+
+    use sigtrap qw(stack-trace old-interface-signals);
+
+Provide a stack trace on the 4 listed signals only:
+
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+
+Die on INT or QUIT:
+
+    use sigtrap qw(die INT QUIT);
+
+Die on HUP, INT, PIPE or TERM:
+
+    use sigtrap qw(die normal-signals);
+
+Die on HUP, INT, PIPE or TERM, except don't change the behavior for
+signals which are already trapped or ignored:
+
+    use sigtrap qw(die untrapped normal-signals);
+
+Die on receipt one of an of the B<normal-signals> which is currently
+B<untrapped>, provide a stack trace on receipt of B<any> of the
+B<error-signals>:
+
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+
+Install my_handler() as the handler for the B<normal-signals>:
+
+    use sigtrap 'handler', \&my_handler, 'normal-signals';
+
+Install my_handler() as the handler for the normal-signals, provide a
+Perl stack trace on receipt of one of the error-signals:
+
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=cut
diff --git a/contrib/perl5/lib/stat.pl b/contrib/perl5/lib/stat.pl
new file mode 100644
index 000000000000..f7c240a4b3e7
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/strict.pm b/contrib/perl5/lib/strict.pm
new file mode 100644
index 000000000000..940e8bf7ff31
--- /dev/null
+++ b/contrib/perl5/lib/strict.pm
@@ -0,0 +1,104 @@
+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
+declared via C<use vars>,
+localized via C<my()> or wasn't fully qualified.  Because this is to avoid
+variable suicide problems and subtle dynamic scoping issues, a merely
+local() variable isn't good enough.  See L<perlfunc/my> and
+L<perlfunc/local>.
+
+    use strict 'vars';
+    $X::foo = 1;	 # ok, fully qualified
+    my $foo = 10;	 # ok, my() var
+    local $foo = 9;	 # blows up
+
+    package Cinna;
+    use vars qw/ $bar /;	# Declares $bar in current package
+    $bar = 'HgS';		# ok, global declared via pragma
+
+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 "=E<gt>" 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<perlmodlib/Pragmatic Modules>.
+
+
+=cut
+
+$strict::VERSION = "1.01";
+
+my %bitmask = (
+refs => 0x00000002,
+subs => 0x00000200,
+vars => 0x00000400
+);
+
+sub bits {
+    my $bits = 0;
+    foreach my $s (@_){ $bits |= $bitmask{$s} || 0; };
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(@_ ? @_ : qw(refs subs vars));
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
+}
+
+1;
diff --git a/contrib/perl5/lib/subs.pm b/contrib/perl5/lib/subs.pm
new file mode 100644
index 000000000000..aa332a678583
--- /dev/null
+++ b/contrib/perl5/lib/subs.pm
@@ -0,0 +1,38 @@
+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.
+
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+See L<perlmodlib/Pragmatic Modules> and L<strict/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/contrib/perl5/lib/syslog.pl b/contrib/perl5/lib/syslog.pl
new file mode 100644
index 000000000000..9e03399e4df6
--- /dev/null
+++ b/contrib/perl5/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; 1' 			||
+     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 = uc $name;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "syslog'$name";
+    defined &$name ? &$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/contrib/perl5/lib/tainted.pl b/contrib/perl5/lib/tainted.pl
new file mode 100644
index 000000000000..6e24867a83dd
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/termcap.pl b/contrib/perl5/lib/termcap.pl
new file mode 100644
index 000000000000..37313432fdee
--- /dev/null
+++ b/contrib/perl5/lib/termcap.pl
@@ -0,0 +1,169 @@
+;# $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/\\(200)/pack('c',0)/eg;			# NUL character
+	    s/\\(0\d\d)/pack('c',oct($1))/eg;	# octal
+	    s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg;	# hex
+	    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/contrib/perl5/lib/timelocal.pl b/contrib/perl5/lib/timelocal.pl
new file mode 100644
index 000000000000..ad322756e387
--- /dev/null
+++ b/contrib/perl5/lib/timelocal.pl
@@ -0,0 +1,18 @@
+;# timelocal.pl
+;#
+;# Usage:
+;#	$time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+;#	$time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+;# This file has been superseded by the Time::Local library module.
+;# It is implemented as a call to that module for backwards compatibility
+;# with code written for perl4; new code should use Time::Local directly.
+
+;# The current implementation shares with the original the questionable
+;# behavior of defining the timelocal() and timegm() functions in the
+;# namespace of whatever package was current when the first instance of
+;# C<require 'timelocal.pl';> was executed in a program.
+
+use Time::Local;
+
+*timelocal::cheat = \&Time::Local::cheat;
diff --git a/contrib/perl5/lib/validate.pl b/contrib/perl5/lib/validate.pl
new file mode 100644
index 000000000000..ec4a04b54367
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/lib/vars.pm b/contrib/perl5/lib/vars.pm
new file mode 100644
index 000000000000..334af9630ada
--- /dev/null
+++ b/contrib/perl5/lib/vars.pm
@@ -0,0 +1,75 @@
+package vars;
+
+require 5.002;
+
+# The following require can't be removed during maintenance
+# releases, sadly, because of the risk of buggy code that does
+# require Carp; Carp::croak "..."; without brackets dying
+# if Carp hasn't been loaded in earlier compile time. :-(
+# We'll let those bugs get found on the development track.
+require Carp if $] < 5.00450;
+
+sub import {
+    my $callpack = caller;
+    my ($pack, @imports, $sym, $ch) = @_;
+    foreach $sym (@imports) {
+        ($ch, $sym) = unpack('a1a*', $sym);
+	if ($sym =~ tr/A-Za-Z_0-9//c) {
+	    # time for a more-detailed check-up
+	    if ($sym =~ /::/) {
+		require Carp;
+		Carp::croak("Can't declare another package's variables");
+	    } elsif ($sym =~ /^\w+[[{].*[]}]$/) {
+		require Carp;
+		Carp::croak("Can't declare individual elements of hash or array");
+	    } elsif ($^W and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
+		require Carp;
+		Carp::carp("No need to declare built-in vars");
+	    }
+	}
+        *{"${callpack}::$sym"} =
+          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
+           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
+           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
+           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
+           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+           : do {
+		require Carp;
+		Carp::croak("'$ch$sym' is not a valid variable name");
+	     });
+    }
+};
+
+1;
+__END__
+
+=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.
+
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+Packages such as the B<AutoLoader> and B<SelfLoader> that delay
+loading of subroutines within packages can create problems with
+package lexicals defined using C<my()>. While the B<vars> pragma
+cannot duplicate the effect of package lexicals (total transparency
+outside of the package), it can act as an acceptable substitute by
+pre-declaring global symbols, ensuring their availability to the
+later-loaded routines.
+
+See L<perlmodlib/Pragmatic Modules>.
+
+=cut