← 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/share/perl/5.20/File/Basename.pm
StatementsExecuted 124 statements in 1.18ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
54379µs96µsFile::Basename::::fileparseFile::Basename::fileparse
11132µs60µsFile::Basename::::fileparse_set_fstypeFile::Basename::fileparse_set_fstype
101124µs24µsFile::Basename::::CORE:regcompFile::Basename::CORE:regcomp (opcode)
152121µs21µsFile::Basename::::CORE:matchFile::Basename::CORE:match (opcode)
11110µs37µsFile::Basename::::dirnameFile::Basename::dirname
1119µs9µsFile::Basename::::BEGIN@5File::Basename::BEGIN@5
1119µs9µsFile::Basename::::BEGIN@13File::Basename::BEGIN@13
1117µs11µsFile::Basename::::_strip_trailing_sepFile::Basename::_strip_trailing_sep
1117µs12µsFile::Basename::::BEGIN@14File::Basename::BEGIN@14
1116µs16µsFile::Basename::::BEGIN@12File::Basename::BEGIN@12
1116µs6µsFile::Basename::::BEGIN@184File::Basename::BEGIN@184
1115µs5µsFile::Basename::::CORE:substFile::Basename::CORE:subst (opcode)
0000s0sFile::Basename::::basenameFile::Basename::basename
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package File::Basename;
2
3# File::Basename is used during the Perl build, when the re extension may
4# not be available, but we only actually need it if running under tainting.
5
# spent 9µs within File::Basename::BEGIN@5 which was called: # once (9µs+0s) by Module::Metadata::BEGIN@29 at line 10
BEGIN {
616µs if (${^TAINT}) {
7 require re;
8 re->import('taint');
9 }
10119µs19µs}
# spent 9µs making 1 call to File::Basename::BEGIN@5
11
12219µs226µs
# spent 16µs (6+10) within File::Basename::BEGIN@12 which was called: # once (6µs+10µs) by Module::Metadata::BEGIN@29 at line 12
use strict;
# spent 16µs making 1 call to File::Basename::BEGIN@12 # spent 10µs making 1 call to strict::import
13233µs19µs
# spent 9µs within File::Basename::BEGIN@13 which was called: # once (9µs+0s) by Module::Metadata::BEGIN@29 at line 13
use 5.006;
# spent 9µs making 1 call to File::Basename::BEGIN@13
142876µs217µs
# spent 12µs (7+5) within File::Basename::BEGIN@14 which was called: # once (7µs+5µs) by Module::Metadata::BEGIN@29 at line 14
use warnings;
# spent 12µs making 1 call to File::Basename::BEGIN@14 # spent 5µs making 1 call to warnings::import
151400nsour(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
161700nsrequire Exporter;
1714µs@ISA = qw(Exporter);
181600ns@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
191200ns$VERSION = "2.85";
20
2111µs160µsfileparse_set_fstype($^O);
# spent 60µs making 1 call to File::Basename::fileparse_set_fstype
22
23
# spent 96µs (79+17) within File::Basename::fileparse which was called 5 times, avg 19µs/call: # 2 times (23µs+6µs) by XML::Simple::find_xml_file at line 941 of XML/Simple.pm, avg 15µs/call # once (32µs+5µs) by FindBin::init at line 140 of FindBin.pm # once (12µs+3µs) by File::Basename::dirname at line 134 # once (11µs+3µs) by FindBin::init at line 147 of FindBin.pm
sub fileparse {
2453µs my($fullname,@suffices) = @_;
25
2652µs unless (defined $fullname) {
27 require Carp;
28 Carp::croak("fileparse(): need a valid pathname");
29 }
30
3152µs my $orig_type = '';
3253µs my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
33
3456µs my($taint) = substr($fullname,0,0); # Is $fullname tainted?
35
3651µs if ($type eq "VMS" and $fullname =~ m{/} ) {
37 # We're doing Unix emulation
38 $orig_type = $type;
39 $type = 'Unix';
40 }
41
425600ns my($dirpath, $basename);
43
44524µs if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
45 ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
46 $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
47 }
48 elsif ($type eq "OS2") {
49 ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
50 $dirpath = './' unless $dirpath; # Can't be 0
51 $dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
52 }
53 elsif ($type eq "MacOS") {
54 ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
55 $dirpath = ':' unless $dirpath;
56 }
57 elsif ($type eq "AmigaOS") {
58 ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
59 $dirpath = './' unless $dirpath;
60 }
61 elsif ($type eq 'VMS' ) {
62 ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
63 $dirpath ||= ''; # should always be defined
64 }
65 else { # Default to Unix semantics.
66534µs517µs ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s);
# spent 17µs making 5 calls to File::Basename::CORE:match, avg 3µs/call
6751µs if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.*)}) {
68 # dev:[000000] is top of VMS tree, similar to Unix '/'
69 # so strip it off and treat the rest as "normal"
70 my $devspec = $1;
71 my $remainder = $3;
72 ($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s);
73 $dirpath ||= ''; # should always be defined
74 $dirpath = $devspec.$dirpath;
75 }
7651µs $dirpath = './' unless $dirpath;
77 }
78
79
8052µs my $tail = '';
8151µs my $suffix = '';
8251µs if (@suffices) {
83 foreach $suffix (@suffices) {
84 my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
85 if ($basename =~ s/$pat//s) {
86 $taint .= substr($suffix,0,0);
87 $tail = $1 . $tail;
88 }
89 }
90 }
91
92 # Ensure taint is propagated from the path to its pieces.
9352µs $tail .= $taint;
94523µs wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
95 : ($basename .= $taint);
96}
97
98sub basename {
99 my($path) = shift;
100
101 # From BSD basename(1)
102 # The basename utility deletes any prefix ending with the last slash '/'
103 # character present in string (after first stripping trailing slashes)
104 _strip_trailing_sep($path);
105
106 my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
107
108 # From BSD basename(1)
109 # The suffix is not stripped if it is identical to the remaining
110 # characters in string.
111 if( length $suffix and !length $basename ) {
112 $basename = $suffix;
113 }
114
115 # Ensure that basename '/' == '/'
116 if( !length $basename ) {
117 $basename = $dirname;
118 }
119
120 return $basename;
121}
122
123
# spent 37µs (10+26) within File::Basename::dirname which was called: # once (10µs+26µs) by XML::SAX::load_parsers at line 57 of XML/SAX.pm
sub dirname {
1241300ns my $path = shift;
125
1261400ns my($type) = $Fileparse_fstype;
127
1281300ns if( $type eq 'VMS' and $path =~ m{/} ) {
129 # Parse as Unix
130 local($File::Basename::Fileparse_fstype) = '';
131 return dirname($path);
132 }
133
13411µs115µs my($basename, $dirname) = fileparse($path);
# spent 15µs making 1 call to File::Basename::fileparse
135
13612µs if ($type eq 'VMS') {
137 $dirname ||= $ENV{DEFAULT};
138 }
139 elsif ($type eq 'MacOS') {
140 if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
141 _strip_trailing_sep($dirname);
142 ($basename,$dirname) = fileparse $dirname;
143 }
144 $dirname .= ":" unless $dirname =~ /:\z/;
145 }
146 elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
147 _strip_trailing_sep($dirname);
148 unless( length($basename) ) {
149 ($basename,$dirname) = fileparse $dirname;
150 _strip_trailing_sep($dirname);
151 }
152 }
153 elsif ($type eq 'AmigaOS') {
154 if ( $dirname =~ /:\z/) { return $dirname }
155 chop $dirname;
156 $dirname =~ s{[^:/]+\z}{} unless length($basename);
157 }
158 else {
15911µs111µs _strip_trailing_sep($dirname);
# spent 11µs making 1 call to File::Basename::_strip_trailing_sep
1601400ns unless( length($basename) ) {
161 ($basename,$dirname) = fileparse $dirname;
162 _strip_trailing_sep($dirname);
163 }
164 }
165
16612µs $dirname;
167}
168
169# Strip the trailing path separator.
170
# spent 11µs (7+5) within File::Basename::_strip_trailing_sep which was called: # once (7µs+5µs) by File::Basename::dirname at line 159
sub _strip_trailing_sep {
1711200ns my $type = $Fileparse_fstype;
172
17314µs if ($type eq 'MacOS') {
174 $_[0] =~ s/([^:]):\z/$1/s;
175 }
176 elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
177 $_[0] =~ s/([^:])[\\\/]*\z/$1/;
178 }
179 else {
18019µs15µs $_[0] =~ s{(.)/*\z}{$1}s;
# spent 5µs making 1 call to File::Basename::CORE:subst
181 }
182}
183
184
# spent 6µs within File::Basename::BEGIN@184 which was called: # once (6µs+0s) by Module::Metadata::BEGIN@29 at line 207
BEGIN {
185
18611µsmy @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
18715µsmy @Types = (@Ignore_Case, qw(Unix));
188
189
# spent 60µs (32+28) within File::Basename::fileparse_set_fstype which was called: # once (32µs+28µs) by Module::Metadata::BEGIN@29 at line 21
sub fileparse_set_fstype {
1901200ns my $old = $Fileparse_fstype;
191
1921300ns if (@_) {
1931900ns my $new_type = shift;
194
1951100ns $Fileparse_fstype = 'Unix'; # default
1961600ns foreach my $type (@Types) {
1971055µs2028µs $Fileparse_fstype = $type if $new_type =~ /^$type/i;
# spent 24µs making 10 calls to File::Basename::CORE:regcomp, avg 2µs/call # spent 4µs making 10 calls to File::Basename::CORE:match, avg 360ns/call
198 }
199
200 $Fileparse_igncase =
20112µs (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
202 }
203
20413µs return $old;
205}
206
207122µs16µs}
# spent 6µs making 1 call to File::Basename::BEGIN@184
208
20914µs1;
210
 
# spent 21µs within File::Basename::CORE:match which was called 15 times, avg 1µs/call: # 10 times (4µs+0s) by File::Basename::fileparse_set_fstype at line 197, avg 360ns/call # 5 times (17µs+0s) by File::Basename::fileparse at line 66, avg 3µs/call
sub File::Basename::CORE:match; # opcode
# spent 24µs within File::Basename::CORE:regcomp which was called 10 times, avg 2µs/call: # 10 times (24µs+0s) by File::Basename::fileparse_set_fstype at line 197, avg 2µs/call
sub File::Basename::CORE:regcomp; # opcode
# spent 5µs within File::Basename::CORE:subst which was called: # once (5µs+0s) by File::Basename::_strip_trailing_sep at line 180
sub File::Basename::CORE:subst; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.