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
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
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);
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.12';
+$VERSION = '3.14';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
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
# 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
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()
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) ;
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',
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 ) = @_;
[ "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' ],
# 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' ],
[ "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' ],
[ "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' ],
[ "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]' ],
--- /dev/null
+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";
projects / p5sagit/p5-mst-13.2.git / commitdiff