From: Rafael Garcia-Suarez Date: Wed, 28 Jul 2004 12:13:36 +0000 (+0000) Subject: Upgrade to File::Spec 0.88. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b2874358a4501aa172a431fb19da878b608622f;p=p5sagit%2Fp5-mst-13.2.git Upgrade to File::Spec 0.88. p4raw-id: //depot/perl@23168 --- diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index b5f56d0..1e28205 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -3,7 +3,8 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '0.87'; +$VERSION = '0.88'; +$VERSION = eval $VERSION; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', @@ -92,7 +93,7 @@ path. Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses -OS2. Of course, if this is the root directory, don't cut off the +OS/2. Of course, if this is the root directory, don't cut off the trailing slash :-) $path = File::Spec->catdir( @directories ); @@ -127,8 +128,8 @@ Returns a string representation of the root directory. Returns a string representation of the first writable directory from a list of possible temporary directories. Returns the current directory if no writable temporary directories are found. The list of directories -checked depends on the platform; e.g. File::Spec::Unix checks $ENV{TMPDIR} -(unless taint is on) and /tmp. +checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}> +(unless taint is on) and F. $tmpdir = File::Spec->tmpdir(); @@ -148,13 +149,13 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.) =item case_tolerant Returns a true or false value indicating, respectively, that alphabetic -is not or is significant when comparing file specifications. +case is not or is significant when comparing file specifications. $is_case_tolerant = File::Spec->case_tolerant(); =item file_name_is_absolute -Takes as argument a path and returns true if it is an absolute path. +Takes as its argument a path, and returns true if it is an absolute path. $is_absolute = File::Spec->file_name_is_absolute( $path ); @@ -164,7 +165,7 @@ Mac OS (Classic). It does consult the working environment for VMS =item path -Takes no argument, returns the environment variable PATH (or the local +Takes no argument. Returns the environment variable C (or the local platform's equivalent) as a list. @PATH = File::Spec->path(); @@ -182,8 +183,8 @@ with no concept of volume, returns '' for volume. ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); For systems with no syntax differentiating filenames from directories, -assumes that the last file is a path unless $no_file is true or a -trailing separator or /. or /.. is present. On Unix this means that $no_file +assumes that the last file is a path unless C<$no_file> is true or a +trailing separator or F or F is present. On Unix, this means that C<$no_file> true makes this return ( '', $path, '' ). The directory portion may or may not be returned with a trailing '/'. @@ -197,19 +198,19 @@ The opposite of L. @dirs = File::Spec->splitdir( $directories ); -$directories must be only the directory portion of the path on systems +C<$directories> must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. Unlike just splitting the directories on the separator, empty directory names (C<''>) can be returned, because these are significant -on some OSs. +on some OSes. =item catpath() Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and directory and file are concatenated. A '/' is -inserted if need be. On other OSs, $volume is significant. +Unix, C<$volume> is ignored, and directory and file are concatenated. A '/' is +inserted if need be. On other OSes, C<$volume> is significant. $full_path = File::Spec->catpath( $volume, $directory, $file ); @@ -221,22 +222,22 @@ from the base path to the destination path: $rel_path = File::Spec->abs2rel( $path ) ; $rel_path = File::Spec->abs2rel( $path, $base ) ; -If $base is not present or '', then L is used. If $base is +If C<$base> is not present or '', then L is used. If C<$base> is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of volume, if $path and $base appear to be +On systems with the concept of volume, if C<$path> and C<$base> appear to be on two different volumes, we will not attempt to resolve the two -paths, and we will instead simply return $path. Note that previous -versions of this module ignored the volume of $base, which resulted in +paths, and we will instead simply return C<$path>. Note that previous +versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be +C<$base> filename as well. Otherwise all path components are assumed to be directories. -If $path is relative, it is converted to absolute form using L. +If C<$path> is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. No checks against the filesystem are made. On VMS, there is @@ -252,21 +253,21 @@ Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; -If $base is not present or '', then L is used. If $base is relative, +If C<$base> is not present or '', then L is used. If C<$base> is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of volume, if $path and $base appear to be +On systems with the concept of volume, if C<$path> and C<$base> appear to be on two different volumes, we will not attempt to resolve the two -paths, and we will instead simply return $path. Note that previous -versions of this module ignored the volume of $base, which resulted in +paths, and we will instead simply return C<$path>. Note that previous +versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be +C<$base> filename as well. Otherwise all path components are assumed to be directories. -If $path is absolute, it is cleaned up and returned using L. +If C<$path> is absolute, it is cleaned up and returned using L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and @@ -286,17 +287,21 @@ L, L, L, L, L, L, L -=head1 AUTHORS - -Kenneth Albanowski , Andy Dougherty -, Andreas KEnig -, Tim Bunce . -OS/2 support by Ilya Zakharevich . -Mac support by Paul Schinder , and Thomas Wegner -. abs2rel() and rel2abs() written by Shigio -Yamaguchi , modified by Barrie Slaymaker -. splitpath(), splitdir(), catpath() and -catdir() by Barrie Slaymaker. +=head1 AUTHOR + +Currently maintained by Ken Williams C<< >>. + +The vast majority of the code was written by +Kenneth Albanowski C<< >>, +Andy Dougherty C<< >>, +Andreas KEnig C<< >>, +Tim Bunce C<< >>. +VMS support by Charles Bailey C<< >>. +OS/2 support by Ilya Zakharevich C<< >>. +Mac support by Paul Schinder C<< >>, and +Thomas Wegner C<< >>. +abs2rel() and rel2abs() written by Shigio Yamaguchi C<< >>, +modified by Barrie Slaymaker C<< >>. +splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker. =cut diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 1a91b95..0d60cfb 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '1.4'; +$VERSION = '1.5'; @ISA = qw(File::Spec::Unix); @@ -201,7 +201,7 @@ sub splitpath { (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? ) - ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) + ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? ) (.*) }xs; $volume = $1; @@ -335,7 +335,9 @@ sub rel2abs { if ( ! $self->file_name_is_absolute( $path ) ) { if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd() ; + 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 ) ; diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 1c2dd6a..899d8dc 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -7,6 +7,7 @@ use File::Spec @File::Spec::EXPORT_OK ; require File::Spec::Unix ; require File::Spec::Win32 ; +require Cwd; eval { require VMS::Filespec ; @@ -226,14 +227,14 @@ if ($^O eq 'MacOS') { [ "Win32->canonpath('/..\\')", '\\' ], [ "Win32->can('_cwd')", '/CODE/' ], -# FakeWin32 subclass (see below) just sets CWD to C:\one\two +# 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/t4','/t1/t2/t3')", '..\\t4' ], [ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], [ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], [ "FakeWin32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ], -[ "FakeWin32->abs2rel('../t4','/t1/t2/t3')", '..\\..\\..\\one\\t4' ], +[ "FakeWin32->abs2rel('../t4','/t1/t2/t3')", '..\\..\\..\\one\\t4' ], # Uses _cwd() [ "FakeWin32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ], [ "FakeWin32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ], [ "FakeWin32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..' ], @@ -558,11 +559,37 @@ if ($^O eq 'MacOS') { ) ; +if ($^O eq 'MSWin32') { + push @tests, [ "FakeWin32->rel2abs('D:foo.txt')", 'D:\\alpha\\beta\\foo.txt' ]; +} + + plan tests => scalar @tests; { - @File::Spec::FakeWin32::ISA = qw(File::Spec::Win32); - sub File::Spec::FakeWin32::_cwd { 'C:\\one\\two' } + package File::Spec::FakeWin32; + use vars qw(@ISA); + @ISA = qw(File::Spec::Win32); + + sub _cwd { 'C:\\one\\two' } + + # Some funky stuff to override Cwd::getdcwd() for testing purposes, + # in the limited scope of the rel2abs() method. + if ($Cwd::VERSION gt '2.17') { + local $^W; + *rel2abs = sub { + my $self = shift; + local $^W; + local *Cwd::getdcwd = sub { + return 'D:\alpha\beta' if $_[0] eq 'D:'; + return 'C:\one\two' if $_[0] eq 'C:'; + return; + }; + *Cwd::getdcwd = *Cwd::getdcwd; # Avoid a 'used only once' warning + return $self->SUPER::rel2abs(@_); + }; + *rel2abs = *rel2abs; # Avoid a 'used only once' warning + } }