From: Steve Peters Date: Fri, 6 Oct 2006 20:02:48 +0000 (+0000) Subject: Upgrade to PathTools-3.21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=110c90cc4fbd0539c76efe20ae7302af29840848;p=p5sagit%2Fp5-mst-13.2.git Upgrade to PathTools-3.21 p4raw-id: //depot/perl@28948 --- diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes index 2199b59..34c6fc5 100644 --- a/ext/Cwd/Changes +++ b/ext/Cwd/Changes @@ -1,5 +1,22 @@ Revision history for Perl distribution PathTools. +3.21 Wed Oct 4 21:13:21 CDT 2006 + + - Added a bunch of X<> tags to the File::Spec docs to help + podindex. [Gabor Szabo] + + - On Win32, abs2rel('C:\one\two\t\foo', 't\bar') should return + '..\foo' when the cwd is 'C:\one\two', but it wasn't noticing that + the two relevant volumes were the same so it would return the full + path 'C:\one\two\t\foo'. This is fixed. [Spotted by Alexandr + Ciornii] + + - On Win32, rel2abs() now always adds a volume (drive letter) if the + given path doesn't have a volume (drive letter or UNC volume). + Previously it could return a value that didn't have a volume if the + input was a semi-absolute path like /foo/bar instead of a + fully-absolute path like C:/foo/bar . + 3.19 Tue Jul 11 22:40:26 CDT 2006 - When abs2rel() is called with two relative paths diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 1a85d67..1a1fd60 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -171,7 +171,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.19'; +$VERSION = '3.21'; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 60553b5..df1549c 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.19'; +$VERSION = '3.21'; $VERSION = eval $VERSION; my %module = (MacOS => 'Mac', @@ -83,6 +83,7 @@ forms of these methods. =over 2 =item canonpath +X No physical check on the filesystem, but a logical cleanup of a path. @@ -97,6 +98,7 @@ processing, you probably want C's C function to actually traverse the filesystem cleaning up paths like this. =item catdir +X Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting @@ -107,6 +109,7 @@ trailing slash :-) $path = File::Spec->catdir( @directories ); =item catfile +X Concatenate one or more directory names and a filename to form a complete path ending with a filename @@ -114,24 +117,28 @@ complete path ending with a filename $path = File::Spec->catfile( @directories, $filename ); =item curdir +X Returns a string representation of the current directory. $curdir = File::Spec->curdir(); =item devnull +X Returns a string representation of the null device. $devnull = File::Spec->devnull(); =item rootdir +X Returns a string representation of the root directory. $rootdir = File::Spec->rootdir(); =item tmpdir +X Returns a string representation of the first writable directory from a list of possible temporary directories. Returns the current directory @@ -142,6 +149,7 @@ checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}> $tmpdir = File::Spec->tmpdir(); =item updir +X Returns a string representation of the parent directory. @@ -172,6 +180,7 @@ Mac OS (Classic). It does consult the working environment for VMS (see L). =item path +X Takes no argument. Returns the environment variable C (or the local platform's equivalent) as a list. @@ -179,10 +188,12 @@ platform's equivalent) as a list. @PATH = File::Spec->path(); =item join +X join is the same as catfile. =item splitpath +X X Splits a path in to volume, directory, and filename portions. On systems with no concept of volume, returns '' for volume. @@ -201,6 +212,7 @@ The results can be passed to L to get back a path equivalent to (usually identical to) the original path. =item splitdir +X X The opposite of L. @@ -223,6 +235,7 @@ inserted if need be. On other OSes, C<$volume> is significant. $full_path = File::Spec->catpath( $volume, $directory, $file ); =item abs2rel +X X X Takes a destination path and an optional base path returns a relative path from the base path to the destination path: @@ -255,6 +268,7 @@ macros are expanded. Based on code written by Shigio Yamaguchi. =item rel2abs() +X X X Converts a relative path to an absolute path. diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 902e14b..18f7652 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -358,12 +358,6 @@ sub abs2rel { for ($path, $base) { $_ = $self->canonpath($_) } - 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; - if (grep $self->file_name_is_absolute($_), $path, $base) { for ($path, $base) { $_ = $self->rel2abs($_) } } @@ -372,6 +366,12 @@ sub abs2rel { for ($path, $base) { $_ = $self->catdir('/', $_) } } + 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]; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 6878c83..6251f53 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -9,6 +9,12 @@ $VERSION = '1.6'; @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 @@ -77,7 +83,9 @@ sub case_tolerant { sub file_name_is_absolute { my ($self,$file) = @_; - return scalar($file =~ m{^([a-z]:)?[\\/]}is); + return $file =~ m{^$VOL_RX}os ? 2 : + $file =~ m{^[\\/]}is ? 1 : + 0; } =item catfile @@ -172,21 +180,16 @@ sub splitpath { my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $path =~ - m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) - (.*) - }xs; + m{^ ( $VOL_RX ? ) (.*) }sox; $volume = $1; $directory = $2; } else { $path =~ - m{^ ( (?: [a-zA-Z]: | - (?:\\\\|//)[^\\/]+[\\/][^\\/]+ - )? - ) + m{^ ( $VOL_RX ? ) ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? ) (.*) - }xs; + }sox; $volume = $1; $directory = $2; $file = $3; @@ -284,32 +287,40 @@ sub _same { sub rel2abs { my ($self,$path,$base ) = @_; - if ( ! $self->file_name_is_absolute( $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 - ) ; + 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 ) ; } diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index bbc54bf..32fdb39 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -265,12 +265,14 @@ if ($^O eq 'MacOS') { [ "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->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1' ], [ "FakeWin32->rel2abs('temp','C:/')", 'C:\\temp' ], [ "FakeWin32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ], [ "FakeWin32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ], [ "FakeWin32->rel2abs('../','C:/')", 'C:\\' ], [ "FakeWin32->rel2abs('../','C:/a')", 'C:\\' ], +[ "FakeWin32->rel2abs('\\foo','C:/a')", 'C:\\foo' ], [ "FakeWin32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], [ "FakeWin32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], [ "FakeWin32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ],