charnames pragma extended with :alias for customized
[p5sagit/p5-mst-13.2.git] / lib / File / Temp.pm
index fd84744..6f351df 100644 (file)
@@ -9,7 +9,8 @@ File::Temp - return name and handle of a temporary file safely
 =head1 PORTABILITY
 
 This module is designed to be portable across operating systems
-and it currently supports Unix, VMS, DOS, OS/2 and Windows. When
+and it currently supports Unix, VMS, DOS, OS/2, Windows and
+Mac OS (Classic). When
 porting to a new OS there are generally three main issues
 that have to be solved:
 
@@ -17,7 +18,7 @@ that have to be solved:
 
 =item *
 
-Can the OS unlink an open file? If it can't then the
+Can the OS unlink an open file? If it can not then the
 C<_can_unlink_opened_file> method should be modified.
 
 =item *
@@ -40,7 +41,7 @@ The C<_can_do_level> method should be modified accordingly.
 
 =head1 SYNOPSIS
 
-  use File::Temp qw/ tempfile tempdir /; 
+  use File::Temp qw/ tempfile tempdir /;
 
   $dir = tempdir( CLEANUP => 1 );
   ($fh, $filename) = tempfile( DIR => $dir );
@@ -91,16 +92,16 @@ Objects (NOT YET IMPLEMENTED):
 
 C<File::Temp> can be used to create and open temporary files in a safe way.
 The tempfile() function can be used to return the name and the open
-filehandle of a temporary file.  The tempdir() function can 
+filehandle of a temporary file.  The tempdir() function can
 be used to create a temporary directory.
 
 The security aspect of temporary file creation is emphasized such that
-a filehandle and filename are returned together.  This helps guarantee that 
-a race condition can not occur where the temporary file is created by another process 
-between checking for the existence of the file and its
-opening.  Additional security levels are provided to check, for 
-example, that the sticky bit is set on world writable directories.
-See L<"safe_level"> for more information.
+a filehandle and filename are returned together.  This helps guarantee
+that a race condition can not occur where the temporary file is
+created by another process between checking for the existence of the
+file and its opening.  Additional security levels are provided to
+check, for example, that the sticky bit is set on world writable
+directories.  See L<"safe_level"> for more information.
 
 For compatibility with popular C library functions, Perl implementations of
 the mkstemp() family of functions are provided. These are, mkstemp(),
@@ -124,7 +125,7 @@ use Carp;
 use File::Spec 0.8;
 use File::Path qw/ rmtree /;
 use Fcntl 1.03;
-use Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
+use Errno;
 require VMS::Stdio if $^O eq 'VMS';
 
 # Need the Symbol package if we are running older perl
@@ -164,9 +165,9 @@ use base qw/Exporter/;
 # add contents of these tags to @EXPORT
 Exporter::export_tags('POSIX','mktemp');
 
-# Version number 
+# Version number
 
-$VERSION = '0.10';
+$VERSION = '0.13';
 
 # This is a list of characters that can be used in random filenames
 
@@ -197,10 +198,19 @@ use constant HIGH     => 2;
 
 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
 
-for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
-  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-  no strict 'refs';
-  $OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    no strict 'refs';
+    $OPENFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # eg CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
 }
 
 # On some systems the O_TEMPORARY flag can be used to tell the OS
@@ -211,13 +221,21 @@ for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
 # this by using a second open flags variable
 
 my $OPENTEMPFLAGS = $OPENFLAGS;
-for my $oflag (qw/ TEMPORARY /) {
-  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-  no strict 'refs';
-  $OPENTEMPFLAGS |= $bit if eval { $bit = &$func(); 1 };
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ TEMPORARY /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    no strict 'refs';
+    $OPENTEMPFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # eg CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
 }
 
-
 # INTERNAL ROUTINES - not to be used outside of package
 
 # Generic routine for getting a temporary filename
@@ -240,9 +258,13 @@ for my $oflag (qw/ TEMPORARY /) {
 #                  default is 0.
 #   "unlink_on_close" => indicates that, if possible,  the OS should remove
 #                        the file as soon as it is closed. Usually indicates
-#                        use of the O_TEMPORARY flag to sysopen. 
+#                        use of the O_TEMPORARY flag to sysopen.
 #                        Usually irrelevant on unix
 
+# Optionally a reference to a scalar can be passed into the function
+# On error this will be used to store the reason for the error
+#   "ErrStr"  => \$errstr
+
 # "open" and "mkdir" can not both be true
 # "unlink_on_close" is not used when "mkdir" is true.
 
@@ -256,30 +278,38 @@ for my $oflag (qw/ TEMPORARY /) {
 #   ($fh, $name) = _gettemp($template, "open" => 1);
 
 # for the current version, failures are associated with
-# a carp to give the reason whilst debugging
-
+# stored in an error string and returned to give the reason whilst debugging
+# This routine is not called by any external function
 sub _gettemp {
 
   croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
     unless scalar(@_) >= 1;
 
+  # the internal error string - expect it to be overridden
+  # Need this in case the caller decides not to supply us a value
+  # need an anonymous scalar
+  my $tempErrStr;
+
   # Default options
   my %options = (
                 "open" => 0,
                 "mkdir" => 0,
                 "suffixlen" => 0,
                 "unlink_on_close" => 0,
+                "ErrStr" => \$tempErrStr,
                );
 
   # Read the template
   my $template = shift;
   if (ref($template)) {
+    # Use a warning here since we have not yet merged ErrStr
     carp "File::Temp::_gettemp: template must not be a reference";
     return ();
   }
 
   # Check that the number of entries on stack are even
   if (scalar(@_) % 2 != 0) {
+    # Use a warning here since we have not yet merged ErrStr
     carp "File::Temp::_gettemp: Must have even number of options";
     return ();
   }
@@ -287,9 +317,12 @@ sub _gettemp {
   # Read the options and merge with defaults
   %options = (%options, @_)  if @_;
 
+  # Make sure the error string is set to undef
+  ${$options{ErrStr}} = undef;
+
   # Can not open the file and make a directory in a single call
   if ($options{"open"} && $options{"mkdir"}) {
-    carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n";
+    ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
     return ();
   }
 
@@ -304,7 +337,8 @@ sub _gettemp {
   # we know where we are looking and what we are looking for
 
   if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
-    carp "File::Temp::_gettemp: The template must contain at least ". MINX ." 'X' characters\n";
+    ${$options{ErrStr}} = "The template must contain at least ".
+      MINX . " 'X' characters\n";
     return ();
   }
 
@@ -332,14 +366,15 @@ sub _gettemp {
     # Split the directory and put it back together again
     my @dirs = File::Spec->splitdir($directories);
 
-    # If @dirs only has one entry that means we are in the current
-    # directory
+    # If @dirs only has one entry (i.e. the directory template) that means
+    # we are in the current directory
     if ($#dirs == 0) {
       $parent = File::Spec->curdir;
     } else {
 
       if ($^O eq 'VMS') {  # need volume to avoid relative dir spec
         $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
+        $parent = 'sys$disk:[]' if $parent eq '';
       } else {
 
        # Put it back together without the last one
@@ -365,29 +400,35 @@ sub _gettemp {
 
   }
 
-  # Check that the parent directories exist 
+  # Check that the parent directories exist
   # Do this even for the case where we are simply returning a name
   # not a file -- no point returning a name that includes a directory
   # that does not exist or is not writable
 
-  unless (-d $parent && -w _) {
-    carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory"
-      . " or is not writable\n";
+  unless (-d $parent) {
+    ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
+    return ();
+  }
+  unless (-w _) {
+    ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
       return ();
   }
 
+
   # Check the stickiness of the directory and chown giveaway if required
   # If the directory is world writable the sticky bit
   # must be set
 
   if (File::Temp->safe_level == MEDIUM) {
-    unless (_is_safe($parent)) {
-      carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+    my $safeerr;
+    unless (_is_safe($parent,\$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
       return ();
     }
   } elsif (File::Temp->safe_level == HIGH) {
-    unless (_is_verysafe($parent)) {
-      carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+    my $safeerr;
+    unless (_is_verysafe($parent, \$safeerr)) {
+      ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
       return ();
     }
   }
@@ -408,7 +449,7 @@ sub _gettemp {
       # Try to make sure this will be marked close-on-exec
       # XXX: Win32 doesn't respect this, nor the proper fcntl,
       #      but may have O_NOINHERIT. This may or may not be in Fcntl.
-      local $^F = 2; 
+      local $^F = 2;
 
       # Store callers umask
       my $umask = umask();
@@ -431,24 +472,24 @@ sub _gettemp {
       if ( $open_success ) {
 
        # Reset umask
-       umask($umask);
-       
+       umask($umask) if defined $umask;
+
        # Opened successfully - return file handle and name
        return ($fh, $path);
 
       } else {
        # Reset umask
-       umask($umask);
+       umask($umask) if defined $umask;
 
        # Error opening file - abort with error
        # if the reason was anything but EEXIST
-       unless ($! == EEXIST) {
-         carp "File::Temp: Could not create temp file $path: $!";
+       unless ($!{EEXIST}) {
+         ${$options{ErrStr}} = "Could not create temp file $path: $!";
          return ();
        }
 
        # Loop round for another try
-       
+
       }
     } elsif ($options{"mkdir"}) {
 
@@ -462,18 +503,18 @@ sub _gettemp {
       if (mkdir( $path, 0700)) {
        # created okay
        # Reset umask
-       umask($umask);
+       umask($umask) if defined $umask;
 
        return undef, $path;
       } else {
 
        # Reset umask
-       umask($umask);
+       umask($umask) if defined $umask;
 
        # Abort with error if the reason for failure was anything
        # except EEXIST
-       unless ($! == EEXIST) {
-         carp "File::Temp: Could not create directory $path: $!";
+       unless ($!{EEXIST}) {
+         ${$options{ErrStr}} = "Could not create directory $path: $!";
          return ();
        }
 
@@ -518,15 +559,15 @@ sub _gettemp {
 
     # Check for out of control looping
     if ($counter > $MAX_GUESS) {
-      carp "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
+      ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
       return ();
     }
 
   }
 
   # If we get here, we have run out of tries
-  carp "Have exceeded the maximum number of attempts (".MAX_TRIES .
-    ") to open temp file/dir";
+  ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
+    . MAX_TRIES . ") to open temp file/dir";
 
   return ();
 
@@ -549,10 +590,10 @@ sub _randchar {
 }
 
 # Internal routine to replace the XXXX... with random characters
-# This has to be done by _gettemp() every time it fails to 
+# This has to be done by _gettemp() every time it fails to
 # open a temp file/dir
 
-# Arguments:  $template (the template with XXX), 
+# Arguments:  $template (the template with XXX),
 #             $ignore   (number of characters at end to ignore)
 
 # Returns:    modified template
@@ -587,6 +628,7 @@ sub _replace_XX {
 # Will not work on systems that do not support sticky bit
 
 #Args:  directory path to check
+#       Optionally: reference to scalar to contain error message
 # Returns true if the path is safe and false otherwise.
 # Returns undef if can not even run stat() on the path
 
@@ -599,17 +641,26 @@ sub _replace_XX {
 sub _is_safe {
 
   my $path = shift;
+  my $err_ref = shift;
 
   # Stat path
   my @info = stat($path);
-  return 0 unless scalar(@info);
+  unless (scalar(@info)) {
+    $$err_ref = "stat(path) returned no values";
+    return 0;
+  };
   return 1 if $^O eq 'VMS';  # owner delete control at file level
 
   # Check to see whether owner is neither superuser (or a system uid) nor me
   # Use the real uid from the $< variable
   # UID is in [4]
-  if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
-    carp "Directory owned neither by root nor the current user";
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+               File::Temp->top_system_uid());
+
+    $$err_ref = "Directory owned neither by root nor the current user"
+      if ref($err_ref);
     return 0;
   }
 
@@ -620,29 +671,44 @@ sub _is_safe {
   # mode is in info[2]
   if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
       ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
-    return 0 unless -d _;       # Must be a directory
-    return 0 unless -k _;       # Must be sticky
+    # Must be a directory
+    unless (-d _) {
+      $$err_ref = "Path ($path) is not a directory"
+      if ref($err_ref);
+      return 0;
+    }
+    # Must have sticky bit set
+    unless (-k _) {
+      $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
+       if ref($err_ref);
+      return 0;
+    }
   }
 
   return 1;
 }
 
 # Internal routine to check whether a directory is safe
-# for temp files. Safer than _is_safe since it checks for 
+# for temp files. Safer than _is_safe since it checks for
 # the possibility of chown giveaway and if that is a possibility
 # checks each directory in the path to see if it is safe (with _is_safe)
 
 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
 # directory anyway.
 
+# Takes optional second arg as scalar ref to error reason
+
 sub _is_verysafe {
 
   # Need POSIX - but only want to bother if really necessary due to overhead
   require POSIX;
 
   my $path = shift;
+  print "_is_verysafe testing $path\n" if $DEBUG;
   return 1 if $^O eq 'VMS';  # owner delete control at file level
 
+  my $err_ref = shift;
+
   # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
   # and If it is not there do the extensive test
   my $chown_restricted;
@@ -653,7 +719,7 @@ sub _is_verysafe {
   if (defined $chown_restricted) {
 
     # Return if the current directory is safe
-    return _is_safe($path) if POSIX::sysconf( $chown_restricted );
+    return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
 
   }
 
@@ -670,7 +736,7 @@ sub _is_verysafe {
   # Split directory into components - assume no file
   my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
 
-  # Slightly less efficient than having a a function in File::Spec
+  # Slightly less efficient than having a function in File::Spec
   # to chop off the end of a directory or even a function that
   # can handle ../ in a directory tree
   # Sometimes splitdir() returns a blank at the end
@@ -688,7 +754,7 @@ sub _is_verysafe {
     print "TESTING DIR $dir\n" if $DEBUG;
 
     # Check the directory
-    return 0 unless _is_safe($dir);
+    return 0 unless _is_safe($dir,$err_ref);
 
   }
 
@@ -708,7 +774,7 @@ sub _is_verysafe {
 
 sub _can_unlink_opened_file {
 
-  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos') {
+  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
     return 0;
   } else {
     return 1;
@@ -732,7 +798,7 @@ sub _can_do_level {
   return 1 if $level == STANDARD;
 
   # Currently, the systems that can do HIGH or MEDIUM are identical
-  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin') {
+  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS') {
     return 0;
   } else {
     return 1;
@@ -785,7 +851,6 @@ sub _can_do_level {
       }
     }
 
-
   }
 
   # This is the sub called to register a file for deferred unlinking
@@ -814,7 +879,7 @@ sub _can_do_level {
        push (@dirs_to_unlink, $fname);
 
       } else {
-       carp "Request to remove directory $fname could not be completed since it does not exist!\n";
+       carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
       }
 
     } else {
@@ -825,7 +890,7 @@ sub _can_do_level {
        push(@files_to_unlink, [$fh, $fname]);
 
       } else {
-       carp "Request to remove file $fname could not be completed since it is not there!\n";
+       carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
       }
 
     }
@@ -876,29 +941,32 @@ is specified.
 Return the filename and filehandle as before except that the file is
 automatically removed when the program exits. Default is for the file
 to be removed if a file handle is requested and to be kept if the
-filename is requested.
+filename is requested. In a scalar context (where no filename is
+returned) the file is always deleted either on exit or when it is closed.
 
 If the template is not specified, a template is always
 automatically generated. This temporary file is placed in tmpdir()
-(L<File::Spec>) unless a directory is specified explicitly with the 
+(L<File::Spec>) unless a directory is specified explicitly with the
 DIR option.
 
   $fh = tempfile( $template, DIR => $dir );
 
 If called in scalar context, only the filehandle is returned
-and the file will automatically be deleted when closed (see 
+and the file will automatically be deleted when closed (see
 the description of tmpfile() elsewhere in this document).
-This is the preferred mode of operation, as if you only 
+This is the preferred mode of operation, as if you only
 have a filehandle, you can never create a race condition
 by fumbling with the filename. On systems that can not unlink
-an open file (for example, Windows NT) the file is marked for
-deletion when the program ends (equivalent to setting UNLINK to 1).
+an open file or can not mark a file as temporary when it is opened
+(for example, Windows NT uses the C<O_TEMPORARY> flag))
+the file is marked for deletion when the program ends (equivalent
+to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
 
   (undef, $filename) = tempfile($template, OPEN => 0);
 
 This will return the filename based on the template but
 will not open this file.  Cannot be used in conjunction with
-UNLINK set to true. Default is to always open the file 
+UNLINK set to true. Default is to always open the file
 to protect from possible race conditions. A warning is issued
 if warnings are turned on. Consider using the tmpnam()
 and mktemp() functions described elsewhere in this document
@@ -973,19 +1041,34 @@ sub tempfile {
   # Now add a suffix
   $template .= $options{"SUFFIX"};
 
+  # Determine whether we should tell _gettemp to unlink the file
+  # On unix this is irrelevant and can be worked out after the file is
+  # opened (simply by unlinking the open filehandle). On Windows or VMS
+  # we have to indicate temporary-ness when we open the file. In general
+  # we only want a true temporary file if we are returning just the
+  # filehandle - if the user wants the filename they probably do not
+  # want the file to disappear as soon as they close it.
+  # For this reason, tie unlink_on_close to the return context regardless
+  # of OS.
+  my $unlink_on_close = ( wantarray ? 0 : 1);
+
   # Create the file
-  my ($fh, $path);
-  croak "Error in tempfile() using $template"
+  my ($fh, $path, $errstr);
+  croak "Error in tempfile() using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
                                    "open" => $options{'OPEN'},
                                    "mkdir"=> 0 ,
-                                   "unlink_on_close" => $options{'UNLINK'},
+                                    "unlink_on_close" => $unlink_on_close,
                                    "suffixlen" => length($options{'SUFFIX'}),
+                                   "ErrStr" => \$errstr,
                                   ) );
 
   # Set up an exit handler that can do whatever is right for the
-  # system. Do not check return status since this is all done with
-  # END blocks
+  # system. This removes files at exit when requested explicitly or when
+  # system is asked to unlink_on_close but is unable to do so because
+  # of OS limitations.
+  # The latter should be achieved by using a tied filehandle.
+  # Do not check return status since this is all done with END blocks.
   _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
 
   # Return
@@ -1040,7 +1123,7 @@ prepending the supplied directory.
 
   $tempdir = tempdir ( $template, TMPDIR => 1 );
 
-Using the supplied template, creat the temporary directory in 
+Using the supplied template, create the temporary directory in
 a standard location for temporary files. Equivalent to doing
 
   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
@@ -1052,7 +1135,7 @@ nor a directory are supplied.
 
   $tempdir = tempdir( $template, CLEANUP => 1);
 
-Create a temporary directory using the supplied template, but 
+Create a temporary directory using the supplied template, but
 attempt to remove it (and all files inside it) when the program
 exits. Note that an attempt will be made to remove all files from
 the directory even if they were not created by this module (otherwise
@@ -1103,7 +1186,7 @@ sub tempdir  {
       # Prepend the supplied directory or temp dir
       if ($options{"DIR"}) {
 
-       $template = File::Spec->catfile($options{"DIR"}, $template);
+        $template = File::Spec->catdir($options{"DIR"}, $template);
 
       } elsif ($options{TMPDIR}) {
 
@@ -1135,11 +1218,18 @@ sub tempdir  {
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
-  croak "Error in tempdir() using $template"
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
+
+  my $errstr;
+  croak "Error in tempdir() using $template: $errstr"
     unless ((undef, $tempdir) = _gettemp($template,
                                    "open" => 0,
                                    "mkdir"=> 1 ,
                                    "suffixlen" => $suffixlen,
+                                   "ErrStr" => \$errstr,
                                   ) );
 
   # Install exit handler; must be dynamic to get lexical
@@ -1156,7 +1246,7 @@ sub tempdir  {
 
 =head1 MKTEMP FUNCTIONS
 
-The following functions are Perl implementations of the 
+The following functions are Perl implementations of the
 mktemp() family of temp file generation system calls.
 
 =over 4
@@ -1185,12 +1275,13 @@ sub mkstemp {
 
   my $template = shift;
 
-  my ($fh, $path);
-  croak "Error in mkstemp using $template"
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemp using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
                                    "open" => 1,
                                    "mkdir"=> 0 ,
                                    "suffixlen" => 0,
+                                   "ErrStr" => \$errstr,
                                   ) );
 
   if (wantarray()) {
@@ -1227,12 +1318,13 @@ sub mkstemps {
 
   $template .= $suffix;
 
-  my ($fh, $path);
-  croak "Error in mkstemps using $template"
+  my ($fh, $path, $errstr);
+  croak "Error in mkstemps using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
-                                   "open" => 1, 
+                                   "open" => 1,
                                    "mkdir"=> 0 ,
                                    "suffixlen" => length($suffix),
+                                   "ErrStr" => \$errstr,
                                   ) );
 
   if (wantarray()) {
@@ -1270,12 +1362,17 @@ sub mkdtemp {
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
-  my ($junk, $tmpdir);
-  croak "Error creating temp directory from template $template\n"
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
+  my ($junk, $tmpdir, $errstr);
+  croak "Error creating temp directory from template $template\: $errstr"
     unless (($junk, $tmpdir) = _gettemp($template,
                                        "open" => 0,
                                        "mkdir"=> 1 ,
                                        "suffixlen" => $suffixlen,
+                                       "ErrStr" => \$errstr,
                                       ) );
 
   return $tmpdir;
@@ -1300,12 +1397,13 @@ sub mktemp {
 
   my $template = shift;
 
-  my ($tmpname, $junk);
-  croak "Error getting name to temp file from template $template\n"
+  my ($tmpname, $junk, $errstr);
+  croak "Error getting name to temp file from template $template: $errstr"
     unless (($junk, $tmpname) = _gettemp($template,
                                         "open" => 0,
                                         "mkdir"=> 0 ,
                                         "suffixlen" => 0,
+                                        "ErrStr" => \$errstr,
                                         ) );
 
   return $tmpname;
@@ -1316,7 +1414,7 @@ sub mktemp {
 =head1 POSIX FUNCTIONS
 
 This section describes the re-implementation of the tmpnam()
-and tmpfile() functions described in L<POSIX> 
+and tmpfile() functions described in L<POSIX>
 using the mkstemp() from this module.
 
 Unlike the L<POSIX|POSIX> implementations, the directory used
@@ -1380,6 +1478,10 @@ In scalar context, returns the filehandle of a temporary file.
 The file is removed when the filehandle is closed or when the program
 exits. No access to the filename is provided.
 
+If the temporary file can not be created undef is returned.
+Currently this command will probably not work when the temporary
+directory is on an NFS file system.
+
 =cut
 
 sub tmpfile {
@@ -1388,7 +1490,9 @@ sub tmpfile {
   my ($fh, $file) = tmpnam();
 
   # Make sure file is removed when filehandle is closed
-  unlink0($fh, $file) or croak "Unable to unlink temporary file: $!";
+  # This will fail on NFS
+  unlink0($fh, $file)
+    or return undef;
 
   return $fh;
 
@@ -1402,7 +1506,7 @@ These functions are provided for backwards compatibility
 with common tempfile generation C library functions.
 
 They are not exported and must be addressed using the full package
-name. 
+name.
 
 =over 4
 
@@ -1410,14 +1514,14 @@ name.
 
 Return the name of a temporary file in the specified directory
 using a prefix. The file is guaranteed not to exist at the time
-the function was called, but such guarantees are good for one 
+the function was called, but such guarantees are good for one
 clock tick only.  Always use the proper form of C<sysopen>
 with C<O_CREAT | O_EXCL> if you must open such a filename.
 
   $filename = File::Temp::tempnam( $dir, $prefix );
 
 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
-(using unix file convention as an example) 
+(using unix file convention as an example)
 
 Because this function uses mktemp(), it can suffer from race conditions.
 
@@ -1500,7 +1604,7 @@ sub unlink0 {
   my @fh = stat $fh;
 
   if ($fh[3] > 1 && $^W) {
-    carp "unlink0: fstat found too many links; SB=@fh";
+    carp "unlink0: fstat found too many links; SB=@fh" if $^W;
   }
 
   # Stat the path
@@ -1526,10 +1630,10 @@ sub unlink0 {
     @okstat = (1,2,3,4,5,7,8,9,10);
   } elsif ($^O eq 'os2') {
     @okstat = (0, 2..$#fh);
-  } elsif ($^O eq 'dos') {
-    @okstat = (2,3,4,5,7,8,9,10);
   } elsif ($^O eq 'VMS') { # device and file ID are sufficient
     @okstat = (0, 1);
+  } elsif ($^O eq 'dos') {
+     @okstat = (0,2..7,11..$#fh);
   }
 
   # Now compare each entry explicitly by number
@@ -1559,6 +1663,8 @@ sub unlink0 {
     # Make sure that the link count is zero
     # - Cygwin provides deferred unlinking, however,
     #   on Win9x the link count remains 1
+    # On NFS the link count may still be 1 but we cant know that
+    # we are on NFS
     return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
 
   } else {
@@ -1607,11 +1713,11 @@ for sticky bit.
 In addition to the MEDIUM security checks, also check for the
 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
 sysconf() function. If this is a possibility, each directory in the
-path is checked in turn for safeness, recursively walking back to the 
+path is checked in turn for safeness, recursively walking back to the
 root directory.
 
 For platforms that do not support the L<POSIX|POSIX>
-C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is 
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
 assumed that ``chown() giveaway'' is possible and the recursive test
 is performed.
 
@@ -1624,7 +1730,7 @@ The level can be changed as follows:
 The level constants are not exported by the module.
 
 Currently, you must be running at least perl v5.6.0 in order to
-run with MEDIUM or HIGH security. This is simply because the 
+run with MEDIUM or HIGH security. This is simply because the
 safety tests use functions from L<Fcntl|Fcntl> that are not
 available in older versions of perl. The problem is that the version
 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
@@ -1641,7 +1747,7 @@ If you really need to see whether the change has been accepted
 simply examine the return value of C<safe_level>.
 
   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
-  die "Could not change to high security" 
+  die "Could not change to high security"
       if $newlevel != File::Temp::HIGH;
 
 =cut
@@ -1651,10 +1757,10 @@ simply examine the return value of C<safe_level>.
   my $LEVEL = STANDARD;
   sub safe_level {
     my $self = shift;
-    if (@_) { 
+    if (@_) {
       my $level = shift;
       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
-       carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n";
+       carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
       } else {
        # Dont allow this on perl 5.005 or earlier
        if ($] < 5.006 && $level != STANDARD) {
@@ -1673,8 +1779,8 @@ simply examine the return value of C<safe_level>.
 =item TopSystemUID
 
 This is the highest UID on the current system that refers to a root
-UID. This is used to make sure that the temporary directory is 
-owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than 
+UID. This is used to make sure that the temporary directory is
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
 simply by root.
 
 This is required since on many unix systems C</tmp> is not owned
@@ -1726,6 +1832,15 @@ descriptor before passing it to another process.
     fcntl($tmpfh, F_SETFD, 0)
         or die "Can't clear close-on-exec flag on temp fh: $!\n";
 
+=head2 Temporary files and NFS
+
+Some problems are associated with using temporary files that reside
+on NFS file systems and it is recommended that a local filesystem
+is used whenever possible. Some of the security tests will most probably
+fail when the temp file is not local. Additionally, be aware that
+the performance of I/O operations over NFS will not be as good as for
+a local disk.
+
 =head1 HISTORY
 
 Originally began life in May 1999 as an XS interface to the system
@@ -1738,19 +1853,19 @@ operating system and to help with portability.
 
 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
 
-See L<File::MkTemp> for a different implementation of temporary
-file handling.
+See L<IO::File> and L<File::MkTemp> for different implementations of
+temporary file handling.
 
 =head1 AUTHOR
 
 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
 
-Copyright (C) 1999, 2000 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2001 Tim Jenness and the UK Particle Physics and
 Astronomy Research Council. All Rights Reserved.  This program is free
 software; you can redistribute it and/or modify it under the same
 terms as Perl itself.
 
-Original Perl implementation loosely based on the OpenBSD C code for 
+Original Perl implementation loosely based on the OpenBSD C code for
 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
 should be written and providing ideas for code improvements and
 security enhancements.