New tlperl part XIV

git-svn-id: svn://tug.org/texlive/trunk@21436 c570f23f-e606-0410-a88d-b1316a301751

22 files changed, 13913 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl/lib/File/Basename.pm b/Master/tlpkg/tlperl/lib/File/Basename.pm
new file mode 100644
index 00000000000..d842844daf1
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Basename.pm
@@ -0,0 +1,402 @@
+=head1 NAME
+
+File::Basename - Parse file paths into directory, filename and suffix.
+
+=head1 SYNOPSIS
+
+    use File::Basename;
+
+    ($name,$path,$suffix) = fileparse($fullname,@suffixlist);
+    $name = fileparse($fullname,@suffixlist);
+
+    $basename = basename($fullname,@suffixlist);
+    $dirname  = dirname($fullname);
+
+
+=head1 DESCRIPTION
+
+These routines allow you to parse file paths into their directory, filename
+and suffix.
+
+B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and
+quirks, of the shell and C functions of the same name.  See each
+function's documentation for details.  If your concern is just parsing
+paths it is safer to use L<File::Spec>'s C<splitpath()> and
+C<splitdir()> methods.
+
+It is guaranteed that
+
+    # Where $path_separator is / for Unix, \ for Windows, etc...
+    dirname($path) . $path_separator . basename($path);
+
+is equivalent to the original path for all systems but VMS.
+
+
+=cut
+
+
+package File::Basename;
+
+# File::Basename is used during the Perl build, when the re extension may
+# not be available, but we only actually need it if running under tainting.
+BEGIN {
+  if (${^TAINT}) {
+    require re;
+    re->import('taint');
+  }
+}
+
+
+use strict;
+use 5.006;
+use warnings;
+our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+$VERSION = "2.78";
+
+fileparse_set_fstype($^O);
+
+
+=over 4
+
+=item C<fileparse>
+X<fileparse>
+
+    my($filename, $directories, $suffix) = fileparse($path);
+    my($filename, $directories, $suffix) = fileparse($path, @suffixes);
+    my $filename                         = fileparse($path, @suffixes);
+
+The C<fileparse()> routine divides a file path into its $directories, $filename
+and (optionally) the filename $suffix.
+
+$directories contains everything up to and including the last
+directory separator in the $path including the volume (if applicable).
+The remainder of the $path is the $filename.
+
+     # On Unix returns ("baz", "/foo/bar/", "")
+     fileparse("/foo/bar/baz");
+
+     # On Windows returns ("baz", "C:\foo\bar\", "")
+     fileparse("C:\foo\bar\baz");
+
+     # On Unix returns ("", "/foo/bar/baz/", "")
+     fileparse("/foo/bar/baz/");
+
+If @suffixes are given each element is a pattern (either a string or a
+C<qr//>) matched against the end of the $filename.  The matching
+portion is removed and becomes the $suffix.
+
+     # On Unix returns ("baz", "/foo/bar/", ".txt")
+     fileparse("/foo/bar/baz.txt", qr/\.[^.]*/);
+
+If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
+matching for suffix removal is performed case-insensitively, since
+those systems are not case-sensitive when opening existing files.
+
+You are guaranteed that C<$directories . $filename . $suffix> will
+denote the same location as the original $path.
+
+=cut
+
+
+sub fileparse {
+  my($fullname,@suffices) = @_;
+
+  unless (defined $fullname) {
+      require Carp;
+      Carp::croak("fileparse(): need a valid pathname");
+  }
+
+  my $orig_type = '';
+  my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
+
+  my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
+
+  if ($type eq "VMS" and $fullname =~ m{/} ) {
+    # We're doing Unix emulation
+    $orig_type = $type;
+    $type = 'Unix';
+  }
+
+  my($dirpath, $basename);
+
+  if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
+    ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
+    $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
+  }
+  elsif ($type eq "OS2") {
+    ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
+    $dirpath = './' unless $dirpath;	# Can't be 0
+    $dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
+  }
+  elsif ($type eq "MacOS") {
+    ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
+    $dirpath = ':' unless $dirpath;
+  }
+  elsif ($type eq "AmigaOS") {
+    ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
+    $dirpath = './' unless $dirpath;
+  }
+  elsif ($type eq 'VMS' ) {
+    ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
+    $dirpath ||= '';  # should always be defined
+  }
+  else { # Default to Unix semantics.
+    ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s);
+    if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.*)}) {
+      # dev:[000000] is top of VMS tree, similar to Unix '/'
+      # so strip it off and treat the rest as "normal"
+      my $devspec  = $1;
+      my $remainder = $3;
+      ($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s);
+      $dirpath ||= '';  # should always be defined
+      $dirpath = $devspec.$dirpath;
+    }
+    $dirpath = './' unless $dirpath;
+  }
+      
+
+  my $tail   = '';
+  my $suffix = '';
+  if (@suffices) {
+    foreach $suffix (@suffices) {
+      my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
+      if ($basename =~ s/$pat//s) {
+        $taint .= substr($suffix,0,0);
+        $tail = $1 . $tail;
+      }
+    }
+  }
+
+  # Ensure taint is propgated from the path to its pieces.
+  $tail .= $taint;
+  wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
+            : ($basename .= $taint);
+}
+
+
+
+=item C<basename>
+X<basename> X<filename>
+
+    my $filename = basename($path);
+    my $filename = basename($path, @suffixes);
+
+This function is provided for compatibility with the Unix shell command
+C<basename(1)>.  It does B<NOT> always return the file name portion of a
+path as you might expect.  To be safe, if you want the file name portion of
+a path use C<fileparse()>.
+
+C<basename()> returns the last level of a filepath even if the last
+level is clearly directory.  In effect, it is acting like C<pop()> for
+paths.  This differs from C<fileparse()>'s behaviour.
+
+    # Both return "bar"
+    basename("/foo/bar");
+    basename("/foo/bar/");
+
+@suffixes work as in C<fileparse()> except all regex metacharacters are
+quoted.
+
+    # These two function calls are equivalent.
+    my $filename = basename("/foo/bar/baz.txt",  ".txt");
+    my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
+
+Also note that in order to be compatible with the shell command,
+C<basename()> does not strip off a suffix if it is identical to the
+remaining characters in the filename.
+
+=cut
+
+
+sub basename {
+  my($path) = shift;
+
+  # From BSD basename(1)
+  # The basename utility deletes any prefix ending with the last slash `/'
+  # character present in string (after first stripping trailing slashes)
+  _strip_trailing_sep($path);
+
+  my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
+
+  # From BSD basename(1)
+  # The suffix is not stripped if it is identical to the remaining 
+  # characters in string.
+  if( length $suffix and !length $basename ) {
+      $basename = $suffix;
+  }
+  
+  # Ensure that basename '/' == '/'
+  if( !length $basename ) {
+      $basename = $dirname;
+  }
+
+  return $basename;
+}
+
+
+
+=item C<dirname>
+X<dirname>
+
+This function is provided for compatibility with the Unix shell
+command C<dirname(1)> and has inherited some of its quirks.  In spite of
+its name it does B<NOT> always return the directory name as you might
+expect.  To be safe, if you want the directory name of a path use
+C<fileparse()>.
+
+Only on VMS (where there is no ambiguity between the file and directory
+portions of a path) and AmigaOS (possibly due to an implementation quirk in
+this module) does C<dirname()> work like C<fileparse($path)>, returning just the
+$directories.
+
+    # On VMS and AmigaOS
+    my $directories = dirname($path);
+
+When using Unix or MSDOS syntax this emulates the C<dirname(1)> shell function
+which is subtly different from how C<fileparse()> works.  It returns all but
+the last level of a file path even if the last level is clearly a directory.
+In effect, it is not returning the directory portion but simply the path one
+level up acting like C<chop()> for file paths.
+
+Also unlike C<fileparse()>, C<dirname()> does not include a trailing slash on
+its returned path.
+
+    # returns /foo/bar.  fileparse() would return /foo/bar/
+    dirname("/foo/bar/baz");
+
+    # also returns /foo/bar despite the fact that baz is clearly a 
+    # directory.  fileparse() would return /foo/bar/baz/
+    dirname("/foo/bar/baz/");
+
+    # returns '.'.  fileparse() would return 'foo/'
+    dirname("foo/");
+
+Under VMS, if there is no directory information in the $path, then the
+current default device and directory is used.
+
+=cut
+
+
+sub dirname {
+    my $path = shift;
+
+    my($type) = $Fileparse_fstype;
+
+    if( $type eq 'VMS' and $path =~ m{/} ) {
+        # Parse as Unix
+        local($File::Basename::Fileparse_fstype) = '';
+        return dirname($path);
+    }
+
+    my($basename, $dirname) = fileparse($path);
+
+    if ($type eq 'VMS') { 
+        $dirname ||= $ENV{DEFAULT};
+    }
+    elsif ($type eq 'MacOS') {
+	if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
+            _strip_trailing_sep($dirname);
+	    ($basename,$dirname) = fileparse $dirname;
+	}
+	$dirname .= ":" unless $dirname =~ /:\z/;
+    }
+    elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { 
+        _strip_trailing_sep($dirname);
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    _strip_trailing_sep($dirname);
+	}
+    }
+    elsif ($type eq 'AmigaOS') {
+        if ( $dirname =~ /:\z/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s{[^:/]+\z}{} unless length($basename);
+    }
+    else {
+        _strip_trailing_sep($dirname);
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    _strip_trailing_sep($dirname);
+	}
+    }
+
+    $dirname;
+}
+
+
+# Strip the trailing path separator.
+sub _strip_trailing_sep  {
+    my $type = $Fileparse_fstype;
+
+    if ($type eq 'MacOS') {
+        $_[0] =~ s/([^:]):\z/$1/s;
+    }
+    elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { 
+        $_[0] =~ s/([^:])[\\\/]*\z/$1/;
+    }
+    else {
+        $_[0] =~ s{(.)/*\z}{$1}s;
+    }
+}
+
+
+=item C<fileparse_set_fstype>
+X<filesystem>
+
+  my $type = fileparse_set_fstype();
+  my $previous_type = fileparse_set_fstype($type);
+
+Normally File::Basename will assume a file path type native to your current
+operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
+With this function you can override that assumption.
+
+Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
+"MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
+"Epoc" and "Unix" (all case-insensitive).  If an unrecognized $type is
+given "Unix" will be assumed.
+
+If you've selected VMS syntax, and the file specification you pass to
+one of these routines contains a "/", they assume you are using Unix
+emulation and apply the Unix syntax rules instead, for that function
+call only.
+
+=back
+
+=cut
+
+
+BEGIN {
+
+my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
+my @Types = (@Ignore_Case, qw(Unix));
+
+sub fileparse_set_fstype {
+    my $old = $Fileparse_fstype;
+
+    if (@_) {
+        my $new_type = shift;
+
+        $Fileparse_fstype = 'Unix';  # default
+        foreach my $type (@Types) {
+            $Fileparse_fstype = $type if $new_type =~ /^$type/i;
+        }
+
+        $Fileparse_igncase = 
+          (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
+    }
+
+    return $old;
+}
+
+}
+
+
+1;
+
+
+=head1 SEE ALSO
+
+L<dirname(1)>, L<basename(1)>, L<File::Spec>
diff --git a/Master/tlpkg/tlperl/lib/File/CheckTree.pm b/Master/tlpkg/tlperl/lib/File/CheckTree.pm
new file mode 100644
index 00000000000..d7948f2385f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/CheckTree.pm
@@ -0,0 +1,238 @@
+package File::CheckTree;
+
+use 5.006;
+use Cwd;
+use Exporter;
+use File::Spec;
+use warnings;
+use strict;
+
+our $VERSION = '4.4';
+our @ISA     = qw(Exporter);
+our @EXPORT  = qw(validate);
+
+=head1 NAME
+
+File::CheckTree - run many filetest checks on a tree
+
+=head1 SYNOPSIS
+
+    use File::CheckTree;
+
+    $num_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
+directives, each 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.
+
+=head1 AUTHOR
+
+File::CheckTree was derived from lib/validate.pl which was
+written by Larry Wall.
+Revised by Paul Grassie <F<grassie@perl.com>> in 2002.
+
+=head1 HISTORY
+
+File::CheckTree used to not display fatal error messages.
+It used to count only those warnings produced by a generic C<|| warn>
+(and not those in which the user supplied the message).  In addition,
+the validate() routine would leave the user program in whatever
+directory was last entered through the use of "cd" directives.
+These bugs were fixed during the development of perl 5.8.
+The first fixed version of File::CheckTree was 4.2.
+
+=cut
+
+my $Warnings;
+
+sub validate {
+    my ($starting_dir, $file, $test, $cwd, $oldwarnings);
+
+    $starting_dir = cwd;
+
+    $cwd = "";
+    $Warnings = 0;
+
+    foreach my $check (split /\n/, $_[0]) {
+        my ($testlist, @testlist);
+
+        # skip blanks/comments
+        next if $check =~ /^\s*#/ || $check =~ /^\s*$/;
+
+        # Todo:
+        # should probably check for invalid directives and die
+        # but earlier versions of File::CheckTree did not do this either
+
+        # split a line like "/foo -r || die"
+        # so that $file is "/foo", $test is "-r || die"
+        # (making special allowance for quoted filenames).
+        if ($check =~ m/^\s*"([^"]+)"\s+(.*?)\s*$/ or
+            $check =~ m/^\s*'([^']+)'\s+(.*?)\s*$/ or
+            $check =~ m/^\s*(\S+?)\s+(\S.*?)\s*$/)
+        {
+            ($file, $test) = ($1,$2);
+        }
+        else {
+            die "Malformed line: '$check'";
+        };
+
+        # change a $test like "!-ug || die" to "!-Z || die",
+        # capturing the bundled tests (e.g. "ug") in $2
+        if ($test =~ s/ ^ (!?-) (\w{2,}) \b /$1Z/x) {
+            $testlist = $2;
+            # split bundled tests, e.g. "ug" to 'u', 'g'
+            @testlist = split(//, $testlist);
+        }
+        else {
+            # put in placeholder Z for stand-alone test
+            @testlist = ('Z');
+        }
+
+        # will compare these two later to stop on 1st warning w/in a bundle
+        $oldwarnings = $Warnings;
+
+        foreach my $one (@testlist) {
+            # examples of $test: "!-Z || die" or "-w || warn"
+            my $this = $test;
+
+            # expand relative $file to full pathname if preceded by cd directive
+            $file = File::Spec->catfile($cwd, $file) 
+                    if $cwd && !File::Spec->file_name_is_absolute($file);
+
+            # put filename in after the test operator
+            $this =~ s/(-\w\b)/$1 "\$file"/g;
+
+            # change the "-Z" representing a bundle with the $one test
+            $this =~ s/-Z/-$one/;
+
+            # if it's a "cd" directive...
+            if ($this =~ /^cd\b/) {
+                # add "|| die ..."
+                $this .= ' || die "cannot cd to $file\n"';
+                # expand "cd" directive with directory name
+                $this =~ s/\bcd\b/chdir(\$cwd = '$file')/;
+            }
+            else {
+                # add "|| warn" as a default disposition
+                $this .= ' || warn' unless $this =~ /\|\|/; 
+
+                # change a generic ".. || die" or ".. || warn"
+                # to call valmess instead of die/warn directly
+                # valmess will look up the error message from %Val_Message
+                $this =~ s/ ^ ( (\S+) \s+ \S+ ) \s* \|\| \s* (die|warn) \s* $
+                          /$1 || valmess('$3', '$2', \$file)/x;
+            }
+
+            {
+                # count warnings, either from valmess or '-r || warn "my msg"'
+                # also, call any pre-existing signal handler for __WARN__
+                my $orig_sigwarn = $SIG{__WARN__};
+                local $SIG{__WARN__} = sub {
+                    ++$Warnings;
+                    if ( $orig_sigwarn ) {
+                        $orig_sigwarn->(@_);
+                    }
+                    else {
+                        warn "@_";
+                    }
+                };
+
+                # do the test
+                eval $this;
+
+                # re-raise an exception caused by a "... || die" test 
+                if (my $err = $@) {
+                    # in case of any cd directives, return from whence we came
+                    if ($starting_dir ne cwd) {
+                        chdir($starting_dir) || die "$starting_dir: $!";
+                    }
+                    die $err;
+                }
+            }
+
+            # stop on 1st warning within a bundle of tests
+            last if $Warnings > $oldwarnings;
+        }
+    }
+
+    # in case of any cd directives, return from whence we came
+    if ($starting_dir ne cwd) {
+        chdir($starting_dir) || die "chdir $starting_dir: $!";
+    }
+
+    return $Warnings;
+}
+
+my %Val_Message = (
+    'r' => "is not readable by uid $>.",
+    'w' => "is not writable by uid $>.",
+    'x' => "is not executable by uid $>.",
+    'o' => "is not owned by uid $>.",
+    'R' => "is not readable by you.",
+    'W' => "is not writable by you.",
+    'X' => "is not executable by you.",
+    'O' => "is not owned by you.",
+    'e' => "does not exist.",
+    'z' => "does not have zero size.",
+    's' => "does not have non-zero size.",
+    'f' => "is not a plain file.",
+    'd' => "is not a directory.",
+    'l' => "is not a symbolic link.",
+    'p' => "is not a named pipe (FIFO).",
+    'S' => "is not a socket.",
+    'b' => "is not a block special file.",
+    'c' => "is not a character special file.",
+    'u' => "does not have the setuid bit set.",
+    'g' => "does not have the setgid bit set.",
+    'k' => "does not have the sticky bit set.",
+    'T' => "is not a text file.",
+    'B' => "is not a binary file."
+);
+
+sub valmess {
+    my ($disposition, $test, $file) = @_;
+    my $ferror;
+
+    if ($test =~ / ^ (!?) -(\w) \s* $ /x) {
+        my ($neg, $ftype) = ($1, $2);
+
+        $ferror = "$file $Val_Message{$ftype}";
+
+        if ($neg eq '!') {
+            $ferror =~ s/ is not / should not be / ||
+            $ferror =~ s/ does not / should not / ||
+            $ferror =~ s/ not / /;
+        }
+    }
+    else {
+        $ferror = "Can't do $test $file.\n";
+    }
+
+    die "$ferror\n" if $disposition eq 'die';
+    warn "$ferror\n";
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Compare.pm b/Master/tlpkg/tlperl/lib/File/Compare.pm
new file mode 100644
index 00000000000..05e1c41d211
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Compare.pm
@@ -0,0 +1,182 @@
+package File::Compare;
+
+use 5.006;
+use strict;
+use warnings;
+our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big);
+
+require Exporter;
+
+$VERSION = '1.1006';
+@ISA = qw(Exporter);
+@EXPORT = qw(compare);
+@EXPORT_OK = qw(cmp compare_text);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub croak {
+    require Carp;
+    goto &Carp::croak;
+}
+
+sub compare {
+    croak("Usage: compare( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my ($from,$to,$size) = @_;
+    my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0);
+
+    my ($fromsize,$closefrom,$closeto);
+    local (*FROM, *TO);
+
+    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;
+	unless ($text_mode) {
+	    binmode FROM;
+	    $fromsize = -s FROM;
+	}
+	$closefrom = 1;
+    }
+
+    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 unless $text_mode;
+	$closeto = 1;
+    }
+
+    if (!$text_mode && $closefrom && $closeto) {
+	# If both are opened files we know they differ if their size differ
+	goto fail_inner if $fromsize != -s TO;
+    }
+
+    if ($text_mode) {
+	local $/ = "\n";
+	my ($fline,$tline);
+	while (defined($fline = <FROM>)) {
+	    goto fail_inner unless defined($tline = <TO>);
+	    if (ref $size) {
+		# $size contains ref to comparison function
+		goto fail_inner if &$size($fline, $tline);
+	    } else {
+		goto fail_inner if $fline ne $tline;
+	    }
+	}
+	goto fail_inner if defined($tline = <TO>);
+    }
+    else {
+	unless (defined($size) && $size > 0) {
+	    $size = $fromsize || -s TO || 0;
+	    $size = 1024 if $size < 512;
+	    $size = $Too_Big if $size > $Too_Big;
+	}
+
+	my ($fr,$tr,$fbuf,$tbuf);
+	$fbuf = $tbuf = '';
+	while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
+	    unless (defined($tr = read(TO,$tbuf,$fr)) && $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) {
+	my $status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return -1;
+}
+
+sub cmp;
+*cmp = \&compare;
+
+sub compare_text {
+    my ($from,$to,$cmp) = @_;
+    croak("Usage: compare_text( file1, file2 [, cmp-function])")
+	unless @_ == 2 || @_ == 3;
+    croak("Third arg to compare_text() function must be a code reference")
+	if @_ == 3 && ref($cmp) ne 'CODE';
+
+    # Using a negative buffer size puts compare into text_mode too
+    $cmp = -1 unless defined $cmp;
+    compare($from, $to, $cmp);
+}
+
+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.
+
+File::Compare::compare_text does a line by line comparison of the two
+files. It stops as soon as a difference is detected. compare_text()
+accepts an optional third argument: This must be a CODE reference to
+a line comparison function, which returns 0 when both lines are considered
+equal. For example:
+
+    compare_text($file1, $file2)
+
+is basically equivalent to
+
+    compare_text($file1, $file2, sub {$_[0] ne $_[1]} )
+
+=head1 RETURN
+
+File::Compare::compare and its sibling functions 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/Master/tlpkg/tlperl/lib/File/Copy.pm b/Master/tlpkg/tlperl/lib/File/Copy.pm
new file mode 100644
index 00000000000..eed6a53195b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Copy.pm
@@ -0,0 +1,656 @@
+# 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 5.006;
+use strict;
+use warnings;
+use File::Spec;
+use Config;
+# During perl build, we need File::Copy but Scalar::Util might not be built yet
+# And then we need these games to avoid loading overload, as that will
+# confuse miniperl during the bootstrap of perl.
+my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
+our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
+sub copy;
+sub syscopy;
+sub cp;
+sub mv;
+
+$VERSION = '2.18';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(copy move);
+@EXPORT_OK = qw(cp mv);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub croak {
+    require Carp;
+    goto &Carp::croak;
+}
+
+sub carp {
+    require Carp;
+    goto &Carp::carp;
+}
+
+my $macfiles;
+if ($^O eq 'MacOS') {
+	$macfiles = eval { require Mac::MoreFiles };
+	warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
+		if $@ && $^W;
+}
+
+# Look up the feature settings on VMS using VMS::Feature when available.
+
+my $use_vms_feature = 0;
+BEGIN {
+    if ($^O eq 'VMS') {
+        if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+            $use_vms_feature = 1;
+        }
+    }
+}
+
+# Need to look up the UNIX report mode.  This may become a dynamic mode
+# in the future.
+sub _vms_unix_rpt {
+    my $unix_rpt;
+    if ($use_vms_feature) {
+        $unix_rpt = VMS::Feature::current("filename_unix_report");
+    } else {
+        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
+    }
+    return $unix_rpt;
+}
+
+# Need to look up the EFS character set mode.  This may become a dynamic
+# mode in the future.
+sub _vms_efs {
+    my $efs;
+    if ($use_vms_feature) {
+        $efs = VMS::Feature::current("efs_charset");
+    } else {
+        my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
+        $efs = $env_efs =~ /^[ET1]/i;
+    }
+    return $efs;
+}
+
+
+sub _catname {
+    my($from, $to) = @_;
+    if (not defined &basename) {
+	require File::Basename;
+	import  File::Basename 'basename';
+    }
+
+    if ($^O eq 'MacOS') {
+	# a partial dir name that's valid only in the cwd (e.g. 'tmp')
+	$to = ':' . $to if $to !~ /:/;
+    }
+
+    return File::Spec->catfile($to, basename($from));
+}
+
+# _eq($from, $to) tells whether $from and $to are identical
+sub _eq {
+    my ($from, $to) = map {
+        $Scalar_Util_loaded && Scalar::Util::blessed($_)
+	    && overload::Method($_, q{""})
+            ? "$_"
+            : $_
+    } (@_);
+    return '' if ( (ref $from) xor (ref $to) );
+    return $from == $to if ref $from;
+    return $from eq $to;
+}
+
+sub copy {
+    croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+
+    my $size;
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    }
+
+    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 (_eq($from, $to)) { # works for references, too
+	carp("'$from' and '$to' are identical (not copied)");
+        # The "copy" was a success as the source and destination contain
+        # the same data.
+        return 1;
+    }
+
+    if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
+	!($^O eq 'MSWin32' || $^O eq 'os2')) {
+	my @fs = stat($from);
+	if (@fs) {
+	    my @ts = stat($to);
+	    if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) {
+		carp("'$from' and '$to' are identical (not copied)");
+                return 0;
+	    }
+	}
+    }
+
+    if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    if (defined &syscopy && !$Syscopy_is_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.
+	&& !($from_a_handle && $^O eq 'MSWin32')
+	&& !($from_a_handle && $^O eq 'MacOS')
+	&& !($from_a_handle && $^O eq 'NetWare')
+       )
+    {
+	my $copy_to = $to;
+
+        if ($^O eq 'VMS' && -e $from) {
+
+            if (! -d $to && ! -d $from) {
+
+                my $vms_efs = _vms_efs();
+                my $unix_rpt = _vms_unix_rpt();
+                my $unix_mode = 0;
+                my $from_unix = 0;
+                $from_unix = 1 if ($from =~ /^\.\.?$/);
+                my $from_vms = 0;
+                $from_vms = 1 if ($from =~ m#[\[<\]]#);
+
+                # Need to know if we are in Unix mode.
+                if ($from_vms == $from_unix) {
+                    $unix_mode = $unix_rpt;
+                } else {
+                    $unix_mode = $from_unix;
+                }
+
+                # VMS has sticky defaults on extensions, which means that
+                # if there is a null extension on the destination file, it
+                # will inherit the extension of the source file
+                # So add a '.' for a null extension.
+
+                # In unix_rpt mode, the trailing dot should not be added.
+
+                if ($vms_efs) {
+                    $copy_to = $to;
+                } else {
+                    $copy_to = VMS::Filespec::vmsify($to);
+                }
+                my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
+                $file = $file . '.'
+                    unless (($file =~ /(?<!\^)\./) || $unix_rpt);
+                $copy_to = File::Spec->catpath($vol, $dirs, $file);
+
+                # Get rid of the old versions to be like UNIX
+                1 while unlink $copy_to;
+            }
+        }
+
+        return syscopy($from, $copy_to) || 0;
+    }
+
+    my $closefrom = 0;
+    my $closeto = 0;
+    my ($status, $r, $buf);
+    local($\) = '';
+
+    my $from_h;
+    if ($from_a_handle) {
+       $from_h = $from;
+    } else {
+       open $from_h, "<", $from or goto fail_open1;
+       binmode $from_h or die "($!,$^E)";
+       $closefrom = 1;
+    }
+
+    # Seems most logical to do this here, in case future changes would want to
+    # make this croak for some reason.
+    unless (defined $size) {
+	$size = tied(*$from_h) ? 0 : -s $from_h || 0;
+	$size = 1024 if ($size < 512);
+	$size = $Too_Big if ($size > $Too_Big);
+    }
+
+    my $to_h;
+    if ($to_a_handle) {
+       $to_h = $to;
+    } else {
+	$to_h = \do { local *FH }; # XXX is this line obsolete?
+	open $to_h, ">", $to or goto fail_open2;
+	binmode $to_h or die "($!,$^E)";
+	$closeto = 1;
+    }
+
+    $! = 0;
+    for (;;) {
+	my ($r, $w, $t);
+       defined($r = sysread($from_h, $buf, $size))
+	    or goto fail_inner;
+	last unless $r;
+	for ($w = 0; $w < $r; $w += $t) {
+           $t = syswrite($to_h, $buf, $r - $w, $w)
+		or goto fail_inner;
+	}
+    }
+
+    close($to_h) || goto fail_open2 if $closeto;
+    close($from_h) || 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_h;
+	$! = $status unless $!;
+    }
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+       close $from_h;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return 0;
+}
+
+sub cp {
+    my($from,$to) = @_;
+    my(@fromstat) = stat $from;
+    my(@tostat) = stat $to;
+    my $perm;
+
+    return 0 unless copy(@_) and @fromstat;
+
+    if (@tostat) {
+        $perm = $tostat[2];
+    } else {
+        $perm = $fromstat[2] & ~(umask || 0);
+	@tostat = stat $to;
+    }
+    # Might be more robust to look for S_I* in Fcntl, but we're
+    # trying to avoid dependence on any XS-containing modules,
+    # since File::Copy is used during the Perl build.
+    $perm &= 07777;
+    if ($perm & 06000) {
+	croak("Unable to check setuid/setgid permissions for $to: $!")
+	    unless @tostat;
+
+	if ($perm & 04000 and                     # setuid
+	    $fromstat[4] != $tostat[4]) {         # owner must match
+	    $perm &= ~06000;
+	}
+
+	if ($perm & 02000 && $> != 0) {           # if not root, setgid
+	    my $ok = $fromstat[5] == $tostat[5];  # group must match
+	    if ($ok) {                            # and we must be in group
+                $ok = grep { $_ == $fromstat[5] } split /\s+/, $)
+	    }
+	    $perm &= ~06000 unless $ok;
+	}
+    }
+    return 0 unless @tostat;
+    return 1 if $perm == ($tostat[2] & 07777);
+    return eval { chmod $perm, $to; } ? 1 : 0;
+}
+
+sub _move {
+    croak("Usage: move(FROM, TO) ") unless @_ == 3;
+
+    my($from,$to,$fallback) = @_;
+
+    my($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;
+    }
+
+    my $rename_to = $to;
+    if (-$^O eq 'VMS' && -e $from) {
+
+        if (! -d $to && ! -d $from) {
+
+            my $vms_efs = _vms_efs();
+            my $unix_rpt = _vms_unix_rpt();
+            my $unix_mode = 0;
+            my $from_unix = 0;
+            $from_unix = 1 if ($from =~ /^\.\.?$/);
+            my $from_vms = 0;
+            $from_vms = 1 if ($from =~ m#[\[<\]]#);
+
+            # Need to know if we are in Unix mode.
+            if ($from_vms == $from_unix) {
+                $unix_mode = $unix_rpt;
+            } else {
+                $unix_mode = $from_unix;
+            }
+
+            # VMS has sticky defaults on extensions, which means that
+            # if there is a null extension on the destination file, it
+            # will inherit the extension of the source file
+            # So add a '.' for a null extension.
+
+            # In unix_rpt mode, the trailing dot should not be added.
+
+            if ($vms_efs) {
+                $rename_to = $to;
+            } else {
+                $rename_to = VMS::Filespec::vmsify($to);
+            }
+            my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
+            $file = $file . '.'
+                unless (($file =~ /(?<!\^)\./) || $unix_rpt);
+            $rename_to = File::Spec->catpath($vol, $dirs, $file);
+
+            # Get rid of the old versions to be like UNIX
+            1 while unlink $rename_to;
+        }
+    }
+
+    return 1 if rename $from, $rename_to;
+
+    # 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
+                  ((!defined $tosz1) ||			   #  not before or
+		   ($tosz1 != $tosz2 or $tomt1 != $tomt2)) &&  #   was changed
+                $tosz2 == $fromsz;                         # it's all there
+
+    ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
+
+    {
+        local $@;
+        eval {
+            local $SIG{__DIE__};
+            $fallback->($from,$to) or die;
+            my($atime, $mtime) = (stat($from))[8,9];
+            utime($atime, $mtime, $to);
+            unlink($from)   or die;
+        };
+        return 1 unless $@;
+    }
+    ($sts,$ossts) = ($! + 0, $^E + 0);
+
+    ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
+    unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
+    ($!,$^E) = ($sts,$ossts);
+    return 0;
+}
+
+sub move { _move(@_,\&copy); }
+sub mv   { _move(@_,\&cp);   }
+
+# &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;
+	};
+    } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
+	# Win32::CopyFile() fill only work if we can load Win32.xs
+	*syscopy = sub {
+	    return 0 unless @_ == 2;
+	    return Win32::CopyFile(@_, 1);
+	};
+    } elsif ($macfiles) {
+	*syscopy = sub {
+	    my($from, $to) = @_;
+	    my($dir, $toname);
+
+	    return 0 unless -e $from;
+
+	    if ($to =~ /(.*:)([^:]+):?$/) {
+		($dir, $toname) = ($1, $2);
+	    } else {
+		($dir, $toname) = (":", $to);
+	    }
+
+	    unlink($to);
+	    Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
+	};
+    } else {
+	$Syscopy_is_copy = 1;
+	*syscopy = \&copy;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 SYNOPSIS
+
+	use File::Copy;
+
+	copy("file1","file2") or die "Copy failed: $!";
+	copy("Copy.pm",\*STDOUT);
+	move("/dev1/fileA","/dev2/fileB");
+
+	use File::Copy "cp";
+
+	$n = FileHandle->new("/a/file","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 copy
+X<copy> X<cp>
+
+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).  Trying to copy a file on top
+of itself is a fatal error.
+
+If the destination (second argument) already exists and is a directory,
+and the source (first argument) is not a filehandle, then the source
+file will be copied into the directory specified by the destination,
+using the same base name as the source file.  It's a failure to have a
+filehandle as the source when the destination is a directory.
+
+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 behaviour 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 will 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 C<cp>
+alias for this function. The syntax is I<exactly> the same.  The
+behavior is nearly the same as well: as of version 2.15, <cp> will
+preserve the source file's permission bits like the shell utility
+C<cp(1)> would do, while C<copy> uses the default permissions for the
+target file (which may depend on the process' C<umask>, file
+ownership, inherited ACLs, etc.).  If an error occurs in setting
+permissions, C<cp> will return 0, regardless of whether the file was
+successfully copied.
+
+=item move
+X<move> X<mv> X<rename>
+
+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 C<mv> alias for this function in the same way that
+you may use the <cp> alias for C<copy>.
+
+=item syscopy
+X<syscopy>
+
+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, which doesn't preserve OS-specific attributes.  For
+VMS systems, this calls the C<rmscopy> routine (see below).  For OS/2
+systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
+this calls C<Win32::CopyFile>.
+
+On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
+if available.
+
+B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
+
+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).
+
+=item rmscopy($from,$to[,$date_flag])
+X<rmscopy>
+
+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 NOTES
+
+=over 4
+
+=item *
+
+On Mac OS (Classic), the path separator is ':', not '/', and the 
+current directory is denoted as ':', not '.'. You should be careful 
+about specifying relative pathnames. While a full path always begins 
+with a volume name, a relative pathname should always begin with a 
+':'.  If specifying a volume name only, a trailing ':' is required.
+
+E.g.
+
+  copy("file1", "tmp");        # creates the file 'tmp' in the current directory
+  copy("file1", ":tmp:");      # creates :tmp:file1
+  copy("file1", ":tmp");       # same as above
+  copy("file1", "tmp");        # same as above, if 'tmp' is a directory (but don't do
+                               # that, since it may cause confusion, see example #1)
+  copy("file1", "tmp:file1");  # error, since 'tmp:' is not a volume
+  copy("file1", ":tmp:file1"); # ok, partial path
+  copy("file1", "DataHD:");    # creates DataHD:file1
+
+  move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one
+                                             # volume to another
+
+=back
+
+=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@newman.upenn.eduE<gt>> in 1996.
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/File/DosGlob.pm b/Master/tlpkg/tlperl/lib/File/DosGlob.pm
new file mode 100644
index 00000000000..496a14c1379
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/DosGlob.pm
@@ -0,0 +1,571 @@
+#!perl -w
+
+# use strict fails
+#Can't use string ("main::glob") as a symbol ref while "strict refs" in use at /usr/lib/perl5/5.005/File/DosGlob.pm line 191.
+
+#
+# Documentation at the __END__
+#
+
+package File::DosGlob;
+
+our $VERSION = '1.01';
+use strict;
+use warnings;
+
+sub doglob {
+    my $cond = shift;
+    my @retval = ();
+    #print "doglob: ", join('|', @_), "\n";
+  OUTER:
+    for my $pat (@_) {
+	my @matched = ();
+	my @globdirs = ();
+	my $head = '.';
+	my $sepchr = '/';
+        my $tail;
+	next OUTER unless defined $pat and $pat ne '';
+	# if arg is within quotes strip em and do no globbing
+	if ($pat =~ /^"(.*)"\z/s) {
+	    $pat = $1;
+	    if ($cond eq 'd') { push(@retval, $pat) if -d $pat }
+	    else              { push(@retval, $pat) if -e $pat }
+	    next OUTER;
+	}
+	# wildcards with a drive prefix such as h:*.pm must be changed
+	# to h:./*.pm to expand correctly
+	if ($pat =~ m|^([A-Za-z]:)[^/\\]|s) {
+	    substr($pat,0,2) = $1 . "./";
+	}
+	if ($pat =~ m|^(.*)([\\/])([^\\/]*)\z|s) {
+	    ($head, $sepchr, $tail) = ($1,$2,$3);
+	    #print "div: |$head|$sepchr|$tail|\n";
+	    push (@retval, $pat), 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]:\z/s;
+	    $pat = $tail;
+	}
+	#
+	# If file component has no wildcards, we can avoid opendir
+	unless ($pat =~ /[*?]/) {
+	    $head = '' if $head eq '.';
+	    $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
+	    $head .= $pat;
+	    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
+        $pat =~ s:([].+^\-\${}[|]):\\$1:g;
+	# and convert DOS-style wildcards to regex
+	$pat =~ s/\*/.*/g;
+	$pat =~ s/\?/.?/g;
+
+	#print "regex: '$pat', head: '$head'\n";
+	my $matchsub = sub { $_[0] =~ m|^$pat\z|is };
+      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($pat,'\\.') != -1) {
+		push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
+	    }
+	}
+	push @retval, @matched if @matched;
+    }
+    return @retval;
+}
+
+
+#
+# Do DOS-like globbing on Mac OS 
+#
+sub doglob_Mac {
+    my $cond = shift;
+    my @retval = ();
+
+	#print "doglob_Mac: ", join('|', @_), "\n";
+  OUTER:
+    for my $arg (@_) {
+        local $_ = $arg;
+	my @matched = ();
+	my @globdirs = ();
+	my $head = ':';
+	my $not_esc_head = $head;
+	my $sepchr = ':';	
+	next OUTER unless defined $_ and $_ ne '';
+	# if arg is within quotes strip em and do no globbing
+	if (/^"(.*)"\z/s) {
+	    $_ = $1;
+		# $_ may contain escaped metachars '\*', '\?' and '\'
+	        my $not_esc_arg = $_;
+		$not_esc_arg =~ s/\\([*?\\])/$1/g;
+	    if ($cond eq 'd') { push(@retval, $not_esc_arg) if -d $not_esc_arg }
+	    else              { push(@retval, $not_esc_arg) if -e $not_esc_arg }
+	    next OUTER;
+	}
+
+	if (m|^(.*?)(:+)([^:]*)\z|s) { # note: $1 is not greedy
+	    my $tail;
+	    ($head, $sepchr, $tail) = ($1,$2,$3);
+	    #print "div: |$head|$sepchr|$tail|\n";
+	    push (@retval, $_), next OUTER if $tail eq '';		
+		#
+		# $head may contain escaped metachars '\*' and '\?'
+		
+		my $tmp_head = $head;
+		# if a '*' or '?' is preceded by an odd count of '\', temporary delete 
+		# it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as 
+		# wildcards
+		$tmp_head =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg;
+	
+		if ($tmp_head =~ /[*?]/) { # if there are wildcards ...	
+		@globdirs = doglob_Mac('d', $head);
+		push(@retval, doglob_Mac($cond, map {"$_$sepchr$tail"} @globdirs)),
+		    next OUTER if @globdirs;
+	    }
+		
+		$head .= $sepchr; 
+		$not_esc_head = $head;
+		# unescape $head for file operations
+		$not_esc_head =~ s/\\([*?\\])/$1/g;
+	    $_ = $tail;
+	}
+	#
+	# If file component has no wildcards, we can avoid opendir
+	
+	my $tmp_tail = $_;
+	# if a '*' or '?' is preceded by an odd count of '\', temporary delete 
+	# it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as 
+	# wildcards
+	$tmp_tail =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg;
+	
+	unless ($tmp_tail =~ /[*?]/) { # if there are wildcards ...
+	    $not_esc_head = $head = '' if $head eq ':';
+	    my $not_esc_tail = $_;
+	    # unescape $head and $tail for file operations
+	    $not_esc_tail =~ s/\\([*?\\])/$1/g;
+	    $head .= $_;
+		$not_esc_head .= $not_esc_tail;
+	    if ($cond eq 'd') { push(@retval,$head) if -d $not_esc_head }
+	    else              { push(@retval,$head) if -e $not_esc_head }
+	    next OUTER;
+	}
+	#print "opendir($not_esc_head)\n";
+	opendir(D, $not_esc_head) or next OUTER;
+	my @leaves = readdir D;
+	closedir D;
+
+	# escape regex metachars but not '\' and glob chars '*', '?'
+	$_ =~ s:([].+^\-\${}[|]):\\$1:g;
+	# and convert DOS-style wildcards to regex,
+	# but only if they are not escaped
+	$_ =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg;
+
+	#print "regex: '$_', head: '$head', unescaped head: '$not_esc_head'\n";
+	my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
+	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 "$not_esc_head$e";
+		
+		if (&$matchsub($e)) {
+			my $leave = (($not_esc_head eq ':') && (-f "$not_esc_head$e")) ? 
+		            	"$e" : "$not_esc_head$e";
+			#
+			# On Mac OS, the two glob metachars '*' and '?' and the escape 
+			# char '\' are valid characters for file and directory names. 
+			# We have to escape and treat them specially.
+			$leave =~ s|([*?\\])|\\$1|g;		
+			push(@matched, $leave);
+			next INNER;
+		}
+	}
+	push @retval, @matched if @matched;
+    }
+    return @retval;
+}
+
+#
+# _expand_volume() will only be used on Mac OS (Classic): 
+# Takes an array of original patterns as argument and returns an array of  
+# possibly modified patterns. Each original pattern is processed like 
+# that:
+# + If there's a volume name in the pattern, we push a separate pattern 
+#   for each mounted volume that matches (with '*', '?' and '\' escaped).  
+# + If there's no volume name in the original pattern, it is pushed 
+#   unchanged. 
+# Note that the returned array of patterns may be empty.
+#  
+sub _expand_volume {
+	
+	require MacPerl; # to be verbose
+	
+	my @pat = @_;
+	my @new_pat = ();
+	my @FSSpec_Vols = MacPerl::Volumes();
+	my @mounted_volumes = ();
+
+	foreach my $spec_vol (@FSSpec_Vols) {		
+		# push all mounted volumes into array
+     	push @mounted_volumes, MacPerl::MakePath($spec_vol);
+	}
+	#print "mounted volumes: |@mounted_volumes|\n";
+	
+	while (@pat) {
+		my $pat = shift @pat;	
+		if ($pat =~ /^([^:]+:)(.*)\z/) { # match a volume name?
+			my $vol_pat = $1;
+			my $tail = $2;
+			#
+			# escape regex metachars but not '\' and glob chars '*', '?'
+			$vol_pat =~ s:([].+^\-\${}[|]):\\$1:g;
+			# and convert DOS-style wildcards to regex,
+			# but only if they are not escaped
+			$vol_pat =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg;
+			#print "volume regex: '$vol_pat' \n";
+				
+			foreach my $volume (@mounted_volumes) {
+				if ($volume =~ m|^$vol_pat\z|ios) {
+					#
+					# On Mac OS, the two glob metachars '*' and '?' and the  
+					# escape char '\' are valid characters for volume names. 
+					# We have to escape and treat them specially.
+					$volume =~ s|([*?\\])|\\$1|g;
+					push @new_pat, $volume . $tail;
+				}
+			}			
+		} else { # no volume name in pattern, push original pattern
+			push @new_pat, $pat;
+		}
+	}
+	return @new_pat;
+}
+
+
+#
+# _preprocess_pattern() will only be used on Mac OS (Classic): 
+# Resolves any updirs in the pattern. Removes a single trailing colon 
+# from the pattern, unless it's a volume name pattern like "*HD:"
+#
+sub _preprocess_pattern {
+	my @pat = @_;
+	
+	foreach my $p (@pat) {
+		my $proceed;
+		# resolve any updirs, e.g. "*HD:t?p::a*" -> "*HD:a*"
+		do {
+			$proceed = ($p =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);  
+		} while ($proceed);
+		# remove a single trailing colon, e.g. ":*:" -> ":*"
+		$p =~ s/:([^:]+):\z/:$1/;
+	}
+	return @pat;
+}
+		
+		
+#
+# _un_escape() will only be used on Mac OS (Classic):
+# Unescapes a list of arguments which may contain escaped 
+# metachars '*', '?' and '\'.
+#
+sub _un_escape {
+	foreach (@_) {
+		s/\\([*?\\])/$1/g;
+	}
+	return @_;
+}
+
+#
+# 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,$cxix) = @_;
+    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;
+    }
+
+    # Mike Mestnik: made to do abc{1,2,3} == abc1 abc2 abc3.
+    #   abc3 will be the original {3} (and drop the {}).
+    #   abc1 abc2 will be put in @appendpat.
+    # This was just the esiest way, not nearly the best.
+    REHASH: {
+	my @appendpat = ();
+	for (@pat) {
+	    # There must be a "," I.E. abc{efg} is not what we want.
+	    while ( /^(.*)(?<!\\)\{(.*?)(?<!\\)\,.*?(?<!\\)\}(.*)$/ ) {
+		my ($start, $match, $end) = ($1, $2, $3);
+		#print "Got: \n\t$start\n\t$match\n\t$end\n";
+		my $tmp = "$start$match$end";
+		while ( $tmp =~ s/^(.*?)(?<!\\)\{(?:.*(?<!\\)\,)?(.*\Q$match\E.*?)(?:(?<!\\)\,.*)?(?<!\\)\}(.*)$/$1$2$3/ ) {
+		    #print "Striped: $tmp\n";
+		    #  these expanshions will be preformed by the original,
+		    #  when we call REHASH.
+		}
+		push @appendpat, ("$tmp");
+		s/^\Q$start\E(?<!\\)\{\Q$match\E(?<!\\)\,/$start\{/;
+		if ( /^\Q$start\E(?<!\\)\{(?!.*?(?<!\\)\,.*?\Q$end\E$)(.*)(?<!\\)\}\Q$end\E$/ ) {
+		    $match = $1;
+		    #print "GOT: \n\t$start\n\t$match\n\t$end\n\n";
+		    $_ = "$start$match$end";
+		}
+	    }
+	    #print "Sould have "GOT" vs "Got"!\n";
+		#FIXME: There should be checking for this.
+		#  How or what should be done about failure is beond me.
+	}
+	if ( $#appendpat != -1
+		) {
+	    #print "LOOP\n";
+	    #FIXME: Max loop, no way! :")
+	    for ( @appendpat ) {
+	        push @pat, $_;
+	    }
+	    goto REHASH;
+	}
+    }
+    for ( @pat ) {
+	s/\\{/{/g;
+	s/\\}/}/g;
+	s/\\,/,/g;
+    }
+    #print join ("\n", @pat). "\n";
+ 
+    # 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) {
+	if ($^O eq 'MacOS') {
+		# first, take care of updirs and trailing colons
+		@pat = _preprocess_pattern(@pat);
+		# expand volume names
+		@pat = _expand_volume(@pat);
+		$entries{$cxix} = (@pat) ? [_un_escape( doglob_Mac(1,@pat) )] : [()];
+	} else {
+		$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;
+	}
+    }
+}
+
+{
+    no strict 'refs';
+
+    sub import {
+    my $pkg = shift;
+    return unless @_;
+    my $sym = shift;
+    my $callpkg = ($sym =~ s/^GLOBAL_//s ? '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 NOTES
+
+=over 4
+
+=item *
+
+Mac OS (Classic) users should note a few differences. The specification 
+of pathnames in glob patterns adheres to the usual Mac OS conventions: 
+The path separator is a colon ':', not a slash '/' or backslash '\'. A 
+full path always begins with a volume name. A relative pathname on Mac 
+OS must always begin with a ':', except when specifying a file or 
+directory name in the current working directory, where the leading colon 
+is optional. If specifying a volume name only, a trailing ':' is 
+required. Due to these rules, a glob like E<lt>*:E<gt> will find all 
+mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find 
+all files and directories in the current directory.
+
+Note that updirs in the glob pattern are resolved before the matching begins,
+i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
+that a single trailing ':' in the pattern is ignored (unless it's a volume
+name pattern like "*HD:"), i.e. a glob like <:*:> will find both directories 
+I<and> files (and not, as one might expect, only directories). 
+
+The metachars '*', '?' and the escape char '\' are valid characters in 
+volume, directory and file names on Mac OS. Hence, if you want to match
+a '*', '?' or '\' literally, you have to escape these characters. Due to 
+perl's quoting rules, things may get a bit complicated, when you want to 
+match a string like '\*' literally, or when you want to match '\' literally, 
+but treat the immediately following character '*' as metachar. So, here's a 
+rule of thumb (applies to both single- and double-quoted strings): escape 
+each '*' or '?' or '\' with a backslash, if you want to treat them literally, 
+and then double each backslash and your are done. E.g. 
+
+- Match '\*' literally
+
+   escape both '\' and '*'  : '\\\*'
+   double the backslashes   : '\\\\\\*'
+
+(Internally, the glob routine sees a '\\\*', which means that both '\' and 
+'*' are escaped.)
+
+
+- Match '\' literally, treat '*' as metachar
+
+   escape '\' but not '*'   : '\\*'
+   double the backslashes   : '\\\\*'
+
+(Internally, the glob routine sees a '\\*', which means that '\' is escaped and 
+'*' is not.)
+
+Note that you also have to quote literal spaces in the glob pattern, as described
+above.
+
+=back
+
+=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@activestate.com>
+
+=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/Master/tlpkg/tlperl/lib/File/Fetch.pm b/Master/tlpkg/tlperl/lib/File/Fetch.pm
new file mode 100644
index 00000000000..4aabc29be55
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Fetch.pm
@@ -0,0 +1,1466 @@
+package File::Fetch;
+
+use strict;
+use FileHandle;
+use File::Temp;
+use File::Copy;
+use File::Spec;
+use File::Spec::Unix;
+use File::Basename              qw[dirname];
+
+use Cwd                         qw[cwd];
+use Carp                        qw[carp];
+use IPC::Cmd                    qw[can_run run QUOTE];
+use File::Path                  qw[mkpath];
+use File::Temp                  qw[tempdir];
+use Params::Check               qw[check];
+use Module::Load::Conditional   qw[can_load];
+use Locale::Maketext::Simple    Style => 'gettext';
+
+use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
+                $BLACKLIST $METHOD_FAIL $VERSION $METHODS
+                $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
+            ];
+
+$VERSION        = '0.24';
+$VERSION        = eval $VERSION;    # avoid warnings with development releases
+$PREFER_BIN     = 0;                # XXX TODO implement
+$FROM_EMAIL     = 'File-Fetch@example.com';
+$USER_AGENT     = "File::Fetch/$VERSION";
+$BLACKLIST      = [qw|ftp|];
+$METHOD_FAIL    = { };
+$FTP_PASSIVE    = 1;
+$TIMEOUT        = 0;
+$DEBUG          = 0;
+$WARN           = 1;
+
+### methods available to fetch the file depending on the scheme
+$METHODS = {
+    http    => [ qw|lwp wget curl lftp lynx iosock| ],
+    ftp     => [ qw|lwp netftp wget curl lftp ncftp ftp| ],
+    file    => [ qw|lwp lftp file| ],
+    rsync   => [ qw|rsync| ]
+};
+
+### silly warnings ###
+local $Params::Check::VERBOSE               = 1;
+local $Params::Check::VERBOSE               = 1;
+local $Module::Load::Conditional::VERBOSE   = 0;
+local $Module::Load::Conditional::VERBOSE   = 0;
+
+### see what OS we are on, important for file:// uris ###
+use constant ON_WIN     => ($^O eq 'MSWin32');
+use constant ON_VMS     => ($^O eq 'VMS');                                
+use constant ON_UNIX    => (!ON_WIN);
+use constant HAS_VOL    => (ON_WIN);
+use constant HAS_SHARE  => (ON_WIN);
+
+
+=pod
+
+=head1 NAME
+
+File::Fetch - A generic file fetching mechanism
+
+=head1 SYNOPSIS
+
+    use File::Fetch;
+
+    ### build a File::Fetch object ###
+    my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt');
+
+    ### fetch the uri to cwd() ###
+    my $where = $ff->fetch() or die $ff->error;
+
+    ### fetch the uri to /tmp ###
+    my $where = $ff->fetch( to => '/tmp' );
+
+    ### parsed bits from the uri ###
+    $ff->uri;
+    $ff->scheme;
+    $ff->host;
+    $ff->path;
+    $ff->file;
+
+=head1 DESCRIPTION
+
+File::Fetch is a generic file fetching mechanism.
+
+It allows you to fetch any file pointed to by a C<ftp>, C<http>,
+C<file>, or C<rsync> uri by a number of different means.
+
+See the C<HOW IT WORKS> section further down for details.
+
+=head1 ACCESSORS
+
+A C<File::Fetch> object has the following accessors
+
+=over 4
+
+=item $ff->uri
+
+The uri you passed to the constructor
+
+=item $ff->scheme
+
+The scheme from the uri (like 'file', 'http', etc)
+
+=item $ff->host
+
+The hostname in the uri.  Will be empty if host was originally 
+'localhost' for a 'file://' url.
+
+=item $ff->vol
+
+On operating systems with the concept of a volume the second element
+of a file:// is considered to the be volume specification for the file.
+Thus on Win32 this routine returns the volume, on other operating
+systems this returns nothing.
+
+On Windows this value may be empty if the uri is to a network share, in 
+which case the 'share' property will be defined. Additionally, volume 
+specifications that use '|' as ':' will be converted on read to use ':'.
+
+On VMS, which has a volume concept, this field will be empty because VMS
+file specifications are converted to absolute UNIX format and the volume
+information is transparently included.
+
+=item $ff->share
+
+On systems with the concept of a network share (currently only Windows) returns 
+the sharename from a file://// url.  On other operating systems returns empty.
+
+=item $ff->path
+
+The path from the uri, will be at least a single '/'.
+
+=item $ff->file
+
+The name of the remote file. For the local file name, the
+result of $ff->output_file will be used. 
+
+=cut
+
+
+##########################
+### Object & Accessors ###
+##########################
+
+{
+    ### template for autogenerated accessors ###
+    my $Tmpl = {
+        scheme          => { default => 'http' },
+        host            => { default => 'localhost' },
+        path            => { default => '/' },
+        file            => { required => 1 },
+        uri             => { required => 1 },
+        vol             => { default => '' }, # windows for file:// uris
+        share           => { default => '' }, # windows for file:// uris
+        _error_msg      => { no_override => 1 },
+        _error_msg_long => { no_override => 1 },
+    };
+    
+    for my $method ( keys %$Tmpl ) {
+        no strict 'refs';
+        *$method = sub {
+                        my $self = shift;
+                        $self->{$method} = $_[0] if @_;
+                        return $self->{$method};
+                    }
+    }
+    
+    sub _create {
+        my $class = shift;
+        my %hash  = @_;
+        
+        my $args = check( $Tmpl, \%hash ) or return;
+        
+        bless $args, $class;
+    
+        if( lc($args->scheme) ne 'file' and not $args->host ) {
+            return $class->_error(loc(
+                "Hostname required when fetching from '%1'",$args->scheme));
+        }
+        
+        for (qw[path file]) {
+            unless( $args->$_() ) { # 5.5.x needs the ()
+                return $class->_error(loc("No '%1' specified",$_));
+            }
+        }
+        
+        return $args;
+    }    
+}
+
+=item $ff->output_file
+
+The name of the output file. This is the same as $ff->file,
+but any query parameters are stripped off. For example:
+
+    http://example.com/index.html?x=y
+
+would make the output file be C<index.html> rather than 
+C<index.html?x=y>.
+
+=back
+
+=cut
+
+sub output_file {
+    my $self = shift;
+    my $file = $self->file;
+    
+    $file =~ s/\?.*$//g;
+    
+    return $file;
+}
+
+### XXX do this or just point to URI::Escape?
+# =head2 $esc_uri = $ff->escaped_uri
+# 
+# =cut
+# 
+# ### most of this is stolen straight from URI::escape
+# {   ### Build a char->hex map
+#     my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
+# 
+#     sub escaped_uri {
+#         my $self = shift;
+#         my $uri  = $self->uri;
+# 
+#         ### Default unsafe characters.  RFC 2732 ^(uric - reserved)
+#         $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/
+#                     $escapes{$1} || $self->_fail_hi($1)/ge;
+# 
+#         return $uri;
+#     }
+# 
+#     sub _fail_hi {
+#         my $self = shift;
+#         my $char = shift;
+#         
+#         $self->_error(loc(
+#             "Can't escape '%1', try using the '%2' module instead", 
+#             sprintf("\\x{%04X}", ord($char)), 'URI::Escape'
+#         ));            
+#     }
+# 
+#     sub output_file {
+#     
+#     }
+#     
+#     
+# }
+
+=head1 METHODS
+
+=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );
+
+Parses the uri and creates a corresponding File::Fetch::Item object,
+that is ready to be C<fetch>ed and returns it.
+
+Returns false on failure.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my %hash  = @_;
+
+    my ($uri);
+    my $tmpl = {
+        uri => { required => 1, store => \$uri },
+    };
+
+    check( $tmpl, \%hash ) or return;
+
+    ### parse the uri to usable parts ###
+    my $href    = $class->_parse_uri( $uri ) or return;
+
+    ### make it into a FFI object ###
+    my $ff      = $class->_create( %$href ) or return;
+
+
+    ### return the object ###
+    return $ff;
+}
+
+### parses an uri to a hash structure:
+###
+### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' )
+###
+### becomes:
+###
+### $href = {
+###     scheme  => 'ftp',
+###     host    => 'ftp.cpan.org',
+###     path    => '/pub/mirror',
+###     file    => 'index.html'
+### };
+###
+### In the case of file:// urls there maybe be additional fields
+###
+### For systems with volume specifications such as Win32 there will be 
+### a volume specifier provided in the 'vol' field.
+###
+###   'vol' => 'volumename'
+###
+### For windows file shares there may be a 'share' key specified
+###
+###   'share' => 'sharename' 
+###
+### Note that the rules of what a file:// url means vary by the operating system 
+### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious
+### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and 
+### not '/foo/bar.txt'
+###
+### Similarly if the host interpreting the url is VMS then 
+### file:///disk$user/my/notes/note12345.txt' means 
+### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as
+### if it is unix where it means /disk$user/my/notes/note12345.txt'.
+### Except for some cases in the File::Spec methods, Perl on VMS will generally
+### handle UNIX format file specifications.
+###
+### This means it is impossible to serve certain file:// urls on certain systems.
+###
+### Thus are the problems with a protocol-less specification. :-(
+###
+
+sub _parse_uri {
+    my $self = shift;
+    my $uri  = shift or return;
+
+    my $href = { uri => $uri };
+
+    ### find the scheme ###
+    $uri            =~ s|^(\w+)://||;
+    $href->{scheme} = $1;
+
+    ### See rfc 1738 section 3.10
+    ### http://www.faqs.org/rfcs/rfc1738.html
+    ### And wikipedia for more on windows file:// urls
+    ### http://en.wikipedia.org/wiki/File://
+    if( $href->{scheme} eq 'file' ) {
+        
+        my @parts = split '/',$uri;
+
+        ### file://hostname/...
+        ### file://hostname/...
+        ### normalize file://localhost with file:///
+        $href->{host} = $parts[0] || '';
+
+        ### index in @parts where the path components begin;
+        my $index = 1;  
+
+        ### file:////hostname/sharename/blah.txt        
+        if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) {
+            
+            $href->{host}   = $parts[2] || '';  # avoid warnings
+            $href->{share}  = $parts[3] || '';  # avoid warnings        
+
+            $index          = 4         # index after the share
+
+        ### file:///D|/blah.txt
+        ### file:///D:/blah.txt
+        } elsif (HAS_VOL) {
+        
+            ### this code comes from dmq's patch, but:
+            ### XXX if volume is empty, wouldn't that be an error? --kane
+            ### if so, our file://localhost test needs to be fixed as wel            
+            $href->{vol}    = $parts[1] || '';
+
+            ### correct D| style colume descriptors
+            $href->{vol}    =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN;
+
+            $index          = 2;        # index after the volume
+        } 
+
+        ### rebuild the path from the leftover parts;
+        $href->{path} = join '/', '', splice( @parts, $index, $#parts );
+
+    } else {
+        ### using anything but qw() in hash slices may produce warnings 
+        ### in older perls :-(
+        @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
+    }
+
+    ### split the path into file + dir ###
+    {   my @parts = File::Spec::Unix->splitpath( delete $href->{path} );
+        $href->{path} = $parts[1];
+        $href->{file} = $parts[2];
+    }
+
+    ### host will be empty if the target was 'localhost' and the 
+    ### scheme was 'file'
+    $href->{host} = '' if   ($href->{host}      eq 'localhost') and
+                            ($href->{scheme}    eq 'file');
+
+    return $href;
+}
+
+=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] )
+
+Fetches the file you requested and returns the full path to the file.
+
+By default it writes to C<cwd()>, but you can override that by specifying 
+the C<to> argument:
+
+    ### file fetch to /tmp, full path to the file in $where
+    $where = $ff->fetch( to => '/tmp' );
+
+    ### file slurped into $scalar, full path to the file in $where
+    ### file is downloaded to a temp directory and cleaned up at exit time
+    $where = $ff->fetch( to => \$scalar );
+
+Returns the full path to the downloaded file on success, and false
+on failure.
+
+=cut
+
+sub fetch {
+    my $self = shift or return;
+    my %hash = @_;
+
+    my $target;
+    my $tmpl = {
+        to  => { default => cwd(), store => \$target },
+    };
+
+    check( $tmpl, \%hash ) or return;
+
+    my ($to, $fh);
+    ### you want us to slurp the contents
+    if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
+        $to = tempdir( 'FileFetch.XXXXXX', CLEANUP => 1 );
+
+    ### plain old fetch
+    } else {
+        $to = $target;
+
+        ### On VMS force to VMS format so File::Spec will work.
+        $to = VMS::Filespec::vmspath($to) if ON_VMS;
+
+        ### create the path if it doesn't exist yet ###
+        unless( -d $to ) {
+            eval { mkpath( $to ) };
+    
+            return $self->_error(loc("Could not create path '%1'",$to)) if $@;
+        }
+    }
+
+    ### set passive ftp if required ###
+    local $ENV{FTP_PASSIVE} = $FTP_PASSIVE;
+
+    ### we dont use catfile on win32 because if we are using a cygwin tool
+    ### under cmd.exe they wont understand windows style separators.
+    my $out_to = ON_WIN ? $to.'/'.$self->output_file 
+                        : File::Spec->catfile( $to, $self->output_file );
+    
+    for my $method ( @{ $METHODS->{$self->scheme} } ) {
+        my $sub =  '_'.$method.'_fetch';
+
+        unless( __PACKAGE__->can($sub) ) {
+            $self->_error(loc("Cannot call method for '%1' -- WEIRD!",
+                        $method));
+            next;
+        }
+
+        ### method is blacklisted ###
+        next if grep { lc $_ eq $method } @$BLACKLIST;
+
+        ### method is known to fail ###
+        next if $METHOD_FAIL->{$method};
+
+        ### there's serious issues with IPC::Run and quoting of command
+        ### line arguments. using quotes in the wrong place breaks things,
+        ### and in the case of say, 
+        ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document
+        ### "index.html" "http://www.cpan.org/index.html?q=1&y=2"
+        ### it doesn't matter how you quote, it always fails.
+        local $IPC::Cmd::USE_IPC_RUN = 0;
+        
+        if( my $file = $self->$sub( 
+                        to => $out_to
+        )){
+
+            unless( -e $file && -s _ ) {
+                $self->_error(loc("'%1' said it fetched '%2', ".
+                     "but it was not created",$method,$file));
+
+                ### mark the failure ###
+                $METHOD_FAIL->{$method} = 1;
+
+                next;
+
+            } else {
+
+                ### slurp mode?
+                if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
+                    
+                    ### open the file
+                    open my $fh, $file or do {
+                        $self->_error(
+                            loc("Could not open '%1': %2", $file, $!));
+                        return;                            
+                    };
+                    
+                    ### slurp
+                    $$target = do { local $/; <$fh> };
+                
+                } 
+
+                my $abs = File::Spec->rel2abs( $file );
+                return $abs;
+
+            }
+        }
+    }
+
+
+    ### if we got here, we looped over all methods, but we weren't able
+    ### to fetch it.
+    return;
+}
+
+########################
+### _*_fetch methods ###
+########################
+
+### LWP fetching ###
+sub _lwp_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### modules required to download with lwp ###
+    my $use_list = {
+        LWP                 => '0.0',
+        'LWP::UserAgent'    => '0.0',
+        'HTTP::Request'     => '0.0',
+        'HTTP::Status'      => '0.0',
+        URI                 => '0.0',
+
+    };
+
+    if( can_load(modules => $use_list) ) {
+
+        ### setup the uri object
+        my $uri = URI->new( File::Spec::Unix->catfile(
+                                    $self->path, $self->file
+                        ) );
+
+        ### special rules apply for file:// uris ###
+        $uri->scheme( $self->scheme );
+        $uri->host( $self->scheme eq 'file' ? '' : $self->host );
+        $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
+
+        ### set up the useragent object
+        my $ua = LWP::UserAgent->new();
+        $ua->timeout( $TIMEOUT ) if $TIMEOUT;
+        $ua->agent( $USER_AGENT );
+        $ua->from( $FROM_EMAIL );
+        $ua->env_proxy;
+
+        my $res = $ua->mirror($uri, $to) or return;
+
+        ### uptodate or fetched ok ###
+        if ( $res->code == 304 or $res->code == 200 ) {
+            return $to;
+
+        } else {
+            return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]",
+                        $res->code, HTTP::Status::status_message($res->code),
+                        $res->status_line));
+        }
+
+    } else {
+        $METHOD_FAIL->{'lwp'} = 1;
+        return;
+    }
+}
+
+### Simple IO::Socket::INET fetching ###
+sub _iosock_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    my $use_list = {
+        'IO::Socket::INET' => '0.0',
+        'IO::Select'       => '0.0',
+    };
+
+    if( can_load(modules => $use_list) ) {
+        my $sock = IO::Socket::INET->new( 
+            PeerHost => $self->host,
+            ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
+        );
+
+        unless ( $sock ) {
+            return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!));
+        }
+
+        my $fh = FileHandle->new;
+
+        # Check open()
+
+        unless ( $fh->open($to,'>') ) {
+            return $self->_error(loc(
+                 "Could not open '%1' for writing: %2",$to,$!));
+        }
+
+        my $path = File::Spec::Unix->catfile( $self->path, $self->file );
+        my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a";
+        $sock->send( $req );
+
+        my $select = IO::Select->new( $sock );
+
+        my $resp = '';
+        my $normal = 0;
+        while ( $select->can_read( $TIMEOUT || 60 ) ) {
+          my $ret = $sock->sysread( $resp, 4096, length($resp) );
+          if ( !defined $ret or $ret == 0 ) {
+            $select->remove( $sock );
+            $normal++;
+          }
+        }
+        close $sock;
+
+        unless ( $normal ) {
+            return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
+        }
+
+        # Check the "response"
+        # Strip preceeding blank lines apparently they are allowed (RFC 2616 4.1)
+        $resp =~ s/^(\x0d?\x0a)+//;
+        # Check it is an HTTP response
+        unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) {
+            return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host));
+        }
+
+        # Check for OK
+        my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;
+        unless ( $code eq '200' ) {
+            return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host));
+        }
+
+        print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
+        close $fh;
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'iosock'} = 1;
+        return;
+    }
+}
+
+### Net::FTP fetching
+sub _netftp_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### required modules ###
+    my $use_list = { 'Net::FTP' => 0 };
+
+    if( can_load( modules => $use_list ) ) {
+
+        ### make connection ###
+        my $ftp;
+        my @options = ($self->host);
+        push(@options, Timeout => $TIMEOUT) if $TIMEOUT;
+        unless( $ftp = Net::FTP->new( @options ) ) {
+            return $self->_error(loc("Ftp creation failed: %1",$@));
+        }
+
+        ### login ###
+        unless( $ftp->login( anonymous => $FROM_EMAIL ) ) {
+            return $self->_error(loc("Could not login to '%1'",$self->host));
+        }
+
+        ### set binary mode, just in case ###
+        $ftp->binary;
+
+        ### create the remote path 
+        ### remember remote paths are unix paths! [#11483]
+        my $remote = File::Spec::Unix->catfile( $self->path, $self->file );
+
+        ### fetch the file ###
+        my $target;
+        unless( $target = $ftp->get( $remote, $to ) ) {
+            return $self->_error(loc("Could not fetch '%1' from '%2'",
+                        $remote, $self->host));
+        }
+
+        ### log out ###
+        $ftp->quit;
+
+        return $target;
+
+    } else {
+        $METHOD_FAIL->{'netftp'} = 1;
+        return;
+    }
+}
+
+### /bin/wget fetch ###
+sub _wget_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### see if we have a wget binary ###
+    if( my $wget = can_run('wget') ) {
+
+        ### no verboseness, thanks ###
+        my $cmd = [ $wget, '--quiet' ];
+
+        ### if a timeout is set, add it ###
+        push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+
+        ### run passive if specified ###
+        push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
+
+        ### set the output document, add the uri ###
+        push @$cmd, '--output-document', $to, $self->uri;
+
+        ### with IPC::Cmd > 0.41, this is fixed in teh library,
+        ### and there's no need for special casing any more.
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        # $IPC::Cmd::USE_IPC_RUN
+        #    ? ($to, $self->uri)
+        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+        ### shell out ###
+        my $captured;
+        unless(run( command => $cmd, 
+                    buffer  => \$captured, 
+                    verbose => $DEBUG  
+        )) {
+            ### wget creates the output document always, even if the fetch
+            ### fails.. so unlink it in that case
+            1 while unlink $to;
+            
+            return $self->_error(loc( "Command failed: %1", $captured || '' ));
+        }
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'wget'} = 1;
+        return;
+    }
+}
+
+### /bin/lftp fetch ###
+sub _lftp_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### see if we have a wget binary ###
+    if( my $lftp = can_run('lftp') ) {
+
+        ### no verboseness, thanks ###
+        my $cmd = [ $lftp, '-f' ];
+
+        my $fh = File::Temp->new;
+        
+        my $str;
+        
+        ### if a timeout is set, add it ###
+        $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
+
+        ### run passive if specified ###
+        $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
+
+        ### set the output document, add the uri ###
+        ### quote the URI, because lftp supports certain shell
+        ### expansions, most notably & for backgrounding.
+        ### ' quote does nto work, must be "
+        $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;
+
+        if( $DEBUG ) {
+            my $pp_str = join ' ', split $/, $str;
+            print "# lftp command: $pp_str\n";
+        }              
+
+        ### write straight to the file.
+        $fh->autoflush(1);
+        print $fh $str;
+
+        ### the command needs to be 1 string to be executed
+        push @$cmd, $fh->filename;
+
+        ### with IPC::Cmd > 0.41, this is fixed in teh library,
+        ### and there's no need for special casing any more.
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        # $IPC::Cmd::USE_IPC_RUN
+        #    ? ($to, $self->uri)
+        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+
+        ### shell out ###
+        my $captured;
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG
+        )) {
+            ### wget creates the output document always, even if the fetch
+            ### fails.. so unlink it in that case
+            1 while unlink $to;
+
+            return $self->_error(loc( "Command failed: %1", $captured || '' ));
+        }
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'lftp'} = 1;
+        return;
+    }
+}
+
+
+
+### /bin/ftp fetch ###
+sub _ftp_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### see if we have a ftp binary ###
+    if( my $ftp = can_run('ftp') ) {
+
+        my $fh = FileHandle->new;
+
+        local $SIG{CHLD} = 'IGNORE';
+
+        unless ($fh->open("|$ftp -n")) {
+            return $self->_error(loc("%1 creation failed: %2", $ftp, $!));
+        }
+
+        my @dialog = (
+            "lcd " . dirname($to),
+            "open " . $self->host,
+            "user anonymous $FROM_EMAIL",
+            "cd /",
+            "cd " . $self->path,
+            "binary",
+            "get " . $self->file . " " . $self->output_file,
+            "quit",
+        );
+
+        foreach (@dialog) { $fh->print($_, "\n") }
+        $fh->close or return;
+
+        return $to;
+    }
+}
+
+### lynx is stupid - it decompresses any .gz file it finds to be text
+### use /bin/lynx to fetch files
+sub _lynx_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### see if we have a lynx binary ###
+    if( my $lynx = can_run('lynx') ) {
+
+        unless( IPC::Cmd->can_capture_buffer ) {
+            $METHOD_FAIL->{'lynx'} = 1;
+
+            return $self->_error(loc( 
+                "Can not capture buffers. Can not use '%1' to fetch files",
+                'lynx' ));
+        }            
+
+        ### check if the HTTP resource exists ###
+        if ($self->uri =~ /^https?:\/\//i) {
+            my $cmd = [
+                $lynx,
+                '-head',
+                '-source',
+                "-auth=anonymous:$FROM_EMAIL",
+            ];
+
+            push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
+
+            push @$cmd, $self->uri;
+
+            ### shell out ###
+            my $head;
+            unless(run( command => $cmd,
+                        buffer  => \$head,
+                        verbose => $DEBUG )
+            ) {
+                return $self->_error(loc("Command failed: %1", $head || ''));
+            }
+
+            unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) {
+                return $self->_error(loc("Command failed: %1", $head || ''));
+            }
+        }
+
+        ### write to the output file ourselves, since lynx ass_u_mes to much
+        my $local = FileHandle->new(">$to")
+                        or return $self->_error(loc(
+                            "Could not open '%1' for writing: %2",$to,$!));
+
+        ### dump to stdout ###
+        my $cmd = [
+            $lynx,
+            '-source',
+            "-auth=anonymous:$FROM_EMAIL",
+        ];
+
+        push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
+
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        push @$cmd, $self->uri;
+        
+        ### with IPC::Cmd > 0.41, this is fixed in teh library,
+        ### and there's no need for special casing any more.
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        # $IPC::Cmd::USE_IPC_RUN
+        #    ? $self->uri
+        #    : QUOTE. $self->uri .QUOTE;
+
+
+        ### shell out ###
+        my $captured;
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG )
+        ) {
+            return $self->_error(loc("Command failed: %1", $captured || ''));
+        }
+
+        ### print to local file ###
+        ### XXX on a 404 with a special error page, $captured will actually
+        ### hold the contents of that page, and make it *appear* like the
+        ### request was a success, when really it wasn't :(
+        ### there doesn't seem to be an option for lynx to change the exit
+        ### code based on a 4XX status or so.
+        ### the closest we can come is using --error_file and parsing that,
+        ### which is very unreliable ;(
+        $local->print( $captured );
+        $local->close or return;
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'lynx'} = 1;
+        return;
+    }
+}
+
+### use /bin/ncftp to fetch files
+sub _ncftp_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    ### we can only set passive mode in interactive sesssions, so bail out
+    ### if $FTP_PASSIVE is set
+    return if $FTP_PASSIVE;
+
+    ### see if we have a ncftp binary ###
+    if( my $ncftp = can_run('ncftp') ) {
+
+        my $cmd = [
+            $ncftp,
+            '-V',                   # do not be verbose
+            '-p', $FROM_EMAIL,      # email as password
+            $self->host,            # hostname
+            dirname($to),           # local dir for the file
+                                    # remote path to the file
+            ### DO NOT quote things for IPC::Run, it breaks stuff.
+            $IPC::Cmd::USE_IPC_RUN
+                        ? File::Spec::Unix->catdir( $self->path, $self->file )
+                        : QUOTE. File::Spec::Unix->catdir( 
+                                        $self->path, $self->file ) .QUOTE
+            
+        ];
+
+        ### shell out ###
+        my $captured;
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG )
+        ) {
+            return $self->_error(loc("Command failed: %1", $captured || ''));
+        }
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'ncftp'} = 1;
+        return;
+    }
+}
+
+### use /bin/curl to fetch files
+sub _curl_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    if (my $curl = can_run('curl')) {
+
+        ### these long opts are self explanatory - I like that -jmb
+	    my $cmd = [ $curl, '-q' ];
+
+	    push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;
+
+	    push(@$cmd, '--silent') unless $DEBUG;
+
+        ### curl does the right thing with passive, regardless ###
+    	if ($self->scheme eq 'ftp') {
+    		push(@$cmd, '--user', "anonymous:$FROM_EMAIL");
+    	}
+
+        ### curl doesn't follow 302 (temporarily moved) etc automatically
+        ### so we add --location to enable that.
+        push @$cmd, '--fail', '--location', '--output', $to, $self->uri;
+
+        ### with IPC::Cmd > 0.41, this is fixed in teh library,
+        ### and there's no need for special casing any more.
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        # $IPC::Cmd::USE_IPC_RUN
+        #    ? ($to, $self->uri)
+        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+
+        my $captured;
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG )
+        ) {
+
+            return $self->_error(loc("Command failed: %1", $captured || ''));
+        }
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'curl'} = 1;
+        return;
+    }
+}
+
+
+### use File::Copy for fetching file:// urls ###
+###
+### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html)
+### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://)
+###
+    
+sub _file_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    
+    
+    ### prefix a / on unix systems with a file uri, since it would
+    ### look somewhat like this:
+    ###     file:///home/kane/file
+    ### wheras windows file uris for 'c:\some\dir\file' might look like:
+    ###     file:///C:/some/dir/file
+    ###     file:///C|/some/dir/file
+    ### or for a network share '\\host\share\some\dir\file':
+    ###     file:////host/share/some/dir/file
+    ###    
+    ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like:
+    ###     file://vms.host.edu/disk$user/my/notes/note12345.txt
+    ###
+    
+    my $path    = $self->path;
+    my $vol     = $self->vol;
+    my $share   = $self->share;
+
+    my $remote;
+    if (!$share and $self->host) {
+        return $self->_error(loc( 
+            "Currently %1 cannot handle hosts in %2 urls",
+            'File::Fetch', 'file://'
+        ));            
+    }
+    
+    if( $vol ) {
+        $path   = File::Spec->catdir( split /\//, $path );
+        $remote = File::Spec->catpath( $vol, $path, $self->file);
+
+    } elsif( $share ) {
+        ### win32 specific, and a share name, so we wont bother with File::Spec
+        $path   =~ s|/+|\\|g;
+        $remote = "\\\\".$self->host."\\$share\\$path";
+
+    } else {
+        ### File::Spec on VMS can not currently handle UNIX syntax.
+        my $file_class = ON_VMS
+            ? 'File::Spec::Unix'
+            : 'File::Spec';
+
+        $remote  = $file_class->catfile( $path, $self->file );
+    }
+
+    ### File::Copy is littered with 'die' statements :( ###
+    my $rv = eval { File::Copy::copy( $remote, $to ) };
+
+    ### something went wrong ###
+    if( !$rv or $@ ) {
+        return $self->_error(loc("Could not copy '%1' to '%2': %3 %4",
+                             $remote, $to, $!, $@));
+    }
+
+    return $to;
+}
+
+### use /usr/bin/rsync to fetch files
+sub _rsync_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    if (my $rsync = can_run('rsync')) {
+
+        my $cmd = [ $rsync ];
+
+        ### XXX: rsync has no I/O timeouts at all, by default
+        push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+
+        push(@$cmd, '--quiet') unless $DEBUG;
+
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        push @$cmd, $self->uri, $to;
+
+        ### with IPC::Cmd > 0.41, this is fixed in teh library,
+        ### and there's no need for special casing any more.
+        ### DO NOT quote things for IPC::Run, it breaks stuff.
+        # $IPC::Cmd::USE_IPC_RUN
+        #    ? ($to, $self->uri)
+        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+        my $captured;
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG )
+        ) {
+
+            return $self->_error(loc("Command %1 failed: %2", 
+                "@$cmd" || '', $captured || ''));
+        }
+
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'rsync'} = 1;
+        return;
+    }
+}
+
+#################################
+#
+# Error code
+#
+#################################
+
+=pod
+
+=head2 $ff->error([BOOL])
+
+Returns the last encountered error as string.
+Pass it a true value to get the C<Carp::longmess()> output instead.
+
+=cut
+
+### error handling the way Archive::Extract does it
+sub _error {
+    my $self    = shift;
+    my $error   = shift;
+    
+    $self->_error_msg( $error );
+    $self->_error_msg_long( Carp::longmess($error) );
+    
+    if( $WARN ) {
+        carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
+    }
+
+    return;
+}
+
+sub error {
+    my $self = shift;
+    return shift() ? $self->_error_msg_long : $self->_error_msg;
+}
+
+
+1;
+
+=pod
+
+=head1 HOW IT WORKS
+
+File::Fetch is able to fetch a variety of uris, by using several
+external programs and modules.
+
+Below is a mapping of what utilities will be used in what order
+for what schemes, if available:
+
+    file    => LWP, lftp, file
+    http    => LWP, wget, curl, lftp, lynx, iosock
+    ftp     => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
+    rsync   => rsync
+
+If you'd like to disable the use of one or more of these utilities
+and/or modules, see the C<$BLACKLIST> variable further down.
+
+If a utility or module isn't available, it will be marked in a cache
+(see the C<$METHOD_FAIL> variable further down), so it will not be
+tried again. The C<fetch> method will only fail when all options are
+exhausted, and it was not able to retrieve the file.
+
+C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
+retrieving C<http> schemed urls. It doesn't follow redirects for instance.
+
+A special note about fetching files from an ftp uri:
+
+By default, all ftp connections are done in passive mode. To change
+that, see the C<$FTP_PASSIVE> variable further down.
+
+Furthermore, ftp uris only support anonymous connections, so no
+named user/password pair can be passed along.
+
+C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable
+further down.
+
+=head1 GLOBAL VARIABLES
+
+The behaviour of File::Fetch can be altered by changing the following
+global variables:
+
+=head2 $File::Fetch::FROM_EMAIL
+
+This is the email address that will be sent as your anonymous ftp
+password.
+
+Default is C<File-Fetch@example.com>.
+
+=head2 $File::Fetch::USER_AGENT
+
+This is the useragent as C<LWP> will report it.
+
+Default is C<File::Fetch/$VERSION>.
+
+=head2 $File::Fetch::FTP_PASSIVE
+
+This variable controls whether the environment variable C<FTP_PASSIVE>
+and any passive switches to commandline tools will be set to true.
+
+Default value is 1.
+
+Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch
+files, since passive mode can only be set interactively for this binary
+
+=head2 $File::Fetch::TIMEOUT
+
+When set, controls the network timeout (counted in seconds).
+
+Default value is 0.
+
+=head2 $File::Fetch::WARN
+
+This variable controls whether errors encountered internally by
+C<File::Fetch> should be C<carp>'d or not.
+
+Set to false to silence warnings. Inspect the output of the C<error()>
+method manually to see what went wrong.
+
+Defaults to C<true>.
+
+=head2 $File::Fetch::DEBUG
+
+This enables debugging output when calling commandline utilities to
+fetch files.
+This also enables C<Carp::longmess> errors, instead of the regular
+C<carp> errors.
+
+Good for tracking down why things don't work with your particular
+setup.
+
+Default is 0.
+
+=head2 $File::Fetch::BLACKLIST
+
+This is an array ref holding blacklisted modules/utilities for fetching
+files with.
+
+To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could
+set $File::Fetch::BLACKLIST to:
+
+    $File::Fetch::BLACKLIST = [qw|lwp netftp|]
+
+The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable.
+
+See the note on C<MAPPING> below.
+
+=head2 $File::Fetch::METHOD_FAIL
+
+This is a hashref registering what modules/utilities were known to fail
+for fetching files (mostly because they weren't installed).
+
+You can reset this cache by assigning an empty hashref to it, or
+individually remove keys.
+
+See the note on C<MAPPING> below.
+
+=head1 MAPPING
+
+
+Here's a quick mapping for the utilities/modules, and their names for
+the $BLACKLIST, $METHOD_FAIL and other internal functions.
+
+    LWP         => lwp
+    Net::FTP    => netftp
+    wget        => wget
+    lynx        => lynx
+    ncftp       => ncftp
+    ftp         => ftp
+    curl        => curl
+    rsync       => rsync
+    lftp        => lftp
+    IO::Socket  => iosock
+
+=head1 FREQUENTLY ASKED QUESTIONS
+
+=head2 So how do I use a proxy with File::Fetch?
+
+C<File::Fetch> currently only supports proxies with LWP::UserAgent.
+You will need to set your environment variables accordingly. For
+example, to use an ftp proxy:
+
+    $ENV{ftp_proxy} = 'foo.com';
+
+Refer to the LWP::UserAgent manpage for more details.
+
+=head2 I used 'lynx' to fetch a file, but its contents is all wrong!
+
+C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>,
+which we in turn capture. If that content is a 'custom' error file
+(like, say, a C<404 handler>), you will get that contents instead.
+
+Sadly, C<lynx> doesn't support any options to return a different exit
+code on non-C<200 OK> status, giving us no way to tell the difference
+between a 'successfull' fetch and a custom error page.
+
+Therefor, we recommend to only use C<lynx> as a last resort. This is 
+why it is at the back of our list of methods to try as well.
+
+=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
+
+C<File::Fetch> is relatively smart about things. When trying to write 
+a file to disk, it removes the C<query parameters> (see the 
+C<output_file> method for details) from the file name before creating
+it. In most cases this suffices.
+
+If you have any other characters you need to escape, please install 
+the C<URI::Escape> module from CPAN, and pre-encode your URI before
+passing it to C<File::Fetch>. You can read about the details of URIs 
+and URI encoding here:
+
+  http://www.faqs.org/rfcs/rfc2396.html
+
+=head1 TODO
+
+=over 4
+
+=item Implement $PREFER_BIN
+
+To indicate to rather use commandline tools than modules
+
+=back
+
+=head1 BUG REPORTS
+
+Please report bugs or other issues to E<lt>bug-file-fetch@rt.cpan.org<gt>.
+
+=head1 AUTHOR
+
+This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+This library is free software; you may redistribute and/or modify it 
+under the same terms as Perl itself.
+
+
+=cut
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
+
+
+
+
diff --git a/Master/tlpkg/tlperl/lib/File/Find.pm b/Master/tlpkg/tlperl/lib/File/Find.pm
new file mode 100644
index 00000000000..e72f3e32b30
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Find.pm
@@ -0,0 +1,1349 @@
+package File::Find;
+use 5.006;
+use strict;
+use warnings;
+use warnings::register;
+our $VERSION = '1.15';
+require Exporter;
+require Cwd;
+
+#
+# Modified to ensure sub-directory traversal order is not inverded by stack
+# push and pops.  That is remains in the same order as in the directory file,
+# or user pre-processing (EG:sorted).
+#
+
+=head1 NAME
+
+File::Find - Traverse a directory tree.
+
+=head1 SYNOPSIS
+
+    use File::Find;
+    find(\&wanted, @directories_to_search);
+    sub wanted { ... }
+
+    use File::Find;
+    finddepth(\&wanted, @directories_to_search);
+    sub wanted { ... }
+
+    use File::Find;
+    find({ wanted => \&process, follow => 1 }, '.');
+
+=head1 DESCRIPTION
+
+These are functions for searching through directory trees doing work
+on each file found similar to the Unix I<find> command.  File::Find
+exports two functions, C<find> and C<finddepth>.  They work similarly
+but have subtle differences.
+
+=over 4
+
+=item B<find>
+
+  find(\&wanted,  @directories);
+  find(\%options, @directories);
+
+C<find()> does a depth-first search over the given C<@directories> in
+the order they are given.  For each file or directory found, it calls
+the C<&wanted> subroutine.  (See below for details on how to use the
+C<&wanted> function).  Additionally, for each directory found, it will
+C<chdir()> into that directory and continue the search, invoking the
+C<&wanted> function on each file or subdirectory in the directory.
+
+=item B<finddepth>
+
+  finddepth(\&wanted,  @directories);
+  finddepth(\%options, @directories);
+
+C<finddepth()> works just like C<find()> except that it invokes the
+C<&wanted> function for a directory I<after> invoking it for the
+directory's contents.  It does a postorder traversal instead of a
+preorder traversal, working from the bottom of the directory tree up
+where C<find()> works from the top of the tree down.
+
+=back
+
+=head2 %options
+
+The first argument to C<find()> is either a code reference to your
+C<&wanted> function, or a hash reference describing the operations
+to be performed for each file.  The
+code reference is described in L<The wanted function> below.
+
+Here are the possible keys for the hash:
+
+=over 3
+
+=item C<wanted>
+
+The value should be a code reference.  This code reference is
+described in L<The wanted function> below. The C<&wanted> subroutine is
+mandatory.
+
+=item C<bydepth>
+
+Reports the name of a directory only AFTER all its entries
+have been reported.  Entry point C<finddepth()> is a shortcut for
+specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
+
+=item C<preprocess>
+
+The value should be a code reference. This code reference is used to
+preprocess the current directory. The name of the currently processed
+directory is in C<$File::Find::dir>. Your preprocessing function is
+called after C<readdir()>, but before the loop that calls the C<wanted()>
+function. It is called with a list of strings (actually file/directory
+names) and is expected to return a list of strings. The code can be
+used to sort the file/directory names alphabetically, numerically,
+or to filter out directory entries based on their name alone. When
+I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
+
+=item C<postprocess>
+
+The value should be a code reference. It is invoked just before leaving
+the currently processed directory. It is called in void context with no
+arguments. The name of the current directory is in C<$File::Find::dir>. This
+hook is handy for summarizing a directory, such as calculating its disk
+usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
+no-op.
+
+=item C<follow>
+
+Causes symbolic links to be followed. Since directory trees with symbolic
+links (followed) may contain files more than once and may even have
+cycles, a hash has to be built up with an entry for each file.
+This might be expensive both in space and time for a large
+directory tree. See I<follow_fast> and I<follow_skip> below.
+If either I<follow> or I<follow_fast> is in effect:
+
+=over 6
+
+=item *
+
+It is guaranteed that an I<lstat> has been called before the user's
+C<wanted()> function is called. This enables fast file checks involving S<_>.
+Note that this guarantee no longer holds if I<follow> or I<follow_fast>
+are not set.
+
+=item *
+
+There is a variable C<$File::Find::fullname> which holds the absolute
+pathname of the file with all symbolic links resolved.  If the link is
+a dangling symbolic link, then fullname will be set to C<undef>.
+
+=back
+
+This is a no-op on Win32.
+
+=item C<follow_fast>
+
+This is similar to I<follow> except that it may report some files more
+than once.  It does detect cycles, however.  Since only symbolic links
+have to be hashed, this is much cheaper both in space and time.  If
+processing a file more than once (by the user's C<wanted()> function)
+is worse than just taking time, the option I<follow> should be used.
+
+This is also a no-op on Win32.
+
+=item C<follow_skip>
+
+C<follow_skip==1>, which is the default, causes all files which are
+neither directories nor symbolic links to be ignored if they are about
+to be processed a second time. If a directory or a symbolic link
+are about to be processed a second time, File::Find dies.
+
+C<follow_skip==0> causes File::Find to die if any file is about to be
+processed a second time.
+
+C<follow_skip==2> causes File::Find to ignore any duplicate files and
+directories but to proceed normally otherwise.
+
+=item C<dangling_symlinks>
+
+If true and a code reference, will be called with the symbolic link
+name and the directory it lives in as arguments.  Otherwise, if true
+and warnings are on, warning "symbolic_link_name is a dangling
+symbolic link\n" will be issued.  If false, the dangling symbolic link
+will be silently ignored.
+
+=item C<no_chdir>
+
+Does not C<chdir()> to each directory as it recurses. The C<wanted()>
+function will need to be aware of this, of course. In this case,
+C<$_> will be the same as C<$File::Find::name>.
+
+=item C<untaint>
+
+If find is used in taint-mode (-T command line switch or if EUID != UID
+or if EGID != GID) then internally directory names have to be untainted
+before they can be chdir'ed to. Therefore they are checked against a regular
+expression I<untaint_pattern>.  Note that all names passed to the user's
+I<wanted()> function are still tainted. If this option is used while
+not in taint-mode, C<untaint> is a no-op.
+
+=item C<untaint_pattern>
+
+See above. This should be set using the C<qr> quoting operator.
+The default is set to  C<qr|^([-+@\w./]+)$|>.
+Note that the parentheses are vital.
+
+=item C<untaint_skip>
+
+If set, a directory which fails the I<untaint_pattern> is skipped,
+including all its sub-directories. The default is to 'die' in such a case.
+
+=back
+
+=head2 The wanted function
+
+The C<wanted()> function does whatever verifications you want on
+each file and directory.  Note that despite its name, the C<wanted()>
+function is a generic callback function, and does B<not> tell
+File::Find if a file is "wanted" or not.  In fact, its return value
+is ignored.
+
+The wanted function takes no arguments but rather does its work
+through a collection of variables.
+
+=over 4
+
+=item C<$File::Find::dir> is the current directory name,
+
+=item C<$_> is the current filename within that directory
+
+=item C<$File::Find::name> is the complete pathname to the file.
+
+=back
+
+The above variables have all been localized and may be changed without
+affecting data outside of the wanted function.
+
+For example, when examining the file F</some/path/foo.ext> you will have:
+
+    $File::Find::dir  = /some/path/
+    $_                = foo.ext
+    $File::Find::name = /some/path/foo.ext
+
+You are chdir()'d to C<$File::Find::dir> when the function is called,
+unless C<no_chdir> was specified. Note that when changing to
+directories is in effect the root directory (F</>) is a somewhat
+special case inasmuch as the concatenation of C<$File::Find::dir>,
+C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
+table below summarizes all variants:
+
+              $File::Find::name  $File::Find::dir  $_
+ default      /                  /                 .
+ no_chdir=>0  /etc               /                 etc
+              /etc/x             /etc              x
+
+ no_chdir=>1  /                  /                 /
+              /etc               /                 /etc
+              /etc/x             /etc              /etc/x
+
+
+When C<follow> or C<follow_fast> are in effect, there is
+also a C<$File::Find::fullname>.  The function may set
+C<$File::Find::prune> to prune the tree unless C<bydepth> was
+specified.  Unless C<follow> or C<follow_fast> is specified, for
+compatibility reasons (find.pl, find2perl) there are in addition the
+following globals available: C<$File::Find::topdir>,
+C<$File::Find::topdev>, C<$File::Find::topino>,
+C<$File::Find::topmode> and C<$File::Find::topnlink>.
+
+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.*\z/s &&
+        (($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);
+    }
+
+Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
+filehandle that caches the information from the preceding
+C<stat()>, C<lstat()>, or filetest.
+
+Here's another interesting wanted function.  It will find all symbolic
+links that don't resolve:
+
+    sub wanted {
+         -l && !-e && print "bogus link: $File::Find::name\n";
+    }
+
+See also the script C<pfind> on CPAN for a nice application of this
+module.
+
+=head1 WARNINGS
+
+If you run your program with the C<-w> switch, or if you use the
+C<warnings> pragma, File::Find will report warnings for several weird
+situations. You can disable these warnings by putting the statement
+
+    no warnings 'File::Find';
+
+in the appropriate scope. See L<perllexwarn> for more info about lexical
+warnings.
+
+=head1 CAVEAT
+
+=over 2
+
+=item $dont_use_nlink
+
+You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
+force File::Find to always stat directories. This was used for file systems
+that do not have an C<nlink> count matching the number of sub-directories.
+Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
+system) and a couple of others.
+
+You shouldn't need to set this variable, since File::Find should now detect
+such file systems on-the-fly and switch itself to using stat. This works even
+for parts of your file system, like a mounted CD-ROM.
+
+If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
+
+=item symlinks
+
+Be aware that the option to follow symbolic links can be dangerous.
+Depending on the structure of the directory tree (including symbolic
+links to directories) you might traverse a given (physical) directory
+more than once (only if C<follow_fast> is in effect).
+Furthermore, deleting or changing files in a symbolically linked directory
+might cause very unpleasant surprises, since you delete or change files
+in an unknown directory.
+
+=back
+
+=head1 NOTES
+
+=over 4
+
+=item *
+
+Mac OS (Classic) users should note a few differences:
+
+=over 4
+
+=item *
+
+The path separator is ':', not '/', and the current directory is denoted
+as ':', not '.'. You should be careful about specifying relative pathnames.
+While a full path always begins with a volume name, a relative pathname
+should always begin with a ':'.  If specifying a volume name only, a
+trailing ':' is required.
+
+=item *
+
+C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
+contains the name of a directory, that name may or may not end with a
+':'. Likewise, C<$File::Find::name>, which contains the complete
+pathname to that directory, and C<$File::Find::fullname>, which holds
+the absolute pathname of that directory with all symbolic links resolved,
+may or may not end with a ':'.
+
+=item *
+
+The default C<untaint_pattern> (see above) on Mac OS is set to
+C<qr|^(.+)$|>. Note that the parentheses are vital.
+
+=item *
+
+The invisible system file "Icon\015" is ignored. While this file may
+appear in every directory, there are some more invisible system files
+on every volume, which are all located at the volume root level (i.e.
+"MacintoshHD:"). These system files are B<not> excluded automatically.
+Your filter may use the following code to recognize invisible files or
+directories (requires Mac::Files):
+
+ use Mac::Files;
+
+ # invisible() --  returns 1 if file/directory is invisible,
+ # 0 if it's visible or undef if an error occurred
+
+ sub invisible($) {
+   my $file = shift;
+   my ($fileCat, $fileInfo);
+   my $invisible_flag =  1 << 14;
+
+   if ( $fileCat = FSpGetCatInfo($file) ) {
+     if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
+       return (($fileInfo->fdFlags & $invisible_flag) && 1);
+     }
+   }
+   return undef;
+ }
+
+Generally, invisible files are system files, unless an odd application
+decides to use invisible files for its own purposes. To distinguish
+such files from system files, you have to look at the B<type> and B<creator>
+file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
+C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
+(see MacPerl.pm for details).
+
+Files that appear on the desktop actually reside in an (hidden) directory
+named "Desktop Folder" on the particular disk volume. Note that, although
+all desktop files appear to be on the same "virtual" desktop, each disk
+volume actually maintains its own "Desktop Folder" directory.
+
+=back
+
+=back
+
+=head1 BUGS AND CAVEATS
+
+Despite the name of the C<finddepth()> function, both C<find()> and
+C<finddepth()> perform a depth-first search of the directory
+hierarchy.
+
+=head1 HISTORY
+
+File::Find used to produce incorrect results if called recursively.
+During the development of perl 5.8 this bug was fixed.
+The first fixed version of File::Find was 1.01.
+
+=head1 SEE ALSO
+
+find, find2perl.
+
+=cut
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(find finddepth);
+
+
+use strict;
+my $Is_VMS;
+my $Is_MacOS;
+
+require File::Basename;
+require File::Spec;
+
+# Should ideally be my() not our() but local() currently
+# refuses to operate on lexicals
+
+our %SLnkSeen;
+our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
+    $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
+    $pre_process, $post_process, $dangling_symlinks);
+
+sub contract_name {
+    my ($cdir,$fn) = @_;
+
+    return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
+
+    $cdir = substr($cdir,0,rindex($cdir,'/')+1);
+
+    $fn =~ s|^\./||;
+
+    my $abs_name= $cdir . $fn;
+
+    if (substr($fn,0,3) eq '../') {
+       1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
+    }
+
+    return $abs_name;
+}
+
+# return the absolute name of a directory or file
+sub contract_name_Mac {
+    my ($cdir,$fn) = @_;
+    my $abs_name;
+
+    if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
+
+	my $colon_count = length ($1);
+	if ($colon_count == 1) {
+	    $abs_name = $cdir . $2;
+	    return $abs_name;
+	}
+	else {
+	    # need to move up the tree, but
+	    # only if it's not a volume name
+	    for (my $i=1; $i<$colon_count; $i++) {
+		unless ($cdir =~ /^[^:]+:$/) { # volume name
+		    $cdir =~ s/[^:]+:$//;
+		}
+		else {
+		    return undef;
+		}
+	    }
+	    $abs_name = $cdir . $2;
+	    return $abs_name;
+	}
+
+    }
+    else {
+
+	# $fn may be a valid path to a directory or file or (dangling)
+	# symlink, without a leading ':'
+	if ( (-e $fn) || (-l $fn) ) {
+	    if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
+		return $fn; # $fn is already an absolute path
+	    }
+	    else {
+		$abs_name = $cdir . $fn;
+		return $abs_name;
+	    }
+	}
+	else { # argh!, $fn is not a valid directory/file
+	     return undef;
+	}
+    }
+}
+
+sub PathCombine($$) {
+    my ($Base,$Name) = @_;
+    my $AbsName;
+
+    if ($Is_MacOS) {
+	# $Name is the resolved symlink (always a full path on MacOS),
+	# i.e. there's no need to call contract_name_Mac()
+	$AbsName = $Name;
+
+	# (simple) check for recursion
+	if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
+	    return undef;
+	}
+    }
+    else {
+	if (substr($Name,0,1) eq '/') {
+	    $AbsName= $Name;
+	}
+	else {
+	    $AbsName= contract_name($Base,$Name);
+	}
+
+	# (simple) check for recursion
+	my $newlen= length($AbsName);
+	if ($newlen <= length($Base)) {
+	    if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
+		&& $AbsName eq substr($Base,0,$newlen))
+	    {
+		return undef;
+	    }
+	}
+    }
+    return $AbsName;
+}
+
+sub Follow_SymLink($) {
+    my ($AbsName) = @_;
+
+    my ($NewName,$DEV, $INO);
+    ($DEV, $INO)= lstat $AbsName;
+
+    while (-l _) {
+	if ($SLnkSeen{$DEV, $INO}++) {
+	    if ($follow_skip < 2) {
+		die "$AbsName is encountered a second time";
+	    }
+	    else {
+		return undef;
+	    }
+	}
+	$NewName= PathCombine($AbsName, readlink($AbsName));
+	unless(defined $NewName) {
+	    if ($follow_skip < 2) {
+		die "$AbsName is a recursive symbolic link";
+	    }
+	    else {
+		return undef;
+	    }
+	}
+	else {
+	    $AbsName= $NewName;
+	}
+	($DEV, $INO) = lstat($AbsName);
+	return undef unless defined $DEV;  #  dangling symbolic link
+    }
+
+    if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
+	if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
+	    die "$AbsName encountered a second time";
+	}
+	else {
+	    return undef;
+	}
+    }
+
+    return $AbsName;
+}
+
+our($dir, $name, $fullname, $prune);
+sub _find_dir_symlnk($$$);
+sub _find_dir($$$);
+
+# check whether or not a scalar variable is tainted
+# (code straight from the Camel, 3rd ed., page 561)
+sub is_tainted_pp {
+    my $arg = shift;
+    my $nada = substr($arg, 0, 0); # zero-length
+    local $@;
+    eval { eval "# $nada" };
+    return length($@) != 0;
+}
+
+sub _find_opt {
+    my $wanted = shift;
+    die "invalid top directory" unless defined $_[0];
+
+    # This function must local()ize everything because callbacks may
+    # call find() or finddepth()
+
+    local %SLnkSeen;
+    local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
+	$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
+	$pre_process, $post_process, $dangling_symlinks);
+    local($dir, $name, $fullname, $prune);
+    local *_ = \my $a;
+
+    my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
+    if ($Is_VMS) {
+	# VMS returns this by default in VMS format which just doesn't
+	# work for the rest of this module.
+	$cwd = VMS::Filespec::unixpath($cwd);
+
+	# Apparently this is not expected to have a trailing space.
+	# To attempt to make VMS/UNIX conversions mostly reversable,
+	# a trailing slash is needed.  The run-time functions ignore the
+	# resulting double slash, but it causes the perl tests to fail.
+        $cwd =~ s#/\z##;
+
+	# This comes up in upper case now, but should be lower.
+	# In the future this could be exact case, no need to change.
+    }
+    my $cwd_untainted  = $cwd;
+    my $check_t_cwd    = 1;
+    $wanted_callback   = $wanted->{wanted};
+    $bydepth           = $wanted->{bydepth};
+    $pre_process       = $wanted->{preprocess};
+    $post_process      = $wanted->{postprocess};
+    $no_chdir          = $wanted->{no_chdir};
+    $full_check        = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
+    $follow            = $^O eq 'MSWin32' ? 0 :
+                             $full_check || $wanted->{follow_fast};
+    $follow_skip       = $wanted->{follow_skip};
+    $untaint           = $wanted->{untaint};
+    $untaint_pat       = $wanted->{untaint_pattern};
+    $untaint_skip      = $wanted->{untaint_skip};
+    $dangling_symlinks = $wanted->{dangling_symlinks};
+
+    # for compatibility reasons (find.pl, find2perl)
+    local our ($topdir, $topdev, $topino, $topmode, $topnlink);
+
+    # a symbolic link to a directory doesn't increase the link count
+    $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
+
+    my ($abs_dir, $Is_Dir);
+
+    Proc_Top_Item:
+    foreach my $TOP (@_) {
+	my $top_item = $TOP;
+
+	($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
+
+	if ($Is_MacOS) {
+	    $top_item = ":$top_item"
+		if ( (-d _) && ( $top_item !~ /:/ ) );
+	} elsif ($^O eq 'MSWin32') {
+	    $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
+	}
+	else {
+	    $top_item =~ s|/\z|| unless $top_item eq '/';
+	}
+
+	$Is_Dir= 0;
+
+	if ($follow) {
+
+	    if ($Is_MacOS) {
+		$cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
+
+		if ($top_item eq $File::Find::current_dir) {
+		    $abs_dir = $cwd;
+		}
+		else {
+		    $abs_dir = contract_name_Mac($cwd, $top_item);
+		    unless (defined $abs_dir) {
+			warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
+			next Proc_Top_Item;
+		    }
+		}
+
+	    }
+	    else {
+		if (substr($top_item,0,1) eq '/') {
+		    $abs_dir = $top_item;
+		}
+		elsif ($top_item eq $File::Find::current_dir) {
+		    $abs_dir = $cwd;
+		}
+		else {  # care about any  ../
+		    $top_item =~ s/\.dir\z//i if $Is_VMS;
+		    $abs_dir = contract_name("$cwd/",$top_item);
+		}
+	    }
+	    $abs_dir= Follow_SymLink($abs_dir);
+	    unless (defined $abs_dir) {
+		if ($dangling_symlinks) {
+		    if (ref $dangling_symlinks eq 'CODE') {
+			$dangling_symlinks->($top_item, $cwd);
+		    } else {
+			warnings::warnif "$top_item is a dangling symbolic link\n";
+		    }
+		}
+		next Proc_Top_Item;
+	    }
+
+	    if (-d _) {
+		$top_item =~ s/\.dir\z//i if $Is_VMS;
+		_find_dir_symlnk($wanted, $abs_dir, $top_item);
+		$Is_Dir= 1;
+	    }
+	}
+	else { # no follow
+	    $topdir = $top_item;
+	    unless (defined $topnlink) {
+		warnings::warnif "Can't stat $top_item: $!\n";
+		next Proc_Top_Item;
+	    }
+	    if (-d _) {
+		$top_item =~ s/\.dir\z//i if $Is_VMS;
+		_find_dir($wanted, $top_item, $topnlink);
+		$Is_Dir= 1;
+	    }
+	    else {
+		$abs_dir= $top_item;
+	    }
+	}
+
+	unless ($Is_Dir) {
+	    unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
+		if ($Is_MacOS) {
+		    ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
+		}
+		else {
+		    ($dir,$_) = ('./', $top_item);
+		}
+	    }
+
+	    $abs_dir = $dir;
+	    if (( $untaint ) && (is_tainted($dir) )) {
+		( $abs_dir ) = $dir =~ m|$untaint_pat|;
+		unless (defined $abs_dir) {
+		    if ($untaint_skip == 0) {
+			die "directory $dir is still tainted";
+		    }
+		    else {
+			next Proc_Top_Item;
+		    }
+		}
+	    }
+
+	    unless ($no_chdir || chdir $abs_dir) {
+		warnings::warnif "Couldn't chdir $abs_dir: $!\n";
+		next Proc_Top_Item;
+	    }
+
+	    $name = $abs_dir . $_; # $File::Find::name
+	    $_ = $name if $no_chdir;
+
+	    { $wanted_callback->() }; # protect against wild "next"
+
+	}
+
+	unless ( $no_chdir ) {
+	    if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
+		( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
+		unless (defined $cwd_untainted) {
+		    die "insecure cwd in find(depth)";
+		}
+		$check_t_cwd = 0;
+	    }
+	    unless (chdir $cwd_untainted) {
+		die "Can't cd to $cwd: $!\n";
+	    }
+	}
+    }
+}
+
+# API:
+#  $wanted
+#  $p_dir :  "parent directory"
+#  $nlink :  what came back from the stat
+# preconditions:
+#  chdir (if not no_chdir) to dir
+
+sub _find_dir($$$) {
+    my ($wanted, $p_dir, $nlink) = @_;
+    my ($CdLvl,$Level) = (0,0);
+    my @Stack;
+    my @filenames;
+    my ($subcount,$sub_nlink);
+    my $SE= [];
+    my $dir_name= $p_dir;
+    my $dir_pref;
+    my $dir_rel = $File::Find::current_dir;
+    my $tainted = 0;
+    my $no_nlink;
+
+    if ($Is_MacOS) {
+	$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
+    } elsif ($^O eq 'MSWin32') {
+	$dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
+    } elsif ($^O eq 'VMS') {
+
+	#	VMS is returning trailing .dir on directories
+	#	and trailing . on files and symbolic links
+	#	in UNIX syntax.
+	#
+
+	$p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
+
+	$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
+    }
+    else {
+	$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
+    }
+
+    local ($dir, $name, $prune, *DIR);
+
+    unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
+	my $udir = $p_dir;
+	if (( $untaint ) && (is_tainted($p_dir) )) {
+	    ( $udir ) = $p_dir =~ m|$untaint_pat|;
+	    unless (defined $udir) {
+		if ($untaint_skip == 0) {
+		    die "directory $p_dir is still tainted";
+		}
+		else {
+		    return;
+		}
+	    }
+	}
+	unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
+	    warnings::warnif "Can't cd to $udir: $!\n";
+	    return;
+	}
+    }
+
+    # push the starting directory
+    push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
+
+    if ($Is_MacOS) {
+	$p_dir = $dir_pref;  # ensure trailing ':'
+    }
+
+    while (defined $SE) {
+	unless ($bydepth) {
+	    $dir= $p_dir; # $File::Find::dir
+	    $name= $dir_name; # $File::Find::name
+	    $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
+	    # prune may happen here
+	    $prune= 0;
+	    { $wanted_callback->() };	# protect against wild "next"
+	    next if $prune;
+	}
+
+	# change to that directory
+	unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
+	    my $udir= $dir_rel;
+	    if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
+		( $udir ) = $dir_rel =~ m|$untaint_pat|;
+		unless (defined $udir) {
+		    if ($untaint_skip == 0) {
+			if ($Is_MacOS) {
+			    die "directory ($p_dir) $dir_rel is still tainted";
+			}
+			else {
+			    die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
+			}
+		    } else { # $untaint_skip == 1
+			next;
+		    }
+		}
+	    }
+	    unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
+		if ($Is_MacOS) {
+		    warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
+		}
+		else {
+		    warnings::warnif "Can't cd to (" .
+			($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
+		}
+		next;
+	    }
+	    $CdLvl++;
+	}
+
+	if ($Is_MacOS) {
+	    $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
+	}
+
+	$dir= $dir_name; # $File::Find::dir
+
+	# Get the list of files in the current directory.
+	unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
+	    warnings::warnif "Can't opendir($dir_name): $!\n";
+	    next;
+	}
+	@filenames = readdir DIR;
+	closedir(DIR);
+	@filenames = $pre_process->(@filenames) if $pre_process;
+	push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
+
+	# default: use whatever was specifid
+        # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
+        $no_nlink = $avoid_nlink;
+        # if dir has wrong nlink count, force switch to slower stat method
+        $no_nlink = 1 if ($nlink < 2);
+
+	if ($nlink == 2 && !$no_nlink) {
+	    # This dir has no subdirectories.
+	    for my $FN (@filenames) {
+		if ($Is_VMS) {
+		# Big hammer here - Compensate for VMS trailing . and .dir
+		# No win situation until this is changed, but this
+		# will handle the majority of the cases with breaking the fewest
+
+		    $FN =~ s/\.dir\z//i;
+		    $FN =~ s#\.$## if ($FN ne '.');
+		}
+		next if $FN =~ $File::Find::skip_pattern;
+		
+		$name = $dir_pref . $FN; # $File::Find::name
+		$_ = ($no_chdir ? $name : $FN); # $_
+		{ $wanted_callback->() }; # protect against wild "next"
+	    }
+
+	}
+	else {
+	    # This dir has subdirectories.
+	    $subcount = $nlink - 2;
+
+	    # HACK: insert directories at this position. so as to preserve
+	    # the user pre-processed ordering of files.
+	    # EG: directory traversal is in user sorted order, not at random.
+            my $stack_top = @Stack;
+
+	    for my $FN (@filenames) {
+		next if $FN =~ $File::Find::skip_pattern;
+		if ($subcount > 0 || $no_nlink) {
+		    # Seen all the subdirs?
+		    # check for directoriness.
+		    # stat is faster for a file in the current directory
+		    $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
+
+		    if (-d _) {
+			--$subcount;
+			$FN =~ s/\.dir\z//i if $Is_VMS;
+			# HACK: replace push to preserve dir traversal order
+			#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
+			splice @Stack, $stack_top, 0,
+			         [$CdLvl,$dir_name,$FN,$sub_nlink];
+		    }
+		    else {
+			$name = $dir_pref . $FN; # $File::Find::name
+			$_= ($no_chdir ? $name : $FN); # $_
+			{ $wanted_callback->() }; # protect against wild "next"
+		    }
+		}
+		else {
+		    $name = $dir_pref . $FN; # $File::Find::name
+		    $_= ($no_chdir ? $name : $FN); # $_
+		    { $wanted_callback->() }; # protect against wild "next"
+		}
+	    }
+	}
+    }
+    continue {
+	while ( defined ($SE = pop @Stack) ) {
+	    ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
+	    if ($CdLvl > $Level && !$no_chdir) {
+		my $tmp;
+		if ($Is_MacOS) {
+		    $tmp = (':' x ($CdLvl-$Level)) . ':';
+		}
+		elsif ($Is_VMS) {
+		    $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
+		}
+		else {
+		    $tmp = join('/',('..') x ($CdLvl-$Level));
+		}
+		die "Can't cd to $tmp from $dir_name"
+		    unless chdir ($tmp);
+		$CdLvl = $Level;
+	    }
+
+	    if ($Is_MacOS) {
+		# $pdir always has a trailing ':', except for the starting dir,
+		# where $dir_rel eq ':'
+		$dir_name = "$p_dir$dir_rel";
+		$dir_pref = "$dir_name:";
+	    }
+	    elsif ($^O eq 'MSWin32') {
+		$dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
+		$dir_pref = "$dir_name/";
+	    }
+	    elsif ($^O eq 'VMS') {
+                if ($p_dir =~ m/[\]>]+$/) {
+                    $dir_name = $p_dir;
+                    $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
+                    $dir_pref = $dir_name;
+                }
+                else {
+                    $dir_name = "$p_dir/$dir_rel";
+                    $dir_pref = "$dir_name/";
+                }
+	    }
+	    else {
+		$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+		$dir_pref = "$dir_name/";
+	    }
+
+	    if ( $nlink == -2 ) {
+		$name = $dir = $p_dir; # $File::Find::name / dir
+                $_ = $File::Find::current_dir;
+		$post_process->();		# End-of-directory processing
+	    }
+	    elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
+		$name = $dir_name;
+		if ($Is_MacOS) {
+		    if ($dir_rel eq ':') { # must be the top dir, where we started
+			$name =~ s|:$||; # $File::Find::name
+			$p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
+		    }
+		    $dir = $p_dir; # $File::Find::dir
+		    $_ = ($no_chdir ? $name : $dir_rel); # $_
+		}
+		else {
+		    if ( substr($name,-2) eq '/.' ) {
+			substr($name, length($name) == 2 ? -1 : -2) = '';
+		    }
+		    $dir = $p_dir;
+		    $_ = ($no_chdir ? $dir_name : $dir_rel );
+		    if ( substr($_,-2) eq '/.' ) {
+			substr($_, length($_) == 2 ? -1 : -2) = '';
+		    }
+		}
+		{ $wanted_callback->() }; # protect against wild "next"
+	     }
+	     else {
+		push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
+		last;
+	    }
+	}
+    }
+}
+
+
+# API:
+#  $wanted
+#  $dir_loc : absolute location of a dir
+#  $p_dir   : "parent directory"
+# preconditions:
+#  chdir (if not no_chdir) to dir
+
+sub _find_dir_symlnk($$$) {
+    my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
+    my @Stack;
+    my @filenames;
+    my $new_loc;
+    my $updir_loc = $dir_loc; # untainted parent directory
+    my $SE = [];
+    my $dir_name = $p_dir;
+    my $dir_pref;
+    my $loc_pref;
+    my $dir_rel = $File::Find::current_dir;
+    my $byd_flag; # flag for pending stack entry if $bydepth
+    my $tainted = 0;
+    my $ok = 1;
+
+    if ($Is_MacOS) {
+	$dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
+	$loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
+    } else {
+	$dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
+	$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
+    }
+
+    local ($dir, $name, $fullname, $prune, *DIR);
+
+    unless ($no_chdir) {
+	# untaint the topdir
+	if (( $untaint ) && (is_tainted($dir_loc) )) {
+	    ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
+	     # once untainted, $updir_loc is pushed on the stack (as parent directory);
+	    # hence, we don't need to untaint the parent directory every time we chdir
+	    # to it later
+	    unless (defined $updir_loc) {
+		if ($untaint_skip == 0) {
+		    die "directory $dir_loc is still tainted";
+		}
+		else {
+		    return;
+		}
+	    }
+	}
+	$ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
+	unless ($ok) {
+	    warnings::warnif "Can't cd to $updir_loc: $!\n";
+	    return;
+	}
+    }
+
+    push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
+
+    if ($Is_MacOS) {
+	$p_dir = $dir_pref; # ensure trailing ':'
+    }
+
+    while (defined $SE) {
+
+	unless ($bydepth) {
+	    # change (back) to parent directory (always untainted)
+	    unless ($no_chdir) {
+		unless (chdir $updir_loc) {
+		    warnings::warnif "Can't cd to $updir_loc: $!\n";
+		    next;
+		}
+	    }
+	    $dir= $p_dir; # $File::Find::dir
+	    $name= $dir_name; # $File::Find::name
+	    $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
+	    $fullname= $dir_loc; # $File::Find::fullname
+	    # prune may happen here
+	    $prune= 0;
+	    lstat($_); # make sure  file tests with '_' work
+	    { $wanted_callback->() }; # protect against wild "next"
+	    next if $prune;
+	}
+
+	# change to that directory
+	unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
+	    $updir_loc = $dir_loc;
+	    if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
+		# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
+		( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
+		unless (defined $updir_loc) {
+		    if ($untaint_skip == 0) {
+			die "directory $dir_loc is still tainted";
+		    }
+		    else {
+			next;
+		    }
+		}
+	    }
+	    unless (chdir $updir_loc) {
+		warnings::warnif "Can't cd to $updir_loc: $!\n";
+		next;
+	    }
+	}
+
+	if ($Is_MacOS) {
+	    $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
+	}
+
+	$dir = $dir_name; # $File::Find::dir
+
+	# Get the list of files in the current directory.
+	unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
+	    warnings::warnif "Can't opendir($dir_loc): $!\n";
+	    next;
+	}
+	@filenames = readdir DIR;
+	closedir(DIR);
+
+	for my $FN (@filenames) {
+	    if ($Is_VMS) {
+	    # Big hammer here - Compensate for VMS trailing . and .dir
+	    # No win situation until this is changed, but this
+	    # will handle the majority of the cases with breaking the fewest.
+
+		$FN =~ s/\.dir\z//i;
+		$FN =~ s#\.$## if ($FN ne '.');
+	    }
+	    next if $FN =~ $File::Find::skip_pattern;
+
+	    # follow symbolic links / do an lstat
+	    $new_loc = Follow_SymLink($loc_pref.$FN);
+
+	    # ignore if invalid symlink
+	    unless (defined $new_loc) {
+	        if (!defined -l _ && $dangling_symlinks) {
+	            if (ref $dangling_symlinks eq 'CODE') {
+	                $dangling_symlinks->($FN, $dir_pref);
+	            } else {
+	                warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
+	            }
+	        }
+
+	        $fullname = undef;
+	        $name = $dir_pref . $FN;
+	        $_ = ($no_chdir ? $name : $FN);
+	        { $wanted_callback->() };
+	        next;
+	    }
+
+	    if (-d _) {
+		if ($Is_VMS) {
+		    $FN =~ s/\.dir\z//i;
+		    $FN =~ s#\.$## if ($FN ne '.');
+		    $new_loc =~ s/\.dir\z//i;
+		    $new_loc =~ s#\.$## if ($new_loc ne '.');
+		}
+		push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
+	    }
+	    else {
+		$fullname = $new_loc; # $File::Find::fullname
+		$name = $dir_pref . $FN; # $File::Find::name
+		$_ = ($no_chdir ? $name : $FN); # $_
+		{ $wanted_callback->() }; # protect against wild "next"
+	    }
+	}
+
+    }
+    continue {
+	while (defined($SE = pop @Stack)) {
+	    ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
+	    if ($Is_MacOS) {
+		# $p_dir always has a trailing ':', except for the starting dir,
+		# where $dir_rel eq ':'
+		$dir_name = "$p_dir$dir_rel";
+		$dir_pref = "$dir_name:";
+		$loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
+	    }
+	    else {
+		$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+		$dir_pref = "$dir_name/";
+		$loc_pref = "$dir_loc/";
+	    }
+	    if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
+		unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
+		    unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
+			warnings::warnif "Can't cd to $updir_loc: $!\n";
+			next;
+		    }
+		}
+		$fullname = $dir_loc; # $File::Find::fullname
+		$name = $dir_name; # $File::Find::name
+		if ($Is_MacOS) {
+		    if ($dir_rel eq ':') { # must be the top dir, where we started
+			$name =~ s|:$||; # $File::Find::name
+			$p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
+		    }
+		    $dir = $p_dir; # $File::Find::dir
+		     $_ = ($no_chdir ? $name : $dir_rel); # $_
+		}
+		else {
+		    if ( substr($name,-2) eq '/.' ) {
+			substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
+		    }
+		    $dir = $p_dir; # $File::Find::dir
+		    $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
+		    if ( substr($_,-2) eq '/.' ) {
+			substr($_, length($_) == 2 ? -1 : -2) = '';
+		    }
+		}
+
+		lstat($_); # make sure file tests with '_' work
+		{ $wanted_callback->() }; # protect against wild "next"
+	    }
+	    else {
+		push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
+		last;
+	    }
+	}
+    }
+}
+
+
+sub wrap_wanted {
+    my $wanted = shift;
+    if ( ref($wanted) eq 'HASH' ) {
+        unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
+            die 'no &wanted subroutine given';
+        }
+	if ( $wanted->{follow} || $wanted->{follow_fast}) {
+	    $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
+	}
+	if ( $wanted->{untaint} ) {
+	    $wanted->{untaint_pattern} = $File::Find::untaint_pattern
+		unless defined $wanted->{untaint_pattern};
+	    $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
+	}
+	return $wanted;
+    }
+    elsif( ref( $wanted ) eq 'CODE' ) {
+	return { wanted => $wanted };
+    }
+    else {
+       die 'no &wanted subroutine given';
+    }
+}
+
+sub find {
+    my $wanted = shift;
+    _find_opt(wrap_wanted($wanted), @_);
+}
+
+sub finddepth {
+    my $wanted = wrap_wanted(shift);
+    $wanted->{bydepth} = 1;
+    _find_opt($wanted, @_);
+}
+
+# default
+$File::Find::skip_pattern    = qr/^\.{1,2}\z/;
+$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
+
+# These are hard-coded for now, but may move to hint files.
+if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    $File::Find::dont_use_nlink  = 1;
+}
+elsif ($^O eq 'MacOS') {
+    $Is_MacOS = 1;
+    $File::Find::dont_use_nlink  = 1;
+    $File::Find::skip_pattern    = qr/^Icon\015\z/;
+    $File::Find::untaint_pattern = qr|^(.+)$|;
+}
+
+# this _should_ work properly on all platforms
+# where File::Find can be expected to work
+$File::Find::current_dir = File::Spec->curdir || '.';
+
+$File::Find::dont_use_nlink = 1
+    if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
+       $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
+	   $^O eq 'nto';
+
+# Set dont_use_nlink in your hint file if your system's stat doesn't
+# 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 ($File::Find::dont_use_nlink) {
+    require Config;
+    $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+}
+
+# We need a function that checks if a scalar is tainted. Either use the
+# Scalar::Util module's tainted() function or our (slower) pure Perl
+# fallback is_tainted_pp()
+{
+    local $@;
+    eval { require Scalar::Util };
+    *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Glob.pm b/Master/tlpkg/tlperl/lib/File/Glob.pm
new file mode 100644
index 00000000000..7c6b92cf415
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Glob.pm
@@ -0,0 +1,496 @@
+package File::Glob;
+
+use strict;
+our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
+    $AUTOLOAD, $DEFAULT_FLAGS);
+
+use XSLoader ();
+
+@ISA = qw(Exporter);
+
+# NOTE: The glob() export is only here for compatibility with 5.6.0.
+# csh_glob() should not be used directly, unless you know what you're doing.
+
+@EXPORT_OK   = qw(
+    csh_glob
+    bsd_glob
+    glob
+    GLOB_ABEND
+    GLOB_ALPHASORT
+    GLOB_ALTDIRFUNC
+    GLOB_BRACE
+    GLOB_CSH
+    GLOB_ERR
+    GLOB_ERROR
+    GLOB_LIMIT
+    GLOB_MARK
+    GLOB_NOCASE
+    GLOB_NOCHECK
+    GLOB_NOMAGIC
+    GLOB_NOSORT
+    GLOB_NOSPACE
+    GLOB_QUOTE
+    GLOB_TILDE
+);
+
+%EXPORT_TAGS = (
+    'glob' => [ qw(
+        GLOB_ABEND
+	GLOB_ALPHASORT
+        GLOB_ALTDIRFUNC
+        GLOB_BRACE
+        GLOB_CSH
+        GLOB_ERR
+        GLOB_ERROR
+        GLOB_LIMIT
+        GLOB_MARK
+        GLOB_NOCASE
+        GLOB_NOCHECK
+        GLOB_NOMAGIC
+        GLOB_NOSORT
+        GLOB_NOSPACE
+        GLOB_QUOTE
+        GLOB_TILDE
+        glob
+        bsd_glob
+    ) ],
+);
+
+$VERSION = '1.07';
+
+sub import {
+    require Exporter;
+    my $i = 1;
+    while ($i < @_) {
+	if ($_[$i] =~ /^:(case|nocase|globally)$/) {
+	    splice(@_, $i, 1);
+	    $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
+	    $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
+	    if ($1 eq 'globally') {
+		local $^W;
+		*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
+	    }
+	    next;
+	}
+	++$i;
+    }
+    goto &Exporter::import;
+}
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.  If a constant is not found then control is passed
+    # to the AUTOLOAD in AutoLoader.
+
+    my $constname;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my ($error, $val) = constant($constname);
+    if ($error) {
+	require Carp;
+	Carp::croak($error);
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+XSLoader::load 'File::Glob', $VERSION;
+
+# Preloaded methods go here.
+
+sub GLOB_ERROR {
+    return (constant('GLOB_ERROR'))[1];
+}
+
+sub GLOB_CSH () {
+    GLOB_BRACE()
+	| GLOB_NOMAGIC()
+	| GLOB_QUOTE()
+	| GLOB_TILDE()
+	| GLOB_ALPHASORT()
+}
+
+$DEFAULT_FLAGS = GLOB_CSH();
+if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
+    $DEFAULT_FLAGS |= GLOB_NOCASE();
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+sub bsd_glob {
+    my ($pat,$flags) = @_;
+    $flags = $DEFAULT_FLAGS if @_ < 2;
+    return doglob($pat,$flags);
+}
+
+# File::Glob::glob() is deprecated because its prototype is different from
+# CORE::glob() (use bsd_glob() instead)
+sub glob {
+    splice @_, 1; # don't pass PL_glob_index as flags!
+    goto &bsd_glob;
+}
+
+## borrowed heavily from gsar's File::DosGlob
+my %iter;
+my %entries;
+
+sub csh_glob {
+    my $pat = shift;
+    my $cxix = shift;
+    my @pat;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # extract patterns
+    $pat =~ s/^\s+//;	# Protect against empty elements in
+    $pat =~ s/\s+$//;	# things like < *.c> and <*.c >.
+			# These alone shouldn't trigger ParseWords.
+    if ($pat =~ /\s/) {
+        # XXX this is needed for compatibility with the csh
+	# implementation in Perl.  Need to support a flag
+	# to disable this behavior.
+	require Text::ParseWords;
+	@pat = Text::ParseWords::parse_line('\s+',0,$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) {
+	if (@pat) {
+	    $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
+	}
+	else {
+	    $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
+	}
+    }
+
+    # 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;
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Glob - Perl extension for BSD glob routine
+
+=head1 SYNOPSIS
+
+  use File::Glob ':glob';
+
+  @list = bsd_glob('*.[ch]');
+  $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
+
+  if (GLOB_ERROR) {
+    # an error occurred reading $homedir
+  }
+
+  ## override the core glob (CORE::glob() does this automatically
+  ## by default anyway, since v5.6.0)
+  use File::Glob ':globally';
+  my @sources = <*.{c,h,y}>;
+
+  ## override the core glob, forcing case sensitivity
+  use File::Glob qw(:globally :case);
+  my @sources = <*.{c,h,y}>;
+
+  ## override the core glob forcing case insensitivity
+  use File::Glob qw(:globally :nocase);
+  my @sources = <*.{c,h,y}>;
+
+  ## glob on all files in home directory
+  use File::Glob ':globally';
+  my @sources = <~gnat/*>;
+
+=head1 DESCRIPTION
+
+The glob angle-bracket operator C<< <> >> is a pathname generator that
+implements the rules for file name pattern matching used by Unix-like shells
+such as the Bourne shell or C shell.
+
+File::Glob::bsd_glob() implements the FreeBSD glob(3) routine, which is
+a superset of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").
+bsd_glob() takes a mandatory C<pattern> argument, and an optional
+C<flags> argument, and returns a list of filenames matching the
+pattern, with interpretation of the pattern modified by the C<flags>
+variable.
+
+Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
+Note that they don't share the same prototype--CORE::glob() only accepts
+a single argument.  Due to historical reasons, CORE::glob() will also
+split its argument on whitespace, treating it as multiple patterns,
+whereas bsd_glob() considers them as one pattern.
+
+=head2 META CHARACTERS
+
+  \       Quote the next metacharacter
+  []      Character class
+  {}      Multiple pattern
+  *       Match any string of characters
+  ?       Match any single character
+  ~       User name home directory
+
+The metanotation C<a{b,c,d}e> is a shorthand for C<abe ace ade>.  Left to
+right order is preserved, with results of matches being sorted separately
+at a low level to preserve this order. As a special case C<{>, C<}>, and
+C<{}> are passed undisturbed.
+
+=head2 POSIX FLAGS
+
+The POSIX defined flags for bsd_glob() are:
+
+=over 4
+
+=item C<GLOB_ERR>
+
+Force bsd_glob() to return an error when it encounters a directory it
+cannot open or read.  Ordinarily bsd_glob() continues to find matches.
+
+=item C<GLOB_LIMIT>
+
+Make bsd_glob() return an error (GLOB_NOSPACE) when the pattern expands
+to a size bigger than the system constant C<ARG_MAX> (usually found in
+limits.h).  If your system does not define this constant, bsd_glob() uses
+C<sysconf(_SC_ARG_MAX)> or C<_POSIX_ARG_MAX> where available (in that
+order).  You can inspect these values using the standard C<POSIX>
+extension.
+
+=item C<GLOB_MARK>
+
+Each pathname that is a directory that matches the pattern has a slash
+appended.
+
+=item C<GLOB_NOCASE>
+
+By default, file names are assumed to be case sensitive; this flag
+makes bsd_glob() treat case differences as not significant.
+
+=item C<GLOB_NOCHECK>
+
+If the pattern does not match any pathname, then bsd_glob() returns a list
+consisting of only the pattern.  If C<GLOB_QUOTE> is set, its effect
+is present in the pattern returned.
+
+=item C<GLOB_NOSORT>
+
+By default, the pathnames are sorted in ascending ASCII order; this
+flag prevents that sorting (speeding up bsd_glob()).
+
+=back
+
+The FreeBSD extensions to the POSIX standard are the following flags:
+
+=over 4
+
+=item C<GLOB_BRACE>
+
+Pre-process the string to expand C<{pat,pat,...}> strings like csh(1).
+The pattern '{}' is left unexpanded for historical reasons (and csh(1)
+does the same thing to ease typing of find(1) patterns).
+
+=item C<GLOB_NOMAGIC>
+
+Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
+contain any of the special characters "*", "?" or "[".  C<NOMAGIC> is
+provided to simplify implementing the historic csh(1) globbing
+behaviour and should probably not be used anywhere else.
+
+=item C<GLOB_QUOTE>
+
+Use the backslash ('\') character for quoting: every occurrence of a
+backslash followed by a character in the pattern is replaced by that
+character, avoiding any special interpretation of the character.
+(But see below for exceptions on DOSISH systems).
+
+=item C<GLOB_TILDE>
+
+Expand patterns that start with '~' to user name home directories.
+
+=item C<GLOB_CSH>
+
+For convenience, C<GLOB_CSH> is a synonym for
+C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT>.
+
+=back
+
+The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
+extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
+implemented in the Perl version because they involve more complex
+interaction with the underlying C structures.
+
+The following flag has been added in the Perl implementation for
+csh compatibility:
+
+=over 4
+
+=item C<GLOB_ALPHASORT>
+
+If C<GLOB_NOSORT> is not in effect, sort filenames is alphabetical
+order (case does not matter) rather than in ASCII order.
+
+=back
+
+=head1 DIAGNOSTICS
+
+bsd_glob() returns a list of matching paths, possibly zero length.  If an
+error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
+set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
+or one of the following values otherwise:
+
+=over 4
+
+=item C<GLOB_NOSPACE>
+
+An attempt to allocate memory failed.
+
+=item C<GLOB_ABEND>
+
+The glob was stopped because an error was encountered.
+
+=back
+
+In the case where bsd_glob() has found some matching paths, but is
+interrupted by an error, it will return a list of filenames B<and>
+set &File::Glob::ERROR.
+
+Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
+by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
+continue processing despite those errors, unless the C<GLOB_ERR> flag is
+set.
+
+Be aware that all filenames returned from File::Glob are tainted.
+
+=head1 NOTES
+
+=over 4
+
+=item *
+
+If you want to use multiple patterns, e.g. C<bsd_glob("a* b*")>, you should
+probably throw them in a set as in C<bsd_glob("{a*,b*}")>.  This is because
+the argument to bsd_glob() isn't subjected to parsing by the C shell.
+Remember that you can use a backslash to escape things.
+
+=item *
+
+On DOSISH systems, backslash is a valid directory separator character.
+In this case, use of backslash as a quoting character (via GLOB_QUOTE)
+interferes with the use of backslash as a directory separator. The
+best (simplest, most portable) solution is to use forward slashes for
+directory separators, and backslashes for quoting. However, this does
+not match "normal practice" on these systems. As a concession to user
+expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
+glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
+All other backslashes are passed through unchanged.
+
+=item *
+
+Win32 users should use the real slash.  If you really want to use
+backslashes, consider using Sarathy's File::DosGlob, which comes with
+the standard Perl distribution.
+
+=item *
+
+Mac OS (Classic) users should note a few differences. Since
+Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
+~user) and the C<GLOB_TILDE> flag is used, it simply returns that
+pattern without doing any expansion.
+
+Glob on Mac OS is case-insensitive by default (if you don't use any
+flags). If you specify any flags at all and still want glob
+to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
+
+The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
+should be careful about specifying relative pathnames. While a full path
+always begins with a volume name, a relative pathname should always
+begin with a ':'.  If specifying a volume name only, a trailing ':' is
+required.
+
+The specification of pathnames in glob patterns adheres to the usual Mac
+OS conventions: The path separator is a colon ':', not a slash '/'. A
+full path always begins with a volume name. A relative pathname on Mac
+OS must always begin with a ':', except when specifying a file or
+directory name in the current working directory, where the leading colon
+is optional. If specifying a volume name only, a trailing ':' is
+required. Due to these rules, a glob like E<lt>*:E<gt> will find all
+mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find
+all files and directories in the current directory.
+
+Note that updirs in the glob pattern are resolved before the matching begins,
+i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
+that a single trailing ':' in the pattern is ignored (unless it's a volume
+name pattern like "*HD:"), i.e. a glob like E<lt>:*:E<gt> will find both
+directories I<and> files (and not, as one might expect, only directories).
+You can, however, use the C<GLOB_MARK> flag to distinguish (without a file
+test) directory names from file names.
+
+If the C<GLOB_MARK> flag is set, all directory paths will have a ':' appended.
+Since a directory like 'lib:' is I<not> a valid I<relative> path on Mac OS,
+both a leading and a trailing colon will be added, when the directory name in
+question doesn't contain any colons (e.g. 'lib' becomes ':lib:').
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc/glob>, glob(3)
+
+=head1 AUTHOR
+
+The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
+and is released under the artistic license.  Further modifications were
+made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
+E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
+E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
+following copyright:
+
+    Copyright (c) 1989, 1993 The Regents of the University of California.
+    All rights reserved.
+
+    This code is derived from software contributed to Berkeley by
+    Guido van Rossum.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+    3. Neither the name of the University nor the names of its contributors
+       may be used to endorse or promote products derived from this software
+       without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+    ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+    ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+    OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+    SUCH DAMAGE.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/File/GlobMapper.pm b/Master/tlpkg/tlperl/lib/File/GlobMapper.pm
new file mode 100644
index 00000000000..40a606309e0
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/GlobMapper.pm
@@ -0,0 +1,679 @@
+package File::GlobMapper;
+
+use strict;
+use warnings;
+use Carp;
+
+our ($CSH_GLOB);
+
+BEGIN
+{
+    if ($] < 5.006)
+    { 
+        require File::BSDGlob; import File::BSDGlob qw(:glob) ;
+        $CSH_GLOB = File::BSDGlob::GLOB_CSH() ;
+        *globber = \&File::BSDGlob::csh_glob;
+    }  
+    else
+    { 
+        require File::Glob; import File::Glob qw(:glob) ;
+        $CSH_GLOB = File::Glob::GLOB_CSH() ;
+        #*globber = \&File::Glob::bsd_glob;
+        *globber = \&File::Glob::csh_glob;
+    }  
+}
+
+our ($Error);
+
+our ($VERSION, @EXPORT_OK);
+$VERSION = '1.000';
+@EXPORT_OK = qw( globmap );
+
+
+our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount);
+$noPreBS = '(?<!\\\)' ; # no preceeding backslash
+$metachars = '.*?[](){}';
+$matchMetaRE = '[' . quotemeta($metachars) . ']';
+
+%mapping = (
+                '*' => '([^/]*)',
+                '?' => '([^/])',
+                '.' => '\.',
+                '[' => '([',
+                '(' => '(',
+                ')' => ')',
+           );
+
+%wildCount = map { $_ => 1 } qw/ * ? . { ( [ /;           
+
+sub globmap ($$;)
+{
+    my $inputGlob = shift ;
+    my $outputGlob = shift ;
+
+    my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_)
+        or croak "globmap: $Error" ;
+    return $obj->getFileMap();
+}
+
+sub new
+{
+    my $class = shift ;
+    my $inputGlob = shift ;
+    my $outputGlob = shift ;
+    # TODO -- flags needs to default to whatever File::Glob does
+    my $flags = shift || $CSH_GLOB ;
+    #my $flags = shift ;
+
+    $inputGlob =~ s/^\s*\<\s*//;
+    $inputGlob =~ s/\s*\>\s*$//;
+
+    $outputGlob =~ s/^\s*\<\s*//;
+    $outputGlob =~ s/\s*\>\s*$//;
+
+    my %object =
+            (   InputGlob   => $inputGlob,
+                OutputGlob  => $outputGlob,
+                GlobFlags   => $flags,
+                Braces      => 0,
+                WildCount   => 0,
+                Pairs       => [],
+                Sigil       => '#',
+            );
+
+    my $self = bless \%object, ref($class) || $class ;
+
+    $self->_parseInputGlob()
+        or return undef ;
+
+    $self->_parseOutputGlob()
+        or return undef ;
+    
+    my @inputFiles = globber($self->{InputGlob}, $flags) ;
+
+    if (GLOB_ERROR)
+    {
+        $Error = $!;
+        return undef ;
+    }
+
+    #if (whatever)
+    {
+        my $missing = grep { ! -e $_ } @inputFiles ;
+
+        if ($missing)
+        {
+            $Error = "$missing input files do not exist";
+            return undef ;
+        }
+    }
+
+    $self->{InputFiles} = \@inputFiles ;
+
+    $self->_getFiles()
+        or return undef ;
+
+    return $self;
+}
+
+sub _retError
+{
+    my $string = shift ;
+    $Error = "$string in input fileglob" ;
+    return undef ;
+}
+
+sub _unmatched
+{
+    my $delimeter = shift ;
+
+    _retError("Unmatched $delimeter");
+    return undef ;
+}
+
+sub _parseBit
+{
+    my $self = shift ;
+
+    my $string = shift ;
+
+    my $out = '';
+    my $depth = 0 ;
+
+    while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//)
+    {
+        $out .= quotemeta($1) ;
+        $out .= $mapping{$2} if defined $mapping{$2};
+
+        ++ $self->{WildCount} if $wildCount{$2} ;
+
+        if ($2 eq ',')
+        { 
+            return _unmatched "("
+                if $depth ;
+            
+            $out .= '|';
+        }
+        elsif ($2 eq '(')
+        { 
+            ++ $depth ;
+        }
+        elsif ($2 eq ')')
+        { 
+            return _unmatched ")"
+                if ! $depth ;
+
+            -- $depth ;
+        }
+        elsif ($2 eq '[')
+        {
+            # TODO -- quotemeta & check no '/'
+            # TODO -- check for \]  & other \ within the []
+            $string =~ s#(.*?\])##
+                or return _unmatched "[" ;
+            $out .= "$1)" ;
+        }
+        elsif ($2 eq ']')
+        {
+            return _unmatched "]" ;
+        }
+        elsif ($2 eq '{' || $2 eq '}')
+        {
+            return _retError "Nested {} not allowed" ;
+        }
+    }
+
+    $out .= quotemeta $string;
+
+    return _unmatched "("
+        if $depth ;
+
+    return $out ;
+}
+
+sub _parseInputGlob
+{
+    my $self = shift ;
+
+    my $string = $self->{InputGlob} ;
+    my $inGlob = '';
+
+    # Multiple concatenated *'s don't make sense
+    #$string =~ s#\*\*+#*# ;
+
+    # TODO -- Allow space to delimit patterns?
+    #my @strings = split /\s+/, $string ;
+    #for my $str (@strings)
+    my $out = '';
+    my $depth = 0 ;
+
+    while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//)
+    {
+        $out .= quotemeta($1) ;
+        $out .= $mapping{$2} if defined $mapping{$2};
+        ++ $self->{WildCount} if $wildCount{$2} ;
+
+        if ($2 eq '(')
+        { 
+            ++ $depth ;
+        }
+        elsif ($2 eq ')')
+        { 
+            return _unmatched ")"
+                if ! $depth ;
+
+            -- $depth ;
+        }
+        elsif ($2 eq '[')
+        {
+            # TODO -- quotemeta & check no '/' or '(' or ')'
+            # TODO -- check for \]  & other \ within the []
+            $string =~ s#(.*?\])##
+                or return _unmatched "[";
+            $out .= "$1)" ;
+        }
+        elsif ($2 eq ']')
+        {
+            return _unmatched "]" ;
+        }
+        elsif ($2 eq '}')
+        {
+            return _unmatched "}" ;
+        }
+        elsif ($2 eq '{')
+        {
+            # TODO -- check no '/' within the {}
+            # TODO -- check for \}  & other \ within the {}
+
+            my $tmp ;
+            unless ( $string =~ s/(.*?)$noPreBS\}//)
+            {
+                return _unmatched "{";
+            }
+            #$string =~ s#(.*?)\}##;
+
+            #my $alt = join '|', 
+            #          map { quotemeta $_ } 
+            #          split "$noPreBS,", $1 ;
+            my $alt = $self->_parseBit($1);
+            defined $alt or return 0 ;
+            $out .= "($alt)" ;
+
+            ++ $self->{Braces} ;
+        }
+    }
+
+    return _unmatched "("
+        if $depth ;
+
+    $out .= quotemeta $string ;
+
+
+    $self->{InputGlob} =~ s/$noPreBS[\(\)]//g;
+    $self->{InputPattern} = $out ;
+
+    #print "# INPUT '$self->{InputGlob}' => '$out'\n";
+
+    return 1 ;
+
+}
+
+sub _parseOutputGlob
+{
+    my $self = shift ;
+
+    my $string = $self->{OutputGlob} ;
+    my $maxwild = $self->{WildCount};
+
+    if ($self->{GlobFlags} & GLOB_TILDE)
+    #if (1)
+    {
+        $string =~ s{
+              ^ ~             # find a leading tilde
+              (               # save this in $1
+                  [^/]        # a non-slash character
+                        *     # repeated 0 or more times (0 means me)
+              )
+            }{
+              $1
+                  ? (getpwnam($1))[7]
+                  : ( $ENV{HOME} || $ENV{LOGDIR} )
+            }ex;
+
+    }
+
+    # max #1 must be == to max no of '*' in input
+    while ( $string =~ m/#(\d)/g )
+    {
+        croak "Max wild is #$maxwild, you tried #$1"
+            if $1 > $maxwild ;
+    }
+
+    my $noPreBS = '(?<!\\\)' ; # no preceeding backslash
+    #warn "noPreBS = '$noPreBS'\n";
+
+    #$string =~ s/${noPreBS}\$(\d)/\${$1}/g;
+    $string =~ s/${noPreBS}#(\d)/\${$1}/g;
+    $string =~ s#${noPreBS}\*#\${inFile}#g;
+    $string = '"' . $string . '"';
+
+    #print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
+    $self->{OutputPattern} = $string ;
+
+    return 1 ;
+}
+
+sub _getFiles
+{
+    my $self = shift ;
+
+    my %outInMapping = ();
+    my %inFiles = () ;
+
+    foreach my $inFile (@{ $self->{InputFiles} })
+    {
+        next if $inFiles{$inFile} ++ ;
+
+        my $outFile = $inFile ;
+
+        if ( $inFile =~ m/$self->{InputPattern}/ )
+        {
+            no warnings 'uninitialized';
+            eval "\$outFile = $self->{OutputPattern};" ;
+
+            if (defined $outInMapping{$outFile})
+            {
+                $Error =  "multiple input files map to one output file";
+                return undef ;
+            }
+            $outInMapping{$outFile} = $inFile;
+            push @{ $self->{Pairs} }, [$inFile, $outFile];
+        }
+    }
+
+    return 1 ;
+}
+
+sub getFileMap
+{
+    my $self = shift ;
+
+    return $self->{Pairs} ;
+}
+
+sub getHash
+{
+    my $self = shift ;
+
+    return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::GlobMapper - Extend File Glob to Allow Input and Output Files
+
+=head1 SYNOPSIS
+
+    use File::GlobMapper qw( globmap );
+
+    my $aref = globmap $input => $output
+        or die $File::GlobMapper::Error ;
+
+    my $gm = new File::GlobMapper $input => $output
+        or die $File::GlobMapper::Error ;
+
+
+=head1 DESCRIPTION
+
+This module needs Perl5.005 or better.
+
+This module takes the existing C<File::Glob> module as a starting point and
+extends it to allow new filenames to be derived from the files matched by
+C<File::Glob>.
+
+This can be useful when carrying out batch operations on multiple files that
+have both an input filename and output filename and the output file can be
+derived from the input filename. Examples of operations where this can be
+useful include, file renaming, file copying and file compression.
+
+
+=head2 Behind The Scenes
+
+To help explain what C<File::GlobMapper> does, consider what code you
+would write if you wanted to rename all files in the current directory
+that ended in C<.tar.gz> to C<.tgz>. So say these files are in the
+current directory
+
+    alpha.tar.gz
+    beta.tar.gz
+    gamma.tar.gz
+
+and they need renamed to this
+
+    alpha.tgz
+    beta.tgz
+    gamma.tgz
+
+Below is a possible implementation of a script to carry out the rename
+(error cases have been omitted)
+
+    foreach my $old ( glob "*.tar.gz" )
+    {
+        my $new = $old;
+        $new =~ s#(.*)\.tar\.gz$#$1.tgz# ;
+
+        rename $old => $new 
+            or die "Cannot rename '$old' to '$new': $!\n;
+    }
+
+Notice that a file glob pattern C<*.tar.gz> was used to match the
+C<.tar.gz> files, then a fairly similar regular expression was used in
+the substitute to allow the new filename to be created.
+
+Given that the file glob is just a cut-down regular expression and that it
+has already done a lot of the hard work in pattern matching the filenames,
+wouldn't it be handy to be able to use the patterns in the fileglob to
+drive the new filename?
+
+Well, that's I<exactly> what C<File::GlobMapper> does. 
+
+Here is same snippet of code rewritten using C<globmap>
+
+    for my $pair (globmap '<*.tar.gz>' => '<#1.tgz>' )
+    {
+        my ($from, $to) = @$pair;
+        rename $from => $to 
+            or die "Cannot rename '$old' to '$new': $!\n;
+    }
+
+So how does it work?
+
+Behind the scenes the C<globmap> function does a combination of a
+file glob to match existing filenames followed by a substitute
+to create the new filenames. 
+
+Notice how both parameters to C<globmap> are strings that are delimited by <>.
+This is done to make them look more like file globs - it is just syntactic
+sugar, but it can be handy when you want the strings to be visually
+distinctive. The enclosing <> are optional, so you don't have to use them - in
+fact the first thing globmap will do is remove these delimiters if they are
+present.
+
+The first parameter to C<globmap>, C<*.tar.gz>, is an I<Input File Glob>. 
+Once the enclosing "< ... >" is removed, this is passed (more or
+less) unchanged to C<File::Glob> to carry out a file match.
+
+Next the fileglob C<*.tar.gz> is transformed behind the scenes into a
+full Perl regular expression, with the additional step of wrapping each
+transformed wildcard metacharacter sequence in parenthesis.
+
+In this case the input fileglob C<*.tar.gz> will be transformed into
+this Perl regular expression 
+
+    ([^/]*)\.tar\.gz
+
+Wrapping with parenthesis allows the wildcard parts of the Input File
+Glob to be referenced by the second parameter to C<globmap>, C<#1.tgz>,
+the I<Output File Glob>. This parameter operates just like the replacement
+part of a substitute command. The difference is that the C<#1> syntax
+is used to reference sub-patterns matched in the input fileglob, rather
+than the C<$1> syntax that is used with perl regular expressions. In
+this case C<#1> is used to refer to the text matched by the C<*> in the
+Input File Glob. This makes it easier to use this module where the
+parameters to C<globmap> are typed at the command line.
+
+The final step involves passing each filename matched by the C<*.tar.gz>
+file glob through the derived Perl regular expression in turn and
+expanding the output fileglob using it.
+
+The end result of all this is a list of pairs of filenames. By default
+that is what is returned by C<globmap>. In this example the data structure
+returned will look like this
+
+     ( ['alpha.tar.gz' => 'alpha.tgz'],
+       ['beta.tar.gz'  => 'beta.tgz' ],
+       ['gamma.tar.gz' => 'gamma.tgz']
+     )
+
+
+Each pair is an array reference with two elements - namely the I<from>
+filename, that C<File::Glob> has matched, and a I<to> filename that is
+derived from the I<from> filename.
+
+
+
+=head2 Limitations
+
+C<File::GlobMapper> has been kept simple deliberately, so it isn't intended to
+solve all filename mapping operations. Under the hood C<File::Glob> (or for
+older versions of Perl, C<File::BSDGlob>) is used to match the files, so you
+will never have the flexibility of full Perl regular expression.
+
+=head2 Input File Glob
+
+The syntax for an Input FileGlob is identical to C<File::Glob>, except
+for the following
+
+=over 5
+
+=item 1.
+
+No nested {}
+
+=item 2.
+
+Whitespace does not delimit fileglobs.
+
+=item 3.
+
+The use of parenthesis can be used to capture parts of the input filename.
+
+=item 4.
+
+If an Input glob matches the same file more than once, only the first
+will be used.
+
+=back
+
+The syntax
+
+=over 5
+
+=item B<~>
+
+=item B<~user>
+
+
+=item B<.>
+
+Matches a literal '.'.
+Equivalent to the Perl regular expression
+
+    \.
+
+=item B<*>
+
+Matches zero or more characters, except '/'. Equivalent to the Perl
+regular expression
+
+    [^/]*
+
+=item B<?>
+
+Matches zero or one character, except '/'. Equivalent to the Perl
+regular expression
+
+    [^/]?
+
+=item B<\>
+
+Backslash is used, as usual, to escape the next character.
+
+=item  B<[]>
+
+Character class.
+
+=item  B<{,}>
+
+Alternation
+
+=item  B<()>
+
+Capturing parenthesis that work just like perl
+
+=back
+
+Any other character it taken literally.
+
+=head2 Output File Glob
+
+The Output File Glob is a normal string, with 2 glob-like features.
+
+The first is the '*' metacharacter. This will be replaced by the complete
+filename matched by the input file glob. So
+
+    *.c *.Z
+
+The second is     
+
+Output FileGlobs take the 
+
+=over 5
+
+=item "*"
+
+The "*" character will be replaced with the complete input filename.
+
+=item #1
+
+Patterns of the form /#\d/ will be replaced with the 
+
+=back
+
+=head2 Returned Data
+
+
+=head1 EXAMPLES
+
+=head2 A Rename script
+
+Below is a simple "rename" script that uses C<globmap> to determine the
+source and destination filenames.
+
+    use File::GlobMapper qw(globmap) ;
+    use File::Copy;
+
+    die "rename: Usage rename 'from' 'to'\n"
+        unless @ARGV == 2 ;
+
+    my $fromGlob = shift @ARGV;
+    my $toGlob   = shift @ARGV;
+
+    my $pairs = globmap($fromGlob, $toGlob)
+        or die $File::GlobMapper::Error;
+
+    for my $pair (@$pairs)
+    {
+        my ($from, $to) = @$pair;
+        move $from => $to ;
+    }
+
+
+
+Here is an example that renames all c files to cpp.
+    
+    $ rename '*.c' '#1.cpp'
+
+=head2 A few example globmaps
+
+Below are a few examples of globmaps
+
+To copy all your .c file to a backup directory
+
+    '</my/home/*.c>'    '</my/backup/#1.c>'
+
+If you want to compress all    
+
+    '</my/home/*.[ch]>'    '<*.gz>'
+
+To uncompress
+
+    '</my/home/*.[ch].gz>'    '</my/home/#1.#2>'
+
+=head1 SEE ALSO
+
+L<File::Glob|File::Glob>
+
+=head1 AUTHOR
+
+The I<File::GlobMapper> module was written by Paul Marquess, F<pmqs@cpan.org>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2005 Paul Marquess. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/File/Path.pm b/Master/tlpkg/tlperl/lib/File/Path.pm
new file mode 100644
index 00000000000..5a9a88e4020
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Path.pm
@@ -0,0 +1,981 @@
+package File::Path;
+
+use 5.005_04;
+use strict;
+
+use Cwd 'getcwd';
+use File::Basename ();
+use File::Spec     ();
+
+BEGIN {
+    if ($] < 5.006) {
+        # can't say 'opendir my $dh, $dirname'
+        # need to initialise $dh
+        eval "use Symbol";
+    }
+}
+
+use Exporter ();
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+$VERSION   = '2.08_01';
+@ISA       = qw(Exporter);
+@EXPORT    = qw(mkpath rmtree);
+@EXPORT_OK = qw(make_path remove_tree);
+
+my $Is_VMS     = $^O eq 'VMS';
+my $Is_MacOS   = $^O eq 'MacOS';
+
+# These OSes complain if you want to remove a file that you have no
+# write permission to:
+my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
+
+# Unix-like systems need to stat each directory in order to detect
+# race condition. MS-Windows is immune to this particular attack.
+my $Need_Stat_Check = !($^O eq 'MSWin32');
+
+sub _carp {
+    require Carp;
+    goto &Carp::carp;
+}
+
+sub _croak {
+    require Carp;
+    goto &Carp::croak;
+}
+
+sub _error {
+    my $arg     = shift;
+    my $message = shift;
+    my $object  = shift;
+
+    if ($arg->{error}) {
+        $object = '' unless defined $object;
+        $message .= ": $!" if $!;
+        push @{${$arg->{error}}}, {$object => $message};
+    }
+    else {
+        _carp(defined($object) ? "$message for $object: $!" : "$message: $!");
+    }
+}
+
+sub make_path {
+    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    goto &mkpath;
+}
+
+sub mkpath {
+    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
+
+    my $arg;
+    my $paths;
+
+    if ($old_style) {
+        my ($verbose, $mode);
+        ($paths, $verbose, $mode) = @_;
+        $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
+        $arg->{verbose} = $verbose;
+        $arg->{mode}    = defined $mode ? $mode : 0777;
+    }
+    else {
+        $arg = pop @_;
+        $arg->{mode}      = delete $arg->{mask} if exists $arg->{mask};
+        $arg->{mode}      = 0777 unless exists $arg->{mode};
+        ${$arg->{error}}  = [] if exists $arg->{error};
+        $arg->{owner}     = delete $arg->{user} if exists $arg->{user};
+        $arg->{owner}     = delete $arg->{uid}  if exists $arg->{uid};
+        if (exists $arg->{owner} and $arg->{owner} =~ /\D/) {
+            my $uid = (getpwnam $arg->{owner})[2];
+            if (defined $uid) {
+                $arg->{owner} = $uid;
+            }
+            else {
+                _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed");
+                delete $arg->{owner};
+            }
+        }
+        if (exists $arg->{group} and $arg->{group} =~ /\D/) {
+            my $gid = (getgrnam $arg->{group})[2];
+            if (defined $gid) {
+                $arg->{group} = $gid;
+            }
+            else {
+                _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed");
+                delete $arg->{group};
+            }
+        }
+        if (exists $arg->{owner} and not exists $arg->{group}) {
+            $arg->{group} = -1; # chown will leave group unchanged
+        }
+        if (exists $arg->{group} and not exists $arg->{owner}) {
+            $arg->{owner} = -1; # chown will leave owner unchanged
+        }
+        $paths = [@_];
+    }
+    return _mkpath($arg, $paths);
+}
+
+sub _mkpath {
+    my $arg   = shift;
+    my $paths = shift;
+
+    my(@created,$path);
+    foreach $path (@$paths) {
+        next unless defined($path) and length($path);
+        $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
+        # Logic wants Unix paths, so go with the flow.
+        if ($Is_VMS) {
+            next if $path eq '/';
+            $path = VMS::Filespec::unixify($path);
+        }
+        next if -d $path;
+        my $parent = File::Basename::dirname($path);
+        unless (-d $parent or $path eq $parent) {
+            push(@created,_mkpath($arg, [$parent]));
+        }
+        print "mkdir $path\n" if $arg->{verbose};
+        if (mkdir($path,$arg->{mode})) {
+            push(@created, $path);
+            if (exists $arg->{owner}) {
+				# NB: $arg->{group} guaranteed to be set during initialisation
+                if (!chown $arg->{owner}, $arg->{group}, $path) {
+                    _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}");
+                }
+            }
+        }
+        else {
+            my $save_bang = $!;
+            my ($e, $e1) = ($save_bang, $^E);
+            $e .= "; $e1" if $e ne $e1;
+            # allow for another process to have created it meanwhile
+            if (!-d $path) {
+                $! = $save_bang;
+                if ($arg->{error}) {
+                    push @{${$arg->{error}}}, {$path => $e};
+                }
+                else {
+                    _croak("mkdir $path: $e");
+                }
+            }
+        }
+    }
+    return @created;
+}
+
+sub remove_tree {
+    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    goto &rmtree;
+}
+
+sub _is_subdir {
+    my($dir, $test) = @_;
+
+    my($dv, $dd) = File::Spec->splitpath($dir, 1);
+    my($tv, $td) = File::Spec->splitpath($test, 1);
+
+    # not on same volume
+    return 0 if $dv ne $tv;
+
+    my @d = File::Spec->splitdir($dd);
+    my @t = File::Spec->splitdir($td);
+
+    # @t can't be a subdir if it's shorter than @d
+    return 0 if @t < @d;
+
+    return join('/', @d) eq join('/', splice @t, 0, +@d);
+}
+
+sub rmtree {
+    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
+
+    my $arg;
+    my $paths;
+
+    if ($old_style) {
+        my ($verbose, $safe);
+        ($paths, $verbose, $safe) = @_;
+        $arg->{verbose} = $verbose;
+        $arg->{safe}    = defined $safe    ? $safe    : 0;
+
+        if (defined($paths) and length($paths)) {
+            $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
+        }
+        else {
+            _carp ("No root path(s) specified\n");
+            return 0;
+        }
+    }
+    else {
+        $arg = pop @_;
+        ${$arg->{error}}  = [] if exists $arg->{error};
+        ${$arg->{result}} = [] if exists $arg->{result};
+        $paths = [@_];
+    }
+
+    $arg->{prefix} = '';
+    $arg->{depth}  = 0;
+
+    my @clean_path;
+    $arg->{cwd} = getcwd() or do {
+        _error($arg, "cannot fetch initial working directory");
+        return 0;
+    };
+    for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint
+
+    for my $p (@$paths) {
+        # need to fixup case and map \ to / on Windows
+        my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p)          : $p;
+        my $ortho_cwd  = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd};
+        my $ortho_root_length = length($ortho_root);
+        $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']'
+        if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) {
+            local $! = 0;
+            _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p);
+            next;
+        }
+
+        if ($Is_MacOS) {
+            $p  = ":$p" unless $p =~ /:/;
+            $p .= ":"   unless $p =~ /:\z/;
+        }
+        elsif ($^O eq 'MSWin32') {
+            $p =~ s{[/\\]\z}{};
+        }
+        else {
+            $p =~ s{/\z}{};
+        }
+        push @clean_path, $p;
+    }
+
+    @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do {
+        _error($arg, "cannot stat initial working directory", $arg->{cwd});
+        return 0;
+    };
+
+    return _rmtree($arg, \@clean_path);
+}
+
+sub _rmtree {
+    my $arg   = shift;
+    my $paths = shift;
+
+    my $count  = 0;
+    my $curdir = File::Spec->curdir();
+    my $updir  = File::Spec->updir();
+
+    my (@files, $root);
+    ROOT_DIR:
+    foreach $root (@$paths) {
+        # since we chdir into each directory, it may not be obvious
+        # to figure out where we are if we generate a message about
+        # a file name. We therefore construct a semi-canonical
+        # filename, anchored from the directory being unlinked (as
+        # opposed to being truly canonical, anchored from the root (/).
+
+        my $canon = $arg->{prefix}
+            ? File::Spec->catfile($arg->{prefix}, $root)
+            : $root
+        ;
+
+        my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR;
+
+        if ( -d _ ) {
+            $root = VMS::Filespec::vmspath(VMS::Filespec::pathify($root)) if $Is_VMS;
+
+            if (!chdir($root)) {
+                # see if we can escalate privileges to get in
+                # (e.g. funny protection mask such as -w- instead of rwx)
+                $perm &= 07777;
+                my $nperm = $perm | 0700;
+                if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) {
+                    _error($arg, "cannot make child directory read-write-exec", $canon);
+                    next ROOT_DIR;
+                }
+                elsif (!chdir($root)) {
+                    _error($arg, "cannot chdir to child", $canon);
+                    next ROOT_DIR;
+                }
+            }
+
+            my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do {
+                _error($arg, "cannot stat current working directory", $canon);
+                next ROOT_DIR;
+            };
+
+            if ($Need_Stat_Check) {
+                ($ldev eq $cur_dev and $lino eq $cur_inode)
+                    or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
+            }
+
+            $perm &= 07777; # don't forget setuid, setgid, sticky bits
+            my $nperm = $perm | 0700;
+
+            # notabene: 0700 is for making readable in the first place,
+            # it's also intended to change it to writable in case we have
+            # to recurse in which case we are better than rm -rf for 
+            # subtrees with strange permissions
+
+            if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) {
+                _error($arg, "cannot make directory read+writeable", $canon);
+                $nperm = $perm;
+            }
+
+            my $d;
+            $d = gensym() if $] < 5.006;
+            if (!opendir $d, $curdir) {
+                _error($arg, "cannot opendir", $canon);
+                @files = ();
+            }
+            else {
+                no strict 'refs';
+                if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
+                    # Blindly untaint dir names if taint mode is
+                    # active, or any perl < 5.006
+                    @files = map { /\A(.*)\z/s; $1 } readdir $d;
+                }
+                else {
+                    @files = readdir $d;
+                }
+                closedir $d;
+            }
+
+            if ($Is_VMS) {
+                # Deleting large numbers of files from VMS Files-11
+                # filesystems is faster if done in reverse ASCIIbetical order.
+                # include '.' to '.;' from blead patch #31775
+                @files = map {$_ eq '.' ? '.;' : $_} reverse @files;
+            }
+
+            @files = grep {$_ ne $updir and $_ ne $curdir} @files;
+
+            if (@files) {
+                # remove the contained files before the directory itself
+                my $narg = {%$arg};
+                @{$narg}{qw(device inode cwd prefix depth)}
+                    = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1);
+                $count += _rmtree($narg, \@files);
+            }
+
+            # restore directory permissions of required now (in case the rmdir
+            # below fails), while we are still in the directory and may do so
+            # without a race via '.'
+            if ($nperm != $perm and not chmod($perm, $curdir)) {
+                _error($arg, "cannot reset chmod", $canon);
+            }
+
+            # don't leave the client code in an unexpected directory
+            chdir($arg->{cwd})
+                or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting.");
+
+            # ensure that a chdir upwards didn't take us somewhere other
+            # than we expected (see CVE-2002-0435)
+            ($cur_dev, $cur_inode) = (stat $curdir)[0,1]
+                or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting.");
+
+            if ($Need_Stat_Check) {
+                ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode)
+                    or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
+            }
+
+            if ($arg->{depth} or !$arg->{keep_root}) {
+                if ($arg->{safe} &&
+                    ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+                    print "skipped $root\n" if $arg->{verbose};
+                    next ROOT_DIR;
+                }
+                if ($Force_Writeable and !chmod $perm | 0700, $root) {
+                    _error($arg, "cannot make directory writeable", $canon);
+                }
+                print "rmdir $root\n" if $arg->{verbose};
+                if (rmdir $root) {
+                    push @{${$arg->{result}}}, $root if $arg->{result};
+                    ++$count;
+                }
+                else {
+                    _error($arg, "cannot remove directory", $canon);
+                    if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+                    ) {
+                        _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
+                    }
+                }
+            }
+        }
+        else {
+            # not a directory
+            $root = VMS::Filespec::vmsify("./$root")
+                if $Is_VMS
+                   && !File::Spec->file_name_is_absolute($root)
+                   && ($root !~ m/(?<!\^)[\]>]+/);  # not already in VMS syntax
+
+            if ($arg->{safe} &&
+                ($Is_VMS ? !&VMS::Filespec::candelete($root)
+                         : !(-l $root || -w $root)))
+            {
+                print "skipped $root\n" if $arg->{verbose};
+                next ROOT_DIR;
+            }
+
+            my $nperm = $perm & 07777 | 0600;
+            if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) {
+                _error($arg, "cannot make file writeable", $canon);
+            }
+            print "unlink $canon\n" if $arg->{verbose};
+            # delete all versions under VMS
+            for (;;) {
+                if (unlink $root) {
+                    push @{${$arg->{result}}}, $root if $arg->{result};
+                }
+                else {
+                    _error($arg, "cannot unlink file", $canon);
+                    $Force_Writeable and chmod($perm, $root) or
+                        _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
+                    last;
+                }
+                ++$count;
+                last unless $Is_VMS && lstat $root;
+            }
+        }
+    }
+    return $count;
+}
+
+sub _slash_lc {
+    # fix up slashes and case on MSWin32 so that we can determine that
+    # c:\path\to\dir is underneath C:/Path/To
+    my $path = shift;
+    $path =~ tr{\\}{/};
+    return lc($path);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Path - Create or remove directory trees
+
+=head1 VERSION
+
+This document describes version 2.08 of File::Path, released
+2009-10-04.
+
+=head1 SYNOPSIS
+
+  use File::Path qw(make_path remove_tree);
+
+  make_path('foo/bar/baz', '/zug/zwang');
+  make_path('foo/bar/baz', '/zug/zwang', {
+      verbose => 1,
+      mode => 0711,
+  });
+
+  remove_tree('foo/bar/baz', '/zug/zwang');
+  remove_tree('foo/bar/baz', '/zug/zwang', {
+      verbose => 1,
+      error  => \my $err_list,
+  });
+
+  # legacy (interface promoted before v2.00)
+  mkpath('/foo/bar/baz');
+  mkpath('/foo/bar/baz', 1, 0711);
+  mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
+  rmtree('foo/bar/baz', 1, 1);
+  rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
+
+  # legacy (interface promoted before v2.06)
+  mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
+  rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
+
+=head1 DESCRIPTION
+
+This module provide a convenient way to create directories of
+arbitrary depth and to delete an entire directory subtree from the
+filesystem.
+
+The following functions are provided:
+
+=over
+
+=item make_path( $dir1, $dir2, .... )
+
+=item make_path( $dir1, $dir2, ...., \%opts )
+
+The C<make_path> function creates the given directories if they don't
+exists before, much like the Unix command C<mkdir -p>.
+
+The function accepts a list of directories to be created. Its
+behaviour may be tuned by an optional hashref appearing as the last
+parameter on the call.
+
+The function returns the list of directories actually created during
+the call; in scalar context the number of directories created.
+
+The following keys are recognised in the option hash:
+
+=over
+
+=item mode => $num
+
+The numeric permissions mode to apply to each created directory
+(defaults to 0777), to be modified by the current C<umask>. If the
+directory already exists (and thus does not need to be created),
+the permissions will not be modified.
+
+C<mask> is recognised as an alias for this parameter.
+
+=item verbose => $bool
+
+If present, will cause C<make_path> to print the name of each directory
+as it is created. By default nothing is printed.
+
+=item error => \$err
+
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store any errors that are encountered.  See the L</"ERROR
+HANDLING"> section for more information.
+
+If this parameter is not used, certain error conditions may raise
+a fatal error that will cause the program will halt, unless trapped
+in an C<eval> block.
+
+=item owner => $owner
+
+=item user => $owner
+
+=item uid => $owner
+
+If present, will cause any created directory to be owned by C<$owner>.
+If the value is numeric, it will be interpreted as a uid, otherwise
+as username is assumed. An error will be issued if the username cannot be
+mapped to a uid, or the uid does not exist, or the process lacks the
+privileges to change ownership.
+
+Ownwership of directories that already exist will not be changed.
+
+C<user> and C<uid> are aliases of C<owner>.
+
+=item group => $group
+
+If present, will cause any created directory to be owned by the group C<$group>.
+If the value is numeric, it will be interpreted as a gid, otherwise
+as group name is assumed. An error will be issued if the group name cannot be
+mapped to a gid, or the gid does not exist, or the process lacks the
+privileges to change group ownership.
+
+Group ownwership of directories that already exist will not be changed.
+
+    make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
+
+=back
+
+=item mkpath( $dir )
+
+=item mkpath( $dir, $verbose, $mode )
+
+=item mkpath( [$dir1, $dir2,...], $verbose, $mode )
+
+=item mkpath( $dir1, $dir2,..., \%opt )
+
+The mkpath() function provide the legacy interface of make_path() with
+a different interpretation of the arguments passed.  The behaviour and
+return value of the function is otherwise identical to make_path().
+
+=item remove_tree( $dir1, $dir2, .... )
+
+=item remove_tree( $dir1, $dir2, ...., \%opts )
+
+The C<remove_tree> function deletes the given directories and any
+files and subdirectories they might contain, much like the Unix
+command C<rm -r> or C<del /s> on Windows.
+
+The function accepts a list of directories to be
+removed. Its behaviour may be tuned by an optional hashref
+appearing as the last parameter on the call.
+
+The functions returns the number of files successfully deleted.
+
+The following keys are recognised in the option hash:
+
+=over
+
+=item verbose => $bool
+
+If present, will cause C<remove_tree> to print the name of each file as
+it is unlinked. By default nothing is printed.
+
+=item safe => $bool
+
+When set to a true value, will cause C<remove_tree> to skip the files
+for which the process lacks the required privileges needed to delete
+files, such as delete privileges on VMS. In other words, the code
+will make no attempt to alter file permissions. Thus, if the process
+is interrupted, no filesystem object will be left in a more
+permissive mode.
+
+=item keep_root => $bool
+
+When set to a true value, will cause all files and subdirectories
+to be removed, except the initially specified directories. This comes
+in handy when cleaning out an application's scratch directory.
+
+  remove_tree( '/tmp', {keep_root => 1} );
+
+=item result => \$res
+
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store all files and directories unlinked
+during the call. If nothing is unlinked, the array will be empty.
+
+  remove_tree( '/tmp', {result => \my $list} );
+  print "unlinked $_\n" for @$list;
+
+This is a useful alternative to the C<verbose> key.
+
+=item error => \$err
+
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store any errors that are encountered.  See the L</"ERROR
+HANDLING"> section for more information.
+
+Removing things is a much more dangerous proposition than
+creating things. As such, there are certain conditions that
+C<remove_tree> may encounter that are so dangerous that the only
+sane action left is to kill the program.
+
+Use C<error> to trap all that is reasonable (problems with
+permissions and the like), and let it die if things get out
+of hand. This is the safest course of action.
+
+=back
+
+=item rmtree( $dir )
+
+=item rmtree( $dir, $verbose, $safe )
+
+=item rmtree( [$dir1, $dir2,...], $verbose, $safe )
+
+=item rmtree( $dir1, $dir2,..., \%opt )
+
+The rmtree() function provide the legacy interface of remove_tree()
+with a different interpretation of the arguments passed. The behaviour
+and return value of the function is otherwise identical to
+remove_tree().
+
+=back
+
+=head2 ERROR HANDLING
+
+=over 4
+
+=item B<NOTE:>
+
+The following error handling mechanism is considered
+experimental and is subject to change pending feedback from
+users.
+
+=back
+
+If C<make_path> or C<remove_tree> encounter an error, a diagnostic
+message will be printed to C<STDERR> via C<carp> (for non-fatal
+errors), or via C<croak> (for fatal errors).
+
+If this behaviour is not desirable, the C<error> attribute may be
+used to hold a reference to a variable, which will be used to store
+the diagnostics. The variable is made a reference to an array of hash
+references.  Each hash contain a single key/value pair where the key
+is the name of the file, and the value is the error message (including
+the contents of C<$!> when appropriate).  If a general error is
+encountered the diagnostic key will be empty.
+
+An example usage looks like:
+
+  remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
+  if (@$err) {
+      for my $diag (@$err) {
+          my ($file, $message) = %$diag;
+          if ($file eq '') {
+              print "general error: $message\n";
+          }
+          else {
+              print "problem unlinking $file: $message\n";
+          }
+      }
+  }
+  else {
+      print "No error encountered\n";
+  }
+
+Note that if no errors are encountered, C<$err> will reference an
+empty array.  This means that C<$err> will always end up TRUE; so you
+need to test C<@$err> to determine if errors occured.
+
+=head2 NOTES
+
+C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
+current namespace. These days, this is considered bad style, but
+to change it now would break too much code. Nonetheless, you are
+invited to specify what it is you are expecting to use:
+
+  use File::Path 'rmtree';
+
+The routines C<make_path> and C<remove_tree> are B<not> exported
+by default. You must specify which ones you want to use.
+
+  use File::Path 'remove_tree';
+
+Note that a side-effect of the above is that C<mkpath> and C<rmtree>
+are no longer exported at all. This is due to the way the C<Exporter>
+module works. If you are migrating a codebase to use the new
+interface, you will have to list everything explicitly. But that's
+just good practice anyway.
+
+  use File::Path qw(remove_tree rmtree);
+
+=head3 API CHANGES
+
+The API was changed in the 2.0 branch. For a time, C<mkpath> and
+C<rmtree> tried, unsuccessfully, to deal with the two different
+calling mechanisms. This approach was considered a failure.
+
+The new semantics are now only available with C<make_path> and
+C<remove_tree>. The old semantics are only available through
+C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
+to at least 2.08 in order to avoid surprises.
+
+=head3 SECURITY CONSIDERATIONS
+
+There were race conditions 1.x implementations of File::Path's
+C<rmtree> function (although sometimes patched depending on the OS
+distribution or platform). The 2.0 version contains code to avoid the
+problem mentioned in CVE-2002-0435.
+
+See the following pages for more information:
+
+  http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905
+  http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html
+  http://www.debian.org/security/2005/dsa-696
+
+Additionally, unless the C<safe> parameter is set (or the
+third parameter in the traditional interface is TRUE), should a
+C<remove_tree> be interrupted, files that were originally in read-only
+mode may now have their permissions set to a read-write (or "delete
+OK") mode.
+
+=head1 DIAGNOSTICS
+
+FATAL errors will cause the program to halt (C<croak>), since the
+problem is so severe that it would be dangerous to continue. (This
+can always be trapped with C<eval>, but it's not a good idea. Under
+the circumstances, dying is the best thing to do).
+
+SEVERE errors may be trapped using the modern interface. If the
+they are not trapped, or the old interface is used, such an error
+will cause the program will halt.
+
+All other errors may be trapped using the modern interface, otherwise
+they will be C<carp>ed about. Program execution will not be halted.
+
+=over 4
+
+=item mkdir [path]: [errmsg] (SEVERE)
+
+C<make_path> was unable to create the path. Probably some sort of
+permissions error at the point of departure, or insufficient resources
+(such as free inodes on Unix).
+
+=item No root path(s) specified
+
+C<make_path> was not given any paths to create. This message is only
+emitted if the routine is called with the traditional interface.
+The modern interface will remain silent if given nothing to do.
+
+=item No such file or directory
+
+On Windows, if C<make_path> gives you this warning, it may mean that
+you have exceeded your filesystem's maximum path length.
+
+=item cannot fetch initial working directory: [errmsg]
+
+C<remove_tree> attempted to determine the initial directory by calling
+C<Cwd::getcwd>, but the call failed for some reason. No attempt
+will be made to delete anything.
+
+=item cannot stat initial working directory: [errmsg]
+
+C<remove_tree> attempted to stat the initial directory (after having
+successfully obtained its name via C<getcwd>), however, the call
+failed for some reason. No attempt will be made to delete anything.
+
+=item cannot chdir to [dir]: [errmsg]
+
+C<remove_tree> attempted to set the working directory in order to
+begin deleting the objects therein, but was unsuccessful. This is
+usually a permissions issue. The routine will continue to delete
+other things, but this directory will be left intact.
+
+=item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
+
+C<remove_tree> recorded the device and inode of a directory, and then
+moved into it. It then performed a C<stat> on the current directory
+and detected that the device and inode were no longer the same. As
+this is at the heart of the race condition problem, the program
+will die at this point.
+
+=item cannot make directory [dir] read+writeable: [errmsg]
+
+C<remove_tree> attempted to change the permissions on the current directory
+to ensure that subsequent unlinkings would not run into problems,
+but was unable to do so. The permissions remain as they were, and
+the program will carry on, doing the best it can.
+
+=item cannot read [dir]: [errmsg]
+
+C<remove_tree> tried to read the contents of the directory in order
+to acquire the names of the directory entries to be unlinked, but
+was unsuccessful. This is usually a permissions issue. The
+program will continue, but the files in this directory will remain
+after the call.
+
+=item cannot reset chmod [dir]: [errmsg]
+
+C<remove_tree>, after having deleted everything in a directory, attempted
+to restore its permissions to the original state but failed. The
+directory may wind up being left behind.
+
+=item cannot remove [dir] when cwd is [dir]
+
+The current working directory of the program is F</some/path/to/here>
+and you are attempting to remove an ancestor, such as F</some/path>.
+The directory tree is left untouched.
+
+The solution is to C<chdir> out of the child directory to a place
+outside the directory tree to be removed.
+
+=item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
+
+C<remove_tree>, after having deleted everything and restored the permissions
+of a directory, was unable to chdir back to the parent. The program
+halts to avoid a race condition from occurring.
+
+=item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
+
+C<remove_tree> was unable to stat the parent directory after have returned
+from the child. Since there is no way of knowing if we returned to
+where we think we should be (by comparing device and inode) the only
+way out is to C<croak>.
+
+=item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
+
+When C<remove_tree> returned from deleting files in a child directory, a
+check revealed that the parent directory it returned to wasn't the one
+it started out from. This is considered a sign of malicious activity.
+
+=item cannot make directory [dir] writeable: [errmsg]
+
+Just before removing a directory (after having successfully removed
+everything it contained), C<remove_tree> attempted to set the permissions
+on the directory to ensure it could be removed and failed. Program
+execution continues, but the directory may possibly not be deleted.
+
+=item cannot remove directory [dir]: [errmsg]
+
+C<remove_tree> attempted to remove a directory, but failed. This may because
+some objects that were unable to be removed remain in the directory, or
+a permissions issue. The directory will be left behind.
+
+=item cannot restore permissions of [dir] to [0nnn]: [errmsg]
+
+After having failed to remove a directory, C<remove_tree> was unable to
+restore its permissions from a permissive state back to a possibly
+more restrictive setting. (Permissions given in octal).
+
+=item cannot make file [file] writeable: [errmsg]
+
+C<remove_tree> attempted to force the permissions of a file to ensure it
+could be deleted, but failed to do so. It will, however, still attempt
+to unlink the file.
+
+=item cannot unlink file [file]: [errmsg]
+
+C<remove_tree> failed to remove a file. Probably a permissions issue.
+
+=item cannot restore permissions of [file] to [0nnn]: [errmsg]
+
+After having failed to remove a file, C<remove_tree> was also unable
+to restore the permissions on the file to a possibly less permissive
+setting. (Permissions given in octal).
+
+=item unable to map [owner] to a uid, ownership not changed");
+
+C<make_path> was instructed to give the ownership of created
+directories to the symbolic name [owner], but C<getpwnam> did
+not return the corresponding numeric uid. The directory will
+be created, but ownership will not be changed.
+
+=item unable to map [group] to a gid, group ownership not changed
+
+C<make_path> was instructed to give the group ownership of created
+directories to the symbolic name [group], but C<getgrnam> did
+not return the corresponding numeric gid. The directory will
+be created, but group ownership will not be changed.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<File::Remove>
+
+Allows files and directories to be moved to the Trashcan/Recycle
+Bin (where they may later be restored if necessary) if the operating
+system supports such functionality. This feature may one day be
+made available directly in C<File::Path>.
+
+=item *
+
+L<File::Find::Rule>
+
+When removing directory trees, if you want to examine each file to
+decide whether to delete it (and possibly leaving large swathes
+alone), F<File::Find::Rule> offers a convenient and flexible approach
+to examining directory trees.
+
+=back
+
+=head1 BUGS
+
+Please report all bugs on the RT queue:
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path>
+
+=head1 ACKNOWLEDGEMENTS
+
+Paul Szabo identified the race condition originally, and Brendan
+O'Dea wrote an implementation for Debian that addressed the problem.
+That code was used as a basis for the current code. Their efforts
+are greatly appreciated.
+
+Gisle Aas made a number of improvements to the documentation for
+2.07 and his advice and assistance is also greatly appreciated.
+
+=head1 AUTHORS
+
+Tim Bunce and Charles Bailey. Currently maintained by David Landgren
+<F<david@landgren.net>>.
+
+=head1 COPYRIGHT
+
+This module is copyright (C) Charles Bailey, Tim Bunce and
+David Landgren 1995-2009. All rights reserved.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/File/Spec.pm b/Master/tlpkg/tlperl/lib/File/Spec.pm
new file mode 100644
index 00000000000..9caf4eba0d0
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec.pm
@@ -0,0 +1,336 @@
+package File::Spec;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+$VERSION = '3.31_01';
+$VERSION = eval $VERSION;
+
+my %module = (MacOS   => 'Mac',
+	      MSWin32 => 'Win32',
+	      os2     => 'OS2',
+	      VMS     => 'VMS',
+	      epoc    => 'Epoc',
+	      NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
+	      symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
+	      dos     => 'OS2',   # Yes, File::Spec::OS2 works on DJGPP.
+	      cygwin  => 'Cygwin');
+
+
+my $module = $module{$^O} || 'Unix';
+
+require "File/Spec/$module.pm";
+@ISA = ("File::Spec::$module");
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Spec - portably perform operations on file names
+
+=head1 SYNOPSIS
+
+	use File::Spec;
+
+	$x=File::Spec->catfile('a', 'b', 'c');
+
+which returns 'a/b/c' under Unix. Or:
+
+	use File::Spec::Functions;
+
+	$x = catfile('a', 'b', 'c');
+
+=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 facilities available
+only under that OS, it may not be possible to load all modules under all
+operating systems.
+
+Since File::Spec is object oriented, subroutines should not be called directly,
+as in:
+
+	File::Spec::catfile('a','b');
+
+but rather as class methods:
+
+	File::Spec->catfile('a','b');
+
+For simple uses, L<File::Spec::Functions> provides convenient functional
+forms of these methods.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+X<canonpath>
+
+No physical check on the filesystem, but a logical cleanup of a
+path.
+
+    $cpath = File::Spec->canonpath( $path ) ;
+
+Note that this does *not* collapse F<x/../y> sections into F<y>.  This
+is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
+then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
+F<../>-removal would give you.  If you want to do this kind of
+processing, you probably want C<Cwd>'s C<realpath()> function to
+actually traverse the filesystem cleaning up paths like this.
+
+=item catdir
+X<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
+OS/2. Of course, if this is the root directory, don't cut off the
+trailing slash :-)
+
+    $path = File::Spec->catdir( @directories );
+
+=item catfile
+X<catfile>
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+    $path = File::Spec->catfile( @directories, $filename );
+
+=item curdir
+X<curdir>
+
+Returns a string representation of the current directory.
+
+    $curdir = File::Spec->curdir();
+
+=item devnull
+X<devnull>
+
+Returns a string representation of the null device.
+
+    $devnull = File::Spec->devnull();
+
+=item rootdir
+X<rootdir>
+
+Returns a string representation of the root directory.
+
+    $rootdir = File::Spec->rootdir();
+
+=item tmpdir
+X<tmpdir>
+
+Returns a string representation of the first writable directory from a
+list of possible temporary directories.  Returns the current directory
+if no writable temporary directories are found.  The list of directories
+checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}>
+(unless taint is on) and F</tmp>.
+
+    $tmpdir = File::Spec->tmpdir();
+
+=item updir
+X<updir>
+
+Returns a string representation of the parent directory.
+
+    $updir = File::Spec->updir();
+
+=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.)
+
+    @paths = File::Spec->no_upwards( @paths );
+
+=item case_tolerant
+
+Returns a true or false value indicating, respectively, that alphabetic
+case is not or is significant when comparing file specifications.
+
+    $is_case_tolerant = File::Spec->case_tolerant();
+
+=item file_name_is_absolute
+
+Takes as its argument a path, and returns true if it is an absolute path.
+
+    $is_absolute = File::Spec->file_name_is_absolute( $path );
+
+This does not consult the local filesystem on Unix, Win32, OS/2, or
+Mac OS (Classic).  It does consult the working environment for VMS
+(see L<File::Spec::VMS/file_name_is_absolute>).
+
+=item path
+X<path>
+
+Takes no argument.  Returns the environment variable C<PATH> (or the local
+platform's equivalent) as a list.
+
+    @PATH = File::Spec->path();
+
+=item join
+X<join, path>
+
+join is the same as catfile.
+
+=item splitpath
+X<splitpath> X<split, path>
+
+Splits a path in to volume, directory, and filename portions. On systems
+with no concept of volume, returns '' for volume. 
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+For systems with no syntax differentiating filenames from directories, 
+assumes that the last file is a path unless C<$no_file> is true or a
+trailing separator or F</.> or F</..> is present. On Unix, this means that C<$no_file>
+true makes this return ( '', $path, '' ).
+
+The directory portion may or may not be returned with a trailing '/'.
+
+The results can be passed to L</catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+=item splitdir
+X<splitdir> X<split, dir>
+
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+C<$directories> must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, empty
+directory names (C<''>) can be returned, because these are significant
+on some OSes.
+
+=item catpath()
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, C<$volume> is ignored, and directory and file are concatenated.  A '/' is
+inserted if need be.  On other OSes, C<$volume> is significant.
+
+    $full_path = File::Spec->catpath( $volume, $directory, $file );
+
+=item abs2rel
+X<abs2rel> X<absolute, path> X<relative, path>
+
+Takes a destination path and an optional base path returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $path ) ;
+    $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is
+relative, then it is converted to absolute form using
+L</rel2abs()>. This means that it is taken to be relative to
+L<Cwd::cwd()|Cwd>.
+
+On systems with the concept of volume, if C<$path> and C<$base> appear to be
+on two different volumes, we will not attempt to resolve the two
+paths, and we will instead simply return C<$path>.  Note that previous
+versions of this module ignored the volume of C<$base>, which resulted in
+garbage results part of the time.
+
+On systems that have a grammar that indicates filenames, this ignores the 
+C<$base> filename as well. Otherwise all path components are assumed to be
+directories.
+
+If C<$path> is relative, it is converted to absolute form using L</rel2abs()>.
+This means that it is taken to be relative to L<Cwd::cwd()|Cwd>.
+
+No checks against the filesystem are made.  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=item rel2abs()
+X<rel2abs> X<absolute, path> X<relative, path>
+
+Converts a relative path to an absolute path. 
+
+    $abs_path = File::Spec->rel2abs( $path ) ;
+    $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is relative,
+then it is converted to absolute form using L</rel2abs()>. This means that it
+is taken to be relative to L<Cwd::cwd()|Cwd>.
+
+On systems with the concept of volume, if C<$path> and C<$base> appear to be
+on two different volumes, we will not attempt to resolve the two
+paths, and we will instead simply return C<$path>.  Note that previous
+versions of this module ignored the volume of C<$base>, which resulted in
+garbage results part of the time.
+
+On systems that have a grammar that indicates filenames, this ignores the 
+C<$base> filename as well. Otherwise all path components are assumed to be
+directories.
+
+If C<$path> is absolute, it is cleaned up and returned using L</canonpath()>.
+
+No checks against the filesystem are made.  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=back
+
+For further information, please see L<File::Spec::Unix>,
+L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or
+L<File::Spec::VMS>.
+
+=head1 SEE ALSO
+
+L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>,
+L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>,
+L<ExtUtils::MakeMaker>
+
+=head1 AUTHOR
+
+Currently maintained by Ken Williams C<< <KWILLIAMS@cpan.org> >>.
+
+The vast majority of the code was written by
+Kenneth Albanowski C<< <kjahds@kjahds.com> >>,
+Andy Dougherty C<< <doughera@lafayette.edu> >>,
+Andreas KE<ouml>nig C<< <A.Koenig@franz.ww.TU-Berlin.DE> >>,
+Tim Bunce C<< <Tim.Bunce@ig.co.uk> >>.
+VMS support by Charles Bailey C<< <bailey@newman.upenn.edu> >>.
+OS/2 support by Ilya Zakharevich C<< <ilya@math.ohio-state.edu> >>.
+Mac support by Paul Schinder C<< <schinder@pobox.com> >>, and
+Thomas Wegner C<< <wegner_thomas@yahoo.com> >>.
+abs2rel() and rel2abs() written by Shigio Yamaguchi C<< <shigio@tamacom.com> >>,
+modified by Barrie Slaymaker C<< <barries@slaysys.com> >>.
+splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm b/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm
new file mode 100644
index 00000000000..050a1bb2b77
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm
@@ -0,0 +1,155 @@
+package File::Spec::Cygwin;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Cygwin - methods for Cygwin file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Cygwin; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+This module is still in beta.  Cygwin-knowledgeable folks are invited
+to offer patches and suggestions.
+
+=cut
+
+=pod
+
+=over 4
+
+=item canonpath
+
+Any C<\> (backslashes) are converted to C</> (forward slashes),
+and then File::Spec::Unix canonpath() is called on the result.
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+    return unless defined $path;
+
+    $path =~ s|\\|/|g;
+
+    # Handle network path names beginning with double slash
+    my $node = '';
+    if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
+        $node = $1;
+    }
+    return $node . $self->SUPER::canonpath($path);
+}
+
+sub catdir {
+    my $self = shift;
+    return unless @_;
+
+    # Don't create something that looks like a //network/path
+    if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
+        shift;
+        return $self->SUPER::catdir('', @_);
+    }
+
+    $self->SUPER::catdir(@_);
+}
+
+=pod
+
+=item file_name_is_absolute
+
+True is returned if the file name begins with C<drive_letter:>,
+and if not, File::Spec::Unix file_name_is_absolute() is called.
+
+=cut
+
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
+    return $self->SUPER::file_name_is_absolute($file);
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first existing directory
+from the following list:
+
+    $ENV{TMPDIR}
+    /tmp
+    $ENV{'TMP'}
+    $ENV{'TEMP'}
+    C:/temp
+
+Since Perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
+}
+
+=item case_tolerant
+
+Override Unix. Cygwin case-tolerance depends on managed mount settings and
+as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
+indicating the case significance when comparing file specifications.
+Default: 1
+
+=cut
+
+sub case_tolerant {
+  return 1 unless $^O eq 'cygwin'
+    and defined &Cygwin::mount_flags;
+
+  my $drive = shift;
+  if (! $drive) {
+      my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
+      my $prefix = pop(@flags);
+      if (! $prefix || $prefix eq 'cygdrive') {
+          $drive = '/cygdrive/c';
+      } elsif ($prefix eq '/') {
+          $drive = '/c';
+      } else {
+          $drive = "$prefix/c";
+      }
+  }
+  my $mntopts = Cygwin::mount_flags($drive);
+  if ($mntopts and ($mntopts =~ /,managed/)) {
+    return 0;
+  }
+  eval { require Win32API::File; } or return 1;
+  my $osFsType = "\0"x256;
+  my $osVolName = "\0"x256;
+  my $ouFsFlags = 0;
+  Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
+  if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
+  else { return 1; }
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm b/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm
new file mode 100644
index 00000000000..54ff667c52f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm
@@ -0,0 +1,79 @@
+package File::Spec::Epoc;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+require File::Spec::Unix;
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Epoc - methods for Epoc file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Epoc; # 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.
+
+This package is still work in progress ;-)
+
+=cut
+
+sub case_tolerant {
+    return 1;
+}
+
+=pod
+
+=over 4
+
+=item canonpath()
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=back
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    return unless defined $path;
+
+    $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
+    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
+    $path =~  s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
+    return $path;
+}
+
+=pod
+
+=head1 AUTHOR
+
+o.flebbe@gmx.de
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm b/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm
new file mode 100644
index 00000000000..e7becc7cfae
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm
@@ -0,0 +1,110 @@
+package File::Spec::Functions;
+
+use File::Spec;
+use strict;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+	canonpath
+	catdir
+	catfile
+	curdir
+	rootdir
+	updir
+	no_upwards
+	file_name_is_absolute
+	path
+);
+
+@EXPORT_OK = qw(
+	devnull
+	tmpdir
+	splitpath
+	splitdir
+	catpath
+	abs2rel
+	rel2abs
+	case_tolerant
+);
+
+%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
+
+foreach my $meth (@EXPORT, @EXPORT_OK) {
+    my $sub = File::Spec->can($meth);
+    no strict 'refs';
+    *{$meth} = sub {&$sub('File::Spec', @_)};
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec::Functions - portably perform operations on file names
+
+=head1 SYNOPSIS
+
+	use File::Spec::Functions;
+	$x = catfile('a','b');
+
+=head1 DESCRIPTION
+
+This module exports convenience functions for all of the class methods
+provided by File::Spec.
+
+For a reference of available functions, please consult L<File::Spec::Unix>,
+which contains the entire set, and which is 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>.
+
+=head2 Exports
+
+The following functions are exported by default.
+
+	canonpath
+	catdir
+	catfile
+	curdir
+	rootdir
+	updir
+	no_upwards
+	file_name_is_absolute
+	path
+
+
+The following functions are exported only by request.
+
+	devnull
+	tmpdir
+	splitpath
+	splitdir
+	catpath
+	abs2rel
+	rel2abs
+	case_tolerant
+
+All the functions may be imported using the C<:ALL> tag.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
+File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm b/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm
new file mode 100644
index 00000000000..8b47470d6b3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm
@@ -0,0 +1,781 @@
+package File::Spec::Mac;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+@ISA = qw(File::Spec::Unix);
+
+my $macfiles;
+if ($^O eq 'MacOS') {
+	$macfiles = eval { require Mac::Files };
+}
+
+sub case_tolerant { 1 }
+
+
+=head1 NAME
+
+File::Spec::Mac - File::Spec for Mac OS (Classic)
+
+=head1 SYNOPSIS
+
+ require File::Spec::Mac; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+On Mac OS, there's nothing to be done. Returns what it's given.
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    return $path;
+}
+
+=item catdir()
+
+Concatenate two or more directory names to form a path separated by colons
+(":") ending with a directory. Resulting paths are B<relative> by default,
+but can be forced to be absolute (but avoid this, see below). Automatically
+puts a trailing ":" on the end of the complete path, because that's what's
+done in MacPerl's environment and helps to distinguish a file path from a
+directory path.
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
+path is relative by default and I<not> absolute. This decision was made due
+to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
+on all other operating systems, it will now also follow this convention on Mac
+OS. Note that this may break some existing scripts.
+
+The intended purpose of this routine is to concatenate I<directory names>.
+But because of the nature of Macintosh paths, some additional possibilities
+are allowed to make using this routine give reasonable results for some
+common situations. In other words, you are also allowed to concatenate
+I<paths> instead of directory names (strictly speaking, a string like ":a"
+is a path, but not a name, since it contains a punctuation character ":").
+
+So, beside calls like
+
+    catdir("a") = ":a:"
+    catdir("a","b") = ":a:b:"
+    catdir() = ""                    (special case)
+
+calls like the following
+
+    catdir(":a:") = ":a:"
+    catdir(":a","b") = ":a:b:"
+    catdir(":a:","b") = ":a:b:"
+    catdir(":a:",":b:") = ":a:b:"
+    catdir(":") = ":"
+
+are allowed.
+
+Here are the rules that are used in C<catdir()>; note that we try to be as
+compatible as possible to Unix:
+
+=over 2
+
+=item 1.
+
+The resulting path is relative by default, i.e. the resulting path will have a
+leading colon.
+
+=item 2.
+
+A trailing colon is added automatically to the resulting path, to denote a
+directory.
+
+=item 3.
+
+Generally, each argument has one leading ":" and one trailing ":"
+removed (if any). They are then joined together by a ":". Special
+treatment applies for arguments denoting updir paths like "::lib:",
+see (4), or arguments consisting solely of colons ("colon paths"),
+see (5).
+
+=item 4.
+
+When an updir path like ":::lib::" is passed as argument, the number
+of directories to climb up is handled correctly, not removing leading
+or trailing colons when necessary. E.g.
+
+    catdir(":::a","::b","c")    = ":::a::b:c:"
+    catdir(":::a::","::b","c")  = ":::a:::b:c:"
+
+=item 5.
+
+Adding a colon ":" or empty string "" to a path at I<any> position
+doesn't alter the path, i.e. these arguments are ignored. (When a ""
+is passed as the first argument, it has a special meaning, see
+(6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
+while an empty string "" is generally ignored (see
+C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
+(updir), and a ":::" is handled like a "../.." etc.  E.g.
+
+    catdir("a",":",":","b")   = ":a:b:"
+    catdir("a",":","::",":b") = ":a::b:"
+
+=item 6.
+
+If the first argument is an empty string "" or is a volume name, i.e. matches
+the pattern /^[^:]+:/, the resulting path is B<absolute>.
+
+=item 7.
+
+Passing an empty string "" as the first argument to C<catdir()> is
+like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
+
+    catdir("","a","b")          is the same as
+
+    catdir(rootdir(),"a","b").
+
+This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
+C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
+volume, which is the closest in concept to Unix' "/". This should help
+to run existing scripts originally written for Unix.
+
+=item 8.
+
+For absolute paths, some cleanup is done, to ensure that the volume
+name isn't immediately followed by updirs. This is invalid, because
+this would go beyond "root". Generally, these cases are handled like
+their Unix counterparts:
+
+ Unix:
+    Unix->catdir("","")                 =  "/"
+    Unix->catdir("",".")                =  "/"
+    Unix->catdir("","..")               =  "/"              # can't go beyond root
+    Unix->catdir("",".","..","..","a")  =  "/a"
+ Mac:
+    Mac->catdir("","")                  =  rootdir()         # (e.g. "HD:")
+    Mac->catdir("",":")                 =  rootdir()
+    Mac->catdir("","::")                =  rootdir()         # can't go beyond root
+    Mac->catdir("",":","::","::","a")   =  rootdir() . "a:"  # (e.g. "HD:a:")
+
+However, this approach is limited to the first arguments following
+"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
+arguments that move up the directory tree, an invalid path going
+beyond root can be created.
+
+=back
+
+As you've seen, you can force C<catdir()> to create an absolute path
+by passing either an empty string or a path that begins with a volume
+name as the first argument. However, you are strongly encouraged not
+to do so, since this is done only for backward compatibility. Newer
+versions of File::Spec come with a method called C<catpath()> (see
+below), that is designed to offer a portable solution for the creation
+of absolute paths.  It takes volume, directory and file portions and
+returns an entire path. While C<catdir()> is still suitable for the
+concatenation of I<directory names>, you are encouraged to use
+C<catpath()> to concatenate I<volume names> and I<directory
+paths>. E.g.
+
+    $dir      = File::Spec->catdir("tmp","sources");
+    $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
+
+yields
+
+    "MacintoshHD:tmp:sources:" .
+
+=cut
+
+sub catdir {
+	my $self = shift;
+	return '' unless @_;
+	my @args = @_;
+	my $first_arg;
+	my $relative;
+
+	# take care of the first argument
+
+	if ($args[0] eq '')  { # absolute path, rootdir
+		shift @args;
+		$relative = 0;
+		$first_arg = $self->rootdir;
+
+	} elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
+		$relative = 0;
+		$first_arg = shift @args;
+		# add a trailing ':' if need be (may be it's a path like HD:dir)
+		$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+
+	} else { # relative path
+		$relative = 1;
+		if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
+			# updir colon path ('::', ':::' etc.), don't shift
+			$first_arg = ':';
+		} elsif ($args[0] eq ':') {
+			$first_arg = shift @args;
+		} else {
+			# add a trailing ':' if need be
+			$first_arg = shift @args;
+			$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+		}
+	}
+
+	# For all other arguments,
+	# (a) ignore arguments that equal ':' or '',
+	# (b) handle updir paths specially:
+	#     '::' 			-> concatenate '::'
+	#     '::' . '::' 	-> concatenate ':::' etc.
+	# (c) add a trailing ':' if need be
+
+	my $result = $first_arg;
+	while (@args) {
+		my $arg = shift @args;
+		unless (($arg eq '') || ($arg eq ':')) {
+			if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
+				my $updir_count = length($arg) - 1;
+				while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
+					$arg = shift @args;
+					$updir_count += (length($arg) - 1);
+				}
+				$arg = (':' x $updir_count);
+			} else {
+				$arg =~ s/^://s; # remove a leading ':' if any
+				$arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
+			}
+			$result .= $arg;
+		}#unless
+	}
+
+	if ( ($relative) && ($result !~ /^:/) ) {
+		# add a leading colon if need be
+		$result = ":$result";
+	}
+
+	unless ($relative) {
+		# remove updirs immediately following the volume name
+		$result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
+	}
+
+	return $result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename. Resulting paths are B<relative>
+by default, but can be forced to be absolute (but avoid this).
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
+resulting path is relative by default and I<not> absolute. This
+decision was made due to portability reasons. Since
+C<File::Spec-E<gt>catfile()> returns relative paths on all other
+operating systems, it will now also follow this convention on Mac OS.
+Note that this may break some existing scripts.
+
+The last argument is always considered to be the file portion. Since
+C<catfile()> uses C<catdir()> (see above) for the concatenation of the
+directory portions (if any), the following with regard to relative and
+absolute paths is true:
+
+    catfile("")     = ""
+    catfile("file") = "file"
+
+but
+
+    catfile("","")        = rootdir()         # (e.g. "HD:")
+    catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
+    catfile("HD:","file") = "HD:file"
+
+This means that C<catdir()> is called only when there are two or more
+arguments, as one might expect.
+
+Note that the leading ":" is removed from the filename, so that
+
+    catfile("a","b","file")  = ":a:b:file"    and
+
+    catfile("a","b",":file") = ":a:b:file"
+
+give the same answer.
+
+To concatenate I<volume names>, I<directory paths> and I<filenames>,
+you are encouraged to use C<catpath()> (see below).
+
+=cut
+
+sub catfile {
+    my $self = shift;
+    return '' unless @_;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $file =~ s/^://s;
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representing the current directory. On Mac OS, this is ":".
+
+=cut
+
+sub curdir {
+    return ":";
+}
+
+=item devnull
+
+Returns a string representing the null device. On Mac OS, this is "Dev:Null".
+
+=cut
+
+sub devnull {
+    return "Dev:Null";
+}
+
+=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. The name has a
+trailing ":", because that's the correct specification for a volume
+name on Mac OS.
+
+If Mac::Files could not be loaded, the empty string is returned.
+
+=cut
+
+sub rootdir {
+#
+#  There's no real root directory on Mac OS. The name of the startup
+#  volume is returned, since that's the closest in concept.
+#
+    return '' unless $macfiles;
+    my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+	&Mac::Files::kSystemFolderType);
+    $system =~ s/:.*\Z(?!\n)/:/s;
+    return $system;
+}
+
+=item tmpdir
+
+Returns the contents of $ENV{TMPDIR}, if that directory exits or the
+current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
+contain a path like "MacintoshHD:Temporary Items:", which is a hidden
+directory on your startup volume.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
+}
+
+=item updir
+
+Returns a string representing the parent directory. On Mac OS, this is "::".
+
+=cut
+
+sub updir {
+    return "::";
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, if it is an absolute path.
+If the path has a leading ":", it's a relative path. Otherwise, it's an
+absolute path, unless the path doesn't contain any colons, i.e. it's a name
+like "a". In this particular case, the path is considered to be relative
+(i.e. it is considered to be a filename). Use ":" in the appropriate place
+in the path if you want to distinguish unambiguously. As a special case,
+the filename '' is always considered to be absolute. Note that with version
+1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
+
+E.g.
+
+    File::Spec->file_name_is_absolute("a");             # false (relative)
+    File::Spec->file_name_is_absolute(":a:b:");         # false (relative)
+    File::Spec->file_name_is_absolute("MacintoshHD:");  # true (absolute)
+    File::Spec->file_name_is_absolute("");              # true (absolute)
+
+
+=cut
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    if ($file =~ /:/) {
+	return (! ($file =~ m/^:/s) );
+    } elsif ( $file eq '' ) {
+        return 1 ;
+    } else {
+	return 0; # i.e. a file like "a"
+    }
+}
+
+=item path
+
+Returns the null list for the MacPerl application, since the concept is
+usually meaningless under Mac OS. 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.
+#
+    return unless exists $ENV{Commands};
+    return split(/,/, $ENV{Commands});
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path into volume, directory, and filename portions.
+
+On Mac OS, assumes that the last part of the path is a filename unless
+$no_file is true or a trailing separator ":" is present.
+
+The volume portion is always returned with a trailing ":". The directory portion
+is always returned with a leading (to denote a relative path) and a trailing ":"
+(to denote a directory). The file portion is always returned I<without> a leading ":".
+Empty portions are returned as empty string ''.
+
+The results can be passed to C<catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+    my ($volume,$directory,$file);
+
+    if ( $nofile ) {
+        ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
+    }
+    else {
+        $path =~
+            m|^( (?: [^:]+: )? )
+               ( (?: .*: )? )
+               ( .* )
+             |xs;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    $volume = '' unless defined($volume);
+	$directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
+    if ($directory) {
+        # Make sure non-empty directories begin and end in ':'
+        $directory .= ':' unless (substr($directory,-1) eq ':');
+        $directory = ":$directory" unless (substr($directory,0,1) eq ':');
+    } else {
+	$directory = '';
+    }
+    $file = '' unless defined($file);
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of C<catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories should be only the directory portion of the path on systems
+that have the concept of a volume or that have path syntax that differentiates
+files from directories. Consider using C<splitpath()> otherwise.
+
+Unlike just splitting the directories on the separator, empty directory names
+(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
+colon to distinguish a directory path from a file path, a single trailing colon
+will be ignored, i.e. there's no empty directory name after it.
+
+Hence, on Mac OS, both
+
+    File::Spec->splitdir( ":a:b::c:" );    and
+    File::Spec->splitdir( ":a:b::c" );
+
+yield:
+
+    ( "a", "b", "::", "c")
+
+while
+
+    File::Spec->splitdir( ":a:b::c::" );
+
+yields:
+
+    ( "a", "b", "::", "c", "::")
+
+
+=cut
+
+sub splitdir {
+	my ($self, $path) = @_;
+	my @result = ();
+	my ($head, $sep, $tail, $volume, $directories);
+
+	return @result if ( (!defined($path)) || ($path eq '') );
+	return (':') if ($path eq ':');
+
+	( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
+
+	# deprecated, but handle it correctly
+	if ($volume) {
+		push (@result, $volume);
+		$sep .= ':';
+	}
+
+	while ($sep || $directories) {
+		if (length($sep) > 1) {
+			my $updir_count = length($sep) - 1;
+			for (my $i=0; $i<$updir_count; $i++) {
+				# push '::' updir_count times;
+				# simulate Unix '..' updirs
+				push (@result, '::');
+			}
+		}
+		$sep = '';
+		if ($directories) {
+			( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
+			push (@result, $head);
+			$directories = $tail;
+		}
+	}
+	return @result;
+}
+
+
+=item catpath
+
+    $path = File::Spec->catpath($volume,$directory,$file);
+
+Takes volume, directory and file portions and returns an entire path. On Mac OS,
+$volume, $directory and $file are concatenated.  A ':' is inserted if need be. You
+may pass an empty string for each portion. If all portions are empty, the empty
+string is returned. If $volume is empty, the result will be a relative path,
+beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
+is removed form $file and the remainder is returned. If $file is empty, the
+resulting path will have a trailing ':'.
+
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    if ( (! $volume) && (! $directory) ) {
+	$file =~ s/^:// if $file;
+	return $file ;
+    }
+
+    # We look for a volume in $volume, then in $directory, but not both
+
+    my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
+
+    $volume = $dir_volume unless length $volume;
+    my $path = $volume; # may be ''
+    $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
+
+    if ($directory) {
+	$directory = $dir_dirs if $volume;
+	$directory =~ s/^://; # remove leading ':' if any
+	$path .= $directory;
+	$path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
+    }
+
+    if ($file) {
+	$file =~ s/^://; # remove leading ':' if any
+	$path .= $file;
+    }
+
+    return $path;
+}
+
+=item abs2rel
+
+Takes a destination path and an optional base path and returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $path ) ;
+    $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then the current working directory is used.
+If $base is relative, then it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+If $path and $base appear to be on two different volumes, we will not
+attempt to resolve the two paths, and we will instead simply return
+$path.  Note that previous versions of this module ignored the volume
+of $base, which resulted in garbage results part of the time.
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename.  This filename is ignored.  Otherwise all path
+components are assumed to be directories.
+
+If $path is relative, it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+Based on code written by Shigio Yamaguchi.
+
+
+=cut
+
+# maybe this should be done in canonpath() ?
+sub _resolve_updirs {
+	my $path = shift @_;
+	my $proceed;
+
+	# resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
+	do {
+		$proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
+	} while ($proceed);
+
+	return $path;
+}
+
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( !defined( $base ) || $base eq '' ) {
+	$base = $self->_cwd();
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+	$base = _resolve_updirs( $base ); # resolve updirs in $base
+    }
+    else {
+	$base = _resolve_updirs( $base );
+    }
+
+    # Split up paths - ignore $base's file
+    my ( $path_vol, $path_dirs, $path_file ) =  $self->splitpath( $path );
+    my ( $base_vol, $base_dirs )             =  $self->splitpath( $base );
+
+    return $path unless lc( $path_vol ) eq lc( $base_vol );
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_dirs );
+    my @basechunks = $self->splitdir( $base_dirs );
+	
+    while ( @pathchunks &&
+	    @basechunks &&
+	    lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # @pathchunks now has the directories to descend in to.
+    # ensure relative path, even if @pathchunks is empty
+    $path_dirs = $self->catdir( ':', @pathchunks );
+
+    # @basechunks now contains the number of directories to climb out of.
+    $base_dirs = (':' x @basechunks) . ':' ;
+
+    return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path:
+
+    $abs_path = File::Spec->rel2abs( $path ) ;
+    $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then $base is set to the current working
+directory. If $base is relative, then it is converted to absolute form
+using C<rel2abs()>. This means that it is taken to be relative to the
+current working directory.
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename.  This filename is ignored.  Otherwise all path
+components are assumed to be directories.
+
+If $path is already absolute, it is returned and $base is ignored.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub rel2abs {
+    my ($self,$path,$base) = @_;
+
+    if ( ! $self->file_name_is_absolute($path) ) {
+        # Figure out the effective $base and clean it up.
+        if ( !defined( $base ) || $base eq '' ) {
+	    $base = $self->_cwd();
+        }
+        elsif ( ! $self->file_name_is_absolute($base) ) {
+            $base = $self->rel2abs($base) ;
+        }
+
+	# Split up paths
+
+	# igonore $path's volume
+        my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
+
+        # ignore $base's file part
+	my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
+
+	# Glom them together
+	$path_dirs = ':' if ($path_dirs eq '');
+	$base_dirs =~ s/:$//; # remove trailing ':', if any
+	$base_dirs = $base_dirs . $path_dirs;
+
+        $path = $self->catpath( $base_vol, $base_dirs, $path_file );
+    }
+    return $path;
+}
+
+
+=back
+
+=head1 AUTHORS
+
+See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
+<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm b/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm
new file mode 100644
index 00000000000..a8fa63e3c16
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm
@@ -0,0 +1,274 @@
+package File::Spec::OS2;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+@ISA = qw(File::Spec::Unix);
+
+sub devnull {
+    return "/dev/nul";
+}
+
+sub case_tolerant {
+    return 1;
+}
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
+}
+
+sub path {
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g;
+    my @path = split(';',$path);
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
+}
+
+sub _cwd {
+    # In OS/2 the "require Cwd" is unnecessary bloat.
+    return Cwd::sys_cwd();
+}
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my @d = @ENV{qw(TMPDIR TEMP TMP)};	# function call could autovivivy
+    $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/'  );
+}
+
+sub catdir {
+    my $self = shift;
+    my @args = @_;
+    foreach (@args) {
+	tr[\\][/];
+        # append a backslash to each argument unless it has one there
+        $_ .= "/" unless m{/$};
+    }
+    return $self->canonpath(join('', @args));
+}
+
+sub canonpath {
+    my ($self,$path) = @_;
+    return unless defined $path;
+
+    $path =~ s/^([a-z]:)/\l$1/s;
+    $path =~ s|\\|/|g;
+    $path =~ s|([^/])/+|$1/|g;                  # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g;                     # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+(?=[^/])||s;		# ./xx      -> xx
+    $path =~ s|/\Z(?!\n)||
+             unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/       -> xx
+    $path =~ s{^/\.\.$}{/};                     # /..    -> /
+    1 while $path =~ s{^/\.\.}{};               # /../xx -> /xx
+    return $path;
+}
+
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+    my ($volume,$directory,$file) = ('','','');
+    if ( $nofile ) {
+        $path =~ 
+            m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
+                 (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+    }
+    else {
+        $path =~ 
+            m{^ ( (?: [a-zA-Z]: |
+                      (?:\\\\|//)[^\\/]+[\\/][^\\/]+
+                  )?
+                )
+                ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
+                (.*)
+             }xs;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    split m|[\\/]|, $directories, -1;
+}
+
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    # If it's UNC, make sure the glue separator is there, reusing
+    # whatever separator is first in the $volume
+    $volume .= $1
+        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
+             $directory =~ m@^[^\\/]@s
+           ) ;
+
+    $volume .= $directory ;
+
+    # If the volume is not just A:, make sure the glue separator is 
+    # there, reusing whatever separator is first in the $volume if possible.
+    if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
+         $volume =~ m@[^\\/]\Z(?!\n)@      &&
+         $file   =~ m@[^\\/]@
+       ) {
+        $volume =~ m@([\\/])@ ;
+        my $sep = $1 ? $1 : '/' ;
+        $volume .= $sep ;
+    }
+
+    $volume .= $file ;
+
+    return $volume ;
+}
+
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        $path = $self->rel2abs( $path ) ;
+    } else {
+        $path = $self->canonpath( $path ) ;
+    }
+
+    # Figure out the effective $base and clean it up.
+    if ( !defined( $base ) || $base eq '' ) {
+	$base = $self->_cwd();
+    } elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    } else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Split up paths
+    my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
+    my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
+    return $path unless $path_volume eq $base_volume;
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
+
+    while ( @pathchunks && 
+            @basechunks && 
+            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
+          ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # No need to catdir, we know these are well formed.
+    $path_directories = CORE::join( '/', @pathchunks );
+    $base_directories = CORE::join( '/', @basechunks );
+
+    # $base_directories now contains the directories the resulting relative
+    # path must ascend out of before it can descend to $path_directory.  So, 
+    # replace all names with $parentDir
+
+    #FA Need to replace between backslashes...
+    $base_directories =~ s|[^\\/]+|..|g ;
+
+    # Glue the two together, using a separator if necessary, and preventing an
+    # empty result.
+
+    #FA Must check that new directories are not empty.
+    if ( $path_directories ne '' && $base_directories ne '' ) {
+        $path_directories = "$base_directories/$path_directories" ;
+    } else {
+        $path_directories = "$base_directories$path_directories" ;
+    }
+
+    return $self->canonpath( 
+        $self->catpath( "", $path_directories, $path_file ) 
+    ) ;
+}
+
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+
+        if ( !defined( $base ) || $base eq '' ) {
+	    $base = $self->_cwd();
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path, 1 ))[1,2] ;
+
+        my ( $base_volume, $base_directories ) =
+            $self->splitpath( $base, 1 ) ;
+
+        $path = $self->catpath( 
+            $base_volume, 
+            $self->catdir( $base_directories, $path_directories ), 
+            $path_file
+        ) ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::Spec::OS2 - methods for OS/2 file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::OS2; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+Amongst the changes made for OS/2 are...
+
+=over 4
+
+=item tmpdir
+
+Modifies the list of places temp directory information is looked for.
+
+    $ENV{TMPDIR}
+    $ENV{TEMP}
+    $ENV{TMP}
+    /tmp
+    /
+
+=item splitpath
+
+Volumes can be drive letters or UNC sharenames (\\server\share).
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm b/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm
new file mode 100644
index 00000000000..8fd2320a392
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm
@@ -0,0 +1,521 @@
+package File::Spec::Unix;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+=head1 NAME
+
+File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
+
+=head1 SYNOPSIS
+
+ require File::Spec::Unix; # Done automatically by File::Spec
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications.  Other File::Spec
+modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
+override specific methods.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath()
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminates successive slashes and successive "/.".
+
+    $cpath = File::Spec->canonpath( $path ) ;
+
+Note that this does *not* collapse F<x/../y> sections into F<y>.  This
+is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
+then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
+F<../>-removal would give you.  If you want to do this kind of
+processing, you probably want C<Cwd>'s C<realpath()> function to
+actually traverse the filesystem cleaning up paths like this.
+
+=cut
+
+sub canonpath {
+    my ($self,$path) = @_;
+    return unless defined $path;
+    
+    # Handle POSIX-style node names beginning with double slash (qnx, nto)
+    # (POSIX says: "a pathname that begins with two successive slashes
+    # may be interpreted in an implementation-defined manner, although
+    # more than two leading slashes shall be treated as a single slash.")
+    my $node = '';
+    my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
+
+
+    if ( $double_slashes_special
+         && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
+      $node = $1;
+    }
+    # This used to be
+    # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
+    # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
+    # (Mainly because trailing "" directories didn't get stripped).
+    # Why would cygwin avoid collapsing multiple slashes into one? --jhi
+    $path =~ s|/{2,}|/|g;                            # xx////xx  -> xx/xx
+    $path =~ s{(?:/\.)+(?:/|\z)}{/}g;                # xx/././xx -> xx/xx
+    $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
+    $path =~ s|^/(?:\.\./)+|/|;                      # /../../xx -> xx
+    $path =~ s|^/\.\.$|/|;                         # /..       -> /
+    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
+    return "$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;
+
+    $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
+}
+
+=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 = $self->canonpath(pop @_);
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $dir .= "/" unless substr($dir,-1) eq "/";
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representation of the current directory.  "." on UNIX.
+
+=cut
+
+sub curdir { '.' }
+
+=item devnull
+
+Returns a string representation of the null device. "/dev/null" on UNIX.
+
+=cut
+
+sub devnull { '/dev/null' }
+
+=item rootdir
+
+Returns a string representation of the root directory.  "/" on UNIX.
+
+=cut
+
+sub rootdir { '/' }
+
+=item tmpdir
+
+Returns a string representation of the first writable directory from
+the following list or the current directory if none from the list are
+writable:
+
+    $ENV{TMPDIR}
+    /tmp
+
+Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+is tainted, it is not used.
+
+=cut
+
+my $tmpdir;
+sub _tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my $self = shift;
+    my @dirlist = @_;
+    {
+	no strict 'refs';
+	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
+            require Scalar::Util;
+	    @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
+	}
+    }
+    foreach (@dirlist) {
+	next unless defined && -d && -w _;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = $self->curdir unless defined $tmpdir;
+    $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
+    return $tmpdir;
+}
+
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
+}
+
+=item updir
+
+Returns a string representation of the parent directory.  ".." on UNIX.
+
+=cut
+
+sub updir { '..' }
+
+=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}\z/s, @_);
+}
+
+=item case_tolerant
+
+Returns a true or false value indicating, respectively, that alphabetic
+is not or is significant when comparing file specifications.
+
+=cut
+
+sub case_tolerant { 0 }
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true if it is an absolute path.
+
+This does not consult the local filesystem on Unix, Win32, OS/2 or Mac 
+OS (Classic).  It does consult the working environment for VMS (see
+L<File::Spec::VMS/file_name_is_absolute>).
+
+=cut
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m:^/:s);
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+    return () unless exists $ENV{PATH};
+    my @path = split(':', $ENV{PATH});
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
+}
+
+=item join
+
+join is the same as catfile.
+
+=cut
+
+sub join {
+    my $self = shift;
+    return $self->catfile(@_);
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path into volume, directory, and filename portions. On systems
+with no concept of volume, returns '' for volume. 
+
+For systems with no syntax differentiating filenames from directories, 
+assumes that the last file is a path unless $no_file is true or a 
+trailing separator or /. or /.. is present. On Unix this means that $no_file
+true makes this return ( '', $path, '' ).
+
+The directory portion may or may not be returned with a trailing '/'.
+
+The results can be passed to L</catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+
+    my ($volume,$directory,$file) = ('','','');
+
+    if ( $nofile ) {
+        $directory = $path;
+    }
+    else {
+        $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
+        $directory = $1;
+        $file      = $2;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, empty
+directory names (C<''>) can be returned, because these are significant
+on some OSs.
+
+On Unix,
+
+    File::Spec->splitdir( "/a/b//c/" );
+
+Yields:
+
+    ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+    return split m|/|, $_[1], -1;  # Preserve trailing fields
+}
+
+
+=item catpath()
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
+inserted if needed (though if the directory portion doesn't start with
+'/' it is not added).  On other OSs, $volume is significant.
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    if ( $directory ne ''                && 
+         $file ne ''                     && 
+         substr( $directory, -1 ) ne '/' && 
+         substr( $file, 0, 1 ) ne '/' 
+    ) {
+        $directory .= "/$file" ;
+    }
+    else {
+        $directory .= $file ;
+    }
+
+    return $directory ;
+}
+
+=item abs2rel
+
+Takes a destination path and an optional base path returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $path ) ;
+    $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
+relative, then it is converted to absolute form using
+L</rel2abs()>. This means that it is taken to be relative to
+L<cwd()|Cwd>.
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename. Otherwise all path components are assumed to be
+directories.
+
+If $path is relative, it is converted to absolute form using L</rel2abs()>.
+This means that it is taken to be relative to L<cwd()|Cwd>.
+
+No checks against the filesystem are made.  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub abs2rel {
+    my($self,$path,$base) = @_;
+    $base = $self->_cwd() unless defined $base and length $base;
+
+    ($path, $base) = map $self->canonpath($_), $path, $base;
+
+    if (grep $self->file_name_is_absolute($_), $path, $base) {
+	($path, $base) = map $self->rel2abs($_), $path, $base;
+    }
+    else {
+	# save a couple of cwd()s if both paths are relative
+	($path, $base) = map $self->catdir('/', $_), $path, $base;
+    }
+
+    my ($path_volume) = $self->splitpath($path, 1);
+    my ($base_volume) = $self->splitpath($base, 1);
+
+    # Can't relativize across volumes
+    return $path unless $path_volume eq $base_volume;
+
+    my $path_directories = ($self->splitpath($path, 1))[1];
+    my $base_directories = ($self->splitpath($base, 1))[1];
+
+    # For UNC paths, the user might give a volume like //foo/bar that
+    # strictly speaking has no directory portion.  Treat it as if it
+    # had the root directory for that volume.
+    if (!length($base_directories) and $self->file_name_is_absolute($base)) {
+      $base_directories = $self->rootdir;
+    }
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
+
+    if ($base_directories eq $self->rootdir) {
+      shift @pathchunks;
+      return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
+    }
+
+    while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+    return $self->curdir unless @pathchunks || @basechunks;
+
+    # $base now contains the directories the resulting relative path 
+    # must ascend out of before it can descend to $path_directory.
+    my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
+    return $self->canonpath( $self->catpath('', $result_dirs, '') );
+}
+
+sub _same {
+  $_[1] eq $_[2];
+}
+
+=item rel2abs()
+
+Converts a relative path to an absolute path. 
+
+    $abs_path = File::Spec->rel2abs( $path ) ;
+    $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
+relative, then it is converted to absolute form using
+L</rel2abs()>. This means that it is taken to be relative to
+L<cwd()|Cwd>.
+
+On systems that have a grammar that indicates filenames, this ignores
+the $base filename. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+No checks against the filesystem are made.  On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    # Clean up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        # Figure out the effective $base and clean it up.
+        if ( !defined( $base ) || $base eq '' ) {
+	    $base = $self->_cwd();
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        # Glom them together
+        $path = $self->catdir( $base, $path ) ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+# Internal routine to File::Spec, no point in making this public since
+# it is the standard Cwd interface.  Most of the platform-specific
+# File::Spec subclasses use this.
+sub _cwd {
+    require Cwd;
+    Cwd::getcwd();
+}
+
+
+# Internal method to reduce xx\..\yy -> yy
+sub _collapse {
+    my($fs, $path) = @_;
+
+    my $updir  = $fs->updir;
+    my $curdir = $fs->curdir;
+
+    my($vol, $dirs, $file) = $fs->splitpath($path);
+    my @dirs = $fs->splitdir($dirs);
+    pop @dirs if @dirs && $dirs[-1] eq '';
+
+    my @collapsed;
+    foreach my $dir (@dirs) {
+        if( $dir eq $updir              and   # if we have an updir
+            @collapsed                  and   # and something to collapse
+            length $collapsed[-1]       and   # and its not the rootdir
+            $collapsed[-1] ne $updir    and   # nor another updir
+            $collapsed[-1] ne $curdir         # nor the curdir
+          ) 
+        {                                     # then
+            pop @collapsed;                   # collapse
+        }
+        else {                                # else
+            push @collapsed, $dir;            # just hang onto it
+        }
+    }
+
+    return $fs->catpath($vol,
+                        $fs->catdir(@collapsed),
+                        $file
+                       );
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm b/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm
new file mode 100644
index 00000000000..6135fc54635
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm
@@ -0,0 +1,1141 @@
+package File::Spec::VMS;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+@ISA = qw(File::Spec::Unix);
+
+use File::Basename;
+use VMS::Filespec;
+
+=head1 NAME
+
+File::Spec::VMS - methods for VMS file specs
+
+=head1 SYNOPSIS
+
+ require 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.
+
+The default behavior is to allow either VMS or Unix syntax on input and to 
+return VMS syntax on output, even when Unix syntax was given on input.
+
+When used with a Perl of version 5.10 or greater and a CRTL possessing the
+relevant capabilities, override behavior depends on the CRTL features
+C<DECC$FILENAME_UNIX_REPORT> and C<DECC$EFS_CHARSET>.  When the
+C<DECC$EFS_CHARSET> feature is enabled and the input parameters are clearly
+in Unix syntax, the output will be in Unix syntax.  If
+C<DECC$FILENAME_UNIX_REPORT> is enabled and the output syntax cannot be
+determined from the input syntax, the output will be in Unix syntax.
+
+=over 4
+
+=cut
+
+# Need to look up the feature settings.  The preferred way is to use the
+# VMS::Feature module, but that may not be available to dual life modules.
+
+my $use_feature;
+BEGIN {
+    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+        $use_feature = 1;
+    }
+}
+
+# Need to look up the UNIX report mode.  This may become a dynamic mode
+# in the future.
+sub _unix_rpt {
+    my $unix_rpt;
+    if ($use_feature) {
+        $unix_rpt = VMS::Feature::current("filename_unix_report");
+    } else {
+        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
+    }
+    return $unix_rpt;
+}
+
+# Need to look up the EFS character set mode.  This may become a dynamic
+# mode in the future.
+sub _efs {
+    my $efs;
+    if ($use_feature) {
+        $efs = VMS::Feature::current("efs_charset");
+    } else {
+        my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
+        $efs = $env_efs =~ /^[ET1]/i; 
+    }
+    return $efs;
+}
+
+=item canonpath (override)
+
+Removes redundant portions of file specifications according to the syntax
+detected.
+
+=cut
+
+
+sub canonpath {
+    my($self,$path) = @_;
+
+    return undef unless defined $path;
+
+    my $efs = $self->_efs;
+
+    if ($path =~ m|/|) { # Fake Unix
+      my $pathify = $path =~ m|/\Z(?!\n)|;
+      $path = $self->SUPER::canonpath($path);
+
+      # Do not convert to VMS when EFS character sets are in use
+      return $path if $efs;
+
+      if ($pathify) { return vmspath($path); }
+      else          { return vmsify($path);  }
+    }
+    else {
+
+#FIXME - efs parsing has different rules.  Characters in a VMS filespec
+#        are only delimiters if not preceded by '^';
+
+	$path =~ tr/<>/[]/;			# < and >       ==> [ and ]
+	$path =~ s/\]\[\./\.\]\[/g;		# ][.		==> .][
+	$path =~ s/\[000000\.\]\[/\[/g;		# [000000.][	==> [
+	$path =~ s/\[000000\./\[/g;		# [000000.	==> [
+	$path =~ s/\.\]\[000000\]/\]/g;		# .][000000]	==> ]
+	$path =~ s/\.\]\[/\./g;			# foo.][bar     ==> foo.bar
+	1 while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
+						# That loop does the following
+						# with any amount of dashes:
+						# .-.-.		==> .--.
+						# [-.-.		==> [--.
+						# .-.-]		==> .--]
+						# [-.-]		==> [--]
+	1 while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+						# That loop does the following
+						# with any amount (minimum 2)
+						# of dashes:
+						# .foo.--.	==> .-.
+						# .foo.--]	==> .-]
+						# [foo.--.	==> [-.
+						# [foo.--]	==> [-]
+						#
+						# And then, the remaining cases
+	$path =~ s/\[\.-/[-/;			# [.-		==> [-
+	$path =~ s/\.[^\]\.]+\.-\./\./g;	# .foo.-.	==> .
+	$path =~ s/\[[^\]\.]+\.-\./\[/g;	# [foo.-.	==> [
+	$path =~ s/\.[^\]\.]+\.-\]/\]/g;	# .foo.-]	==> ]
+	$path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-]       ==> [000000]
+	$path =~ s/\[\]// unless $path eq '[]';	# []		==>
+	return $path;
+    }
+}
+
+=item catdir (override)
+
+Concatenates a list of file specifications, and returns the result as a
+directory specification.  No check is made for "impossible"
+cases (e.g. elements other than the first being absolute filespecs).
+
+=cut
+
+sub catdir {
+    my $self = shift;
+    my $dir = pop;
+
+    my $efs = $self->_efs;
+    my $unix_rpt = $self->_unix_rpt;
+
+
+    my @dirs = grep {defined() && length()} @_;
+    if ($efs) {
+        # Legacy mode removes blank entries.
+        # But that breaks existing generic perl code that
+        # uses a blank path at the beginning of the array
+        # to indicate an absolute path.
+        # So put it back if found.
+        if (@_) {
+            if ($_[0] eq '') {
+                unshift @dirs, '';
+            }
+        }
+    }
+
+    my $rslt;
+    if (@dirs) {
+	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+	my ($spath,$sdir) = ($path,$dir);
+
+        if ($efs) {
+            # Extended character set in use, go into DWIM mode.
+
+            # Now we need to identify what the directory is in
+            # of the specification in order to merge them.
+            my $path_unix = 0;
+            $path_unix = 1 if ($path =~ m#/#);
+            $path_unix = 1 if ($path =~ /^\.\.?$/);
+            my $path_vms = 0;
+            $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#);
+            $path_vms = 1 if ($path =~ /^--?$/);
+            my $dir_unix = 0;
+            $dir_unix = 1 if ($dir =~ m#/#);
+            $dir_unix = 1 if ($dir =~ /^\.\.?$/);
+            my $dir_vms = 0;
+            $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#);
+            $dir_vms = 1 if ($dir =~ /^--?$/);
+
+            my $unix_mode = 0;
+            if (($path_unix != $dir_unix) && ($path_vms != $dir_vms)) {
+                # Ambiguous, so if in $unix_rpt mode then assume UNIX.
+                $unix_mode = 1 if $unix_rpt;
+            } else {
+                $unix_mode = 1 if (!$path_vms && !$dir_vms && $unix_rpt);
+                $unix_mode = 1 if ($path_unix || $dir_unix);
+            }
+
+            if ($unix_mode) {
+
+                # Fix up mixed syntax imput as good as possible - GIGO
+                $path = unixify($path) if $path_vms;
+                $dir = unixify($dir) if $dir_vms;
+
+                $rslt = $path;
+                # Append a path delimiter
+                $rslt .= '/' unless ($rslt =~ m#/$#);
+
+                $rslt .= $dir;
+                return $self->SUPER::canonpath($rslt);
+            } else {
+
+                #with <> posible instead of [.
+                # Normalize the brackets
+                # Fixme - need to not switch when preceded by ^.
+                $path =~ s/</\[/g;
+                $path =~ s/>/\]/g;
+                $dir =~ s/</\[/g;
+                $dir =~ s/>/\]/g;
+
+                # Fix up mixed syntax imput as good as possible - GIGO
+                $path = vmsify($path) if $path_unix;
+                $dir = vmsify($dir) if $dir_unix;
+
+                #Possible path values: foo: [.foo] [foo] foo, and $(foo)
+                #or starting with '-', or foo.dir
+                #If path is foo, it needs to be converted to [.foo]
+
+                # Fix up a bare path name.
+                unless ($path_vms) {
+                    $path =~ s/\.dir\Z(?!\n)//i;
+                    if (($path ne '') && ($path !~ /^-/)) {
+                        # Non blank and not prefixed with '-', add a dot
+                        $path = '[.' . $path;
+                    } else {
+                        # Just start a directory.
+                        $path = '[' . $path;
+                    }
+                } else {
+                    $path =~ s/\]$//;
+                }
+
+                #Possible dir values: [.dir] dir and $(foo)
+
+                # No punctuation may have a trailing .dir
+                unless ($dir_vms) {
+                    $dir =~ s/\.dir\Z(?!\n)//i;
+                } else {
+
+                    #strip off the brackets
+                    $dir =~ s/^\[//;
+                    $dir =~ s/\]$//;
+                }
+
+                #strip off the leading dot if present.
+                $dir =~ s/^\.//;
+
+                # Now put the specifications together.
+                if ($dir ne '') {
+                    # Add a separator unless this is an absolute path
+                    $path .= '.' if ($path ne '[');
+                    $rslt = $path . $dir . ']';
+                } else {
+                    $rslt = $path . ']';
+                }
+            }
+
+	} else {
+	    # Traditional ODS-2 mode.
+	    $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; 
+
+	    $sdir = $self->eliminate_macros($sdir)
+		unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
+	    $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+
+	    # Special case for VMS absolute directory specs: these will have
+	    # had device prepended during trip through Unix syntax in
+	    # eliminate_macros(), since Unix syntax has no way to express
+	    # "absolute from the top of this device's directory tree".
+	    if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
+	} 
+    } else {
+	# Single directory, just make sure it is in directory format
+	# Return an empty string on null input, and pass through macros.
+
+	if    (not defined $dir or not length $dir) { $rslt = ''; }
+	elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s) { 
+	    $rslt = $dir;
+	} else {
+            my $unix_mode = 0;
+
+            if ($efs) {
+                my $dir_unix = 0;
+                $dir_unix = 1 if ($dir =~ m#/#);
+                $dir_unix = 1 if ($dir =~ /^\.\.?$/);
+                my $dir_vms = 0;
+                $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#);
+                $dir_vms = 1 if ($dir =~ /^--?$/);
+
+                if ($dir_vms == $dir_unix) {
+                    # Ambiguous, so if in $unix_rpt mode then assume UNIX.
+                    $unix_mode = 1 if $unix_rpt;
+                } else {
+                    $unix_mode = 1 if $dir_unix;
+                }
+            }
+
+            if ($unix_mode) {
+                return $dir;
+            } else {
+                # For VMS, force it to be in directory format
+	 	$rslt = vmspath($dir);
+	    }
+	}
+    }
+    return $self->canonpath($rslt);
+}
+
+=item catfile (override)
+
+Concatenates a list of directory specifications with a filename specification
+to build a path.
+
+=cut
+
+sub catfile {
+    my $self = shift;
+    my $tfile = pop();
+    my $file = $self->canonpath($tfile);
+    my @files = grep {defined() && length()} @_;
+
+    my $efs = $self->_efs;
+    my $unix_rpt = $self->_unix_rpt;
+
+    # Assume VMS mode
+    my $unix_mode = 0;
+    my $file_unix = 0;
+    my $file_vms = 0;
+    if ($efs) {
+
+        # Now we need to identify format the file is in
+        # of the specification in order to merge them.
+        $file_unix = 1 if ($tfile =~ m#/#);
+        $file_unix = 1 if ($tfile =~ /^\.\.?$/);
+        $file_vms = 1 if ($tfile =~ m#(?<!\^)[\[<\]:]#);
+        $file_vms = 1 if ($tfile =~ /^--?$/);
+
+        # We may know for sure what the format is.
+        if (($file_unix != $file_vms)) {
+            $unix_mode = 1 if ($file_unix && $unix_rpt);
+        }
+    }
+
+    my $rslt;
+    if (@files) {
+	# concatenate the directories.
+	my $path;
+        if (@files == 1) {
+           $path = $files[0];
+        } else {
+            if ($file_vms) {
+                # We need to make sure this is in VMS mode to avoid doing
+                # both a vmsify and unixfy on the same path, as that may
+                # lose significant data.
+                my $i = @files - 1;
+                my $tdir = $files[$i];
+                my $tdir_vms = 0;
+                my $tdir_unix = 0;
+                $tdir_vms = 1 if ($tdir =~ m#(?<!\^)[\[<\]:]#);
+                $tdir_unix = 1 if ($tdir =~ m#/#);
+                $tdir_unix = 1 if ($tdir =~ /^\.\.?$/);
+
+                if (!$tdir_vms) {
+                    if ($tdir_unix) { 
+                        $tdir = vmspath($tdir);
+                    } else {
+                        $tdir =~ s/\.dir\Z(?!\n)//i;
+                        $tdir = '[.' . $tdir . ']';
+                    }
+                    $files[$i] = $tdir;
+                }
+            }
+            $path = $self->catdir(@files);
+        }
+	my $spath = $path;
+
+        # Some thing building a VMS path in pieces may try to pass a
+        # directory name in filename format, so normalize it.
+	$spath =~ s/\.dir\Z(?!\n)//i;
+
+        # if the spath ends with a directory delimiter and the file is bare,
+        # then just concat them.
+	if ($spath =~ /^(?<!\^)[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
+	    $rslt = "$spath$file";
+	} else {
+            if ($efs) {
+
+                # Now we need to identify what the directory is in
+                # of the specification in order to merge them.
+                my $spath_unix = 0;
+                $spath_unix = 1 if ($spath =~ m#/#);
+                $spath_unix = 1 if ($spath =~ /^\.\.?$/);
+                my $spath_vms = 0;
+                $spath_vms = 1 if ($spath =~ m#(?<!\^)[\[<\]:]#);
+                $spath_vms = 1 if ($spath =~ /^--?$/);
+
+                # Assume VMS mode
+                if (($spath_unix == $spath_vms) &&
+                    ($file_unix == $file_vms)) {
+                     # Ambigous, so if in $unix_rpt mode then assume UNIX.
+                     $unix_mode = 1 if $unix_rpt;
+                } else {
+                     $unix_mode = 1
+                         if (($spath_unix || $file_unix) && $unix_rpt);
+                }
+
+                if (!$unix_mode) {
+                    if ($spath_vms) {
+                        $spath = '[' . $spath . ']' if $spath =~ /^-/;
+                        $rslt = vmspath($spath);
+                    } else {
+                        $rslt = '[.' . $spath . ']';
+                    }
+                    $file = vmsify($file) if ($file_unix);
+                } else {
+                    $spath = unixify($spath) if ($spath_vms);
+                    $rslt = $spath;
+                    $file = unixify($file) if ($file_vms);
+
+                    # Unix merge may need a directory delimitor.
+                    # A null path indicates root on Unix.
+                    $rslt .= '/' unless ($rslt =~ m#/$#);
+                }
+
+                $rslt .= $file;
+                $rslt =~ s/\]\[//;
+
+	    } else {
+		# Traditional VMS Perl mode expects that this is done.
+		# Note for future maintainers:
+		# This is left here for compatibility with perl scripts
+		# that have come to expect this behavior, even though
+		# usually the Perl scripts ported to VMS have to be
+		# patched because of it changing Unix syntax file
+		# to VMS format.
+
+		$rslt = $self->eliminate_macros($spath);
+
+
+	        $rslt = vmsify($rslt.((defined $rslt) &&
+		    ($rslt ne '') ? '/' : '').unixify($file));
+	    }
+	}
+    }
+    else {
+        # Only passed a single file?
+        my $xfile = $file;
+
+        # Traditional VMS perl expects this conversion.
+        $xfile = vmsify($file) unless ($efs);
+
+        $rslt = (defined($file) && length($file)) ? $xfile : '';
+    }
+    return $self->canonpath($rslt) unless $unix_rpt;
+
+    # In Unix report mode, do not strip off redundent path information.
+    return $rslt;
+}
+
+
+=item curdir (override)
+
+Returns a string representation of the current directory: '[]' or '.'
+
+=cut
+
+sub curdir {
+    my $self = shift @_;
+    return '.' if ($self->_unix_rpt);
+    return '[]';
+}
+
+=item devnull (override)
+
+Returns a string representation of the null device: '_NLA0:' or '/dev/null'
+
+=cut
+
+sub devnull {
+    my $self = shift @_;
+    return '/dev/null' if ($self->_unix_rpt);
+    return "_NLA0:";
+}
+
+=item rootdir (override)
+
+Returns a string representation of the root directory: 'SYS$DISK:[000000]'
+or '/'
+
+=cut
+
+sub rootdir {
+    my $self = shift @_;
+    if ($self->_unix_rpt) {
+       # Root may exist, try it first.
+       my $try = '/';
+       my ($dev1, $ino1) = stat('/');
+       my ($dev2, $ino2) = stat('.');
+
+       # Perl falls back to '.' if it can not determine '/'
+       if (($dev1 != $dev2) || ($ino1 != $ino2)) {
+           return $try;
+       }
+       # Fall back to UNIX format sys$disk.
+       return '/sys$disk/';
+    }
+    return 'SYS$DISK:[000000]';
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first writable directory
+from the following list or '' if none are writable:
+
+    /tmp if C<DECC$FILENAME_UNIX_REPORT> is enabled.
+    sys$scratch:
+    $ENV{TMPDIR}
+
+Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+is tainted, it is not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    my $self = shift @_;
+    return $tmpdir if defined $tmpdir;
+    if ($self->_unix_rpt) {
+        $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR});
+        return $tmpdir;
+    }
+
+    $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
+}
+
+=item updir (override)
+
+Returns a string representation of the parent directory: '[-]' or '..'
+
+=cut
+
+sub updir {
+    my $self = shift @_;
+    return '..' if ($self->_unix_rpt);
+    return '[-]';
+}
+
+=item case_tolerant (override)
+
+VMS file specification syntax is case-tolerant.
+
+=cut
+
+sub case_tolerant {
+    return 1;
+}
+
+=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); }
+    return @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\$\-]+\Z(?!\n)/s && $ENV{$file};
+    return scalar($file =~ m!^/!s             ||
+		  $file =~ m![<\[][^.\-\]>]!  ||
+		  $file =~ /:[^<\[]/);
+}
+
+=item splitpath (override)
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Passing a true value for C<$no_file> indicates that the path being
+split only contains directory components, even on systems where you
+can usually (when not supporting a foreign syntax) tell the difference
+between directories and files at a glance.
+
+=cut
+
+sub splitpath {
+    my($self,$path, $nofile) = @_;
+    my($dev,$dir,$file)      = ('','','');
+    my $efs = $self->_efs;
+    my $vmsify_path = vmsify($path);
+    if ($efs) {
+        my $path_vms = 0;
+        $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#);
+        $path_vms = 1 if ($path =~ /^--?$/);
+        if (!$path_vms) {
+            return $self->SUPER::splitpath($path, $nofile);
+        }
+        $vmsify_path = $path;
+    }
+
+    if ( $nofile ) {
+        #vmsify('d1/d2/d3') returns '[.d1.d2]d3'
+        #vmsify('/d1/d2/d3') returns 'd1:[d2]d3'
+        if( $vmsify_path =~ /(.*)\](.+)/ ){
+            $vmsify_path = $1.'.'.$2.']';
+        }
+        $vmsify_path =~ /(.+:)?(.*)/s;
+        $dir = defined $2 ? $2 : ''; # dir can be '0'
+        return ($1 || '',$dir,$file);
+    }
+    else {
+        $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
+        return ($1 || '',$2 || '',$3);
+    }
+}
+
+=item splitdir (override)
+
+Split a directory specification into the components.
+
+=cut
+
+sub splitdir {
+    my($self,$dirspec) = @_;
+    my @dirs = ();
+    return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) );
+
+    my $efs = $self->_efs;
+
+    my $dir_unix = 0;
+    $dir_unix = 1 if ($dirspec =~ m#/#);
+    $dir_unix = 1 if ($dirspec =~ /^\.\.?$/);
+
+    # Unix filespecs in EFS mode handled by Unix routines.
+    if ($efs && $dir_unix) {
+        return $self->SUPER::splitdir($dirspec);
+    }
+
+    # FIX ME, only split for VMS delimiters not prefixed with '^'.
+
+    $dirspec =~ tr/<>/[]/;			# < and >	==> [ and ]
+    $dirspec =~ s/\]\[\./\.\]\[/g;		# ][.		==> .][
+    $dirspec =~ s/\[000000\.\]\[/\[/g;		# [000000.][	==> [
+    $dirspec =~ s/\[000000\./\[/g;		# [000000.	==> [
+    $dirspec =~ s/\.\]\[000000\]/\]/g;		# .][000000]	==> ]
+    $dirspec =~ s/\.\]\[/\./g;			# foo.][bar	==> foo.bar
+    while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
+						# That loop does the following
+						# with any amount of dashes:
+						# .--.		==> .-.-.
+						# [--.		==> [-.-.
+						# .--]		==> .-.-]
+						# [--]		==> [-.-]
+    $dirspec = "[$dirspec]" unless $dirspec =~ /(?<!\^)[\[<]/; # make legal
+    $dirspec =~ s/^(\[|<)\./$1/;
+    @dirs = split /(?<!\^)\./, vmspath($dirspec);
+    $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
+    @dirs;
+}
+
+
+=item catpath (override)
+
+Construct a complete filespec.
+
+=cut
+
+sub catpath {
+    my($self,$dev,$dir,$file) = @_;
+    
+    my $efs = $self->_efs;
+    my $unix_rpt = $self->_unix_rpt;
+
+    my $unix_mode = 0;
+    my $dir_unix = 0;
+    $dir_unix = 1 if ($dir =~ m#/#);
+    $dir_unix = 1 if ($dir =~ /^\.\.?$/);
+    my $dir_vms = 0;
+    $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#);
+    $dir_vms = 1 if ($dir =~ /^--?$/);
+
+    if ($efs && (length($dev) == 0)) {
+        if ($dir_unix == $dir_vms) {
+            $unix_mode = $unix_rpt;
+        } else {
+            $unix_mode = $dir_unix;
+        }
+    } 
+
+    # We look for a volume in $dev, then in $dir, but not both
+    # but only if using VMS syntax.
+    if (!$unix_mode) {
+        $dir = vmspath($dir) if $dir_unix;
+        my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir);
+        $dev = $dir_volume unless length $dev;
+        $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) :
+                                  $dir_dir;
+    }
+    if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
+    else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
+    if (length($dev) or length($dir)) {
+      if ($efs) {
+          if ($unix_mode) {
+              $dir .= '/' unless ($dir =~ m#/$#);
+          } else {
+              $dir = vmspath($dir) if (($dir =~ m#/#) || ($dir =~ /^\.\.?$/));
+              $dir = "[$dir]" unless $dir =~ /^[\[<]/;
+          }
+      } else {
+          $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
+          $dir = vmspath($dir);
+      }
+    }
+    $dir = '' if length($dev) && ($dir eq '[]' || $dir eq '<>');
+    "$dev$dir$file";
+}
+
+=item abs2rel (override)
+
+Attempt to convert a file specification to a relative specification.
+On a system with volumes, like VMS, this may not be possible.
+
+=cut
+
+sub abs2rel {
+    my $self = shift;
+    my($path,$base) = @_;
+
+    my $efs = $self->_efs;
+    my $unix_rpt = $self->_unix_rpt;
+
+    # We need to identify what the directory is in
+    # of the specification in order to process them
+    my $path_unix = 0;
+    $path_unix = 1 if ($path =~ m#/#);
+    $path_unix = 1 if ($path =~ /^\.\.?$/);
+    my $path_vms = 0;
+    $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#);
+    $path_vms = 1 if ($path =~ /^--?$/);
+
+    my $unix_mode = 0;
+    if ($path_vms == $path_unix) {
+        $unix_mode = $unix_rpt;
+    } else {
+        $unix_mode = $path_unix;
+    }
+
+    my $base_unix = 0;
+    my $base_vms = 0;
+
+    if (defined $base) {
+        $base_unix = 1 if ($base =~ m#/#);
+        $base_unix = 1 if ($base =~ /^\.\.?$/);
+        $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#);
+        $base_vms = 1 if ($base =~ /^--?$/);
+
+        if ($path_vms == $path_unix) {
+            if ($base_vms == $base_unix) {
+                $unix_mode = $unix_rpt;
+            } else {
+                $unix_mode = $base_unix;
+            }
+        } else {
+            $unix_mode = 0 if $base_vms;
+        }
+    }
+
+    if ($efs) {
+        if ($unix_mode) {
+            # We are UNIX mode.
+            $base = unixpath($base) if $base_vms;
+            $base = unixify($path) if $path_vms;
+
+            # Here VMS is different, and in order to do this right
+            # we have to take the realpath for both the path and the base
+            # so that we can remove the common components.
+
+            if ($path =~ m#^/#) {
+                if (defined $base) {
+
+                    # For the shorterm, if the starting directories are
+                    # common, remove them.
+                    my $bq = qq($base);
+                    $bq =~ s/\$/\\\$/;
+                    $path =~ s/^$bq//i;
+                }
+                return $path;
+            }
+
+            return File::Spec::Unix::abs2rel( $self, $path, $base );
+
+        } else {
+            $base = vmspath($base) if $base_unix;
+            $path = vmsify($path) if $path_unix;
+        }
+    }
+
+    unless (defined $base and length $base) {
+        $base = $self->_cwd();
+        if ($efs) {
+            $base_unix = 1 if ($base =~ m#/#);
+            $base_unix = 1 if ($base =~ /^\.\.?$/);
+            $base = vmspath($base) if $base_unix;
+        }
+    }
+
+    for ($path, $base) { $_ = $self->canonpath($_) }
+
+    # Are we even starting $path on the same (node::)device as $base?  Note that
+    # logical paths or nodename differences may be on the "same device" 
+    # but the comparison that ignores device differences so as to concatenate 
+    # [---] up directory specs is not even a good idea in cases where there is 
+    # a logical path difference between $path and $base nodename and/or device.
+    # Hence we fall back to returning the absolute $path spec
+    # if there is a case blind device (or node) difference of any sort
+    # and we do not even try to call $parse() or consult %ENV for $trnlnm()
+    # (this module needs to run on non VMS platforms after all).
+    
+    my ($path_volume, $path_directories, $path_file) = $self->splitpath($path);
+    my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
+    return $path unless lc($path_volume) eq lc($base_volume);
+
+    for ($path, $base) { $_ = $self->rel2abs($_) }
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path_directories );
+    my $pathchunks = @pathchunks;
+    unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
+    my @basechunks = $self->splitdir( $base_directories );
+    my $basechunks = @basechunks;
+    unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
+
+    while ( @pathchunks && 
+            @basechunks && 
+            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
+          ) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    # @basechunks now contains the directories to climb out of,
+    # @pathchunks now has the directories to descend in to.
+    if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
+      $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+    }
+    else {
+      $path_directories = join '.', @pathchunks;
+    }
+    $path_directories = '['.$path_directories.']';
+    return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
+}
+
+
+=item rel2abs (override)
+
+Return an absolute file specification from a relative one.
+
+=cut
+
+sub rel2abs {
+    my $self = shift ;
+    my ($path,$base ) = @_;
+    return undef unless defined $path;
+
+    my $efs = $self->_efs;
+    my $unix_rpt = $self->_unix_rpt;
+
+    # We need to identify what the directory is in
+    # of the specification in order to process them
+    my $path_unix = 0;
+    $path_unix = 1 if ($path =~ m#/#);
+    $path_unix = 1 if ($path =~ /^\.\.?$/);
+    my $path_vms = 0;
+    $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#);
+    $path_vms = 1 if ($path =~ /^--?$/);
+
+    my $unix_mode = 0;
+    if ($path_vms == $path_unix) {
+        $unix_mode = $unix_rpt;
+    } else {
+        $unix_mode = $path_unix;
+    }
+
+    my $base_unix = 0;
+    my $base_vms = 0;
+
+    if (defined $base) {
+        $base_unix = 1 if ($base =~ m#/#);
+        $base_unix = 1 if ($base =~ /^\.\.?$/);
+        $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#);
+        $base_vms = 1 if ($base =~ /^--?$/);
+
+        # If we could not determine the path mode, see if we can find out
+        # from the base.
+        if ($path_vms == $path_unix) {
+            if ($base_vms != $base_unix) {
+                $unix_mode = $base_unix;
+            }
+        }
+    }
+
+    if (!$efs) {
+        # Legacy behavior, convert to VMS syntax.
+        $unix_mode = 0;
+        if (defined $base) {
+            $base = vmspath($base) if $base =~ m/\//;
+        }
+
+        if ($path =~ m/\//) {
+	    $path = ( -d $path || $path =~ m/\/\z/  # educated guessing about
+		       ? vmspath($path)             # whether it's a directory
+		       : vmsify($path) );
+        }
+   }
+
+    # Clean up and split up $path
+    if ( ! $self->file_name_is_absolute( $path ) ) {
+        # Figure out the effective $base and clean it up.
+        if ( !defined( $base ) || $base eq '' ) {
+            $base = $self->_cwd;
+        }
+        elsif ( ! $self->file_name_is_absolute( $base ) ) {
+            $base = $self->rel2abs( $base ) ;
+        }
+        else {
+            $base = $self->canonpath( $base ) ;
+        }
+
+        if ($efs) {
+            # base may have changed, so need to look up format again.
+            if ($unix_mode) {
+                $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#);
+                $base_vms = 1 if ($base =~ /^--?$/);
+                $base = unixpath($base) if $base_vms;
+                $base .= '/' unless ($base =~ m#/$#);
+            } else {
+                $base_unix = 1 if ($base =~ m#/#);
+                $base_unix = 1 if ($base =~ /^\.\.?$/);
+                $base = vmspath($base) if $base_unix; 
+            }
+        }
+
+        # Split up paths
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path ))[1,2] ;
+
+        my ( $base_volume, $base_directories ) =
+            $self->splitpath( $base ) ;
+
+        $path_directories = '' if $path_directories eq '[]' ||
+                                  $path_directories eq '<>';
+        my $sep = '' ;
+
+        if ($efs) {
+            # Merge the paths assuming that the base is absolute.
+            $base_directories = $self->catdir('',
+                                              $base_directories,
+                                              $path_directories);
+        } else {
+            # Legacy behavior assumes VMS only paths
+            $sep = '.'
+                if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
+                     $path_directories =~ m{^[^.\[<]}s
+                ) ;
+            $base_directories = "$base_directories$sep$path_directories";
+            $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
+        }
+
+        $path_file = '' if ($path_file eq '.') && $unix_mode;
+
+        $path = $self->catpath( $base_volume, $base_directories, $path_file );
+   }
+
+    return $self->canonpath( $path ) ;
+}
+
+
+# eliminate_macros() and fixpath() are MakeMaker-specific methods
+# which are used inside catfile() and catdir().  MakeMaker has its own
+# copies as of 6.06_03 which are the canonical ones.  We leave these
+# here, in peace, so that File::Spec continues to work with MakeMakers
+# prior to 6.06_03.
+# 
+# Please consider these two methods deprecated.  Do not patch them,
+# patch the ones in ExtUtils::MM_VMS instead.
+#
+# Update:  MakeMaker 6.48 is still using these routines on VMS.
+# so they need to be kept up to date with ExtUtils::MM_VMS.
+#
+# The traditional VMS mode using ODS-2 disks depends on these routines
+# being here.  These routines should not be called in when the
+# C<DECC$EFS_CHARSET> or C<DECC$FILENAME_UNIX_REPORT> modes are enabled.
+
+sub eliminate_macros {
+    my($self,$path) = @_;
+    return '' unless (defined $path) && ($path ne '');
+    $self = {} unless ref $self;
+
+    if ($path =~ /\s/) {
+      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+    }
+
+    my $npath = unixify($path);
+    # sometimes unixify will return a string with an off-by-one trailing null
+    $npath =~ s{\0$}{};
+
+    my($complex) = 0;
+    my($head,$macro,$tail);
+
+    # perform m##g in scalar context so it acts as an iterator
+    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
+        if (defined $self->{$2}) {
+            ($head,$macro,$tail) = ($1,$2,$3);
+            if (ref $self->{$macro}) {
+                if (ref $self->{$macro} eq 'ARRAY') {
+                    $macro = join ' ', @{$self->{$macro}};
+                }
+                else {
+                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                    $macro = "\cB$macro\cB";
+                    $complex = 1;
+                }
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
+            $npath = "$head$macro$tail";
+        }
+    }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
+    $npath;
+}
+
+# Deprecated.  See the note above for eliminate_macros().
+
+# 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.
+
+# fixpath() checks to see whether the result matches the name of a
+# directory in the current default directory and returns a directory or
+# file specification accordingly.  C<$is_dir> can be set to true to
+# force fixpath() to consider the path to be a directory or false to force
+# it to be a file.
+
+sub fixpath {
+    my($self,$path,$force_path) = @_;
+    return '' unless $path;
+    $self = bless {}, $self unless ref $self;
+    my($fixedpath,$prefix,$name);
+
+    if ($path =~ /\s/) {
+      return join ' ',
+             map { $self->fixpath($_,$force_path) }
+	     split /\s+/, $path;
+    }
+
+    if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
+            $fixedpath = vmspath($self->eliminate_macros($path));
+        }
+        else {
+            $fixedpath = vmsify($self->eliminate_macros($path));
+        }
+    }
+    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
+        my($vmspre) = $self->eliminate_macros("\$($prefix)");
+        # is it a dir or just a name?
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # No hints, so we try to guess
+    if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+        $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+    }
+
+    # Trim off root dirname if it's had other dirs inserted in front of it.
+    $fixedpath =~ s/\.000000([\]>])/$1/;
+    # Special case for VMS absolute directory specs: these will have had device
+    # prepended during trip through Unix syntax in eliminate_macros(), since
+    # Unix syntax has no way to express "absolute from the top of this device's
+    # directory tree".
+    if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
+    $fixedpath;
+}
+
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+An explanation of VMS file specs can be found at
+L<http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files>.
+
+=cut
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm b/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm
new file mode 100644
index 00000000000..93301ac7357
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm
@@ -0,0 +1,444 @@
+package File::Spec::Win32;
+
+use strict;
+
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '3.30';
+$VERSION = eval $VERSION;
+
+@ISA = qw(File::Spec::Unix);
+
+# Some regexes we use for path splitting
+my $DRIVE_RX = '[a-zA-Z]:';
+my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
+my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
+
+
+=head1 NAME
+
+File::Spec::Win32 - methods for Win32 file specs
+
+=head1 SYNOPSIS
+
+ require 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 4
+
+=item devnull
+
+Returns a string representation of the null device.
+
+=cut
+
+sub devnull {
+    return "nul";
+}
+
+sub rootdir { '\\' }
+
+
+=item tmpdir
+
+Returns a string representation of the first existing directory
+from the following list:
+
+    $ENV{TMPDIR}
+    $ENV{TEMP}
+    $ENV{TMP}
+    SYS:/temp
+    C:\system\temp
+    C:/temp
+    /tmp
+    /
+
+The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
+for Symbian (the File::Spec::Win32 is used also for those platforms).
+
+Since Perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
+			      'SYS:/temp',
+			      'C:\system\temp',
+			      'C:/temp',
+			      '/tmp',
+			      '/'  );
+}
+
+=item case_tolerant
+
+MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
+indicating the case significance when comparing file specifications.
+Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
+See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
+Default: 1
+
+=cut
+
+sub case_tolerant {
+  eval { require Win32API::File; } or return 1;
+  my $drive = shift || "C:";
+  my $osFsType = "\0"x256;
+  my $osVolName = "\0"x256;
+  my $ouFsFlags = 0;
+  Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
+  if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
+  else { return 1; }
+}
+
+=item file_name_is_absolute
+
+As of right now, this returns 2 if the path is absolute with a
+volume, 1 if it's absolute with no volume, 0 otherwise.
+
+=cut
+
+sub file_name_is_absolute {
+
+    my ($self,$file) = @_;
+
+    if ($file =~ m{^($VOL_RX)}o) {
+      my $vol = $1;
+      return ($vol =~ m{^$UNC_RX}o ? 2
+	      : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
+	      : 0);
+    }
+    return $file =~  m{^[\\/]} ? 1 : 0;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    shift;
+
+    # Legacy / compatibility support
+    #
+    shift, return _canon_cat( "/", @_ )
+	if $_[0] eq "";
+
+    # Compatibility with File::Spec <= 3.26:
+    #     catfile('A:', 'foo') should return 'A:\foo'.
+    return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
+        if $_[0] =~ m{^$DRIVE_RX\z}o;
+
+    return _canon_cat( @_ );
+}
+
+sub catdir {
+    shift;
+
+    # Legacy / compatibility support
+    #
+    return ""
+    	unless @_;
+    shift, return _canon_cat( "/", @_ )
+	if $_[0] eq "";
+
+    # Compatibility with File::Spec <= 3.26:
+    #     catdir('A:', 'foo') should return 'A:\foo'.
+    return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
+        if $_[0] =~ m{^$DRIVE_RX\z}o;
+
+    return _canon_cat( @_ );
+}
+
+sub path {
+    my @path = split(';', $ENV{PATH});
+    s/"//g for @path;
+    @path = grep length, @path;
+    unshift(@path, ".");
+    return @path;
+}
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+On Win32 makes 
+
+	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
+	dir1\dir2\dir3\...\dir4   -> \dir\dir4
+
+=cut
+
+sub canonpath {
+    # Legacy / compatibility support
+    #
+    return $_[1] if !defined($_[1]) or $_[1] eq '';
+    return _canon_cat( $_[1] );
+}
+
+=item splitpath
+
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path into volume, directory, and filename portions. Assumes that 
+the last file is a path unless the path ends in '\\', '\\.', '\\..'
+or $no_file is true.  On Win32 this means that $no_file true makes this return 
+( $volume, $path, '' ).
+
+Separators accepted are \ and /.
+
+Volumes can be drive letters or UNC sharenames (\\server\share).
+
+The results can be passed to L</catpath> to get back a path equivalent to
+(usually identical to) the original path.
+
+=cut
+
+sub splitpath {
+    my ($self,$path, $nofile) = @_;
+    my ($volume,$directory,$file) = ('','','');
+    if ( $nofile ) {
+        $path =~ 
+            m{^ ( $VOL_RX ? ) (.*) }sox;
+        $volume    = $1;
+        $directory = $2;
+    }
+    else {
+        $path =~ 
+            m{^ ( $VOL_RX ? )
+                ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
+                (.*)
+             }sox;
+        $volume    = $1;
+        $directory = $2;
+        $file      = $3;
+    }
+
+    return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L<catdir()|File::Spec/catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems 
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, leading empty and 
+trailing directory entries can be returned, because these are significant
+on some OSs. So,
+
+    File::Spec->splitdir( "/a/b/c" );
+
+Yields:
+
+    ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+    my ($self,$directories) = @_ ;
+    #
+    # split() likes to forget about trailing null fields, so here we
+    # check to be sure that there will not be any before handling the
+    # simple case.
+    #
+    if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
+        return split( m|[\\/]|, $directories );
+    }
+    else {
+        #
+        # since there was a trailing separator, add a file name to the end, 
+        # then do the split, then replace it with ''.
+        #
+        my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
+        $directories[ $#directories ]= '' ;
+        return @directories ;
+    }
+}
+
+
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and this is just like catfile(). On other OSs,
+the $volume become significant.
+
+=cut
+
+sub catpath {
+    my ($self,$volume,$directory,$file) = @_;
+
+    # If it's UNC, make sure the glue separator is there, reusing
+    # whatever separator is first in the $volume
+    my $v;
+    $volume .= $v
+        if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
+             $directory =~ m@^[^\\/]@s
+           ) ;
+
+    $volume .= $directory ;
+
+    # If the volume is not just A:, make sure the glue separator is 
+    # there, reusing whatever separator is first in the $volume if possible.
+    if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
+         $volume =~ m@[^\\/]\Z(?!\n)@      &&
+         $file   =~ m@[^\\/]@
+       ) {
+        $volume =~ m@([\\/])@ ;
+        my $sep = $1 ? $1 : '\\' ;
+        $volume .= $sep ;
+    }
+
+    $volume .= $file ;
+
+    return $volume ;
+}
+
+sub _same {
+  lc($_[1]) eq lc($_[2]);
+}
+
+sub rel2abs {
+    my ($self,$path,$base ) = @_;
+
+    my $is_abs = $self->file_name_is_absolute($path);
+
+    # Check for volume (should probably document the '2' thing...)
+    return $self->canonpath( $path ) if $is_abs == 2;
+
+    if ($is_abs) {
+      # It's missing a volume, add one
+      my $vol = ($self->splitpath( $self->_cwd() ))[0];
+      return $self->canonpath( $vol . $path );
+    }
+
+    if ( !defined( $base ) || $base eq '' ) {
+      require Cwd ;
+      $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
+      $base = $self->_cwd() unless defined $base ;
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+      $base = $self->rel2abs( $base ) ;
+    }
+    else {
+      $base = $self->canonpath( $base ) ;
+    }
+
+    my ( $path_directories, $path_file ) =
+      ($self->splitpath( $path, 1 ))[1,2] ;
+
+    my ( $base_volume, $base_directories ) =
+      $self->splitpath( $base, 1 ) ;
+
+    $path = $self->catpath( 
+			   $base_volume, 
+			   $self->catdir( $base_directories, $path_directories ), 
+			   $path_file
+			  ) ;
+
+    return $self->canonpath( $path ) ;
+}
+
+=back
+
+=head2 Note For File::Spec::Win32 Maintainers
+
+Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+
+sub _canon_cat				# @path -> path
+{
+    my ($first, @rest) = @_;
+
+    my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x	# drive letter
+    	       ? ucfirst( $1 ).( $2 ? "\\" : "" )
+	       : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
+				 (?: [\\/] ([^\\/]+) )?
+	       			 [\\/]? }{}xs			# UNC volume
+	       ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
+	       : $first =~ s{ \A [\\/] }{}x			# root dir
+	       ? "\\"
+	       : "";
+    my $path   = join "\\", $first, @rest;
+
+    $path =~ tr#\\/#\\\\#s;		# xx/yy --> xx\yy & xx\\yy --> xx\yy
+
+    					# xx/././yy --> xx/yy
+    $path =~ s{(?:
+		(?:\A|\\)		# at begin or after a slash
+		\.
+		(?:\\\.)*		# and more
+		(?:\\|\z) 		# at end or followed by slash
+	       )+			# performance boost -- I do not know why
+	     }{\\}gx;
+
+    # XXX I do not know whether more dots are supported by the OS supporting
+    #     this ... annotation (NetWare or symbian but not MSWin32).
+    #     Then .... could easily become ../../.. etc:
+    # Replace \.\.\. by (\.\.\.+)  and substitute with
+    # { $1 . ".." . "\\.." x (length($2)-2) }gex
+	     				# ... --> ../..
+    $path =~ s{ (\A|\\)			# at begin or after a slash
+    		\.\.\.
+		(?=\\|\z) 		# at end or followed by slash
+	     }{$1..\\..}gx;
+    					# xx\yy\..\zz --> xx\zz
+    while ( $path =~ s{(?:
+		(?:\A|\\)		# at begin or after a slash
+		[^\\]+			# rip this 'yy' off
+		\\\.\.
+		(?<!\A\.\.\\\.\.)	# do *not* replace ^..\..
+		(?<!\\\.\.\\\.\.)	# do *not* replace \..\..
+		(?:\\|\z) 		# at end or followed by slash
+	       )+			# performance boost -- I do not know why
+	     }{\\}sx ) {}
+
+    $path =~ s#\A\\##;			# \xx --> xx  NOTE: this is *not* root
+    $path =~ s#\\\z##;			# xx\ --> xx
+
+    if ( $volume =~ m#\\\z# )
+    {					# <vol>\.. --> <vol>\
+	$path =~ s{ \A			# at begin
+		    \.\.
+		    (?:\\\.\.)*		# and more
+		    (?:\\|\z) 		# at end or followed by slash
+		 }{}x;
+
+	return $1			# \\HOST\SHARE\ --> \\HOST\SHARE
+	    if    $path eq ""
+	      and $volume =~ m#\A(\\\\.*)\\\z#s;
+    }
+    return $path ne "" || $volume ? $volume.$path : ".";
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Temp.pm b/Master/tlpkg/tlperl/lib/File/Temp.pm
new file mode 100644
index 00000000000..a2d4ae0759f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Temp.pm
@@ -0,0 +1,2452 @@
+package File::Temp;
+
+=head1 NAME
+
+File::Temp - return name and handle of a temporary file safely
+
+=begin __INTERNALS
+
+=head1 PORTABILITY
+
+This section is at the top in order to provide easier access to
+porters.  It is not expected to be rendered by a standard pod
+formatting tool. Please skip straight to the SYNOPSIS section if you
+are not trying to port this module to a new platform.
+
+This module is designed to be portable across operating systems and it
+currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
+(Classic). When porting to a new OS there are generally three main
+issues that have to be solved:
+
+=over 4
+
+=item *
+
+Can the OS unlink an open file? If it can not then the
+C<_can_unlink_opened_file> method should be modified.
+
+=item *
+
+Are the return values from C<stat> reliable? By default all the
+return values from C<stat> are compared when unlinking a temporary
+file using the filename and the handle. Operating systems other than
+unix do not always have valid entries in all fields. If C<unlink0> fails
+then the C<stat> comparison should be modified accordingly.
+
+=item *
+
+Security. Systems that can not support a test for the sticky bit
+on a directory can not use the MEDIUM and HIGH security tests.
+The C<_can_do_level> method should be modified accordingly.
+
+=back
+
+=end __INTERNALS
+
+=head1 SYNOPSIS
+
+  use File::Temp qw/ tempfile tempdir /;
+
+  $fh = tempfile();
+  ($fh, $filename) = tempfile();
+
+  ($fh, $filename) = tempfile( $template, DIR => $dir);
+  ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
+  ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
+
+  binmode( $fh, ":utf8" );
+
+  $dir = tempdir( CLEANUP => 1 );
+  ($fh, $filename) = tempfile( DIR => $dir );
+
+Object interface:
+
+  require File::Temp;
+  use File::Temp ();
+  use File::Temp qw/ :seekable /;
+
+  $fh = File::Temp->new();
+  $fname = $fh->filename;
+
+  $fh = File::Temp->new(TEMPLATE => $template);
+  $fname = $fh->filename;
+
+  $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
+  print $tmp "Some data\n";
+  print "Filename is $tmp\n";
+  $tmp->seek( 0, SEEK_END );
+
+The following interfaces are provided for compatibility with
+existing APIs. They should not be used in new code.
+
+MkTemp family:
+
+  use File::Temp qw/ :mktemp  /;
+
+  ($fh, $file) = mkstemp( "tmpfileXXXXX" );
+  ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
+
+  $tmpdir = mkdtemp( $template );
+
+  $unopened_file = mktemp( $template );
+
+POSIX functions:
+
+  use File::Temp qw/ :POSIX /;
+
+  $file = tmpnam();
+  $fh = tmpfile();
+
+  ($fh, $file) = tmpnam();
+
+Compatibility functions:
+
+  $unopened_file = File::Temp::tempnam( $dir, $pfx );
+
+=head1 DESCRIPTION
+
+C<File::Temp> can be used to create and open temporary files in a safe
+way.  There is both a function interface and an object-oriented
+interface.  The File::Temp constructor or the tempfile() function can
+be used to return the name and the open filehandle of a temporary
+file.  The tempdir() function can be used to create a temporary
+directory.
+
+The security aspect of temporary file creation is emphasized such that
+a filehandle and filename are returned together.  This helps guarantee
+that a race condition can not occur where the temporary file is
+created by another process between checking for the existence of the
+file and its opening.  Additional security levels are provided to
+check, for example, that the sticky bit is set on world writable
+directories.  See L<"safe_level"> for more information.
+
+For compatibility with popular C library functions, Perl implementations of
+the mkstemp() family of functions are provided. These are, mkstemp(),
+mkstemps(), mkdtemp() and mktemp().
+
+Additionally, implementations of the standard L<POSIX|POSIX>
+tmpnam() and tmpfile() functions are provided if required.
+
+Implementations of mktemp(), tmpnam(), and tempnam() are provided,
+but should be used with caution since they return only a filename
+that was valid when function was called, so cannot guarantee
+that the file will not exist by the time the caller opens the filename.
+
+Filehandles returned by these functions support the seekable methods.
+
+=cut
+
+# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
+# People would like a version on 5.004 so give them what they want :-)
+use 5.004;
+use strict;
+use Carp;
+use File::Spec 0.8;
+use File::Path qw/ rmtree /;
+use Fcntl 1.03;
+use IO::Seekable;               # For SEEK_*
+use Errno;
+require VMS::Stdio if $^O eq 'VMS';
+
+# pre-emptively load Carp::Heavy. If we don't when we run out of file
+# handles and attempt to call croak() we get an error message telling
+# us that Carp::Heavy won't load rather than an error telling us we
+# have run out of file handles. We either preload croak() or we
+# switch the calls to croak from _gettemp() to use die.
+eval { require Carp::Heavy; };
+
+# Need the Symbol package if we are running older perl
+require Symbol if $] < 5.006;
+
+### For the OO interface
+use base qw/ IO::Handle IO::Seekable /;
+use overload '""' => "STRINGIFY", fallback => 1;
+
+# use 'our' on v5.6.0
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
+
+$DEBUG = 0;
+$KEEP_ALL = 0;
+
+# We are exporting functions
+
+use base qw/Exporter/;
+
+# Export list - to allow fine tuning of export table
+
+@EXPORT_OK = qw{
+                 tempfile
+                 tempdir
+                 tmpnam
+                 tmpfile
+                 mktemp
+                 mkstemp
+                 mkstemps
+                 mkdtemp
+                 unlink0
+                 cleanup
+                 SEEK_SET
+                 SEEK_CUR
+                 SEEK_END
+             };
+
+# Groups of functions for export
+
+%EXPORT_TAGS = (
+                'POSIX' => [qw/ tmpnam tmpfile /],
+                'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+                'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
+               );
+
+# add contents of these tags to @EXPORT
+Exporter::export_tags('POSIX','mktemp','seekable');
+
+# Version number
+
+$VERSION = '0.22';
+
+# This is a list of characters that can be used in random filenames
+
+my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+                 a b c d e f g h i j k l m n o p q r s t u v w x y z
+                 0 1 2 3 4 5 6 7 8 9 _
+               /);
+
+# Maximum number of tries to make a temp file before failing
+
+use constant MAX_TRIES => 1000;
+
+# Minimum number of X characters that should be in a template
+use constant MINX => 4;
+
+# Default template when no template supplied
+
+use constant TEMPXXX => 'X' x 10;
+
+# Constants for the security level
+
+use constant STANDARD => 0;
+use constant MEDIUM   => 1;
+use constant HIGH     => 2;
+
+# OPENFLAGS. If we defined the flag to use with Sysopen here this gives
+# us an optimisation when many temporary files are requested
+
+my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
+my $LOCKFLAG;
+
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    no strict 'refs';
+    $OPENFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # e.g. CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
+  # Special case O_EXLOCK
+  $LOCKFLAG = eval {
+    local $SIG{__DIE__} = sub {};
+    local $SIG{__WARN__} = sub {};
+    &Fcntl::O_EXLOCK();
+  };
+}
+
+# On some systems the O_TEMPORARY flag can be used to tell the OS
+# to automatically remove the file when it is closed. This is fine
+# in most cases but not if tempfile is called with UNLINK=>0 and
+# the filename is requested -- in the case where the filename is to
+# be passed to another routine. This happens on windows. We overcome
+# this by using a second open flags variable
+
+my $OPENTEMPFLAGS = $OPENFLAGS;
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ TEMPORARY /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    local($@);
+    no strict 'refs';
+    $OPENTEMPFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # e.g. CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
+}
+
+# Private hash tracking which files have been created by each process id via the OO interface
+my %FILES_CREATED_BY_OBJECT;
+
+# INTERNAL ROUTINES - not to be used outside of package
+
+# Generic routine for getting a temporary filename
+# modelled on OpenBSD _gettemp() in mktemp.c
+
+# The template must contain X's that are to be replaced
+# with the random values
+
+#  Arguments:
+
+#  TEMPLATE   - string containing the XXXXX's that is converted
+#           to a random filename and opened if required
+
+# Optionally, a hash can also be supplied containing specific options
+#   "open" => if true open the temp file, else just return the name
+#             default is 0
+#   "mkdir"=> if true, we are creating a temp directory rather than tempfile
+#             default is 0
+#   "suffixlen" => number of characters at end of PATH to be ignored.
+#                  default is 0.
+#   "unlink_on_close" => indicates that, if possible,  the OS should remove
+#                        the file as soon as it is closed. Usually indicates
+#                        use of the O_TEMPORARY flag to sysopen.
+#                        Usually irrelevant on unix
+#   "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
+
+# Optionally a reference to a scalar can be passed into the function
+# On error this will be used to store the reason for the error
+#   "ErrStr"  => \$errstr
+
+# "open" and "mkdir" can not both be true
+# "unlink_on_close" is not used when "mkdir" is true.
+
+# The default options are equivalent to mktemp().
+
+# Returns:
+#   filehandle - open file handle (if called with doopen=1, else undef)
+#   temp name  - name of the temp file or directory
+
+# For example:
+#   ($fh, $name) = _gettemp($template, "open" => 1);
+
+# for the current version, failures are associated with
+# stored in an error string and returned to give the reason whilst debugging
+# This routine is not called by any external function
+sub _gettemp {
+
+  croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
+    unless scalar(@_) >= 1;
+
+  # the internal error string - expect it to be overridden
+  # Need this in case the caller decides not to supply us a value
+  # need an anonymous scalar
+  my $tempErrStr;
+
+  # Default options
+  my %options = (
+                 "open" => 0,
+                 "mkdir" => 0,
+                 "suffixlen" => 0,
+                 "unlink_on_close" => 0,
+                 "use_exlock" => 1,
+                 "ErrStr" => \$tempErrStr,
+                );
+
+  # Read the template
+  my $template = shift;
+  if (ref($template)) {
+    # Use a warning here since we have not yet merged ErrStr
+    carp "File::Temp::_gettemp: template must not be a reference";
+    return ();
+  }
+
+  # Check that the number of entries on stack are even
+  if (scalar(@_) % 2 != 0) {
+    # Use a warning here since we have not yet merged ErrStr
+    carp "File::Temp::_gettemp: Must have even number of options";
+    return ();
+  }
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # Make sure the error string is set to undef
+  ${$options{ErrStr}} = undef;
+
+  # Can not open the file and make a directory in a single call
+  if ($options{"open"} && $options{"mkdir"}) {
+    ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
+    return ();
+  }
+
+  # Find the start of the end of the  Xs (position of last X)
+  # Substr starts from 0
+  my $start = length($template) - 1 - $options{"suffixlen"};
+
+  # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
+  # (taking suffixlen into account). Any fewer is insecure.
+
+  # Do it using substr - no reason to use a pattern match since
+  # we know where we are looking and what we are looking for
+
+  if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
+    ${$options{ErrStr}} = "The template must end with at least ".
+      MINX . " 'X' characters\n";
+    return ();
+  }
+
+  # Replace all the X at the end of the substring with a
+  # random character or just all the XX at the end of a full string.
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # and generate a full path from the template
+
+  my $path = _replace_XX($template, $options{"suffixlen"});
+
+
+  # Split the path into constituent parts - eventually we need to check
+  # whether the directory exists
+  # We need to know whether we are making a temp directory
+  # or a tempfile
+
+  my ($volume, $directories, $file);
+  my $parent;                   # parent directory
+  if ($options{"mkdir"}) {
+    # There is no filename at the end
+    ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
+
+    # The parent is then $directories without the last directory
+    # Split the directory and put it back together again
+    my @dirs = File::Spec->splitdir($directories);
+
+    # If @dirs only has one entry (i.e. the directory template) that means
+    # we are in the current directory
+    if ($#dirs == 0) {
+      $parent = File::Spec->curdir;
+    } else {
+
+      if ($^O eq 'VMS') {     # need volume to avoid relative dir spec
+        $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
+        $parent = 'sys$disk:[]' if $parent eq '';
+      } else {
+
+        # Put it back together without the last one
+        $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
+
+        # ...and attach the volume (no filename)
+        $parent = File::Spec->catpath($volume, $parent, '');
+      }
+
+    }
+
+  } else {
+
+    # Get rid of the last filename (use File::Basename for this?)
+    ($volume, $directories, $file) = File::Spec->splitpath( $path );
+
+    # Join up without the file part
+    $parent = File::Spec->catpath($volume,$directories,'');
+
+    # If $parent is empty replace with curdir
+    $parent = File::Spec->curdir
+      unless $directories ne '';
+
+  }
+
+  # Check that the parent directories exist
+  # Do this even for the case where we are simply returning a name
+  # not a file -- no point returning a name that includes a directory
+  # that does not exist or is not writable
+
+  unless (-e $parent) {
+    ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
+    return ();
+  }
+  unless (-d $parent) {
+    ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
+    return ();
+  }
+
+  # Check the stickiness of the directory and chown giveaway if required
+  # If the directory is world writable the sticky bit
+  # must be set
+
+  if (File::Temp->safe_level == MEDIUM) {
+    my $safeerr;
+    unless (_is_safe($parent,\$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
+      return ();
+    }
+  } elsif (File::Temp->safe_level == HIGH) {
+    my $safeerr;
+    unless (_is_verysafe($parent, \$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
+      return ();
+    }
+  }
+
+
+  # Now try MAX_TRIES time to open the file
+  for (my $i = 0; $i < MAX_TRIES; $i++) {
+
+    # Try to open the file if requested
+    if ($options{"open"}) {
+      my $fh;
+
+      # If we are running before perl5.6.0 we can not auto-vivify
+      if ($] < 5.006) {
+        $fh = &Symbol::gensym;
+      }
+
+      # Try to make sure this will be marked close-on-exec
+      # XXX: Win32 doesn't respect this, nor the proper fcntl,
+      #      but may have O_NOINHERIT. This may or may not be in Fcntl.
+      local $^F = 2;
+
+      # Attempt to open the file
+      my $open_success = undef;
+      if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
+        # make it auto delete on close by setting FAB$V_DLT bit
+        $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+        $open_success = $fh;
+      } else {
+        my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
+                      $OPENTEMPFLAGS :
+                      $OPENFLAGS );
+        $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
+        $open_success = sysopen($fh, $path, $flags, 0600);
+      }
+      if ( $open_success ) {
+
+        # in case of odd umask force rw
+        chmod(0600, $path);
+
+        # Opened successfully - return file handle and name
+        return ($fh, $path);
+
+      } else {
+
+        # Error opening file - abort with error
+        # if the reason was anything but EEXIST
+        unless ($!{EEXIST}) {
+          ${$options{ErrStr}} = "Could not create temp file $path: $!";
+          return ();
+        }
+
+        # Loop round for another try
+
+      }
+    } elsif ($options{"mkdir"}) {
+
+      # Open the temp directory
+      if (mkdir( $path, 0700)) {
+        # in case of odd umask
+        chmod(0700, $path);
+
+        return undef, $path;
+      } else {
+
+        # Abort with error if the reason for failure was anything
+        # except EEXIST
+        unless ($!{EEXIST}) {
+          ${$options{ErrStr}} = "Could not create directory $path: $!";
+          return ();
+        }
+
+        # Loop round for another try
+
+      }
+
+    } else {
+
+      # Return true if the file can not be found
+      # Directory has been checked previously
+
+      return (undef, $path) unless -e $path;
+
+      # Try again until MAX_TRIES
+
+    }
+
+    # Did not successfully open the tempfile/dir
+    # so try again with a different set of random letters
+    # No point in trying to increment unless we have only
+    # 1 X say and the randomness could come up with the same
+    # file MAX_TRIES in a row.
+
+    # Store current attempt - in principal this implies that the
+    # 3rd time around the open attempt that the first temp file
+    # name could be generated again. Probably should store each
+    # attempt and make sure that none are repeated
+
+    my $original = $path;
+    my $counter = 0;            # Stop infinite loop
+    my $MAX_GUESS = 50;
+
+    do {
+
+      # Generate new name from original template
+      $path = _replace_XX($template, $options{"suffixlen"});
+
+      $counter++;
+
+    } until ($path ne $original || $counter > $MAX_GUESS);
+
+    # Check for out of control looping
+    if ($counter > $MAX_GUESS) {
+      ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
+      return ();
+    }
+
+  }
+
+  # If we get here, we have run out of tries
+  ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
+    . MAX_TRIES . ") to open temp file/dir";
+
+  return ();
+
+}
+
+# Internal routine to replace the XXXX... with random characters
+# This has to be done by _gettemp() every time it fails to
+# open a temp file/dir
+
+# Arguments:  $template (the template with XXX),
+#             $ignore   (number of characters at end to ignore)
+
+# Returns:    modified template
+
+sub _replace_XX {
+
+  croak 'Usage: _replace_XX($template, $ignore)'
+    unless scalar(@_) == 2;
+
+  my ($path, $ignore) = @_;
+
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # Alternatively, could simply set $ignore to length($path)-1
+  # Don't want to always use substr when not required though.
+  my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
+
+  if ($ignore) {
+    substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
+  } else {
+    $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
+  }
+  return $path;
+}
+
+# Internal routine to force a temp file to be writable after
+# it is created so that we can unlink it. Windows seems to occassionally
+# force a file to be readonly when written to certain temp locations
+sub _force_writable {
+  my $file = shift;
+  chmod 0600, $file;
+}
+
+
+# internal routine to check to see if the directory is safe
+# First checks to see if the directory is not owned by the
+# current user or root. Then checks to see if anyone else
+# can write to the directory and if so, checks to see if
+# it has the sticky bit set
+
+# Will not work on systems that do not support sticky bit
+
+#Args:  directory path to check
+#       Optionally: reference to scalar to contain error message
+# Returns true if the path is safe and false otherwise.
+# Returns undef if can not even run stat() on the path
+
+# This routine based on version written by Tom Christiansen
+
+# Presumably, by the time we actually attempt to create the
+# file or directory in this directory, it may not be safe
+# anymore... Have to run _is_safe directly after the open.
+
+sub _is_safe {
+
+  my $path = shift;
+  my $err_ref = shift;
+
+  # Stat path
+  my @info = stat($path);
+  unless (scalar(@info)) {
+    $$err_ref = "stat(path) returned no values";
+    return 0;
+  }
+  ;
+  return 1 if $^O eq 'VMS';     # owner delete control at file level
+
+  # Check to see whether owner is neither superuser (or a system uid) nor me
+  # Use the effective uid from the $> variable
+  # UID is in [4]
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
+
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
+                File::Temp->top_system_uid());
+
+    $$err_ref = "Directory owned neither by root nor the current user"
+      if ref($err_ref);
+    return 0;
+  }
+
+  # check whether group or other can write file
+  # use 066 to detect either reading or writing
+  # use 022 to check writability
+  # Do it with S_IWOTH and S_IWGRP for portability (maybe)
+  # mode is in info[2]
+  if (($info[2] & &Fcntl::S_IWGRP) ||  # Is group writable?
+      ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
+    # Must be a directory
+    unless (-d $path) {
+      $$err_ref = "Path ($path) is not a directory"
+        if ref($err_ref);
+      return 0;
+    }
+    # Must have sticky bit set
+    unless (-k $path) {
+      $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
+        if ref($err_ref);
+      return 0;
+    }
+  }
+
+  return 1;
+}
+
+# Internal routine to check whether a directory is safe
+# for temp files. Safer than _is_safe since it checks for
+# the possibility of chown giveaway and if that is a possibility
+# checks each directory in the path to see if it is safe (with _is_safe)
+
+# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
+# directory anyway.
+
+# Takes optional second arg as scalar ref to error reason
+
+sub _is_verysafe {
+
+  # Need POSIX - but only want to bother if really necessary due to overhead
+  require POSIX;
+
+  my $path = shift;
+  print "_is_verysafe testing $path\n" if $DEBUG;
+  return 1 if $^O eq 'VMS';     # owner delete control at file level
+
+  my $err_ref = shift;
+
+  # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
+  # and If it is not there do the extensive test
+  local($@);
+  my $chown_restricted;
+  $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
+    if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
+
+  # If chown_resticted is set to some value we should test it
+  if (defined $chown_restricted) {
+
+    # Return if the current directory is safe
+    return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
+
+  }
+
+  # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
+  # was not avialable or the symbol was there but chown giveaway
+  # is allowed. Either way, we now have to test the entire tree for
+  # safety.
+
+  # Convert path to an absolute directory if required
+  unless (File::Spec->file_name_is_absolute($path)) {
+    $path = File::Spec->rel2abs($path);
+  }
+
+  # Split directory into components - assume no file
+  my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
+
+  # Slightly less efficient than having a function in File::Spec
+  # to chop off the end of a directory or even a function that
+  # can handle ../ in a directory tree
+  # Sometimes splitdir() returns a blank at the end
+  # so we will probably check the bottom directory twice in some cases
+  my @dirs = File::Spec->splitdir($directories);
+
+  # Concatenate one less directory each time around
+  foreach my $pos (0.. $#dirs) {
+    # Get a directory name
+    my $dir = File::Spec->catpath($volume,
+                                  File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
+                                  ''
+                                 );
+
+    print "TESTING DIR $dir\n" if $DEBUG;
+
+    # Check the directory
+    return 0 unless _is_safe($dir,$err_ref);
+
+  }
+
+  return 1;
+}
+
+
+
+# internal routine to determine whether unlink works on this
+# platform for files that are currently open.
+# Returns true if we can, false otherwise.
+
+# Currently WinNT, OS/2 and VMS can not unlink an opened file
+# On VMS this is because the O_EXCL flag is used to open the
+# temporary file. Currently I do not know enough about the issues
+# on VMS to decide whether O_EXCL is a requirement.
+
+sub _can_unlink_opened_file {
+
+  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
+    return 0;
+  } else {
+    return 1;
+  }
+
+}
+
+# internal routine to decide which security levels are allowed
+# see safe_level() for more information on this
+
+# Controls whether the supplied security level is allowed
+
+#   $cando = _can_do_level( $level )
+
+sub _can_do_level {
+
+  # Get security level
+  my $level = shift;
+
+  # Always have to be able to do STANDARD
+  return 1 if $level == STANDARD;
+
+  # Currently, the systems that can do HIGH or MEDIUM are identical
+  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
+    return 0;
+  } else {
+    return 1;
+  }
+
+}
+
+# This routine sets up a deferred unlinking of a specified
+# filename and filehandle. It is used in the following cases:
+#  - Called by unlink0 if an opened file can not be unlinked
+#  - Called by tempfile() if files are to be removed on shutdown
+#  - Called by tempdir() if directories are to be removed on shutdown
+
+# Arguments:
+#   _deferred_unlink( $fh, $fname, $isdir );
+#
+#   - filehandle (so that it can be expclicitly closed if open
+#   - filename   (the thing we want to remove)
+#   - isdir      (flag to indicate that we are being given a directory)
+#                 [and hence no filehandle]
+
+# Status is not referred to since all the magic is done with an END block
+
+{
+  # Will set up two lexical variables to contain all the files to be
+  # removed. One array for files, another for directories They will
+  # only exist in this block.
+
+  #  This means we only have to set up a single END block to remove
+  #  all files. 
+
+  # in order to prevent child processes inadvertently deleting the parent
+  # temp files we use a hash to store the temp files and directories
+  # created by a particular process id.
+
+  # %files_to_unlink contains values that are references to an array of
+  # array references containing the filehandle and filename associated with
+  # the temp file.
+  my (%files_to_unlink, %dirs_to_unlink);
+
+  # Set up an end block to use these arrays
+  END {
+    local($., $@, $!, $^E, $?);
+    cleanup();
+  }
+
+  # Cleanup function. Always triggered on END but can be invoked
+  # manually.
+  sub cleanup {
+    if (!$KEEP_ALL) {
+      # Files
+      my @files = (exists $files_to_unlink{$$} ?
+                   @{ $files_to_unlink{$$} } : () );
+      foreach my $file (@files) {
+        # close the filehandle without checking its state
+        # in order to make real sure that this is closed
+        # if its already closed then I dont care about the answer
+        # probably a better way to do this
+        close($file->[0]);      # file handle is [0]
+
+        if (-f $file->[1]) {       # file name is [1]
+          _force_writable( $file->[1] ); # for windows
+          unlink $file->[1] or warn "Error removing ".$file->[1];
+        }
+      }
+      # Dirs
+      my @dirs = (exists $dirs_to_unlink{$$} ?
+                  @{ $dirs_to_unlink{$$} } : () );
+      foreach my $dir (@dirs) {
+        if (-d $dir) {
+          # Some versions of rmtree will abort if you attempt to remove
+          # the directory you are sitting in. We protect that and turn it
+          # into a warning. We do this because this occurs during
+          # cleanup and so can not be caught by the user.
+          eval { rmtree($dir, $DEBUG, 0); };
+          warn $@ if ($@ && $^W);
+        }
+      }
+
+      # clear the arrays
+      @{ $files_to_unlink{$$} } = ()
+        if exists $files_to_unlink{$$};
+      @{ $dirs_to_unlink{$$} } = ()
+        if exists $dirs_to_unlink{$$};
+    }
+  }
+
+
+  # This is the sub called to register a file for deferred unlinking
+  # This could simply store the input parameters and defer everything
+  # until the END block. For now we do a bit of checking at this
+  # point in order to make sure that (1) we have a file/dir to delete
+  # and (2) we have been called with the correct arguments.
+  sub _deferred_unlink {
+
+    croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
+      unless scalar(@_) == 3;
+
+    my ($fh, $fname, $isdir) = @_;
+
+    warn "Setting up deferred removal of $fname\n"
+      if $DEBUG;
+
+    # If we have a directory, check that it is a directory
+    if ($isdir) {
+
+      if (-d $fname) {
+
+        # Directory exists so store it
+        # first on VMS turn []foo into [.foo] for rmtree
+        $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
+        $dirs_to_unlink{$$} = [] 
+          unless exists $dirs_to_unlink{$$};
+        push (@{ $dirs_to_unlink{$$} }, $fname);
+
+      } else {
+        carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
+      }
+
+    } else {
+
+      if (-f $fname) {
+
+        # file exists so store handle and name for later removal
+        $files_to_unlink{$$} = []
+          unless exists $files_to_unlink{$$};
+        push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
+
+      } else {
+        carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
+      }
+
+    }
+
+  }
+
+
+}
+
+=head1 OBJECT-ORIENTED INTERFACE
+
+This is the primary interface for interacting with
+C<File::Temp>. Using the OO interface a temporary file can be created
+when the object is constructed and the file can be removed when the
+object is no longer required.
+
+Note that there is no method to obtain the filehandle from the
+C<File::Temp> object. The object itself acts as a filehandle. Also,
+the object is configured such that it stringifies to the name of the
+temporary file, and can be compared to a filename directly. The object
+isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
+available.
+
+=over 4
+
+=item B<new>
+
+Create a temporary file object.
+
+  my $tmp = File::Temp->new();
+
+by default the object is constructed as if C<tempfile>
+was called without options, but with the additional behaviour
+that the temporary file is removed by the object destructor
+if UNLINK is set to true (the default).
+
+Supported arguments are the same as for C<tempfile>: UNLINK
+(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
+template is specified using the TEMPLATE option. The OPEN option
+is not supported (the file is always opened).
+
+ $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
+                        DIR => 'mydir',
+                        SUFFIX => '.dat');
+
+Arguments are case insensitive.
+
+Can call croak() if an error occurs.
+
+=cut
+
+sub new {
+  my $proto = shift;
+  my $class = ref($proto) || $proto;
+
+  # read arguments and convert keys to upper case
+  my %args = @_;
+  %args = map { uc($_), $args{$_} } keys %args;
+
+  # see if they are unlinking (defaulting to yes)
+  my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
+  delete $args{UNLINK};
+
+  # template (store it in an array so that it will
+  # disappear from the arg list of tempfile)
+  my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
+  delete $args{TEMPLATE};
+
+  # Protect OPEN
+  delete $args{OPEN};
+
+  # Open the file and retain file handle and file name
+  my ($fh, $path) = tempfile( @template, %args );
+
+  print "Tmp: $fh - $path\n" if $DEBUG;
+
+  # Store the filename in the scalar slot
+  ${*$fh} = $path;
+
+  # Cache the filename by pid so that the destructor can decide whether to remove it
+  $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
+
+  # Store unlink information in hash slot (plus other constructor info)
+  %{*$fh} = %args;
+
+  # create the object
+  bless $fh, $class;
+
+  # final method-based configuration
+  $fh->unlink_on_destroy( $unlink );
+
+  return $fh;
+}
+
+=item B<newdir>
+
+Create a temporary directory using an object oriented interface.
+
+  $dir = File::Temp->newdir();
+
+By default the directory is deleted when the object goes out of scope.
+
+Supports the same options as the C<tempdir> function. Note that directories
+created with this method default to CLEANUP => 1.
+
+  $dir = File::Temp->newdir( $template, %options );
+
+=cut
+
+sub newdir {
+  my $self = shift;
+
+  # need to handle args as in tempdir because we have to force CLEANUP
+  # default without passing CLEANUP to tempdir
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+  my %options = @_;
+  my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
+
+  delete $options{CLEANUP};
+
+  my $tempdir;
+  if (defined $template) {
+    $tempdir = tempdir( $template, %options );
+  } else {
+    $tempdir = tempdir( %options );
+  }
+  return bless { DIRNAME => $tempdir,
+                 CLEANUP => $cleanup,
+                 LAUNCHPID => $$,
+               }, "File::Temp::Dir";
+}
+
+=item B<filename>
+
+Return the name of the temporary file associated with this object
+(if the object was created using the "new" constructor).
+
+  $filename = $tmp->filename;
+
+This method is called automatically when the object is used as
+a string.
+
+=cut
+
+sub filename {
+  my $self = shift;
+  return ${*$self};
+}
+
+sub STRINGIFY {
+  my $self = shift;
+  return $self->filename;
+}
+
+=item B<dirname>
+
+Return the name of the temporary directory associated with this
+object (if the object was created using the "newdir" constructor).
+
+  $dirname = $tmpdir->dirname;
+
+This method is called automatically when the object is used in string context.
+
+=item B<unlink_on_destroy>
+
+Control whether the file is unlinked when the object goes out of scope.
+The file is removed if this value is true and $KEEP_ALL is not.
+
+ $fh->unlink_on_destroy( 1 );
+
+Default is for the file to be removed.
+
+=cut
+
+sub unlink_on_destroy {
+  my $self = shift;
+  if (@_) {
+    ${*$self}{UNLINK} = shift;
+  }
+  return ${*$self}{UNLINK};
+}
+
+=item B<DESTROY>
+
+When the object goes out of scope, the destructor is called. This
+destructor will attempt to unlink the file (using C<unlink1>)
+if the constructor was called with UNLINK set to 1 (the default state
+if UNLINK is not specified).
+
+No error is given if the unlink fails.
+
+If the object has been passed to a child process during a fork, the
+file will be deleted when the object goes out of scope in the parent.
+
+For a temporary directory object the directory will be removed
+unless the CLEANUP argument was used in the constructor (and set to
+false) or C<unlink_on_destroy> was modified after creation.
+
+If the global variable $KEEP_ALL is true, the file or directory
+will not be removed.
+
+=cut
+
+sub DESTROY {
+  local($., $@, $!, $^E, $?);
+  my $self = shift;
+
+  # Make sure we always remove the file from the global hash
+  # on destruction. This prevents the hash from growing uncontrollably
+  # and post-destruction there is no reason to know about the file.
+  my $file = $self->filename;
+  my $was_created_by_proc;
+  if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
+    $was_created_by_proc = 1;
+    delete $FILES_CREATED_BY_OBJECT{$$}{$file};
+  }
+
+  if (${*$self}{UNLINK} && !$KEEP_ALL) {
+    print "# --------->   Unlinking $self\n" if $DEBUG;
+
+    # only delete if this process created it
+    return unless $was_created_by_proc;
+
+    # The unlink1 may fail if the file has been closed
+    # by the caller. This leaves us with the decision
+    # of whether to refuse to remove the file or simply
+    # do an unlink without test. Seems to be silly
+    # to do this when we are trying to be careful
+    # about security
+    _force_writable( $file ); # for windows
+    unlink1( $self, $file )
+      or unlink($file);
+  }
+}
+
+=back
+
+=head1 FUNCTIONS
+
+This section describes the recommended interface for generating
+temporary files and directories.
+
+=over 4
+
+=item B<tempfile>
+
+This is the basic function to generate temporary files.
+The behaviour of the file can be changed using various options:
+
+  $fh = tempfile();
+  ($fh, $filename) = tempfile();
+
+Create a temporary file in  the directory specified for temporary
+files, as specified by the tmpdir() function in L<File::Spec>.
+
+  ($fh, $filename) = tempfile($template);
+
+Create a temporary file in the current directory using the supplied
+template.  Trailing `X' characters are replaced with random letters to
+generate the filename.  At least four `X' characters must be present
+at the end of the template.
+
+  ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
+
+Same as previously, except that a suffix is added to the template
+after the `X' translation.  Useful for ensuring that a temporary
+filename has a particular extension when needed by other applications.
+But see the WARNING at the end.
+
+  ($fh, $filename) = tempfile($template, DIR => $dir);
+
+Translates the template as before except that a directory name
+is specified.
+
+  ($fh, $filename) = tempfile($template, TMPDIR => 1);
+
+Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
+into the same temporary directory as would be used if no template was
+specified at all.
+
+  ($fh, $filename) = tempfile($template, UNLINK => 1);
+
+Return the filename and filehandle as before except that the file is
+automatically removed when the program exits (dependent on
+$KEEP_ALL). Default is for the file to be removed if a file handle is
+requested and to be kept if the filename is requested. In a scalar
+context (where no filename is returned) the file is always deleted
+either (depending on the operating system) on exit or when it is
+closed (unless $KEEP_ALL is true when the temp file is created).
+
+Use the object-oriented interface if fine-grained control of when
+a file is removed is required.
+
+If the template is not specified, a template is always
+automatically generated. This temporary file is placed in tmpdir()
+(L<File::Spec>) unless a directory is specified explicitly with the
+DIR option.
+
+  $fh = tempfile( DIR => $dir );
+
+If called in scalar context, only the filehandle is returned and the
+file will automatically be deleted when closed on operating systems
+that support this (see the description of tmpfile() elsewhere in this
+document).  This is the preferred mode of operation, as if you only
+have a filehandle, you can never create a race condition by fumbling
+with the filename. On systems that can not unlink an open file or can
+not mark a file as temporary when it is opened (for example, Windows
+NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
+the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
+flag is ignored if present.
+
+  (undef, $filename) = tempfile($template, OPEN => 0);
+
+This will return the filename based on the template but
+will not open this file.  Cannot be used in conjunction with
+UNLINK set to true. Default is to always open the file
+to protect from possible race conditions. A warning is issued
+if warnings are turned on. Consider using the tmpnam()
+and mktemp() functions described elsewhere in this document
+if opening the file is not required.
+
+If the operating system supports it (for example BSD derived systems), the 
+filehandle will be opened with O_EXLOCK (open with exclusive file lock). 
+This can sometimes cause problems if the intention is to pass the filename 
+to another system that expects to take an exclusive lock itself (such as 
+DBD::SQLite) whilst ensuring that the tempfile is not reused. In this 
+situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK 
+will be true (this retains compatibility with earlier releases).
+
+  ($fh, $filename) = tempfile($template, EXLOCK => 0);
+
+Options can be combined as required.
+
+Will croak() if there is an error.
+
+=cut
+
+sub tempfile {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+                 "DIR"    => undef, # Directory prefix
+                 "SUFFIX" => '',    # Template suffix
+                 "UNLINK" => 0,     # Do not unlink file on exit
+                 "OPEN"   => 1,     # Open file
+                 "TMPDIR" => 0, # Place tempfile in tempdir if template specified
+                 "EXLOCK" => 1, # Open file with O_EXLOCK
+                );
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # First decision is whether or not to open the file
+  if (! $options{"OPEN"}) {
+
+    warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
+      if $^W;
+
+  }
+
+  if ($options{"DIR"} and $^O eq 'VMS') {
+
+    # on VMS turn []foo into [.foo] for concatenation
+    $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
+  }
+
+  # Construct the template
+
+  # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
+  # functions or simply constructing a template and using _gettemp()
+  # explicitly. Go for the latter
+
+  # First generate a template if not defined and prefix the directory
+  # If no template must prefix the temp directory
+  if (defined $template) {
+    # End up with current directory if neither DIR not TMPDIR are set
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, $template);
+
+    } elsif ($options{TMPDIR}) {
+
+      $template = File::Spec->catfile(File::Spec->tmpdir, $template );
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
+
+    } else {
+
+      $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
+
+    }
+
+  }
+
+  # Now add a suffix
+  $template .= $options{"SUFFIX"};
+
+  # Determine whether we should tell _gettemp to unlink the file
+  # On unix this is irrelevant and can be worked out after the file is
+  # opened (simply by unlinking the open filehandle). On Windows or VMS
+  # we have to indicate temporary-ness when we open the file. In general
+  # we only want a true temporary file if we are returning just the
+  # filehandle - if the user wants the filename they probably do not
+  # want the file to disappear as soon as they close it (which may be
+  # important if they want a child process to use the file)
+  # For this reason, tie unlink_on_close to the return context regardless
+  # of OS.
+  my $unlink_on_close = ( wantarray ? 0 : 1);
+
+  # Create the file
+  my ($fh, $path, $errstr);
+  croak "Error in tempfile() using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+                                    "open" => $options{'OPEN'},
+                                    "mkdir"=> 0 ,
+                                    "unlink_on_close" => $unlink_on_close,
+                                    "suffixlen" => length($options{'SUFFIX'}),
+                                    "ErrStr" => \$errstr,
+                                    "use_exlock" => $options{EXLOCK},
+                                   ) );
+
+  # Set up an exit handler that can do whatever is right for the
+  # system. This removes files at exit when requested explicitly or when
+  # system is asked to unlink_on_close but is unable to do so because
+  # of OS limitations.
+  # The latter should be achieved by using a tied filehandle.
+  # Do not check return status since this is all done with END blocks.
+  _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
+
+  # Return
+  if (wantarray()) {
+
+    if ($options{'OPEN'}) {
+      return ($fh, $path);
+    } else {
+      return (undef, $path);
+    }
+
+  } else {
+
+    # Unlink the file. It is up to unlink0 to decide what to do with
+    # this (whether to unlink now or to defer until later)
+    unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
+
+    # Return just the filehandle.
+    return $fh;
+  }
+
+
+}
+
+=item B<tempdir>
+
+This is the recommended interface for creation of temporary
+directories.  By default the directory will not be removed on exit
+(that is, it won't be temporary; this behaviour can not be changed
+because of issues with backwards compatibility). To enable removal
+either use the CLEANUP option which will trigger removal on program
+exit, or consider using the "newdir" method in the object interface which
+will allow the directory to be cleaned up when the object goes out of
+scope.
+
+The behaviour of the function depends on the arguments:
+
+  $tempdir = tempdir();
+
+Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
+
+  $tempdir = tempdir( $template );
+
+Create a directory from the supplied template. This template is
+similar to that described for tempfile(). `X' characters at the end
+of the template are replaced with random letters to construct the
+directory name. At least four `X' characters must be in the template.
+
+  $tempdir = tempdir ( DIR => $dir );
+
+Specifies the directory to use for the temporary directory.
+The temporary directory name is derived from an internal template.
+
+  $tempdir = tempdir ( $template, DIR => $dir );
+
+Prepend the supplied directory name to the template. The template
+should not include parent directory specifications itself. Any parent
+directory specifications are removed from the template before
+prepending the supplied directory.
+
+  $tempdir = tempdir ( $template, TMPDIR => 1 );
+
+Using the supplied template, create the temporary directory in
+a standard location for temporary files. Equivalent to doing
+
+  $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
+
+but shorter. Parent directory specifications are stripped from the
+template itself. The C<TMPDIR> option is ignored if C<DIR> is set
+explicitly.  Additionally, C<TMPDIR> is implied if neither a template
+nor a directory are supplied.
+
+  $tempdir = tempdir( $template, CLEANUP => 1);
+
+Create a temporary directory using the supplied template, but
+attempt to remove it (and all files inside it) when the program
+exits. Note that an attempt will be made to remove all files from
+the directory even if they were not created by this module (otherwise
+why ask to clean it up?). The directory removal is made with
+the rmtree() function from the L<File::Path|File::Path> module.
+Of course, if the template is not specified, the temporary directory
+will be created in tmpdir() and will also be removed at program exit.
+
+Will croak() if there is an error.
+
+=cut
+
+# '
+
+sub tempdir  {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+                 "CLEANUP"    => 0, # Remove directory on exit
+                 "DIR"        => '', # Root directory
+                 "TMPDIR"     => 0,  # Use tempdir with template
+                );
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # Modify or generate the template
+
+  # Deal with the DIR and TMPDIR options
+  if (defined $template) {
+
+    # Need to strip directory path if using DIR or TMPDIR
+    if ($options{'TMPDIR'} || $options{'DIR'}) {
+
+      # Strip parent directory from the filename
+      #
+      # There is no filename at the end
+      $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
+      my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
+
+      # Last directory is then our template
+      $template = (File::Spec->splitdir($directories))[-1];
+
+      # Prepend the supplied directory or temp dir
+      if ($options{"DIR"}) {
+
+        $template = File::Spec->catdir($options{"DIR"}, $template);
+
+      } elsif ($options{TMPDIR}) {
+
+        # Prepend tmpdir
+        $template = File::Spec->catdir(File::Spec->tmpdir, $template);
+
+      }
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
+
+    } else {
+
+      $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
+
+    }
+
+  }
+
+  # Create the directory
+  my $tempdir;
+  my $suffixlen = 0;
+  if ($^O eq 'VMS') {           # dir names can end in delimiters
+    $template =~ m/([\.\]:>]+)$/;
+    $suffixlen = length($1);
+  }
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
+
+  my $errstr;
+  croak "Error in tempdir() using $template: $errstr"
+    unless ((undef, $tempdir) = _gettemp($template,
+                                         "open" => 0,
+                                         "mkdir"=> 1 ,
+                                         "suffixlen" => $suffixlen,
+                                         "ErrStr" => \$errstr,
+                                        ) );
+
+  # Install exit handler; must be dynamic to get lexical
+  if ( $options{'CLEANUP'} && -d $tempdir) {
+    _deferred_unlink(undef, $tempdir, 1);
+  }
+
+  # Return the dir name
+  return $tempdir;
+
+}
+
+=back
+
+=head1 MKTEMP FUNCTIONS
+
+The following functions are Perl implementations of the
+mktemp() family of temp file generation system calls.
+
+=over 4
+
+=item B<mkstemp>
+
+Given a template, returns a filehandle to the temporary file and the name
+of the file.
+
+  ($fh, $name) = mkstemp( $template );
+
+In scalar context, just the filehandle is returned.
+
+The template may be any filename with some number of X's appended
+to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
+with unique alphanumeric combinations.
+
+Will croak() if there is an error.
+
+=cut
+
+
+
+sub mkstemp {
+
+  croak "Usage: mkstemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemp using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+                                    "open" => 1,
+                                    "mkdir"=> 0 ,
+                                    "suffixlen" => 0,
+                                    "ErrStr" => \$errstr,
+                                   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+
+=item B<mkstemps>
+
+Similar to mkstemp(), except that an extra argument can be supplied
+with a suffix to be appended to the template.
+
+  ($fh, $name) = mkstemps( $template, $suffix );
+
+For example a template of C<testXXXXXX> and suffix of C<.dat>
+would generate a file similar to F<testhGji_w.dat>.
+
+Returns just the filehandle alone when called in scalar context.
+
+Will croak() if there is an error.
+
+=cut
+
+sub mkstemps {
+
+  croak "Usage: mkstemps(template, suffix)"
+    if scalar(@_) != 2;
+
+
+  my $template = shift;
+  my $suffix   = shift;
+
+  $template .= $suffix;
+
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemps using $template: $errstr"
+    unless (($fh, $path) = _gettemp($template,
+                                    "open" => 1,
+                                    "mkdir"=> 0 ,
+                                    "suffixlen" => length($suffix),
+                                    "ErrStr" => \$errstr,
+                                   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+=item B<mkdtemp>
+
+Create a directory from a template. The template must end in
+X's that are replaced by the routine.
+
+  $tmpdir_name = mkdtemp($template);
+
+Returns the name of the temporary directory created.
+
+Directory must be removed by the caller.
+
+Will croak() if there is an error.
+
+=cut
+
+#' # for emacs
+
+sub mkdtemp {
+
+  croak "Usage: mkdtemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+  my $suffixlen = 0;
+  if ($^O eq 'VMS') {           # dir names can end in delimiters
+    $template =~ m/([\.\]:>]+)$/;
+    $suffixlen = length($1);
+  }
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
+  my ($junk, $tmpdir, $errstr);
+  croak "Error creating temp directory from template $template\: $errstr"
+    unless (($junk, $tmpdir) = _gettemp($template,
+                                        "open" => 0,
+                                        "mkdir"=> 1 ,
+                                        "suffixlen" => $suffixlen,
+                                        "ErrStr" => \$errstr,
+                                       ) );
+
+  return $tmpdir;
+
+}
+
+=item B<mktemp>
+
+Returns a valid temporary filename but does not guarantee
+that the file will not be opened by someone else.
+
+  $unopened_file = mktemp($template);
+
+Template is the same as that required by mkstemp().
+
+Will croak() if there is an error.
+
+=cut
+
+sub mktemp {
+
+  croak "Usage: mktemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($tmpname, $junk, $errstr);
+  croak "Error getting name to temp file from template $template: $errstr"
+    unless (($junk, $tmpname) = _gettemp($template,
+                                         "open" => 0,
+                                         "mkdir"=> 0 ,
+                                         "suffixlen" => 0,
+                                         "ErrStr" => \$errstr,
+                                        ) );
+
+  return $tmpname;
+}
+
+=back
+
+=head1 POSIX FUNCTIONS
+
+This section describes the re-implementation of the tmpnam()
+and tmpfile() functions described in L<POSIX>
+using the mkstemp() from this module.
+
+Unlike the L<POSIX|POSIX> implementations, the directory used
+for the temporary file is not specified in a system include
+file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
+returned by L<File::Spec|File::Spec>. On some implementations this
+location can be set using the C<TMPDIR> environment variable, which
+may not be secure.
+If this is a problem, simply use mkstemp() and specify a template.
+
+=over 4
+
+=item B<tmpnam>
+
+When called in scalar context, returns the full name (including path)
+of a temporary file (uses mktemp()). The only check is that the file does
+not already exist, but there is no guarantee that that condition will
+continue to apply.
+
+  $file = tmpnam();
+
+When called in list context, a filehandle to the open file and
+a filename are returned. This is achieved by calling mkstemp()
+after constructing a suitable template.
+
+  ($fh, $file) = tmpnam();
+
+If possible, this form should be used to prevent possible
+race conditions.
+
+See L<File::Spec/tmpdir> for information on the choice of temporary
+directory for a particular operating system.
+
+Will croak() if there is an error.
+
+=cut
+
+sub tmpnam {
+
+  # Retrieve the temporary directory name
+  my $tmpdir = File::Spec->tmpdir;
+
+  croak "Error temporary directory is not writable"
+    if $tmpdir eq '';
+
+  # Use a ten character template and append to tmpdir
+  my $template = File::Spec->catfile($tmpdir, TEMPXXX);
+
+  if (wantarray() ) {
+    return mkstemp($template);
+  } else {
+    return mktemp($template);
+  }
+
+}
+
+=item B<tmpfile>
+
+Returns the filehandle of a temporary file.
+
+  $fh = tmpfile();
+
+The file is removed when the filehandle is closed or when the program
+exits. No access to the filename is provided.
+
+If the temporary file can not be created undef is returned.
+Currently this command will probably not work when the temporary
+directory is on an NFS file system.
+
+Will croak() if there is an error.
+
+=cut
+
+sub tmpfile {
+
+  # Simply call tmpnam() in a list context
+  my ($fh, $file) = tmpnam();
+
+  # Make sure file is removed when filehandle is closed
+  # This will fail on NFS
+  unlink0($fh, $file)
+    or return undef;
+
+  return $fh;
+
+}
+
+=back
+
+=head1 ADDITIONAL FUNCTIONS
+
+These functions are provided for backwards compatibility
+with common tempfile generation C library functions.
+
+They are not exported and must be addressed using the full package
+name.
+
+=over 4
+
+=item B<tempnam>
+
+Return the name of a temporary file in the specified directory
+using a prefix. The file is guaranteed not to exist at the time
+the function was called, but such guarantees are good for one
+clock tick only.  Always use the proper form of C<sysopen>
+with C<O_CREAT | O_EXCL> if you must open such a filename.
+
+  $filename = File::Temp::tempnam( $dir, $prefix );
+
+Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
+(using unix file convention as an example)
+
+Because this function uses mktemp(), it can suffer from race conditions.
+
+Will croak() if there is an error.
+
+=cut
+
+sub tempnam {
+
+  croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
+
+  my ($dir, $prefix) = @_;
+
+  # Add a string to the prefix
+  $prefix .= 'XXXXXXXX';
+
+  # Concatenate the directory to the file
+  my $template = File::Spec->catfile($dir, $prefix);
+
+  return mktemp($template);
+
+}
+
+=back
+
+=head1 UTILITY FUNCTIONS
+
+Useful functions for dealing with the filehandle and filename.
+
+=over 4
+
+=item B<unlink0>
+
+Given an open filehandle and the associated filename, make a safe
+unlink. This is achieved by first checking that the filename and
+filehandle initially point to the same file and that the number of
+links to the file is 1 (all fields returned by stat() are compared).
+Then the filename is unlinked and the filehandle checked once again to
+verify that the number of links on that file is now 0.  This is the
+closest you can come to making sure that the filename unlinked was the
+same as the file whose descriptor you hold.
+
+  unlink0($fh, $path)
+     or die "Error unlinking file $path safely";
+
+Returns false on error but croaks() if there is a security
+anomaly. The filehandle is not closed since on some occasions this is
+not required.
+
+On some platforms, for example Windows NT, it is not possible to
+unlink an open file (the file must be closed first). On those
+platforms, the actual unlinking is deferred until the program ends and
+good status is returned. A check is still performed to make sure that
+the filehandle and filename are pointing to the same thing (but not at
+the time the end block is executed since the deferred removal may not
+have access to the filehandle).
+
+Additionally, on Windows NT not all the fields returned by stat() can
+be compared. For example, the C<dev> and C<rdev> fields seem to be
+different.  Also, it seems that the size of the file returned by stat()
+does not always agree, with C<stat(FH)> being more accurate than
+C<stat(filename)>, presumably because of caching issues even when
+using autoflush (this is usually overcome by waiting a while after
+writing to the tempfile before attempting to C<unlink0> it).
+
+Finally, on NFS file systems the link count of the file handle does
+not always go to zero immediately after unlinking. Currently, this
+command is expected to fail on NFS disks.
+
+This function is disabled if the global variable $KEEP_ALL is true
+and an unlink on open file is supported. If the unlink is to be deferred
+to the END block, the file is still registered for removal.
+
+This function should not be called if you are using the object oriented
+interface since the it will interfere with the object destructor deleting
+the file.
+
+=cut
+
+sub unlink0 {
+
+  croak 'Usage: unlink0(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  cmpstat($fh, $path) or return 0;
+
+  # attempt remove the file (does not work on some platforms)
+  if (_can_unlink_opened_file()) {
+
+    # return early (Without unlink) if we have been instructed to retain files.
+    return 1 if $KEEP_ALL;
+
+    # XXX: do *not* call this on a directory; possible race
+    #      resulting in recursive removal
+    croak "unlink0: $path has become a directory!" if -d $path;
+    unlink($path) or return 0;
+
+    # Stat the filehandle
+    my @fh = stat $fh;
+
+    print "Link count = $fh[3] \n" if $DEBUG;
+
+    # Make sure that the link count is zero
+    # - Cygwin provides deferred unlinking, however,
+    #   on Win9x the link count remains 1
+    # On NFS the link count may still be 1 but we cant know that
+    # we are on NFS
+    return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
+
+  } else {
+    _deferred_unlink($fh, $path, 0);
+    return 1;
+  }
+
+}
+
+=item B<cmpstat>
+
+Compare C<stat> of filehandle with C<stat> of provided filename.  This
+can be used to check that the filename and filehandle initially point
+to the same file and that the number of links to the file is 1 (all
+fields returned by stat() are compared).
+
+  cmpstat($fh, $path)
+     or die "Error comparing handle with file";
+
+Returns false if the stat information differs or if the link count is
+greater than 1. Calls croak if there is a security anomaly.
+
+On certain platforms, for example Windows, not all the fields returned by stat()
+can be compared. For example, the C<dev> and C<rdev> fields seem to be
+different in Windows.  Also, it seems that the size of the file
+returned by stat() does not always agree, with C<stat(FH)> being more
+accurate than C<stat(filename)>, presumably because of caching issues
+even when using autoflush (this is usually overcome by waiting a while
+after writing to the tempfile before attempting to C<unlink0> it).
+
+Not exported by default.
+
+=cut
+
+sub cmpstat {
+
+  croak 'Usage: cmpstat(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  warn "Comparing stat\n"
+    if $DEBUG;
+
+  # Stat the filehandle - which may be closed if someone has manually
+  # closed the file. Can not turn off warnings without using $^W
+  # unless we upgrade to 5.006 minimum requirement
+  my @fh;
+  {
+    local ($^W) = 0;
+    @fh = stat $fh;
+  }
+  return unless @fh;
+
+  if ($fh[3] > 1 && $^W) {
+    carp "unlink0: fstat found too many links; SB=@fh" if $^W;
+  }
+
+  # Stat the path
+  my @path = stat $path;
+
+  unless (@path) {
+    carp "unlink0: $path is gone already" if $^W;
+    return;
+  }
+
+  # this is no longer a file, but may be a directory, or worse
+  unless (-f $path) {
+    confess "panic: $path is no longer a file: SB=@fh";
+  }
+
+  # Do comparison of each member of the array
+  # On WinNT dev and rdev seem to be different
+  # depending on whether it is a file or a handle.
+  # Cannot simply compare all members of the stat return
+  # Select the ones we can use
+  my @okstat = (0..$#fh);       # Use all by default
+  if ($^O eq 'MSWin32') {
+    @okstat = (1,2,3,4,5,7,8,9,10);
+  } elsif ($^O eq 'os2') {
+    @okstat = (0, 2..$#fh);
+  } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
+    @okstat = (0, 1);
+  } elsif ($^O eq 'dos') {
+    @okstat = (0,2..7,11..$#fh);
+  } elsif ($^O eq 'mpeix') {
+    @okstat = (0..4,8..10);
+  }
+
+  # Now compare each entry explicitly by number
+  for (@okstat) {
+    print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
+    # Use eq rather than == since rdev, blksize, and blocks (6, 11,
+    # and 12) will be '' on platforms that do not support them.  This
+    # is fine since we are only comparing integers.
+    unless ($fh[$_] eq $path[$_]) {
+      warn "Did not match $_ element of stat\n" if $DEBUG;
+      return 0;
+    }
+  }
+
+  return 1;
+}
+
+=item B<unlink1>
+
+Similar to C<unlink0> except after file comparison using cmpstat, the
+filehandle is closed prior to attempting to unlink the file. This
+allows the file to be removed without using an END block, but does
+mean that the post-unlink comparison of the filehandle state provided
+by C<unlink0> is not available.
+
+  unlink1($fh, $path)
+     or die "Error closing and unlinking file";
+
+Usually called from the object destructor when using the OO interface.
+
+Not exported by default.
+
+This function is disabled if the global variable $KEEP_ALL is true.
+
+Can call croak() if there is a security anomaly during the stat()
+comparison.
+
+=cut
+
+sub unlink1 {
+  croak 'Usage: unlink1(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  cmpstat($fh, $path) or return 0;
+
+  # Close the file
+  close( $fh ) or return 0;
+
+  # Make sure the file is writable (for windows)
+  _force_writable( $path );
+
+  # return early (without unlink) if we have been instructed to retain files.
+  return 1 if $KEEP_ALL;
+
+  # remove the file
+  return unlink($path);
+}
+
+=item B<cleanup>
+
+Calling this function will cause any temp files or temp directories
+that are registered for removal to be removed. This happens automatically
+when the process exits but can be triggered manually if the caller is sure
+that none of the temp files are required. This method can be registered as
+an Apache callback.
+
+On OSes where temp files are automatically removed when the temp file
+is closed, calling this function will have no effect other than to remove
+temporary directories (which may include temporary files).
+
+  File::Temp::cleanup();
+
+Not exported by default.
+
+=back
+
+=head1 PACKAGE VARIABLES
+
+These functions control the global state of the package.
+
+=over 4
+
+=item B<safe_level>
+
+Controls the lengths to which the module will go to check the safety of the
+temporary file or directory before proceeding.
+Options are:
+
+=over 8
+
+=item STANDARD
+
+Do the basic security measures to ensure the directory exists and is
+writable, that temporary files are opened only if they do not already
+exist, and that possible race conditions are avoided.  Finally the
+L<unlink0|"unlink0"> function is used to remove files safely.
+
+=item MEDIUM
+
+In addition to the STANDARD security, the output directory is checked
+to make sure that it is owned either by root or the user running the
+program. If the directory is writable by group or by other, it is then
+checked to make sure that the sticky bit is set.
+
+Will not work on platforms that do not support the C<-k> test
+for sticky bit.
+
+=item HIGH
+
+In addition to the MEDIUM security checks, also check for the
+possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
+sysconf() function. If this is a possibility, each directory in the
+path is checked in turn for safeness, recursively walking back to the
+root directory.
+
+For platforms that do not support the L<POSIX|POSIX>
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
+assumed that ``chown() giveaway'' is possible and the recursive test
+is performed.
+
+=back
+
+The level can be changed as follows:
+
+  File::Temp->safe_level( File::Temp::HIGH );
+
+The level constants are not exported by the module.
+
+Currently, you must be running at least perl v5.6.0 in order to
+run with MEDIUM or HIGH security. This is simply because the
+safety tests use functions from L<Fcntl|Fcntl> that are not
+available in older versions of perl. The problem is that the version
+number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
+they are different versions.
+
+On systems that do not support the HIGH or MEDIUM safety levels
+(for example Win NT or OS/2) any attempt to change the level will
+be ignored. The decision to ignore rather than raise an exception
+allows portable programs to be written with high security in mind
+for the systems that can support this without those programs failing
+on systems where the extra tests are irrelevant.
+
+If you really need to see whether the change has been accepted
+simply examine the return value of C<safe_level>.
+
+  $newlevel = File::Temp->safe_level( File::Temp::HIGH );
+  die "Could not change to high security"
+      if $newlevel != File::Temp::HIGH;
+
+=cut
+
+{
+  # protect from using the variable itself
+  my $LEVEL = STANDARD;
+  sub safe_level {
+    my $self = shift;
+    if (@_) {
+      my $level = shift;
+      if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
+        carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
+      } else {
+        # Dont allow this on perl 5.005 or earlier
+        if ($] < 5.006 && $level != STANDARD) {
+          # Cant do MEDIUM or HIGH checks
+          croak "Currently requires perl 5.006 or newer to do the safe checks";
+        }
+        # Check that we are allowed to change level
+        # Silently ignore if we can not.
+        $LEVEL = $level if _can_do_level($level);
+      }
+    }
+    return $LEVEL;
+  }
+}
+
+=item TopSystemUID
+
+This is the highest UID on the current system that refers to a root
+UID. This is used to make sure that the temporary directory is
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
+simply by root.
+
+This is required since on many unix systems C</tmp> is not owned
+by root.
+
+Default is to assume that any UID less than or equal to 10 is a root
+UID.
+
+  File::Temp->top_system_uid(10);
+  my $topid = File::Temp->top_system_uid;
+
+This value can be adjusted to reduce security checking if required.
+The value is only relevant when C<safe_level> is set to MEDIUM or higher.
+
+=cut
+
+{
+  my $TopSystemUID = 10;
+  $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
+  sub top_system_uid {
+    my $self = shift;
+    if (@_) {
+      my $newuid = shift;
+      croak "top_system_uid: UIDs should be numeric"
+        unless $newuid =~ /^\d+$/s;
+      $TopSystemUID = $newuid;
+    }
+    return $TopSystemUID;
+  }
+}
+
+=item B<$KEEP_ALL>
+
+Controls whether temporary files and directories should be retained
+regardless of any instructions in the program to remove them
+automatically.  This is useful for debugging but should not be used in
+production code.
+
+  $File::Temp::KEEP_ALL = 1;
+
+Default is for files to be removed as requested by the caller.
+
+In some cases, files will only be retained if this variable is true
+when the file is created. This means that you can not create a temporary
+file, set this variable and expect the temp file to still be around
+when the program exits.
+
+=item B<$DEBUG>
+
+Controls whether debugging messages should be enabled.
+
+  $File::Temp::DEBUG = 1;
+
+Default is for debugging mode to be disabled.
+
+=back
+
+=head1 WARNING
+
+For maximum security, endeavour always to avoid ever looking at,
+touching, or even imputing the existence of the filename.  You do not
+know that that filename is connected to the same file as the handle
+you have, and attempts to check this can only trigger more race
+conditions.  It's far more secure to use the filehandle alone and
+dispense with the filename altogether.
+
+If you need to pass the handle to something that expects a filename
+then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
+programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
+programs.  You will have to clear the close-on-exec bit on that file
+descriptor before passing it to another process.
+
+    use Fcntl qw/F_SETFD F_GETFD/;
+    fcntl($tmpfh, F_SETFD, 0)
+        or die "Can't clear close-on-exec flag on temp fh: $!\n";
+
+=head2 Temporary files and NFS
+
+Some problems are associated with using temporary files that reside
+on NFS file systems and it is recommended that a local filesystem
+is used whenever possible. Some of the security tests will most probably
+fail when the temp file is not local. Additionally, be aware that
+the performance of I/O operations over NFS will not be as good as for
+a local disk.
+
+=head2 Forking
+
+In some cases files created by File::Temp are removed from within an
+END block. Since END blocks are triggered when a child process exits
+(unless C<POSIX::_exit()> is used by the child) File::Temp takes care
+to only remove those temp files created by a particular process ID. This
+means that a child will not attempt to remove temp files created by the
+parent process.
+
+If you are forking many processes in parallel that are all creating
+temporary files, you may need to reset the random number seed using
+srand(EXPR) in each child else all the children will attempt to walk
+through the same set of random file names and may well cause
+themselves to give up if they exceed the number of retry attempts.
+
+=head2 Directory removal
+
+Note that if you have chdir'ed into the temporary directory and it is
+subsequently cleaned up (either in the END block or as part of object
+destruction), then you will get a warning from File::Path::rmtree().
+
+=head2 BINMODE
+
+The file returned by File::Temp will have been opened in binary mode
+if such a mode is available. If that is not correct, use the C<binmode()>
+function to change the mode of the filehandle.
+
+Note that you can modify the encoding of a file opened by File::Temp
+also by using C<binmode()>.
+
+=head1 HISTORY
+
+Originally began life in May 1999 as an XS interface to the system
+mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
+translated to Perl for total control of the code's
+security checking, to ensure the presence of the function regardless of
+operating system and to help with portability. The module was shipped
+as a standard part of perl from v5.6.1.
+
+=head1 SEE ALSO
+
+L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
+
+See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
+different implementations of temporary file handling.
+
+See L<File::Tempdir> for an alternative object-oriented wrapper for
+the C<tempdir> function.
+
+=head1 AUTHOR
+
+Tim Jenness E<lt>tjenness@cpan.orgE<gt>
+
+Copyright (C) 2007-2009 Tim Jenness.
+Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
+Astronomy Research Council. All Rights Reserved.  This program is free
+software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+Original Perl implementation loosely based on the OpenBSD C code for
+mkstemp(). Thanks to Tom Christiansen for suggesting that this module
+should be written and providing ideas for code improvements and
+security enhancements.
+
+=cut
+
+package File::Temp::Dir;
+
+use File::Path qw/ rmtree /;
+use strict;
+use overload '""' => "STRINGIFY", fallback => 1;
+
+# private class specifically to support tempdir objects
+# created by File::Temp->newdir
+
+# ostensibly the same method interface as File::Temp but without
+# inheriting all the IO::Seekable methods and other cruft
+
+# Read-only - returns the name of the temp directory
+
+sub dirname {
+  my $self = shift;
+  return $self->{DIRNAME};
+}
+
+sub STRINGIFY {
+  my $self = shift;
+  return $self->dirname;
+}
+
+sub unlink_on_destroy {
+  my $self = shift;
+  if (@_) {
+    $self->{CLEANUP} = shift;
+  }
+  return $self->{CLEANUP};
+}
+
+sub DESTROY {
+  my $self = shift;
+  local($., $@, $!, $^E, $?);
+  if ($self->unlink_on_destroy && 
+      $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
+    if (-d $self->{DIRNAME}) {
+      # Some versions of rmtree will abort if you attempt to remove
+      # the directory you are sitting in. We protect that and turn it
+      # into a warning. We do this because this occurs during object
+      # destruction and so can not be caught by the user.
+      eval { rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0); };
+      warn $@ if ($@ && $^W);
+    }
+  }
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/File/Which.pm b/Master/tlpkg/tlperl/lib/File/Which.pm
new file mode 100644
index 00000000000..69e336b03bd
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/Which.pm
@@ -0,0 +1,254 @@
+package File::Which;
+
+use 5.004;
+use strict;
+use Exporter   ();
+use File::Spec ();
+
+use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK};
+BEGIN {
+	$VERSION   = '1.09';
+	@ISA       = 'Exporter';
+	@EXPORT    = 'which';
+	@EXPORT_OK = 'where';
+}
+
+use constant IS_VMS => ($^O eq 'VMS');
+use constant IS_MAC => ($^O eq 'MacOS');
+use constant IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
+
+# For Win32 systems, stores the extensions used for
+# executable files
+# For others, the empty string is used
+# because 'perl' . '' eq 'perl' => easier
+my @PATHEXT = ('');
+if ( IS_DOS ) {
+	# WinNT. PATHEXT might be set on Cygwin, but not used.
+	if ( $ENV{PATHEXT} ) {
+		push @PATHEXT, split ';', $ENV{PATHEXT};
+	} else {
+		# Win9X or other: doesn't have PATHEXT, so needs hardcoded.
+		push @PATHEXT, qw{.com .exe .bat};
+	}
+} elsif ( IS_VMS ) {
+	push @PATHEXT, qw{.exe .com};
+}
+
+sub which {
+	my ($exec) = @_;
+
+	return undef unless $exec;
+
+	my $all = wantarray;
+	my @results = ();
+
+	# check for aliases first
+	if ( IS_VMS ) {
+		my $symbol = `SHOW SYMBOL $exec`;
+		chomp($symbol);
+		unless ( $? ) {
+			return $symbol unless $all;
+			push @results, $symbol;
+		}
+	}
+	if ( IS_MAC ) {
+		my @aliases = split /\,/, $ENV{Aliases};
+		foreach my $alias ( @aliases ) {
+			# This has not been tested!!
+			# PPT which says MPW-Perl cannot resolve `Alias $alias`,
+			# let's just hope it's fixed
+			if ( lc($alias) eq lc($exec) ) {
+				chomp(my $file = `Alias $alias`);
+				last unless $file;  # if it failed, just go on the normal way
+				return $file unless $all;
+				push @results, $file;
+				# we can stop this loop as if it finds more aliases matching,
+				# it'll just be the same result anyway
+				last;
+			}
+		}
+	}
+
+	my @path = File::Spec->path;
+	if ( IS_DOS or IS_VMS or IS_MAC ) {
+		unshift @path, File::Spec->curdir;
+	}
+
+	foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
+		for my $ext ( @PATHEXT ) {
+			my $file = $base.$ext;
+
+			# We don't want dirs (as they are -x)
+			next if -d $file;
+
+			if (
+				# Executable, normal case
+				-x _
+				or (
+					# MacOS doesn't mark as executable so we check -e
+					IS_MAC
+					||
+					(
+						IS_DOS
+						and
+						grep {
+							$file =~ /$_\z/i
+						} @PATHEXT[1..$#PATHEXT]
+					)
+					# DOSish systems don't pass -x on
+					# non-exe/bat/com files. so we check -e.
+					# However, we don't want to pass -e on files
+					# that aren't in PATHEXT, like README.
+					and -e _
+				)
+			) {
+				return $file unless $all;
+				push @results, $file;
+			}
+		}
+	}
+
+	if ( $all ) {
+		return @results;
+	} else {
+		return undef;
+	}
+}
+
+sub where {
+	# force wantarray
+	my @res = which($_[0]);
+	return @res;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+File::Which - Portable implementation of the `which' utility
+
+=head1 SYNOPSIS
+
+  use File::Which;                  # exports which()
+  use File::Which qw(which where);  # exports which() and where()
+  
+  my $exe_path = which('perldoc');
+  
+  my @paths = where('perl');
+  - Or -
+  my @paths = which('perl'); # an array forces search for all of them
+
+=head1 DESCRIPTION
+
+C<File::Which> was created to be able to get the paths to executable programs
+on systems under which the `which' program wasn't implemented in the shell.
+
+C<File::Which> searches the directories of the user's C<PATH> (as returned by
+C<File::Spec-E<gt>path()>), looking for executable files having the name
+specified as a parameter to C<which()>. Under Win32 systems, which do not have a
+notion of directly executable files, but uses special extensions such as C<.exe>
+and C<.bat> to identify them, C<File::Which> takes extra steps to assure that
+you will find the correct file (so for example, you might be searching for
+C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.)
+
+=head1 Steps Used on Win32, DOS, OS2 and VMS
+
+=head2 Windows NT
+
+Windows NT has a special environment variable called C<PATHEXT>, which is used
+by the shell to look for executable files. Usually, it will contain a list in
+the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an
+environment variable, it parses the list and uses it as the different
+extensions.
+
+=head2 Windows 9x and other ancient Win/DOS/OS2
+
+This set of operating systems don't have the C<PATHEXT> variable, and usually
+you will find executable files there with the extensions C<.exe>, C<.bat> and
+(less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running
+under Win32 but does not find a C<PATHEXT> variable.
+
+=head2 VMS
+
+Same case as Windows 9x: uses C<.exe> and C<.com> (in that order).
+
+=head1 Functions
+
+=head2 which($short_exe_name)
+
+Exported by default.
+
+C<$short_exe_name> is the name used in the shell to call the program (for
+example, C<perl>).
+
+If it finds an executable with the name you specified, C<which()> will return
+the absolute path leading to this executable (for example, F</usr/bin/perl> or
+F<C:\Perl\Bin\perl.exe>).
+
+If it does I<not> find the executable, it returns C<undef>.
+
+If C<which()> is called in list context, it will return I<all> the
+matches.
+
+=head2 where($short_exe_name)
+
+Not exported by default.
+
+Same as C<which($short_exe_name)> in array context. Same as the
+C<`where'> utility, will return an array containing all the path names
+matching C<$short_exe_name>.
+
+=head1 BUGS AND CAVEATS
+
+Not tested on VMS or MacOS, although there is platform specific code
+for those. Anyone who haves a second would be very kind to send me a
+report of how it went.
+
+File::Spec adds the current directory to the front of PATH if on
+Win32, VMS or MacOS. I have no knowledge of those so don't know if the
+current directory is searced first or not. Could someone please tell
+me?
+
+=head1 SUPPORT
+
+Bugs should be reported via the CPAN bug tracker at
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Which>
+
+For other issues, contact the maintainer.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+Per Einar Ellefsen E<lt>pereinar@cpan.orgE<gt>
+
+Originated in F<modperl-2.0/lib/Apache/Build.pm>. Changed for use in DocSet
+(for the mod_perl site) and Win32-awareness by me, with slight modifications
+by Stas Bekman, then extracted to create C<File::Which>.
+
+Version 0.04 had some significant platform-related changes, taken from
+the Perl Power Tools C<`which'> implementation by Abigail with
+enhancements from Peter Prymmer. See
+L<http://www.perl.com/language/ppt/src/which/index.html> for more
+information.
+
+=head1 COPYRIGHT
+
+Copyright 2002 Per Einar Ellefsen.
+
+Some parts copyright 2009 Adam Kennedy.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<File::Spec>, L<which(1)>, Perl Power Tools:
+L<http://www.perl.com/language/ppt/index.html>.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/File/stat.pm b/Master/tlpkg/tlperl/lib/File/stat.pm
new file mode 100644
index 00000000000..bdf3aad52a2
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/File/stat.pm
@@ -0,0 +1,346 @@
+package File::stat;
+use 5.006;
+
+use strict;
+use warnings;
+use warnings::register;
+use Carp;
+
+BEGIN { *warnif = \&warnings::warnif }
+
+our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+our $VERSION = '1.02';
+
+my @fields;
+BEGIN { 
+    use Exporter   ();
+    @EXPORT      = qw(stat lstat);
+    @fields      = 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_OK   = ( @fields, "stat_cando" );
+    %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] );
+}
+use vars @fields;
+
+use Fcntl qw(S_IRUSR S_IWUSR S_IXUSR);
+
+BEGIN {
+    # These constants will croak on use if the platform doesn't define
+    # them. It's important to avoid inflicting that on the user.
+    no strict 'refs';
+    for (qw(suid sgid svtx)) {
+        my $val = eval { &{"Fcntl::S_I\U$_"} };
+        *{"_$_"} = defined $val ? sub { $_[0] & $val ? 1 : "" } : sub { "" };
+    }
+    for (qw(SOCK CHR BLK REG DIR FIFO LNK)) {
+        *{"S_IS$_"} = defined eval { &{"Fcntl::S_IF$_"} }
+            ? \&{"Fcntl::S_IS$_"} : sub { "" };
+    }
+}
+
+# from doio.c
+sub _ingroup {
+
+    $^O eq "MacOS"  and return 1;
+    
+    my ($gid, $eff)   = @_;
+
+    # I am assuming that since VMS doesn't have getgroups(2), $) will
+    # always only contain a single entry.
+    $^O eq "VMS"    and return $_[0] == $);
+
+    my ($egid, @supp) = split " ", $);
+    my ($rgid)        = split " ", $(;
+
+    $gid == ($eff ? $egid : $rgid)  and return 1;
+    grep $gid == $_, @supp          and return 1;
+
+    return "";
+}
+
+# VMS uses the Unix version of the routine, even though this is very
+# suboptimal. VMS has a permissions structure that doesn't really fit
+# into struct stat, and unlike on Win32 the normal -X operators respect
+# that, but unfortunately by the time we get here we've already lost the
+# information we need. It looks to me as though if we were to preserve
+# the st_devnam entry of vmsish.h's fake struct stat (which actually
+# holds the filename) it might be possible to do this right, but both
+# getting that value out of the struct (perl's stat doesn't return it)
+# and interpreting it later would require this module to have an XS
+# component (at which point we might as well just call Perl_cando and
+# have done with it).
+    
+if (grep $^O eq $_, qw/os2 MSWin32 dos/) {
+
+    # from doio.c
+    *cando = sub { ($_[0][2] & $_[1]) ? 1 : "" };
+}
+else {
+
+    # from doio.c
+    *cando = sub {
+        my ($s, $mode, $eff) = @_;
+        my $uid = $eff ? $> : $<;
+
+        $^O ne "VMS" and $uid == 0  and return 1;
+
+        my ($stmode, $stuid, $stgid) = @$s[2,4,5];
+
+        # This code basically assumes that the rwx bits of the mode are
+        # the 0777 bits, but so does Perl_cando.
+        if ($stuid == $uid) {
+            $stmode & $mode         and return 1;
+        }
+        elsif (_ingroup($stgid, $eff)) {
+            $stmode & ($mode >> 3)  and return 1;
+        }
+        else {
+            $stmode & ($mode >> 6)  and return 1;
+        }
+        return "";
+    };
+}
+
+# alias for those who don't like objects
+*stat_cando = \&cando;
+
+my %op = (
+    r => sub { cando($_[0], S_IRUSR, 1) },
+    w => sub { cando($_[0], S_IWUSR, 1) },
+    x => sub { cando($_[0], S_IXUSR, 1) },
+    o => sub { $_[0][4] == $>           },
+
+    R => sub { cando($_[0], S_IRUSR, 0) },
+    W => sub { cando($_[0], S_IWUSR, 0) },
+    X => sub { cando($_[0], S_IXUSR, 0) },
+    O => sub { $_[0][4] == $<           },
+
+    e => sub { 1 },
+    z => sub { $_[0][7] == 0    },
+    s => sub { $_[0][7]         },
+
+    f => sub { S_ISREG ($_[0][2]) },
+    d => sub { S_ISDIR ($_[0][2]) },
+    l => sub { S_ISLNK ($_[0][2]) },
+    p => sub { S_ISFIFO($_[0][2]) },
+    S => sub { S_ISSOCK($_[0][2]) },
+    b => sub { S_ISBLK ($_[0][2]) },
+    c => sub { S_ISCHR ($_[0][2]) },
+
+    u => sub { _suid($_[0][2]) },
+    g => sub { _sgid($_[0][2]) },
+    k => sub { _svtx($_[0][2]) },
+
+    M => sub { ($^T - $_[0][9] ) / 86400 },
+    C => sub { ($^T - $_[0][10]) / 86400 },
+    A => sub { ($^T - $_[0][8] ) / 86400 },
+);
+
+use constant HINT_FILETEST_ACCESS => 0x00400000;
+
+# we need fallback=>1 or stringifying breaks
+use overload 
+    fallback => 1,
+    -X => sub {
+        my ($s, $op) = @_;
+
+        if (index "rwxRWX", $op) {
+            (caller 0)[8] & HINT_FILETEST_ACCESS
+                and warnif("File::stat ignores use filetest 'access'");
+
+            $^O eq "VMS" and warnif("File::stat ignores VMS ACLs");
+
+            # It would be nice to have a warning about using -l on a
+            # non-lstat, but that would require an extra member in the
+            # object.
+        }
+
+        if ($op{$op}) {
+            return $op{$op}->($_[0]);
+        }
+        else {
+            croak "-$op is not implemented on a File::stat object";
+        }
+    };
+
+# 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 defined $st;
+	my $fh;
+    {
+		local $!;
+		no strict 'refs';
+		require Symbol;
+		$fh = \*{ Symbol::qualify( $arg, caller() )};
+		return unless defined fileno $fh;
+	}
+    return populate(CORE::stat $fh);
+}
+
+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";
+ } 
+
+ if ( -x $st ) {
+     print "$file is executable\n";
+ }
+
+ use Fcntl "S_IRUSR";
+ if ( $st->cando(S_IRUSR, 1) ) {
+     print "My effective uid can read $file\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.  
+
+As of version 1.02 (provided with perl 5.12) the object provides C<"-X">
+overloading, so you can call filetest operators (C<-f>, C<-x>, and so
+on) on it. It also provides a C<< ->cando >> method, called like
+
+ $st->cando( ACCESS, EFFECTIVE )
+
+where I<ACCESS> is one of C<S_IRUSR>, C<S_IWUSR> or C<S_IXUSR> from the
+L<Fcntl|Fcntl> module, and I<EFFECTIVE> indicates whether to use
+effective (true) or real (false) ids. The method interprets the C<mode>,
+C<uid> and C<gid> fields, and returns whether or not the current process
+would be allowed the specified access.
+
+If you don't want to use the objects, you may import the C<< ->cando >>
+method into your namespace as a regular function called C<stat_cando>.
+This takes an arrayref containing the return values of C<stat> or
+C<lstat> as its first argument, and interprets it for you.
+
+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 BUGS
+
+As of Perl 5.8.0 after using this module you cannot use the implicit
+C<$_> or the special filehandle C<_> with stat() or lstat(), trying
+to do so leads into strange errors.  The workaround is for C<$_> to
+be explicit
+
+    my $stat_obj = stat $_;
+
+and for C<_> to explicitly populate the object using the unexported
+and undocumented populate() function with CORE::stat():
+
+    my $stat_obj = File::stat::populate(CORE::stat(_));
+
+=head1 ERRORS
+
+=over 4
+
+=item -%s is not implemented on a File::stat object
+
+The filetest operators C<-t>, C<-T> and C<-B> are not implemented, as
+they require more information than just a stat buffer.
+
+=back
+
+=head1 WARNINGS
+
+These can all be disabled with
+
+    no warnings "File::stat";
+
+=over 4
+
+=item File::stat ignores use filetest 'access'
+
+You have tried to use one of the C<-rwxRWX> filetests with C<use
+filetest 'access'> in effect. C<File::stat> will ignore the pragma, and
+just use the information in the C<mode> member as usual.
+
+=item File::stat ignores VMS ACLs
+
+VMS systems have a permissions structure that cannot be completely
+represented in a stat buffer, and unlike on other systems the builtin
+filetest operators respect this. The C<File::stat> overloads, however,
+do not, since the information required is not available.
+
+=back
+
+=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