Upgrade to File-Temp-0.17. Also, a change to Tim Jenness's email.

p4raw-id: //depot/perl@28755

2 files changed, 101 insertions, 19 deletions

diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm
index 488343505f..fa499c07a0 100644
--- a/lib/File/Temp.pm
+++ b/lib/File/Temp.pm
@@ -61,13 +61,18 @@ Object interface:
 
   require File::Temp;
   use File::Temp ();
+  use File::Temp qw/ :seekable /;
 
-  $fh = new File::Temp( TEMPLATE => $template );
+  $fh = new File::Temp();
+  $fname = $fh->filename;
+
+  $fh = new File::Temp(TEMPLATE => $template);
   $fname = $fh->filename;
 
   $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
   print $tmp "Some data\n";
   print "Filename is $tmp\n";
+  $tmp->seek( 0, SEEK_END );
 
 The following interfaces are provided for compatibility with
 existing APIs. They should not be used in new code.
@@ -128,8 +133,8 @@ that the file will not exist by the time the caller opens the filename.
 =cut
 
 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
-# People would like a version on 5.005 so give them what they want :-)
-use 5.005;
+# People would like a version on 5.004 so give them what they want :-)
+use 5.004;
 use strict;
 use Carp;
 use File::Spec 0.8;
@@ -138,11 +143,18 @@ use Fcntl 1.03;
 use Errno;
 require VMS::Stdio if $^O eq 'VMS';
 
+# pre-emptively load Carp::Heavy. If we don't when we run out of file
+# handles and attempt to call croak() we get an error message telling
+# us that Carp::Heavy won't load rather than an error telling us we
+# have run out of file handles. We either preload croak() or we
+# switch the calls to croak from _gettemp() to use die.
+require Carp::Heavy;
+
 # Need the Symbol package if we are running older perl
 require Symbol if $] < 5.006;
 
 ### For the OO interface
-use base qw/ IO::Handle /;
+use base qw/ IO::Handle IO::Seekable /;
 use overload '""' => "STRINGIFY";
 
 
@@ -169,6 +181,9 @@ use base qw/Exporter/;
 	      mkdtemp
 	      unlink0
 	      cleanup
+	      SEEK_SET
+              SEEK_CUR
+              SEEK_END
 		};
 
 # Groups of functions for export
@@ -176,14 +191,15 @@ use base qw/Exporter/;
 %EXPORT_TAGS = (
 		'POSIX' => [qw/ tmpnam tmpfile /],
 		'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+		'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
 	       );
 
 # add contents of these tags to @EXPORT
-Exporter::export_tags('POSIX','mktemp');
+Exporter::export_tags('POSIX','mktemp','seekable');
 
 # Version number
 
-$VERSION = '0.16_01';
+$VERSION = '0.17';
 
 # This is a list of characters that can be used in random filenames
 
@@ -220,7 +236,7 @@ unless ($^O eq 'MacOS') {
     no strict 'refs';
     $OPENFLAGS |= $bit if eval {
       # Make sure that redefined die handlers do not cause problems
-      # eg CGI::Carp
+      # e.g. CGI::Carp
       local $SIG{__DIE__} = sub {};
       local $SIG{__WARN__} = sub {};
       $bit = &$func();
@@ -243,7 +259,7 @@ unless ($^O eq 'MacOS') {
     no strict 'refs';
     $OPENTEMPFLAGS |= $bit if eval {
       # Make sure that redefined die handlers do not cause problems
-      # eg CGI::Carp
+      # e.g. CGI::Carp
       local $SIG{__DIE__} = sub {};
       local $SIG{__WARN__} = sub {};
       $bit = &$func();
@@ -346,7 +362,7 @@ sub _gettemp {
   # Substr starts from 0
   my $start = length($template) - 1 - $options{"suffixlen"};
 
-  # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
+  # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
   # (taking suffixlen into account). Any fewer is insecure.
 
   # Do it using substr - no reason to use a pattern match since
@@ -679,11 +695,11 @@ sub _is_safe {
   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
+  # Use the effective uid from the $> variable
   # UID is in [4]
-  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
 
-    Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
 		File::Temp->top_system_uid());
 
     $$err_ref = "Directory owned neither by root nor the current user"
@@ -969,7 +985,8 @@ object is no longer required.
 Note that there is no method to obtain the filehandle from the
 C<File::Temp> object. The object itself acts as a filehandle. Also,
 the object is configured such that it stringifies to the name of the
-temporary file.
+temporary file. The object isa C<IO::Handle> and isa C<IO::Seekable>
+so all those methods are available.
 
 =over 4
 
@@ -995,6 +1012,8 @@ is not supported (the file is always opened).
 
 Arguments are case insensitive.
 
+Can call croak() if an error occurs.
+
 =cut
 
 sub new {
@@ -1189,6 +1208,8 @@ if opening the file is not required.
 
 Options can be combined as required.
 
+Will croak() if there is an error.
+
 =cut
 
 sub tempfile {
@@ -1360,6 +1381,8 @@ the rmtree() function from the L<File::Path|File::Path> module.
 Of course, if the template is not specified, the temporary directory
 will be created in tmpdir() and will also be removed at program exit.
 
+Will croak() if there is an error.
+
 =cut
 
 # '
@@ -1480,6 +1503,8 @@ The template may be any filename with some number of X's appended
 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
 with unique alphanumeric combinations.
 
+Will croak() if there is an error.
+
 =cut
 
 
@@ -1521,6 +1546,8 @@ would generate a file similar to F<testhGji_w.dat>.
 
 Returns just the filehandle alone when called in scalar context.
 
+Will croak() if there is an error.
+
 =cut
 
 sub mkstemps {
@@ -1559,10 +1586,11 @@ X's that are replaced by the routine.
   $tmpdir_name = mkdtemp($template);
 
 Returns the name of the temporary directory created.
-Returns undef on failure.
 
 Directory must be removed by the caller.
 
+Will croak() if there is an error.
+
 =cut
 
 #' # for emacs
@@ -1604,6 +1632,8 @@ that the file will not be opened by someone else.
 
 Template is the same as that required by mkstemp().
 
+Will croak() if there is an error.
+
 =cut
 
 sub mktemp {
@@ -1664,6 +1694,8 @@ race conditions.
 See L<File::Spec/tmpdir> for information on the choice of temporary
 directory for a particular operating system.
 
+Will croak() if there is an error.
+
 =cut
 
 sub tmpnam {
@@ -1698,6 +1730,8 @@ 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.
 
+Will croak() if there is an error.
+
 =cut
 
 sub tmpfile {
@@ -1741,6 +1775,8 @@ Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
 
 Because this function uses mktemp(), it can suffer from race conditions.
 
+Will croak() if there is an error.
+
 =cut
 
 sub tempnam {
@@ -1781,8 +1817,9 @@ same as the file whose descriptor you hold.
   unlink0($fh, $path)
      or die "Error unlinking file $path safely";
 
-Returns false on error. The filehandle is not closed since on some
-occasions this is not required.
+Returns false on error but croaks() if there is a security
+anomaly. The filehandle is not closed since on some occasions this is
+not required.
 
 On some platforms, for example Windows NT, it is not possible to
 unlink an open file (the file must be closed first). On those
@@ -1808,6 +1845,10 @@ This function is disabled if the global variable $KEEP_ALL is true
 and an unlink on open file is supported. If the unlink is to be deferred
 to the END block, the file is still registered for removal.
 
+This function should not be called if you are using the object oriented
+interface since the it will interfere with the object destructor deleting
+the file.
+
 =cut
 
 sub unlink0 {
@@ -1861,9 +1902,9 @@ fields returned by stat() are compared).
      or die "Error comparing handle with file";
 
 Returns false if the stat information differs or if the link count is
-greater than 1.
+greater than 1. Calls croak if there is a security anomaly.
 
-On certain platforms, e.g. Windows, not all the fields returned by stat()
+On certain platforms, for example Windows, not all the fields returned by stat()
 can be compared. For example, the C<dev> and C<rdev> fields seem to be
 different in Windows.  Also, it seems that the size of the file
 returned by stat() does not always agree, with C<stat(FH)> being more
@@ -1963,6 +2004,9 @@ Not exported by default.
 
 This function is disabled if the global variable $KEEP_ALL is true.
 
+Can call croak() if there is a security anomaly during the stat()
+comparison.
+
 =cut
 
 sub unlink1 {
@@ -2204,6 +2248,12 @@ to only remove those temp files created by a particular process ID. This
 means that a child will not attempt to remove temp files created by the
 parent process.
 
+If you are forking many processes in parallel that are all creating
+temporary files, you may need to reset the random number seed using
+srand(EXPR) in each child else all the children will attempt to walk
+through the same set of random file names and may well cause
+themselves to give up if they exceed the number of retry attempts.
+
 =head2 BINMODE
 
 The file returned by File::Temp will have been opened in binary mode
@@ -2230,7 +2280,7 @@ different implementations of temporary file handling.
 
 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
 
-Copyright (C) 1999-2005 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2006 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.
diff --git a/lib/File/Temp/t/seekable.t b/lib/File/Temp/t/seekable.t
new file mode 100644
index 0000000000..8432a1d90d
--- /dev/null
+++ b/lib/File/Temp/t/seekable.t
@@ -0,0 +1,32 @@
+#  -*- perl -*-
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl File-Temp.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 7;
+BEGIN { use_ok('File::Temp') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+# make sure we can create a tmp file...
+$tmp = File::Temp->new;
+isa_ok( $tmp, 'File::Temp' );
+isa_ok( $tmp, 'IO::Handle' );
+isa_ok( $tmp, 'IO::Seekable' );
+
+# make sure the seek method is available...
+ok( File::Temp->can('seek'), 'tmp can seek' );
+
+# make sure IO::Handle methods are still there...
+ok( File::Temp->can('print'), 'tmp can print' );
+
+# let's see what we're exporting...
+$c = scalar @File::Temp::EXPORT;
+$l = join ' ', @File::Temp::EXPORT;
+ok( $c == 9, "really exporting $c: $l" );