This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade PathTools to 3.28_01
authorNicholas Clark <nick@ccl4.org>
Sun, 19 Oct 2008 10:23:11 +0000 (10:23 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 19 Oct 2008 10:23:11 +0000 (10:23 +0000)
p4raw-id: //depot/perl@34514

12 files changed:
ext/Cwd/t/win32.t
lib/Cwd.pm
lib/File/Spec.pm
lib/File/Spec/Cygwin.pm
lib/File/Spec/Epoc.pm
lib/File/Spec/Functions.pm
lib/File/Spec/Mac.pm
lib/File/Spec/OS2.pm
lib/File/Spec/Unix.pm
lib/File/Spec/VMS.pm
lib/File/Spec/Win32.pm
lib/File/Spec/t/Spec.t

index f4945f6..2934c81 100644 (file)
@@ -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' );
+
index b93c003..f00072b 100644 (file)
@@ -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);
index 53d4a5a..b4bcaeb 100644 (file)
@@ -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',
index 1b2c045..89444f9 100644 (file)
@@ -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;
 
index 1e0ad18..57d2ec2 100644 (file)
@@ -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);
index ab335e1..a695763 100644 (file)
@@ -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;
 
index 97fa676..fdf3528 100644 (file)
@@ -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);
 
index 48d09fa..54dda3d 100644 (file)
@@ -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);
 
index e8dbaa9..57b83c6 100644 (file)
@@ -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
 
index 747a89d..f68927d 100644 (file)
@@ -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/) {
index 9b90340..4df45f6 100644 (file)
@@ -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
 
index 83c22a6..6150bc3 100644 (file)
@@ -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]'                              ],