From: Rafael Garcia-Suarez Date: Sat, 27 Aug 2005 16:59:02 +0000 (+0000) Subject: Upgrade to PathTools 3.10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9596c75cf25afc08d6274085fe826f0f50fd6c98;p=p5sagit%2Fp5-mst-13.2.git Upgrade to PathTools 3.10 p4raw-id: //depot/perl@25334 --- diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes index 0f5d532..8155127 100644 --- a/ext/Cwd/Changes +++ b/ext/Cwd/Changes @@ -1,5 +1,16 @@ Revision history for Perl distribution PathTools. +3.10 Thu Aug 25 22:24:57 CDT 2005 + + - eliminate_macros() and fixpath() in File::Spec::VMS are now + deprecated, since they are MakeMaker-specific and now live inside + MakeMaker. [Michael Schwern] + + - canonpath() on Win32 now collapses foo/.. (or foo\..) sections + correctly, rather than doing the "misguided" work it was previously + doing. Note that canonpath() on Unix still does NOT collapse these + sections, as doing so would be incorrect. [Michael Schwern] + 3.09 Tue Jun 14 20:36:50 CDT 2005 - Added some block delimiters (brackets) in the Perl_getcwd_sv() XS diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 18f4b65..c00dbc5 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.09'; +$VERSION = '3.10'; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 89d7e45..ae1cd93 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.09'; +$VERSION = '3.10'; $VERSION = eval $VERSION; my %module = (MacOS => 'Mac', diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 47ad797..4a25fe6 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -59,7 +59,8 @@ sub canonpath { $path =~ s|/+|/|g; # xx////xx -> xx/xx $path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx - $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx + $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx + $path =~ s|^/\.\.$|/|; # /.. -> / $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx return "$node$path"; } @@ -472,4 +473,38 @@ sub _cwd { Cwd::cwd(); } + +# Internal method to reduce xx\..\yy -> yy +sub _collapse { + my($fs, $path) = @_; + + my $updir = $fs->updir; + my $curdir = $fs->curdir; + + my($vol, $dirs, $file) = $fs->splitpath($path); + my @dirs = $fs->splitdir($dirs); + + my @collapsed; + foreach my $dir (@dirs) { + if( $dir eq $updir and # if we have an updir + @collapsed and # and something to collapse + length $collapsed[-1] and # and its not the rootdir + $collapsed[-1] ne $updir and # nor another updir + $collapsed[-1] ne $curdir # nor the curdir + ) + { # then + pop @collapsed; # collapse + } + else { # else + push @collapsed, $dir; # just hang onto it + } + } + + return $fs->catpath($vol, + $fs->catdir(@collapsed), + $file + ); +} + + 1; diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 887746b..f8923f2 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -27,118 +27,6 @@ the semantics. =over 4 -=item eliminate_macros - -Expands MM[KS]/Make macros in a text string, using the contents of -identically named elements of C<%$self>, and returns the result -as a file specification in Unix syntax. - -=cut - -sub eliminate_macros { - my($self,$path) = @_; - return '' unless $path; - $self = {} unless ref $self; - - if ($path =~ /\s/) { - return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; - } - - my($npath) = unixify($path); - my($complex) = 0; - my($head,$macro,$tail); - - # perform m##g in scalar context so it acts as an iterator - while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { - if ($self->{$2}) { - ($head,$macro,$tail) = ($1,$2,$3); - if (ref $self->{$macro}) { - if (ref $self->{$macro} eq 'ARRAY') { - $macro = join ' ', @{$self->{$macro}}; - } - else { - print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), - "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; - $macro = "\cB$macro\cB"; - $complex = 1; - } - } - else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } - $npath = "$head$macro$tail"; - } - } - if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; } - $npath; -} - -=item fixpath - -Catchall routine to clean up problem MM[SK]/Make macros. Expands macros -in any directory specification, in order to avoid juxtaposing two -VMS-syntax directories when MM[SK] is run. Also expands expressions which -are all macro, so that we can tell how long the expansion is, and avoid -overrunning DCL's command buffer when MM[KS] is running. - -If optional second argument has a TRUE value, then the return string is -a VMS-syntax directory specification, if it is FALSE, the return string -is a VMS-syntax file specification, and if it is not specified, fixpath() -checks to see whether it matches the name of a directory in the current -default directory, and returns a directory or file specification accordingly. - -=cut - -sub fixpath { - my($self,$path,$force_path) = @_; - return '' unless $path; - $self = bless {} unless ref $self; - my($fixedpath,$prefix,$name); - - if ($path =~ /\s/) { - return join ' ', - map { $self->fixpath($_,$force_path) } - split /\s+/, $path; - } - - if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { - if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { - $fixedpath = vmspath($self->eliminate_macros($path)); - } - else { - $fixedpath = vmsify($self->eliminate_macros($path)); - } - } - elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { - my($vmspre) = $self->eliminate_macros("\$($prefix)"); - # is it a dir or just a name? - $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; - $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; - $fixedpath = vmspath($fixedpath) if $force_path; - } - else { - $fixedpath = $path; - $fixedpath = vmspath($fixedpath) if $force_path; - } - # No hints, so we try to guess - if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { - $fixedpath = vmspath($fixedpath) if -d $fixedpath; - } - - # Trim off root dirname if it's had other dirs inserted in front of it. - $fixedpath =~ s/\.000000([\]>])/$1/; - # Special case for VMS absolute directory specs: these will have had device - # prepended during trip through Unix syntax in eliminate_macros(), since - # Unix syntax has no way to express "absolute from the top of this device's - # directory tree". - if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } - $fixedpath; -} - -=back - -=head2 Methods always loaded - -=over 4 - =item canonpath (override) Removes redundant portions of file specifications according to VMS syntax. @@ -188,7 +76,7 @@ sub canonpath { } } -=item catdir +=item catdir (override) Concatenates a list of file specifications, and returns the result as a VMS-syntax directory specification. No check is made for "impossible" @@ -222,7 +110,7 @@ sub catdir { return $self->canonpath($rslt); } -=item catfile +=item catfile (override) Concatenates a list of file specifications, and returns the result as a VMS-syntax file specification. @@ -519,6 +407,98 @@ sub rel2abs { } +# eliminate_macros() and fixpath() are MakeMaker-specific methods +# which are used inside catfile() and catdir(). MakeMaker has its own +# copies as of 6.06_03 which are the canonical ones. We leave these +# here, in peace, so that File::Spec continues to work with MakeMakers +# prior to 6.06_03. +# +# Please consider these two methods deprecated. Do not patch them, +# patch the ones in ExtUtils::MM_VMS instead. +sub eliminate_macros { + my($self,$path) = @_; + return '' unless $path; + $self = {} unless ref $self; + + if ($path =~ /\s/) { + return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; + } + + my($npath) = unixify($path); + my($complex) = 0; + my($head,$macro,$tail); + + # perform m##g in scalar context so it acts as an iterator + while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { + if ($self->{$2}) { + ($head,$macro,$tail) = ($1,$2,$3); + if (ref $self->{$macro}) { + if (ref $self->{$macro} eq 'ARRAY') { + $macro = join ' ', @{$self->{$macro}}; + } + else { + print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), + "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; + $macro = "\cB$macro\cB"; + $complex = 1; + } + } + else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } + $npath = "$head$macro$tail"; + } + } + if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; } + $npath; +} + +# Deprecated. See the note above for eliminate_macros(). +sub fixpath { + my($self,$path,$force_path) = @_; + return '' unless $path; + $self = bless {} unless ref $self; + my($fixedpath,$prefix,$name); + + if ($path =~ /\s/) { + return join ' ', + map { $self->fixpath($_,$force_path) } + split /\s+/, $path; + } + + if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { + if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { + $fixedpath = vmspath($self->eliminate_macros($path)); + } + else { + $fixedpath = vmsify($self->eliminate_macros($path)); + } + } + elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { + my($vmspre) = $self->eliminate_macros("\$($prefix)"); + # is it a dir or just a name? + $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; + $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; + $fixedpath = vmspath($fixedpath) if $force_path; + } + else { + $fixedpath = $path; + $fixedpath = vmspath($fixedpath) if $force_path; + } + # No hints, so we try to guess + if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { + $fixedpath = vmspath($fixedpath) if -d $fixedpath; + } + + # Trim off root dirname if it's had other dirs inserted in front of it. + $fixedpath =~ s/\.000000([\]>])/$1/; + # Special case for VMS absolute directory specs: these will have had device + # prepended during trip through Unix syntax in eliminate_macros(), since + # Unix syntax has no way to express "absolute from the top of this device's + # directory tree". + if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } + $fixedpath; +} + + =back =head1 COPYRIGHT diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index f2b8c39..94094f0 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -127,7 +127,7 @@ On Win32 makes sub canonpath { my ($self,$path) = @_; - my $orig_path = $path; + $path =~ s/^([a-z]:)/\u$1/s; $path =~ s|/|\\|g; $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx @@ -144,29 +144,7 @@ sub canonpath { $path =~ s{^\\\.\.$}{\\}; # \.. -> \ 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx - my ($vol,$dirs,$file) = $self->splitpath($path); - my @dirs = $self->splitdir($dirs); - my (@base_dirs, @path_dirs); - my $dest = \@base_dirs; - for my $dir (@dirs){ - $dest = \@path_dirs if $dir eq $self->updir; - push @$dest, $dir; - } - # for each .. in @path_dirs pop one item from - # @base_dirs - while (my $dir = shift @path_dirs){ - unless ($dir eq $self->updir){ - unshift @path_dirs, $dir; - last; - } - pop @base_dirs; - } - $path = $self->catpath( - $vol, - $self->catdir(@base_dirs, @path_dirs), - $file - ); - return $path; + return $self->_collapse($path); } =item splitpath @@ -274,8 +252,9 @@ sub catpath { # If it's UNC, make sure the glue separator is there, reusing # whatever separator is first in the $volume - $volume .= $1 - if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && + my $v; + $volume .= $v + if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) && $directory =~ m@^[^\\/]@s ) ; diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 85d580c..02ebde3 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -91,12 +91,16 @@ if ($^O eq 'MacOS') { [ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ], [ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ], -[ "Unix->canonpath('')", '' ], [ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], -[ "Unix->canonpath('/.')", '/' ], -[ "Unix->canonpath('/./')", '/' ], -[ "Unix->canonpath('/a/./')", '/a' ], -[ "Unix->canonpath('/a/.')", '/a' ], +[ "Unix->canonpath('')", '' ], +# rt.perl.org 27052 +[ "Unix->canonpath('a/../../b/c')", 'a/../../b/c' ], +[ "Unix->canonpath('/.')", '/' ], +[ "Unix->canonpath('/./')", '/' ], +[ "Unix->canonpath('/a/./')", '/a' ], +[ "Unix->canonpath('/a/.')", '/a' ], +[ "Unix->canonpath('/../../')", '/' ], +[ "Unix->canonpath('/../..')", '/' ], [ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], [ "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ], @@ -209,6 +213,8 @@ if ($^O eq 'MacOS') { [ "Win32->canonpath('a:')", 'A:' ], [ "Win32->canonpath('A:f')", 'A:f' ], [ "Win32->canonpath('A:/')", 'A:\\' ], +# rt.perl.org 27052 +[ "Win32->canonpath('a\\..\\..\\b\\c')", '..\\b\\c' ], [ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ], [ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ], [ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ],