From: Craig A. Berry Date: Fri, 27 Aug 2004 18:51:09 +0000 (-0500) Subject: File::Spec::VMS update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bdc74e5c2734b34a8c5fa5e12c27531128646d22;p=p5sagit%2Fp5-mst-13.2.git File::Spec::VMS update From: "Craig A. Berry" Message-ID: <412FC8ED.1020300@mac.com> p4raw-id: //depot/perl@23241 --- diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 362cdaa..82d639f 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/> 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 --- 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]' ],