← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/share/perl/5.18/File/Temp.pm
StatementsExecuted 262 statements in 5.99ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111564µs769µsFile::Temp::::BEGIN@150 File::Temp::BEGIN@150
221139µs423µsFile::Temp::::_gettemp File::Temp::_gettemp
21167µs98µsFile::Temp::::_replace_XX File::Temp::_replace_XX
11159µs59µsFile::Temp::::CORE:sysopen File::Temp::CORE:sysopen (opcode)
11155µs55µsFile::Temp::::CORE:mkdir File::Temp::CORE:mkdir (opcode)
11145µs323µsFile::Temp::::tempfile File::Temp::tempfile
22138µs61µsFile::Temp::::_deferred_unlink File::Temp::_deferred_unlink
11138µs395µsFile::Temp::::tempdir File::Temp::tempdir
22134µs34µsFile::Temp::::_parse_args File::Temp::_parse_args
22117µs17µsFile::Temp::::CORE:chmod File::Temp::CORE:chmod (opcode)
191116µs16µsFile::Temp::::CORE:substcont File::Temp::CORE:substcont (opcode)
11114µs216µsFile::Temp::::BEGIN@148 File::Temp::BEGIN@148
11113µs13µsFile::Temp::::BEGIN@142 File::Temp::BEGIN@142
11112µs41µsFile::Temp::Dir::::BEGIN@2488File::Temp::Dir::BEGIN@2488
21110µs10µsFile::Temp::::CORE:ftis File::Temp::CORE:ftis (opcode)
1119µs19µsFile::Temp::::BEGIN@143 File::Temp::BEGIN@143
1119µs30µsFile::Temp::::BEGIN@224 File::Temp::BEGIN@224
1119µs17µsFile::Temp::::BEGIN@145 File::Temp::BEGIN@145
1119µs104µsFile::Temp::::BEGIN@165 File::Temp::BEGIN@165
2119µs9µsFile::Temp::::CORE:regcomp File::Temp::CORE:regcomp (opcode)
4118µs8µsFile::Temp::::safe_level File::Temp::safe_level
1117µs35µsFile::Temp::::BEGIN@166 File::Temp::BEGIN@166
1117µs34µsFile::Temp::::BEGIN@147 File::Temp::BEGIN@147
1117µs27µsFile::Temp::::BEGIN@151 File::Temp::BEGIN@151
1117µs18µsFile::Temp::::BEGIN@177 File::Temp::BEGIN@177
1117µs28µsFile::Temp::::BEGIN@149 File::Temp::BEGIN@149
1117µs55µsFile::Temp::::BEGIN@170 File::Temp::BEGIN@170
1117µs38µsFile::Temp::Dir::::BEGIN@2490File::Temp::Dir::BEGIN@2490
1116µs42µsFile::Temp::::BEGIN@221 File::Temp::BEGIN@221
1116µs36µsFile::Temp::::BEGIN@144 File::Temp::BEGIN@144
1116µs26µsFile::Temp::::BEGIN@228 File::Temp::BEGIN@228
2116µs6µsFile::Temp::::CORE:match File::Temp::CORE:match (opcode)
1116µs25µsFile::Temp::::BEGIN@232 File::Temp::BEGIN@232
1116µs17µsFile::Temp::Dir::::BEGIN@2489File::Temp::Dir::BEGIN@2489
1116µs25µsFile::Temp::::BEGIN@233 File::Temp::BEGIN@233
1116µs13µsFile::Temp::::BEGIN@245 File::Temp::BEGIN@245
2116µs6µsFile::Temp::::CORE:subst File::Temp::CORE:subst (opcode)
1115µs24µsFile::Temp::::BEGIN@234 File::Temp::BEGIN@234
1115µs12µsFile::Temp::::BEGIN@275 File::Temp::BEGIN@275
4314µs4µsFile::Temp::::CORE:ftdir File::Temp::CORE:ftdir (opcode)
1113µs3µsFile::Temp::::BEGIN@146 File::Temp::BEGIN@146
1111µs1µsFile::Temp::::CORE:ftfile File::Temp::CORE:ftfile (opcode)
111800ns800nsFile::Temp::::__ANON__[:249] File::Temp::__ANON__[:249]
111600ns600nsFile::Temp::::__ANON__[:257] File::Temp::__ANON__[:257]
111600ns600nsFile::Temp::::__ANON__[:279] File::Temp::__ANON__[:279]
0000s0sFile::Temp::::DESTROY File::Temp::DESTROY
0000s0sFile::Temp::Dir::::DESTROYFile::Temp::Dir::DESTROY
0000s0sFile::Temp::Dir::::STRINGIFYFile::Temp::Dir::STRINGIFY
0000s0sFile::Temp::Dir::::dirnameFile::Temp::Dir::dirname
0000s0sFile::Temp::Dir::::unlink_on_destroyFile::Temp::Dir::unlink_on_destroy
0000s0sFile::Temp::::END File::Temp::END
0000s0sFile::Temp::::NUMIFY File::Temp::NUMIFY
0000s0sFile::Temp::::STRINGIFY File::Temp::STRINGIFY
0000s0sFile::Temp::::__ANON__[:250] File::Temp::__ANON__[:250]
0000s0sFile::Temp::::__ANON__[:258] File::Temp::__ANON__[:258]
0000s0sFile::Temp::::__ANON__[:280] File::Temp::__ANON__[:280]
0000s0sFile::Temp::::_can_do_level File::Temp::_can_do_level
0000s0sFile::Temp::::_can_unlink_opened_file File::Temp::_can_unlink_opened_file
0000s0sFile::Temp::::_force_writable File::Temp::_force_writable
0000s0sFile::Temp::::_is_safe File::Temp::_is_safe
0000s0sFile::Temp::::_is_verysafe File::Temp::_is_verysafe
0000s0sFile::Temp::::cleanup File::Temp::cleanup
0000s0sFile::Temp::::cmpstat File::Temp::cmpstat
0000s0sFile::Temp::::filename File::Temp::filename
0000s0sFile::Temp::::mkdtemp File::Temp::mkdtemp
0000s0sFile::Temp::::mkstemp File::Temp::mkstemp
0000s0sFile::Temp::::mkstemps File::Temp::mkstemps
0000s0sFile::Temp::::mktemp File::Temp::mktemp
0000s0sFile::Temp::::new File::Temp::new
0000s0sFile::Temp::::newdir File::Temp::newdir
0000s0sFile::Temp::::tempnam File::Temp::tempnam
0000s0sFile::Temp::::tmpfile File::Temp::tmpfile
0000s0sFile::Temp::::tmpnam File::Temp::tmpnam
0000s0sFile::Temp::::top_system_uid File::Temp::top_system_uid
0000s0sFile::Temp::::unlink0 File::Temp::unlink0
0000s0sFile::Temp::::unlink1 File::Temp::unlink1
0000s0sFile::Temp::::unlink_on_destroy File::Temp::unlink_on_destroy
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package File::Temp;
2
3=head1 NAME
4
5File::Temp - return name and handle of a temporary file safely
6
7=begin __INTERNALS
8
9=head1 PORTABILITY
10
11This section is at the top in order to provide easier access to
12porters. It is not expected to be rendered by a standard pod
13formatting tool. Please skip straight to the SYNOPSIS section if you
14are not trying to port this module to a new platform.
15
16This module is designed to be portable across operating systems and it
17currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
18(Classic). When porting to a new OS there are generally three main
19issues that have to be solved:
20
21=over 4
22
23=item *
24
25Can the OS unlink an open file? If it can not then the
26C<_can_unlink_opened_file> method should be modified.
27
28=item *
29
30Are the return values from C<stat> reliable? By default all the
31return values from C<stat> are compared when unlinking a temporary
32file using the filename and the handle. Operating systems other than
33unix do not always have valid entries in all fields. If utility function
34C<File::Temp::unlink0> fails then the C<stat> comparison should be
35modified accordingly.
36
37=item *
38
39Security. Systems that can not support a test for the sticky bit
40on a directory can not use the MEDIUM and HIGH security tests.
41The C<_can_do_level> method should be modified accordingly.
42
43=back
44
45=end __INTERNALS
46
47=head1 SYNOPSIS
48
49 use File::Temp qw/ tempfile tempdir /;
50
51 $fh = tempfile();
52 ($fh, $filename) = tempfile();
53
54 ($fh, $filename) = tempfile( $template, DIR => $dir);
55 ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
56 ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
57
58 binmode( $fh, ":utf8" );
59
60 $dir = tempdir( CLEANUP => 1 );
61 ($fh, $filename) = tempfile( DIR => $dir );
62
63Object interface:
64
65 require File::Temp;
66 use File::Temp ();
67 use File::Temp qw/ :seekable /;
68
69 $fh = File::Temp->new();
70 $fname = $fh->filename;
71
72 $fh = File::Temp->new(TEMPLATE => $template);
73 $fname = $fh->filename;
74
75 $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
76 print $tmp "Some data\n";
77 print "Filename is $tmp\n";
78 $tmp->seek( 0, SEEK_END );
79
80The following interfaces are provided for compatibility with
81existing APIs. They should not be used in new code.
82
83MkTemp family:
84
85 use File::Temp qw/ :mktemp /;
86
87 ($fh, $file) = mkstemp( "tmpfileXXXXX" );
88 ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
89
90 $tmpdir = mkdtemp( $template );
91
92 $unopened_file = mktemp( $template );
93
94POSIX functions:
95
96 use File::Temp qw/ :POSIX /;
97
98 $file = tmpnam();
99 $fh = tmpfile();
100
101 ($fh, $file) = tmpnam();
102
103Compatibility functions:
104
105 $unopened_file = File::Temp::tempnam( $dir, $pfx );
106
107=head1 DESCRIPTION
108
109C<File::Temp> can be used to create and open temporary files in a safe
110way. There is both a function interface and an object-oriented
111interface. The File::Temp constructor or the tempfile() function can
112be used to return the name and the open filehandle of a temporary
113file. The tempdir() function can be used to create a temporary
114directory.
115
116The security aspect of temporary file creation is emphasized such that
117a filehandle and filename are returned together. This helps guarantee
118that a race condition can not occur where the temporary file is
119created by another process between checking for the existence of the
120file and its opening. Additional security levels are provided to
121check, for example, that the sticky bit is set on world writable
122directories. See L<"safe_level"> for more information.
123
124For compatibility with popular C library functions, Perl implementations of
125the mkstemp() family of functions are provided. These are, mkstemp(),
126mkstemps(), mkdtemp() and mktemp().
127
128Additionally, implementations of the standard L<POSIX|POSIX>
129tmpnam() and tmpfile() functions are provided if required.
130
131Implementations of mktemp(), tmpnam(), and tempnam() are provided,
132but should be used with caution since they return only a filename
133that was valid when function was called, so cannot guarantee
134that the file will not exist by the time the caller opens the filename.
135
136Filehandles returned by these functions support the seekable methods.
137
138=cut
139
140# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
141# People would like a version on 5.004 so give them what they want :-)
142237µs113µs
# spent 13µs within File::Temp::BEGIN@142 which was called: # once (13µs+0s) by Path::Class::Dir::BEGIN@14 at line 142
use 5.004;
# spent 13µs making 1 call to File::Temp::BEGIN@142
143219µs229µs
# spent 19µs (9+10) within File::Temp::BEGIN@143 which was called: # once (9µs+10µs) by Path::Class::Dir::BEGIN@14 at line 143
use strict;
# spent 19µs making 1 call to File::Temp::BEGIN@143 # spent 10µs making 1 call to strict::import
144222µs266µs
# spent 36µs (6+30) within File::Temp::BEGIN@144 which was called: # once (6µs+30µs) by Path::Class::Dir::BEGIN@14 at line 144
use Carp;
# spent 36µs making 1 call to File::Temp::BEGIN@144 # spent 30µs making 1 call to Exporter::import
145331µs225µs
# spent 17µs (9+8) within File::Temp::BEGIN@145 which was called: # once (9µs+8µs) by Path::Class::Dir::BEGIN@14 at line 145
use File::Spec 0.8;
# spent 17µs making 1 call to File::Temp::BEGIN@145 # spent 8µs making 1 call to UNIVERSAL::VERSION
146219µs13µs
# spent 3µs within File::Temp::BEGIN@146 which was called: # once (3µs+0s) by Path::Class::Dir::BEGIN@14 at line 146
use Cwd ();
# spent 3µs making 1 call to File::Temp::BEGIN@146
147222µs261µs
# spent 34µs (7+27) within File::Temp::BEGIN@147 which was called: # once (7µs+27µs) by Path::Class::Dir::BEGIN@14 at line 147
use File::Path qw/ rmtree /;
# spent 34µs making 1 call to File::Temp::BEGIN@147 # spent 27µs making 1 call to Exporter::import
148334µs3418µs
# spent 216µs (14+202) within File::Temp::BEGIN@148 which was called: # once (14µs+202µs) by Path::Class::Dir::BEGIN@14 at line 148
use Fcntl 1.03;
# spent 216µs making 1 call to File::Temp::BEGIN@148 # spent 196µs making 1 call to Exporter::import # spent 6µs making 1 call to UNIVERSAL::VERSION
149219µs250µs
# spent 28µs (7+22) within File::Temp::BEGIN@149 which was called: # once (7µs+22µs) by Path::Class::Dir::BEGIN@14 at line 149
use IO::Seekable; # For SEEK_*
# spent 28µs making 1 call to File::Temp::BEGIN@149 # spent 22µs making 1 call to Exporter::import
150295µs2781µs
# spent 769µs (564+205) within File::Temp::BEGIN@150 which was called: # once (564µs+205µs) by Path::Class::Dir::BEGIN@14 at line 150
use Errno;
# spent 769µs making 1 call to File::Temp::BEGIN@150 # spent 12µs making 1 call to Exporter::import
151247µs246µs
# spent 27µs (7+20) within File::Temp::BEGIN@151 which was called: # once (7µs+20µs) by Path::Class::Dir::BEGIN@14 at line 151
use Scalar::Util 'refaddr';
# spent 27µs making 1 call to File::Temp::BEGIN@151 # spent 20µs making 1 call to Exporter::import
15211µsrequire VMS::Stdio if $^O eq 'VMS';
153
154# pre-emptively load Carp::Heavy. If we don't when we run out of file
155# handles and attempt to call croak() we get an error message telling
156# us that Carp::Heavy won't load rather than an error telling us we
157# have run out of file handles. We either preload croak() or we
158# switch the calls to croak from _gettemp() to use die.
159274µseval { require Carp::Heavy; };
160
161# Need the Symbol package if we are running older perl
1621900nsrequire Symbol if $] < 5.006;
163
164### For the OO interface
165228µs2199µs
# spent 104µs (9+95) within File::Temp::BEGIN@165 which was called: # once (9µs+95µs) by Path::Class::Dir::BEGIN@14 at line 165
use base qw/ IO::Handle IO::Seekable /;
# spent 104µs making 1 call to File::Temp::BEGIN@165 # spent 95µs making 1 call to base::import
16615µs128µs
# spent 35µs (7+28) within File::Temp::BEGIN@166 which was called: # once (7µs+28µs) by Path::Class::Dir::BEGIN@14 at line 167
use overload '""' => "STRINGIFY", '0+' => "NUMIFY",
# spent 28µs making 1 call to overload::import
167120µs135µs fallback => 1;
# spent 35µs making 1 call to File::Temp::BEGIN@166
168
169# use 'our' on v5.6.0
170230µs2103µs
# spent 55µs (7+48) within File::Temp::BEGIN@170 which was called: # once (7µs+48µs) by Path::Class::Dir::BEGIN@14 at line 170
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
# spent 55µs making 1 call to File::Temp::BEGIN@170 # spent 48µs making 1 call to vars::import
171
1721100ns$DEBUG = 0;
1731100ns$KEEP_ALL = 0;
174
175# We are exporting functions
176
177280µs229µs
# spent 18µs (7+11) within File::Temp::BEGIN@177 which was called: # once (7µs+11µs) by Path::Class::Dir::BEGIN@14 at line 177
use base qw/Exporter/;
# spent 18µs making 1 call to File::Temp::BEGIN@177 # spent 11µs making 1 call to base::import
178
179# Export list - to allow fine tuning of export table
180
18112µs@EXPORT_OK = qw{
182 tempfile
183 tempdir
184 tmpnam
185 tmpfile
186 mktemp
187 mkstemp
188 mkstemps
189 mkdtemp
190 unlink0
191 cleanup
192 SEEK_SET
193 SEEK_CUR
194 SEEK_END
195 };
196
197# Groups of functions for export
198
19913µs%EXPORT_TAGS = (
200 'POSIX' => [qw/ tmpnam tmpfile /],
201 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
202 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
203 );
204
205# add contents of these tags to @EXPORT
20612µs121µsExporter::export_tags('POSIX','mktemp','seekable');
# spent 21µs making 1 call to Exporter::export_tags
207
208# Version number
209
2101300ns$VERSION = '0.23';
211
212# This is a list of characters that can be used in random filenames
213
21417µsmy @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
215 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
216 0 1 2 3 4 5 6 7 8 9 _
217 /);
218
219# Maximum number of tries to make a temp file before failing
220
221222µs277µs
# spent 42µs (6+36) within File::Temp::BEGIN@221 which was called: # once (6µs+36µs) by Path::Class::Dir::BEGIN@14 at line 221
use constant MAX_TRIES => 1000;
# spent 42µs making 1 call to File::Temp::BEGIN@221 # spent 36µs making 1 call to constant::import
222
223# Minimum number of X characters that should be in a template
224228µs251µs
# spent 30µs (9+21) within File::Temp::BEGIN@224 which was called: # once (9µs+21µs) by Path::Class::Dir::BEGIN@14 at line 224
use constant MINX => 4;
# spent 30µs making 1 call to File::Temp::BEGIN@224 # spent 21µs making 1 call to constant::import
225
226# Default template when no template supplied
227
228221µs247µs
# spent 26µs (6+20) within File::Temp::BEGIN@228 which was called: # once (6µs+20µs) by Path::Class::Dir::BEGIN@14 at line 228
use constant TEMPXXX => 'X' x 10;
# spent 26µs making 1 call to File::Temp::BEGIN@228 # spent 20µs making 1 call to constant::import
229
230# Constants for the security level
231
232218µs245µs
# spent 25µs (6+20) within File::Temp::BEGIN@232 which was called: # once (6µs+20µs) by Path::Class::Dir::BEGIN@14 at line 232
use constant STANDARD => 0;
# spent 25µs making 1 call to File::Temp::BEGIN@232 # spent 20µs making 1 call to constant::import
233218µs244µs
# spent 25µs (6+19) within File::Temp::BEGIN@233 which was called: # once (6µs+19µs) by Path::Class::Dir::BEGIN@14 at line 233
use constant MEDIUM => 1;
# spent 25µs making 1 call to File::Temp::BEGIN@233 # spent 19µs making 1 call to constant::import
234260µs243µs
# spent 24µs (5+19) within File::Temp::BEGIN@234 which was called: # once (5µs+19µs) by Path::Class::Dir::BEGIN@14 at line 234
use constant HIGH => 2;
# spent 24µs making 1 call to File::Temp::BEGIN@234 # spent 19µs making 1 call to constant::import
235
236# OPENFLAGS. If we defined the flag to use with Sysopen here this gives
237# us an optimisation when many temporary files are requested
238
2391200nsmy $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
2401100nsmy $LOCKFLAG;
241
24211µsunless ($^O eq 'MacOS') {
2431600ns for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
24442µs my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
2452132µs221µs
# spent 13µs (6+8) within File::Temp::BEGIN@245 which was called: # once (6µs+8µs) by Path::Class::Dir::BEGIN@14 at line 245
no strict 'refs';
# spent 13µs making 1 call to File::Temp::BEGIN@245 # spent 8µs making 1 call to strict::unimport
24642µs $OPENFLAGS |= $bit if eval {
247 # Make sure that redefined die handlers do not cause problems
248 # e.g. CGI::Carp
249512µs
# spent 800ns within File::Temp::__ANON__[/usr/share/perl/5.18/File/Temp.pm:249] which was called: # once (800ns+0s) by Fcntl::O_NOINHERIT at line 251
local $SIG{__DIE__} = sub {};
25046µs local $SIG{__WARN__} = sub {};
251444µs532µs $bit = &$func();
# spent 20µs making 1 call to Fcntl::O_NOINHERIT # spent 4µs making 1 call to Fcntl::O_NOFOLLOW # spent 3µs making 1 call to Fcntl::O_LARGEFILE # spent 3µs making 1 call to Fcntl::O_BINARY # spent 800ns making 1 call to File::Temp::__ANON__[File/Temp.pm:249]
25237µs 1;
253 };
254 }
255 # Special case O_EXLOCK
2561100ns $LOCKFLAG = eval {
25724µs
# spent 600ns within File::Temp::__ANON__[/usr/share/perl/5.18/File/Temp.pm:257] which was called: # once (600ns+0s) by Fcntl::O_EXLOCK at line 259
local $SIG{__DIE__} = sub {};
25811µs local $SIG{__WARN__} = sub {};
259110µs29µs &Fcntl::O_EXLOCK();
# spent 8µs making 1 call to Fcntl::O_EXLOCK # spent 600ns making 1 call to File::Temp::__ANON__[File/Temp.pm:257]
260 };
261}
262
263# On some systems the O_TEMPORARY flag can be used to tell the OS
264# to automatically remove the file when it is closed. This is fine
265# in most cases but not if tempfile is called with UNLINK=>0 and
266# the filename is requested -- in the case where the filename is to
267# be passed to another routine. This happens on windows. We overcome
268# this by using a second open flags variable
269
2701200nsmy $OPENTEMPFLAGS = $OPENFLAGS;
2711800nsunless ($^O eq 'MacOS') {
2721400ns for my $oflag (qw/ TEMPORARY /) {
2731600ns my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
2741100ns local($@);
27524.13ms220µs
# spent 12µs (5+7) within File::Temp::BEGIN@275 which was called: # once (5µs+7µs) by Path::Class::Dir::BEGIN@14 at line 275
no strict 'refs';
# spent 12µs making 1 call to File::Temp::BEGIN@275 # spent 7µs making 1 call to strict::unimport
2761600ns $OPENTEMPFLAGS |= $bit if eval {
277 # Make sure that redefined die handlers do not cause problems
278 # e.g. CGI::Carp
27924µs
# spent 600ns within File::Temp::__ANON__[/usr/share/perl/5.18/File/Temp.pm:279] which was called: # once (600ns+0s) by Fcntl::O_TEMPORARY at line 281
local $SIG{__DIE__} = sub {};
28011µs local $SIG{__WARN__} = sub {};
281110µs29µs $bit = &$func();
# spent 9µs making 1 call to Fcntl::O_TEMPORARY # spent 600ns making 1 call to File::Temp::__ANON__[File/Temp.pm:279]
282 1;
283 };
284 }
285}
286
287# Private hash tracking which files have been created by each process id via the OO interface
2881100nsmy %FILES_CREATED_BY_OBJECT;
289
290# INTERNAL ROUTINES - not to be used outside of package
291
292# Generic routine for getting a temporary filename
293# modelled on OpenBSD _gettemp() in mktemp.c
294
295# The template must contain X's that are to be replaced
296# with the random values
297
298# Arguments:
299
300# TEMPLATE - string containing the XXXXX's that is converted
301# to a random filename and opened if required
302
303# Optionally, a hash can also be supplied containing specific options
304# "open" => if true open the temp file, else just return the name
305# default is 0
306# "mkdir"=> if true, we are creating a temp directory rather than tempfile
307# default is 0
308# "suffixlen" => number of characters at end of PATH to be ignored.
309# default is 0.
310# "unlink_on_close" => indicates that, if possible, the OS should remove
311# the file as soon as it is closed. Usually indicates
312# use of the O_TEMPORARY flag to sysopen.
313# Usually irrelevant on unix
314# "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
315
316# Optionally a reference to a scalar can be passed into the function
317# On error this will be used to store the reason for the error
318# "ErrStr" => \$errstr
319
320# "open" and "mkdir" can not both be true
321# "unlink_on_close" is not used when "mkdir" is true.
322
323# The default options are equivalent to mktemp().
324
325# Returns:
326# filehandle - open file handle (if called with doopen=1, else undef)
327# temp name - name of the temp file or directory
328
329# For example:
330# ($fh, $name) = _gettemp($template, "open" => 1);
331
332# for the current version, failures are associated with
333# stored in an error string and returned to give the reason whilst debugging
334# This routine is not called by any external function
335
# spent 423µs (139+284) within File::Temp::_gettemp which was called 2 times, avg 212µs/call: # once (76µs+156µs) by File::Temp::tempdir at line 1634 # once (63µs+129µs) by File::Temp::tempfile at line 1449
sub _gettemp {
336
33721µs croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
338 unless scalar(@_) >= 1;
339
340 # the internal error string - expect it to be overridden
341 # Need this in case the caller decides not to supply us a value
342 # need an anonymous scalar
3432300ns my $tempErrStr;
344
345 # Default options
34628µs my %options = (
347 "open" => 0,
348 "mkdir" => 0,
349 "suffixlen" => 0,
350 "unlink_on_close" => 0,
351 "use_exlock" => 1,
352 "ErrStr" => \$tempErrStr,
353 );
354
355 # Read the template
35621µs my $template = shift;
3572600ns if (ref($template)) {
358 # Use a warning here since we have not yet merged ErrStr
359 carp "File::Temp::_gettemp: template must not be a reference";
360 return ();
361 }
362
363 # Check that the number of entries on stack are even
36421µs if (scalar(@_) % 2 != 0) {
365 # Use a warning here since we have not yet merged ErrStr
366 carp "File::Temp::_gettemp: Must have even number of options";
367 return ();
368 }
369
370 # Read the options and merge with defaults
371210µs %options = (%options, @_) if @_;
372
373 # Make sure the error string is set to undef
37422µs ${$options{ErrStr}} = undef;
375
376 # Can not open the file and make a directory in a single call
37721µs if ($options{"open"} && $options{"mkdir"}) {
378 ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
379 return ();
380 }
381
382 # Find the start of the end of the Xs (position of last X)
383 # Substr starts from 0
38423µs my $start = length($template) - 1 - $options{"suffixlen"};
385
386 # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
387 # (taking suffixlen into account). Any fewer is insecure.
388
389 # Do it using substr - no reason to use a pattern match since
390 # we know where we are looking and what we are looking for
391
39223µs if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
393 ${$options{ErrStr}} = "The template must end with at least ".
394 MINX . " 'X' characters\n";
395 return ();
396 }
397
398 # Replace all the X at the end of the substring with a
399 # random character or just all the XX at the end of a full string.
400 # Do it as an if, since the suffix adjusts which section to replace
401 # and suffixlen=0 returns nothing if used in the substr directly
402 # and generate a full path from the template
403
40425µs298µs my $path = _replace_XX($template, $options{"suffixlen"});
# spent 98µs making 2 calls to File::Temp::_replace_XX, avg 49µs/call
405
406
407 # Split the path into constituent parts - eventually we need to check
408 # whether the directory exists
409 # We need to know whether we are making a temp directory
410 # or a tempfile
411
4122300ns my ($volume, $directories, $file);
413 my $parent; # parent directory
41421µs if ($options{"mkdir"}) {
415 # There is no filename at the end
41613µs14µs ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
# spent 4µs making 1 call to File::Spec::Unix::splitpath
417
418 # The parent is then $directories without the last directory
419 # Split the directory and put it back together again
42012µs13µs my @dirs = File::Spec->splitdir($directories);
# spent 3µs making 1 call to File::Spec::Unix::splitdir
421
422 # If @dirs only has one entry (i.e. the directory template) that means
423 # we are in the current directory
42411µs if ($#dirs == 0) {
425 $parent = File::Spec->curdir;
426 } else {
427
4281900ns if ($^O eq 'VMS') { # need volume to avoid relative dir spec
429 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
430 $parent = 'sys$disk:[]' if $parent eq '';
431 } else {
432
433 # Put it back together without the last one
43414µs113µs $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
# spent 13µs making 1 call to File::Spec::Unix::catdir
435
436 # ...and attach the volume (no filename)
43712µs14µs $parent = File::Spec->catpath($volume, $parent, '');
# spent 4µs making 1 call to File::Spec::Unix::catpath
438 }
439
440 }
441
442 } else {
443
444 # Get rid of the last filename (use File::Basename for this?)
44515µs110µs ($volume, $directories, $file) = File::Spec->splitpath( $path );
# spent 10µs making 1 call to File::Spec::Unix::splitpath
446
447 # Join up without the file part
44813µs13µs $parent = File::Spec->catpath($volume,$directories,'');
# spent 3µs making 1 call to File::Spec::Unix::catpath
449
450 # If $parent is empty replace with curdir
4511500ns $parent = File::Spec->curdir
452 unless $directories ne '';
453
454 }
455
456 # Check that the parent directories exist
457 # Do this even for the case where we are simply returning a name
458 # not a file -- no point returning a name that includes a directory
459 # that does not exist or is not writable
460
461217µs210µs unless (-e $parent) {
# spent 10µs making 2 calls to File::Temp::CORE:ftis, avg 5µs/call
462 ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
463 return ();
464 }
46527µs22µs unless (-d $parent) {
# spent 2µs making 2 calls to File::Temp::CORE:ftdir, avg 850ns/call
466 ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
467 return ();
468 }
469
470 # Check the stickiness of the directory and chown giveaway if required
471 # If the directory is world writable the sticky bit
472 # must be set
473
47427µs48µs if (File::Temp->safe_level == MEDIUM) {
# spent 8µs making 4 calls to File::Temp::safe_level, avg 2µs/call
475 my $safeerr;
476 unless (_is_safe($parent,\$safeerr)) {
477 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
478 return ();
479 }
480 } elsif (File::Temp->safe_level == HIGH) {
481 my $safeerr;
482 unless (_is_verysafe($parent, \$safeerr)) {
483 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
484 return ();
485 }
486 }
487
488
489 # Now try MAX_TRIES time to open the file
49022µs for (my $i = 0; $i < MAX_TRIES; $i++) {
491
492 # Try to open the file if requested
49322µs if ($options{"open"}) {
4941400ns my $fh;
495
496 # If we are running before perl5.6.0 we can not auto-vivify
4971600ns if ($] < 5.006) {
498 $fh = &Symbol::gensym;
499 }
500
501 # Try to make sure this will be marked close-on-exec
502 # XXX: Win32 doesn't respect this, nor the proper fcntl,
503 # but may have O_NOINHERIT. This may or may not be in Fcntl.
50412µs local $^F = 2;
505
506 # Attempt to open the file
5071300ns my $open_success = undef;
50811µs if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
509 # make it auto delete on close by setting FAB$V_DLT bit
510 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
511 $open_success = $fh;
512 } else {
5131500ns my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
514 $OPENTEMPFLAGS :
515 $OPENFLAGS );
5161200ns $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
517168µs159µs $open_success = sysopen($fh, $path, $flags, 0600);
# spent 59µs making 1 call to File::Temp::CORE:sysopen
518 }
5191300ns if ( $open_success ) {
520
521 # in case of odd umask force rw
522112µs110µs chmod(0600, $path);
# spent 10µs making 1 call to File::Temp::CORE:chmod
523
524 # Opened successfully - return file handle and name
52515µs return ($fh, $path);
526
527 } else {
528
529 # Error opening file - abort with error
530 # if the reason was anything but EEXIST
531 unless ($!{EEXIST}) {
532 ${$options{ErrStr}} = "Could not create temp file $path: $!";
533 return ();
534 }
535
536 # Loop round for another try
537
538 }
539 } elsif ($options{"mkdir"}) {
540
541 # Open the temp directory
542167µs155µs if (mkdir( $path, 0700)) {
# spent 55µs making 1 call to File::Temp::CORE:mkdir
543 # in case of odd umask
544112µs17µs chmod(0700, $path);
# spent 7µs making 1 call to File::Temp::CORE:chmod
545
54615µs return undef, $path;
547 } else {
548
549 # Abort with error if the reason for failure was anything
550 # except EEXIST
551 unless ($!{EEXIST}) {
552 ${$options{ErrStr}} = "Could not create directory $path: $!";
553 return ();
554 }
555
556 # Loop round for another try
557
558 }
559
560 } else {
561
562 # Return true if the file can not be found
563 # Directory has been checked previously
564
565 return (undef, $path) unless -e $path;
566
567 # Try again until MAX_TRIES
568
569 }
570
571 # Did not successfully open the tempfile/dir
572 # so try again with a different set of random letters
573 # No point in trying to increment unless we have only
574 # 1 X say and the randomness could come up with the same
575 # file MAX_TRIES in a row.
576
577 # Store current attempt - in principal this implies that the
578 # 3rd time around the open attempt that the first temp file
579 # name could be generated again. Probably should store each
580 # attempt and make sure that none are repeated
581
582 my $original = $path;
583 my $counter = 0; # Stop infinite loop
584 my $MAX_GUESS = 50;
585
586 do {
587
588 # Generate new name from original template
589 $path = _replace_XX($template, $options{"suffixlen"});
590
591 $counter++;
592
593 } until ($path ne $original || $counter > $MAX_GUESS);
594
595 # Check for out of control looping
596 if ($counter > $MAX_GUESS) {
597 ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
598 return ();
599 }
600
601 }
602
603 # If we get here, we have run out of tries
604 ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
605 . MAX_TRIES . ") to open temp file/dir";
606
607 return ();
608
609}
610
611# Internal routine to replace the XXXX... with random characters
612# This has to be done by _gettemp() every time it fails to
613# open a temp file/dir
614
615# Arguments: $template (the template with XXX),
616# $ignore (number of characters at end to ignore)
617
618# Returns: modified template
619
620
# spent 98µs (67+30) within File::Temp::_replace_XX which was called 2 times, avg 49µs/call: # 2 times (67µs+30µs) by File::Temp::_gettemp at line 404, avg 49µs/call
sub _replace_XX {
621
62221µs croak 'Usage: _replace_XX($template, $ignore)'
623 unless scalar(@_) == 2;
624
62521µs my ($path, $ignore) = @_;
626
627 # Do it as an if, since the suffix adjusts which section to replace
628 # and suffixlen=0 returns nothing if used in the substr directly
629 # Alternatively, could simply set $ignore to length($path)-1
630 # Don't want to always use substr when not required though.
63122µs my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
632
63321µs if ($ignore) {
634 substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
635 } else {
636288µs2330µs $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
# spent 16µs making 19 calls to File::Temp::CORE:substcont, avg 847ns/call # spent 9µs making 2 calls to File::Temp::CORE:regcomp, avg 4µs/call # spent 6µs making 2 calls to File::Temp::CORE:subst, avg 3µs/call
637 }
63826µs return $path;
639}
640
641# Internal routine to force a temp file to be writable after
642# it is created so that we can unlink it. Windows seems to occasionally
643# force a file to be readonly when written to certain temp locations
644sub _force_writable {
645 my $file = shift;
646 chmod 0600, $file;
647}
648
649
650# internal routine to check to see if the directory is safe
651# First checks to see if the directory is not owned by the
652# current user or root. Then checks to see if anyone else
653# can write to the directory and if so, checks to see if
654# it has the sticky bit set
655
656# Will not work on systems that do not support sticky bit
657
658#Args: directory path to check
659# Optionally: reference to scalar to contain error message
660# Returns true if the path is safe and false otherwise.
661# Returns undef if can not even run stat() on the path
662
663# This routine based on version written by Tom Christiansen
664
665# Presumably, by the time we actually attempt to create the
666# file or directory in this directory, it may not be safe
667# anymore... Have to run _is_safe directly after the open.
668
669sub _is_safe {
670
671 my $path = shift;
672 my $err_ref = shift;
673
674 # Stat path
675 my @info = stat($path);
676 unless (scalar(@info)) {
677 $$err_ref = "stat(path) returned no values";
678 return 0;
679 }
680 ;
681 return 1 if $^O eq 'VMS'; # owner delete control at file level
682
683 # Check to see whether owner is neither superuser (or a system uid) nor me
684 # Use the effective uid from the $> variable
685 # UID is in [4]
686 if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
687
688 Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
689 File::Temp->top_system_uid());
690
691 $$err_ref = "Directory owned neither by root nor the current user"
692 if ref($err_ref);
693 return 0;
694 }
695
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)
700 # mode is in info[2]
701 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
702 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
703 # Must be a directory
704 unless (-d $path) {
705 $$err_ref = "Path ($path) is not a directory"
706 if ref($err_ref);
707 return 0;
708 }
709 # Must have sticky bit set
710 unless (-k $path) {
711 $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
712 if ref($err_ref);
713 return 0;
714 }
715 }
716
717 return 1;
718}
719
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)
724
725# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
726# directory anyway.
727
728# Takes optional second arg as scalar ref to error reason
729
730sub _is_verysafe {
731
732 # Need POSIX - but only want to bother if really necessary due to overhead
733 require POSIX;
734
735 my $path = shift;
736 print "_is_verysafe testing $path\n" if $DEBUG;
737 return 1 if $^O eq 'VMS'; # owner delete control at file level
738
739 my $err_ref = shift;
740
741 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
742 # and If it is not there do the extensive test
743 local($@);
744 my $chown_restricted;
745 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
746 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
747
748 # If chown_resticted is set to some value we should test it
749 if (defined $chown_restricted) {
750
751 # Return if the current directory is safe
752 return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
753
754 }
755
756 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
757 # was not available or the symbol was there but chown giveaway
758 # is allowed. Either way, we now have to test the entire tree for
759 # safety.
760
761 # Convert path to an absolute directory if required
762 unless (File::Spec->file_name_is_absolute($path)) {
763 $path = File::Spec->rel2abs($path);
764 }
765
766 # Split directory into components - assume no file
767 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
768
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);
775
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]),
781 ''
782 );
783
784 print "TESTING DIR $dir\n" if $DEBUG;
785
786 # Check the directory
787 return 0 unless _is_safe($dir,$err_ref);
788
789 }
790
791 return 1;
792}
793
- -
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.
799
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.
804
805sub _can_unlink_opened_file {
806
807 if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
808 return 0;
809 } else {
810 return 1;
811 }
812
813}
814
815# internal routine to decide which security levels are allowed
816# see safe_level() for more information on this
817
818# Controls whether the supplied security level is allowed
819
820# $cando = _can_do_level( $level )
821
822sub _can_do_level {
823
824 # Get security level
825 my $level = shift;
826
827 # Always have to be able to do STANDARD
828 return 1 if $level == STANDARD;
829
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') {
832 return 0;
833 } else {
834 return 1;
835 }
836
837}
838
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
844
845# Arguments:
846# _deferred_unlink( $fh, $fname, $isdir );
847#
848# - filehandle (so that it can be explicitly 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]
852
853# Status is not referred to since all the magic is done with an END block
854
855{
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.
859
860 # This means we only have to set up a single END block to remove
861 # all files.
862
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.
866
867 # %files_to_unlink contains values that are references to an array of
868 # array references containing the filehandle and filename associated with
869 # the temp file.
8702700ns my (%files_to_unlink, %dirs_to_unlink);
871
872 # Set up an end block to use these arrays
873 END {
874 local($., $@, $!, $^E, $?);
875 cleanup(at_exit => 1);
876 }
877
878 # Cleanup function. Always triggered on END (with at_exit => 1) but
879 # can be invoked manually.
880 sub cleanup {
881 my %h = @_;
882 my $at_exit = delete $h{at_exit};
883 $at_exit = 0 if not defined $at_exit;
884 { my @k = sort keys %h; die "unrecognized parameters: @k" if @k }
885
886 if (!$KEEP_ALL) {
887 # Files
888 my @files = (exists $files_to_unlink{$$} ?
889 @{ $files_to_unlink{$$} } : () );
890 foreach my $file (@files) {
891 # close the filehandle without checking its state
892 # in order to make real sure that this is closed
893 # if its already closed then I dont care about the answer
894 # probably a better way to do this
895 close($file->[0]); # file handle is [0]
896
897 if (-f $file->[1]) { # file name is [1]
898 _force_writable( $file->[1] ); # for windows
899 unlink $file->[1] or warn "Error removing ".$file->[1];
900 }
901 }
902 # Dirs
903 my @dirs = (exists $dirs_to_unlink{$$} ?
904 @{ $dirs_to_unlink{$$} } : () );
905 my ($cwd, $cwd_to_remove);
906 foreach my $dir (@dirs) {
907 if (-d $dir) {
908 # Some versions of rmtree will abort if you attempt to remove
909 # the directory you are sitting in. For automatic cleanup
910 # at program exit, we avoid this by chdir()ing out of the way
911 # first. If not at program exit, it's best not to mess with the
912 # current directory, so just let it fail with a warning.
913 if ($at_exit) {
914 $cwd = Cwd::abs_path(File::Spec->curdir) if not defined $cwd;
915 my $abs = Cwd::abs_path($dir);
916 if ($abs eq $cwd) {
917 $cwd_to_remove = $dir;
918 next;
919 }
920 }
921 eval { rmtree($dir, $DEBUG, 0); };
922 warn $@ if ($@ && $^W);
923 }
924 }
925
926 if (defined $cwd_to_remove) {
927 # We do need to clean up the current directory, and everything
928 # else is done, so get out of there and remove it.
929 chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";
930 my $updir = File::Spec->updir;
931 chdir $updir or die "cannot chdir to $updir: $!";
932 eval { rmtree($cwd_to_remove, $DEBUG, 0); };
933 warn $@ if ($@ && $^W);
934 }
935
936 # clear the arrays
937 @{ $files_to_unlink{$$} } = ()
938 if exists $files_to_unlink{$$};
939 @{ $dirs_to_unlink{$$} } = ()
940 if exists $dirs_to_unlink{$$};
941 }
942 }
943
944
945 # This is the sub called to register a file for deferred unlinking
946 # This could simply store the input parameters and defer everything
947 # until the END block. For now we do a bit of checking at this
948 # point in order to make sure that (1) we have a file/dir to delete
949 # and (2) we have been called with the correct arguments.
950
# spent 61µs (38+23) within File::Temp::_deferred_unlink which was called 2 times, avg 31µs/call: # once (21µs+15µs) by File::Temp::tempdir at line 1643 # once (17µs+8µs) by File::Temp::tempfile at line 1465
sub _deferred_unlink {
951
95221µs croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
953 unless scalar(@_) == 3;
954
95522µs my ($fh, $fname, $isdir) = @_;
956
9572800ns warn "Setting up deferred removal of $fname\n"
958 if $DEBUG;
959
960 # make sure we save the absolute path for later cleanup
961 # OK to untaint because we only ever use this internally
962 # as a file path, never interpolating into the shell
963222µs215µs $fname = Cwd::abs_path($fname);
# spent 15µs making 2 calls to Cwd::abs_path, avg 8µs/call
964214µs26µs ($fname) = $fname =~ /^(.*)$/;
# spent 6µs making 2 calls to File::Temp::CORE:match, avg 3µs/call
965
966 # If we have a directory, check that it is a directory
96729µs if ($isdir) {
968
96913µs1900ns if (-d $fname) {
# spent 900ns making 1 call to File::Temp::CORE:ftdir
970
971 # Directory exists so store it
972 # first on VMS turn []foo into [.foo] for rmtree
97311µs $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
97413µs $dirs_to_unlink{$$} = []
975 unless exists $dirs_to_unlink{$$};
97611µs push (@{ $dirs_to_unlink{$$} }, $fname);
977
978 } else {
979 carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
980 }
981
982 } else {
983
98415µs11µs if (-f $fname) {
# spent 1µs making 1 call to File::Temp::CORE:ftfile
985
986 # file exists so store handle and name for later removal
98712µs $files_to_unlink{$$} = []
988 unless exists $files_to_unlink{$$};
98911µs push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
990
991 } else {
992 carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
993 }
994
995 }
996
997 }
998
999
1000}
1001
1002# normalize argument keys to upper case and do consistent handling
1003# of leading template vs TEMPLATE
1004
# spent 34µs within File::Temp::_parse_args which was called 2 times, avg 17µs/call: # once (22µs+0s) by File::Temp::tempfile at line 1378 # once (12µs+0s) by File::Temp::tempdir at line 1570
sub _parse_args {
100522µs my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
100622µs my %args = @_;
1007220µs %args = map { uc($_), $args{$_} } keys %args;
1008
1009 # template (store it in an array so that it will
1010 # disappear from the arg list of tempfile)
101123µs my @template = (
1012 exists $args{TEMPLATE} ? $args{TEMPLATE} :
1013 $leading_template ? $leading_template : ()
1014 );
101521µs delete $args{TEMPLATE};
1016
1017210µs return( \@template, \%args );
1018}
1019
1020=head1 OBJECT-ORIENTED INTERFACE
1021
1022This is the primary interface for interacting with
1023C<File::Temp>. Using the OO interface a temporary file can be created
1024when the object is constructed and the file can be removed when the
1025object is no longer required.
1026
1027Note that there is no method to obtain the filehandle from the
1028C<File::Temp> object. The object itself acts as a filehandle. The object
1029isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
1030available.
1031
1032Also, the object is configured such that it stringifies to the name of the
1033temporary file and so can be compared to a filename directly. It numifies
1034to the C<refaddr> the same as other handles and so can be compared to other
1035handles with C<==>.
1036
1037 $fh eq $filename # as a string
1038 $fh != \*STDOUT # as a number
1039
1040=over 4
1041
1042=item B<new>
1043
1044Create a temporary file object.
1045
1046 my $tmp = File::Temp->new();
1047
1048by default the object is constructed as if C<tempfile>
1049was called without options, but with the additional behaviour
1050that the temporary file is removed by the object destructor
1051if UNLINK is set to true (the default).
1052
1053Supported arguments are the same as for C<tempfile>: UNLINK
1054(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
1055template is specified using the TEMPLATE option. The OPEN option
1056is not supported (the file is always opened).
1057
1058 $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
1059 DIR => 'mydir',
1060 SUFFIX => '.dat');
1061
1062Arguments are case insensitive.
1063
1064Can call croak() if an error occurs.
1065
1066=cut
1067
1068sub new {
1069 my $proto = shift;
1070 my $class = ref($proto) || $proto;
1071
1072 my ($maybe_template, $args) = _parse_args(@_);
1073
1074 # see if they are unlinking (defaulting to yes)
1075 my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 );
1076 delete $args->{UNLINK};
1077
1078 # Protect OPEN
1079 delete $args->{OPEN};
1080
1081 # Open the file and retain file handle and file name
1082 my ($fh, $path) = tempfile( @$maybe_template, %$args );
1083
1084 print "Tmp: $fh - $path\n" if $DEBUG;
1085
1086 # Store the filename in the scalar slot
1087 ${*$fh} = $path;
1088
1089 # Cache the filename by pid so that the destructor can decide whether to remove it
1090 $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
1091
1092 # Store unlink information in hash slot (plus other constructor info)
1093 %{*$fh} = %$args;
1094
1095 # create the object
1096 bless $fh, $class;
1097
1098 # final method-based configuration
1099 $fh->unlink_on_destroy( $unlink );
1100
1101 return $fh;
1102}
1103
1104=item B<newdir>
1105
1106Create a temporary directory using an object oriented interface.
1107
1108 $dir = File::Temp->newdir();
1109
1110By default the directory is deleted when the object goes out of scope.
1111
1112Supports the same options as the C<tempdir> function. Note that directories
1113created with this method default to CLEANUP => 1.
1114
1115 $dir = File::Temp->newdir( $template, %options );
1116
1117A template may be specified either with a leading template or
1118with a TEMPLATE argument.
1119
1120=cut
1121
1122sub newdir {
1123 my $self = shift;
1124
1125 my ($maybe_template, $args) = _parse_args(@_);
1126
1127 # handle CLEANUP without passing CLEANUP to tempdir
1128 my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 );
1129 delete $args->{CLEANUP};
1130
1131 my $tempdir = tempdir( @$maybe_template, %$args);
1132
1133 # get a safe absolute path for cleanup, just like
1134 # happens in _deferred_unlink
1135 my $real_dir = Cwd::abs_path( $tempdir );
1136 ($real_dir) = $real_dir =~ /^(.*)$/;
1137
1138 return bless { DIRNAME => $tempdir,
1139 REALNAME => $real_dir,
1140 CLEANUP => $cleanup,
1141 LAUNCHPID => $$,
1142 }, "File::Temp::Dir";
1143}
1144
1145=item B<filename>
1146
1147Return the name of the temporary file associated with this object
1148(if the object was created using the "new" constructor).
1149
1150 $filename = $tmp->filename;
1151
1152This method is called automatically when the object is used as
1153a string.
1154
1155=cut
1156
1157sub filename {
1158 my $self = shift;
1159 return ${*$self};
1160}
1161
1162sub STRINGIFY {
1163 my $self = shift;
1164 return $self->filename;
1165}
1166
1167# For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because
1168# refaddr() demands one parameter only, whereas overload.pm calls with three
1169# even for unary operations like '0+'.
1170sub NUMIFY {
1171 return refaddr($_[0]);
1172}
1173
1174=item B<dirname>
1175
1176Return the name of the temporary directory associated with this
1177object (if the object was created using the "newdir" constructor).
1178
1179 $dirname = $tmpdir->dirname;
1180
1181This method is called automatically when the object is used in string context.
1182
1183=item B<unlink_on_destroy>
1184
1185Control whether the file is unlinked when the object goes out of scope.
1186The file is removed if this value is true and $KEEP_ALL is not.
1187
1188 $fh->unlink_on_destroy( 1 );
1189
1190Default is for the file to be removed.
1191
1192=cut
1193
1194sub unlink_on_destroy {
1195 my $self = shift;
1196 if (@_) {
1197 ${*$self}{UNLINK} = shift;
1198 }
1199 return ${*$self}{UNLINK};
1200}
1201
1202=item B<DESTROY>
1203
1204When the object goes out of scope, the destructor is called. This
1205destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
1206if the constructor was called with UNLINK set to 1 (the default state
1207if UNLINK is not specified).
1208
1209No error is given if the unlink fails.
1210
1211If the object has been passed to a child process during a fork, the
1212file will be deleted when the object goes out of scope in the parent.
1213
1214For a temporary directory object the directory will be removed unless
1215the CLEANUP argument was used in the constructor (and set to false) or
1216C<unlink_on_destroy> was modified after creation. Note that if a temp
1217directory is your current directory, it cannot be removed - a warning
1218will be given in this case. C<chdir()> out of the directory before
1219letting the object go out of scope.
1220
1221If the global variable $KEEP_ALL is true, the file or directory
1222will not be removed.
1223
1224=cut
1225
1226sub DESTROY {
1227 local($., $@, $!, $^E, $?);
1228 my $self = shift;
1229
1230 # Make sure we always remove the file from the global hash
1231 # on destruction. This prevents the hash from growing uncontrollably
1232 # and post-destruction there is no reason to know about the file.
1233 my $file = $self->filename;
1234 my $was_created_by_proc;
1235 if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
1236 $was_created_by_proc = 1;
1237 delete $FILES_CREATED_BY_OBJECT{$$}{$file};
1238 }
1239
1240 if (${*$self}{UNLINK} && !$KEEP_ALL) {
1241 print "# ---------> Unlinking $self\n" if $DEBUG;
1242
1243 # only delete if this process created it
1244 return unless $was_created_by_proc;
1245
1246 # The unlink1 may fail if the file has been closed
1247 # by the caller. This leaves us with the decision
1248 # of whether to refuse to remove the file or simply
1249 # do an unlink without test. Seems to be silly
1250 # to do this when we are trying to be careful
1251 # about security
1252 _force_writable( $file ); # for windows
1253 unlink1( $self, $file )
1254 or unlink($file);
1255 }
1256}
1257
1258=back
1259
1260=head1 FUNCTIONS
1261
1262This section describes the recommended interface for generating
1263temporary files and directories.
1264
1265=over 4
1266
1267=item B<tempfile>
1268
1269This is the basic function to generate temporary files.
1270The behaviour of the file can be changed using various options:
1271
1272 $fh = tempfile();
1273 ($fh, $filename) = tempfile();
1274
1275Create a temporary file in the directory specified for temporary
1276files, as specified by the tmpdir() function in L<File::Spec>.
1277
1278 ($fh, $filename) = tempfile($template);
1279
1280Create a temporary file in the current directory using the supplied
1281template. Trailing `X' characters are replaced with random letters to
1282generate the filename. At least four `X' characters must be present
1283at the end of the template.
1284
1285 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1286
1287Same as previously, except that a suffix is added to the template
1288after the `X' translation. Useful for ensuring that a temporary
1289filename has a particular extension when needed by other applications.
1290But see the WARNING at the end.
1291
1292 ($fh, $filename) = tempfile($template, DIR => $dir);
1293
1294Translates the template as before except that a directory name
1295is specified.
1296
1297 ($fh, $filename) = tempfile($template, TMPDIR => 1);
1298
1299Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
1300into the same temporary directory as would be used if no template was
1301specified at all.
1302
1303 ($fh, $filename) = tempfile($template, UNLINK => 1);
1304
1305Return the filename and filehandle as before except that the file is
1306automatically removed when the program exits (dependent on
1307$KEEP_ALL). Default is for the file to be removed if a file handle is
1308requested and to be kept if the filename is requested. In a scalar
1309context (where no filename is returned) the file is always deleted
1310either (depending on the operating system) on exit or when it is
1311closed (unless $KEEP_ALL is true when the temp file is created).
1312
1313Use the object-oriented interface if fine-grained control of when
1314a file is removed is required.
1315
1316If the template is not specified, a template is always
1317automatically generated. This temporary file is placed in tmpdir()
1318(L<File::Spec>) unless a directory is specified explicitly with the
1319DIR option.
1320
1321 $fh = tempfile( DIR => $dir );
1322
1323If called in scalar context, only the filehandle is returned and the
1324file will automatically be deleted when closed on operating systems
1325that support this (see the description of tmpfile() elsewhere in this
1326document). This is the preferred mode of operation, as if you only
1327have a filehandle, you can never create a race condition by fumbling
1328with the filename. On systems that can not unlink an open file or can
1329not mark a file as temporary when it is opened (for example, Windows
1330NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
1331the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
1332flag is ignored if present.
1333
1334 (undef, $filename) = tempfile($template, OPEN => 0);
1335
1336This will return the filename based on the template but
1337will not open this file. Cannot be used in conjunction with
1338UNLINK set to true. Default is to always open the file
1339to protect from possible race conditions. A warning is issued
1340if warnings are turned on. Consider using the tmpnam()
1341and mktemp() functions described elsewhere in this document
1342if opening the file is not required.
1343
1344If the operating system supports it (for example BSD derived systems), the
1345filehandle will be opened with O_EXLOCK (open with exclusive file lock).
1346This can sometimes cause problems if the intention is to pass the filename
1347to another system that expects to take an exclusive lock itself (such as
1348DBD::SQLite) whilst ensuring that the tempfile is not reused. In this
1349situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK
1350will be true (this retains compatibility with earlier releases).
1351
1352 ($fh, $filename) = tempfile($template, EXLOCK => 0);
1353
1354Options can be combined as required.
1355
1356Will croak() if there is an error.
1357
1358=cut
1359
1360
# spent 323µs (45+278) within File::Temp::tempfile which was called: # once (45µs+278µs) by Test::PONAPI::Repository::MockDB::Loader::_build_dbd at line 16 of lib/Test/PONAPI/Repository/MockDB/Loader.pm
sub tempfile {
13611700ns if ( @_ && $_[0] eq 'File::Temp' ) {
1362 croak "'tempfile' can't be called as a method";
1363 }
1364 # Can not check for argument count since we can have any
1365 # number of args
1366
1367 # Default options
136815µs my %options = (
1369 "DIR" => undef, # Directory prefix
1370 "SUFFIX" => '', # Template suffix
1371 "UNLINK" => 0, # Do not unlink file on exit
1372 "OPEN" => 1, # Open file
1373 "TMPDIR" => 0, # Place tempfile in tempdir if template specified
1374 "EXLOCK" => 1, # Open file with O_EXLOCK
1375 );
1376
1377 # Check to see whether we have an odd or even number of arguments
137813µs122µs my ($maybe_template, $args) = _parse_args(@_);
# spent 22µs making 1 call to File::Temp::_parse_args
137911µs my $template = @$maybe_template ? $maybe_template->[0] : undef;
1380
1381 # Read the options and merge with defaults
138214µs %options = (%options, %$args);
1383
1384 # First decision is whether or not to open the file
13851300ns if (! $options{"OPEN"}) {
1386
1387 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1388 if $^W;
1389
1390 }
1391
13921400ns if ($options{"DIR"} and $^O eq 'VMS') {
1393
1394 # on VMS turn []foo into [.foo] for concatenation
1395 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1396 }
1397
1398 # Construct the template
1399
1400 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1401 # functions or simply constructing a template and using _gettemp()
1402 # explicitly. Go for the latter
1403
1404 # First generate a template if not defined and prefix the directory
1405 # If no template must prefix the temp directory
14061600ns if (defined $template) {
1407 # End up with current directory if neither DIR not TMPDIR are set
140818µs240µs if ($options{"DIR"}) {
# spent 38µs making 1 call to File::Spec::Unix::catfile # spent 2µs making 1 call to File::Spec::Unix::tmpdir
1409
1410 $template = File::Spec->catfile($options{"DIR"}, $template);
1411
1412 } elsif ($options{TMPDIR}) {
1413
1414 $template = File::Spec->catfile(File::Spec->tmpdir, $template );
1415
1416 }
1417
1418 } else {
1419
1420 if ($options{"DIR"}) {
1421
1422 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1423
1424 } else {
1425
1426 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
1427
1428 }
1429
1430 }
1431
1432 # Now add a suffix
14331400ns $template .= $options{"SUFFIX"};
1434
1435 # Determine whether we should tell _gettemp to unlink the file
1436 # On unix this is irrelevant and can be worked out after the file is
1437 # opened (simply by unlinking the open filehandle). On Windows or VMS
1438 # we have to indicate temporary-ness when we open the file. In general
1439 # we only want a true temporary file if we are returning just the
1440 # filehandle - if the user wants the filename they probably do not
1441 # want the file to disappear as soon as they close it (which may be
1442 # important if they want a child process to use the file)
1443 # For this reason, tie unlink_on_close to the return context regardless
1444 # of OS.
14451500ns my $unlink_on_close = ( wantarray ? 0 : 1);
1446
1447 # Create the file
14481200ns my ($fh, $path, $errstr);
144915µs1191µs croak "Error in tempfile() using template $template: $errstr"
# spent 191µs making 1 call to File::Temp::_gettemp
1450 unless (($fh, $path) = _gettemp($template,
1451 "open" => $options{'OPEN'},
1452 "mkdir"=> 0 ,
1453 "unlink_on_close" => $unlink_on_close,
1454 "suffixlen" => length($options{'SUFFIX'}),
1455 "ErrStr" => \$errstr,
1456 "use_exlock" => $options{EXLOCK},
1457 ) );
1458
1459 # Set up an exit handler that can do whatever is right for the
1460 # system. This removes files at exit when requested explicitly or when
1461 # system is asked to unlink_on_close but is unable to do so because
1462 # of OS limitations.
1463 # The latter should be achieved by using a tied filehandle.
1464 # Do not check return status since this is all done with END blocks.
146513µs125µs _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
# spent 25µs making 1 call to File::Temp::_deferred_unlink
1466
1467 # Return
146815µs if (wantarray()) {
1469
1470 if ($options{'OPEN'}) {
1471 return ($fh, $path);
1472 } else {
1473 return (undef, $path);
1474 }
1475
1476 } else {
1477
1478 # Unlink the file. It is up to unlink0 to decide what to do with
1479 # this (whether to unlink now or to defer until later)
1480 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1481
1482 # Return just the filehandle.
1483 return $fh;
1484 }
1485
1486
1487}
1488
1489=item B<tempdir>
1490
1491This is the recommended interface for creation of temporary
1492directories. By default the directory will not be removed on exit
1493(that is, it won't be temporary; this behaviour can not be changed
1494because of issues with backwards compatibility). To enable removal
1495either use the CLEANUP option which will trigger removal on program
1496exit, or consider using the "newdir" method in the object interface which
1497will allow the directory to be cleaned up when the object goes out of
1498scope.
1499
1500The behaviour of the function depends on the arguments:
1501
1502 $tempdir = tempdir();
1503
1504Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1505
1506 $tempdir = tempdir( $template );
1507
1508Create a directory from the supplied template. This template is
1509similar to that described for tempfile(). `X' characters at the end
1510of the template are replaced with random letters to construct the
1511directory name. At least four `X' characters must be in the template.
1512
1513 $tempdir = tempdir ( DIR => $dir );
1514
1515Specifies the directory to use for the temporary directory.
1516The temporary directory name is derived from an internal template.
1517
1518 $tempdir = tempdir ( $template, DIR => $dir );
1519
1520Prepend the supplied directory name to the template. The template
1521should not include parent directory specifications itself. Any parent
1522directory specifications are removed from the template before
1523prepending the supplied directory.
1524
1525 $tempdir = tempdir ( $template, TMPDIR => 1 );
1526
1527Using the supplied template, create the temporary directory in
1528a standard location for temporary files. Equivalent to doing
1529
1530 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1531
1532but shorter. Parent directory specifications are stripped from the
1533template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1534explicitly. Additionally, C<TMPDIR> is implied if neither a template
1535nor a directory are supplied.
1536
1537 $tempdir = tempdir( $template, CLEANUP => 1);
1538
1539Create a temporary directory using the supplied template, but
1540attempt to remove it (and all files inside it) when the program
1541exits. Note that an attempt will be made to remove all files from
1542the directory even if they were not created by this module (otherwise
1543why ask to clean it up?). The directory removal is made with
1544the rmtree() function from the L<File::Path|File::Path> module.
1545Of course, if the template is not specified, the temporary directory
1546will be created in tmpdir() and will also be removed at program exit.
1547
1548Will croak() if there is an error.
1549
1550=cut
1551
1552# '
1553
1554
# spent 395µs (38+357) within File::Temp::tempdir which was called: # once (38µs+357µs) by PONAPI::CLI::RunServer::_create_dir at line 32 of lib/PONAPI/CLI/RunServer.pm
sub tempdir {
15551900ns if ( @_ && $_[0] eq 'File::Temp' ) {
1556 croak "'tempdir' can't be called as a method";
1557 }
1558
1559 # Can not check for argument count since we can have any
1560 # number of args
1561
1562 # Default options
156313µs my %options = (
1564 "CLEANUP" => 0, # Remove directory on exit
1565 "DIR" => '', # Root directory
1566 "TMPDIR" => 0, # Use tempdir with template
1567 );
1568
1569 # Check to see whether we have an odd or even number of arguments
157013µs112µs my ($maybe_template, $args) = _parse_args(@_);
# spent 12µs making 1 call to File::Temp::_parse_args
15711600ns my $template = @$maybe_template ? $maybe_template->[0] : undef;
1572
1573 # Read the options and merge with defaults
157413µs %options = (%options, %$args);
1575
1576 # Modify or generate the template
1577
1578 # Deal with the DIR and TMPDIR options
157912µs if (defined $template) {
1580
1581 # Need to strip directory path if using DIR or TMPDIR
1582 if ($options{'TMPDIR'} || $options{'DIR'}) {
1583
1584 # Strip parent directory from the filename
1585 #
1586 # There is no filename at the end
1587 $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1588 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1589
1590 # Last directory is then our template
1591 $template = (File::Spec->splitdir($directories))[-1];
1592
1593 # Prepend the supplied directory or temp dir
1594 if ($options{"DIR"}) {
1595
1596 $template = File::Spec->catdir($options{"DIR"}, $template);
1597
1598 } elsif ($options{TMPDIR}) {
1599
1600 # Prepend tmpdir
1601 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1602
1603 }
1604
1605 }
1606
1607 } else {
1608
16091700ns if ($options{"DIR"}) {
1610
1611 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1612
1613 } else {
1614
161515µs275µs $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
# spent 60µs making 1 call to File::Spec::Unix::tmpdir # spent 15µs making 1 call to File::Spec::Unix::catdir
1616
1617 }
1618
1619 }
1620
1621 # Create the directory
16221200ns my $tempdir;
16231200ns my $suffixlen = 0;
16241600ns if ($^O eq 'VMS') { # dir names can end in delimiters
1625 $template =~ m/([\.\]:>]+)$/;
1626 $suffixlen = length($1);
1627 }
162811µs if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1629 # dir name has a trailing ':'
1630 ++$suffixlen;
1631 }
1632
16331200ns my $errstr;
163413µs1232µs croak "Error in tempdir() using $template: $errstr"
# spent 232µs making 1 call to File::Temp::_gettemp
1635 unless ((undef, $tempdir) = _gettemp($template,
1636 "open" => 0,
1637 "mkdir"=> 1 ,
1638 "suffixlen" => $suffixlen,
1639 "ErrStr" => \$errstr,
1640 ) );
1641
1642 # Install exit handler; must be dynamic to get lexical
164316µs238µs if ( $options{'CLEANUP'} && -d $tempdir) {
# spent 37µs making 1 call to File::Temp::_deferred_unlink # spent 1µs making 1 call to File::Temp::CORE:ftdir
1644 _deferred_unlink(undef, $tempdir, 1);
1645 }
1646
1647 # Return the dir name
164814µs return $tempdir;
1649
1650}
1651
1652=back
1653
1654=head1 MKTEMP FUNCTIONS
1655
1656The following functions are Perl implementations of the
1657mktemp() family of temp file generation system calls.
1658
1659=over 4
1660
1661=item B<mkstemp>
1662
1663Given a template, returns a filehandle to the temporary file and the name
1664of the file.
1665
1666 ($fh, $name) = mkstemp( $template );
1667
1668In scalar context, just the filehandle is returned.
1669
1670The template may be any filename with some number of X's appended
1671to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1672with unique alphanumeric combinations.
1673
1674Will croak() if there is an error.
1675
1676=cut
1677
- -
1680sub mkstemp {
1681
1682 croak "Usage: mkstemp(template)"
1683 if scalar(@_) != 1;
1684
1685 my $template = shift;
1686
1687 my ($fh, $path, $errstr);
1688 croak "Error in mkstemp using $template: $errstr"
1689 unless (($fh, $path) = _gettemp($template,
1690 "open" => 1,
1691 "mkdir"=> 0 ,
1692 "suffixlen" => 0,
1693 "ErrStr" => \$errstr,
1694 ) );
1695
1696 if (wantarray()) {
1697 return ($fh, $path);
1698 } else {
1699 return $fh;
1700 }
1701
1702}
1703
1704
1705=item B<mkstemps>
1706
1707Similar to mkstemp(), except that an extra argument can be supplied
1708with a suffix to be appended to the template.
1709
1710 ($fh, $name) = mkstemps( $template, $suffix );
1711
1712For example a template of C<testXXXXXX> and suffix of C<.dat>
1713would generate a file similar to F<testhGji_w.dat>.
1714
1715Returns just the filehandle alone when called in scalar context.
1716
1717Will croak() if there is an error.
1718
1719=cut
1720
1721sub mkstemps {
1722
1723 croak "Usage: mkstemps(template, suffix)"
1724 if scalar(@_) != 2;
1725
1726
1727 my $template = shift;
1728 my $suffix = shift;
1729
1730 $template .= $suffix;
1731
1732 my ($fh, $path, $errstr);
1733 croak "Error in mkstemps using $template: $errstr"
1734 unless (($fh, $path) = _gettemp($template,
1735 "open" => 1,
1736 "mkdir"=> 0 ,
1737 "suffixlen" => length($suffix),
1738 "ErrStr" => \$errstr,
1739 ) );
1740
1741 if (wantarray()) {
1742 return ($fh, $path);
1743 } else {
1744 return $fh;
1745 }
1746
1747}
1748
1749=item B<mkdtemp>
1750
1751Create a directory from a template. The template must end in
1752X's that are replaced by the routine.
1753
1754 $tmpdir_name = mkdtemp($template);
1755
1756Returns the name of the temporary directory created.
1757
1758Directory must be removed by the caller.
1759
1760Will croak() if there is an error.
1761
1762=cut
1763
1764#' # for emacs
1765
1766sub mkdtemp {
1767
1768 croak "Usage: mkdtemp(template)"
1769 if scalar(@_) != 1;
1770
1771 my $template = shift;
1772 my $suffixlen = 0;
1773 if ($^O eq 'VMS') { # dir names can end in delimiters
1774 $template =~ m/([\.\]:>]+)$/;
1775 $suffixlen = length($1);
1776 }
1777 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1778 # dir name has a trailing ':'
1779 ++$suffixlen;
1780 }
1781 my ($junk, $tmpdir, $errstr);
1782 croak "Error creating temp directory from template $template\: $errstr"
1783 unless (($junk, $tmpdir) = _gettemp($template,
1784 "open" => 0,
1785 "mkdir"=> 1 ,
1786 "suffixlen" => $suffixlen,
1787 "ErrStr" => \$errstr,
1788 ) );
1789
1790 return $tmpdir;
1791
1792}
1793
1794=item B<mktemp>
1795
1796Returns a valid temporary filename but does not guarantee
1797that the file will not be opened by someone else.
1798
1799 $unopened_file = mktemp($template);
1800
1801Template is the same as that required by mkstemp().
1802
1803Will croak() if there is an error.
1804
1805=cut
1806
1807sub mktemp {
1808
1809 croak "Usage: mktemp(template)"
1810 if scalar(@_) != 1;
1811
1812 my $template = shift;
1813
1814 my ($tmpname, $junk, $errstr);
1815 croak "Error getting name to temp file from template $template: $errstr"
1816 unless (($junk, $tmpname) = _gettemp($template,
1817 "open" => 0,
1818 "mkdir"=> 0 ,
1819 "suffixlen" => 0,
1820 "ErrStr" => \$errstr,
1821 ) );
1822
1823 return $tmpname;
1824}
1825
1826=back
1827
1828=head1 POSIX FUNCTIONS
1829
1830This section describes the re-implementation of the tmpnam()
1831and tmpfile() functions described in L<POSIX>
1832using the mkstemp() from this module.
1833
1834Unlike the L<POSIX|POSIX> implementations, the directory used
1835for the temporary file is not specified in a system include
1836file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1837returned by L<File::Spec|File::Spec>. On some implementations this
1838location can be set using the C<TMPDIR> environment variable, which
1839may not be secure.
1840If this is a problem, simply use mkstemp() and specify a template.
1841
1842=over 4
1843
1844=item B<tmpnam>
1845
1846When called in scalar context, returns the full name (including path)
1847of a temporary file (uses mktemp()). The only check is that the file does
1848not already exist, but there is no guarantee that that condition will
1849continue to apply.
1850
1851 $file = tmpnam();
1852
1853When called in list context, a filehandle to the open file and
1854a filename are returned. This is achieved by calling mkstemp()
1855after constructing a suitable template.
1856
1857 ($fh, $file) = tmpnam();
1858
1859If possible, this form should be used to prevent possible
1860race conditions.
1861
1862See L<File::Spec/tmpdir> for information on the choice of temporary
1863directory for a particular operating system.
1864
1865Will croak() if there is an error.
1866
1867=cut
1868
1869sub tmpnam {
1870
1871 # Retrieve the temporary directory name
1872 my $tmpdir = File::Spec->tmpdir;
1873
1874 croak "Error temporary directory is not writable"
1875 if $tmpdir eq '';
1876
1877 # Use a ten character template and append to tmpdir
1878 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1879
1880 if (wantarray() ) {
1881 return mkstemp($template);
1882 } else {
1883 return mktemp($template);
1884 }
1885
1886}
1887
1888=item B<tmpfile>
1889
1890Returns the filehandle of a temporary file.
1891
1892 $fh = tmpfile();
1893
1894The file is removed when the filehandle is closed or when the program
1895exits. No access to the filename is provided.
1896
1897If the temporary file can not be created undef is returned.
1898Currently this command will probably not work when the temporary
1899directory is on an NFS file system.
1900
1901Will croak() if there is an error.
1902
1903=cut
1904
1905sub tmpfile {
1906
1907 # Simply call tmpnam() in a list context
1908 my ($fh, $file) = tmpnam();
1909
1910 # Make sure file is removed when filehandle is closed
1911 # This will fail on NFS
1912 unlink0($fh, $file)
1913 or return undef;
1914
1915 return $fh;
1916
1917}
1918
1919=back
1920
1921=head1 ADDITIONAL FUNCTIONS
1922
1923These functions are provided for backwards compatibility
1924with common tempfile generation C library functions.
1925
1926They are not exported and must be addressed using the full package
1927name.
1928
1929=over 4
1930
1931=item B<tempnam>
1932
1933Return the name of a temporary file in the specified directory
1934using a prefix. The file is guaranteed not to exist at the time
1935the function was called, but such guarantees are good for one
1936clock tick only. Always use the proper form of C<sysopen>
1937with C<O_CREAT | O_EXCL> if you must open such a filename.
1938
1939 $filename = File::Temp::tempnam( $dir, $prefix );
1940
1941Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1942(using unix file convention as an example)
1943
1944Because this function uses mktemp(), it can suffer from race conditions.
1945
1946Will croak() if there is an error.
1947
1948=cut
1949
1950sub tempnam {
1951
1952 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1953
1954 my ($dir, $prefix) = @_;
1955
1956 # Add a string to the prefix
1957 $prefix .= 'XXXXXXXX';
1958
1959 # Concatenate the directory to the file
1960 my $template = File::Spec->catfile($dir, $prefix);
1961
1962 return mktemp($template);
1963
1964}
1965
1966=back
1967
1968=head1 UTILITY FUNCTIONS
1969
1970Useful functions for dealing with the filehandle and filename.
1971
1972=over 4
1973
1974=item B<unlink0>
1975
1976Given an open filehandle and the associated filename, make a safe
1977unlink. This is achieved by first checking that the filename and
1978filehandle initially point to the same file and that the number of
1979links to the file is 1 (all fields returned by stat() are compared).
1980Then the filename is unlinked and the filehandle checked once again to
1981verify that the number of links on that file is now 0. This is the
1982closest you can come to making sure that the filename unlinked was the
1983same as the file whose descriptor you hold.
1984
1985 unlink0($fh, $path)
1986 or die "Error unlinking file $path safely";
1987
1988Returns false on error but croaks() if there is a security
1989anomaly. The filehandle is not closed since on some occasions this is
1990not required.
1991
1992On some platforms, for example Windows NT, it is not possible to
1993unlink an open file (the file must be closed first). On those
1994platforms, the actual unlinking is deferred until the program ends and
1995good status is returned. A check is still performed to make sure that
1996the filehandle and filename are pointing to the same thing (but not at
1997the time the end block is executed since the deferred removal may not
1998have access to the filehandle).
1999
2000Additionally, on Windows NT not all the fields returned by stat() can
2001be compared. For example, the C<dev> and C<rdev> fields seem to be
2002different. Also, it seems that the size of the file returned by stat()
2003does not always agree, with C<stat(FH)> being more accurate than
2004C<stat(filename)>, presumably because of caching issues even when
2005using autoflush (this is usually overcome by waiting a while after
2006writing to the tempfile before attempting to C<unlink0> it).
2007
2008Finally, on NFS file systems the link count of the file handle does
2009not always go to zero immediately after unlinking. Currently, this
2010command is expected to fail on NFS disks.
2011
2012This function is disabled if the global variable $KEEP_ALL is true
2013and an unlink on open file is supported. If the unlink is to be deferred
2014to the END block, the file is still registered for removal.
2015
2016This function should not be called if you are using the object oriented
2017interface since the it will interfere with the object destructor deleting
2018the file.
2019
2020=cut
2021
2022sub unlink0 {
2023
2024 croak 'Usage: unlink0(filehandle, filename)'
2025 unless scalar(@_) == 2;
2026
2027 # Read args
2028 my ($fh, $path) = @_;
2029
2030 cmpstat($fh, $path) or return 0;
2031
2032 # attempt remove the file (does not work on some platforms)
2033 if (_can_unlink_opened_file()) {
2034
2035 # return early (Without unlink) if we have been instructed to retain files.
2036 return 1 if $KEEP_ALL;
2037
2038 # XXX: do *not* call this on a directory; possible race
2039 # resulting in recursive removal
2040 croak "unlink0: $path has become a directory!" if -d $path;
2041 unlink($path) or return 0;
2042
2043 # Stat the filehandle
2044 my @fh = stat $fh;
2045
2046 print "Link count = $fh[3] \n" if $DEBUG;
2047
2048 # Make sure that the link count is zero
2049 # - Cygwin provides deferred unlinking, however,
2050 # on Win9x the link count remains 1
2051 # On NFS the link count may still be 1 but we can't know that
2052 # we are on NFS. Since we can't be sure, we'll defer it
2053
2054 return 1 if $fh[3] == 0 || $^O eq 'cygwin';
2055 }
2056 # fall-through if we can't unlink now
2057 _deferred_unlink($fh, $path, 0);
2058 return 1;
2059}
2060
2061=item B<cmpstat>
2062
2063Compare C<stat> of filehandle with C<stat> of provided filename. This
2064can be used to check that the filename and filehandle initially point
2065to the same file and that the number of links to the file is 1 (all
2066fields returned by stat() are compared).
2067
2068 cmpstat($fh, $path)
2069 or die "Error comparing handle with file";
2070
2071Returns false if the stat information differs or if the link count is
2072greater than 1. Calls croak if there is a security anomaly.
2073
2074On certain platforms, for example Windows, not all the fields returned by stat()
2075can be compared. For example, the C<dev> and C<rdev> fields seem to be
2076different in Windows. Also, it seems that the size of the file
2077returned by stat() does not always agree, with C<stat(FH)> being more
2078accurate than C<stat(filename)>, presumably because of caching issues
2079even when using autoflush (this is usually overcome by waiting a while
2080after writing to the tempfile before attempting to C<unlink0> it).
2081
2082Not exported by default.
2083
2084=cut
2085
2086sub cmpstat {
2087
2088 croak 'Usage: cmpstat(filehandle, filename)'
2089 unless scalar(@_) == 2;
2090
2091 # Read args
2092 my ($fh, $path) = @_;
2093
2094 warn "Comparing stat\n"
2095 if $DEBUG;
2096
2097 # Stat the filehandle - which may be closed if someone has manually
2098 # closed the file. Can not turn off warnings without using $^W
2099 # unless we upgrade to 5.006 minimum requirement
2100 my @fh;
2101 {
2102 local ($^W) = 0;
2103 @fh = stat $fh;
2104 }
2105 return unless @fh;
2106
2107 if ($fh[3] > 1 && $^W) {
2108 carp "unlink0: fstat found too many links; SB=@fh" if $^W;
2109 }
2110
2111 # Stat the path
2112 my @path = stat $path;
2113
2114 unless (@path) {
2115 carp "unlink0: $path is gone already" if $^W;
2116 return;
2117 }
2118
2119 # this is no longer a file, but may be a directory, or worse
2120 unless (-f $path) {
2121 confess "panic: $path is no longer a file: SB=@fh";
2122 }
2123
2124 # Do comparison of each member of the array
2125 # On WinNT dev and rdev seem to be different
2126 # depending on whether it is a file or a handle.
2127 # Cannot simply compare all members of the stat return
2128 # Select the ones we can use
2129 my @okstat = (0..$#fh); # Use all by default
2130 if ($^O eq 'MSWin32') {
2131 @okstat = (1,2,3,4,5,7,8,9,10);
2132 } elsif ($^O eq 'os2') {
2133 @okstat = (0, 2..$#fh);
2134 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
2135 @okstat = (0, 1);
2136 } elsif ($^O eq 'dos') {
2137 @okstat = (0,2..7,11..$#fh);
2138 } elsif ($^O eq 'mpeix') {
2139 @okstat = (0..4,8..10);
2140 }
2141
2142 # Now compare each entry explicitly by number
2143 for (@okstat) {
2144 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
2145 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
2146 # and 12) will be '' on platforms that do not support them. This
2147 # is fine since we are only comparing integers.
2148 unless ($fh[$_] eq $path[$_]) {
2149 warn "Did not match $_ element of stat\n" if $DEBUG;
2150 return 0;
2151 }
2152 }
2153
2154 return 1;
2155}
2156
2157=item B<unlink1>
2158
2159Similar to C<unlink0> except after file comparison using cmpstat, the
2160filehandle is closed prior to attempting to unlink the file. This
2161allows the file to be removed without using an END block, but does
2162mean that the post-unlink comparison of the filehandle state provided
2163by C<unlink0> is not available.
2164
2165 unlink1($fh, $path)
2166 or die "Error closing and unlinking file";
2167
2168Usually called from the object destructor when using the OO interface.
2169
2170Not exported by default.
2171
2172This function is disabled if the global variable $KEEP_ALL is true.
2173
2174Can call croak() if there is a security anomaly during the stat()
2175comparison.
2176
2177=cut
2178
2179sub unlink1 {
2180 croak 'Usage: unlink1(filehandle, filename)'
2181 unless scalar(@_) == 2;
2182
2183 # Read args
2184 my ($fh, $path) = @_;
2185
2186 cmpstat($fh, $path) or return 0;
2187
2188 # Close the file
2189 close( $fh ) or return 0;
2190
2191 # Make sure the file is writable (for windows)
2192 _force_writable( $path );
2193
2194 # return early (without unlink) if we have been instructed to retain files.
2195 return 1 if $KEEP_ALL;
2196
2197 # remove the file
2198 return unlink($path);
2199}
2200
2201=item B<cleanup>
2202
2203Calling this function will cause any temp files or temp directories
2204that are registered for removal to be removed. This happens automatically
2205when the process exits but can be triggered manually if the caller is sure
2206that none of the temp files are required. This method can be registered as
2207an Apache callback.
2208
2209Note that if a temp directory is your current directory, it cannot be
2210removed. C<chdir()> out of the directory first before calling
2211C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
2212is set, this happens automatically.)
2213
2214On OSes where temp files are automatically removed when the temp file
2215is closed, calling this function will have no effect other than to remove
2216temporary directories (which may include temporary files).
2217
2218 File::Temp::cleanup();
2219
2220Not exported by default.
2221
2222=back
2223
2224=head1 PACKAGE VARIABLES
2225
2226These functions control the global state of the package.
2227
2228=over 4
2229
2230=item B<safe_level>
2231
2232Controls the lengths to which the module will go to check the safety of the
2233temporary file or directory before proceeding.
2234Options are:
2235
2236=over 8
2237
2238=item STANDARD
2239
2240Do the basic security measures to ensure the directory exists and is
2241writable, that temporary files are opened only if they do not already
2242exist, and that possible race conditions are avoided. Finally the
2243L<unlink0|"unlink0"> function is used to remove files safely.
2244
2245=item MEDIUM
2246
2247In addition to the STANDARD security, the output directory is checked
2248to make sure that it is owned either by root or the user running the
2249program. If the directory is writable by group or by other, it is then
2250checked to make sure that the sticky bit is set.
2251
2252Will not work on platforms that do not support the C<-k> test
2253for sticky bit.
2254
2255=item HIGH
2256
2257In addition to the MEDIUM security checks, also check for the
2258possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2259sysconf() function. If this is a possibility, each directory in the
2260path is checked in turn for safeness, recursively walking back to the
2261root directory.
2262
2263For platforms that do not support the L<POSIX|POSIX>
2264C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2265assumed that ``chown() giveaway'' is possible and the recursive test
2266is performed.
2267
2268=back
2269
2270The level can be changed as follows:
2271
2272 File::Temp->safe_level( File::Temp::HIGH );
2273
2274The level constants are not exported by the module.
2275
2276Currently, you must be running at least perl v5.6.0 in order to
2277run with MEDIUM or HIGH security. This is simply because the
2278safety tests use functions from L<Fcntl|Fcntl> that are not
2279available in older versions of perl. The problem is that the version
2280number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2281they are different versions.
2282
2283On systems that do not support the HIGH or MEDIUM safety levels
2284(for example Win NT or OS/2) any attempt to change the level will
2285be ignored. The decision to ignore rather than raise an exception
2286allows portable programs to be written with high security in mind
2287for the systems that can support this without those programs failing
2288on systems where the extra tests are irrelevant.
2289
2290If you really need to see whether the change has been accepted
2291simply examine the return value of C<safe_level>.
2292
2293 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2294 die "Could not change to high security"
2295 if $newlevel != File::Temp::HIGH;
2296
2297=cut
2298
2299{
2300 # protect from using the variable itself
23012500ns my $LEVEL = STANDARD;
2302
# spent 8µs within File::Temp::safe_level which was called 4 times, avg 2µs/call: # 4 times (8µs+0s) by File::Temp::_gettemp at line 474, avg 2µs/call
sub safe_level {
230341µs my $self = shift;
230441µs if (@_) {
2305 my $level = shift;
2306 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2307 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2308 } else {
2309 # Don't allow this on perl 5.005 or earlier
2310 if ($] < 5.006 && $level != STANDARD) {
2311 # Cant do MEDIUM or HIGH checks
2312 croak "Currently requires perl 5.006 or newer to do the safe checks";
2313 }
2314 # Check that we are allowed to change level
2315 # Silently ignore if we can not.
2316 $LEVEL = $level if _can_do_level($level);
2317 }
2318 }
231949µs return $LEVEL;
2320 }
2321}
2322
2323=item TopSystemUID
2324
2325This is the highest UID on the current system that refers to a root
2326UID. This is used to make sure that the temporary directory is
2327owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2328simply by root.
2329
2330This is required since on many unix systems C</tmp> is not owned
2331by root.
2332
2333Default is to assume that any UID less than or equal to 10 is a root
2334UID.
2335
2336 File::Temp->top_system_uid(10);
2337 my $topid = File::Temp->top_system_uid;
2338
2339This value can be adjusted to reduce security checking if required.
2340The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2341
2342=cut
2343
2344{
23452200ns my $TopSystemUID = 10;
23461400ns $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2347 sub top_system_uid {
2348 my $self = shift;
2349 if (@_) {
2350 my $newuid = shift;
2351 croak "top_system_uid: UIDs should be numeric"
2352 unless $newuid =~ /^\d+$/s;
2353 $TopSystemUID = $newuid;
2354 }
2355 return $TopSystemUID;
2356 }
2357}
2358
2359=item B<$KEEP_ALL>
2360
2361Controls whether temporary files and directories should be retained
2362regardless of any instructions in the program to remove them
2363automatically. This is useful for debugging but should not be used in
2364production code.
2365
2366 $File::Temp::KEEP_ALL = 1;
2367
2368Default is for files to be removed as requested by the caller.
2369
2370In some cases, files will only be retained if this variable is true
2371when the file is created. This means that you can not create a temporary
2372file, set this variable and expect the temp file to still be around
2373when the program exits.
2374
2375=item B<$DEBUG>
2376
2377Controls whether debugging messages should be enabled.
2378
2379 $File::Temp::DEBUG = 1;
2380
2381Default is for debugging mode to be disabled.
2382
2383=back
2384
2385=head1 WARNING
2386
2387For maximum security, endeavour always to avoid ever looking at,
2388touching, or even imputing the existence of the filename. You do not
2389know that that filename is connected to the same file as the handle
2390you have, and attempts to check this can only trigger more race
2391conditions. It's far more secure to use the filehandle alone and
2392dispense with the filename altogether.
2393
2394If you need to pass the handle to something that expects a filename
2395then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
2396arbitrary programs. Perl code that uses the 2-argument version of
2397C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
2398will need to pass the filename. You will have to clear the
2399close-on-exec bit on that file descriptor before passing it to another
2400process.
2401
2402 use Fcntl qw/F_SETFD F_GETFD/;
2403 fcntl($tmpfh, F_SETFD, 0)
2404 or die "Can't clear close-on-exec flag on temp fh: $!\n";
2405
2406=head2 Temporary files and NFS
2407
2408Some problems are associated with using temporary files that reside
2409on NFS file systems and it is recommended that a local filesystem
2410is used whenever possible. Some of the security tests will most probably
2411fail when the temp file is not local. Additionally, be aware that
2412the performance of I/O operations over NFS will not be as good as for
2413a local disk.
2414
2415=head2 Forking
2416
2417In some cases files created by File::Temp are removed from within an
2418END block. Since END blocks are triggered when a child process exits
2419(unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2420to only remove those temp files created by a particular process ID. This
2421means that a child will not attempt to remove temp files created by the
2422parent process.
2423
2424If you are forking many processes in parallel that are all creating
2425temporary files, you may need to reset the random number seed using
2426srand(EXPR) in each child else all the children will attempt to walk
2427through the same set of random file names and may well cause
2428themselves to give up if they exceed the number of retry attempts.
2429
2430=head2 Directory removal
2431
2432Note that if you have chdir'ed into the temporary directory and it is
2433subsequently cleaned up (either in the END block or as part of object
2434destruction), then you will get a warning from File::Path::rmtree().
2435
2436=head2 Taint mode
2437
2438If you need to run code under taint mode, updating to the latest
2439L<File::Spec> is highly recommended.
2440
2441=head2 BINMODE
2442
2443The file returned by File::Temp will have been opened in binary mode
2444if such a mode is available. If that is not correct, use the C<binmode()>
2445function to change the mode of the filehandle.
2446
2447Note that you can modify the encoding of a file opened by File::Temp
2448also by using C<binmode()>.
2449
2450=head1 HISTORY
2451
2452Originally began life in May 1999 as an XS interface to the system
2453mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2454translated to Perl for total control of the code's
2455security checking, to ensure the presence of the function regardless of
2456operating system and to help with portability. The module was shipped
2457as a standard part of perl from v5.6.1.
2458
2459=head1 SEE ALSO
2460
2461L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2462
2463See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
2464different implementations of temporary file handling.
2465
2466See L<File::Tempdir> for an alternative object-oriented wrapper for
2467the C<tempdir> function.
2468
2469=head1 AUTHOR
2470
2471Tim Jenness E<lt>tjenness@cpan.orgE<gt>
2472
2473Copyright (C) 2007-2010 Tim Jenness.
2474Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
2475Astronomy Research Council. All Rights Reserved. This program is free
2476software; you can redistribute it and/or modify it under the same
2477terms as Perl itself.
2478
2479Original Perl implementation loosely based on the OpenBSD C code for
2480mkstemp(). Thanks to Tom Christiansen for suggesting that this module
2481should be written and providing ideas for code improvements and
2482security enhancements.
2483
2484=cut
2485
2486package File::Temp::Dir;
2487
2488224µs269µs
# spent 41µs (12+28) within File::Temp::Dir::BEGIN@2488 which was called: # once (12µs+28µs) by Path::Class::Dir::BEGIN@14 at line 2488
use File::Path qw/ rmtree /;
# spent 41µs making 1 call to File::Temp::Dir::BEGIN@2488 # spent 28µs making 1 call to Exporter::import
2489231µs228µs
# spent 17µs (6+11) within File::Temp::Dir::BEGIN@2489 which was called: # once (6µs+11µs) by Path::Class::Dir::BEGIN@14 at line 2489
use strict;
# spent 17µs making 1 call to File::Temp::Dir::BEGIN@2489 # spent 11µs making 1 call to strict::import
249014µs131µs
# spent 38µs (7+31) within File::Temp::Dir::BEGIN@2490 which was called: # once (7µs+31µs) by Path::Class::Dir::BEGIN@14 at line 2492
use overload '""' => "STRINGIFY",
# spent 31µs making 1 call to overload::import
2491 '0+' => \&File::Temp::NUMIFY,
24921213µs138µs fallback => 1;
# spent 38µs making 1 call to File::Temp::Dir::BEGIN@2490
2493
2494# private class specifically to support tempdir objects
2495# created by File::Temp->newdir
2496
2497# ostensibly the same method interface as File::Temp but without
2498# inheriting all the IO::Seekable methods and other cruft
2499
2500# Read-only - returns the name of the temp directory
2501
2502sub dirname {
2503 my $self = shift;
2504 return $self->{DIRNAME};
2505}
2506
2507sub STRINGIFY {
2508 my $self = shift;
2509 return $self->dirname;
2510}
2511
2512sub unlink_on_destroy {
2513 my $self = shift;
2514 if (@_) {
2515 $self->{CLEANUP} = shift;
2516 }
2517 return $self->{CLEANUP};
2518}
2519
2520sub DESTROY {
2521 my $self = shift;
2522 local($., $@, $!, $^E, $?);
2523 if ($self->unlink_on_destroy &&
2524 $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
2525 if (-d $self->{REALNAME}) {
2526 # Some versions of rmtree will abort if you attempt to remove
2527 # the directory you are sitting in. We protect that and turn it
2528 # into a warning. We do this because this occurs during object
2529 # destruction and so can not be caught by the user.
2530 eval { rmtree($self->{REALNAME}, $File::Temp::DEBUG, 0); };
2531 warn $@ if ($@ && $^W);
2532 }
2533 }
2534}
2535
2536
2537119µs1;
2538
2539# vim: ts=2 sts=2 sw=2 et:
 
# spent 17µs within File::Temp::CORE:chmod which was called 2 times, avg 8µs/call: # once (10µs+0s) by File::Temp::_gettemp at line 522 # once (7µs+0s) by File::Temp::_gettemp at line 544
sub File::Temp::CORE:chmod; # opcode
# spent 4µs within File::Temp::CORE:ftdir which was called 4 times, avg 950ns/call: # 2 times (2µs+0s) by File::Temp::_gettemp at line 465, avg 850ns/call # once (1µs+0s) by File::Temp::tempdir at line 1643 # once (900ns+0s) by File::Temp::_deferred_unlink at line 969
sub File::Temp::CORE:ftdir; # opcode
# spent 1µs within File::Temp::CORE:ftfile which was called: # once (1µs+0s) by File::Temp::_deferred_unlink at line 984
sub File::Temp::CORE:ftfile; # opcode
# spent 10µs within File::Temp::CORE:ftis which was called 2 times, avg 5µs/call: # 2 times (10µs+0s) by File::Temp::_gettemp at line 461, avg 5µs/call
sub File::Temp::CORE:ftis; # opcode
# spent 6µs within File::Temp::CORE:match which was called 2 times, avg 3µs/call: # 2 times (6µs+0s) by File::Temp::_deferred_unlink at line 964, avg 3µs/call
sub File::Temp::CORE:match; # opcode
# spent 55µs within File::Temp::CORE:mkdir which was called: # once (55µs+0s) by File::Temp::_gettemp at line 542
sub File::Temp::CORE:mkdir; # opcode
# spent 9µs within File::Temp::CORE:regcomp which was called 2 times, avg 4µs/call: # 2 times (9µs+0s) by File::Temp::_replace_XX at line 636, avg 4µs/call
sub File::Temp::CORE:regcomp; # opcode
# spent 6µs within File::Temp::CORE:subst which was called 2 times, avg 3µs/call: # 2 times (6µs+0s) by File::Temp::_replace_XX at line 636, avg 3µs/call
sub File::Temp::CORE:subst; # opcode
# spent 16µs within File::Temp::CORE:substcont which was called 19 times, avg 847ns/call: # 19 times (16µs+0s) by File::Temp::_replace_XX at line 636, avg 847ns/call
sub File::Temp::CORE:substcont; # opcode
# spent 59µs within File::Temp::CORE:sysopen which was called: # once (59µs+0s) by File::Temp::_gettemp at line 517
sub File::Temp::CORE:sysopen; # opcode