From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 14 Mar 2003 13:42:32 +0000 (+0000)
Subject: Cleanup the File::Spec tmpdir() implementations:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=07824bd1cfb16e641e5040a9a4e23799f5535a53;p=p5sagit%2Fp5-mst-13.2.git

Cleanup the File::Spec tmpdir() implementations:
now all the platforms specific modules call _tmpdir()
(inherited from Unix.pm) with the list of platform
specific list of temporary directories, and _tmpdir()
then does the appropriate suitability checking.

p4raw-id: //depot/perl@18980
---

diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index e8b4080..d3a2987 100644
--- a/lib/File/Spec.pm
+++ b/lib/File/Spec.pm
@@ -1,9 +1,9 @@
 package File::Spec;
 
 use strict;
-our(@ISA, $VERSION);
+use vars qw(@ISA $VERSION);
 
-$VERSION = 0.83 ;
+$VERSION = 0.84 ;
 
 my %module = (MacOS   => 'Mac',
 	      MSWin32 => 'Win32',
@@ -125,10 +125,10 @@ Returns a string representation of the root directory.
 =item tmpdir
 
 Returns a string representation of the first writable directory from a
-list of possible temporary directories.  Returns "" if no writable
-temporary directories are found.  The list of directories checked
-depends on the platform; e.g. File::Spec::Unix checks $ENV{TMPDIR} and
-/tmp.
+list of possible temporary directories.  Returns the current directory
+if no writable temporary directories are found.  The list of directories
+checked depends on the platform; e.g. File::Spec::Unix checks $ENV{TMPDIR}
+(unless taint is on) and /tmp.
 
     $tmpdir = File::Spec->tmpdir();
 
diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm
index fcc8331..eaf1203 100644
--- a/lib/File/Spec/Cygwin.pm
+++ b/lib/File/Spec/Cygwin.pm
@@ -1,3 +1,4 @@
+
 package File::Spec::Cygwin;
 
 use strict;
@@ -8,54 +9,75 @@ $VERSION = '1.0';
 
 @ISA = qw(File::Spec::Unix);
 
+=head1 NAME
+
+File::Spec::Cygwin - methods for Cygwin file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Cygwin; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See File::Spec::Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+This module is still in beta.  Cygwin-knowledgeable folks are invited
+to offer patches and suggestions.
+
+=cut
+
+=pod
+
+=item canonpath
+
+Any C<\> (backslashes) are converted to C</> (forward slashes),
+and then File::Spec::Unix canonpath() is called on the result.
+
+=cut
+
 sub canonpath {
     my($self,$path) = @_;
     $path =~ s|\\|/|g;
     return $self->SUPER::canonpath($path);
 }
 
+=pod
+
+=item file_name_is_absolute
+
+True is returned if the file name begins with C<drive_letter:>,
+and if not, File::Spec::Unix file_name_is_absolute() is called.
+
+=cut
+
+
 sub file_name_is_absolute {
     my ($self,$file) = @_;
     return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
     return $self->SUPER::file_name_is_absolute($file);
 }
 
-my $tmpdir;
-sub tmpdir {
-    return $tmpdir if defined $tmpdir;
-    my @dirlist = ($ENV{TMPDIR}, "/tmp", 'C:/temp');
-    {
-	no strict 'refs';
-	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
-            require Scalar::Util;
-	    shift @dirlist if Scalar::Util::tainted($ENV{TMPDIR});
-	}
-    }
-    foreach (@dirlist) {
-	next unless defined && -d && -w _;
-	$tmpdir = $_;
-	last;
-    }
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
-    return $tmpdir;
-}
+=item tmpdir (override)
 
-1;
-__END__
-
-=head1 NAME
+Returns a string representation of the first existing directory
+from the following list:
 
-File::Spec::Cygwin - methods for Cygwin file specs
+    $ENV{TMPDIR}
+    /tmp
+    C:/temp
 
-=head1 SYNOPSIS
+Since Perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
 
- require File::Spec::Cygwin; # Done internally by File::Spec if needed
+=cut
 
-=head1 DESCRIPTION
-
-See File::Spec::Unix for a documentation of the methods provided
-there. This package overrides the implementation of these methods, not
-the semantics.
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my $self = shift;
+    $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
+}
 
-This module is still in beta.  Cygwin-knowledgeable folks are invited
-to offer patches and suggestions.
+1;
diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm
index fc9c8ff..e3c90f0 100644
--- a/lib/File/Spec/Epoc.pm
+++ b/lib/File/Spec/Epoc.pm
@@ -1,10 +1,11 @@
 package File::Spec::Epoc;
 
-our $VERSION = '1.00';
-
 use strict;
 use Cwd;
-use vars qw(@ISA);
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.1';
+
 require File::Spec::Unix;
 @ISA = qw(File::Spec::Unix);
 
diff --git a/lib/File/Spec/Functions.pm b/lib/File/Spec/Functions.pm
index dad7aa3..1a8c2ae 100644
--- a/lib/File/Spec/Functions.pm
+++ b/lib/File/Spec/Functions.pm
@@ -3,9 +3,9 @@ package File::Spec::Functions;
 use File::Spec;
 use strict;
 
-our (@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS,$VERSION);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '1.2';
+$VERSION = '1.3';
 
 require Exporter;
 
diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm
index 2d71706..acf187e 100644
--- a/lib/File/Spec/Mac.pm
+++ b/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.3';
+$VERSION = '1.4';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -360,18 +360,18 @@ sub rootdir {
 
 =item tmpdir
 
-Returns the contents of $ENV{TMPDIR}, if that directory exits or the current working
-directory otherwise. Under MacPerl, $ENV{TMPDIR} will contain a path like
-"MacintoshHD:Temporary Items:", which is a hidden directory on your startup volume.
+Returns the contents of $ENV{TMPDIR}, if that directory exits or the
+current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
+contain a path like "MacintoshHD:Temporary Items:", which is a hidden
+directory on your startup volume.
 
 =cut
 
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
-    return $tmpdir;
+    my $self = shift;
+    $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
 }
 
 =item updir
diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm
index 810ef8c..9bd9381 100644
--- a/lib/File/Spec/OS2.pm
+++ b/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.1';
+$VERSION = '1.2';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -29,27 +29,31 @@ sub path {
     return @path;
 }
 
+=pod
+
+=item tmpdir
+
+Returns a string representation of the first existing directory
+from the following list:
+
+    $ENV{TMPDIR}
+    $ENV{TEMP}
+    $ENV{TMP}
+    /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;
-    my @dirlist = ( @ENV{qw(TMPDIR TEMP TMP)}, qw(/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;
-    }
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
-    $tmpdir =~ s:\\:/:g;
-    $tmpdir = $self->canonpath($tmpdir);
-    return $tmpdir;
+    $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+			      '/tmp',
+			      '/'  );
 }
 
 =item canonpath
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 705559f..3922f21 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -1,7 +1,7 @@
 package File::Spec::Unix;
 
 use strict;
-our($VERSION);
+use vars qw($VERSION);
 
 $VERSION = '1.4';
 
@@ -127,8 +127,9 @@ sub rootdir {
 
 =item tmpdir
 
-Returns a string representation of the first writable directory
-from the following list or "" if none are writable:
+Returns a string representation of the first writable directory from
+the following list or the current directory if none from the list are
+writable:
 
     $ENV{TMPDIR}
     /tmp
@@ -139,14 +140,15 @@ is tainted, it is not used.
 =cut
 
 my $tmpdir;
-sub tmpdir {
+sub _tmpdir {
     return $tmpdir if defined $tmpdir;
-    my @dirlist = ($ENV{TMPDIR}, "/tmp");
+    my $self = shift;
+    my @dirlist = @_;
     {
 	no strict 'refs';
 	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
             require Scalar::Util;
-	    shift @dirlist if Scalar::Util::tainted($ENV{TMPDIR});
+	    @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
 	}
     }
     foreach (@dirlist) {
@@ -154,10 +156,16 @@ sub tmpdir {
 	$tmpdir = $_;
 	last;
     }
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
+    $tmpdir = $self->curdir unless defined $tmpdir;
+    $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
     return $tmpdir;
 }
 
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = _tmpdir( $ENV{TMPDIR}, "/tmp" );
+}
+
 =item updir
 
 Returns a string representation of the parent directory.  ".." on UNIX.
diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index fab1953..70eb39b 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.2';
+$VERSION = '1.4';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -278,21 +278,8 @@ is tainted, it is not used.
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $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;
-    }
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
-    return $tmpdir;
+    my $self = shift;
+    $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
 }
 
 =item updir (override)
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index 1371edc..9e7bb39 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -2,10 +2,11 @@ package File::Spec::Win32;
 
 use strict;
 use Cwd;
+
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.3';
+$VERSION = '1.4';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -48,7 +49,8 @@ from the following list:
     /tmp
     /
 
-The SYS:/temp is preferred in Novell NetWare.
+The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
+is used also for NetWare).
 
 Since Perl 5.8.0, if running under taint mode, and if the environment
 variables are tainted, they are not used.
@@ -59,22 +61,11 @@ my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
     my $self = shift;
-    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;
-    }
-    $tmpdir = File::Spec->curdir unless defined $tmpdir;
-    $tmpdir = $self->canonpath($tmpdir);
-    return $tmpdir;
+    $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+			      'SYS:/temp',
+			      'C:/temp',
+			      '/tmp',
+			      '/'  );
 }
 
 sub case_tolerant {