From d7bc03f01f7e3506a9d9bfd0b13c189fd76b4aa6 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sat, 11 Mar 2000 16:59:48 +0000 Subject: [PATCH] File::Spec::VMS fixups, *not tested* on VMS (from Barrie Slaymaker) p4raw-id: //depot/perl@5653 --- lib/File/Spec/VMS.pm | 122 ++------------------------------------------------- t/lib/filespec.t | 13 +++--- 2 files changed, 12 insertions(+), 123 deletions(-) diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index aecaada..d3f6018 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -133,21 +133,17 @@ Removes redundant portions of file specifications according to VMS syntax =cut sub canonpath { - my($self,$path,$reduce_ricochet) = @_; + my($self,$path) = @_; if ($path =~ m|/|) { # Fake Unix my $pathify = $path =~ m|/\z|; - $path = $self->SUPER::canonpath($path,$reduce_ricochet); + $path = $self->SUPER::canonpath($path); if ($pathify) { return vmspath($path); } else { return vmsify($path); } } else { - $path =~ s-\]\[--g; $path =~ s/> foo.bar - $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo - if ($reduce_ricochet) { - $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/g; - $path =~ s/([\[<\.])([^\[<\.]+)\.-\.?/$1/g; - } + $path =~ s-\]\[--g; $path =~ s/> foo.bar + $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo return $path; } } @@ -357,116 +353,6 @@ sub catpath { "$dev$dir$file"; } -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a VMS path in to volume, directory, and filename portions. -Ignores $no_file, if present, since VMS paths indicate the 'fileness' of a -file. - -The results can be passed to L to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my $self = shift ; - my ($path, $nofile) = @_; - - my ($volume,$directory,$file) ; - - if ( $path =~ m{/} ) { - $path =~ - m{^ ( (?: /[^/]* )? ) - ( (?: .*/(?:[^/]+\.dir)? )? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - $file = $3; - } - else { - $path =~ - m{^ ( (?: (?: (?: [\w\$-]+ (?: "[^"]*")?:: )? [\w\$-]+: )? ) ) - ( (?:\[.*\])? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - $directory = $1 - if $directory =~ /^\[(.*)\]\z/s ; - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path. - -'[' and ']' delimiters are optional. An empty string argument is -equivalent to '[]': both return an array with no elements. - -=cut - -sub splitdir { - my $self = shift ; - my $directories = $_[0] ; - - return File::Spec::Unix::splitdir( $self, @_ ) - if ( $directories =~ m{/} ) ; - - $directories =~ s/^\[(.*)\]\z/$1/s ; - - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m{\.\z} ) { - return split( m{\.}, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m{\.}, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -sub catpath { - my $self = shift; - - return File::Spec::Unix::catpath( $self, @_ ) - if ( join( '', @_ ) =~ m{/} ) ; - - my ($volume,$directory,$file) = @_; - - $volume .= ':' - if $volume =~ /[^:]\z/ ; - - $directory = "[$directory" - if $directory =~ /^[^\[]/s ; - - $directory .= ']' - if $directory =~ /[^\]]\z/ ; - - return "$volume$directory$file" ; -} - sub abs2rel { my $self = shift; diff --git a/t/lib/filespec.t b/t/lib/filespec.t index aba0688..e44648a 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -207,7 +207,6 @@ BEGIN { [ "VMS->canonpath('')", '' ], [ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], [ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d1.-.d2.d3.d4.-]' ], -[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]',1)", 'volume:[d2.d3]' ], [ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", 'volume:[d1]d2.dir;1' ], [ "VMS->splitdir('')", '' ], @@ -313,14 +312,17 @@ eval { require VMS::Filespec ; } ; +my $skip_exception = "Install VMS::Filespec (from vms/ext)" ; + if ( $@ ) { # Not pretty, but it allows testing of things not implemented soley # on VMS. It might be better to change File::Spec::VMS to do this, # making it more usable when running on (say) Unix but working with # VMS paths. eval qq- - sub File::Spec::VMS::unixify { die "Install VMS::Filespec (from vms/ext)" } ; - sub File::Spec::VMS::vmspath { die "Install VMS::Filespec (from vms/ext)" } ; + sub File::Spec::VMS::vmsify { die "$skip_exception" } + sub File::Spec::VMS::unixify { die "$skip_exception" } + sub File::Spec::VMS::vmspath { die "$skip_exception" } - ; $INC{"VMS/Filespec.pm"} = 1 ; } @@ -366,8 +368,9 @@ sub tryfunc { } if ( $@ ) { - if ( $@ =~ /only provided on VMS/ ) { - print "ok $current_test # skip $function \n" ; + if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) { + chomp $@ ; + print "ok $current_test # skip $function: $@\n" ; } else { chomp $@ ; -- 2.7.4