Vendor import of Perl 5.006

1 files changed, 304 insertions, 59 deletions

diff --git a/contrib/perl5/lib/File/Spec/Unix.pm b/contrib/perl5/lib/File/Spec/Unix.pm
index 77de73a..2305b75 100644
--- a/contrib/perl5/lib/File/Spec/Unix.pm
+++ b/contrib/perl5/lib/File/Spec/Unix.pm
@@ -1,23 +1,8 @@
 package File::Spec::Unix;
 
-use Exporter ();
-use Config;
-use File::Basename qw(basename dirname fileparse);
-use DirHandle;
 use strict;
-use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32);
-use File::Spec;
 
-Exporter::import('File::Spec', '$Verbose');
-
-$Is_OS2 = $^O eq 'os2';
-$Is_Mac = $^O eq 'MacOS';
-$Is_Win32 = $^O eq 'MSWin32';
-
-if ($Is_VMS = $^O eq 'VMS') {
-    require VMS::Filespec;
-    import VMS::Filespec qw( &vmsify );
-}
+use Cwd;
 
 =head1 NAME
 
@@ -25,7 +10,7 @@ File::Spec::Unix - methods used by File::Spec
 
 =head1 SYNOPSIS
 
-C<require File::Spec::Unix;>
+ require File::Spec::Unix; # Done automatically by File::Spec
 
 =head1 DESCRIPTION
 
@@ -40,15 +25,18 @@ Methods for manipulating file specifications.
 No physical check on the filesystem, but a logical cleanup of a
 path. On UNIX eliminated successive slashes and successive "/.".
 
+    $cpath = File::Spec->canonpath( $path ) ;
+
 =cut
 
 sub canonpath {
-    my($self,$path) = @_;
-    $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
-    $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
-    $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
-    $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
-    $path;
+    my ($self,$path) = @_;
+    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # 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|| unless $path eq "/";          # xx/       -> xx
+    return $path;
 }
 
 =item catdir
@@ -61,20 +49,14 @@ trailing slash :-)
 
 =cut
 
-# ';
-
 sub catdir {
-    shift;
+    my $self = shift;
     my @args = @_;
-    for (@args) {
+    foreach (@args) {
 	# append a slash to each argument unless it has one there
-	$_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
+	$_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
     }
-    my $result = join('', @args);
-    # remove a trailing slash unless we are root
-    substr($result,-1) = ""
-	if length($result) > 1 && substr($result,-1) eq "/";
-    $result;
+    return $self->canonpath(join('', @args));
 }
 
 =item catfile
@@ -85,29 +67,37 @@ complete path ending with a filename
 =cut
 
 sub catfile {
-    my $self = shift @_;
+    my $self = shift;
     my $file = pop @_;
     return $file unless @_;
     my $dir = $self->catdir(@_);
-    for ($dir) {
-	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
-    }
+    $dir .= "/" unless substr($dir,-1) eq "/";
     return $dir.$file;
 }
 
 =item curdir
 
-Returns a string representing of the current directory.  "." on UNIX.
+Returns a string representation of the current directory.  "." on UNIX.
 
 =cut
 
 sub curdir {
-    return "." ;
+    return ".";
+}
+
+=item devnull
+
+Returns a string representation of the null device. "/dev/null" on UNIX.
+
+=cut
+
+sub devnull {
+    return "/dev/null";
 }
 
 =item rootdir
 
-Returns a string representing of the root directory.  "/" on UNIX.
+Returns a string representation of the root directory.  "/" on UNIX.
 
 =cut
 
@@ -115,9 +105,31 @@ sub rootdir {
     return "/";
 }
 
+=item tmpdir
+
+Returns a string representation of the first writable directory
+from the following list or "" if none are writable:
+
+    $ENV{TMPDIR}
+    /tmp
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ($ENV{TMPDIR}, "/tmp") {
+	next unless defined && -d && -w _;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
+}
+
 =item updir
 
-Returns a string representing of the parent directory.  ".." on UNIX.
+Returns a string representation of the parent directory.  ".." on UNIX.
 
 =cut
 
@@ -133,8 +145,19 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 =cut
 
 sub no_upwards {
-    my($self) = shift;
-    return grep(!/^\.{1,2}$/, @_);
+    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 {
+    return 0;
 }
 
 =item file_name_is_absolute
@@ -144,8 +167,8 @@ Takes as argument a path and returns true, if it is an absolute path.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
-    $file =~ m:^/: ;
+    my ($self,$file) = @_;
+    return scalar($file =~ m:^/:s);
 }
 
 =item path
@@ -155,12 +178,9 @@ Takes no argument, returns the environment variable PATH as an array.
 =cut
 
 sub path {
-    my($self) = @_;
-    my $path_sep = ":";
-    my $path = $ENV{PATH};
-    my @path = split $path_sep, $path;
-    foreach(@path) { $_ = '.' if $_ eq '' }
-    @path;
+    my @path = split(':', $ENV{PATH});
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
 }
 
 =item join
@@ -170,21 +190,247 @@ join is the same as catfile.
 =cut
 
 sub join {
-	my($self) = shift @_;
-	$self->catfile(@_);
+    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 in to volume, directory, and filename portions. On systems
+with no concept of volume, returns undef 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 (e.g. MacOS).
+
+On Unix,
+
+    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| ) {
+        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 nativename
 
-TBW.
+=item catpath
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are catenated.  A '/' is
+inserted if need be.  On other OSs, $volume is significant.
 
 =cut
 
-sub nativename {
-	my($self,$name) = shift @_;
-	$name;
+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( $destination ) ;
+    $rel_path = File::Spec->abs2rel( $destination, $base ) ;
+
+If $base is not present or '', then L<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()>.
+
+On systems with the concept of a volume, this assumes that both paths 
+are on the $destination volume, and ignores the $base volume. 
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. 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()>.
+
+Based on code written by Shigio Yamaguchi.
+
+No checks against the filesystem are made. 
+
+=cut
+
+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 = cwd() ;
+    }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+        $base = $self->rel2abs( $base ) ;
+    }
+    else {
+        $base = $self->canonpath( $base ) ;
+    }
+
+    # Now, remove all leading components that are the same
+    my @pathchunks = $self->splitdir( $path);
+    my @basechunks = $self->splitdir( $base);
+
+    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+        shift @pathchunks ;
+        shift @basechunks ;
+    }
+
+    $path = CORE::join( '/', @pathchunks );
+    $base = CORE::join( '/', @basechunks );
+
+    # $base 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
+    $base =~ s|[^/]+|..|g ;
+
+    # Glue the two together, using a separator if necessary, and preventing an
+    # empty result.
+    if ( $path ne '' && $base ne '' ) {
+        $path = "$base/$path" ;
+    } else {
+        $path = "$base$path" ;
+    }
+
+    return $self->canonpath( $path ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path. 
+
+    $abs_path = File::Spec->rel2abs( $destination ) ;
+    $abs_path = File::Spec->rel2abs( $destination, $base ) ;
+
+If $base is not present or '', then L<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()>.
+
+On systems with the concept of a volume, this assumes that both paths 
+are on the $base volume, and ignores the $destination volume. 
+
+On systems that have a grammar that indicates filenames, this ignores the 
+$base filename as well. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+Based on code written by Shigio Yamaguchi.
+
+No checks against the filesystem are made. 
+
+=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 = 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 SEE ALSO
@@ -194,4 +440,3 @@ L<File::Spec>
 =cut
 
 1;
-__END__