From 486bcc50ba13b9bb0f294f39e26e6e0d78f5f1fe Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 19 Oct 2008 10:23:11 +0000 Subject: [PATCH] Upgrade PathTools to 3.28_01 p4raw-id: //depot/perl@34514 --- ext/Cwd/t/win32.t | 9 ++++++++- lib/Cwd.pm | 3 ++- lib/File/Spec.pm | 2 +- lib/File/Spec/Cygwin.pm | 5 +++-- lib/File/Spec/Epoc.pm | 3 ++- lib/File/Spec/Functions.pm | 3 ++- lib/File/Spec/Mac.pm | 3 ++- lib/File/Spec/OS2.pm | 3 ++- lib/File/Spec/Unix.pm | 13 +++++++------ lib/File/Spec/VMS.pm | 35 +++++++++++++++++++++++++++-------- lib/File/Spec/Win32.pm | 14 ++++++++------ lib/File/Spec/t/Spec.t | 38 ++++++++++++++++++++++++++++++++++++++ 12 files changed, 102 insertions(+), 29 deletions(-) diff --git a/ext/Cwd/t/win32.t b/ext/Cwd/t/win32.t index f4945f6..2934c81 100644 --- a/ext/Cwd/t/win32.t +++ b/ext/Cwd/t/win32.t @@ -11,7 +11,7 @@ use lib File::Spec->catdir('t', 'lib'); use Test::More; if( $^O eq 'MSWin32' ) { - plan tests => 3; + plan tests => 4; } else { plan skip_all => 'this is not win32'; } @@ -29,3 +29,10 @@ if (defined $ddir) { # May not have a D: drive mounted ok 1; } + +# Ensure compatibility with naughty versions of Template::Toolkit, +# which pass in a bare $1 as an argument +'Foo/strawberry' =~ /(.*)/; +my $result = File::Spec::Win32->catfile('C:/cache', $1); +is( $result, 'C:\cache\Foo\strawberry' ); + diff --git a/lib/Cwd.pm b/lib/Cwd.pm index b93c003..f00072b 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -171,7 +171,8 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 53d4a5a..b4bcaeb 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.2701'; +$VERSION = '3.28_01'; $VERSION = eval $VERSION; my %module = (MacOS => 'Mac', diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm index 1b2c045..89444f9 100644 --- a/lib/File/Spec/Cygwin.pm +++ b/lib/File/Spec/Cygwin.pm @@ -4,7 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw(File::Spec::Unix); @@ -111,7 +112,7 @@ Default: 1 =cut -sub case_tolerant () { +sub case_tolerant { return 1 unless $^O eq 'cygwin' and defined &Cygwin::mount_flags; diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm index 1e0ad18..57d2ec2 100644 --- a/lib/File/Spec/Epoc.pm +++ b/lib/File/Spec/Epoc.pm @@ -3,7 +3,8 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; require File::Spec::Unix; @ISA = qw(File::Spec::Unix); diff --git a/lib/File/Spec/Functions.pm b/lib/File/Spec/Functions.pm index ab335e1..a695763 100644 --- a/lib/File/Spec/Functions.pm +++ b/lib/File/Spec/Functions.pm @@ -5,7 +5,8 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; require Exporter; diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index 97fa676..fdf3528 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -4,7 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw(File::Spec::Unix); diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm index 48d09fa..54dda3d 100644 --- a/lib/File/Spec/OS2.pm +++ b/lib/File/Spec/OS2.pm @@ -4,7 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw(File::Spec::Unix); diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index e8dbaa9..57b83c6 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -3,7 +3,8 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; =head1 NAME @@ -104,7 +105,7 @@ Returns a string representation of the current directory. "." on UNIX. =cut -sub curdir () { '.' } +sub curdir { '.' } =item devnull @@ -112,7 +113,7 @@ Returns a string representation of the null device. "/dev/null" on UNIX. =cut -sub devnull () { '/dev/null' } +sub devnull { '/dev/null' } =item rootdir @@ -120,7 +121,7 @@ Returns a string representation of the root directory. "/" on UNIX. =cut -sub rootdir () { '/' } +sub rootdir { '/' } =item tmpdir @@ -169,7 +170,7 @@ Returns a string representation of the parent directory. ".." on UNIX. =cut -sub updir () { '..' } +sub updir { '..' } =item no_upwards @@ -190,7 +191,7 @@ is not or is significant when comparing file specifications. =cut -sub case_tolerant () { 0 } +sub case_tolerant { 0 } =item file_name_is_absolute diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 747a89d..f68927d 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -4,7 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw(File::Spec::Unix); @@ -242,16 +243,34 @@ sub file_name_is_absolute { =item splitpath (override) -Splits using VMS syntax. + ($volume,$directories,$file) = File::Spec->splitpath( $path ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + +Passing a true value for C<$no_file> indicates that the path being +split only contains directory components, even on systems where you +can usually (when not supporting a foreign syntax) tell the difference +between directories and files at a glance. =cut sub splitpath { - my($self,$path) = @_; - my($dev,$dir,$file) = ('','',''); - - vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s; - return ($1 || '',$2 || '',$3); + my($self,$path, $nofile) = @_; + my($dev,$dir,$file) = ('','',''); + my $vmsify_path = vmsify($path); + if ( $nofile ){ + #vmsify('d1/d2/d3') returns '[.d1.d2]d3' + #vmsify('/d1/d2/d3') returns 'd1:[d2]d3' + if( $vmsify_path =~ /(.*)\](.+)/ ){ + $vmsify_path = $1.'.'.$2.']'; + } + $vmsify_path =~ /(.+:)?(.*)/s; + $dir = defined $2 ? $2 : ''; # dir can be '0' + return ($1 || '',$dir,$file); + } + else { + $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s; + return ($1 || '',$2 || '',$3); + } } =item splitdir (override) @@ -470,7 +489,7 @@ sub eliminate_macros { sub fixpath { my($self,$path,$force_path) = @_; return '' unless $path; - $self = bless {} unless ref $self; + $self = bless {}, $self unless ref $self; my($fixedpath,$prefix,$name); if ($path =~ /\s/) { diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 9b90340..4df45f6 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -5,7 +5,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.2701'; +$VERSION = '3.28_01'; +$VERSION = eval $VERSION; @ISA = qw(File::Spec::Unix); @@ -41,7 +42,7 @@ sub devnull { return "nul"; } -sub rootdir () { '\\' } +sub rootdir { '\\' } =item tmpdir @@ -87,7 +88,7 @@ Default: 1 =cut -sub case_tolerant () { +sub case_tolerant { eval { require Win32API::File; } or return 1; my $drive = shift || "C:"; my $osFsType = "\0"x256; @@ -375,9 +376,10 @@ implementation of these methods, not the semantics. =cut -sub _canon_cat(@) # @path -> path +sub _canon_cat # @path -> path { - my $first = shift; + my ($first, @rest) = @_; + my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter ? ucfirst( $1 ).( $2 ? "\\" : "" ) : $first =~ s{ \A (?:\\\\|//) ([^\\/]+) @@ -387,7 +389,7 @@ sub _canon_cat(@) # @path -> path : $first =~ s{ \A [\\/] }{}x # root dir ? "\\" : ""; - my $path = join "\\", $first, @_; + my $path = join "\\", $first, @rest; $path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 83c22a6..6150bc3 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -312,6 +312,44 @@ if ($^O eq 'MacOS') { [ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,[d1.d2.d3],' ], [ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ], +[ "VMS->splitpath('[]')", ',[],' ], +[ "VMS->splitpath('[-]')", ',[-],' ], +[ "VMS->splitpath('[]file')", ',[],file' ], +[ "VMS->splitpath('[-]file')", ',[-],file' ], +[ "VMS->splitpath('')", ',,' ], +[ "VMS->splitpath('0')", ',,0' ], +[ "VMS->splitpath('[0]')", ',[0],' ], +[ "VMS->splitpath('[.0]')", ',[.0],' ], +[ "VMS->splitpath('[0.0.0]')", ',[0.0.0],' ], +[ "VMS->splitpath('[.0.0.0]')", ',[.0.0.0],' ], +[ "VMS->splitpath('[0]0')", ',[0],0' ], +[ "VMS->splitpath('[0.0.0]0')", ',[0.0.0],0' ], +[ "VMS->splitpath('[.0.0.0]0')", ',[.0.0.0],0' ], +[ "VMS->splitpath('0/0')", ',[.0],0' ], +[ "VMS->splitpath('0/0/0')", ',[.0.0],0' ], +[ "VMS->splitpath('/0/0')", '0:,[000000],0' ], +[ "VMS->splitpath('/0/0/0')", '0:,[0],0' ], +[ "VMS->splitpath('d1',1)", ',d1,' ], +# $no_file tests +[ "VMS->splitpath('[d1.d2.d3]',1)", ',[d1.d2.d3],' ], +[ "VMS->splitpath('[.d1.d2.d3]',1)", ',[.d1.d2.d3],' ], +[ "VMS->splitpath('d1/d2/d3',1)", ',[.d1.d2.d3],' ], +[ "VMS->splitpath('/d1/d2/d3',1)", 'd1:,[d2.d3],' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]',1)", 'node::volume:,[d1.d2.d3],' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]',1)", 'node"access_spec"::volume:,[d1.d2.d3],' ], +[ "VMS->splitpath('[]',1)", ',[],' ], +[ "VMS->splitpath('[-]',1)", ',[-],' ], +[ "VMS->splitpath('',1)", ',,' ], +[ "VMS->splitpath('0',1)", ',0,' ], +[ "VMS->splitpath('[0]',1)", ',[0],' ], +[ "VMS->splitpath('[.0]',1)", ',[.0],' ], +[ "VMS->splitpath('[0.0.0]',1)", ',[0.0.0],' ], +[ "VMS->splitpath('[.0.0.0]',1)", ',[.0.0.0],' ], +[ "VMS->splitpath('0/0',1)", ',[.0.0],' ], +[ "VMS->splitpath('0/0/0',1)", ',[.0.0.0],' ], +[ "VMS->splitpath('/0/0',1)", '0:,[000000.0],' ], +[ "VMS->splitpath('/0/0/0',1)", '0:,[0.0],' ], + [ "VMS->catpath('','','file')", 'file' ], [ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ], [ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ], -- 2.7.4