Looks like change 5290 introduced some duplicate subs in to File::Spec::VMS: http://slaysys.com/saf_dev/perl/t/-/depot/perl/lib/File/Spec/VMS.pm?other_rev=%404000&file_mode=Blame#L317 This patch removes the older ones (my attempts), since the newer ones are definite improvements. http://slaysys.com/sav_dev/perl/t/-/depot/perl/lib/File/Spec/VMS.pm?other_rev=%404000&file_mode=Blame#L360 Also, I missed getting rid of $reduce ricochet in VMS.pm, this patch gets rid of it and a corresponding test vector. t/lib/filespec.t grumbles about these a bit and needed a tweak or two besides in order to skip the tests using the newer routines on VMS. THIS PATCH MUST BE TESTED ON VMS since I can't test out the new routines here and the test suite was testing the old routines. Thanks, Barrie --- perl-5.6.0-RC1/t/lib/filespec.t Fri Mar 10 13:41:33 2000 +++ File-Spec/t/lib/filespec.t Fri Mar 10 13:42:27 2000 @@ -207,7 +207,6 @@ [ "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 @@ 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 @@ } if ( $@ ) { - if ( $@ =~ /only provided on VMS/ ) { - print "ok $current_test # skip $function \n" ; + if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) { + chomp $@ ; + print "not ok $current_test # skip $function: $@\n" ; } else { chomp $@ ; --- perl-5.6.0-RC1/lib/File/Spec/VMS.pm Fri Mar 10 13:41:59 2000 +++ File-Spec/lib/File/Spec/VMS.pm Fri Mar 10 12:56:00 2000 @@ -133,21 +133,17 @@ =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/><//g; # foo.][bar ==> 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/><//g; # foo.][bar ==> foo.bar + $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo return $path; } } @@ -355,116 +351,6 @@ else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; } $dir = vmspath($dir); "$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</catpath()> 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</catdir()>. - - @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" ; }
