From: Steve Peters Date: Sat, 10 Dec 2005 15:42:39 +0000 (+0000) Subject: Upgrade to PathTools-3.14_01 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa52125f2139574b06ddadadf21b82bb93e6c77e;p=p5sagit%2Fp5-mst-13.2.git Upgrade to PathTools-3.14_01 p4raw-id: //depot/perl@26318 --- diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes index e104fe5..cf018a3 100644 --- a/ext/Cwd/Changes +++ b/ext/Cwd/Changes @@ -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 diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index f12f47f..4bcbf60 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -409,6 +409,19 @@ PPCODE: } 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 PROTOTYPE: DISABLE diff --git a/lib/Cwd.pm b/lib/Cwd.pm index d5a6db8..462f262 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -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; diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 59afacd..8f26544 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -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', diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 55e6cc3..8be7329 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -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 ; diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 58cac1e..539a93b 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -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 ) ) ; } diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 3fc1f56..e7e5b11 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -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' ],