Front page | perl.perl5.porters |
Postings from March 2000
[PATCH RC1]Remove extra File::Spec::VMS funs, tweak t/lib/filespec.t
From:
Barrie Slaymaker
Date:
March 10, 2000 10:47
Subject:
[PATCH RC1]Remove extra File::Spec::VMS funs, tweak t/lib/filespec.t
Message ID:
200003101847.NAA03703@jester.slaysys.com
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" ;
}
-
[PATCH RC1]Remove extra File::Spec::VMS funs, tweak t/lib/filespec.t
by Barrie Slaymaker