← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/lib/x86_64-linux-gnu/perl/5.20/File/Spec/Unix.pm
StatementsExecuted 33 statements in 2.41ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
123334µs40µsFile::Spec::Unix::::catdirFile::Spec::Unix::catdir (xsub)
22225µs44µsFile::Spec::Unix::::catfileFile::Spec::Unix::catfile (xsub)
143313µs13µsFile::Spec::Unix::::canonpathFile::Spec::Unix::canonpath (xsub)
11113µs24µsFile::Spec::Unix::::BEGIN@3File::Spec::Unix::BEGIN@3
1118µs9µsFile::Spec::Unix::::file_name_is_absoluteFile::Spec::Unix::file_name_is_absolute
1118µs37µsFile::Spec::Unix::::BEGIN@130File::Spec::Unix::BEGIN@130
1117µs36µsFile::Spec::Unix::::BEGIN@69File::Spec::Unix::BEGIN@69
1116µs30µsFile::Spec::Unix::::BEGIN@138File::Spec::Unix::BEGIN@138
1116µs24µsFile::Spec::Unix::::BEGIN@4File::Spec::Unix::BEGIN@4
1116µs28µsFile::Spec::Unix::::BEGIN@75File::Spec::Unix::BEGIN@75
1116µs15µsFile::Spec::Unix::::BEGIN@95File::Spec::Unix::BEGIN@95
1116µs32µsFile::Spec::Unix::::BEGIN@72File::Spec::Unix::BEGIN@72
2225µs5µsFile::Spec::Unix::::curdirFile::Spec::Unix::curdir
1111µs1µsFile::Spec::Unix::::CORE:matchFile::Spec::Unix::CORE:match (opcode)
0000s0sFile::Spec::Unix::::_cache_tmpdirFile::Spec::Unix::_cache_tmpdir
0000s0sFile::Spec::Unix::::_cached_tmpdirFile::Spec::Unix::_cached_tmpdir
0000s0sFile::Spec::Unix::::_collapseFile::Spec::Unix::_collapse
0000s0sFile::Spec::Unix::::_cwdFile::Spec::Unix::_cwd
0000s0sFile::Spec::Unix::::_pp_canonpathFile::Spec::Unix::_pp_canonpath
0000s0sFile::Spec::Unix::::_pp_catdirFile::Spec::Unix::_pp_catdir
0000s0sFile::Spec::Unix::::_pp_catfileFile::Spec::Unix::_pp_catfile
0000s0sFile::Spec::Unix::::_sameFile::Spec::Unix::_same
0000s0sFile::Spec::Unix::::_tmpdirFile::Spec::Unix::_tmpdir
0000s0sFile::Spec::Unix::::abs2relFile::Spec::Unix::abs2rel
0000s0sFile::Spec::Unix::::case_tolerantFile::Spec::Unix::case_tolerant
0000s0sFile::Spec::Unix::::catpathFile::Spec::Unix::catpath
0000s0sFile::Spec::Unix::::devnullFile::Spec::Unix::devnull
0000s0sFile::Spec::Unix::::joinFile::Spec::Unix::join
0000s0sFile::Spec::Unix::::no_upwardsFile::Spec::Unix::no_upwards
0000s0sFile::Spec::Unix::::pathFile::Spec::Unix::path
0000s0sFile::Spec::Unix::::rel2absFile::Spec::Unix::rel2abs
0000s0sFile::Spec::Unix::::rootdirFile::Spec::Unix::rootdir
0000s0sFile::Spec::Unix::::splitdirFile::Spec::Unix::splitdir
0000s0sFile::Spec::Unix::::splitpathFile::Spec::Unix::splitpath
0000s0sFile::Spec::Unix::::tmpdirFile::Spec::Unix::tmpdir
0000s0sFile::Spec::Unix::::updirFile::Spec::Unix::updir
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package File::Spec::Unix;
2
3226µs235µs
# spent 24µs (13+11) within File::Spec::Unix::BEGIN@3 which was called: # once (13µs+11µs) by DateTime::TimeZone::Local::BEGIN@8 at line 3
use strict;
# spent 24µs making 1 call to File::Spec::Unix::BEGIN@3 # spent 11µs making 1 call to strict::import
42975µs241µs
# spent 24µs (6+18) within File::Spec::Unix::BEGIN@4 which was called: # once (6µs+18µs) by DateTime::TimeZone::Local::BEGIN@8 at line 4
use vars qw($VERSION);
# spent 24µs making 1 call to File::Spec::Unix::BEGIN@4 # spent 18µs making 1 call to vars::import
5
61300ns$VERSION = '3.48';
71300nsmy $xs_version = $VERSION;
81600ns$VERSION =~ tr/_//;
9
1013µsunless (defined &canonpath) {
111400ns eval {
1211µs if ( $] >= 5.006 ) {
131500ns require XSLoader;
14145µs137µs XSLoader::load("Cwd", $xs_version);
# spent 37µs making 1 call to XSLoader::load
15 } else {
16 require Cwd;
17 }
18 };
19}
20
21sub _pp_canonpath {
22 my ($self,$path) = @_;
23 return unless defined $path;
24
25 # Handle POSIX-style node names beginning with double slash (qnx, nto)
26 # (POSIX says: "a pathname that begins with two successive slashes
27 # may be interpreted in an implementation-defined manner, although
28 # more than two leading slashes shall be treated as a single slash.")
29 my $node = '';
30 my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
31
32 if ( $double_slashes_special
33 && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
34 $node = $1;
35 }
36 # This used to be
37 # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
38 # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
39 # (Mainly because trailing "" directories didn't get stripped).
40 # Why would cygwin avoid collapsing multiple slashes into one? --jhi
41 $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
42 $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
43 $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
44 $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
45 $path =~ s|^/\.\.$|/|; # /.. -> /
46 $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
47 return "$node$path";
48}
491500ns*canonpath = \&_pp_canonpath unless defined &canonpath;
50
51sub _pp_catdir {
52 my $self = shift;
53
54 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
55}
561100ns*catdir = \&_pp_catdir unless defined &catdir;
57
58sub _pp_catfile {
59 my $self = shift;
60 my $file = $self->canonpath(pop @_);
61 return $file unless @_;
62 my $dir = $self->catdir(@_);
63 $dir .= "/" unless substr($dir,-1) eq "/";
64 return $dir.$file;
65}
661100ns*catfile = \&_pp_catfile unless defined &catfile;
67
6827µs
# spent 5µs within File::Spec::Unix::curdir which was called 2 times, avg 2µs/call: # once (3µs+0s) by XML::Parser::BEGIN@17 at line 19 of XML/Parser/Expat.pm # once (1µs+0s) by Module::Metadata::BEGIN@29 at line 1105 of File/Find.pm
sub curdir { '.' }
69237µs266µs
# spent 36µs (7+29) within File::Spec::Unix::BEGIN@69 which was called: # once (7µs+29µs) by DateTime::TimeZone::Local::BEGIN@8 at line 69
use constant _fn_curdir => ".";
# spent 36µs making 1 call to File::Spec::Unix::BEGIN@69 # spent 29µs making 1 call to constant::import
70
71sub devnull { '/dev/null' }
72237µs258µs
# spent 32µs (6+26) within File::Spec::Unix::BEGIN@72 which was called: # once (6µs+26µs) by DateTime::TimeZone::Local::BEGIN@8 at line 72
use constant _fn_devnull => "/dev/null";
# spent 32µs making 1 call to File::Spec::Unix::BEGIN@72 # spent 26µs making 1 call to constant::import
73
74sub rootdir { '/' }
752123µs250µs
# spent 28µs (6+22) within File::Spec::Unix::BEGIN@75 which was called: # once (6µs+22µs) by DateTime::TimeZone::Local::BEGIN@8 at line 75
use constant _fn_rootdir => "/";
# spent 28µs making 1 call to File::Spec::Unix::BEGIN@75 # spent 22µs making 1 call to constant::import
76
771100nsmy ($tmpdir, %tmpenv);
78# Cache and return the calculated tmpdir, recording which env vars
79# determined it.
80sub _cache_tmpdir {
81 @tmpenv{@_[2..$#_]} = @ENV{@_[2..$#_]};
82 return $tmpdir = $_[1];
83}
84# Retrieve the cached tmpdir, checking first whether relevant env vars have
85# changed and invalidated the cache.
86sub _cached_tmpdir {
87 shift;
88 local $^W;
89 return if grep $ENV{$_} ne $tmpenv{$_}, @_;
90 return $tmpdir;
91}
92sub _tmpdir {
93 my $self = shift;
94 my @dirlist = @_;
952237µs224µs
# spent 15µs (6+9) within File::Spec::Unix::BEGIN@95 which was called: # once (6µs+9µs) by DateTime::TimeZone::Local::BEGIN@8 at line 95
my $taint = do { no strict 'refs'; ${"\cTAINT"} };
# spent 15µs making 1 call to File::Spec::Unix::BEGIN@95 # spent 9µs making 1 call to strict::unimport
96 if ($taint) { # Check for taint mode on perl >= 5.8.0
97 require Scalar::Util;
98 @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
99 }
100 elsif ($] < 5.007) { # No ${^TAINT} before 5.8
101 @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist;
102 }
103
104 foreach (@dirlist) {
105 next unless defined && -d && -w _;
106 $tmpdir = $_;
107 last;
108 }
109 $tmpdir = $self->curdir unless defined $tmpdir;
110 $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
111 if ( !$self->file_name_is_absolute($tmpdir) ) {
112 # See [perl #120593] for the full details
113 # If possible, return a full path, rather than '.' or 'lib', but
114 # jump through some hoops to avoid returning a tainted value.
115 ($tmpdir) = grep {
116 $taint ? ! Scalar::Util::tainted($_) :
117 $] < 5.007 ? eval { eval('1'.substr $_,0,0) } : 1
118 } $self->rel2abs($tmpdir), $tmpdir;
119 }
120 return $tmpdir;
121}
122
123sub tmpdir {
124 my $cached = $_[0]->_cached_tmpdir('TMPDIR');
125 return $cached if defined $cached;
126 $_[0]->_cache_tmpdir($_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ), 'TMPDIR');
127}
128
129sub updir { '..' }
130273µs267µs
# spent 37µs (8+30) within File::Spec::Unix::BEGIN@130 which was called: # once (8µs+30µs) by DateTime::TimeZone::Local::BEGIN@8 at line 130
use constant _fn_updir => "..";
# spent 37µs making 1 call to File::Spec::Unix::BEGIN@130 # spent 30µs making 1 call to constant::import
131
132sub no_upwards {
133 my $self = shift;
134 return grep(!/^\.{1,2}\z/s, @_);
135}
136
137sub case_tolerant { 0 }
1382829µs254µs
# spent 30µs (6+24) within File::Spec::Unix::BEGIN@138 which was called: # once (6µs+24µs) by DateTime::TimeZone::Local::BEGIN@8 at line 138
use constant _fn_case_tolerant => 0;
# spent 30µs making 1 call to File::Spec::Unix::BEGIN@138 # spent 24µs making 1 call to constant::import
139
140
# spent 9µs (8+1000ns) within File::Spec::Unix::file_name_is_absolute which was called: # once (8µs+1000ns) by FindBin::init at line 137 of FindBin.pm
sub file_name_is_absolute {
1411900ns my ($self,$file) = @_;
14218µs11µs return scalar($file =~ m:^/:s);
# spent 1µs making 1 call to File::Spec::Unix::CORE:match
143}
144
145sub path {
146 return () unless exists $ENV{PATH};
147 my @path = split(':', $ENV{PATH});
148 foreach (@path) { $_ = '.' if $_ eq '' }
149 return @path;
150}
151
152sub join {
153 my $self = shift;
154 return $self->catfile(@_);
155}
156
157sub splitpath {
158 my ($self,$path, $nofile) = @_;
159
160 my ($volume,$directory,$file) = ('','','');
161
162 if ( $nofile ) {
163 $directory = $path;
164 }
165 else {
166 $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
167 $directory = $1;
168 $file = $2;
169 }
170
171 return ($volume,$directory,$file);
172}
173
174sub splitdir {
175 return split m|/|, $_[1], -1; # Preserve trailing fields
176}
177
178sub catpath {
179 my ($self,$volume,$directory,$file) = @_;
180
181 if ( $directory ne '' &&
182 $file ne '' &&
183 substr( $directory, -1 ) ne '/' &&
184 substr( $file, 0, 1 ) ne '/'
185 ) {
186 $directory .= "/$file" ;
187 }
188 else {
189 $directory .= $file ;
190 }
191
192 return $directory ;
193}
194
195sub abs2rel {
196 my($self,$path,$base) = @_;
197 $base = $self->_cwd() unless defined $base and length $base;
198
199 ($path, $base) = map $self->canonpath($_), $path, $base;
200
201 my $path_directories;
202 my $base_directories;
203
204 if (grep $self->file_name_is_absolute($_), $path, $base) {
205 ($path, $base) = map $self->rel2abs($_), $path, $base;
206
207 my ($path_volume) = $self->splitpath($path, 1);
208 my ($base_volume) = $self->splitpath($base, 1);
209
210 # Can't relativize across volumes
211 return $path unless $path_volume eq $base_volume;
212
213 $path_directories = ($self->splitpath($path, 1))[1];
214 $base_directories = ($self->splitpath($base, 1))[1];
215
216 # For UNC paths, the user might give a volume like //foo/bar that
217 # strictly speaking has no directory portion. Treat it as if it
218 # had the root directory for that volume.
219 if (!length($base_directories) and $self->file_name_is_absolute($base)) {
220 $base_directories = $self->rootdir;
221 }
222 }
223 else {
224 my $wd= ($self->splitpath($self->_cwd(), 1))[1];
225 $path_directories = $self->catdir($wd, $path);
226 $base_directories = $self->catdir($wd, $base);
227 }
228
229 # Now, remove all leading components that are the same
230 my @pathchunks = $self->splitdir( $path_directories );
231 my @basechunks = $self->splitdir( $base_directories );
232
233 if ($base_directories eq $self->rootdir) {
234 return $self->curdir if $path_directories eq $self->rootdir;
235 shift @pathchunks;
236 return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
237 }
238
239 my @common;
240 while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
241 push @common, shift @pathchunks ;
242 shift @basechunks ;
243 }
244 return $self->curdir unless @pathchunks || @basechunks;
245
246 # @basechunks now contains the directories the resulting relative path
247 # must ascend out of before it can descend to $path_directory. If there
248 # are updir components, we must descend into the corresponding directories
249 # (this only works if they are no symlinks).
250 my @reverse_base;
251 while( defined(my $dir= shift @basechunks) ) {
252 if( $dir ne $self->updir ) {
253 unshift @reverse_base, $self->updir;
254 push @common, $dir;
255 }
256 elsif( @common ) {
257 if( @reverse_base && $reverse_base[0] eq $self->updir ) {
258 shift @reverse_base;
259 pop @common;
260 }
261 else {
262 unshift @reverse_base, pop @common;
263 }
264 }
265 }
266 my $result_dirs = $self->catdir( @reverse_base, @pathchunks );
267 return $self->canonpath( $self->catpath('', $result_dirs, '') );
268}
269
270sub _same {
271 $_[1] eq $_[2];
272}
273
274sub rel2abs {
275 my ($self,$path,$base ) = @_;
276
277 # Clean up $path
278 if ( ! $self->file_name_is_absolute( $path ) ) {
279 # Figure out the effective $base and clean it up.
280 if ( !defined( $base ) || $base eq '' ) {
281 $base = $self->_cwd();
282 }
283 elsif ( ! $self->file_name_is_absolute( $base ) ) {
284 $base = $self->rel2abs( $base ) ;
285 }
286 else {
287 $base = $self->canonpath( $base ) ;
288 }
289
290 # Glom them together
291 $path = $self->catdir( $base, $path ) ;
292 }
293
294 return $self->canonpath( $path ) ;
295}
296
297# Internal routine to File::Spec, no point in making this public since
298# it is the standard Cwd interface. Most of the platform-specific
299# File::Spec subclasses use this.
300sub _cwd {
301 require Cwd;
302 Cwd::getcwd();
303}
304
305# Internal method to reduce xx\..\yy -> yy
306sub _collapse {
307 my($fs, $path) = @_;
308
309 my $updir = $fs->updir;
310 my $curdir = $fs->curdir;
311
312 my($vol, $dirs, $file) = $fs->splitpath($path);
313 my @dirs = $fs->splitdir($dirs);
314 pop @dirs if @dirs && $dirs[-1] eq '';
315
316 my @collapsed;
317 foreach my $dir (@dirs) {
318 if( $dir eq $updir and # if we have an updir
319 @collapsed and # and something to collapse
320 length $collapsed[-1] and # and its not the rootdir
321 $collapsed[-1] ne $updir and # nor another updir
322 $collapsed[-1] ne $curdir # nor the curdir
323 )
324 { # then
325 pop @collapsed; # collapse
326 }
327 else { # else
328 push @collapsed, $dir; # just hang onto it
329 }
330 }
331
332 return $fs->catpath($vol,
333 $fs->catdir(@collapsed),
334 $file
335 );
336}
337
33817µs1;
 
# spent 1µs within File::Spec::Unix::CORE:match which was called: # once (1µs+0s) by File::Spec::Unix::file_name_is_absolute at line 142
sub File::Spec::Unix::CORE:match; # opcode
# spent 13µs within File::Spec::Unix::canonpath which was called 14 times, avg 914ns/call: # 10 times (4µs+0s) by File::Spec::Unix::catdir at line 19 of XML/Parser/Expat.pm, avg 430ns/call # 2 times (7µs+0s) by File::Spec::Unix::catdir or File::Spec::Unix::catfile at line 61 of XML/SAX.pm, avg 3µs/call # 2 times (2µs+0s) by File::Spec::Unix::catdir or File::Spec::Unix::catfile at line 137 of FindBin.pm, avg 900ns/call
sub File::Spec::Unix::canonpath; # xsub
# spent 40µs (34+5) within File::Spec::Unix::catdir which was called 12 times, avg 3µs/call: # 10 times (25µs+4µs) by XML::Parser::BEGIN@17 at line 19 of XML/Parser/Expat.pm, avg 3µs/call # once (6µs+600ns) by File::Spec::Unix::catfile at line 61 of XML/SAX.pm # once (4µs+400ns) by File::Spec::Unix::catfile at line 137 of FindBin.pm
sub File::Spec::Unix::catdir; # xsub
# spent 44µs (25+18) within File::Spec::Unix::catfile which was called 2 times, avg 22µs/call: # once (18µs+13µs) by XML::SAX::load_parsers at line 61 of XML/SAX.pm # once (8µs+6µs) by FindBin::init at line 137 of FindBin.pm
sub File::Spec::Unix::catfile; # xsub
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.