From: Steve Peters Date: Thu, 24 Aug 2006 15:07:58 +0000 (+0000) Subject: Upgrade to File-Temp-0.17. Also, a change to Tim Jenness's email. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5d0b10e0e277da4dc4a7c7f47ea4de1c0bbe695a;p=p5sagit%2Fp5-mst-13.2.git Upgrade to File-Temp-0.17. Also, a change to Tim Jenness's email. p4raw-id: //depot/perl@28755 --- diff --git a/AUTHORS b/AUTHORS index 843cba7..eb752b7 100644 --- a/AUTHORS +++ b/AUTHORS @@ -812,7 +812,7 @@ Tim Ayers Tim Bunce Tim Conrow Tim Freeman -Tim Jenness +Tim Jenness Tim Mooney Tim Sweetman Tim Witham diff --git a/MANIFEST b/MANIFEST index e01eb22..d742541 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1787,6 +1787,7 @@ lib/File/Temp/t/mktemp.t See if File::Temp works lib/File/Temp/t/object.t See if File::Temp works lib/File/Temp/t/posix.t See if File::Temp works lib/File/Temp/t/security.t See if File::Temp works +lib/File/Temp/t/seekable.t See if File::Temp works lib/File/Temp/t/tempfile.t See if File::Temp works lib/filetest.pm For "use filetest" lib/filetest.t See if filetest works diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm index 4883435..fa499c0 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 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 and isa C +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 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. 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. 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 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 and C 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 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 Etjenness@cpan.orgE -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 0000000..8432a1d --- /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" );