5 File::Temp - return name and handle of a temporary file safely
11 This section is at the top in order to provide easier access to
12 porters. It is not expected to be rendered by a standard pod
13 formatting tool. Please skip straight to the SYNOPSIS section if you
14 are not trying to port this module to a new platform.
16 This module is designed to be portable across operating systems and it
17 currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
18 (Classic). When porting to a new OS there are generally three main
19 issues that have to be solved:
25 Can the OS unlink an open file? If it can not then the
26 C<_can_unlink_opened_file> method should be modified.
30 Are the return values from C<stat> reliable? By default all the
31 return values from C<stat> are compared when unlinking a temporary
32 file using the filename and the handle. Operating systems other than
33 unix do not always have valid entries in all fields. If C<unlink0> fails
34 then the C<stat> comparison should be modified accordingly.
38 Security. Systems that can not support a test for the sticky bit
39 on a directory can not use the MEDIUM and HIGH security tests.
40 The C<_can_do_level> method should be modified accordingly.
48 use File::Temp qw/ tempfile tempdir /;
51 ($fh, $filename) = tempfile();
53 ($fh, $filename) = tempfile( $template, DIR => $dir);
54 ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
57 $dir = tempdir( CLEANUP => 1 );
58 ($fh, $filename) = tempfile( DIR => $dir );
64 use File::Temp qw/ :seekable /;
66 $fh = new File::Temp();
67 $fname = $fh->filename;
69 $fh = new File::Temp(TEMPLATE => $template);
70 $fname = $fh->filename;
72 $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
73 print $tmp "Some data\n";
74 print "Filename is $tmp\n";
75 $tmp->seek( 0, SEEK_END );
77 The following interfaces are provided for compatibility with
78 existing APIs. They should not be used in new code.
82 use File::Temp qw/ :mktemp /;
84 ($fh, $file) = mkstemp( "tmpfileXXXXX" );
85 ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
87 $tmpdir = mkdtemp( $template );
89 $unopened_file = mktemp( $template );
93 use File::Temp qw/ :POSIX /;
98 ($fh, $file) = tmpnam();
100 Compatibility functions:
102 $unopened_file = File::Temp::tempnam( $dir, $pfx );
106 C<File::Temp> can be used to create and open temporary files in a safe
107 way. There is both a function interface and an object-oriented
108 interface. The File::Temp constructor or the tempfile() function can
109 be used to return the name and the open filehandle of a temporary
110 file. The tempdir() function can be used to create a temporary
113 The security aspect of temporary file creation is emphasized such that
114 a filehandle and filename are returned together. This helps guarantee
115 that a race condition can not occur where the temporary file is
116 created by another process between checking for the existence of the
117 file and its opening. Additional security levels are provided to
118 check, for example, that the sticky bit is set on world writable
119 directories. See L<"safe_level"> for more information.
121 For compatibility with popular C library functions, Perl implementations of
122 the mkstemp() family of functions are provided. These are, mkstemp(),
123 mkstemps(), mkdtemp() and mktemp().
125 Additionally, implementations of the standard L<POSIX|POSIX>
126 tmpnam() and tmpfile() functions are provided if required.
128 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
129 but should be used with caution since they return only a filename
130 that was valid when function was called, so cannot guarantee
131 that the file will not exist by the time the caller opens the filename.
135 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
136 # People would like a version on 5.004 so give them what they want :-)
141 use File::Path qw/ rmtree /;
144 require VMS::Stdio if $^O eq 'VMS';
146 # pre-emptively load Carp::Heavy. If we don't when we run out of file
147 # handles and attempt to call croak() we get an error message telling
148 # us that Carp::Heavy won't load rather than an error telling us we
149 # have run out of file handles. We either preload croak() or we
150 # switch the calls to croak from _gettemp() to use die.
153 # Need the Symbol package if we are running older perl
154 require Symbol if $] < 5.006;
156 ### For the OO interface
157 use base qw/ IO::Handle IO::Seekable /;
158 use overload '""' => "STRINGIFY";
161 # use 'our' on v5.6.0
162 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
167 # We are exporting functions
169 use base qw/Exporter/;
171 # Export list - to allow fine tuning of export table
189 # Groups of functions for export
192 'POSIX' => [qw/ tmpnam tmpfile /],
193 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
194 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
197 # add contents of these tags to @EXPORT
198 Exporter::export_tags('POSIX','mktemp','seekable');
204 # This is a list of characters that can be used in random filenames
206 my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
207 a b c d e f g h i j k l m n o p q r s t u v w x y z
208 0 1 2 3 4 5 6 7 8 9 _
211 # Maximum number of tries to make a temp file before failing
213 use constant MAX_TRIES => 1000;
215 # Minimum number of X characters that should be in a template
216 use constant MINX => 4;
218 # Default template when no template supplied
220 use constant TEMPXXX => 'X' x 10;
222 # Constants for the security level
224 use constant STANDARD => 0;
225 use constant MEDIUM => 1;
226 use constant HIGH => 2;
228 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
229 # us an optimisation when many temporary files are requested
231 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
233 unless ($^O eq 'MacOS') {
234 for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
235 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
237 $OPENFLAGS |= $bit if eval {
238 # Make sure that redefined die handlers do not cause problems
240 local $SIG{__DIE__} = sub {};
241 local $SIG{__WARN__} = sub {};
248 # On some systems the O_TEMPORARY flag can be used to tell the OS
249 # to automatically remove the file when it is closed. This is fine
250 # in most cases but not if tempfile is called with UNLINK=>0 and
251 # the filename is requested -- in the case where the filename is to
252 # be passed to another routine. This happens on windows. We overcome
253 # this by using a second open flags variable
255 my $OPENTEMPFLAGS = $OPENFLAGS;
256 unless ($^O eq 'MacOS') {
257 for my $oflag (qw/ TEMPORARY /) {
258 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
260 $OPENTEMPFLAGS |= $bit if eval {
261 # Make sure that redefined die handlers do not cause problems
263 local $SIG{__DIE__} = sub {};
264 local $SIG{__WARN__} = sub {};
271 # INTERNAL ROUTINES - not to be used outside of package
273 # Generic routine for getting a temporary filename
274 # modelled on OpenBSD _gettemp() in mktemp.c
276 # The template must contain X's that are to be replaced
277 # with the random values
281 # TEMPLATE - string containing the XXXXX's that is converted
282 # to a random filename and opened if required
284 # Optionally, a hash can also be supplied containing specific options
285 # "open" => if true open the temp file, else just return the name
287 # "mkdir"=> if true, we are creating a temp directory rather than tempfile
289 # "suffixlen" => number of characters at end of PATH to be ignored.
291 # "unlink_on_close" => indicates that, if possible, the OS should remove
292 # the file as soon as it is closed. Usually indicates
293 # use of the O_TEMPORARY flag to sysopen.
294 # Usually irrelevant on unix
296 # Optionally a reference to a scalar can be passed into the function
297 # On error this will be used to store the reason for the error
298 # "ErrStr" => \$errstr
300 # "open" and "mkdir" can not both be true
301 # "unlink_on_close" is not used when "mkdir" is true.
303 # The default options are equivalent to mktemp().
306 # filehandle - open file handle (if called with doopen=1, else undef)
307 # temp name - name of the temp file or directory
310 # ($fh, $name) = _gettemp($template, "open" => 1);
312 # for the current version, failures are associated with
313 # stored in an error string and returned to give the reason whilst debugging
314 # This routine is not called by any external function
317 croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
318 unless scalar(@_) >= 1;
320 # the internal error string - expect it to be overridden
321 # Need this in case the caller decides not to supply us a value
322 # need an anonymous scalar
330 "unlink_on_close" => 0,
331 "ErrStr" => \$tempErrStr,
335 my $template = shift;
336 if (ref($template)) {
337 # Use a warning here since we have not yet merged ErrStr
338 carp "File::Temp::_gettemp: template must not be a reference";
342 # Check that the number of entries on stack are even
343 if (scalar(@_) % 2 != 0) {
344 # Use a warning here since we have not yet merged ErrStr
345 carp "File::Temp::_gettemp: Must have even number of options";
349 # Read the options and merge with defaults
350 %options = (%options, @_) if @_;
352 # Make sure the error string is set to undef
353 ${$options{ErrStr}} = undef;
355 # Can not open the file and make a directory in a single call
356 if ($options{"open"} && $options{"mkdir"}) {
357 ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
361 # Find the start of the end of the Xs (position of last X)
362 # Substr starts from 0
363 my $start = length($template) - 1 - $options{"suffixlen"};
365 # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
366 # (taking suffixlen into account). Any fewer is insecure.
368 # Do it using substr - no reason to use a pattern match since
369 # we know where we are looking and what we are looking for
371 if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
372 ${$options{ErrStr}} = "The template must end with at least ".
373 MINX . " 'X' characters\n";
377 # Replace all the X at the end of the substring with a
378 # random character or just all the XX at the end of a full string.
379 # Do it as an if, since the suffix adjusts which section to replace
380 # and suffixlen=0 returns nothing if used in the substr directly
381 # and generate a full path from the template
383 my $path = _replace_XX($template, $options{"suffixlen"});
386 # Split the path into constituent parts - eventually we need to check
387 # whether the directory exists
388 # We need to know whether we are making a temp directory
391 my ($volume, $directories, $file);
392 my $parent; # parent directory
393 if ($options{"mkdir"}) {
394 # There is no filename at the end
395 ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
397 # The parent is then $directories without the last directory
398 # Split the directory and put it back together again
399 my @dirs = File::Spec->splitdir($directories);
401 # If @dirs only has one entry (i.e. the directory template) that means
402 # we are in the current directory
404 $parent = File::Spec->curdir;
407 if ($^O eq 'VMS') { # need volume to avoid relative dir spec
408 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
409 $parent = 'sys$disk:[]' if $parent eq '';
412 # Put it back together without the last one
413 $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
415 # ...and attach the volume (no filename)
416 $parent = File::Spec->catpath($volume, $parent, '');
423 # Get rid of the last filename (use File::Basename for this?)
424 ($volume, $directories, $file) = File::Spec->splitpath( $path );
426 # Join up without the file part
427 $parent = File::Spec->catpath($volume,$directories,'');
429 # If $parent is empty replace with curdir
430 $parent = File::Spec->curdir
431 unless $directories ne '';
435 # Check that the parent directories exist
436 # Do this even for the case where we are simply returning a name
437 # not a file -- no point returning a name that includes a directory
438 # that does not exist or is not writable
440 unless (-d $parent) {
441 ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
444 unless (-w $parent) {
445 ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
450 # Check the stickiness of the directory and chown giveaway if required
451 # If the directory is world writable the sticky bit
454 if (File::Temp->safe_level == MEDIUM) {
456 unless (_is_safe($parent,\$safeerr)) {
457 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
460 } elsif (File::Temp->safe_level == HIGH) {
462 unless (_is_verysafe($parent, \$safeerr)) {
463 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
469 # Now try MAX_TRIES time to open the file
470 for (my $i = 0; $i < MAX_TRIES; $i++) {
472 # Try to open the file if requested
473 if ($options{"open"}) {
476 # If we are running before perl5.6.0 we can not auto-vivify
478 $fh = &Symbol::gensym;
481 # Try to make sure this will be marked close-on-exec
482 # XXX: Win32 doesn't respect this, nor the proper fcntl,
483 # but may have O_NOINHERIT. This may or may not be in Fcntl.
486 # Store callers umask
492 # Attempt to open the file
493 my $open_success = undef;
494 if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
495 # make it auto delete on close by setting FAB$V_DLT bit
496 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
499 my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
502 $open_success = sysopen($fh, $path, $flags, 0600);
504 if ( $open_success ) {
507 umask($umask) if defined $umask;
509 # Opened successfully - return file handle and name
514 umask($umask) if defined $umask;
516 # Error opening file - abort with error
517 # if the reason was anything but EEXIST
518 unless ($!{EEXIST}) {
519 ${$options{ErrStr}} = "Could not create temp file $path: $!";
523 # Loop round for another try
526 } elsif ($options{"mkdir"}) {
528 # Store callers umask
534 # Open the temp directory
535 if (mkdir( $path, 0700)) {
538 umask($umask) if defined $umask;
544 umask($umask) if defined $umask;
546 # Abort with error if the reason for failure was anything
548 unless ($!{EEXIST}) {
549 ${$options{ErrStr}} = "Could not create directory $path: $!";
553 # Loop round for another try
559 # Return true if the file can not be found
560 # Directory has been checked previously
562 return (undef, $path) unless -e $path;
564 # Try again until MAX_TRIES
568 # Did not successfully open the tempfile/dir
569 # so try again with a different set of random letters
570 # No point in trying to increment unless we have only
571 # 1 X say and the randomness could come up with the same
572 # file MAX_TRIES in a row.
574 # Store current attempt - in principal this implies that the
575 # 3rd time around the open attempt that the first temp file
576 # name could be generated again. Probably should store each
577 # attempt and make sure that none are repeated
579 my $original = $path;
580 my $counter = 0; # Stop infinite loop
585 # Generate new name from original template
586 $path = _replace_XX($template, $options{"suffixlen"});
590 } until ($path ne $original || $counter > $MAX_GUESS);
592 # Check for out of control looping
593 if ($counter > $MAX_GUESS) {
594 ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
600 # If we get here, we have run out of tries
601 ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
602 . MAX_TRIES . ") to open temp file/dir";
608 # Internal routine to return a random character from the
609 # character list. Does not do an srand() since rand()
610 # will do one automatically
612 # No arguments. Return value is the random character
614 # No longer called since _replace_XX runs a few percent faster if
615 # I inline the code. This is important if we are creating thousands of
620 $CHARS[ int( rand( $#CHARS ) ) ];
624 # Internal routine to replace the XXXX... with random characters
625 # This has to be done by _gettemp() every time it fails to
626 # open a temp file/dir
628 # Arguments: $template (the template with XXX),
629 # $ignore (number of characters at end to ignore)
631 # Returns: modified template
635 croak 'Usage: _replace_XX($template, $ignore)'
636 unless scalar(@_) == 2;
638 my ($path, $ignore) = @_;
640 # Do it as an if, since the suffix adjusts which section to replace
641 # and suffixlen=0 returns nothing if used in the substr directly
642 # Alternatively, could simply set $ignore to length($path)-1
643 # Don't want to always use substr when not required though.
646 substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
648 $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
653 # Internal routine to force a temp file to be writable after
654 # it is created so that we can unlink it. Windows seems to occassionally
655 # force a file to be readonly when written to certain temp locations
656 sub _force_writable {
661 umask($umask) if defined $umask;
665 # internal routine to check to see if the directory is safe
666 # First checks to see if the directory is not owned by the
667 # current user or root. Then checks to see if anyone else
668 # can write to the directory and if so, checks to see if
669 # it has the sticky bit set
671 # Will not work on systems that do not support sticky bit
673 #Args: directory path to check
674 # Optionally: reference to scalar to contain error message
675 # Returns true if the path is safe and false otherwise.
676 # Returns undef if can not even run stat() on the path
678 # This routine based on version written by Tom Christiansen
680 # Presumably, by the time we actually attempt to create the
681 # file or directory in this directory, it may not be safe
682 # anymore... Have to run _is_safe directly after the open.
690 my @info = stat($path);
691 unless (scalar(@info)) {
692 $$err_ref = "stat(path) returned no values";
695 return 1 if $^O eq 'VMS'; # owner delete control at file level
697 # Check to see whether owner is neither superuser (or a system uid) nor me
698 # Use the effective uid from the $> variable
700 if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
702 Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
703 File::Temp->top_system_uid());
705 $$err_ref = "Directory owned neither by root nor the current user"
710 # check whether group or other can write file
711 # use 066 to detect either reading or writing
712 # use 022 to check writability
713 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
715 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
716 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
717 # Must be a directory
719 $$err_ref = "Path ($path) is not a directory"
723 # Must have sticky bit set
725 $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
734 # Internal routine to check whether a directory is safe
735 # for temp files. Safer than _is_safe since it checks for
736 # the possibility of chown giveaway and if that is a possibility
737 # checks each directory in the path to see if it is safe (with _is_safe)
739 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
742 # Takes optional second arg as scalar ref to error reason
746 # Need POSIX - but only want to bother if really necessary due to overhead
750 print "_is_verysafe testing $path\n" if $DEBUG;
751 return 1 if $^O eq 'VMS'; # owner delete control at file level
755 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
756 # and If it is not there do the extensive test
757 my $chown_restricted;
758 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
759 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
761 # If chown_resticted is set to some value we should test it
762 if (defined $chown_restricted) {
764 # Return if the current directory is safe
765 return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
769 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
770 # was not avialable or the symbol was there but chown giveaway
771 # is allowed. Either way, we now have to test the entire tree for
774 # Convert path to an absolute directory if required
775 unless (File::Spec->file_name_is_absolute($path)) {
776 $path = File::Spec->rel2abs($path);
779 # Split directory into components - assume no file
780 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
782 # Slightly less efficient than having a function in File::Spec
783 # to chop off the end of a directory or even a function that
784 # can handle ../ in a directory tree
785 # Sometimes splitdir() returns a blank at the end
786 # so we will probably check the bottom directory twice in some cases
787 my @dirs = File::Spec->splitdir($directories);
789 # Concatenate one less directory each time around
790 foreach my $pos (0.. $#dirs) {
791 # Get a directory name
792 my $dir = File::Spec->catpath($volume,
793 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
797 print "TESTING DIR $dir\n" if $DEBUG;
799 # Check the directory
800 return 0 unless _is_safe($dir,$err_ref);
809 # internal routine to determine whether unlink works on this
810 # platform for files that are currently open.
811 # Returns true if we can, false otherwise.
813 # Currently WinNT, OS/2 and VMS can not unlink an opened file
814 # On VMS this is because the O_EXCL flag is used to open the
815 # temporary file. Currently I do not know enough about the issues
816 # on VMS to decide whether O_EXCL is a requirement.
818 sub _can_unlink_opened_file {
820 if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
828 # internal routine to decide which security levels are allowed
829 # see safe_level() for more information on this
831 # Controls whether the supplied security level is allowed
833 # $cando = _can_do_level( $level )
840 # Always have to be able to do STANDARD
841 return 1 if $level == STANDARD;
843 # Currently, the systems that can do HIGH or MEDIUM are identical
844 if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
852 # This routine sets up a deferred unlinking of a specified
853 # filename and filehandle. It is used in the following cases:
854 # - Called by unlink0 if an opened file can not be unlinked
855 # - Called by tempfile() if files are to be removed on shutdown
856 # - Called by tempdir() if directories are to be removed on shutdown
859 # _deferred_unlink( $fh, $fname, $isdir );
861 # - filehandle (so that it can be expclicitly closed if open
862 # - filename (the thing we want to remove)
863 # - isdir (flag to indicate that we are being given a directory)
864 # [and hence no filehandle]
866 # Status is not referred to since all the magic is done with an END block
869 # Will set up two lexical variables to contain all the files to be
870 # removed. One array for files, another for directories They will
871 # only exist in this block.
873 # This means we only have to set up a single END block to remove
876 # in order to prevent child processes inadvertently deleting the parent
877 # temp files we use a hash to store the temp files and directories
878 # created by a particular process id.
880 # %files_to_unlink contains values that are references to an array of
881 # array references containing the filehandle and filename associated with
883 my (%files_to_unlink, %dirs_to_unlink);
885 # Set up an end block to use these arrays
890 # Cleanup function. Always triggered on END but can be invoked
895 my @files = (exists $files_to_unlink{$$} ?
896 @{ $files_to_unlink{$$} } : () );
897 foreach my $file (@files) {
898 # close the filehandle without checking its state
899 # in order to make real sure that this is closed
900 # if its already closed then I dont care about the answer
901 # probably a better way to do this
902 close($file->[0]); # file handle is [0]
904 if (-f $file->[1]) { # file name is [1]
905 _force_writable( $file->[1] ); # for windows
906 unlink $file->[1] or warn "Error removing ".$file->[1];
910 my @dirs = (exists $dirs_to_unlink{$$} ?
911 @{ $dirs_to_unlink{$$} } : () );
912 foreach my $dir (@dirs) {
914 rmtree($dir, $DEBUG, 0);
919 @{ $files_to_unlink{$$} } = ()
920 if exists $files_to_unlink{$$};
921 @{ $dirs_to_unlink{$$} } = ()
922 if exists $dirs_to_unlink{$$};
927 # This is the sub called to register a file for deferred unlinking
928 # This could simply store the input parameters and defer everything
929 # until the END block. For now we do a bit of checking at this
930 # point in order to make sure that (1) we have a file/dir to delete
931 # and (2) we have been called with the correct arguments.
932 sub _deferred_unlink {
934 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
935 unless scalar(@_) == 3;
937 my ($fh, $fname, $isdir) = @_;
939 warn "Setting up deferred removal of $fname\n"
942 # If we have a directory, check that it is a directory
947 # Directory exists so store it
948 # first on VMS turn []foo into [.foo] for rmtree
949 $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
950 $dirs_to_unlink{$$} = []
951 unless exists $dirs_to_unlink{$$};
952 push (@{ $dirs_to_unlink{$$} }, $fname);
955 carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
962 # file exists so store handle and name for later removal
963 $files_to_unlink{$$} = []
964 unless exists $files_to_unlink{$$};
965 push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
968 carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
978 =head1 OBJECT-ORIENTED INTERFACE
980 This is the primary interface for interacting with
981 C<File::Temp>. Using the OO interface a temporary file can be created
982 when the object is constructed and the file can be removed when the
983 object is no longer required.
985 Note that there is no method to obtain the filehandle from the
986 C<File::Temp> object. The object itself acts as a filehandle. Also,
987 the object is configured such that it stringifies to the name of the
988 temporary file. The object isa C<IO::Handle> and isa C<IO::Seekable>
989 so all those methods are available.
995 Create a temporary file object.
997 my $tmp = new File::Temp();
999 by default the object is constructed as if C<tempfile>
1000 was called without options, but with the additional behaviour
1001 that the temporary file is removed by the object destructor
1002 if UNLINK is set to true (the default).
1004 Supported arguments are the same as for C<tempfile>: UNLINK
1005 (defaulting to true), DIR and SUFFIX. Additionally, the filename
1006 template is specified using the TEMPLATE option. The OPEN option
1007 is not supported (the file is always opened).
1009 $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
1013 Arguments are case insensitive.
1015 Can call croak() if an error occurs.
1021 my $class = ref($proto) || $proto;
1023 # read arguments and convert keys to upper case
1025 %args = map { uc($_), $args{$_} } keys %args;
1027 # see if they are unlinking (defaulting to yes)
1028 my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
1029 delete $args{UNLINK};
1031 # template (store it in an error so that it will
1032 # disappear from the arg list of tempfile
1033 my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
1034 delete $args{TEMPLATE};
1039 # Open the file and retain file handle and file name
1040 my ($fh, $path) = tempfile( @template, %args );
1042 print "Tmp: $fh - $path\n" if $DEBUG;
1044 # Store the filename in the scalar slot
1047 # Store unlink information in hash slot (plus other constructor info)
1053 # final method-based configuration
1054 $fh->unlink_on_destroy( $unlink );
1061 Return the name of the temporary file associated with this object.
1063 $filename = $tmp->filename;
1065 This method is called automatically when the object is used as
1077 return $self->filename;
1080 =item B<unlink_on_destroy>
1082 Control whether the file is unlinked when the object goes out of scope.
1083 The file is removed if this value is true and $KEEP_ALL is not.
1085 $fh->unlink_on_destroy( 1 );
1087 Default is for the file to be removed.
1091 sub unlink_on_destroy {
1094 ${*$self}{UNLINK} = shift;
1096 return ${*$self}{UNLINK};
1101 When the object goes out of scope, the destructor is called. This
1102 destructor will attempt to unlink the file (using C<unlink1>)
1103 if the constructor was called with UNLINK set to 1 (the default state
1104 if UNLINK is not specified).
1106 No error is given if the unlink fails.
1108 If the global variable $KEEP_ALL is true, the file will not be removed.
1114 if (${*$self}{UNLINK} && !$KEEP_ALL) {
1115 print "# ---------> Unlinking $self\n" if $DEBUG;
1117 # The unlink1 may fail if the file has been closed
1118 # by the caller. This leaves us with the decision
1119 # of whether to refuse to remove the file or simply
1120 # do an unlink without test. Seems to be silly
1121 # to do this when we are trying to be careful
1123 _force_writable( $self->filename ); # for windows
1124 unlink1( $self, $self->filename )
1125 or unlink($self->filename);
1133 This section describes the recommended interface for generating
1134 temporary files and directories.
1140 This is the basic function to generate temporary files.
1141 The behaviour of the file can be changed using various options:
1144 ($fh, $filename) = tempfile();
1146 Create a temporary file in the directory specified for temporary
1147 files, as specified by the tmpdir() function in L<File::Spec>.
1149 ($fh, $filename) = tempfile($template);
1151 Create a temporary file in the current directory using the supplied
1152 template. Trailing `X' characters are replaced with random letters to
1153 generate the filename. At least four `X' characters must be present
1154 at the end of the template.
1156 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1158 Same as previously, except that a suffix is added to the template
1159 after the `X' translation. Useful for ensuring that a temporary
1160 filename has a particular extension when needed by other applications.
1161 But see the WARNING at the end.
1163 ($fh, $filename) = tempfile($template, DIR => $dir);
1165 Translates the template as before except that a directory name
1168 ($fh, $filename) = tempfile($template, UNLINK => 1);
1170 Return the filename and filehandle as before except that the file is
1171 automatically removed when the program exits (dependent on
1172 $KEEP_ALL). Default is for the file to be removed if a file handle is
1173 requested and to be kept if the filename is requested. In a scalar
1174 context (where no filename is returned) the file is always deleted
1175 either (depending on the operating system) on exit or when it is
1176 closed (unless $KEEP_ALL is true when the temp file is created).
1178 Use the object-oriented interface if fine-grained control of when
1179 a file is removed is required.
1181 If the template is not specified, a template is always
1182 automatically generated. This temporary file is placed in tmpdir()
1183 (L<File::Spec>) unless a directory is specified explicitly with the
1186 $fh = tempfile( $template, DIR => $dir );
1188 If called in scalar context, only the filehandle is returned and the
1189 file will automatically be deleted when closed on operating systems
1190 that support this (see the description of tmpfile() elsewhere in this
1191 document). This is the preferred mode of operation, as if you only
1192 have a filehandle, you can never create a race condition by fumbling
1193 with the filename. On systems that can not unlink an open file or can
1194 not mark a file as temporary when it is opened (for example, Windows
1195 NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
1196 the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
1197 flag is ignored if present.
1199 (undef, $filename) = tempfile($template, OPEN => 0);
1201 This will return the filename based on the template but
1202 will not open this file. Cannot be used in conjunction with
1203 UNLINK set to true. Default is to always open the file
1204 to protect from possible race conditions. A warning is issued
1205 if warnings are turned on. Consider using the tmpnam()
1206 and mktemp() functions described elsewhere in this document
1207 if opening the file is not required.
1209 Options can be combined as required.
1211 Will croak() if there is an error.
1217 # Can not check for argument count since we can have any
1222 "DIR" => undef, # Directory prefix
1223 "SUFFIX" => '', # Template suffix
1224 "UNLINK" => 0, # Do not unlink file on exit
1225 "OPEN" => 1, # Open file
1228 # Check to see whether we have an odd or even number of arguments
1229 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
1231 # Read the options and merge with defaults
1232 %options = (%options, @_) if @_;
1234 # First decision is whether or not to open the file
1235 if (! $options{"OPEN"}) {
1237 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1242 if ($options{"DIR"} and $^O eq 'VMS') {
1244 # on VMS turn []foo into [.foo] for concatenation
1245 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1248 # Construct the template
1250 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1251 # functions or simply constructing a template and using _gettemp()
1252 # explicitly. Go for the latter
1254 # First generate a template if not defined and prefix the directory
1255 # If no template must prefix the temp directory
1256 if (defined $template) {
1257 if ($options{"DIR"}) {
1259 $template = File::Spec->catfile($options{"DIR"}, $template);
1265 if ($options{"DIR"}) {
1267 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1271 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
1278 $template .= $options{"SUFFIX"};
1280 # Determine whether we should tell _gettemp to unlink the file
1281 # On unix this is irrelevant and can be worked out after the file is
1282 # opened (simply by unlinking the open filehandle). On Windows or VMS
1283 # we have to indicate temporary-ness when we open the file. In general
1284 # we only want a true temporary file if we are returning just the
1285 # filehandle - if the user wants the filename they probably do not
1286 # want the file to disappear as soon as they close it (which may be
1287 # important if they want a child process to use the file)
1288 # For this reason, tie unlink_on_close to the return context regardless
1290 my $unlink_on_close = ( wantarray ? 0 : 1);
1293 my ($fh, $path, $errstr);
1294 croak "Error in tempfile() using $template: $errstr"
1295 unless (($fh, $path) = _gettemp($template,
1296 "open" => $options{'OPEN'},
1298 "unlink_on_close" => $unlink_on_close,
1299 "suffixlen" => length($options{'SUFFIX'}),
1300 "ErrStr" => \$errstr,
1303 # Set up an exit handler that can do whatever is right for the
1304 # system. This removes files at exit when requested explicitly or when
1305 # system is asked to unlink_on_close but is unable to do so because
1306 # of OS limitations.
1307 # The latter should be achieved by using a tied filehandle.
1308 # Do not check return status since this is all done with END blocks.
1309 _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1314 if ($options{'OPEN'}) {
1315 return ($fh, $path);
1317 return (undef, $path);
1322 # Unlink the file. It is up to unlink0 to decide what to do with
1323 # this (whether to unlink now or to defer until later)
1324 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1326 # Return just the filehandle.
1335 This is the recommended interface for creation of temporary directories.
1336 The behaviour of the function depends on the arguments:
1338 $tempdir = tempdir();
1340 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1342 $tempdir = tempdir( $template );
1344 Create a directory from the supplied template. This template is
1345 similar to that described for tempfile(). `X' characters at the end
1346 of the template are replaced with random letters to construct the
1347 directory name. At least four `X' characters must be in the template.
1349 $tempdir = tempdir ( DIR => $dir );
1351 Specifies the directory to use for the temporary directory.
1352 The temporary directory name is derived from an internal template.
1354 $tempdir = tempdir ( $template, DIR => $dir );
1356 Prepend the supplied directory name to the template. The template
1357 should not include parent directory specifications itself. Any parent
1358 directory specifications are removed from the template before
1359 prepending the supplied directory.
1361 $tempdir = tempdir ( $template, TMPDIR => 1 );
1363 Using the supplied template, create the temporary directory in
1364 a standard location for temporary files. Equivalent to doing
1366 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1368 but shorter. Parent directory specifications are stripped from the
1369 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1370 explicitly. Additionally, C<TMPDIR> is implied if neither a template
1371 nor a directory are supplied.
1373 $tempdir = tempdir( $template, CLEANUP => 1);
1375 Create a temporary directory using the supplied template, but
1376 attempt to remove it (and all files inside it) when the program
1377 exits. Note that an attempt will be made to remove all files from
1378 the directory even if they were not created by this module (otherwise
1379 why ask to clean it up?). The directory removal is made with
1380 the rmtree() function from the L<File::Path|File::Path> module.
1381 Of course, if the template is not specified, the temporary directory
1382 will be created in tmpdir() and will also be removed at program exit.
1384 Will croak() if there is an error.
1392 # Can not check for argument count since we can have any
1397 "CLEANUP" => 0, # Remove directory on exit
1398 "DIR" => '', # Root directory
1399 "TMPDIR" => 0, # Use tempdir with template
1402 # Check to see whether we have an odd or even number of arguments
1403 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1405 # Read the options and merge with defaults
1406 %options = (%options, @_) if @_;
1408 # Modify or generate the template
1410 # Deal with the DIR and TMPDIR options
1411 if (defined $template) {
1413 # Need to strip directory path if using DIR or TMPDIR
1414 if ($options{'TMPDIR'} || $options{'DIR'}) {
1416 # Strip parent directory from the filename
1418 # There is no filename at the end
1419 $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1420 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1422 # Last directory is then our template
1423 $template = (File::Spec->splitdir($directories))[-1];
1425 # Prepend the supplied directory or temp dir
1426 if ($options{"DIR"}) {
1428 $template = File::Spec->catdir($options{"DIR"}, $template);
1430 } elsif ($options{TMPDIR}) {
1433 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1441 if ($options{"DIR"}) {
1443 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1447 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1453 # Create the directory
1456 if ($^O eq 'VMS') { # dir names can end in delimiters
1457 $template =~ m/([\.\]:>]+)$/;
1458 $suffixlen = length($1);
1460 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1461 # dir name has a trailing ':'
1466 croak "Error in tempdir() using $template: $errstr"
1467 unless ((undef, $tempdir) = _gettemp($template,
1470 "suffixlen" => $suffixlen,
1471 "ErrStr" => \$errstr,
1474 # Install exit handler; must be dynamic to get lexical
1475 if ( $options{'CLEANUP'} && -d $tempdir) {
1476 _deferred_unlink(undef, $tempdir, 1);
1479 # Return the dir name
1486 =head1 MKTEMP FUNCTIONS
1488 The following functions are Perl implementations of the
1489 mktemp() family of temp file generation system calls.
1495 Given a template, returns a filehandle to the temporary file and the name
1498 ($fh, $name) = mkstemp( $template );
1500 In scalar context, just the filehandle is returned.
1502 The template may be any filename with some number of X's appended
1503 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1504 with unique alphanumeric combinations.
1506 Will croak() if there is an error.
1514 croak "Usage: mkstemp(template)"
1517 my $template = shift;
1519 my ($fh, $path, $errstr);
1520 croak "Error in mkstemp using $template: $errstr"
1521 unless (($fh, $path) = _gettemp($template,
1525 "ErrStr" => \$errstr,
1529 return ($fh, $path);
1539 Similar to mkstemp(), except that an extra argument can be supplied
1540 with a suffix to be appended to the template.
1542 ($fh, $name) = mkstemps( $template, $suffix );
1544 For example a template of C<testXXXXXX> and suffix of C<.dat>
1545 would generate a file similar to F<testhGji_w.dat>.
1547 Returns just the filehandle alone when called in scalar context.
1549 Will croak() if there is an error.
1555 croak "Usage: mkstemps(template, suffix)"
1559 my $template = shift;
1562 $template .= $suffix;
1564 my ($fh, $path, $errstr);
1565 croak "Error in mkstemps using $template: $errstr"
1566 unless (($fh, $path) = _gettemp($template,
1569 "suffixlen" => length($suffix),
1570 "ErrStr" => \$errstr,
1574 return ($fh, $path);
1583 Create a directory from a template. The template must end in
1584 X's that are replaced by the routine.
1586 $tmpdir_name = mkdtemp($template);
1588 Returns the name of the temporary directory created.
1590 Directory must be removed by the caller.
1592 Will croak() if there is an error.
1600 croak "Usage: mkdtemp(template)"
1603 my $template = shift;
1605 if ($^O eq 'VMS') { # dir names can end in delimiters
1606 $template =~ m/([\.\]:>]+)$/;
1607 $suffixlen = length($1);
1609 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1610 # dir name has a trailing ':'
1613 my ($junk, $tmpdir, $errstr);
1614 croak "Error creating temp directory from template $template\: $errstr"
1615 unless (($junk, $tmpdir) = _gettemp($template,
1618 "suffixlen" => $suffixlen,
1619 "ErrStr" => \$errstr,
1628 Returns a valid temporary filename but does not guarantee
1629 that the file will not be opened by someone else.
1631 $unopened_file = mktemp($template);
1633 Template is the same as that required by mkstemp().
1635 Will croak() if there is an error.
1641 croak "Usage: mktemp(template)"
1644 my $template = shift;
1646 my ($tmpname, $junk, $errstr);
1647 croak "Error getting name to temp file from template $template: $errstr"
1648 unless (($junk, $tmpname) = _gettemp($template,
1652 "ErrStr" => \$errstr,
1660 =head1 POSIX FUNCTIONS
1662 This section describes the re-implementation of the tmpnam()
1663 and tmpfile() functions described in L<POSIX>
1664 using the mkstemp() from this module.
1666 Unlike the L<POSIX|POSIX> implementations, the directory used
1667 for the temporary file is not specified in a system include
1668 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1669 returned by L<File::Spec|File::Spec>. On some implementations this
1670 location can be set using the C<TMPDIR> environment variable, which
1672 If this is a problem, simply use mkstemp() and specify a template.
1678 When called in scalar context, returns the full name (including path)
1679 of a temporary file (uses mktemp()). The only check is that the file does
1680 not already exist, but there is no guarantee that that condition will
1685 When called in list context, a filehandle to the open file and
1686 a filename are returned. This is achieved by calling mkstemp()
1687 after constructing a suitable template.
1689 ($fh, $file) = tmpnam();
1691 If possible, this form should be used to prevent possible
1694 See L<File::Spec/tmpdir> for information on the choice of temporary
1695 directory for a particular operating system.
1697 Will croak() if there is an error.
1703 # Retrieve the temporary directory name
1704 my $tmpdir = File::Spec->tmpdir;
1706 croak "Error temporary directory is not writable"
1709 # Use a ten character template and append to tmpdir
1710 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1713 return mkstemp($template);
1715 return mktemp($template);
1722 Returns the filehandle of a temporary file.
1726 The file is removed when the filehandle is closed or when the program
1727 exits. No access to the filename is provided.
1729 If the temporary file can not be created undef is returned.
1730 Currently this command will probably not work when the temporary
1731 directory is on an NFS file system.
1733 Will croak() if there is an error.
1739 # Simply call tmpnam() in a list context
1740 my ($fh, $file) = tmpnam();
1742 # Make sure file is removed when filehandle is closed
1743 # This will fail on NFS
1753 =head1 ADDITIONAL FUNCTIONS
1755 These functions are provided for backwards compatibility
1756 with common tempfile generation C library functions.
1758 They are not exported and must be addressed using the full package
1765 Return the name of a temporary file in the specified directory
1766 using a prefix. The file is guaranteed not to exist at the time
1767 the function was called, but such guarantees are good for one
1768 clock tick only. Always use the proper form of C<sysopen>
1769 with C<O_CREAT | O_EXCL> if you must open such a filename.
1771 $filename = File::Temp::tempnam( $dir, $prefix );
1773 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1774 (using unix file convention as an example)
1776 Because this function uses mktemp(), it can suffer from race conditions.
1778 Will croak() if there is an error.
1784 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1786 my ($dir, $prefix) = @_;
1788 # Add a string to the prefix
1789 $prefix .= 'XXXXXXXX';
1791 # Concatenate the directory to the file
1792 my $template = File::Spec->catfile($dir, $prefix);
1794 return mktemp($template);
1800 =head1 UTILITY FUNCTIONS
1802 Useful functions for dealing with the filehandle and filename.
1808 Given an open filehandle and the associated filename, make a safe
1809 unlink. This is achieved by first checking that the filename and
1810 filehandle initially point to the same file and that the number of
1811 links to the file is 1 (all fields returned by stat() are compared).
1812 Then the filename is unlinked and the filehandle checked once again to
1813 verify that the number of links on that file is now 0. This is the
1814 closest you can come to making sure that the filename unlinked was the
1815 same as the file whose descriptor you hold.
1818 or die "Error unlinking file $path safely";
1820 Returns false on error but croaks() if there is a security
1821 anomaly. The filehandle is not closed since on some occasions this is
1824 On some platforms, for example Windows NT, it is not possible to
1825 unlink an open file (the file must be closed first). On those
1826 platforms, the actual unlinking is deferred until the program ends and
1827 good status is returned. A check is still performed to make sure that
1828 the filehandle and filename are pointing to the same thing (but not at
1829 the time the end block is executed since the deferred removal may not
1830 have access to the filehandle).
1832 Additionally, on Windows NT not all the fields returned by stat() can
1833 be compared. For example, the C<dev> and C<rdev> fields seem to be
1834 different. Also, it seems that the size of the file returned by stat()
1835 does not always agree, with C<stat(FH)> being more accurate than
1836 C<stat(filename)>, presumably because of caching issues even when
1837 using autoflush (this is usually overcome by waiting a while after
1838 writing to the tempfile before attempting to C<unlink0> it).
1840 Finally, on NFS file systems the link count of the file handle does
1841 not always go to zero immediately after unlinking. Currently, this
1842 command is expected to fail on NFS disks.
1844 This function is disabled if the global variable $KEEP_ALL is true
1845 and an unlink on open file is supported. If the unlink is to be deferred
1846 to the END block, the file is still registered for removal.
1848 This function should not be called if you are using the object oriented
1849 interface since the it will interfere with the object destructor deleting
1856 croak 'Usage: unlink0(filehandle, filename)'
1857 unless scalar(@_) == 2;
1860 my ($fh, $path) = @_;
1862 cmpstat($fh, $path) or return 0;
1864 # attempt remove the file (does not work on some platforms)
1865 if (_can_unlink_opened_file()) {
1867 # return early (Without unlink) if we have been instructed to retain files.
1868 return 1 if $KEEP_ALL;
1870 # XXX: do *not* call this on a directory; possible race
1871 # resulting in recursive removal
1872 croak "unlink0: $path has become a directory!" if -d $path;
1873 unlink($path) or return 0;
1875 # Stat the filehandle
1878 print "Link count = $fh[3] \n" if $DEBUG;
1880 # Make sure that the link count is zero
1881 # - Cygwin provides deferred unlinking, however,
1882 # on Win9x the link count remains 1
1883 # On NFS the link count may still be 1 but we cant know that
1885 return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
1888 _deferred_unlink($fh, $path, 0);
1896 Compare C<stat> of filehandle with C<stat> of provided filename. This
1897 can be used to check that the filename and filehandle initially point
1898 to the same file and that the number of links to the file is 1 (all
1899 fields returned by stat() are compared).
1902 or die "Error comparing handle with file";
1904 Returns false if the stat information differs or if the link count is
1905 greater than 1. Calls croak if there is a security anomaly.
1907 On certain platforms, for example Windows, not all the fields returned by stat()
1908 can be compared. For example, the C<dev> and C<rdev> fields seem to be
1909 different in Windows. Also, it seems that the size of the file
1910 returned by stat() does not always agree, with C<stat(FH)> being more
1911 accurate than C<stat(filename)>, presumably because of caching issues
1912 even when using autoflush (this is usually overcome by waiting a while
1913 after writing to the tempfile before attempting to C<unlink0> it).
1915 Not exported by default.
1921 croak 'Usage: cmpstat(filehandle, filename)'
1922 unless scalar(@_) == 2;
1925 my ($fh, $path) = @_;
1927 warn "Comparing stat\n"
1930 # Stat the filehandle - which may be closed if someone has manually
1931 # closed the file. Can not turn off warnings without using $^W
1932 # unless we upgrade to 5.006 minimum requirement
1940 if ($fh[3] > 1 && $^W) {
1941 carp "unlink0: fstat found too many links; SB=@fh" if $^W;
1945 my @path = stat $path;
1948 carp "unlink0: $path is gone already" if $^W;
1952 # this is no longer a file, but may be a directory, or worse
1954 confess "panic: $path is no longer a file: SB=@fh";
1957 # Do comparison of each member of the array
1958 # On WinNT dev and rdev seem to be different
1959 # depending on whether it is a file or a handle.
1960 # Cannot simply compare all members of the stat return
1961 # Select the ones we can use
1962 my @okstat = (0..$#fh); # Use all by default
1963 if ($^O eq 'MSWin32') {
1964 @okstat = (1,2,3,4,5,7,8,9,10);
1965 } elsif ($^O eq 'os2') {
1966 @okstat = (0, 2..$#fh);
1967 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
1969 } elsif ($^O eq 'dos') {
1970 @okstat = (0,2..7,11..$#fh);
1971 } elsif ($^O eq 'mpeix') {
1972 @okstat = (0..4,8..10);
1975 # Now compare each entry explicitly by number
1977 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1978 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
1979 # and 12) will be '' on platforms that do not support them. This
1980 # is fine since we are only comparing integers.
1981 unless ($fh[$_] eq $path[$_]) {
1982 warn "Did not match $_ element of stat\n" if $DEBUG;
1992 Similar to C<unlink0> except after file comparison using cmpstat, the
1993 filehandle is closed prior to attempting to unlink the file. This
1994 allows the file to be removed without using an END block, but does
1995 mean that the post-unlink comparison of the filehandle state provided
1996 by C<unlink0> is not available.
1999 or die "Error closing and unlinking file";
2001 Usually called from the object destructor when using the OO interface.
2003 Not exported by default.
2005 This function is disabled if the global variable $KEEP_ALL is true.
2007 Can call croak() if there is a security anomaly during the stat()
2013 croak 'Usage: unlink1(filehandle, filename)'
2014 unless scalar(@_) == 2;
2017 my ($fh, $path) = @_;
2019 cmpstat($fh, $path) or return 0;
2022 close( $fh ) or return 0;
2024 # Make sure the file is writable (for windows)
2025 _force_writable( $path );
2027 # return early (without unlink) if we have been instructed to retain files.
2028 return 1 if $KEEP_ALL;
2031 return unlink($path);
2036 Calling this function will cause any temp files or temp directories
2037 that are registered for removal to be removed. This happens automatically
2038 when the process exits but can be triggered manually if the caller is sure
2039 that none of the temp files are required. This method can be registered as
2042 On OSes where temp files are automatically removed when the temp file
2043 is closed, calling this function will have no effect other than to remove
2044 temporary directories (which may include temporary files).
2046 File::Temp::cleanup();
2048 Not exported by default.
2052 =head1 PACKAGE VARIABLES
2054 These functions control the global state of the package.
2060 Controls the lengths to which the module will go to check the safety of the
2061 temporary file or directory before proceeding.
2068 Do the basic security measures to ensure the directory exists and
2069 is writable, that the umask() is fixed before opening of the file,
2070 that temporary files are opened only if they do not already exist, and
2071 that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
2072 function is used to remove files safely.
2076 In addition to the STANDARD security, the output directory is checked
2077 to make sure that it is owned either by root or the user running the
2078 program. If the directory is writable by group or by other, it is then
2079 checked to make sure that the sticky bit is set.
2081 Will not work on platforms that do not support the C<-k> test
2086 In addition to the MEDIUM security checks, also check for the
2087 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2088 sysconf() function. If this is a possibility, each directory in the
2089 path is checked in turn for safeness, recursively walking back to the
2092 For platforms that do not support the L<POSIX|POSIX>
2093 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2094 assumed that ``chown() giveaway'' is possible and the recursive test
2099 The level can be changed as follows:
2101 File::Temp->safe_level( File::Temp::HIGH );
2103 The level constants are not exported by the module.
2105 Currently, you must be running at least perl v5.6.0 in order to
2106 run with MEDIUM or HIGH security. This is simply because the
2107 safety tests use functions from L<Fcntl|Fcntl> that are not
2108 available in older versions of perl. The problem is that the version
2109 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2110 they are different versions.
2112 On systems that do not support the HIGH or MEDIUM safety levels
2113 (for example Win NT or OS/2) any attempt to change the level will
2114 be ignored. The decision to ignore rather than raise an exception
2115 allows portable programs to be written with high security in mind
2116 for the systems that can support this without those programs failing
2117 on systems where the extra tests are irrelevant.
2119 If you really need to see whether the change has been accepted
2120 simply examine the return value of C<safe_level>.
2122 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2123 die "Could not change to high security"
2124 if $newlevel != File::Temp::HIGH;
2129 # protect from using the variable itself
2130 my $LEVEL = STANDARD;
2135 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2136 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2138 # Dont allow this on perl 5.005 or earlier
2139 if ($] < 5.006 && $level != STANDARD) {
2140 # Cant do MEDIUM or HIGH checks
2141 croak "Currently requires perl 5.006 or newer to do the safe checks";
2143 # Check that we are allowed to change level
2144 # Silently ignore if we can not.
2145 $LEVEL = $level if _can_do_level($level);
2154 This is the highest UID on the current system that refers to a root
2155 UID. This is used to make sure that the temporary directory is
2156 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2159 This is required since on many unix systems C</tmp> is not owned
2162 Default is to assume that any UID less than or equal to 10 is a root
2165 File::Temp->top_system_uid(10);
2166 my $topid = File::Temp->top_system_uid;
2168 This value can be adjusted to reduce security checking if required.
2169 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2174 my $TopSystemUID = 10;
2175 $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2176 sub top_system_uid {
2180 croak "top_system_uid: UIDs should be numeric"
2181 unless $newuid =~ /^\d+$/s;
2182 $TopSystemUID = $newuid;
2184 return $TopSystemUID;
2190 Controls whether temporary files and directories should be retained
2191 regardless of any instructions in the program to remove them
2192 automatically. This is useful for debugging but should not be used in
2195 $File::Temp::KEEP_ALL = 1;
2197 Default is for files to be removed as requested by the caller.
2199 In some cases, files will only be retained if this variable is true
2200 when the file is created. This means that you can not create a temporary
2201 file, set this variable and expect the temp file to still be around
2202 when the program exits.
2206 Controls whether debugging messages should be enabled.
2208 $File::Temp::DEBUG = 1;
2210 Default is for debugging mode to be disabled.
2216 For maximum security, endeavour always to avoid ever looking at,
2217 touching, or even imputing the existence of the filename. You do not
2218 know that that filename is connected to the same file as the handle
2219 you have, and attempts to check this can only trigger more race
2220 conditions. It's far more secure to use the filehandle alone and
2221 dispense with the filename altogether.
2223 If you need to pass the handle to something that expects a filename
2224 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
2225 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
2226 programs. You will have to clear the close-on-exec bit on that file
2227 descriptor before passing it to another process.
2229 use Fcntl qw/F_SETFD F_GETFD/;
2230 fcntl($tmpfh, F_SETFD, 0)
2231 or die "Can't clear close-on-exec flag on temp fh: $!\n";
2233 =head2 Temporary files and NFS
2235 Some problems are associated with using temporary files that reside
2236 on NFS file systems and it is recommended that a local filesystem
2237 is used whenever possible. Some of the security tests will most probably
2238 fail when the temp file is not local. Additionally, be aware that
2239 the performance of I/O operations over NFS will not be as good as for
2244 In some cases files created by File::Temp are removed from within an
2245 END block. Since END blocks are triggered when a child process exits
2246 (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2247 to only remove those temp files created by a particular process ID. This
2248 means that a child will not attempt to remove temp files created by the
2251 If you are forking many processes in parallel that are all creating
2252 temporary files, you may need to reset the random number seed using
2253 srand(EXPR) in each child else all the children will attempt to walk
2254 through the same set of random file names and may well cause
2255 themselves to give up if they exceed the number of retry attempts.
2259 The file returned by File::Temp will have been opened in binary mode
2260 if such a mode is available. If that is not correct, use the binmode()
2261 function to change the mode of the filehandle.
2265 Originally began life in May 1999 as an XS interface to the system
2266 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2267 translated to Perl for total control of the code's
2268 security checking, to ensure the presence of the function regardless of
2269 operating system and to help with portability. The module was shipped
2270 as a standard part of perl from v5.6.1.
2274 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2276 See L<IO::File> and L<File::MkTemp>, L<Apachae::TempFile> for
2277 different implementations of temporary file handling.
2281 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
2283 Copyright (C) 1999-2006 Tim Jenness and the UK Particle Physics and
2284 Astronomy Research Council. All Rights Reserved. This program is free
2285 software; you can redistribute it and/or modify it under the same
2286 terms as Perl itself.
2288 Original Perl implementation loosely based on the OpenBSD C code for
2289 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
2290 should be written and providing ideas for code improvements and
2291 security enhancements.