File::Spec::Unix->tmpdir: Always return an absolute path

This is generally a non-issue, however, if /tmp doesn't exist
and $ENV{TMPDIR} isn't set, ->tmpdir() used to return ".", which
broke the following pattern:

    use File::Temp qw(tempdir);
    use File::Spec;
    my $tmpdir = tempdir(CLEANUP => 1);
    chdir $tmpdir;
    my $file = File::Spec->catfile($tmpdir, "foo");
    open my $fh, ">", $file or die $!;

Because $tmpdir would be something like 'bfhskjf94589', and after
the chdir, the open() would've tried to open $tmpdir/$tmpdir/foo.

Note that this is only the case when not running in taint mode.  If taint
is enabled, ->tmpdir will still return '.'; this mirrors the behavior of
File::Temp.

diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm
index d9de63c..b9f74e0 100644 (file)
--- a/dist/PathTools/Cwd.pm
+++ b/dist/PathTools/Cwd.pm
@@ -171,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 

diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm
index 59a6ce6..c37924f 100644 (file)
--- a/dist/PathTools/lib/File/Spec.pm
+++ b/dist/PathTools/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 $VERSION =~ tr/_//;
 
 my %module = (MacOS   => 'Mac',

diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm
index c646382..d232e0d 100644 (file)
--- a/dist/PathTools/lib/File/Spec/Cygwin.pm
+++ b/dist/PathTools/lib/File/Spec/Cygwin.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm
index e7c95bb..3a5796d 100644 (file)
--- a/dist/PathTools/lib/File/Spec/Epoc.pm
+++ b/dist/PathTools/lib/File/Spec/Epoc.pm
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 $VERSION =~ tr/_//;
 
 require File::Spec::Unix;

diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm
index ba434e8..3de4544 100644 (file)
--- a/dist/PathTools/lib/File/Spec/OS2.pm
+++ b/dist/PathTools/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm
index 868b6a7..270a1fe 100644 (file)
--- a/dist/PathTools/lib/File/Spec/Unix.pm
+++ b/dist/PathTools/lib/File/Spec/Unix.pm
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 
@@ -176,16 +176,15 @@ sub _cached_tmpdir {
 sub _tmpdir {
     my $self = shift;
     my @dirlist = @_;
-    {
-       no strict 'refs';
-       if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
-            require Scalar::Util;
-           @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
-       }
-       elsif ($] < 5.007) { # No ${^TAINT} before 5.8
-           @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist;
-       }
+    my $taint = do { no strict 'refs'; ${"\cTAINT"} };
+    if ($taint) { # Check for taint mode on perl >= 5.8.0
+       require Scalar::Util;
+       @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
+    }
+    elsif ($] < 5.007) { # No ${^TAINT} before 5.8
+       @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist;
     }
+    
     foreach (@dirlist) {
        next unless defined && -d && -w _;
        $tmpdir = $_;
@@ -193,6 +192,16 @@ sub _tmpdir {
     }
     $tmpdir = $self->curdir unless defined $tmpdir;
     $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
+    if ( $tmpdir eq '.' ) {
+        # See [perl #120593] for the full details
+        # If possible, return a full path, rather than '.', but
+        # we have to avoid returning a tainted value, so we jump
+        # through some hoops.
+        ($tmpdir) = grep {
+            $taint     ? ! Scalar::Util::tainted($_) :
+            $] < 5.007 ? eval { eval('1'.substr $_,0,0) } : 1
+        } $self->rel2abs($tmpdir), $tmpdir;
+    }
     return $tmpdir;
 }
 

diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm
index aae0bfc..1fd1a47 100644 (file)
--- a/dist/PathTools/lib/File/Spec/VMS.pm
+++ b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.45';
+$VERSION = '3.45_01';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/t/tmpdir.t b/dist/PathTools/t/tmpdir.t
index 7c13da1..0f03dc5 100644 (file)
--- a/dist/PathTools/t/tmpdir.t
+++ b/dist/PathTools/t/tmpdir.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 7;
+use Test::More tests => 8;
 
 # Grab all of the plain routines from File::Spec
 use File::Spec;
@@ -46,3 +46,8 @@ for ('File::Spec', "File::Spec::Win32") {
     isn't $tmpdir2, $tmpdir1, "$_->tmpdir works with changing env";
   }
 }
+
+ok(
+    File::Spec->file_name_is_absolute(File::Spec->tmpdir()),
+    "tmpdir() always returns an absolute path"
+);