← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Thu Jul 17 22:22:09 2008
Reported on Thu Jul 17 22:22:22 2008

File/usr/share/perl/5.8/File/Spec/Unix.pm
Statements Executed407
Total Time0.000676000000000001 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time		Subroutine
310.00070File::Spec::Unix::canonpath
100.00067File::Spec::Unix::catfile
100.00035File::Spec::Unix::catdir
50.00010File::Spec::Unix::splitdir
60.00005File::Spec::Unix::file_name_is_absolute
00File::Spec::Unix::BEGIN
00File::Spec::Unix::_collapse
00File::Spec::Unix::_cwd
00File::Spec::Unix::_tmpdir
00File::Spec::Unix::abs2rel
00File::Spec::Unix::catpath
00File::Spec::Unix::join
00File::Spec::Unix::no_upwards
00File::Spec::Unix::path
00File::Spec::Unix::rel2abs
00File::Spec::Unix::splitpath
00File::Spec::Unix::tmpdir

LineStmts.Exclusive
Time		Avg.Code
1package File::Spec::Unix;
2
3use strict;
4use vars qw($VERSION);
5
6$VERSION = '1.5';
7
8
# spent 0.00070s within File::Spec::Unix::canonpath which was called 31 times, avg 0.00002s/call: # 10 times (0.00016s) by File::Spec::Unix::catfile at line 42 of /usr/share/perl/5.8/File/Spec/Unix.pm, avg 0.00002s/call # 10 times (0.00026s) by File::Spec::Unix::catdir at line 37 of /usr/share/perl/5.8/File/Spec/Unix.pm, avg 0.00003s/call # 5 times (0.00014s) by HTML::Template::Pro::_find_file at line 333 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 0.00003s/call # 5 times (0.00011s) by HTML::Template::Pro::_find_file at line 320 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 0.00002s/call # 1 times (0.00003s) by HTML::Template::Pro::_find_file at line 314 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm
sub canonpath {
93100.000431e-06 my ($self,$path) = @_;
10
11 # Handle POSIX-style node names beginning with double slash (qnx, nto)
12 # Handle network path names beginning with double slash (cygwin)
13 # (POSIX says: "a pathname that begins with two successive slashes
14 # may be interpreted in an implementation-defined manner, although
15 # more than two leading slashes shall be treated as a single slash.")
16 my $node = '';
17 if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
18 $node = $1;
19 }
20 # This used to be
21 # $path =~ s|/+|/|g unless($^O eq 'cygwin');
22 # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
23 # (Mainly because trailing "" directories didn't get stripped).
24 # Why would cygwin avoid collapsing multiple slashes into one? --jhi
25 $path =~ s|/+|/|g; # xx////xx -> xx/xx
26 $path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx
27 $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
28 $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx
29 $path =~ s|^/\.\.$|/|; # /.. -> /
30 $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
31 return "$node$path";
32}
33
34
# spent 0.00035s within File::Spec::Unix::catdir which was called 10 times, avg 0.00003s/call: # 10 times (0.00035s) by File::Spec::Unix::catfile at line 44 of /usr/share/perl/5.8/File/Spec/Unix.pm, avg 0.00003s/call
sub catdir {
35200.000063e-06 my $self = shift;
36
37 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
# spent 0.00026s making 10 calls to File::Spec::Unix::canonpath, avg 0.00003s/call
38}
39
40
# spent 0.00067s within File::Spec::Unix::catfile which was called 10 times, avg 0.00007s/call: # 5 times (0.00033s) by HTML::Template::Pro::_find_file at line 320 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 0.00007s/call # 5 times (0.00034s) by HTML::Template::Pro::_find_file at line 332 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 0.00007s/call
sub catfile {
41600.000142e-06 my $self = shift;
42 my $file = $self->canonpath(pop @_);
# spent 0.00016s making 10 calls to File::Spec::Unix::canonpath, avg 0.00002s/call
43 return $file unless @_;
44 my $dir = $self->catdir(@_);
# spent 0.00035s making 10 calls to File::Spec::Unix::catdir, avg 0.00003s/call
45 $dir .= "/" unless substr($dir,-1) eq "/";
46 return $dir.$file;
47}
48
49sub curdir () { '.' }
50
51sub devnull () { '/dev/null' }
52
53sub rootdir () { '/' }
54
55my $tmpdir;
56sub _tmpdir {
57 return $tmpdir if defined $tmpdir;
58 my $self = shift;
59 my @dirlist = @_;
60 {
61 no strict 'refs';
62 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
63 require Scalar::Util;
64 @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
65 }
66 }
67 foreach (@dirlist) {
68 next unless defined && -d && -w _;
69 $tmpdir = $_;
70 last;
71 }
72 $tmpdir = $self->curdir unless defined $tmpdir;
73 $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
74 return $tmpdir;
75}
76
77sub tmpdir {
78 return $tmpdir if defined $tmpdir;
79 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
80}
81
82sub updir () { '..' }
83
84sub no_upwards {
85 my $self = shift;
86 return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
87}
88
89sub case_tolerant () { 0 }
90
91
# spent 0.00005s within File::Spec::Unix::file_name_is_absolute which was called 6 times, avg 8e-06s/call: # 6 times (0.00005s) by HTML::Template::Pro::_find_file at line 314 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 8e-06s/call
sub file_name_is_absolute {
92120.000022e-06 my ($self,$file) = @_;
93 return scalar($file =~ m:^/:s);
94}
95
96sub path {
97 return () unless exists $ENV{PATH};
98 my @path = split(':', $ENV{PATH});
99 foreach (@path) { $_ = '.' if $_ eq '' }
100 return @path;
101}
102
103sub join {
104 my $self = shift;
105 return $self->catfile(@_);
106}
107
108sub splitpath {
109 my ($self,$path, $nofile) = @_;
110
111 my ($volume,$directory,$file) = ('','','');
112
113 if ( $nofile ) {
114 $directory = $path;
115 }
116 else {
117 $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
118 $directory = $1;
119 $file = $2;
120 }
121
122 return ($volume,$directory,$file);
123}
124
125
# spent 0.00010s within File::Spec::Unix::splitdir which was called 5 times, avg 0.00002s/call: # 5 times (0.00010s) by HTML::Template::Pro::_get_filepath at line 301 of /usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm, avg 0.00002s/call
sub splitdir {
12650.000025e-06 return split m|/|, $_[1], -1; # Preserve trailing fields
127}
128
129sub catpath {
130 my ($self,$volume,$directory,$file) = @_;
131
132 if ( $directory ne '' &&
133 $file ne '' &&
134 substr( $directory, -1 ) ne '/' &&
135 substr( $file, 0, 1 ) ne '/'
136 ) {
137 $directory .= "/$file" ;
138 }
139 else {
140 $directory .= $file ;
141 }
142
143 return $directory ;
144}
145
146sub abs2rel {
147 my($self,$path,$base) = @_;
148
149 # Figure out the effective $base and clean it up.
150 if ( !defined( $base ) || $base eq '' ) {
151 $base = $self->_cwd();
152 }
153 elsif ( ! $self->file_name_is_absolute( $base ) ) {
154 if ( ! $self->file_name_is_absolute( $path ) ) {
155 # optimisation where both paths are relative: save 2 x cwd
156 $base = $self->canonpath( "/$base" );
157 $path = "/$path";
158 }
159 else {
160 $base = $self->rel2abs( $base ) ;
161 }
162 }
163 else {
164 $base = $self->canonpath( $base ) ;
165 }
166
167 # Clean up $path
168 if ( ! $self->file_name_is_absolute( $path ) ) {
169 $path = $self->rel2abs( $path ) ;
170 }
171 else {
172 $path = $self->canonpath( $path ) ;
173 }
174
175 # Now, remove all leading components that are the same
176 my @pathchunks = $self->splitdir( $path);
177 my @basechunks = $self->splitdir( $base);
178
179 while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
180 shift @pathchunks ;
181 shift @basechunks ;
182 }
183
184 $path = CORE::join( '/', @pathchunks );
185 $base = CORE::join( '/', @basechunks );
186
187 # $base now contains the directories the resulting relative path
188 # must ascend out of before it can descend to $path_directory. So,
189 # replace all names with $parentDir
190 $base =~ s|[^/]+|..|g ;
191
192 # Glue the two together, using a separator if necessary, and preventing an
193 # empty result.
194 if ( $path ne '' && $base ne '' ) {
195 $path = "$base/$path" ;
196 } else {
197 $path = "$base$path" ;
198 }
199
200 return $self->canonpath( $path ) ;
201}
202
203sub rel2abs {
204 my ($self,$path,$base ) = @_;
205
206 # Clean up $path
207 if ( ! $self->file_name_is_absolute( $path ) ) {
208 # Figure out the effective $base and clean it up.
209 if ( !defined( $base ) || $base eq '' ) {
210 $base = $self->_cwd();
211 }
212 elsif ( ! $self->file_name_is_absolute( $base ) ) {
213 $base = $self->rel2abs( $base ) ;
214 }
215 else {
216 $base = $self->canonpath( $base ) ;
217 }
218
219 # Glom them together
220 $path = $self->catdir( $base, $path ) ;
221 }
222
223 return $self->canonpath( $path ) ;
224}
225
226# Internal routine to File::Spec, no point in making this public since
227# it is the standard Cwd interface. Most of the platform-specific
228# File::Spec subclasses use this.
229sub _cwd {
230 require Cwd;
231 Cwd::cwd();
232}
233
234# Internal method to reduce xx\..\yy -> yy
235sub _collapse {
236 my($fs, $path) = @_;
237
238 my $updir = $fs->updir;
239 my $curdir = $fs->curdir;
240
241 my($vol, $dirs, $file) = $fs->splitpath($path);
242 my @dirs = $fs->splitdir($dirs);
243
244 my @collapsed;
245 foreach my $dir (@dirs) {
246 if( $dir eq $updir and # if we have an updir
247 @collapsed and # and something to collapse
248 length $collapsed[-1] and # and its not the rootdir
249 $collapsed[-1] ne $updir and # nor another updir
250 $collapsed[-1] ne $curdir # nor the curdir
251 )
252 { # then
253 pop @collapsed; # collapse
254 }
255 else { # else
256 push @collapsed, $dir; # just hang onto it
257 }
258 }
259
260 return $fs->catpath($vol,
261 $fs->catdir(@collapsed),
262 $file
263 );
264}
265
2661;
Report produced by the NYTProf 2.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.