File::Spec::VMS update

From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <412FC8ED.1020300@mac.com>

p4raw-id: //depot/perl@23241

2 files changed, 78 insertions, 14 deletions

diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index 362cdaa2a8..82d639f3f1 100644
--- 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 899d8dc895..0ceb81cee1 100644
--- 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]'         ],