Re: File/Spec/t/rel2abs2rel2whatever broken again

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

diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index 519fb86..c2e463b 100644 (file)
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -47,13 +47,24 @@ from the following list:
     /tmp
     /
 
+Since perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
 =cut
 
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
     my $self = shift;
-    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
+    my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /));
+    {
+       no strict 'refs';
+       if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
+           require Scalar::Util;
+           @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
+       }
+    }
+    foreach (@dirlist) {
        next unless defined && -d;
        $tmpdir = $_;
        last;
@@ -106,11 +117,11 @@ sub canonpath {
     my ($self,$path) = @_;
     $path =~ s/^([a-z]:)/\u$1/s;
     $path =~ s|/|\\|g;
-    $path =~ s|([^\\])\\+|$1\\|g;                  # xx////xx  -> xx/xx
-    $path =~ s|(\\\.)+\\|\\|g;                     # xx/././xx -> xx/xx
-    $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # ./xx      -> xx
+    $path =~ s|([^\\])\\+|$1\\|g;                  # xx\\\\xx  -> xx\xx
+    $path =~ s|(\\\.)+\\|\\|g;                     # xx\.\.\xx -> xx\xx
+    $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # .\xx      -> xx
     $path =~ s|\\\Z(?!\n)||
-             unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx/       -> xx
+             unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx\       -> xx
     return $path;
 }
 
@@ -266,7 +277,7 @@ sub abs2rel {
     }
 
     # Split up paths
-    my ( $path_volume, $path_directories, $path_file ) =
+    my ( undef, $path_directories, $path_file ) =
         $self->splitpath( $path, 1 ) ;
 
     my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
@@ -304,11 +315,8 @@ sub abs2rel {
         $path_directories = "$base_directories$path_directories" ;
     }
 
-    # It makes no sense to add a relative path to a UNC volume
-    $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
-
     return $self->canonpath( 
-        $self->catpath($path_volume, $path_directories, $path_file ) 
+        $self->catpath( "", $path_directories, $path_file ) 
     ) ;
 }