← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 03:38:15 2020
Reported on Wed Feb 12 04:56:35 2020

Filename/usr/share/perl/5.28/File/Temp.pm
StatementsExecuted 1869998 statements in 8.37s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
27907212.41s7.03sFile::Temp::::_gettemp File::Temp::_gettemp
27907111.76s2.36sFile::Temp::::_replace_XX File::Temp::_replace_XX
27905221.36s9.73sFile::Temp::::tempfile File::Temp::tempfile
27905111.15s1.15sFile::Temp::::CORE:sysopen File::Temp::CORE:sysopen (opcode)
30696811392ms392msFile::Temp::::CORE:substcont File::Temp::CORE:substcont (opcode)
2790931235ms235msFile::Temp::::_parse_args File::Temp::_parse_args
2790721174ms174msFile::Temp::::CORE:chmod File::Temp::CORE:chmod (opcode)
2790711172ms172msFile::Temp::::CORE:ftis File::Temp::CORE:ftis (opcode)
2790711134ms134msFile::Temp::::CORE:subst File::Temp::CORE:subst (opcode)
558141196.3ms96.3msFile::Temp::::safe_level File::Temp::safe_level
279071173.3ms73.3msFile::Temp::::CORE:regcomp File::Temp::CORE:regcomp (opcode)
279071136.7ms36.7msFile::Temp::::CORE:ftdir File::Temp::CORE:ftdir (opcode)
111755µs969µsFile::Temp::::BEGIN@16 File::Temp::BEGIN@16
111322µs425µsFile::Temp::::BEGIN@15 File::Temp::BEGIN@15
2511209µs275µsFile::Temp::::NUMIFY File::Temp::NUMIFY
2732193µs193µsFile::Temp::Dir::::dirnameFile::Temp::Dir::dirname
211176µs176µsFile::Temp::::CORE:mkdir File::Temp::CORE:mkdir (opcode)
111116µs92.0msFile::Temp::Dir::::DESTROYFile::Temp::Dir::DESTROY
22282µs828µsFile::Temp::::newdir File::Temp::newdir
21163µs690µsFile::Temp::::tempdir File::Temp::tempdir
11138µs70µsFile::Temp::::END File::Temp::END
11131µs32µsFile::Temp::::cleanup File::Temp::cleanup
11120µs29µsFile::Temp::::BEGIN@11 File::Temp::BEGIN@11
11120µs297µsFile::Temp::::BEGIN@14 File::Temp::BEGIN@14
11119µs19µsFile::Temp::::BEGIN@8 File::Temp::BEGIN@8
11117µs54µsFile::Temp::::BEGIN@31 File::Temp::BEGIN@31
11114µs51µsFile::Temp::::BEGIN@13 File::Temp::BEGIN@13
11113µs72µsFile::Temp::Dir::::BEGIN@1541File::Temp::Dir::BEGIN@1541
11113µs13µsFile::Temp::Dir::::CORE:ftdirFile::Temp::Dir::CORE:ftdir (opcode)
11112µs19µsFile::Temp::::BEGIN@137 File::Temp::BEGIN@137
11110µs53µsFile::Temp::::BEGIN@32 File::Temp::BEGIN@32
1119µs54µsFile::Temp::Dir::::BEGIN@1543File::Temp::Dir::BEGIN@1543
1118µs12µsFile::Temp::Dir::::BEGIN@1542File::Temp::Dir::BEGIN@1542
1118µs61µsFile::Temp::::BEGIN@83 File::Temp::BEGIN@83
1118µs19µsFile::Temp::::BEGIN@43 File::Temp::BEGIN@43
1118µs27µsFile::Temp::::BEGIN@17 File::Temp::BEGIN@17
1117µs22µsFile::Temp::::BEGIN@107 File::Temp::BEGIN@107
1117µs9µsFile::Temp::::BEGIN@9 File::Temp::BEGIN@9
1116µs54µsFile::Temp::::BEGIN@36 File::Temp::BEGIN@36
2116µs6µsFile::Temp::::CORE:match File::Temp::CORE:match (opcode)
1115µs28µsFile::Temp::::BEGIN@90 File::Temp::BEGIN@90
1115µs31µsFile::Temp::::BEGIN@10 File::Temp::BEGIN@10
1115µs25µsFile::Temp::::BEGIN@95 File::Temp::BEGIN@95
1115µs27µsFile::Temp::::BEGIN@86 File::Temp::BEGIN@86
1115µs24µsFile::Temp::::BEGIN@96 File::Temp::BEGIN@96
1114µs25µsFile::Temp::::BEGIN@94 File::Temp::BEGIN@94
1113µs3µsFile::Temp::Dir::::unlink_on_destroyFile::Temp::Dir::unlink_on_destroy
1112µs2µsFile::Temp::::BEGIN@12 File::Temp::BEGIN@12
1111µs1µsFile::Temp::::CORE:sort File::Temp::CORE:sort (opcode)
111900ns900nsFile::Temp::::__ANON__[:111] File::Temp::__ANON__[:111]
111600ns600nsFile::Temp::::__ANON__ File::Temp::__ANON__ (xsub)
111600ns600nsFile::Temp::::__ANON__[:141] File::Temp::__ANON__[:141]
111500ns500nsFile::Temp::::__ANON__[:119] File::Temp::__ANON__[:119]
0000s0sFile::Temp::::DESTROY File::Temp::DESTROY
0000s0sFile::Temp::Dir::::STRINGIFYFile::Temp::Dir::STRINGIFY
0000s0sFile::Temp::::STRINGIFY File::Temp::STRINGIFY
0000s0sFile::Temp::::__ANON__[:112] File::Temp::__ANON__[:112]
0000s0sFile::Temp::::__ANON__[:120] File::Temp::__ANON__[:120]
0000s0sFile::Temp::::__ANON__[:142] File::Temp::__ANON__[:142]
0000s0sFile::Temp::::_can_do_level File::Temp::_can_do_level
0000s0sFile::Temp::::_can_unlink_opened_file File::Temp::_can_unlink_opened_file
0000s0sFile::Temp::::_deferred_unlink File::Temp::_deferred_unlink
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::::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::::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# ABSTRACT: return name and handle of a temporary file safely
31500nsour $VERSION = '0.2304'; # VERSION
4
5# Toolchain targets v5.8.1, but we'll try to support back to v5.6 anyway.
6# It might be possible to make this v5.5, but many v5.6isms are creeping
7# into the code and tests.
8246µs119µs
# spent 19µs within File::Temp::BEGIN@8 which was called: # once (19µs+0s) by IO::CaptureOutput::_proxy::BEGIN@138 at line 8
use 5.006;
# spent 19µs making 1 call to File::Temp::BEGIN@8
9217µs211µs
# spent 9µs (7+2) within File::Temp::BEGIN@9 which was called: # once (7µs+2µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 9
use strict;
# spent 9µs making 1 call to File::Temp::BEGIN@9 # spent 2µs making 1 call to strict::import
10223µs257µs
# spent 31µs (5+26) within File::Temp::BEGIN@10 which was called: # once (5µs+26µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 10
use Carp;
# spent 31µs making 1 call to File::Temp::BEGIN@10 # spent 26µs making 1 call to Exporter::import
11343µs337µs
# spent 29µs (20+9) within File::Temp::BEGIN@11 which was called: # once (20µs+9µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 11
use File::Spec 0.8;
# spent 29µs making 1 call to File::Temp::BEGIN@11 # spent 8µs making 1 call to UNIVERSAL::VERSION # spent 600ns making 1 call to File::Temp::__ANON__
12249µs12µs
# spent 2µs within File::Temp::BEGIN@12 which was called: # once (2µs+0s) by IO::CaptureOutput::_proxy::BEGIN@138 at line 12
use Cwd ();
# spent 2µs making 1 call to File::Temp::BEGIN@12
13343µs389µs
# spent 51µs (14+38) within File::Temp::BEGIN@13 which was called: # once (14µs+38µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 13
use File::Path 2.06 qw/ rmtree /;
# spent 51µs making 1 call to File::Temp::BEGIN@13 # spent 32µs making 1 call to Exporter::import # spent 6µs making 1 call to UNIVERSAL::VERSION
14344µs3575µs
# spent 297µs (20+278) within File::Temp::BEGIN@14 which was called: # once (20µs+278µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 14
use Fcntl 1.03;
# spent 297µs making 1 call to File::Temp::BEGIN@14 # spent 272µs making 1 call to Exporter::import # spent 5µs making 1 call to UNIVERSAL::VERSION
15294µs2448µs
# spent 425µs (322+103) within File::Temp::BEGIN@15 which was called: # once (322µs+103µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 15
use IO::Seekable; # For SEEK_*
# spent 425µs making 1 call to File::Temp::BEGIN@15 # spent 23µs making 1 call to Exporter::import
162123µs2984µs
# spent 969µs (755+214) within File::Temp::BEGIN@16 which was called: # once (755µs+214µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 16
use Errno;
# spent 969µs making 1 call to File::Temp::BEGIN@16 # spent 14µs making 1 call to Exporter::import
17262µs246µs
# spent 27µs (8+19) within File::Temp::BEGIN@17 which was called: # once (8µs+19µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 17
use Scalar::Util 'refaddr';
# spent 27µs making 1 call to File::Temp::BEGIN@17 # spent 19µs making 1 call to Exporter::import
1812µsrequire VMS::Stdio if $^O eq 'VMS';
19
20# pre-emptively load Carp::Heavy. If we don't when we run out of file
21# handles and attempt to call croak() we get an error message telling
22# us that Carp::Heavy won't load rather than an error telling us we
23# have run out of file handles. We either preload croak() or we
24# switch the calls to croak from _gettemp() to use die.
252159µseval { require Carp::Heavy; };
26
27# Need the Symbol package if we are running older perl
281300nsrequire Symbol if $] < 5.006;
29
30### For the OO interface
313151µs392µs
# spent 54µs (17+37) within File::Temp::BEGIN@31 which was called: # once (17µs+37µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 31
use parent 0.221 qw/ IO::Handle IO::Seekable /;
# spent 54µs making 1 call to File::Temp::BEGIN@31 # spent 29µs making 1 call to parent::import # spent 8µs making 1 call to UNIVERSAL::VERSION
3218µs143µs
# spent 53µs (10+43) within File::Temp::BEGIN@32 which was called: # once (10µs+43µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 33
use overload '""' => "STRINGIFY", '0+' => "NUMIFY",
# spent 43µs making 1 call to overload::import
33122µs153µs fallback => 1;
# spent 53µs making 1 call to File::Temp::BEGIN@32
34
35# use 'our' on v5.6.0
36234µs2103µs
# spent 54µs (6+48) within File::Temp::BEGIN@36 which was called: # once (6µs+48µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 36
use vars qw(@EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
# spent 54µs making 1 call to File::Temp::BEGIN@36 # spent 48µs making 1 call to vars::import
37
381100ns$DEBUG = 0;
391100ns$KEEP_ALL = 0;
40
41# We are exporting functions
42
433104µs329µs
# spent 19µs (8+10) within File::Temp::BEGIN@43 which was called: # once (8µs+10µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 43
use Exporter 5.57 'import'; # 5.57 lets us import 'import'
# spent 19µs making 1 call to File::Temp::BEGIN@43 # spent 6µs making 1 call to UNIVERSAL::VERSION # spent 5µs making 1 call to Exporter::import
44
45# Export list - to allow fine tuning of export table
46
4713µs@EXPORT_OK = qw{
48 tempfile
49 tempdir
50 tmpnam
51 tmpfile
52 mktemp
53 mkstemp
54 mkstemps
55 mkdtemp
56 unlink0
57 cleanup
58 SEEK_SET
59 SEEK_CUR
60 SEEK_END
61 };
62
63# Groups of functions for export
64
6515µs%EXPORT_TAGS = (
66 'POSIX' => [qw/ tmpnam tmpfile /],
67 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
68 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
69 );
70
71# add contents of these tags to @EXPORT
7212µs129µsExporter::export_tags('POSIX','mktemp','seekable');
# spent 29µs making 1 call to Exporter::export_tags
73
74# This is a list of characters that can be used in random filenames
75
7615µ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
77 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
78 0 1 2 3 4 5 6 7 8 9 _
79 /);
80
81# Maximum number of tries to make a temp file before failing
82
83225µs2113µs
# spent 61µs (8+52) within File::Temp::BEGIN@83 which was called: # once (8µs+52µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 83
use constant MAX_TRIES => 1000;
# spent 61µs making 1 call to File::Temp::BEGIN@83 # spent 52µs making 1 call to constant::import
84
85# Minimum number of X characters that should be in a template
86229µs250µs
# spent 27µs (5+23) within File::Temp::BEGIN@86 which was called: # once (5µs+23µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 86
use constant MINX => 4;
# spent 27µs making 1 call to File::Temp::BEGIN@86 # spent 23µs making 1 call to constant::import
87
88# Default template when no template supplied
89
90224µs251µs
# spent 28µs (5+23) within File::Temp::BEGIN@90 which was called: # once (5µs+23µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 90
use constant TEMPXXX => 'X' x 10;
# spent 28µs making 1 call to File::Temp::BEGIN@90 # spent 23µs making 1 call to constant::import
91
92# Constants for the security level
93
94220µs246µs
# spent 25µs (4+21) within File::Temp::BEGIN@94 which was called: # once (4µs+21µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 94
use constant STANDARD => 0;
# spent 25µs making 1 call to File::Temp::BEGIN@94 # spent 21µs making 1 call to constant::import
95220µs245µs
# spent 25µs (5+20) within File::Temp::BEGIN@95 which was called: # once (5µs+20µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 95
use constant MEDIUM => 1;
# spent 25µs making 1 call to File::Temp::BEGIN@95 # spent 20µs making 1 call to constant::import
96271µs244µs
# spent 24µs (5+20) within File::Temp::BEGIN@96 which was called: # once (5µs+20µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 96
use constant HIGH => 2;
# spent 24µs making 1 call to File::Temp::BEGIN@96 # spent 20µs making 1 call to constant::import
97
98# OPENFLAGS. If we defined the flag to use with Sysopen here this gives
99# us an optimisation when many temporary files are requested
100
1011200nsmy $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
1021100nsmy $LOCKFLAG;
103
10411µsunless ($^O eq 'MacOS') {
1051400ns for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
10642µs my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
1072181µs236µs
# spent 22µs (7+15) within File::Temp::BEGIN@107 which was called: # once (7µs+15µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 107
no strict 'refs';
# spent 22µs making 1 call to File::Temp::BEGIN@107 # spent 15µs making 1 call to strict::unimport
10842µs $OPENFLAGS |= $bit if eval {
109 # Make sure that redefined die handlers do not cause problems
110 # e.g. CGI::Carp
111511µs
# spent 900ns within File::Temp::__ANON__[/usr/share/perl/5.28/File/Temp.pm:111] which was called: # once (900ns+0s) by Fcntl::O_NOINHERIT at line 113
local $SIG{__DIE__} = sub {};
11246µs local $SIG{__WARN__} = sub {};
113463µs550µs $bit = &$func();
# spent 36µs making 1 call to Fcntl::O_NOINHERIT # spent 7µs making 1 call to Fcntl::O_NOFOLLOW # spent 4µs making 1 call to Fcntl::O_BINARY # spent 3µs making 1 call to Fcntl::O_LARGEFILE # spent 900ns making 1 call to File::Temp::__ANON__[File/Temp.pm:111]
11437µs 1;
115 };
116 }
117 # Special case O_EXLOCK
1181200ns $LOCKFLAG = eval {
11924µs
# spent 500ns within File::Temp::__ANON__[/usr/share/perl/5.28/File/Temp.pm:119] which was called: # once (500ns+0s) by Fcntl::O_EXLOCK at line 121
local $SIG{__DIE__} = sub {};
12012µs local $SIG{__WARN__} = sub {};
121114µs213µs &Fcntl::O_EXLOCK();
# spent 12µs making 1 call to Fcntl::O_EXLOCK # spent 500ns making 1 call to File::Temp::__ANON__[File/Temp.pm:119]
122 };
123}
124
125# On some systems the O_TEMPORARY flag can be used to tell the OS
126# to automatically remove the file when it is closed. This is fine
127# in most cases but not if tempfile is called with UNLINK=>0 and
128# the filename is requested -- in the case where the filename is to
129# be passed to another routine. This happens on windows. We overcome
130# this by using a second open flags variable
131
1321100nsmy $OPENTEMPFLAGS = $OPENFLAGS;
1331800nsunless ($^O eq 'MacOS') {
1341300ns for my $oflag (qw/ TEMPORARY /) {
1351700ns my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
1361200ns local($@);
1372666µs227µs
# spent 19µs (12+8) within File::Temp::BEGIN@137 which was called: # once (12µs+8µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 137
no strict 'refs';
# spent 19µs making 1 call to File::Temp::BEGIN@137 # spent 8µs making 1 call to strict::unimport
1381300ns $OPENTEMPFLAGS |= $bit if eval {
139 # Make sure that redefined die handlers do not cause problems
140 # e.g. CGI::Carp
14125µs
# spent 600ns within File::Temp::__ANON__[/usr/share/perl/5.28/File/Temp.pm:141] which was called: # once (600ns+0s) by Fcntl::O_TEMPORARY at line 143
local $SIG{__DIE__} = sub {};
14211µs local $SIG{__WARN__} = sub {};
143113µs213µs $bit = &$func();
# spent 12µs making 1 call to Fcntl::O_TEMPORARY # spent 600ns making 1 call to File::Temp::__ANON__[File/Temp.pm:141]
144 1;
145 };
146 }
147}
148
149# Private hash tracking which files have been created by each process id via the OO interface
1501100nsmy %FILES_CREATED_BY_OBJECT;
151
152# INTERNAL ROUTINES - not to be used outside of package
153
154# Generic routine for getting a temporary filename
155# modelled on OpenBSD _gettemp() in mktemp.c
156
157# The template must contain X's that are to be replaced
158# with the random values
159
160# Arguments:
161
162# TEMPLATE - string containing the XXXXX's that is converted
163# to a random filename and opened if required
164
165# Optionally, a hash can also be supplied containing specific options
166# "open" => if true open the temp file, else just return the name
167# default is 0
168# "mkdir"=> if true, we are creating a temp directory rather than tempfile
169# default is 0
170# "suffixlen" => number of characters at end of PATH to be ignored.
171# default is 0.
172# "unlink_on_close" => indicates that, if possible, the OS should remove
173# the file as soon as it is closed. Usually indicates
174# use of the O_TEMPORARY flag to sysopen.
175# Usually irrelevant on unix
176# "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
177
178# Optionally a reference to a scalar can be passed into the function
179# On error this will be used to store the reason for the error
180# "ErrStr" => \$errstr
181
182# "open" and "mkdir" can not both be true
183# "unlink_on_close" is not used when "mkdir" is true.
184
185# The default options are equivalent to mktemp().
186
187# Returns:
188# filehandle - open file handle (if called with doopen=1, else undef)
189# temp name - name of the temp file or directory
190
191# For example:
192# ($fh, $name) = _gettemp($template, "open" => 1);
193
194# for the current version, failures are associated with
195# stored in an error string and returned to give the reason whilst debugging
196# This routine is not called by any external function
197
# spent 7.03s (2.41+4.62) within File::Temp::_gettemp which was called 27907 times, avg 252µs/call: # 27905 times (2.41s+4.62s) by File::Temp::tempfile at line 1088, avg 252µs/call # 2 times (202µs+399µs) by File::Temp::tempdir at line 1201, avg 301µs/call
sub _gettemp {
198
1992790721.1ms croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
200 unless scalar(@_) >= 1;
201
202 # the internal error string - expect it to be overridden
203 # Need this in case the caller decides not to supply us a value
204 # need an anonymous scalar
205279076.83ms my $tempErrStr;
206
207 # Default options
20827907158ms my %options = (
209 "open" => 0,
210 "mkdir" => 0,
211 "suffixlen" => 0,
212 "unlink_on_close" => 0,
213 "use_exlock" => 1,
214 "ErrStr" => \$tempErrStr,
215 );
216
217 # Read the template
2182790714.0ms my $template = shift;
2192790716.2ms if (ref($template)) {
220 # Use a warning here since we have not yet merged ErrStr
221 carp "File::Temp::_gettemp: template must not be a reference";
222 return ();
223 }
224
225 # Check that the number of entries on stack are even
2262790720.4ms if (scalar(@_) % 2 != 0) {
227 # Use a warning here since we have not yet merged ErrStr
228 carp "File::Temp::_gettemp: Must have even number of options";
229 return ();
230 }
231
232 # Read the options and merge with defaults
23327907160ms %options = (%options, @_) if @_;
234
235 # Make sure the error string is set to undef
2362790725.6ms ${$options{ErrStr}} = undef;
237
238 # Can not open the file and make a directory in a single call
2392790726.6ms if ($options{"open"} && $options{"mkdir"}) {
240 ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
241 return ();
242 }
243
244 # Find the start of the end of the Xs (position of last X)
245 # Substr starts from 0
2462790727.7ms my $start = length($template) - 1 - $options{"suffixlen"};
247
248 # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
249 # (taking suffixlen into account). Any fewer is insecure.
250
251 # Do it using substr - no reason to use a pattern match since
252 # we know where we are looking and what we are looking for
253
2542790746.7ms if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
255 ${$options{ErrStr}} = "The template must end with at least ".
256 MINX . " 'X' characters\n";
257 return ();
258 }
259
260 # Replace all the X at the end of the substring with a
261 # random character or just all the XX at the end of a full string.
262 # Do it as an if, since the suffix adjusts which section to replace
263 # and suffixlen=0 returns nothing if used in the substr directly
264 # and generate a full path from the template
265
2662790780.5ms279072.36s my $path = _replace_XX($template, $options{"suffixlen"});
# spent 2.36s making 27907 calls to File::Temp::_replace_XX, avg 85µs/call
267
268 # Split the path into constituent parts - eventually we need to check
269 # whether the directory exists
270 # We need to know whether we are making a temp directory
271 # or a tempfile
272
273279077.36ms my ($volume, $directories, $file);
274 my $parent; # parent directory
2752790721.0ms if ($options{"mkdir"}) {
276 # There is no filename at the end
277216µs28µs ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
# spent 8µs making 2 calls to File::Spec::Unix::splitpath, avg 4µs/call
278
279 # The parent is then $directories without the last directory
280 # Split the directory and put it back together again
28128µs25µs my @dirs = File::Spec->splitdir($directories);
# spent 5µs making 2 calls to File::Spec::Unix::splitdir, avg 2µs/call
282
283 # If @dirs only has one entry (i.e. the directory template) that means
284 # we are in the current directory
28523µs if ($#dirs == 0) {
286 $parent = File::Spec->curdir;
287 } else {
288
28922µs if ($^O eq 'VMS') { # need volume to avoid relative dir spec
290 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
291 $parent = 'sys$disk:[]' if $parent eq '';
292 } else {
293
294 # Put it back together without the last one
295246µs448µs $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
# spent 35µs making 2 calls to File::Spec::Unix::catdir, avg 17µs/call # spent 13µs making 2 calls to File::Spec::Unix::canonpath, avg 6µs/call
296
297 # ...and attach the volume (no filename)
29826µs210µs $parent = File::Spec->catpath($volume, $parent, '');
# spent 10µs making 2 calls to File::Spec::Unix::catpath, avg 5µs/call
299 }
300
301 }
302
303 } else {
304
305 # Get rid of the last filename (use File::Basename for this?)
30627905116ms27905483ms ($volume, $directories, $file) = File::Spec->splitpath( $path );
# spent 483ms making 27905 calls to File::Spec::Unix::splitpath, avg 17µs/call
307
308 # Join up without the file part
3092790576.4ms27905147ms $parent = File::Spec->catpath($volume,$directories,'');
# spent 147ms making 27905 calls to File::Spec::Unix::catpath, avg 5µs/call
310
311 # If $parent is empty replace with curdir
3122790513.0ms $parent = File::Spec->curdir
313 unless $directories ne '';
314
315 }
316
317 # Check that the parent directories exist
318 # Do this even for the case where we are simply returning a name
319 # not a file -- no point returning a name that includes a directory
320 # that does not exist or is not writable
321
32227907285ms27907172ms unless (-e $parent) {
# spent 172ms making 27907 calls to File::Temp::CORE:ftis, avg 6µs/call
323 ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
324 return ();
325 }
32627907140ms2790736.7ms unless (-d $parent) {
# spent 36.7ms making 27907 calls to File::Temp::CORE:ftdir, avg 1µs/call
327 ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
328 return ();
329 }
330
331 # Check the stickiness of the directory and chown giveaway if required
332 # If the directory is world writable the sticky bit
333 # must be set
334
33527907166ms5581496.3ms if (File::Temp->safe_level == MEDIUM) {
# spent 96.3ms making 55814 calls to File::Temp::safe_level, avg 2µs/call
336 my $safeerr;
337 unless (_is_safe($parent,\$safeerr)) {
338 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
339 return ();
340 }
341 } elsif (File::Temp->safe_level == HIGH) {
342 my $safeerr;
343 unless (_is_verysafe($parent, \$safeerr)) {
344 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
345 return ();
346 }
347 }
348
349 # Now try MAX_TRIES time to open the file
3502790734.5ms for (my $i = 0; $i < MAX_TRIES; $i++) {
351
352 # Try to open the file if requested
3532790711.5ms if ($options{"open"}) {
354279056.25ms my $fh;
355
356 # If we are running before perl5.6.0 we can not auto-vivify
3572790514.6ms if ($] < 5.006) {
358 $fh = &Symbol::gensym;
359 }
360
361 # Try to make sure this will be marked close-on-exec
362 # XXX: Win32 doesn't respect this, nor the proper fcntl,
363 # but may have O_NOINHERIT. This may or may not be in Fcntl.
3642790548.6ms local $^F = 2;
365
366 # Attempt to open the file
367279059.22ms my $open_success = undef;
3682790537.9ms if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
369 # make it auto delete on close by setting FAB$V_DLT bit
370 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
371 $open_success = $fh;
372 } else {
3732790524.8ms my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
374 $OPENTEMPFLAGS :
375 $OPENFLAGS );
3762790510.9ms $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
377279051.41s279051.15s $open_success = sysopen($fh, $path, $flags, 0600);
# spent 1.15s making 27905 calls to File::Temp::CORE:sysopen, avg 41µs/call
378 }
3792790512.7ms if ( $open_success ) {
380
381 # in case of odd umask force rw
38227905313ms27905174ms chmod(0600, $path);
# spent 174ms making 27905 calls to File::Temp::CORE:chmod, avg 6µs/call
383
384 # Opened successfully - return file handle and name
38527905218ms return ($fh, $path);
386
387 } else {
388
389 # Error opening file - abort with error
390 # if the reason was anything but EEXIST
39114.69ms110µs unless ($!{EEXIST}) {
# spent 10µs making 1 call to Errno::_tie_it
392 ${$options{ErrStr}} = "Could not create temp file $path: $!";
393 return ();
394 }
395
396 # Loop round for another try
397
398 }
399 } elsif ($options{"mkdir"}) {
400
401 # Open the temp directory
4022184µs2176µs if (mkdir( $path, 0700)) {
# spent 176µs making 2 calls to File::Temp::CORE:mkdir, avg 88µs/call
403 # in case of odd umask
404225µs218µs chmod(0700, $path);
# spent 18µs making 2 calls to File::Temp::CORE:chmod, avg 9µs/call
405
406210µs return undef, $path;
407 } else {
408
409 # Abort with error if the reason for failure was anything
410 # except EEXIST
411 unless ($!{EEXIST}) {
412 ${$options{ErrStr}} = "Could not create directory $path: $!";
413 return ();
414 }
415
416 # Loop round for another try
417
418 }
419
420 } else {
421
422 # Return true if the file can not be found
423 # Directory has been checked previously
424
425 return (undef, $path) unless -e $path;
426
427 # Try again until MAX_TRIES
428
429 }
430
431 # Did not successfully open the tempfile/dir
432 # so try again with a different set of random letters
433 # No point in trying to increment unless we have only
434 # 1 X say and the randomness could come up with the same
435 # file MAX_TRIES in a row.
436
437 # Store current attempt - in principal this implies that the
438 # 3rd time around the open attempt that the first temp file
439 # name could be generated again. Probably should store each
440 # attempt and make sure that none are repeated
441
442 my $original = $path;
443 my $counter = 0; # Stop infinite loop
444 my $MAX_GUESS = 50;
445
446 do {
447
448 # Generate new name from original template
449 $path = _replace_XX($template, $options{"suffixlen"});
450
451 $counter++;
452
453 } until ($path ne $original || $counter > $MAX_GUESS);
454
455 # Check for out of control looping
456 if ($counter > $MAX_GUESS) {
457 ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
458 return ();
459 }
460
461 }
462
463 # If we get here, we have run out of tries
464 ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
465 . MAX_TRIES . ") to open temp file/dir";
466
467 return ();
468
469}
470
471# Internal routine to replace the XXXX... with random characters
472# This has to be done by _gettemp() every time it fails to
473# open a temp file/dir
474
475# Arguments: $template (the template with XXX),
476# $ignore (number of characters at end to ignore)
477
478# Returns: modified template
479
480
# spent 2.36s (1.76+598ms) within File::Temp::_replace_XX which was called 27907 times, avg 85µs/call: # 27907 times (1.76s+598ms) by File::Temp::_gettemp at line 266, avg 85µs/call
sub _replace_XX {
481
4822790718.6ms croak 'Usage: _replace_XX($template, $ignore)'
483 unless scalar(@_) == 2;
484
4852790715.2ms my ($path, $ignore) = @_;
486
487 # Do it as an if, since the suffix adjusts which section to replace
488 # and suffixlen=0 returns nothing if used in the substr directly
489 # Alternatively, could simply set $ignore to length($path)-1
490 # Don't want to always use substr when not required though.
4912790730.7ms my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
492
4932790726.7ms if ($ignore) {
494 substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
495 } else {
496279072.20s362782598ms $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
# spent 392ms making 306968 calls to File::Temp::CORE:substcont, avg 1µs/call # spent 134ms making 27907 calls to File::Temp::CORE:subst, avg 5µs/call # spent 73.3ms making 27907 calls to File::Temp::CORE:regcomp, avg 3µs/call
497 }
49827907192ms return $path;
499}
500
501# Internal routine to force a temp file to be writable after
502# it is created so that we can unlink it. Windows seems to occasionally
503# force a file to be readonly when written to certain temp locations
504sub _force_writable {
505 my $file = shift;
506 chmod 0600, $file;
507}
508
509# internal routine to check to see if the directory is safe
510# First checks to see if the directory is not owned by the
511# current user or root. Then checks to see if anyone else
512# can write to the directory and if so, checks to see if
513# it has the sticky bit set
514
515# Will not work on systems that do not support sticky bit
516
517#Args: directory path to check
518# Optionally: reference to scalar to contain error message
519# Returns true if the path is safe and false otherwise.
520# Returns undef if can not even run stat() on the path
521
522# This routine based on version written by Tom Christiansen
523
524# Presumably, by the time we actually attempt to create the
525# file or directory in this directory, it may not be safe
526# anymore... Have to run _is_safe directly after the open.
527
528sub _is_safe {
529
530 my $path = shift;
531 my $err_ref = shift;
532
533 # Stat path
534 my @info = stat($path);
535 unless (scalar(@info)) {
536 $$err_ref = "stat(path) returned no values";
537 return 0;
538 }
539 ;
540 return 1 if $^O eq 'VMS'; # owner delete control at file level
541
542 # Check to see whether owner is neither superuser (or a system uid) nor me
543 # Use the effective uid from the $> variable
544 # UID is in [4]
545 if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
546
547 Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
548 File::Temp->top_system_uid());
549
550 $$err_ref = "Directory owned neither by root nor the current user"
551 if ref($err_ref);
552 return 0;
553 }
554
555 # check whether group or other can write file
556 # use 066 to detect either reading or writing
557 # use 022 to check writability
558 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
559 # mode is in info[2]
560 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
561 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
562 # Must be a directory
563 unless (-d $path) {
564 $$err_ref = "Path ($path) is not a directory"
565 if ref($err_ref);
566 return 0;
567 }
568 # Must have sticky bit set
569 unless (-k $path) {
570 $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
571 if ref($err_ref);
572 return 0;
573 }
574 }
575
576 return 1;
577}
578
579# Internal routine to check whether a directory is safe
580# for temp files. Safer than _is_safe since it checks for
581# the possibility of chown giveaway and if that is a possibility
582# checks each directory in the path to see if it is safe (with _is_safe)
583
584# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
585# directory anyway.
586
587# Takes optional second arg as scalar ref to error reason
588
589sub _is_verysafe {
590
591 # Need POSIX - but only want to bother if really necessary due to overhead
592 require POSIX;
593
594 my $path = shift;
595 print "_is_verysafe testing $path\n" if $DEBUG;
596 return 1 if $^O eq 'VMS'; # owner delete control at file level
597
598 my $err_ref = shift;
599
600 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
601 # and If it is not there do the extensive test
602 local($@);
603 my $chown_restricted;
604 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
605 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
606
607 # If chown_resticted is set to some value we should test it
608 if (defined $chown_restricted) {
609
610 # Return if the current directory is safe
611 return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
612
613 }
614
615 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
616 # was not available or the symbol was there but chown giveaway
617 # is allowed. Either way, we now have to test the entire tree for
618 # safety.
619
620 # Convert path to an absolute directory if required
621 unless (File::Spec->file_name_is_absolute($path)) {
622 $path = File::Spec->rel2abs($path);
623 }
624
625 # Split directory into components - assume no file
626 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
627
628 # Slightly less efficient than having a function in File::Spec
629 # to chop off the end of a directory or even a function that
630 # can handle ../ in a directory tree
631 # Sometimes splitdir() returns a blank at the end
632 # so we will probably check the bottom directory twice in some cases
633 my @dirs = File::Spec->splitdir($directories);
634
635 # Concatenate one less directory each time around
636 foreach my $pos (0.. $#dirs) {
637 # Get a directory name
638 my $dir = File::Spec->catpath($volume,
639 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
640 ''
641 );
642
643 print "TESTING DIR $dir\n" if $DEBUG;
644
645 # Check the directory
646 return 0 unless _is_safe($dir,$err_ref);
647
648 }
649
650 return 1;
651}
652
653# internal routine to determine whether unlink works on this
654# platform for files that are currently open.
655# Returns true if we can, false otherwise.
656
657# Currently WinNT, OS/2 and VMS can not unlink an opened file
658# On VMS this is because the O_EXCL flag is used to open the
659# temporary file. Currently I do not know enough about the issues
660# on VMS to decide whether O_EXCL is a requirement.
661
662sub _can_unlink_opened_file {
663
664 if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
665 return 0;
666 } else {
667 return 1;
668 }
669
670}
671
672# internal routine to decide which security levels are allowed
673# see safe_level() for more information on this
674
675# Controls whether the supplied security level is allowed
676
677# $cando = _can_do_level( $level )
678
679sub _can_do_level {
680
681 # Get security level
682 my $level = shift;
683
684 # Always have to be able to do STANDARD
685 return 1 if $level == STANDARD;
686
687 # Currently, the systems that can do HIGH or MEDIUM are identical
688 if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
689 return 0;
690 } else {
691 return 1;
692 }
693
694}
695
696# This routine sets up a deferred unlinking of a specified
697# filename and filehandle. It is used in the following cases:
698# - Called by unlink0 if an opened file can not be unlinked
699# - Called by tempfile() if files are to be removed on shutdown
700# - Called by tempdir() if directories are to be removed on shutdown
701
702# Arguments:
703# _deferred_unlink( $fh, $fname, $isdir );
704#
705# - filehandle (so that it can be explicitly closed if open
706# - filename (the thing we want to remove)
707# - isdir (flag to indicate that we are being given a directory)
708# [and hence no filehandle]
709
710# Status is not referred to since all the magic is done with an END block
711
712{
713 # Will set up two lexical variables to contain all the files to be
714 # removed. One array for files, another for directories They will
715 # only exist in this block.
716
717 # This means we only have to set up a single END block to remove
718 # all files.
719
720 # in order to prevent child processes inadvertently deleting the parent
721 # temp files we use a hash to store the temp files and directories
722 # created by a particular process id.
723
724 # %files_to_unlink contains values that are references to an array of
725 # array references containing the filehandle and filename associated with
726 # the temp file.
7271400ns my (%files_to_unlink, %dirs_to_unlink);
728
729 # Set up an end block to use these arrays
730
# spent 70µs (38+32) within File::Temp::END which was called: # once (38µs+32µs) by main::RUNTIME at line 0 of /root/tor-browser-build/rbm/rbm
END {
731119µs local($., $@, $!, $^E, $?);
732117µs132µs cleanup(at_exit => 1);
# spent 32µs making 1 call to File::Temp::cleanup
733 }
734
735 # Cleanup function. Always triggered on END (with at_exit => 1) but
736 # can be invoked manually.
737
# spent 32µs (31+1000ns) within File::Temp::cleanup which was called: # once (31µs+1000ns) by File::Temp::END at line 732
sub cleanup {
73813µs my %h = @_;
73911µs my $at_exit = delete $h{at_exit};
7401400ns $at_exit = 0 if not defined $at_exit;
741316µs11µs { my @k = sort keys %h; die "unrecognized parameters: @k" if @k }
# spent 1µs making 1 call to File::Temp::CORE:sort
742
743116µs if (!$KEEP_ALL) {
744 # Files
745 my @files = (exists $files_to_unlink{$$} ?
74613µs @{ $files_to_unlink{$$} } : () );
74711µs foreach my $file (@files) {
748 # close the filehandle without checking its state
749 # in order to make real sure that this is closed
750 # if its already closed then I don't care about the answer
751 # probably a better way to do this
752 close($file->[0]); # file handle is [0]
753
754 if (-f $file->[1]) { # file name is [1]
755 _force_writable( $file->[1] ); # for windows
756 unlink $file->[1] or warn "Error removing ".$file->[1];
757 }
758 }
759 # Dirs
760 my @dirs = (exists $dirs_to_unlink{$$} ?
76111µs @{ $dirs_to_unlink{$$} } : () );
7621300ns my ($cwd, $cwd_to_remove);
76311µs foreach my $dir (@dirs) {
764 if (-d $dir) {
765 # Some versions of rmtree will abort if you attempt to remove
766 # the directory you are sitting in. For automatic cleanup
767 # at program exit, we avoid this by chdir()ing out of the way
768 # first. If not at program exit, it's best not to mess with the
769 # current directory, so just let it fail with a warning.
770 if ($at_exit) {
771 $cwd = Cwd::abs_path(File::Spec->curdir) if not defined $cwd;
772 my $abs = Cwd::abs_path($dir);
773 if ($abs eq $cwd) {
774 $cwd_to_remove = $dir;
775 next;
776 }
777 }
778 eval { rmtree($dir, $DEBUG, 0); };
779 warn $@ if ($@ && $^W);
780 }
781 }
782
7831400ns if (defined $cwd_to_remove) {
784 # We do need to clean up the current directory, and everything
785 # else is done, so get out of there and remove it.
786 chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";
787 my $updir = File::Spec->updir;
788 chdir $updir or die "cannot chdir to $updir: $!";
789 eval { rmtree($cwd_to_remove, $DEBUG, 0); };
790 warn $@ if ($@ && $^W);
791 }
792
793 # clear the arrays
794 @{ $files_to_unlink{$$} } = ()
7951500ns if exists $files_to_unlink{$$};
796 @{ $dirs_to_unlink{$$} } = ()
7971700ns if exists $dirs_to_unlink{$$};
798 }
799 }
800
801 # This is the sub called to register a file for deferred unlinking
802 # This could simply store the input parameters and defer everything
803 # until the END block. For now we do a bit of checking at this
804 # point in order to make sure that (1) we have a file/dir to delete
805 # and (2) we have been called with the correct arguments.
806 sub _deferred_unlink {
807
808 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
809 unless scalar(@_) == 3;
810
811 my ($fh, $fname, $isdir) = @_;
812
813 warn "Setting up deferred removal of $fname\n"
814 if $DEBUG;
815
816 # make sure we save the absolute path for later cleanup
817 # OK to untaint because we only ever use this internally
818 # as a file path, never interpolating into the shell
819 $fname = Cwd::abs_path($fname);
820 ($fname) = $fname =~ /^(.*)$/;
821
822 # If we have a directory, check that it is a directory
823 if ($isdir) {
824
825 if (-d $fname) {
826
827 # Directory exists so store it
828 # first on VMS turn []foo into [.foo] for rmtree
829 $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
830 $dirs_to_unlink{$$} = []
831 unless exists $dirs_to_unlink{$$};
832 push (@{ $dirs_to_unlink{$$} }, $fname);
833
834 } else {
835 carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
836 }
837
838 } else {
839
840 if (-f $fname) {
841
842 # file exists so store handle and name for later removal
843 $files_to_unlink{$$} = []
844 unless exists $files_to_unlink{$$};
845 push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
846
847 } else {
848 carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
849 }
850
851 }
852
853 }
854
855}
856
857# normalize argument keys to upper case and do consistent handling
858# of leading template vs TEMPLATE
8591200ns
# spent 235ms within File::Temp::_parse_args which was called 27909 times, avg 8µs/call: # 27905 times (235ms+0s) by File::Temp::tempfile at line 1009, avg 8µs/call # 2 times (23µs+0s) by File::Temp::newdir at line 914, avg 12µs/call # 2 times (7µs+0s) by File::Temp::tempdir at line 1137, avg 3µs/call
sub _parse_args {
8602790945.8ms my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
8612790917.8ms my %args = @_;
8622790936.4ms %args = map { uc($_), $args{$_} } keys %args;
863
864 # template (store it in an array so that it will
865 # disappear from the arg list of tempfile)
866 my @template = (
867 exists $args{TEMPLATE} ? $args{TEMPLATE} :
8682790948.0ms $leading_template ? $leading_template : ()
869 );
8702790910.9ms delete $args{TEMPLATE};
871
87227909176ms return( \@template, \%args );
873}
874
875sub new {
876 my $proto = shift;
877 my $class = ref($proto) || $proto;
878
879 my ($maybe_template, $args) = _parse_args(@_);
880
881 # see if they are unlinking (defaulting to yes)
882 my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 );
883 delete $args->{UNLINK};
884
885 # Protect OPEN
886 delete $args->{OPEN};
887
888 # Open the file and retain file handle and file name
889 my ($fh, $path) = tempfile( @$maybe_template, %$args );
890
891 print "Tmp: $fh - $path\n" if $DEBUG;
892
893 # Store the filename in the scalar slot
894 ${*$fh} = $path;
895
896 # Cache the filename by pid so that the destructor can decide whether to remove it
897 $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
898
899 # Store unlink information in hash slot (plus other constructor info)
900 %{*$fh} = %$args;
901
902 # create the object
903 bless $fh, $class;
904
905 # final method-based configuration
906 $fh->unlink_on_destroy( $unlink );
907
908 return $fh;
909}
910
911
# spent 828µs (82+746) within File::Temp::newdir which was called 2 times, avg 414µs/call: # once (59µs+409µs) by RBM::build_run at line 995 of /root/tor-browser-build/rbm/lib/RBM.pm # once (23µs+337µs) by RBM::DefaultConfig::rbm_tmp_dir at line 111 of /root/tor-browser-build/rbm/lib/RBM/DefaultConfig.pm
sub newdir {
9122700ns my $self = shift;
913
91426µs223µs my ($maybe_template, $args) = _parse_args(@_);
# spent 23µs making 2 calls to File::Temp::_parse_args, avg 12µs/call
915
916 # handle CLEANUP without passing CLEANUP to tempdir
91722µs my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 );
9182700ns delete $args->{CLEANUP};
919
92027µs2690µs my $tempdir = tempdir( @$maybe_template, %$args);
# spent 690µs making 2 calls to File::Temp::tempdir, avg 345µs/call
921
922 # get a safe absolute path for cleanup, just like
923 # happens in _deferred_unlink
924262µs227µs my $real_dir = Cwd::abs_path( $tempdir );
# spent 27µs making 2 calls to Cwd::abs_path, avg 14µs/call
925212µs26µs ($real_dir) = $real_dir =~ /^(.*)$/;
# spent 6µs making 2 calls to File::Temp::CORE:match, avg 3µs/call
926
927223µs return bless { DIRNAME => $tempdir,
928 REALNAME => $real_dir,
929 CLEANUP => $cleanup,
930 LAUNCHPID => $$,
931 }, "File::Temp::Dir";
932}
933
934sub filename {
935 my $self = shift;
936 return ${*$self};
937}
938
939sub STRINGIFY {
940 my $self = shift;
941 return $self->filename;
942}
943
944# For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because
945# refaddr() demands one parameter only, whereas overload.pm calls with three
946# even for unary operations like '0+'.
947
# spent 275µs (209+66) within File::Temp::NUMIFY which was called 25 times, avg 11µs/call: # 25 times (209µs+66µs) by RBM::DefaultConfig::rbm_tmp_dir at line 108 of /root/tor-browser-build/rbm/lib/RBM/DefaultConfig.pm, avg 11µs/call
sub NUMIFY {
94825335µs2566µs return refaddr($_[0]);
# spent 66µs making 25 calls to Scalar::Util::refaddr, avg 3µs/call
949}
950
951sub unlink_on_destroy {
952 my $self = shift;
953 if (@_) {
954 ${*$self}{UNLINK} = shift;
955 }
956 return ${*$self}{UNLINK};
957}
958
959sub DESTROY {
960 local($., $@, $!, $^E, $?);
961 my $self = shift;
962
963 # Make sure we always remove the file from the global hash
964 # on destruction. This prevents the hash from growing uncontrollably
965 # and post-destruction there is no reason to know about the file.
966 my $file = $self->filename;
967 my $was_created_by_proc;
968 if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
969 $was_created_by_proc = 1;
970 delete $FILES_CREATED_BY_OBJECT{$$}{$file};
971 }
972
973 if (${*$self}{UNLINK} && !$KEEP_ALL) {
974 print "# ---------> Unlinking $self\n" if $DEBUG;
975
976 # only delete if this process created it
977 return unless $was_created_by_proc;
978
979 # The unlink1 may fail if the file has been closed
980 # by the caller. This leaves us with the decision
981 # of whether to refuse to remove the file or simply
982 # do an unlink without test. Seems to be silly
983 # to do this when we are trying to be careful
984 # about security
985 _force_writable( $file ); # for windows
986 unlink1( $self, $file )
987 or unlink($file);
988 }
989}
990
991
# spent 9.73s (1.36+8.37) within File::Temp::tempfile which was called 27905 times, avg 349µs/call: # 27890 times (1.36s+8.37s) by IO::CaptureOutput::_proxy::new at line 168 of IO/CaptureOutput.pm, avg 349µs/call # 15 times (688µs+5.54ms) by RBM::run_script at line 465 of /root/tor-browser-build/rbm/lib/RBM.pm, avg 415µs/call
sub tempfile {
9922790517.2ms if ( @_ && $_[0] eq 'File::Temp' ) {
993 croak "'tempfile' can't be called as a method";
994 }
995 # Can not check for argument count since we can have any
996 # number of args
997
998 # Default options
99927905172ms my %options = (
1000 "DIR" => undef, # Directory prefix
1001 "SUFFIX" => '', # Template suffix
1002 "UNLINK" => 0, # Do not unlink file on exit
1003 "OPEN" => 1, # Open file
1004 "TMPDIR" => 0, # Place tempfile in tempdir if template specified
1005 "EXLOCK" => 1, # Open file with O_EXLOCK
1006 );
1007
1008 # Check to see whether we have an odd or even number of arguments
10092790568.8ms27905235ms my ($maybe_template, $args) = _parse_args(@_);
# spent 235ms making 27905 calls to File::Temp::_parse_args, avg 8µs/call
10102790521.1ms my $template = @$maybe_template ? $maybe_template->[0] : undef;
1011
1012 # Read the options and merge with defaults
10132790597.4ms %options = (%options, %$args);
1014
1015 # First decision is whether or not to open the file
10162790520.7ms if (! $options{"OPEN"}) {
1017
1018 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1019 if $^W;
1020
1021 }
1022
10232790511.8ms if ($options{"DIR"} and $^O eq 'VMS') {
1024
1025 # on VMS turn []foo into [.foo] for concatenation
1026 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1027 }
1028
1029 # Construct the template
1030
1031 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1032 # functions or simply constructing a template and using _gettemp()
1033 # explicitly. Go for the latter
1034
1035 # First generate a template if not defined and prefix the directory
1036 # If no template must prefix the temp directory
10372790531.3ms if (defined $template) {
1038 # End up with current directory if neither DIR not TMPDIR are set
1039 if ($options{"DIR"}) {
1040
1041 $template = File::Spec->catfile($options{"DIR"}, $template);
1042
1043 } elsif ($options{TMPDIR}) {
1044
1045 $template = File::Spec->catfile(File::Spec->tmpdir, $template );
1046
1047 }
1048
1049 } else {
1050
10512790514.1ms60466µs if ($options{"DIR"}) {
# spent 327µs making 15 calls to File::Spec::Unix::catfile, avg 22µs/call # spent 100µs making 15 calls to File::Spec::Unix::catdir, avg 7µs/call # spent 40µs making 30 calls to File::Spec::Unix::canonpath, avg 1µs/call
1052
1053 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1054
1055 } else {
1056
105727890945ms1394501.38s $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
# spent 608ms making 27890 calls to File::Spec::Unix::catfile, avg 22µs/call # spent 499ms making 27890 calls to File::Spec::Unix::tmpdir, avg 18µs/call # spent 202ms making 27890 calls to File::Spec::Unix::catdir, avg 7µs/call # spent 72.0ms making 55780 calls to File::Spec::Unix::canonpath, avg 1µs/call
1058
1059 }
1060
1061 }
1062
1063 # Now add a suffix
10642790515.6ms $template .= $options{"SUFFIX"};
1065
1066 # Determine whether we should tell _gettemp to unlink the file
1067 # On unix this is irrelevant and can be worked out after the file is
1068 # opened (simply by unlinking the open filehandle). On Windows or VMS
1069 # we have to indicate temporary-ness when we open the file. In general
1070 # we only want a true temporary file if we are returning just the
1071 # filehandle - if the user wants the filename they probably do not
1072 # want the file to disappear as soon as they close it (which may be
1073 # important if they want a child process to use the file)
1074 # For this reason, tie unlink_on_close to the return context regardless
1075 # of OS.
10762790520.5ms my $unlink_on_close = ( wantarray ? 0 : 1);
1077
1078 # Create the file
1079279057.85ms my ($fh, $path, $errstr);
1080 croak "Error in tempfile() using template $template: $errstr"
1081 unless (($fh, $path) = _gettemp($template,
1082 "open" => $options{'OPEN'},
1083 "mkdir"=> 0 ,
1084 "unlink_on_close" => $unlink_on_close,
1085 "suffixlen" => length($options{'SUFFIX'}),
1086 "ErrStr" => \$errstr,
1087 "use_exlock" => $options{EXLOCK},
108827905128ms279057.03s ) );
# spent 7.03s making 27905 calls to File::Temp::_gettemp, avg 252µs/call
1089
1090 # Set up an exit handler that can do whatever is right for the
1091 # system. This removes files at exit when requested explicitly or when
1092 # system is asked to unlink_on_close but is unable to do so because
1093 # of OS limitations.
1094 # The latter should be achieved by using a tied filehandle.
1095 # Do not check return status since this is all done with END blocks.
10962790513.8ms _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1097
1098 # Return
109927905157ms if (wantarray()) {
1100
1101 if ($options{'OPEN'}) {
1102 return ($fh, $path);
1103 } else {
1104 return (undef, $path);
1105 }
1106
1107 } else {
1108
1109 # Unlink the file. It is up to unlink0 to decide what to do with
1110 # this (whether to unlink now or to defer until later)
1111 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1112
1113 # Return just the filehandle.
1114 return $fh;
1115 }
1116
1117}
1118
1119# '
1120
1121
# spent 690µs (63+626) within File::Temp::tempdir which was called 2 times, avg 345µs/call: # 2 times (63µs+626µs) by File::Temp::newdir at line 920, avg 345µs/call
sub tempdir {
112223µs if ( @_ && $_[0] eq 'File::Temp' ) {
1123 croak "'tempdir' can't be called as a method";
1124 }
1125
1126 # Can not check for argument count since we can have any
1127 # number of args
1128
1129 # Default options
113026µs my %options = (
1131 "CLEANUP" => 0, # Remove directory on exit
1132 "DIR" => '', # Root directory
1133 "TMPDIR" => 0, # Use tempdir with template
1134 );
1135
1136 # Check to see whether we have an odd or even number of arguments
113723µs27µs my ($maybe_template, $args) = _parse_args(@_);
# spent 7µs making 2 calls to File::Temp::_parse_args, avg 3µs/call
113822µs my $template = @$maybe_template ? $maybe_template->[0] : undef;
1139
1140 # Read the options and merge with defaults
114124µs %options = (%options, %$args);
1142
1143 # Modify or generate the template
1144
1145 # Deal with the DIR and TMPDIR options
114622µs if (defined $template) {
1147
1148 # Need to strip directory path if using DIR or TMPDIR
114922µs if ($options{'TMPDIR'} || $options{'DIR'}) {
1150
1151 # Strip parent directory from the filename
1152 #
1153 # There is no filename at the end
115411µs $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
115515µs16µs my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
# spent 6µs making 1 call to File::Spec::Unix::splitpath
1156
1157 # Last directory is then our template
115813µs12µs $template = (File::Spec->splitdir($directories))[-1];
# spent 2µs making 1 call to File::Spec::Unix::splitdir
1159
1160 # Prepend the supplied directory or temp dir
1161114µs211µs if ($options{"DIR"}) {
# spent 10µs making 1 call to File::Spec::Unix::catdir # spent 1µs making 1 call to File::Spec::Unix::canonpath
1162
1163 $template = File::Spec->catdir($options{"DIR"}, $template);
1164
1165 } elsif ($options{TMPDIR}) {
1166
1167 # Prepend tmpdir
1168 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1169
1170 }
1171
1172 }
1173
1174 } else {
1175
1176 if ($options{"DIR"}) {
1177
1178 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1179
1180 } else {
1181
1182 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1183
1184 }
1185
1186 }
1187
1188 # Create the directory
118921µs my $tempdir;
11902700ns my $suffixlen = 0;
119121µs if ($^O eq 'VMS') { # dir names can end in delimiters
1192 $template =~ m/([\.\]:>]+)$/;
1193 $suffixlen = length($1);
1194 }
119521µs if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1196 # dir name has a trailing ':'
1197 ++$suffixlen;
1198 }
1199
12002300ns my $errstr;
120127µs2601µs croak "Error in tempdir() using $template: $errstr"
# spent 601µs making 2 calls to File::Temp::_gettemp, avg 301µs/call
1202 unless ((undef, $tempdir) = _gettemp($template,
1203 "open" => 0,
1204 "mkdir"=> 1 ,
1205 "suffixlen" => $suffixlen,
1206 "ErrStr" => \$errstr,
1207 ) );
1208
1209 # Install exit handler; must be dynamic to get lexical
12102900ns if ( $options{'CLEANUP'} && -d $tempdir) {
1211 _deferred_unlink(undef, $tempdir, 1);
1212 }
1213
1214 # Return the dir name
121528µs return $tempdir;
1216
1217}
1218
1219sub mkstemp {
1220
1221 croak "Usage: mkstemp(template)"
1222 if scalar(@_) != 1;
1223
1224 my $template = shift;
1225
1226 my ($fh, $path, $errstr);
1227 croak "Error in mkstemp using $template: $errstr"
1228 unless (($fh, $path) = _gettemp($template,
1229 "open" => 1,
1230 "mkdir"=> 0 ,
1231 "suffixlen" => 0,
1232 "ErrStr" => \$errstr,
1233 ) );
1234
1235 if (wantarray()) {
1236 return ($fh, $path);
1237 } else {
1238 return $fh;
1239 }
1240
1241}
1242
1243sub mkstemps {
1244
1245 croak "Usage: mkstemps(template, suffix)"
1246 if scalar(@_) != 2;
1247
1248 my $template = shift;
1249 my $suffix = shift;
1250
1251 $template .= $suffix;
1252
1253 my ($fh, $path, $errstr);
1254 croak "Error in mkstemps using $template: $errstr"
1255 unless (($fh, $path) = _gettemp($template,
1256 "open" => 1,
1257 "mkdir"=> 0 ,
1258 "suffixlen" => length($suffix),
1259 "ErrStr" => \$errstr,
1260 ) );
1261
1262 if (wantarray()) {
1263 return ($fh, $path);
1264 } else {
1265 return $fh;
1266 }
1267
1268}
1269
1270#' # for emacs
1271
1272sub mkdtemp {
1273
1274 croak "Usage: mkdtemp(template)"
1275 if scalar(@_) != 1;
1276
1277 my $template = shift;
1278 my $suffixlen = 0;
1279 if ($^O eq 'VMS') { # dir names can end in delimiters
1280 $template =~ m/([\.\]:>]+)$/;
1281 $suffixlen = length($1);
1282 }
1283 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1284 # dir name has a trailing ':'
1285 ++$suffixlen;
1286 }
1287 my ($junk, $tmpdir, $errstr);
1288 croak "Error creating temp directory from template $template\: $errstr"
1289 unless (($junk, $tmpdir) = _gettemp($template,
1290 "open" => 0,
1291 "mkdir"=> 1 ,
1292 "suffixlen" => $suffixlen,
1293 "ErrStr" => \$errstr,
1294 ) );
1295
1296 return $tmpdir;
1297
1298}
1299
1300sub mktemp {
1301
1302 croak "Usage: mktemp(template)"
1303 if scalar(@_) != 1;
1304
1305 my $template = shift;
1306
1307 my ($tmpname, $junk, $errstr);
1308 croak "Error getting name to temp file from template $template: $errstr"
1309 unless (($junk, $tmpname) = _gettemp($template,
1310 "open" => 0,
1311 "mkdir"=> 0 ,
1312 "suffixlen" => 0,
1313 "ErrStr" => \$errstr,
1314 ) );
1315
1316 return $tmpname;
1317}
1318
1319sub tmpnam {
1320
1321 # Retrieve the temporary directory name
1322 my $tmpdir = File::Spec->tmpdir;
1323
1324 croak "Error temporary directory is not writable"
1325 if $tmpdir eq '';
1326
1327 # Use a ten character template and append to tmpdir
1328 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1329
1330 if (wantarray() ) {
1331 return mkstemp($template);
1332 } else {
1333 return mktemp($template);
1334 }
1335
1336}
1337
1338sub tmpfile {
1339
1340 # Simply call tmpnam() in a list context
1341 my ($fh, $file) = tmpnam();
1342
1343 # Make sure file is removed when filehandle is closed
1344 # This will fail on NFS
1345 unlink0($fh, $file)
1346 or return undef;
1347
1348 return $fh;
1349
1350}
1351
1352sub tempnam {
1353
1354 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1355
1356 my ($dir, $prefix) = @_;
1357
1358 # Add a string to the prefix
1359 $prefix .= 'XXXXXXXX';
1360
1361 # Concatenate the directory to the file
1362 my $template = File::Spec->catfile($dir, $prefix);
1363
1364 return mktemp($template);
1365
1366}
1367
1368sub unlink0 {
1369
1370 croak 'Usage: unlink0(filehandle, filename)'
1371 unless scalar(@_) == 2;
1372
1373 # Read args
1374 my ($fh, $path) = @_;
1375
1376 cmpstat($fh, $path) or return 0;
1377
1378 # attempt remove the file (does not work on some platforms)
1379 if (_can_unlink_opened_file()) {
1380
1381 # return early (Without unlink) if we have been instructed to retain files.
1382 return 1 if $KEEP_ALL;
1383
1384 # XXX: do *not* call this on a directory; possible race
1385 # resulting in recursive removal
1386 croak "unlink0: $path has become a directory!" if -d $path;
1387 unlink($path) or return 0;
1388
1389 # Stat the filehandle
1390 my @fh = stat $fh;
1391
1392 print "Link count = $fh[3] \n" if $DEBUG;
1393
1394 # Make sure that the link count is zero
1395 # - Cygwin provides deferred unlinking, however,
1396 # on Win9x the link count remains 1
1397 # On NFS the link count may still be 1 but we can't know that
1398 # we are on NFS. Since we can't be sure, we'll defer it
1399
1400 return 1 if $fh[3] == 0 || $^O eq 'cygwin';
1401 }
1402 # fall-through if we can't unlink now
1403 _deferred_unlink($fh, $path, 0);
1404 return 1;
1405}
1406
1407sub cmpstat {
1408
1409 croak 'Usage: cmpstat(filehandle, filename)'
1410 unless scalar(@_) == 2;
1411
1412 # Read args
1413 my ($fh, $path) = @_;
1414
1415 warn "Comparing stat\n"
1416 if $DEBUG;
1417
1418 # Stat the filehandle - which may be closed if someone has manually
1419 # closed the file. Can not turn off warnings without using $^W
1420 # unless we upgrade to 5.006 minimum requirement
1421 my @fh;
1422 {
1423 local ($^W) = 0;
1424 @fh = stat $fh;
1425 }
1426 return unless @fh;
1427
1428 if ($fh[3] > 1 && $^W) {
1429 carp "unlink0: fstat found too many links; SB=@fh" if $^W;
1430 }
1431
1432 # Stat the path
1433 my @path = stat $path;
1434
1435 unless (@path) {
1436 carp "unlink0: $path is gone already" if $^W;
1437 return;
1438 }
1439
1440 # this is no longer a file, but may be a directory, or worse
1441 unless (-f $path) {
1442 confess "panic: $path is no longer a file: SB=@fh";
1443 }
1444
1445 # Do comparison of each member of the array
1446 # On WinNT dev and rdev seem to be different
1447 # depending on whether it is a file or a handle.
1448 # Cannot simply compare all members of the stat return
1449 # Select the ones we can use
1450 my @okstat = (0..$#fh); # Use all by default
1451 if ($^O eq 'MSWin32') {
1452 @okstat = (1,2,3,4,5,7,8,9,10);
1453 } elsif ($^O eq 'os2') {
1454 @okstat = (0, 2..$#fh);
1455 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
1456 @okstat = (0, 1);
1457 } elsif ($^O eq 'dos') {
1458 @okstat = (0,2..7,11..$#fh);
1459 } elsif ($^O eq 'mpeix') {
1460 @okstat = (0..4,8..10);
1461 }
1462
1463 # Now compare each entry explicitly by number
1464 for (@okstat) {
1465 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1466 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
1467 # and 12) will be '' on platforms that do not support them. This
1468 # is fine since we are only comparing integers.
1469 unless ($fh[$_] eq $path[$_]) {
1470 warn "Did not match $_ element of stat\n" if $DEBUG;
1471 return 0;
1472 }
1473 }
1474
1475 return 1;
1476}
1477
1478sub unlink1 {
1479 croak 'Usage: unlink1(filehandle, filename)'
1480 unless scalar(@_) == 2;
1481
1482 # Read args
1483 my ($fh, $path) = @_;
1484
1485 cmpstat($fh, $path) or return 0;
1486
1487 # Close the file
1488 close( $fh ) or return 0;
1489
1490 # Make sure the file is writable (for windows)
1491 _force_writable( $path );
1492
1493 # return early (without unlink) if we have been instructed to retain files.
1494 return 1 if $KEEP_ALL;
1495
1496 # remove the file
1497 return unlink($path);
1498}
1499
1500{
1501 # protect from using the variable itself
15021300ns my $LEVEL = STANDARD;
1503
# spent 96.3ms within File::Temp::safe_level which was called 55814 times, avg 2µs/call: # 55814 times (96.3ms+0s) by File::Temp::_gettemp at line 335, avg 2µs/call
sub safe_level {
15045581422.2ms my $self = shift;
15055581415.2ms if (@_) {
1506 my $level = shift;
1507 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
1508 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
1509 } else {
1510 # Don't allow this on perl 5.005 or earlier
1511 if ($] < 5.006 && $level != STANDARD) {
1512 # Cant do MEDIUM or HIGH checks
1513 croak "Currently requires perl 5.006 or newer to do the safe checks";
1514 }
1515 # Check that we are allowed to change level
1516 # Silently ignore if we can not.
1517 $LEVEL = $level if _can_do_level($level);
1518 }
1519 }
152055814191ms return $LEVEL;
1521 }
1522}
1523
1524{
15252100ns my $TopSystemUID = 10;
15261500ns $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
1527 sub top_system_uid {
1528 my $self = shift;
1529 if (@_) {
1530 my $newuid = shift;
1531 croak "top_system_uid: UIDs should be numeric"
1532 unless $newuid =~ /^\d+$/s;
1533 $TopSystemUID = $newuid;
1534 }
1535 return $TopSystemUID;
1536 }
1537}
1538
153910spackage File::Temp::Dir;
1540
1541233µs2131µs
# spent 72µs (13+59) within File::Temp::Dir::BEGIN@1541 which was called: # once (13µs+59µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 1541
use File::Path qw/ rmtree /;
# spent 72µs making 1 call to File::Temp::Dir::BEGIN@1541 # spent 59µs making 1 call to Exporter::import
1542235µs216µs
# spent 12µs (8+4) within File::Temp::Dir::BEGIN@1542 which was called: # once (8µs+4µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 1542
use strict;
# spent 12µs making 1 call to File::Temp::Dir::BEGIN@1542 # spent 4µs making 1 call to strict::import
154317µs146µs
# spent 54µs (9+46) within File::Temp::Dir::BEGIN@1543 which was called: # once (9µs+46µs) by IO::CaptureOutput::_proxy::BEGIN@138 at line 1545
use overload '""' => "STRINGIFY",
# spent 46µs making 1 call to overload::import
1544 '0+' => \&File::Temp::NUMIFY,
15451283µs154µs fallback => 1;
# spent 54µs making 1 call to File::Temp::Dir::BEGIN@1543
1546
1547# private class specifically to support tempdir objects
1548# created by File::Temp->newdir
1549
1550# ostensibly the same method interface as File::Temp but without
1551# inheriting all the IO::Seekable methods and other cruft
1552
1553# Read-only - returns the name of the temp directory
1554
1555
# spent 193µs within File::Temp::Dir::dirname which was called 27 times, avg 7µs/call: # 25 times (165µs+0s) by RBM::DefaultConfig::rbm_tmp_dir at line 108 of /root/tor-browser-build/rbm/lib/RBM/DefaultConfig.pm, avg 7µs/call # once (26µs+0s) by RBM::build_run at line 1001 of /root/tor-browser-build/rbm/lib/RBM.pm # once (2µs+0s) by RBM::DefaultConfig::rbm_tmp_dir at line 113 of /root/tor-browser-build/rbm/lib/RBM/DefaultConfig.pm
sub dirname {
15562729µs my $self = shift;
155727359µs return $self->{DIRNAME};
1558}
1559
1560sub STRINGIFY {
1561 my $self = shift;
1562 return $self->dirname;
1563}
1564
1565
# spent 3µs within File::Temp::Dir::unlink_on_destroy which was called: # once (3µs+0s) by File::Temp::Dir::DESTROY at line 1576
sub unlink_on_destroy {
15661300ns my $self = shift;
15671700ns if (@_) {
1568 $self->{CLEANUP} = shift;
1569 }
1570116µs return $self->{CLEANUP};
1571}
1572
1573
# spent 92.0ms (116µs+91.9) within File::Temp::Dir::DESTROY which was called: # once (116µs+91.9ms) by RBM::build_run at line 1150 of /root/tor-browser-build/rbm/lib/RBM.pm
sub DESTROY {
157411µs my $self = shift;
1575126µs local($., $@, $!, $^E, $?);
1576127µs13µs if ($self->unlink_on_destroy &&
# spent 3µs making 1 call to File::Temp::Dir::unlink_on_destroy
1577 $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
1578151µs113µs if (-d $self->{REALNAME}) {
# spent 13µs making 1 call to File::Temp::Dir::CORE:ftdir
1579 # Some versions of rmtree will abort if you attempt to remove
1580 # the directory you are sitting in. We protect that and turn it
1581 # into a warning. We do this because this occurs during object
1582 # destruction and so can not be caught by the user.
158327µs191.9ms eval { rmtree($self->{REALNAME}, $File::Temp::DEBUG, 0); };
# spent 91.9ms making 1 call to File::Path::rmtree
15841300ns warn $@ if ($@ && $^W);
1585 }
1586 }
1587}
1588
1589129µs1;
1590
1591__END__
 
# spent 174ms within File::Temp::CORE:chmod which was called 27907 times, avg 6µs/call: # 27905 times (174ms+0s) by File::Temp::_gettemp at line 382, avg 6µs/call # 2 times (18µs+0s) by File::Temp::_gettemp at line 404, avg 9µs/call
sub File::Temp::CORE:chmod; # opcode
# spent 36.7ms within File::Temp::CORE:ftdir which was called 27907 times, avg 1µs/call: # 27907 times (36.7ms+0s) by File::Temp::_gettemp at line 326, avg 1µs/call
sub File::Temp::CORE:ftdir; # opcode
# spent 172ms within File::Temp::CORE:ftis which was called 27907 times, avg 6µs/call: # 27907 times (172ms+0s) by File::Temp::_gettemp at line 322, avg 6µ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::newdir at line 925, avg 3µs/call
sub File::Temp::CORE:match; # opcode
# spent 176µs within File::Temp::CORE:mkdir which was called 2 times, avg 88µs/call: # 2 times (176µs+0s) by File::Temp::_gettemp at line 402, avg 88µs/call
sub File::Temp::CORE:mkdir; # opcode
# spent 73.3ms within File::Temp::CORE:regcomp which was called 27907 times, avg 3µs/call: # 27907 times (73.3ms+0s) by File::Temp::_replace_XX at line 496, avg 3µs/call
sub File::Temp::CORE:regcomp; # opcode
# spent 1µs within File::Temp::CORE:sort which was called: # once (1µs+0s) by File::Temp::cleanup at line 741
sub File::Temp::CORE:sort; # opcode
# spent 134ms within File::Temp::CORE:subst which was called 27907 times, avg 5µs/call: # 27907 times (134ms+0s) by File::Temp::_replace_XX at line 496, avg 5µs/call
sub File::Temp::CORE:subst; # opcode
# spent 392ms within File::Temp::CORE:substcont which was called 306968 times, avg 1µs/call: # 306968 times (392ms+0s) by File::Temp::_replace_XX at line 496, avg 1µs/call
sub File::Temp::CORE:substcont; # opcode
# spent 1.15s within File::Temp::CORE:sysopen which was called 27905 times, avg 41µs/call: # 27905 times (1.15s+0s) by File::Temp::_gettemp at line 377, avg 41µs/call
sub File::Temp::CORE:sysopen; # opcode
# spent 13µs within File::Temp::Dir::CORE:ftdir which was called: # once (13µs+0s) by File::Temp::Dir::DESTROY at line 1578
sub File::Temp::Dir::CORE:ftdir; # opcode
# spent 600ns within File::Temp::__ANON__ which was called: # once (600ns+0s) by File::Temp::BEGIN@11 at line 11
sub File::Temp::__ANON__; # xsub
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.