vendor/perl5/5.005.02

14 files changed, 2565 insertions, 0 deletions

diff --git a/contrib/perl5/lib/File/Basename.pm b/contrib/perl5/lib/File/Basename.pm
new file mode 100644
index 0000000000000..69bb1fa5fdcf5
--- /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 0000000000000..dca7f6aff31a8
--- /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 0000000000000..2f9c45c4c60d6
--- /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 0000000000000..d0b3c8977ef04
--- /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 0000000000000..594ee2ec8432b
--- /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 0000000000000..1305d21e6b274
--- /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 0000000000000..39f1ba17713ec
--- /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 0000000000000..5f3dbf5fce764
--- /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 0000000000000..4968e24abca0e
--- /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 0000000000000..d60261770281e
--- /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 0000000000000..77de73a216a3b
--- /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 0000000000000..c5269fd10c7ac
--- /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 0000000000000..034a0cbc2e699
--- /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 0000000000000..f5d17f7da4434
--- /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