Re: File/Spec/t/rel2abs2rel2whatever broken again
[p5sagit/p5-mst-13.2.git] / lib / File / Spec / VMS.pm
index ec20289..f21ff5e 100644 (file)
@@ -3,9 +3,10 @@ package File::Spec::VMS;
 use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
-@ISA = qw(File::Spec::Unix);
 
-$VERSION = 1.0;
+$VERSION = '1.2';
+
+@ISA = qw(File::Spec::Unix);
 
 use Cwd;
 use File::Basename;
@@ -25,7 +26,7 @@ See File::Spec::Unix for a documentation of the methods provided
 there. This package overrides the implementation of these methods, not
 the semantics.
 
-=over
+=over 4
 
 =item eliminate_macros
 
@@ -39,6 +40,11 @@ sub eliminate_macros {
     my($self,$path) = @_;
     return '' unless $path;
     $self = {} unless ref $self;
+
+    if ($path =~ /\s/) {
+      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+    }
+
     my($npath) = unixify($path);
     my($complex) = 0;
     my($head,$macro,$tail);
@@ -88,6 +94,12 @@ sub fixpath {
     $self = bless {} unless ref $self;
     my($fixedpath,$prefix,$name);
 
+    if ($path =~ /\s/) {
+      return join ' ',
+             map { $self->fixpath($_,$force_path) }
+            split /\s+/, $path;
+    }
+
     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
             $fixedpath = vmspath($self->eliminate_macros($path));
@@ -126,7 +138,7 @@ sub fixpath {
 
 =head2 Methods always loaded
 
-=over
+=over 4
 
 =item canonpath (override)
 
@@ -144,8 +156,9 @@ 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/><//g;            # foo.][bar       ==> foo.bar
-      $path =~ s/([\[<])000000\./$1/;                   # [000000.foo     ==> foo
       1 while $path =~ s{([\[<-])\.-}{$1-};             # [.-.-           ==> [--
       $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
       $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
@@ -253,15 +266,26 @@ sub rootdir {
 Returns a string representation of the first writable directory
 from the following list or '' if none are writable:
 
-    sys$scratch
+    sys$scratch:
     $ENV{TMPDIR}
 
+Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+is tainted, it is not used.
+
 =cut
 
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    foreach ('sys$scratch', $ENV{TMPDIR}) {
+    my @dirlist = ('sys$scratch:', $ENV{TMPDIR});
+    {
+       no strict 'refs';
+       if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
+            require Scalar::Util;
+           pop @dirlist if Scalar::Util::tainted($ENV{TMPDIR});
+       }
+    }
+    foreach (@dirlist) {
        next unless defined && -d && -w _;
        $tmpdir = $_;
        last;
@@ -393,6 +417,7 @@ sub abs2rel {
     # Figure out the effective $base and clean it up.
     if ( !defined( $base ) || $base eq '' ) {
         $base = cwd() ;
+        $base = $self->canonpath( $base ) ;
     }
     elsif ( ! $self->file_name_is_absolute( $base ) ) {
         $base = $self->rel2abs( $base ) ;
@@ -415,7 +440,9 @@ sub abs2rel {
 
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_directories );
+    unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
     my @basechunks = $self->splitdir( $base_directories );
+    unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
 
     while ( @pathchunks && 
             @basechunks && 
@@ -439,7 +466,7 @@ Use VMS syntax when converting filespecs.
 
 =cut
 
-sub rel2abs($$;$;) {
+sub rel2abs {
     my $self = shift ;
     return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
         if ( join( '', @_ ) =~ m{/} ) ;