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');
55 ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
57 binmode( $fh, ":utf8" );
59 $dir = tempdir( CLEANUP => 1 );
60 ($fh, $filename) = tempfile( DIR => $dir );
66 use File::Temp qw/ :seekable /;
68 $fh = File::Temp->new();
69 $fname = $fh->filename;
71 $fh = File::Temp->new(TEMPLATE => $template);
72 $fname = $fh->filename;
74 $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
75 print $tmp "Some data\n";
76 print "Filename is $tmp\n";
77 $tmp->seek( 0, SEEK_END );
79 The following interfaces are provided for compatibility with
80 existing APIs. They should not be used in new code.
84 use File::Temp qw/ :mktemp /;
86 ($fh, $file) = mkstemp( "tmpfileXXXXX" );
87 ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
89 $tmpdir = mkdtemp( $template );
91 $unopened_file = mktemp( $template );
95 use File::Temp qw/ :POSIX /;
100 ($fh, $file) = tmpnam();
102 Compatibility functions:
104 $unopened_file = File::Temp::tempnam( $dir, $pfx );
108 C<File::Temp> can be used to create and open temporary files in a safe
109 way. There is both a function interface and an object-oriented
110 interface. The File::Temp constructor or the tempfile() function can
111 be used to return the name and the open filehandle of a temporary
112 file. The tempdir() function can be used to create a temporary
115 The security aspect of temporary file creation is emphasized such that
116 a filehandle and filename are returned together. This helps guarantee
117 that a race condition can not occur where the temporary file is
118 created by another process between checking for the existence of the
119 file and its opening. Additional security levels are provided to
120 check, for example, that the sticky bit is set on world writable
121 directories. See L<"safe_level"> for more information.
123 For compatibility with popular C library functions, Perl implementations of
124 the mkstemp() family of functions are provided. These are, mkstemp(),
125 mkstemps(), mkdtemp() and mktemp().
127 Additionally, implementations of the standard L<POSIX|POSIX>
128 tmpnam() and tmpfile() functions are provided if required.
130 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
131 but should be used with caution since they return only a filename
132 that was valid when function was called, so cannot guarantee
133 that the file will not exist by the time the caller opens the filename.
135 Filehandles returned by these functions support the seekable methods.
139 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
140 # People would like a version on 5.004 so give them what they want :-)
145 use File::Path qw/ rmtree /;
147 use IO::Seekable; # For SEEK_*
149 require VMS::Stdio if $^O eq 'VMS';
151 # pre-emptively load Carp::Heavy. If we don't when we run out of file
152 # handles and attempt to call croak() we get an error message telling
153 # us that Carp::Heavy won't load rather than an error telling us we
154 # have run out of file handles. We either preload croak() or we
155 # switch the calls to croak from _gettemp() to use die.
156 eval { require Carp::Heavy; };
158 # Need the Symbol package if we are running older perl
159 require Symbol if $] < 5.006;
161 ### For the OO interface
162 use base qw/ IO::Handle IO::Seekable /;
163 use overload '""' => "STRINGIFY", fallback => 1;
165 # use 'our' on v5.6.0
166 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
171 # We are exporting functions
173 use base qw/Exporter/;
175 # Export list - to allow fine tuning of export table
193 # Groups of functions for export
196 'POSIX' => [qw/ tmpnam tmpfile /],
197 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
198 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
201 # add contents of these tags to @EXPORT
202 Exporter::export_tags('POSIX','mktemp','seekable');
208 # This is a list of characters that can be used in random filenames
210 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
211 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
212 0 1 2 3 4 5 6 7 8 9 _
215 # Maximum number of tries to make a temp file before failing
217 use constant MAX_TRIES => 1000;
219 # Minimum number of X characters that should be in a template
220 use constant MINX => 4;
222 # Default template when no template supplied
224 use constant TEMPXXX => 'X' x 10;
226 # Constants for the security level
228 use constant STANDARD => 0;
229 use constant MEDIUM => 1;
230 use constant HIGH => 2;
232 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
233 # us an optimisation when many temporary files are requested
235 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
238 unless ($^O eq 'MacOS') {
239 for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
240 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
242 $OPENFLAGS |= $bit if eval {
243 # Make sure that redefined die handlers do not cause problems
245 local $SIG{__DIE__} = sub {};
246 local $SIG{__WARN__} = sub {};
251 # Special case O_EXLOCK
253 local $SIG{__DIE__} = sub {};
254 local $SIG{__WARN__} = sub {};
259 # On some systems the O_TEMPORARY flag can be used to tell the OS
260 # to automatically remove the file when it is closed. This is fine
261 # in most cases but not if tempfile is called with UNLINK=>0 and
262 # the filename is requested -- in the case where the filename is to
263 # be passed to another routine. This happens on windows. We overcome
264 # this by using a second open flags variable
266 my $OPENTEMPFLAGS = $OPENFLAGS;
267 unless ($^O eq 'MacOS') {
268 for my $oflag (qw/ TEMPORARY /) {
269 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
272 $OPENTEMPFLAGS |= $bit if eval {
273 # Make sure that redefined die handlers do not cause problems
275 local $SIG{__DIE__} = sub {};
276 local $SIG{__WARN__} = sub {};
283 # Private hash tracking which files have been created by each process id via the OO interface
284 my %FILES_CREATED_BY_OBJECT;
286 # INTERNAL ROUTINES - not to be used outside of package
288 # Generic routine for getting a temporary filename
289 # modelled on OpenBSD _gettemp() in mktemp.c
291 # The template must contain X's that are to be replaced
292 # with the random values
296 # TEMPLATE - string containing the XXXXX's that is converted
297 # to a random filename and opened if required
299 # Optionally, a hash can also be supplied containing specific options
300 # "open" => if true open the temp file, else just return the name
302 # "mkdir"=> if true, we are creating a temp directory rather than tempfile
304 # "suffixlen" => number of characters at end of PATH to be ignored.
306 # "unlink_on_close" => indicates that, if possible, the OS should remove
307 # the file as soon as it is closed. Usually indicates
308 # use of the O_TEMPORARY flag to sysopen.
309 # Usually irrelevant on unix
310 # "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
312 # Optionally a reference to a scalar can be passed into the function
313 # On error this will be used to store the reason for the error
314 # "ErrStr" => \$errstr
316 # "open" and "mkdir" can not both be true
317 # "unlink_on_close" is not used when "mkdir" is true.
319 # The default options are equivalent to mktemp().
322 # filehandle - open file handle (if called with doopen=1, else undef)
323 # temp name - name of the temp file or directory
326 # ($fh, $name) = _gettemp($template, "open" => 1);
328 # for the current version, failures are associated with
329 # stored in an error string and returned to give the reason whilst debugging
330 # This routine is not called by any external function
333 croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
334 unless scalar(@_) >= 1;
336 # the internal error string - expect it to be overridden
337 # Need this in case the caller decides not to supply us a value
338 # need an anonymous scalar
346 "unlink_on_close" => 0,
348 "ErrStr" => \$tempErrStr,
352 my $template = shift;
353 if (ref($template)) {
354 # Use a warning here since we have not yet merged ErrStr
355 carp "File::Temp::_gettemp: template must not be a reference";
359 # Check that the number of entries on stack are even
360 if (scalar(@_) % 2 != 0) {
361 # Use a warning here since we have not yet merged ErrStr
362 carp "File::Temp::_gettemp: Must have even number of options";
366 # Read the options and merge with defaults
367 %options = (%options, @_) if @_;
369 # Make sure the error string is set to undef
370 ${$options{ErrStr}} = undef;
372 # Can not open the file and make a directory in a single call
373 if ($options{"open"} && $options{"mkdir"}) {
374 ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
378 # Find the start of the end of the Xs (position of last X)
379 # Substr starts from 0
380 my $start = length($template) - 1 - $options{"suffixlen"};
382 # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
383 # (taking suffixlen into account). Any fewer is insecure.
385 # Do it using substr - no reason to use a pattern match since
386 # we know where we are looking and what we are looking for
388 if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
389 ${$options{ErrStr}} = "The template must end with at least ".
390 MINX . " 'X' characters\n";
394 # Replace all the X at the end of the substring with a
395 # random character or just all the XX at the end of a full string.
396 # Do it as an if, since the suffix adjusts which section to replace
397 # and suffixlen=0 returns nothing if used in the substr directly
398 # and generate a full path from the template
400 my $path = _replace_XX($template, $options{"suffixlen"});
403 # Split the path into constituent parts - eventually we need to check
404 # whether the directory exists
405 # We need to know whether we are making a temp directory
408 my ($volume, $directories, $file);
409 my $parent; # parent directory
410 if ($options{"mkdir"}) {
411 # There is no filename at the end
412 ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
414 # The parent is then $directories without the last directory
415 # Split the directory and put it back together again
416 my @dirs = File::Spec->splitdir($directories);
418 # If @dirs only has one entry (i.e. the directory template) that means
419 # we are in the current directory
421 $parent = File::Spec->curdir;
424 if ($^O eq 'VMS') { # need volume to avoid relative dir spec
425 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
426 $parent = 'sys$disk:[]' if $parent eq '';
429 # Put it back together without the last one
430 $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
432 # ...and attach the volume (no filename)
433 $parent = File::Spec->catpath($volume, $parent, '');
440 # Get rid of the last filename (use File::Basename for this?)
441 ($volume, $directories, $file) = File::Spec->splitpath( $path );
443 # Join up without the file part
444 $parent = File::Spec->catpath($volume,$directories,'');
446 # If $parent is empty replace with curdir
447 $parent = File::Spec->curdir
448 unless $directories ne '';
452 # Check that the parent directories exist
453 # Do this even for the case where we are simply returning a name
454 # not a file -- no point returning a name that includes a directory
455 # that does not exist or is not writable
457 unless (-e $parent) {
458 ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
461 unless (-d $parent) {
462 ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
465 unless (-w $parent) {
466 ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
471 # Check the stickiness of the directory and chown giveaway if required
472 # If the directory is world writable the sticky bit
475 if (File::Temp->safe_level == MEDIUM) {
477 unless (_is_safe($parent,\$safeerr)) {
478 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
481 } elsif (File::Temp->safe_level == HIGH) {
483 unless (_is_verysafe($parent, \$safeerr)) {
484 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
490 # Now try MAX_TRIES time to open the file
491 for (my $i = 0; $i < MAX_TRIES; $i++) {
493 # Try to open the file if requested
494 if ($options{"open"}) {
497 # If we are running before perl5.6.0 we can not auto-vivify
499 $fh = &Symbol::gensym;
502 # Try to make sure this will be marked close-on-exec
503 # XXX: Win32 doesn't respect this, nor the proper fcntl,
504 # but may have O_NOINHERIT. This may or may not be in Fcntl.
507 # Attempt to open the file
508 my $open_success = undef;
509 if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
510 # make it auto delete on close by setting FAB$V_DLT bit
511 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
514 my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
517 $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
518 $open_success = sysopen($fh, $path, $flags, 0600);
520 if ( $open_success ) {
522 # in case of odd umask force rw
525 # Opened successfully - return file handle and name
530 # Error opening file - abort with error
531 # if the reason was anything but EEXIST
532 unless ($!{EEXIST}) {
533 ${$options{ErrStr}} = "Could not create temp file $path: $!";
537 # Loop round for another try
540 } elsif ($options{"mkdir"}) {
542 # Open the temp directory
543 if (mkdir( $path, 0700)) {
544 # in case of odd umask
550 # Abort with error if the reason for failure was anything
552 unless ($!{EEXIST}) {
553 ${$options{ErrStr}} = "Could not create directory $path: $!";
557 # Loop round for another try
563 # Return true if the file can not be found
564 # Directory has been checked previously
566 return (undef, $path) unless -e $path;
568 # Try again until MAX_TRIES
572 # Did not successfully open the tempfile/dir
573 # so try again with a different set of random letters
574 # No point in trying to increment unless we have only
575 # 1 X say and the randomness could come up with the same
576 # file MAX_TRIES in a row.
578 # Store current attempt - in principal this implies that the
579 # 3rd time around the open attempt that the first temp file
580 # name could be generated again. Probably should store each
581 # attempt and make sure that none are repeated
583 my $original = $path;
584 my $counter = 0; # Stop infinite loop
589 # Generate new name from original template
590 $path = _replace_XX($template, $options{"suffixlen"});
594 } until ($path ne $original || $counter > $MAX_GUESS);
596 # Check for out of control looping
597 if ($counter > $MAX_GUESS) {
598 ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
604 # If we get here, we have run out of tries
605 ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
606 . MAX_TRIES . ") to open temp file/dir";
612 # Internal routine to replace the XXXX... with random characters
613 # This has to be done by _gettemp() every time it fails to
614 # open a temp file/dir
616 # Arguments: $template (the template with XXX),
617 # $ignore (number of characters at end to ignore)
619 # Returns: modified template
623 croak 'Usage: _replace_XX($template, $ignore)'
624 unless scalar(@_) == 2;
626 my ($path, $ignore) = @_;
628 # Do it as an if, since the suffix adjusts which section to replace
629 # and suffixlen=0 returns nothing if used in the substr directly
630 # Alternatively, could simply set $ignore to length($path)-1
631 # Don't want to always use substr when not required though.
632 my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
635 substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
637 $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
642 # Internal routine to force a temp file to be writable after
643 # it is created so that we can unlink it. Windows seems to occassionally
644 # force a file to be readonly when written to certain temp locations
645 sub _force_writable {
651 # internal routine to check to see if the directory is safe
652 # First checks to see if the directory is not owned by the
653 # current user or root. Then checks to see if anyone else
654 # can write to the directory and if so, checks to see if
655 # it has the sticky bit set
657 # Will not work on systems that do not support sticky bit
659 #Args: directory path to check
660 # Optionally: reference to scalar to contain error message
661 # Returns true if the path is safe and false otherwise.
662 # Returns undef if can not even run stat() on the path
664 # This routine based on version written by Tom Christiansen
666 # Presumably, by the time we actually attempt to create the
667 # file or directory in this directory, it may not be safe
668 # anymore... Have to run _is_safe directly after the open.
676 my @info = stat($path);
677 unless (scalar(@info)) {
678 $$err_ref = "stat(path) returned no values";
681 return 1 if $^O eq 'VMS'; # owner delete control at file level
683 # Check to see whether owner is neither superuser (or a system uid) nor me
684 # Use the effective uid from the $> variable
686 if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
688 Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
689 File::Temp->top_system_uid());
691 $$err_ref = "Directory owned neither by root nor the current user"
696 # check whether group or other can write file
697 # use 066 to detect either reading or writing
698 # use 022 to check writability
699 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
701 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
702 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
703 # Must be a directory
705 $$err_ref = "Path ($path) is not a directory"
709 # Must have sticky bit set
711 $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
720 # Internal routine to check whether a directory is safe
721 # for temp files. Safer than _is_safe since it checks for
722 # the possibility of chown giveaway and if that is a possibility
723 # checks each directory in the path to see if it is safe (with _is_safe)
725 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
728 # Takes optional second arg as scalar ref to error reason
732 # Need POSIX - but only want to bother if really necessary due to overhead
736 print "_is_verysafe testing $path\n" if $DEBUG;
737 return 1 if $^O eq 'VMS'; # owner delete control at file level
741 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
742 # and If it is not there do the extensive test
744 my $chown_restricted;
745 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
746 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
748 # If chown_resticted is set to some value we should test it
749 if (defined $chown_restricted) {
751 # Return if the current directory is safe
752 return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
756 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
757 # was not avialable or the symbol was there but chown giveaway
758 # is allowed. Either way, we now have to test the entire tree for
761 # Convert path to an absolute directory if required
762 unless (File::Spec->file_name_is_absolute($path)) {
763 $path = File::Spec->rel2abs($path);
766 # Split directory into components - assume no file
767 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
769 # Slightly less efficient than having a function in File::Spec
770 # to chop off the end of a directory or even a function that
771 # can handle ../ in a directory tree
772 # Sometimes splitdir() returns a blank at the end
773 # so we will probably check the bottom directory twice in some cases
774 my @dirs = File::Spec->splitdir($directories);
776 # Concatenate one less directory each time around
777 foreach my $pos (0.. $#dirs) {
778 # Get a directory name
779 my $dir = File::Spec->catpath($volume,
780 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
784 print "TESTING DIR $dir\n" if $DEBUG;
786 # Check the directory
787 return 0 unless _is_safe($dir,$err_ref);
796 # internal routine to determine whether unlink works on this
797 # platform for files that are currently open.
798 # Returns true if we can, false otherwise.
800 # Currently WinNT, OS/2 and VMS can not unlink an opened file
801 # On VMS this is because the O_EXCL flag is used to open the
802 # temporary file. Currently I do not know enough about the issues
803 # on VMS to decide whether O_EXCL is a requirement.
805 sub _can_unlink_opened_file {
807 if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
815 # internal routine to decide which security levels are allowed
816 # see safe_level() for more information on this
818 # Controls whether the supplied security level is allowed
820 # $cando = _can_do_level( $level )
827 # Always have to be able to do STANDARD
828 return 1 if $level == STANDARD;
830 # Currently, the systems that can do HIGH or MEDIUM are identical
831 if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
839 # This routine sets up a deferred unlinking of a specified
840 # filename and filehandle. It is used in the following cases:
841 # - Called by unlink0 if an opened file can not be unlinked
842 # - Called by tempfile() if files are to be removed on shutdown
843 # - Called by tempdir() if directories are to be removed on shutdown
846 # _deferred_unlink( $fh, $fname, $isdir );
848 # - filehandle (so that it can be expclicitly closed if open
849 # - filename (the thing we want to remove)
850 # - isdir (flag to indicate that we are being given a directory)
851 # [and hence no filehandle]
853 # Status is not referred to since all the magic is done with an END block
856 # Will set up two lexical variables to contain all the files to be
857 # removed. One array for files, another for directories They will
858 # only exist in this block.
860 # This means we only have to set up a single END block to remove
863 # in order to prevent child processes inadvertently deleting the parent
864 # temp files we use a hash to store the temp files and directories
865 # created by a particular process id.
867 # %files_to_unlink contains values that are references to an array of
868 # array references containing the filehandle and filename associated with
870 my (%files_to_unlink, %dirs_to_unlink);
872 # Set up an end block to use these arrays
877 # Cleanup function. Always triggered on END but can be invoked
882 my @files = (exists $files_to_unlink{$$} ?
883 @{ $files_to_unlink{$$} } : () );
884 foreach my $file (@files) {
885 # close the filehandle without checking its state
886 # in order to make real sure that this is closed
887 # if its already closed then I dont care about the answer
888 # probably a better way to do this
889 close($file->[0]); # file handle is [0]
891 if (-f $file->[1]) { # file name is [1]
892 _force_writable( $file->[1] ); # for windows
893 unlink $file->[1] or warn "Error removing ".$file->[1];
897 my @dirs = (exists $dirs_to_unlink{$$} ?
898 @{ $dirs_to_unlink{$$} } : () );
899 foreach my $dir (@dirs) {
901 rmtree($dir, $DEBUG, 0);
906 @{ $files_to_unlink{$$} } = ()
907 if exists $files_to_unlink{$$};
908 @{ $dirs_to_unlink{$$} } = ()
909 if exists $dirs_to_unlink{$$};
914 # This is the sub called to register a file for deferred unlinking
915 # This could simply store the input parameters and defer everything
916 # until the END block. For now we do a bit of checking at this
917 # point in order to make sure that (1) we have a file/dir to delete
918 # and (2) we have been called with the correct arguments.
919 sub _deferred_unlink {
921 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
922 unless scalar(@_) == 3;
924 my ($fh, $fname, $isdir) = @_;
926 warn "Setting up deferred removal of $fname\n"
929 # If we have a directory, check that it is a directory
934 # Directory exists so store it
935 # first on VMS turn []foo into [.foo] for rmtree
936 $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
937 $dirs_to_unlink{$$} = []
938 unless exists $dirs_to_unlink{$$};
939 push (@{ $dirs_to_unlink{$$} }, $fname);
942 carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
949 # file exists so store handle and name for later removal
950 $files_to_unlink{$$} = []
951 unless exists $files_to_unlink{$$};
952 push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
955 carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
965 =head1 OBJECT-ORIENTED INTERFACE
967 This is the primary interface for interacting with
968 C<File::Temp>. Using the OO interface a temporary file can be created
969 when the object is constructed and the file can be removed when the
970 object is no longer required.
972 Note that there is no method to obtain the filehandle from the
973 C<File::Temp> object. The object itself acts as a filehandle. Also,
974 the object is configured such that it stringifies to the name of the
975 temporary file, and can be compared to a filename directly. The object
976 isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
983 Create a temporary file object.
985 my $tmp = File::Temp->new();
987 by default the object is constructed as if C<tempfile>
988 was called without options, but with the additional behaviour
989 that the temporary file is removed by the object destructor
990 if UNLINK is set to true (the default).
992 Supported arguments are the same as for C<tempfile>: UNLINK
993 (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
994 template is specified using the TEMPLATE option. The OPEN option
995 is not supported (the file is always opened).
997 $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
1001 Arguments are case insensitive.
1003 Can call croak() if an error occurs.
1009 my $class = ref($proto) || $proto;
1011 # read arguments and convert keys to upper case
1013 %args = map { uc($_), $args{$_} } keys %args;
1015 # see if they are unlinking (defaulting to yes)
1016 my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
1017 delete $args{UNLINK};
1019 # template (store it in an error so that it will
1020 # disappear from the arg list of tempfile
1021 my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
1022 delete $args{TEMPLATE};
1027 # Open the file and retain file handle and file name
1028 my ($fh, $path) = tempfile( @template, %args );
1030 print "Tmp: $fh - $path\n" if $DEBUG;
1032 # Store the filename in the scalar slot
1035 # Cache the filename by pid so that the destructor can decide whether to remove it
1036 $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
1038 # Store unlink information in hash slot (plus other constructor info)
1044 # final method-based configuration
1045 $fh->unlink_on_destroy( $unlink );
1052 Create a temporary directory using an object oriented interface.
1054 $dir = File::Temp->newdir();
1056 By default the directory is deleted when the object goes out of scope.
1058 Supports the same options as the C<tempdir> function. Note that directories
1059 created with this method default to CLEANUP => 1.
1061 $dir = File::Temp->newdir( $template, %options );
1068 # need to handle args as in tempdir because we have to force CLEANUP
1069 # default without passing CLEANUP to tempdir
1070 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1072 my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
1074 delete $options{CLEANUP};
1077 if (defined $template) {
1078 $tempdir = tempdir( $template, %options );
1080 $tempdir = tempdir( %options );
1082 return bless { DIRNAME => $tempdir,
1083 CLEANUP => $cleanup,
1085 }, "File::Temp::Dir";
1090 Return the name of the temporary file associated with this object
1091 (if the object was created using the "new" constructor).
1093 $filename = $tmp->filename;
1095 This method is called automatically when the object is used as
1107 return $self->filename;
1112 Return the name of the temporary directory associated with this
1113 object (if the object was created using the "newdir" constructor).
1115 $dirname = $tmpdir->dirname;
1117 This method is called automatically when the object is used in string context.
1119 =item B<unlink_on_destroy>
1121 Control whether the file is unlinked when the object goes out of scope.
1122 The file is removed if this value is true and $KEEP_ALL is not.
1124 $fh->unlink_on_destroy( 1 );
1126 Default is for the file to be removed.
1130 sub unlink_on_destroy {
1133 ${*$self}{UNLINK} = shift;
1135 return ${*$self}{UNLINK};
1140 When the object goes out of scope, the destructor is called. This
1141 destructor will attempt to unlink the file (using C<unlink1>)
1142 if the constructor was called with UNLINK set to 1 (the default state
1143 if UNLINK is not specified).
1145 No error is given if the unlink fails.
1147 If the object has been passed to a child process during a fork, the
1148 file will be deleted when the object goes out of scope in the parent.
1150 For a temporary directory object the directory will be removed
1151 unless the CLEANUP argument was used in the constructor (and set to
1152 false) or C<unlink_on_destroy> was modified after creation.
1154 If the global variable $KEEP_ALL is true, the file or directory
1155 will not be removed.
1161 if (${*$self}{UNLINK} && !$KEEP_ALL) {
1162 print "# ---------> Unlinking $self\n" if $DEBUG;
1164 # only delete if this process created it
1165 return unless exists $FILES_CREATED_BY_OBJECT{$$}{$self->filename};
1167 # The unlink1 may fail if the file has been closed
1168 # by the caller. This leaves us with the decision
1169 # of whether to refuse to remove the file or simply
1170 # do an unlink without test. Seems to be silly
1171 # to do this when we are trying to be careful
1173 _force_writable( $self->filename ); # for windows
1174 unlink1( $self, $self->filename )
1175 or unlink($self->filename);
1183 This section describes the recommended interface for generating
1184 temporary files and directories.
1190 This is the basic function to generate temporary files.
1191 The behaviour of the file can be changed using various options:
1194 ($fh, $filename) = tempfile();
1196 Create a temporary file in the directory specified for temporary
1197 files, as specified by the tmpdir() function in L<File::Spec>.
1199 ($fh, $filename) = tempfile($template);
1201 Create a temporary file in the current directory using the supplied
1202 template. Trailing `X' characters are replaced with random letters to
1203 generate the filename. At least four `X' characters must be present
1204 at the end of the template.
1206 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1208 Same as previously, except that a suffix is added to the template
1209 after the `X' translation. Useful for ensuring that a temporary
1210 filename has a particular extension when needed by other applications.
1211 But see the WARNING at the end.
1213 ($fh, $filename) = tempfile($template, DIR => $dir);
1215 Translates the template as before except that a directory name
1218 ($fh, $filename) = tempfile($template, TMPDIR => 1);
1220 Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
1221 into the same temporary directory as would be used if no template was
1224 ($fh, $filename) = tempfile($template, UNLINK => 1);
1226 Return the filename and filehandle as before except that the file is
1227 automatically removed when the program exits (dependent on
1228 $KEEP_ALL). Default is for the file to be removed if a file handle is
1229 requested and to be kept if the filename is requested. In a scalar
1230 context (where no filename is returned) the file is always deleted
1231 either (depending on the operating system) on exit or when it is
1232 closed (unless $KEEP_ALL is true when the temp file is created).
1234 Use the object-oriented interface if fine-grained control of when
1235 a file is removed is required.
1237 If the template is not specified, a template is always
1238 automatically generated. This temporary file is placed in tmpdir()
1239 (L<File::Spec>) unless a directory is specified explicitly with the
1242 $fh = tempfile( DIR => $dir );
1244 If called in scalar context, only the filehandle is returned and the
1245 file will automatically be deleted when closed on operating systems
1246 that support this (see the description of tmpfile() elsewhere in this
1247 document). This is the preferred mode of operation, as if you only
1248 have a filehandle, you can never create a race condition by fumbling
1249 with the filename. On systems that can not unlink an open file or can
1250 not mark a file as temporary when it is opened (for example, Windows
1251 NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
1252 the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
1253 flag is ignored if present.
1255 (undef, $filename) = tempfile($template, OPEN => 0);
1257 This will return the filename based on the template but
1258 will not open this file. Cannot be used in conjunction with
1259 UNLINK set to true. Default is to always open the file
1260 to protect from possible race conditions. A warning is issued
1261 if warnings are turned on. Consider using the tmpnam()
1262 and mktemp() functions described elsewhere in this document
1263 if opening the file is not required.
1265 If the operating system supports it (for example BSD derived systems), the
1266 filehandle will be opened with O_EXLOCK (open with exclusive file lock).
1267 This can sometimes cause problems if the intention is to pass the filename
1268 to another system that expects to take an exclusive lock itself (such as
1269 DBD::SQLite) whilst ensuring that the tempfile is not reused. In this
1270 situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK
1271 will be true (this retains compatibility with earlier releases).
1273 ($fh, $filename) = tempfile($template, EXLOCK => 0);
1275 Options can be combined as required.
1277 Will croak() if there is an error.
1283 # Can not check for argument count since we can have any
1288 "DIR" => undef, # Directory prefix
1289 "SUFFIX" => '', # Template suffix
1290 "UNLINK" => 0, # Do not unlink file on exit
1291 "OPEN" => 1, # Open file
1292 "TMPDIR" => 0, # Place tempfile in tempdir if template specified
1293 "EXLOCK" => 1, # Open file with O_EXLOCK
1296 # Check to see whether we have an odd or even number of arguments
1297 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
1299 # Read the options and merge with defaults
1300 %options = (%options, @_) if @_;
1302 # First decision is whether or not to open the file
1303 if (! $options{"OPEN"}) {
1305 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1310 if ($options{"DIR"} and $^O eq 'VMS') {
1312 # on VMS turn []foo into [.foo] for concatenation
1313 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1316 # Construct the template
1318 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1319 # functions or simply constructing a template and using _gettemp()
1320 # explicitly. Go for the latter
1322 # First generate a template if not defined and prefix the directory
1323 # If no template must prefix the temp directory
1324 if (defined $template) {
1325 # End up with current directory if neither DIR not TMPDIR are set
1326 if ($options{"DIR"}) {
1328 $template = File::Spec->catfile($options{"DIR"}, $template);
1330 } elsif ($options{TMPDIR}) {
1332 $template = File::Spec->catfile(File::Spec->tmpdir, $template );
1338 if ($options{"DIR"}) {
1340 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1344 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
1351 $template .= $options{"SUFFIX"};
1353 # Determine whether we should tell _gettemp to unlink the file
1354 # On unix this is irrelevant and can be worked out after the file is
1355 # opened (simply by unlinking the open filehandle). On Windows or VMS
1356 # we have to indicate temporary-ness when we open the file. In general
1357 # we only want a true temporary file if we are returning just the
1358 # filehandle - if the user wants the filename they probably do not
1359 # want the file to disappear as soon as they close it (which may be
1360 # important if they want a child process to use the file)
1361 # For this reason, tie unlink_on_close to the return context regardless
1363 my $unlink_on_close = ( wantarray ? 0 : 1);
1366 my ($fh, $path, $errstr);
1367 croak "Error in tempfile() using $template: $errstr"
1368 unless (($fh, $path) = _gettemp($template,
1369 "open" => $options{'OPEN'},
1371 "unlink_on_close" => $unlink_on_close,
1372 "suffixlen" => length($options{'SUFFIX'}),
1373 "ErrStr" => \$errstr,
1374 "use_exlock" => $options{EXLOCK},
1377 # Set up an exit handler that can do whatever is right for the
1378 # system. This removes files at exit when requested explicitly or when
1379 # system is asked to unlink_on_close but is unable to do so because
1380 # of OS limitations.
1381 # The latter should be achieved by using a tied filehandle.
1382 # Do not check return status since this is all done with END blocks.
1383 _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1388 if ($options{'OPEN'}) {
1389 return ($fh, $path);
1391 return (undef, $path);
1396 # Unlink the file. It is up to unlink0 to decide what to do with
1397 # this (whether to unlink now or to defer until later)
1398 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1400 # Return just the filehandle.
1409 This is the recommended interface for creation of temporary
1410 directories. By default the directory will not be removed on exit
1411 (that is, it won't be temporary; this behaviour can not be changed
1412 because of issues with backwards compatibility). To enable removal
1413 either use the CLEANUP option which will trigger removal on program
1414 exit, or consider using the "newdir" method in the object interface which
1415 will allow the directory to be cleaned up when the object goes out of
1418 The behaviour of the function depends on the arguments:
1420 $tempdir = tempdir();
1422 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1424 $tempdir = tempdir( $template );
1426 Create a directory from the supplied template. This template is
1427 similar to that described for tempfile(). `X' characters at the end
1428 of the template are replaced with random letters to construct the
1429 directory name. At least four `X' characters must be in the template.
1431 $tempdir = tempdir ( DIR => $dir );
1433 Specifies the directory to use for the temporary directory.
1434 The temporary directory name is derived from an internal template.
1436 $tempdir = tempdir ( $template, DIR => $dir );
1438 Prepend the supplied directory name to the template. The template
1439 should not include parent directory specifications itself. Any parent
1440 directory specifications are removed from the template before
1441 prepending the supplied directory.
1443 $tempdir = tempdir ( $template, TMPDIR => 1 );
1445 Using the supplied template, create the temporary directory in
1446 a standard location for temporary files. Equivalent to doing
1448 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1450 but shorter. Parent directory specifications are stripped from the
1451 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1452 explicitly. Additionally, C<TMPDIR> is implied if neither a template
1453 nor a directory are supplied.
1455 $tempdir = tempdir( $template, CLEANUP => 1);
1457 Create a temporary directory using the supplied template, but
1458 attempt to remove it (and all files inside it) when the program
1459 exits. Note that an attempt will be made to remove all files from
1460 the directory even if they were not created by this module (otherwise
1461 why ask to clean it up?). The directory removal is made with
1462 the rmtree() function from the L<File::Path|File::Path> module.
1463 Of course, if the template is not specified, the temporary directory
1464 will be created in tmpdir() and will also be removed at program exit.
1466 Will croak() if there is an error.
1474 # Can not check for argument count since we can have any
1479 "CLEANUP" => 0, # Remove directory on exit
1480 "DIR" => '', # Root directory
1481 "TMPDIR" => 0, # Use tempdir with template
1484 # Check to see whether we have an odd or even number of arguments
1485 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1487 # Read the options and merge with defaults
1488 %options = (%options, @_) if @_;
1490 # Modify or generate the template
1492 # Deal with the DIR and TMPDIR options
1493 if (defined $template) {
1495 # Need to strip directory path if using DIR or TMPDIR
1496 if ($options{'TMPDIR'} || $options{'DIR'}) {
1498 # Strip parent directory from the filename
1500 # There is no filename at the end
1501 $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1502 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1504 # Last directory is then our template
1505 $template = (File::Spec->splitdir($directories))[-1];
1507 # Prepend the supplied directory or temp dir
1508 if ($options{"DIR"}) {
1510 $template = File::Spec->catdir($options{"DIR"}, $template);
1512 } elsif ($options{TMPDIR}) {
1515 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1523 if ($options{"DIR"}) {
1525 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1529 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1535 # Create the directory
1538 if ($^O eq 'VMS') { # dir names can end in delimiters
1539 $template =~ m/([\.\]:>]+)$/;
1540 $suffixlen = length($1);
1542 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1543 # dir name has a trailing ':'
1548 croak "Error in tempdir() using $template: $errstr"
1549 unless ((undef, $tempdir) = _gettemp($template,
1552 "suffixlen" => $suffixlen,
1553 "ErrStr" => \$errstr,
1556 # Install exit handler; must be dynamic to get lexical
1557 if ( $options{'CLEANUP'} && -d $tempdir) {
1558 _deferred_unlink(undef, $tempdir, 1);
1561 # Return the dir name
1568 =head1 MKTEMP FUNCTIONS
1570 The following functions are Perl implementations of the
1571 mktemp() family of temp file generation system calls.
1577 Given a template, returns a filehandle to the temporary file and the name
1580 ($fh, $name) = mkstemp( $template );
1582 In scalar context, just the filehandle is returned.
1584 The template may be any filename with some number of X's appended
1585 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1586 with unique alphanumeric combinations.
1588 Will croak() if there is an error.
1596 croak "Usage: mkstemp(template)"
1599 my $template = shift;
1601 my ($fh, $path, $errstr);
1602 croak "Error in mkstemp using $template: $errstr"
1603 unless (($fh, $path) = _gettemp($template,
1607 "ErrStr" => \$errstr,
1611 return ($fh, $path);
1621 Similar to mkstemp(), except that an extra argument can be supplied
1622 with a suffix to be appended to the template.
1624 ($fh, $name) = mkstemps( $template, $suffix );
1626 For example a template of C<testXXXXXX> and suffix of C<.dat>
1627 would generate a file similar to F<testhGji_w.dat>.
1629 Returns just the filehandle alone when called in scalar context.
1631 Will croak() if there is an error.
1637 croak "Usage: mkstemps(template, suffix)"
1641 my $template = shift;
1644 $template .= $suffix;
1646 my ($fh, $path, $errstr);
1647 croak "Error in mkstemps using $template: $errstr"
1648 unless (($fh, $path) = _gettemp($template,
1651 "suffixlen" => length($suffix),
1652 "ErrStr" => \$errstr,
1656 return ($fh, $path);
1665 Create a directory from a template. The template must end in
1666 X's that are replaced by the routine.
1668 $tmpdir_name = mkdtemp($template);
1670 Returns the name of the temporary directory created.
1672 Directory must be removed by the caller.
1674 Will croak() if there is an error.
1682 croak "Usage: mkdtemp(template)"
1685 my $template = shift;
1687 if ($^O eq 'VMS') { # dir names can end in delimiters
1688 $template =~ m/([\.\]:>]+)$/;
1689 $suffixlen = length($1);
1691 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1692 # dir name has a trailing ':'
1695 my ($junk, $tmpdir, $errstr);
1696 croak "Error creating temp directory from template $template\: $errstr"
1697 unless (($junk, $tmpdir) = _gettemp($template,
1700 "suffixlen" => $suffixlen,
1701 "ErrStr" => \$errstr,
1710 Returns a valid temporary filename but does not guarantee
1711 that the file will not be opened by someone else.
1713 $unopened_file = mktemp($template);
1715 Template is the same as that required by mkstemp().
1717 Will croak() if there is an error.
1723 croak "Usage: mktemp(template)"
1726 my $template = shift;
1728 my ($tmpname, $junk, $errstr);
1729 croak "Error getting name to temp file from template $template: $errstr"
1730 unless (($junk, $tmpname) = _gettemp($template,
1734 "ErrStr" => \$errstr,
1742 =head1 POSIX FUNCTIONS
1744 This section describes the re-implementation of the tmpnam()
1745 and tmpfile() functions described in L<POSIX>
1746 using the mkstemp() from this module.
1748 Unlike the L<POSIX|POSIX> implementations, the directory used
1749 for the temporary file is not specified in a system include
1750 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1751 returned by L<File::Spec|File::Spec>. On some implementations this
1752 location can be set using the C<TMPDIR> environment variable, which
1754 If this is a problem, simply use mkstemp() and specify a template.
1760 When called in scalar context, returns the full name (including path)
1761 of a temporary file (uses mktemp()). The only check is that the file does
1762 not already exist, but there is no guarantee that that condition will
1767 When called in list context, a filehandle to the open file and
1768 a filename are returned. This is achieved by calling mkstemp()
1769 after constructing a suitable template.
1771 ($fh, $file) = tmpnam();
1773 If possible, this form should be used to prevent possible
1776 See L<File::Spec/tmpdir> for information on the choice of temporary
1777 directory for a particular operating system.
1779 Will croak() if there is an error.
1785 # Retrieve the temporary directory name
1786 my $tmpdir = File::Spec->tmpdir;
1788 croak "Error temporary directory is not writable"
1791 # Use a ten character template and append to tmpdir
1792 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1795 return mkstemp($template);
1797 return mktemp($template);
1804 Returns the filehandle of a temporary file.
1808 The file is removed when the filehandle is closed or when the program
1809 exits. No access to the filename is provided.
1811 If the temporary file can not be created undef is returned.
1812 Currently this command will probably not work when the temporary
1813 directory is on an NFS file system.
1815 Will croak() if there is an error.
1821 # Simply call tmpnam() in a list context
1822 my ($fh, $file) = tmpnam();
1824 # Make sure file is removed when filehandle is closed
1825 # This will fail on NFS
1835 =head1 ADDITIONAL FUNCTIONS
1837 These functions are provided for backwards compatibility
1838 with common tempfile generation C library functions.
1840 They are not exported and must be addressed using the full package
1847 Return the name of a temporary file in the specified directory
1848 using a prefix. The file is guaranteed not to exist at the time
1849 the function was called, but such guarantees are good for one
1850 clock tick only. Always use the proper form of C<sysopen>
1851 with C<O_CREAT | O_EXCL> if you must open such a filename.
1853 $filename = File::Temp::tempnam( $dir, $prefix );
1855 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1856 (using unix file convention as an example)
1858 Because this function uses mktemp(), it can suffer from race conditions.
1860 Will croak() if there is an error.
1866 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1868 my ($dir, $prefix) = @_;
1870 # Add a string to the prefix
1871 $prefix .= 'XXXXXXXX';
1873 # Concatenate the directory to the file
1874 my $template = File::Spec->catfile($dir, $prefix);
1876 return mktemp($template);
1882 =head1 UTILITY FUNCTIONS
1884 Useful functions for dealing with the filehandle and filename.
1890 Given an open filehandle and the associated filename, make a safe
1891 unlink. This is achieved by first checking that the filename and
1892 filehandle initially point to the same file and that the number of
1893 links to the file is 1 (all fields returned by stat() are compared).
1894 Then the filename is unlinked and the filehandle checked once again to
1895 verify that the number of links on that file is now 0. This is the
1896 closest you can come to making sure that the filename unlinked was the
1897 same as the file whose descriptor you hold.
1900 or die "Error unlinking file $path safely";
1902 Returns false on error but croaks() if there is a security
1903 anomaly. The filehandle is not closed since on some occasions this is
1906 On some platforms, for example Windows NT, it is not possible to
1907 unlink an open file (the file must be closed first). On those
1908 platforms, the actual unlinking is deferred until the program ends and
1909 good status is returned. A check is still performed to make sure that
1910 the filehandle and filename are pointing to the same thing (but not at
1911 the time the end block is executed since the deferred removal may not
1912 have access to the filehandle).
1914 Additionally, on Windows NT not all the fields returned by stat() can
1915 be compared. For example, the C<dev> and C<rdev> fields seem to be
1916 different. Also, it seems that the size of the file returned by stat()
1917 does not always agree, with C<stat(FH)> being more accurate than
1918 C<stat(filename)>, presumably because of caching issues even when
1919 using autoflush (this is usually overcome by waiting a while after
1920 writing to the tempfile before attempting to C<unlink0> it).
1922 Finally, on NFS file systems the link count of the file handle does
1923 not always go to zero immediately after unlinking. Currently, this
1924 command is expected to fail on NFS disks.
1926 This function is disabled if the global variable $KEEP_ALL is true
1927 and an unlink on open file is supported. If the unlink is to be deferred
1928 to the END block, the file is still registered for removal.
1930 This function should not be called if you are using the object oriented
1931 interface since the it will interfere with the object destructor deleting
1938 croak 'Usage: unlink0(filehandle, filename)'
1939 unless scalar(@_) == 2;
1942 my ($fh, $path) = @_;
1944 cmpstat($fh, $path) or return 0;
1946 # attempt remove the file (does not work on some platforms)
1947 if (_can_unlink_opened_file()) {
1949 # return early (Without unlink) if we have been instructed to retain files.
1950 return 1 if $KEEP_ALL;
1952 # XXX: do *not* call this on a directory; possible race
1953 # resulting in recursive removal
1954 croak "unlink0: $path has become a directory!" if -d $path;
1955 unlink($path) or return 0;
1957 # Stat the filehandle
1960 print "Link count = $fh[3] \n" if $DEBUG;
1962 # Make sure that the link count is zero
1963 # - Cygwin provides deferred unlinking, however,
1964 # on Win9x the link count remains 1
1965 # On NFS the link count may still be 1 but we cant know that
1967 return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
1970 _deferred_unlink($fh, $path, 0);
1978 Compare C<stat> of filehandle with C<stat> of provided filename. This
1979 can be used to check that the filename and filehandle initially point
1980 to the same file and that the number of links to the file is 1 (all
1981 fields returned by stat() are compared).
1984 or die "Error comparing handle with file";
1986 Returns false if the stat information differs or if the link count is
1987 greater than 1. Calls croak if there is a security anomaly.
1989 On certain platforms, for example Windows, not all the fields returned by stat()
1990 can be compared. For example, the C<dev> and C<rdev> fields seem to be
1991 different in Windows. Also, it seems that the size of the file
1992 returned by stat() does not always agree, with C<stat(FH)> being more
1993 accurate than C<stat(filename)>, presumably because of caching issues
1994 even when using autoflush (this is usually overcome by waiting a while
1995 after writing to the tempfile before attempting to C<unlink0> it).
1997 Not exported by default.
2003 croak 'Usage: cmpstat(filehandle, filename)'
2004 unless scalar(@_) == 2;
2007 my ($fh, $path) = @_;
2009 warn "Comparing stat\n"
2012 # Stat the filehandle - which may be closed if someone has manually
2013 # closed the file. Can not turn off warnings without using $^W
2014 # unless we upgrade to 5.006 minimum requirement
2022 if ($fh[3] > 1 && $^W) {
2023 carp "unlink0: fstat found too many links; SB=@fh" if $^W;
2027 my @path = stat $path;
2030 carp "unlink0: $path is gone already" if $^W;
2034 # this is no longer a file, but may be a directory, or worse
2036 confess "panic: $path is no longer a file: SB=@fh";
2039 # Do comparison of each member of the array
2040 # On WinNT dev and rdev seem to be different
2041 # depending on whether it is a file or a handle.
2042 # Cannot simply compare all members of the stat return
2043 # Select the ones we can use
2044 my @okstat = (0..$#fh); # Use all by default
2045 if ($^O eq 'MSWin32') {
2046 @okstat = (1,2,3,4,5,7,8,9,10);
2047 } elsif ($^O eq 'os2') {
2048 @okstat = (0, 2..$#fh);
2049 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
2051 } elsif ($^O eq 'dos') {
2052 @okstat = (0,2..7,11..$#fh);
2053 } elsif ($^O eq 'mpeix') {
2054 @okstat = (0..4,8..10);
2057 # Now compare each entry explicitly by number
2059 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
2060 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
2061 # and 12) will be '' on platforms that do not support them. This
2062 # is fine since we are only comparing integers.
2063 unless ($fh[$_] eq $path[$_]) {
2064 warn "Did not match $_ element of stat\n" if $DEBUG;
2074 Similar to C<unlink0> except after file comparison using cmpstat, the
2075 filehandle is closed prior to attempting to unlink the file. This
2076 allows the file to be removed without using an END block, but does
2077 mean that the post-unlink comparison of the filehandle state provided
2078 by C<unlink0> is not available.
2081 or die "Error closing and unlinking file";
2083 Usually called from the object destructor when using the OO interface.
2085 Not exported by default.
2087 This function is disabled if the global variable $KEEP_ALL is true.
2089 Can call croak() if there is a security anomaly during the stat()
2095 croak 'Usage: unlink1(filehandle, filename)'
2096 unless scalar(@_) == 2;
2099 my ($fh, $path) = @_;
2101 cmpstat($fh, $path) or return 0;
2104 close( $fh ) or return 0;
2106 # Make sure the file is writable (for windows)
2107 _force_writable( $path );
2109 # return early (without unlink) if we have been instructed to retain files.
2110 return 1 if $KEEP_ALL;
2113 return unlink($path);
2118 Calling this function will cause any temp files or temp directories
2119 that are registered for removal to be removed. This happens automatically
2120 when the process exits but can be triggered manually if the caller is sure
2121 that none of the temp files are required. This method can be registered as
2124 On OSes where temp files are automatically removed when the temp file
2125 is closed, calling this function will have no effect other than to remove
2126 temporary directories (which may include temporary files).
2128 File::Temp::cleanup();
2130 Not exported by default.
2134 =head1 PACKAGE VARIABLES
2136 These functions control the global state of the package.
2142 Controls the lengths to which the module will go to check the safety of the
2143 temporary file or directory before proceeding.
2150 Do the basic security measures to ensure the directory exists and is
2151 writable, that temporary files are opened only if they do not already
2152 exist, and that possible race conditions are avoided. Finally the
2153 L<unlink0|"unlink0"> function is used to remove files safely.
2157 In addition to the STANDARD security, the output directory is checked
2158 to make sure that it is owned either by root or the user running the
2159 program. If the directory is writable by group or by other, it is then
2160 checked to make sure that the sticky bit is set.
2162 Will not work on platforms that do not support the C<-k> test
2167 In addition to the MEDIUM security checks, also check for the
2168 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2169 sysconf() function. If this is a possibility, each directory in the
2170 path is checked in turn for safeness, recursively walking back to the
2173 For platforms that do not support the L<POSIX|POSIX>
2174 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2175 assumed that ``chown() giveaway'' is possible and the recursive test
2180 The level can be changed as follows:
2182 File::Temp->safe_level( File::Temp::HIGH );
2184 The level constants are not exported by the module.
2186 Currently, you must be running at least perl v5.6.0 in order to
2187 run with MEDIUM or HIGH security. This is simply because the
2188 safety tests use functions from L<Fcntl|Fcntl> that are not
2189 available in older versions of perl. The problem is that the version
2190 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2191 they are different versions.
2193 On systems that do not support the HIGH or MEDIUM safety levels
2194 (for example Win NT or OS/2) any attempt to change the level will
2195 be ignored. The decision to ignore rather than raise an exception
2196 allows portable programs to be written with high security in mind
2197 for the systems that can support this without those programs failing
2198 on systems where the extra tests are irrelevant.
2200 If you really need to see whether the change has been accepted
2201 simply examine the return value of C<safe_level>.
2203 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2204 die "Could not change to high security"
2205 if $newlevel != File::Temp::HIGH;
2210 # protect from using the variable itself
2211 my $LEVEL = STANDARD;
2216 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2217 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2219 # Dont allow this on perl 5.005 or earlier
2220 if ($] < 5.006 && $level != STANDARD) {
2221 # Cant do MEDIUM or HIGH checks
2222 croak "Currently requires perl 5.006 or newer to do the safe checks";
2224 # Check that we are allowed to change level
2225 # Silently ignore if we can not.
2226 $LEVEL = $level if _can_do_level($level);
2235 This is the highest UID on the current system that refers to a root
2236 UID. This is used to make sure that the temporary directory is
2237 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2240 This is required since on many unix systems C</tmp> is not owned
2243 Default is to assume that any UID less than or equal to 10 is a root
2246 File::Temp->top_system_uid(10);
2247 my $topid = File::Temp->top_system_uid;
2249 This value can be adjusted to reduce security checking if required.
2250 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2255 my $TopSystemUID = 10;
2256 $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2257 sub top_system_uid {
2261 croak "top_system_uid: UIDs should be numeric"
2262 unless $newuid =~ /^\d+$/s;
2263 $TopSystemUID = $newuid;
2265 return $TopSystemUID;
2271 Controls whether temporary files and directories should be retained
2272 regardless of any instructions in the program to remove them
2273 automatically. This is useful for debugging but should not be used in
2276 $File::Temp::KEEP_ALL = 1;
2278 Default is for files to be removed as requested by the caller.
2280 In some cases, files will only be retained if this variable is true
2281 when the file is created. This means that you can not create a temporary
2282 file, set this variable and expect the temp file to still be around
2283 when the program exits.
2287 Controls whether debugging messages should be enabled.
2289 $File::Temp::DEBUG = 1;
2291 Default is for debugging mode to be disabled.
2297 For maximum security, endeavour always to avoid ever looking at,
2298 touching, or even imputing the existence of the filename. You do not
2299 know that that filename is connected to the same file as the handle
2300 you have, and attempts to check this can only trigger more race
2301 conditions. It's far more secure to use the filehandle alone and
2302 dispense with the filename altogether.
2304 If you need to pass the handle to something that expects a filename
2305 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
2306 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
2307 programs. You will have to clear the close-on-exec bit on that file
2308 descriptor before passing it to another process.
2310 use Fcntl qw/F_SETFD F_GETFD/;
2311 fcntl($tmpfh, F_SETFD, 0)
2312 or die "Can't clear close-on-exec flag on temp fh: $!\n";
2314 =head2 Temporary files and NFS
2316 Some problems are associated with using temporary files that reside
2317 on NFS file systems and it is recommended that a local filesystem
2318 is used whenever possible. Some of the security tests will most probably
2319 fail when the temp file is not local. Additionally, be aware that
2320 the performance of I/O operations over NFS will not be as good as for
2325 In some cases files created by File::Temp are removed from within an
2326 END block. Since END blocks are triggered when a child process exits
2327 (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2328 to only remove those temp files created by a particular process ID. This
2329 means that a child will not attempt to remove temp files created by the
2332 If you are forking many processes in parallel that are all creating
2333 temporary files, you may need to reset the random number seed using
2334 srand(EXPR) in each child else all the children will attempt to walk
2335 through the same set of random file names and may well cause
2336 themselves to give up if they exceed the number of retry attempts.
2340 The file returned by File::Temp will have been opened in binary mode
2341 if such a mode is available. If that is not correct, use the C<binmode()>
2342 function to change the mode of the filehandle.
2344 Note that you can modify the encoding of a file opened by File::Temp
2345 also by using C<binmode()>.
2349 Originally began life in May 1999 as an XS interface to the system
2350 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2351 translated to Perl for total control of the code's
2352 security checking, to ensure the presence of the function regardless of
2353 operating system and to help with portability. The module was shipped
2354 as a standard part of perl from v5.6.1.
2358 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2360 See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
2361 different implementations of temporary file handling.
2363 See L<File::Tempdir> for an alternative object-oriented wrapper for
2364 the C<tempdir> function.
2368 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
2370 Copyright (C) 2007 Tim Jenness.
2371 Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
2372 Astronomy Research Council. All Rights Reserved. This program is free
2373 software; you can redistribute it and/or modify it under the same
2374 terms as Perl itself.
2376 Original Perl implementation loosely based on the OpenBSD C code for
2377 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
2378 should be written and providing ideas for code improvements and
2379 security enhancements.
2383 package File::Temp::Dir;
2385 use File::Path qw/ rmtree /;
2387 use overload '""' => "STRINGIFY", fallback => 1;
2389 # private class specifically to support tempdir objects
2390 # created by File::Temp->newdir
2392 # ostensibly the same method interface as File::Temp but without
2393 # inheriting all the IO::Seekable methods and other cruft
2395 # Read-only - returns the name of the temp directory
2399 return $self->{DIRNAME};
2404 return $self->dirname;
2407 sub unlink_on_destroy {
2410 $self->{CLEANUP} = shift;
2412 return $self->{CLEANUP};
2417 if ($self->unlink_on_destroy &&
2418 $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
2419 rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0)
2420 if -d $self->{DIRNAME};