← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:02 2013

Filename/usr/share/perl/5.10/File/Spec/Unix.pm
StatementsExecuted 321 statements in 2.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1821438µs569µsFile::Spec::Unix::::canonpathFile::Spec::Unix::canonpath
922201µs847µsFile::Spec::Unix::::catfileFile::Spec::Unix::catfile
1022175µs202µsFile::Spec::Unix::::file_name_is_absoluteFile::Spec::Unix::file_name_is_absolute
10861131µs131µsFile::Spec::Unix::::CORE:substFile::Spec::Unix::CORE:subst (opcode)
91177µs334µsFile::Spec::Unix::::catdirFile::Spec::Unix::catdir
101127µs27µsFile::Spec::Unix::::CORE:matchFile::Spec::Unix::CORE:match (opcode)
11123µs31µsFile::Spec::Unix::::BEGIN@3File::Spec::Unix::BEGIN@3
11116µs36µsFile::Spec::Unix::::BEGIN@65File::Spec::Unix::BEGIN@65
1118µs34µsFile::Spec::Unix::::BEGIN@4File::Spec::Unix::BEGIN@4
0000s0sFile::Spec::Unix::::_collapseFile::Spec::Unix::_collapse
0000s0sFile::Spec::Unix::::_cwdFile::Spec::Unix::_cwd
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::::curdirFile::Spec::Unix::curdir
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
3334µs239µs
# spent 31µs (23+8) within File::Spec::Unix::BEGIN@3 which was called: # once (23µs+8µs) by IO::File::BEGIN@12 at line 3
use strict;
# spent 31µs making 1 call to File::Spec::Unix::BEGIN@3 # spent 8µs making 1 call to strict::import
43414µs259µs
# spent 34µs (8+25) within File::Spec::Unix::BEGIN@4 which was called: # once (8µs+25µs) by IO::File::BEGIN@12 at line 4
use vars qw($VERSION);
# spent 34µs making 1 call to File::Spec::Unix::BEGIN@4 # spent 25µs making 1 call to vars::import
5
61900ns$VERSION = '3.30';
7127µs$VERSION = eval $VERSION;
# spent 4µs executing statements in string eval
8
9
# spent 569µs (438+131) within File::Spec::Unix::canonpath which was called 18 times, avg 32µs/call: # 9 times (270µs+42µs) by File::Spec::Unix::catfile at line 46, avg 35µs/call # 9 times (169µs+89µs) by File::Spec::Unix::catdir at line 41, avg 29µs/call
sub canonpath {
10216600µs my ($self,$path) = @_;
11 return unless defined $path;
12
13 # Handle POSIX-style node names beginning with double slash (qnx, nto)
14 # (POSIX says: "a pathname that begins with two successive slashes
15 # may be interpreted in an implementation-defined manner, although
16 # more than two leading slashes shall be treated as a single slash.")
17 my $node = '';
18 my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
19
20 if ( $double_slashes_special
21 && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
22 $node = $1;
23 }
24 # This used to be
25 # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
26 # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
27 # (Mainly because trailing "" directories didn't get stripped).
28 # Why would cygwin avoid collapsing multiple slashes into one? --jhi
291827µs $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
# spent 27µs making 18 calls to File::Spec::Unix::CORE:subst, avg 2µs/call
301813µs $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
# spent 13µs making 18 calls to File::Spec::Unix::CORE:subst, avg 711ns/call
311810µs $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
# spent 10µs making 18 calls to File::Spec::Unix::CORE:subst, avg 561ns/call
321814µs $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
# spent 14µs making 18 calls to File::Spec::Unix::CORE:subst, avg 783ns/call
331811µs $path =~ s|^/\.\.$|/|; # /.. -> /
# spent 11µs making 18 calls to File::Spec::Unix::CORE:subst, avg 628ns/call
341855µs $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
# spent 55µs making 18 calls to File::Spec::Unix::CORE:subst, avg 3µs/call
35 return "$node$path";
36}
37
38
# spent 334µs (77+258) within File::Spec::Unix::catdir which was called 9 times, avg 37µs/call: # 9 times (77µs+258µs) by File::Spec::Unix::catfile at line 48, avg 37µs/call
sub catdir {
391868µs my $self = shift;
40
419258µs $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
# spent 258µs making 9 calls to File::Spec::Unix::canonpath, avg 29µs/call
42}
43
44
# spent 847µs (201+646) within File::Spec::Unix::catfile which was called 9 times, avg 94µs/call: # 8 times (171µs+580µs) by Template::Provider::_fetch_path at line 525 of Template/Provider.pm, avg 94µs/call # once (31µs+65µs) by XML::SAX::load_parsers at line 61 of XML/SAX.pm
sub catfile {
4554180µs my $self = shift;
469311µs my $file = $self->canonpath(pop @_);
# spent 311µs making 9 calls to File::Spec::Unix::canonpath, avg 35µs/call
47 return $file unless @_;
489334µs my $dir = $self->catdir(@_);
# spent 334µs making 9 calls to File::Spec::Unix::catdir, avg 37µs/call
49 $dir .= "/" unless substr($dir,-1) eq "/";
50 return $dir.$file;
51}
52
53sub curdir { '.' }
54
55sub devnull { '/dev/null' }
56
57sub rootdir { '/' }
58
591500nsmy $tmpdir;
60sub _tmpdir {
61 return $tmpdir if defined $tmpdir;
62 my $self = shift;
63 my @dirlist = @_;
64 {
6531.11ms256µs
# spent 36µs (16+20) within File::Spec::Unix::BEGIN@65 which was called: # once (16µs+20µs) by IO::File::BEGIN@12 at line 65
no strict 'refs';
# spent 36µs making 1 call to File::Spec::Unix::BEGIN@65 # spent 20µs making 1 call to strict::unimport
66 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
67 require Scalar::Util;
68 @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
69 }
70 }
71 foreach (@dirlist) {
72 next unless defined && -d && -w _;
73 $tmpdir = $_;
74 last;
75 }
76 $tmpdir = $self->curdir unless defined $tmpdir;
77 $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
78 return $tmpdir;
79}
80
81sub tmpdir {
82 return $tmpdir if defined $tmpdir;
83 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
84}
85
86sub updir { '..' }
87
88sub no_upwards {
89 my $self = shift;
90 return grep(!/^\.{1,2}\z/s, @_);
91}
92
93sub case_tolerant { 0 }
94
95
# spent 202µs (175+27) within File::Spec::Unix::file_name_is_absolute which was called 10 times, avg 20µs/call: # 9 times (156µs+21µs) by Template::Provider::fetch at line 127 of Template/Provider.pm, avg 20µs/call # once (19µs+6µs) by FindBin::init at line 176 of FindBin.pm
sub file_name_is_absolute {
9620162µs my ($self,$file) = @_;
971027µs return scalar($file =~ m:^/:s);
# spent 27µs making 10 calls to File::Spec::Unix::CORE:match, avg 3µs/call
98}
99
100sub path {
101 return () unless exists $ENV{PATH};
102 my @path = split(':', $ENV{PATH});
103 foreach (@path) { $_ = '.' if $_ eq '' }
104 return @path;
105}
106
107sub join {
108 my $self = shift;
109 return $self->catfile(@_);
110}
111
112sub splitpath {
113 my ($self,$path, $nofile) = @_;
114
115 my ($volume,$directory,$file) = ('','','');
116
117 if ( $nofile ) {
118 $directory = $path;
119 }
120 else {
121 $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
122 $directory = $1;
123 $file = $2;
124 }
125
126 return ($volume,$directory,$file);
127}
128
129sub splitdir {
130 return split m|/|, $_[1], -1; # Preserve trailing fields
131}
132
133sub catpath {
134 my ($self,$volume,$directory,$file) = @_;
135
136 if ( $directory ne '' &&
137 $file ne '' &&
138 substr( $directory, -1 ) ne '/' &&
139 substr( $file, 0, 1 ) ne '/'
140 ) {
141 $directory .= "/$file" ;
142 }
143 else {
144 $directory .= $file ;
145 }
146
147 return $directory ;
148}
149
150sub abs2rel {
151 my($self,$path,$base) = @_;
152 $base = $self->_cwd() unless defined $base and length $base;
153
154 ($path, $base) = map $self->canonpath($_), $path, $base;
155
156 if (grep $self->file_name_is_absolute($_), $path, $base) {
157 ($path, $base) = map $self->rel2abs($_), $path, $base;
158 }
159 else {
160 # save a couple of cwd()s if both paths are relative
161 ($path, $base) = map $self->catdir('/', $_), $path, $base;
162 }
163
164 my ($path_volume) = $self->splitpath($path, 1);
165 my ($base_volume) = $self->splitpath($base, 1);
166
167 # Can't relativize across volumes
168 return $path unless $path_volume eq $base_volume;
169
170 my $path_directories = ($self->splitpath($path, 1))[1];
171 my $base_directories = ($self->splitpath($base, 1))[1];
172
173 # For UNC paths, the user might give a volume like //foo/bar that
174 # strictly speaking has no directory portion. Treat it as if it
175 # had the root directory for that volume.
176 if (!length($base_directories) and $self->file_name_is_absolute($base)) {
177 $base_directories = $self->rootdir;
178 }
179
180 # Now, remove all leading components that are the same
181 my @pathchunks = $self->splitdir( $path_directories );
182 my @basechunks = $self->splitdir( $base_directories );
183
184 if ($base_directories eq $self->rootdir) {
185 shift @pathchunks;
186 return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
187 }
188
189 while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
190 shift @pathchunks ;
191 shift @basechunks ;
192 }
193 return $self->curdir unless @pathchunks || @basechunks;
194
195 # $base now contains the directories the resulting relative path
196 # must ascend out of before it can descend to $path_directory.
197 my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
198 return $self->canonpath( $self->catpath('', $result_dirs, '') );
199}
200
201sub _same {
202 $_[1] eq $_[2];
203}
204
205sub rel2abs {
206 my ($self,$path,$base ) = @_;
207
208 # Clean up $path
209 if ( ! $self->file_name_is_absolute( $path ) ) {
210 # Figure out the effective $base and clean it up.
211 if ( !defined( $base ) || $base eq '' ) {
212 $base = $self->_cwd();
213 }
214 elsif ( ! $self->file_name_is_absolute( $base ) ) {
215 $base = $self->rel2abs( $base ) ;
216 }
217 else {
218 $base = $self->canonpath( $base ) ;
219 }
220
221 # Glom them together
222 $path = $self->catdir( $base, $path ) ;
223 }
224
225 return $self->canonpath( $path ) ;
226}
227
228# Internal routine to File::Spec, no point in making this public since
229# it is the standard Cwd interface. Most of the platform-specific
230# File::Spec subclasses use this.
231sub _cwd {
232 require Cwd;
233 Cwd::getcwd();
234}
235
236# Internal method to reduce xx\..\yy -> yy
237sub _collapse {
238 my($fs, $path) = @_;
239
240 my $updir = $fs->updir;
241 my $curdir = $fs->curdir;
242
243 my($vol, $dirs, $file) = $fs->splitpath($path);
244 my @dirs = $fs->splitdir($dirs);
245 pop @dirs if @dirs && $dirs[-1] eq '';
246
247 my @collapsed;
248 foreach my $dir (@dirs) {
249 if( $dir eq $updir and # if we have an updir
250 @collapsed and # and something to collapse
251 length $collapsed[-1] and # and its not the rootdir
252 $collapsed[-1] ne $updir and # nor another updir
253 $collapsed[-1] ne $curdir # nor the curdir
254 )
255 { # then
256 pop @collapsed; # collapse
257 }
258 else { # else
259 push @collapsed, $dir; # just hang onto it
260 }
261 }
262
263 return $fs->catpath($vol,
264 $fs->catdir(@collapsed),
265 $file
266 );
267}
268
26913µs1;
 
# spent 27µs within File::Spec::Unix::CORE:match which was called 10 times, avg 3µs/call: # 10 times (27µs+0s) by File::Spec::Unix::file_name_is_absolute at line 97, avg 3µs/call
sub File::Spec::Unix::CORE:match; # opcode
# spent 131µs within File::Spec::Unix::CORE:subst which was called 108 times, avg 1µs/call: # 18 times (55µs+0s) by File::Spec::Unix::canonpath at line 34, avg 3µs/call # 18 times (27µs+0s) by File::Spec::Unix::canonpath at line 29, avg 2µs/call # 18 times (14µs+0s) by File::Spec::Unix::canonpath at line 32, avg 783ns/call # 18 times (13µs+0s) by File::Spec::Unix::canonpath at line 30, avg 711ns/call # 18 times (11µs+0s) by File::Spec::Unix::canonpath at line 33, avg 628ns/call # 18 times (10µs+0s) by File::Spec::Unix::canonpath at line 31, avg 561ns/call
sub File::Spec::Unix::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.