Upgrade to PathTools-3.14_01
authorSteve Peters <steve@fisharerojo.org>
Sat, 10 Dec 2005 15:42:39 +0000 (15:42 +0000)
committerSteve Peters <steve@fisharerojo.org>
Sat, 10 Dec 2005 15:42:39 +0000 (15:42 +0000)
p4raw-id: //depot/perl@26318

ext/Cwd/Changes
ext/Cwd/Cwd.xs
lib/Cwd.pm
lib/File/Spec.pm
lib/File/Spec/Unix.pm
lib/File/Spec/VMS.pm
lib/File/Spec/t/Spec.t

index e104fe5..cf018a3 100644 (file)
@@ -1,5 +1,30 @@
 Revision history for Perl distribution PathTools.
 
+3.14_01  Fri Dec  9 22:45:49 CST 2005
+
+ - The Cwd::getcwd() function on *nix is now a direct pass-through to
+   the underlying getcwd() C library function when possible.  This is
+   safer and faster than the previous implementation, which just did
+   abs_path('.'). [Suggested by Nick Ing-Simmons]
+
+ - When Cwd searches for a 'pwd' executable in the $PATH, we now stop
+   after we find the first one rather than continuing the search.  We
+   also avoid the $PATH search altogether when a 'pwd' was already
+   found in a well-known and well-trusted location like /bin or
+   /usr/bin. [Suggested by Nick Ing-Simmons]
+
+ - On Win32 abs2rel($path, $base) was failing whenever $base is the
+   root of a volume (such as C:\ or \\share\dir).  This has been
+   fixed. [Reported by Bryan Daimler]
+
+ - In abs2rel() on VMS, we've fixed handling of directory trees so
+   that the test $file = File::Spec::VMS->abs2rel('[t1.t2.t3]file',
+   '[t1.t2.t3]') returns 'file' instead of an empty string. [John
+   E. Malmberg]
+
+ - In canonpath() on VMS, '[]' was totally optimized away instead of
+   just returning '[]'.  Now it's fixed. [John E. Malmberg]
+
 3.14  Thu Nov 17 18:08:44 CST 2005
 
  - canonpath() has some logic in it that avoids collapsing a
index f12f47f..4bcbf60 100644 (file)
@@ -408,6 +408,19 @@ PPCODE:
 #endif
 }
 
+void
+getcwd()
+PROTOTYPE: DISABLE
+PPCODE:
+{
+    dXSTARG;
+    getcwd_sv(TARG);
+    XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(TARG);
+#endif
+}
+
 void
 abs_path(pathsv=Nullsv)
     SV *pathsv
index d5a6db8..462f262 100644 (file)
@@ -35,7 +35,8 @@ absolute path of the current working directory.
 
 Returns the current working directory.
 
-Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
+Exposes the POSIX function getcwd(3) or re-implements it if it's not
+available.
 
 =item cwd
 
@@ -170,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.14';
+$VERSION = '3.14_01';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -302,6 +303,7 @@ foreach my $try ('/bin/pwd',
         last;
     }
 }
+my $found_pwd_cmd = defined($pwd_cmd);
 unless ($pwd_cmd) {
     # Isn't this wrong?  _backtick_pwd() will fail if somenone has
     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
@@ -334,9 +336,19 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     # The pwd command is not available in some chroot(2)'ed environments
     my $sep = $Config::Config{path_sep} || ':';
     my $os = $^O;  # Protect $^O from tainting
-    if( $os eq 'MacOS' || (defined $ENV{PATH} &&
-                          $os ne 'MSWin32' &&  # no pwd on Windows
-                          grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
+
+
+    # Try again to find a pwd, this time searching the whole PATH.
+    if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
+       my @candidates = split($sep, $ENV{PATH});
+       while (!$found_pwd_cmd and @candidates) {
+           my $candidate = shift @candidates;
+           $found_pwd_cmd = 1 if -x "$candidate/pwd";
+       }
+    }
+
+    # MacOS has some special magic to make `pwd` work.
+    if( $os eq 'MacOS' || $found_pwd_cmd )
     {
        *cwd = \&_backtick_pwd;
     }
@@ -349,16 +361,6 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
 # isn't redefined later (20001212 rspier)
 *fastgetcwd = \&cwd;
 
-# By Brandon S. Allbery
-#
-# Usage: $cwd = getcwd();
-
-sub getcwd
-{
-    abs_path('.');
-}
-
-
 # By John Bazik
 #
 # Usage: $cwd = &fastcwd;
index 59afacd..8f26544 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.14';
+$VERSION = '3.14_01';
 $VERSION = eval $VERSION;
 
 my %module = (MacOS   => 'Mac',
index 55e6cc3..8be7329 100644 (file)
@@ -369,10 +369,22 @@ sub abs2rel {
     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 ;
index 58cac1e..539a93b 100644 (file)
@@ -71,7 +71,7 @@ sub canonpath {
        $path =~ s/\[[^\]\.]+\.-\./\[/g;        # [foo.-.       ==> [
        $path =~ s/\.[^\]\.]+\.-\]/\]/g;        # .foo.-]       ==> ]
        $path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-]       ==> [000000]
-       $path =~ s/\[\]//;                      # []            ==>
+       $path =~ s/\[\]// unless $path eq '[]'; # []            ==>
        return $path;
     }
 }
@@ -335,8 +335,10 @@ sub abs2rel {
 
     # 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 && 
@@ -347,11 +349,15 @@ sub abs2rel {
         shift @basechunks ;
     }
 
-    return $self->curdir unless @pathchunks || @basechunks;
-
     # @basechunks now contains the directories to climb out of,
     # @pathchunks now has the directories to descend in to.
-    $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+    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 ) ) ;
 }
 
index 3fc1f56..e7e5b11 100644 (file)
@@ -255,6 +255,8 @@ if ($^O eq 'MacOS') {
 [ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','B:/t1/t2/t3')",  'A:\\t1\\t2\\t3\\t4' ],
 [ "FakeWin32->abs2rel('E:/foo/bar/baz')",            'E:\\foo\\bar\\baz'      ],
 [ "FakeWin32->abs2rel('C:/one/two/three')",          'three'                  ],
+[ "FakeWin32->abs2rel('C:\\Windows\\System32', 'C:\\')",  'Windows\System32'  ],
+[ "FakeWin32->abs2rel('\\\\computer2\\share3\\foo.txt', '\\\\computer2\\share3')",  'foo.txt' ],
 
 [ "FakeWin32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
 [ "FakeWin32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],