Re: File/Spec/t/rel2abs2rel2whatever broken again

[p5sagit/p5-mst-13.2.git] / lib / File / Spec / VMS.pm

diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index e51286b..f21ff5e 100644 (file)
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -156,9 +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
-      $path =~ s/([^-]+)\.000000([\]\>])/$1$2/;         # foo.000000]     ==> foo]
       1 while $path =~ s{([\[<-])\.-}{$1-};             # [.-.-           ==> [--
       $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
       $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
@@ -269,12 +269,23 @@ from the following list or '' if none are writable:
     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;