develooper 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" ;
 }
 
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About