diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/Cwd/Changes | 30 | ||||
| -rw-r--r-- | lib/Cwd.pm | 2 | ||||
| -rw-r--r-- | lib/File/Spec.pm | 2 | ||||
| -rw-r--r-- | lib/File/Spec/Cygwin.pm | 12 | ||||
| -rw-r--r-- | lib/File/Spec/Unix.pm | 62 | ||||
| -rw-r--r-- | lib/File/Spec/VMS.pm | 2 | ||||
| -rw-r--r-- | lib/File/Spec/Win32.pm | 38 | ||||
| -rw-r--r-- | lib/File/Spec/t/Spec.t | 12 | ||||
| -rw-r--r-- | lib/File/Spec/t/tmpdir.t | 17 |
10 files changed, 98 insertions, 80 deletions
@@ -1560,6 +1560,7 @@ lib/File/Spec/t/crossplatform.t See if File::Spec works crossplatform lib/File/Spec/t/Functions.t See if File::Spec::Functions works lib/File/Spec/t/rel2abs2rel.t See if File::Spec->rel2abs/abs2rel works lib/File/Spec/t/Spec.t See if File::Spec works +lib/File/Spec/t/tmpdir.t See if File::Spec->tmpdir() works lib/File/Spec/Unix.pm portable operations on Unix file names lib/File/Spec/VMS.pm portable operations on VMS file names lib/File/Spec/Win32.pm portable operations on Win32 and NetWare file names diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes index 411e4c4ad0..e104fe56dc 100644 --- a/ext/Cwd/Changes +++ b/ext/Cwd/Changes @@ -1,5 +1,35 @@ Revision history for Perl distribution PathTools. +3.14 Thu Nov 17 18:08:44 CST 2005 + + - canonpath() has some logic in it that avoids collapsing a + //double/slash at the beginning of a pathname on platforms where + that means something special. It used to check the value of $^O + rather than the classname it was called as, which meant that + calling File::Spec::Cygwin->canonpath() didn't act like cygwin + unless you were actually *on* cygwin. Now it does. + + - Fixed a major bug on Cygwin in which catdir() could sometimes + create things that look like //network/paths in cases when it + shouldn't (e.g. catdir("/", "foo", "bar")). + +3.13 Tue Nov 15 23:50:37 CST 2005 + + - Calling tmpdir() on Win32 had the unintended side-effect of storing + some undef values in %INC for the TMPDIR, TEMP, and TMP entries if + they didn't exist already. This is probably a bug in perl itself + (submitted as #37441 on rt.perl.org), which we're now working + around. [Thomas L. Shinnick] + + - Integrated a change from bleadperl - a certain #ifdef in Cwd.xs + needs to apply to WIN32 but not WinCE. [Vadim Konovalov] + + - abs2rel() used to return the empty string when its two arguments + were identical, which made no sense. Now it returns + curdir(). [Spotted by David Golden] + + - The Unix and Win32 implementations of abs2rel() have been unified. + 3.12 Mon Oct 3 22:09:12 CDT 2005 - Fixed a testing error on OS/2 in which a drive letter for the root diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 8d25af9f7c..d5a6db8ec2 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -170,7 +170,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.12'; +$VERSION = '3.14'; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 0c8cd21e05..59afacde9e 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.12'; +$VERSION = '3.14'; $VERSION = eval $VERSION; my %module = (MacOS => 'Mac', diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm index 19a2937c6b..be457b1620 100644 --- a/lib/File/Spec/Cygwin.pm +++ b/lib/File/Spec/Cygwin.pm @@ -43,6 +43,18 @@ sub canonpath { return $self->SUPER::canonpath($path); } +sub catdir { + my $self = shift; + + # Don't create something that looks like a //network/path + if ($_[0] eq '/' or $_[0] eq '\\') { + shift; + return $self->SUPER::catdir('', @_); + } + + $self->SUPER::catdir(@_); +} + =pod =item file_name_is_absolute diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 4a25fe632f..55e6cc30f3 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -48,11 +48,12 @@ sub canonpath { # may be interpreted in an implementation-defined manner, although # more than two leading slashes shall be treated as a single slash.") my $node = ''; - if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) { + my $double_slashes_special = $self->isa("File::Spec::Cygwin") || $^O =~ m/^(?:qnx|nto)$/; + if ( $double_slashes_special && $path =~ s:^(//[^/]+)(/|\z):/:s ) { $node = $1; } # This used to be - # $path =~ s|/+|/|g unless($^O eq 'cygwin'); + # $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 @@ -353,52 +354,39 @@ Based on code written by Shigio Yamaguchi. sub abs2rel { my($self,$path,$base) = @_; + $base = $self->_cwd() unless defined $base and length $base; - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } + for ($path, $base) { $_ = $self->canonpath($_) } - # 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 ) ; - } + 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; + + for ($path, $base) { $_ = $self->rel2abs($_) } + + my $path_directories = ($self->splitpath($path, 1))[1]; + my $base_directories = ($self->splitpath($base, 1))[1]; # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path); - my @basechunks = $self->splitdir( $base); + my @pathchunks = $self->splitdir( $path_directories ); + my @basechunks = $self->splitdir( $base_directories ); - while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) { + while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { shift @pathchunks ; shift @basechunks ; } - - $path = CORE::join( '/', @pathchunks ); - $base = CORE::join( '/', @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. 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" ; - } + # 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, '') ); +} - return $self->canonpath( $path ) ; +sub _same { + $_[1] eq $_[2]; } =item rel2abs() diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index f8923f25fb..58cac1e48c 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -347,6 +347,8 @@ 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) ; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index a324306a74..6878c83f16 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -63,7 +63,7 @@ variables are tainted, they are not used. my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, + $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ), 'SYS:/temp', 'C:\system\temp', 'C:/temp', @@ -277,42 +277,10 @@ sub catpath { return $volume ; } - -sub abs2rel { - my($self,$path,$base) = @_; - $base = $self->_cwd() unless defined $base and length $base; - - 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; - - for ($path, $base) { $_ = $self->rel2abs($_) } - - my $path_directories = ($self->splitpath($path, 1))[1]; - my $base_directories = ($self->splitpath($base, 1))[1]; - - # 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 ; - } - - my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks ); - - return $self->canonpath( $self->catpath('', $result_dirs, '') ); +sub _same { + lc($_[1]) eq lc($_[2]); } - sub rel2abs { my ($self,$path,$base ) = @_; diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 02ebde39af..3fc1f566fb 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -102,7 +102,7 @@ if ($^O eq 'MacOS') { [ "Unix->canonpath('/../../')", '/' ], [ "Unix->canonpath('/../..')", '/' ], -[ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ], [ "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ], [ "Unix->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], [ "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], @@ -236,7 +236,7 @@ if ($^O eq 'MacOS') { # FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta -[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ], [ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ], [ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], [ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], @@ -248,7 +248,7 @@ if ($^O eq 'MacOS') { [ "FakeWin32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ], [ "FakeWin32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], [ "FakeWin32->abs2rel('//a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')", '' ], +[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')", '.' ], [ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','A:/t1/t2/t3')", 't4' ], [ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3/t4')", '..' ], [ "FakeWin32->abs2rel('A:/t1/t2/t3','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3' ], @@ -356,11 +356,11 @@ if ($^O eq 'MacOS') { [ "VMS->catdir('[.name]')", '[.name]' ], [ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], -[ "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", '[]' ], [ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", 'node::volume:[t1.t2.t3]' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", '[-.t4]' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", 'node::volume:[t1.t2.t4]' ], -[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '[]' ], [ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], [ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')", '[.t3]file' ], [ "VMS->abs2rel('v:[t1.t2.t3]file','v:[t1.t2]')", '[.t3]file' ], @@ -369,7 +369,7 @@ if ($^O eq 'MacOS') { [ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[.t4]' ], [ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[---.t4.t5.t6]' ], [ "VMS->abs2rel('[000000]','[t1.t2.t3]')", '[---]' ], -[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", '[-.t4]' ], [ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", 'a:[t1.t2.t4]' ], [ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[---.b]' ], diff --git a/lib/File/Spec/t/tmpdir.t b/lib/File/Spec/t/tmpdir.t new file mode 100644 index 0000000000..cffa0b0dfa --- /dev/null +++ b/lib/File/Spec/t/tmpdir.t @@ -0,0 +1,17 @@ +use strict; +use Test; + +# Grab all of the plain routines from File::Spec +use File::Spec; +use File::Spec::Win32; + +plan tests => 3; + +ok 1, 1, "Loaded"; + +my $num_keys = keys %ENV; +File::Spec->tmpdir; +ok scalar keys %ENV, $num_keys, "tmpdir() shouldn't change the contents of %ENV"; + +File::Spec::Win32->tmpdir; +ok scalar keys %ENV, $num_keys, "Win32->tmpdir() shouldn't change the contents of %ENV"; |