projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: 961f29c)
File::Spec::VMS update
Craig A. Berry [Fri, 27 Aug 2004 18:51:09 +0000 (13:51 -0500)]
From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <412FC8ED.1020300@mac.com>

p4raw-id: //depot/perl@23241

lib/File/Spec/VMS.pm patch | blob | blame | history
lib/File/Spec/t/Spec.t patch | blob | blame | history

diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index 362cdaa..82d639f 100644 (file)
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -155,16 +155,36 @@ sub canonpath {
       else          { return vmsify($path);  }
     }
     else {
-      $path =~ s/([\[<])000000\./$1/g;                  # [000000.foo     ==> [foo
-      $path =~ s/([^-]+)\.(\]\[|><)?000000([\]\>])/$1$3/g;  # foo.000000] ==> foo]
-      $path =~ s-\]\[--g;  $path =~ s/><//g;            # foo.][bar       ==> foo.bar
-      1 while $path =~ s{([\[<-])\.-}{$1-};             # [.-.-           ==> [--
-      $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
-      $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
-      $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g;    # bar.-.foo       ==> foo
-      $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
-      $path =~ s/^[\[<\]>]{2}//;                        # []foo           ==> foo
-      return $path;
+       $path =~ tr/<>/[]/;                     # < and >       ==> [ and ]
+       $path =~ s/\]\[\./\.\]\[/g;             # ][.           ==> .][
+       $path =~ s/\[000000\.\]\[/\[/g;         # [000000.][    ==> [
+       $path =~ s/\[000000\./\[/g;             # [000000.      ==> [
+       $path =~ s/\.\]\[000000\]/\]/g;         # .][000000]    ==> ]
+       $path =~ s/\.\]\[/\./g;                 # foo.][bar     ==> foo.bar
+       1 while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
+                                               # That loop does the following
+                                               # with any amount of dashes:
+                                               # .-.-.         ==> .--.
+                                               # [-.-.         ==> [--.
+                                               # .-.-]         ==> .--]
+                                               # [-.-]         ==> [--]
+       1 while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+                                               # That loop does the following
+                                               # with any amount (minimum 2)
+                                               # of dashes:
+                                               # .foo.--.      ==> .-.
+                                               # .foo.--]      ==> .-]
+                                               # [foo.--.      ==> [-.
+                                               # [foo.--]      ==> [-]
+                                               #
+                                               # And then, the remaining cases
+       $path =~ s/\[\.-/[-/;                   # [.-           ==> [-
+       $path =~ s/\.[^\]\.]+\.-\./\./g;        # .foo.-.       ==> .
+       $path =~ s/\[[^\]\.]+\.-\./\[/g;        # [foo.-.       ==> [
+       $path =~ s/\.[^\]\.]+\.-\]/\]/g;        # .foo.-]       ==> ]
+       $path =~ s/\[[^\]\.]+\.-\]/\[\]/g;      # [foo.-]       ==> []
+       $path =~ s/\[\]//;                      # []            ==>
+       return $path;
     }
 }
 
@@ -351,7 +371,19 @@ Split dirspec using VMS syntax.
 
 sub splitdir {
     my($self,$dirspec) = @_;
-    $dirspec =~ s/\]\[//g;  $dirspec =~ s/\-\-/-.-/g;
+    $dirspec =~ tr/<>/[]/;                     # < and >       ==> [ and ]
+    $dirspec =~ s/\]\[\./\.\]\[/g;             # ][.           ==> .][
+    $dirspec =~ s/\[000000\.\]\[/\[/g;         # [000000.][    ==> [
+    $dirspec =~ s/\[000000\./\[/g;             # [000000.      ==> [
+    $dirspec =~ s/\.\]\[000000\]/\]/g;         # .][000000]    ==> ]
+    $dirspec =~ s/\.\]\[/\./g;                 # foo.][bar     ==> foo.bar
+    while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
+                                               # That loop does the following
+                                               # with any amount of dashes:
+                                               # .--.          ==> .-.-.
+                                               # [--.          ==> [-.-.
+                                               # .--]          ==> .-.-]
+                                               # [--]          ==> [-.-]
     $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
     my(@dirs) = split('\.', vmspath($dirspec));
     $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
@@ -443,10 +475,10 @@ Use VMS syntax when converting filespecs.
 
 sub rel2abs {
     my $self = shift ;
-    return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
-        if ( join( '', @_ ) =~ m{/} ) ;
-
     my ($path,$base ) = @_;
+    return undef unless defined $path;
+    $path = vmsify($path) if $path =~ m/\//;
+    $base = vmspath($base) if defined $base && $base =~ m/\//;
     # Clean up and split up $path
     if ( ! $self->file_name_is_absolute( $path ) ) {
         # Figure out the effective $base and clean it up.
diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t
index 899d8dc..0ceb81c 100644 (file)
--- a/lib/File/Spec/t/Spec.t
+++ b/lib/File/Spec/t/Spec.t
@@ -296,6 +296,32 @@ if ($^O eq 'MacOS') {
 [ "VMS->canonpath('volume:[d1]file')",                     'volume:[d1]file'         ],
 [ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d2.d3]'          ],
 [ "VMS->canonpath('volume:[000000.d1]d2.dir;1')",                 'volume:[d1]d2.dir;1'   ],
+[ "VMS->canonpath('volume:[d1.d2.d3]file.txt')",       'volume:[d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3]file.txt')",              '[d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[-.d1.d2.d3]file.txt')",     'volume:[-.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[-.d1.d2.d3]file.txt')",            '[-.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[--.d1.d2.d3]file.txt')",    'volume:[--.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[--.d1.d2.d3]file.txt')",           '[--.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.-.d2.d3]file.txt')",     'volume:[d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.-.d2.d3]file.txt')",            '[d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.--.d2.d3]file.txt')",    'volume:[-.d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.--.d2.d3]file.txt')",           '[-.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.-.d3]file.txt')",     'volume:[d1.d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.-.d3]file.txt')",            '[d1.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.--.d3]file.txt')",    'volume:[d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.--.d3]file.txt')",           '[d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.d3.-]file.txt')",     'volume:[d1.d2]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3.-]file.txt')",            '[d1.d2]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.d3.--]file.txt')",    'volume:[d1]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3.--]file.txt')",           '[d1]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--]file.txt')",     'volume:[d1]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d3.--]file.txt')",            '[d1]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d2.000000]file.txt')", 'volume:[d1.000000.d2.000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d2.000000]file.txt')",        '[d1.000000.d2.000000]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--.000000]file.txt')",'volume:[d1.000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d3.--.000000]file.txt')",     '[d1.000000]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][-.-.000000]file.txt')",        'volume:[000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][--.-.000000]file.txt')",      '[-.000000]file.txt' ],
 
 [ "VMS->splitdir('')",            ''          ],
 [ "VMS->splitdir('[]')",          ''          ],
@@ -305,6 +331,12 @@ if ($^O eq 'MacOS') {
 [ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ],
 [ "VMS->splitdir('.-.d2.d3')",    ',-,d2,d3'  ],
 [ "VMS->splitdir('[.-.d2.d3]')",  ',-,d2,d3'  ],
+[ "VMS->splitdir('[d1.d2]')",                  'd1,d2'  ],
+[ "VMS->splitdir('[d1-.--d2]')",       'd1-,--d2'  ],
+[ "VMS->splitdir('[d1---.-.d2]')",     'd1---,-,d2'  ],
+[ "VMS->splitdir('[d1.---.d2]')",      'd1,-,-,-,d2'  ],
+[ "VMS->splitdir('[d1---d2]')",        'd1---d2'  ],
+[ "VMS->splitdir('[d1.][000000.d2]')",  'd1,d2'  ],
 
 [ "VMS->catdir('')",                                                      ''                 ],
 [ "VMS->catdir('d1','d2','d3')",                                          '[.d1.d2.d3]'         ],
Unnamed repository; edit this file to name it for gitweb.