Profile of File/Spec/Unix.pm

Filename	/usr/share/perl/5.10/File/Spec/Unix.pm
Statements	Executed 321 statements in 3.53ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
18	2	1	396µs	531µs	File::Spec::Unix::::canonpathFile::Spec::Unix::canonpath
9	2	2	286µs	891µs	File::Spec::Unix::::catfileFile::Spec::Unix::catfile
108	6	1	135µs	135µs	File::Spec::Unix::::CORE:substFile::Spec::Unix::CORE:subst (opcode)
10	2	2	120µs	142µs	File::Spec::Unix::file_name_is_absolute
9	1	1	74µs	324µs	File::Spec::Unix::::catdirFile::Spec::Unix::catdir
1	1	1	38µs	48µs	File::Spec::Unix::::BEGIN@3File::Spec::Unix::BEGIN@3
10	1	1	22µs	22µs	File::Spec::Unix::::CORE:matchFile::Spec::Unix::CORE:match (opcode)
1	1	1	15µs	39µs	File::Spec::Unix::::BEGIN@65File::Spec::Unix::BEGIN@65
1	1	1	14µs	41µs	File::Spec::Unix::::BEGIN@4File::Spec::Unix::BEGIN@4
0	0	0	0s	0s	File::Spec::Unix::::_collapseFile::Spec::Unix::_collapse
0	0	0	0s	0s	File::Spec::Unix::::_cwdFile::Spec::Unix::_cwd
0	0	0	0s	0s	File::Spec::Unix::::_sameFile::Spec::Unix::_same
0	0	0	0s	0s	File::Spec::Unix::::_tmpdirFile::Spec::Unix::_tmpdir
0	0	0	0s	0s	File::Spec::Unix::::abs2relFile::Spec::Unix::abs2rel
0	0	0	0s	0s	File::Spec::Unix::::case_tolerantFile::Spec::Unix::case_tolerant
0	0	0	0s	0s	File::Spec::Unix::::catpathFile::Spec::Unix::catpath
0	0	0	0s	0s	File::Spec::Unix::::curdirFile::Spec::Unix::curdir
0	0	0	0s	0s	File::Spec::Unix::::devnullFile::Spec::Unix::devnull
0	0	0	0s	0s	File::Spec::Unix::::joinFile::Spec::Unix::join
0	0	0	0s	0s	File::Spec::Unix::::no_upwardsFile::Spec::Unix::no_upwards
0	0	0	0s	0s	File::Spec::Unix::::pathFile::Spec::Unix::path
0	0	0	0s	0s	File::Spec::Unix::::rel2absFile::Spec::Unix::rel2abs
0	0	0	0s	0s	File::Spec::Unix::::rootdirFile::Spec::Unix::rootdir
0	0	0	0s	0s	File::Spec::Unix::::splitdirFile::Spec::Unix::splitdir
0	0	0	0s	0s	File::Spec::Unix::::splitpathFile::Spec::Unix::splitpath
0	0	0	0s	0s	File::Spec::Unix::::tmpdirFile::Spec::Unix::tmpdir
0	0	0	0s	0s	File::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
1					package File::Spec::Unix;
2
3	3	58µs	2	58µs	# spent 48µs (38+10) within File::Spec::Unix::BEGIN@3 which was called: # once (38µs+10µs) by IO::File::BEGIN@12 at line 3 use strict; # spent 48µs making 1 call to File::Spec::Unix::BEGIN@3 # spent 10µs making 1 call to strict::import
4	3	553µs	2	69µs	# spent 41µs (14+27) within File::Spec::Unix::BEGIN@4 which was called: # once (14µs+27µs) by IO::File::BEGIN@12 at line 4 use vars qw($VERSION); # spent 41µs making 1 call to File::Spec::Unix::BEGIN@4 # spent 28µs making 1 call to vars::import
5
6	1	800ns			$VERSION = '3.30';
7	1	22µs			$VERSION = eval $VERSION; # spent 5µs executing statements in string eval
8
9					# spent 531µs (396+135) within File::Spec::Unix::canonpath which was called 18 times, avg 30µs/call: # 9 times (239µs+42µs) by File::Spec::Unix::catfile at line 46, avg 31µs/call # 9 times (157µs+93µs) by File::Spec::Unix::catdir at line 41, avg 28µs/call sub canonpath {
10	216	552µ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
29			18	26µs	$path =~ s\|/{2,}\|/\|g; # xx////xx -> xx/xx # spent 26µs making 18 calls to File::Spec::Unix::CORE:subst, avg 1µs/call
30			18	14µs	$path =~ s{(?:/\.)+(?:/\|\z)}{/}g; # xx/././xx -> xx/xx # spent 14µs making 18 calls to File::Spec::Unix::CORE:subst, avg 806ns/call
31			18	13µs	$path =~ s\|^(?:\./)+\|\|s unless $path eq "./"; # ./xx -> xx # spent 13µs making 18 calls to File::Spec::Unix::CORE:subst, avg 733ns/call
32			18	16µs	$path =~ s\|^/(?:\.\./)+\|/\|; # /../../xx -> xx # spent 16µs making 18 calls to File::Spec::Unix::CORE:subst, avg 883ns/call
33			18	13µs	$path =~ s\|^/\.\.$\|/\|; # /.. -> / # spent 13µs making 18 calls to File::Spec::Unix::CORE:subst, avg 711ns/call
34			18	53µs	$path =~ s\|/\z\|\| unless $path eq "/"; # xx/ -> xx # spent 53µs making 18 calls to File::Spec::Unix::CORE:subst, avg 3µs/call
35					return "$node$path";
36					}
37
38					# spent 324µs (74+250) within File::Spec::Unix::catdir which was called 9 times, avg 36µs/call: # 9 times (74µs+250µs) by File::Spec::Unix::catfile at line 48, avg 36µs/call sub catdir {
39	18	100µs			my $self = shift;
40
41			9	250µs	$self->canonpath(join('/', @_, '')); # '' because need a trailing '/' # spent 250µs making 9 calls to File::Spec::Unix::canonpath, avg 28µs/call
42					}
43
44					# spent 891µs (286+605) within File::Spec::Unix::catfile which was called 9 times, avg 99µs/call: # 8 times (262µs+540µs) by Template::Provider::_fetch_path at line 525 of Template/Provider.pm, avg 100µs/call # once (24µs+65µs) by XML::SAX::load_parsers at line 61 of XML/SAX.pm sub catfile {
45	54	246µs			my $self = shift;
46			9	281µs	my $file = $self->canonpath(pop @_); # spent 281µs making 9 calls to File::Spec::Unix::canonpath, avg 31µs/call
47					return $file unless @_;
48			9	324µs	my $dir = $self->catdir(@_); # spent 324µs making 9 calls to File::Spec::Unix::catdir, avg 36µs/call
49					$dir .= "/" unless substr($dir,-1) eq "/";
50					return $dir.$file;
51					}
52
53					sub curdir { '.' }
54
55					sub devnull { '/dev/null' }
56
57					sub rootdir { '/' }
58
59	1	600ns			my $tmpdir;
60					sub _tmpdir {
61					return $tmpdir if defined $tmpdir;
62					my $self = shift;
63					my @dirlist = @_;
64					{
65	3	1.85ms	2	62µs	# spent 39µs (15+24) within File::Spec::Unix::BEGIN@65 which was called: # once (15µs+24µs) by IO::File::BEGIN@12 at line 65 no strict 'refs'; # spent 39µs making 1 call to File::Spec::Unix::BEGIN@65 # spent 24µ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
81					sub tmpdir {
82					return $tmpdir if defined $tmpdir;
83					$tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
84					}
85
86					sub updir { '..' }
87
88					sub no_upwards {
89					my $self = shift;
90					return grep(!/^\.{1,2}\z/s, @_);
91					}
92
93					sub case_tolerant { 0 }
94
95					# spent 142µs (120+22) within File::Spec::Unix::file_name_is_absolute which was called 10 times, avg 14µs/call: # 9 times (107µs+18µs) by Template::Provider::fetch at line 127 of Template/Provider.pm, avg 14µs/call # once (13µs+3µs) by FindBin::init at line 176 of FindBin.pm sub file_name_is_absolute {
96	20	136µs			my ($self,$file) = @_;
97			10	22µs	return scalar($file =~ m:^/:s); # spent 22µs making 10 calls to File::Spec::Unix::CORE:match, avg 2µs/call
98					}
99
100					sub path {
101					return () unless exists $ENV{PATH};
102					my @path = split(':', $ENV{PATH});
103					foreach (@path) { $_ = '.' if $_ eq '' }
104					return @path;
105					}
106
107					sub join {
108					my $self = shift;
109					return $self->catfile(@_);
110					}
111
112					sub 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
129					sub splitdir {
130					return split m\|/\|, $_[1], -1; # Preserve trailing fields
131					}
132
133					sub 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
150					sub 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
201					sub _same {
202					$_[1] eq $_[2];
203					}
204
205					sub 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.
231					sub _cwd {
232					require Cwd;
233					Cwd::getcwd();
234					}
235
236					# Internal method to reduce xx\..\yy -> yy
237					sub _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
269	1	4µs			1;

					# spent 22µs within File::Spec::Unix::CORE:match which was called 10 times, avg 2µs/call: # 10 times (22µs+0s) by File::Spec::Unix::file_name_is_absolute at line 97, avg 2µs/call sub File::Spec::Unix::CORE:match; # opcode
					# spent 135µs within File::Spec::Unix::CORE:subst which was called 108 times, avg 1µs/call: # 18 times (53µs+0s) by File::Spec::Unix::canonpath at line 34, avg 3µs/call # 18 times (26µs+0s) by File::Spec::Unix::canonpath at line 29, avg 1µs/call # 18 times (16µs+0s) by File::Spec::Unix::canonpath at line 32, avg 883ns/call # 18 times (14µs+0s) by File::Spec::Unix::canonpath at line 30, avg 806ns/call # 18 times (13µs+0s) by File::Spec::Unix::canonpath at line 31, avg 733ns/call # 18 times (13µs+0s) by File::Spec::Unix::canonpath at line 33, avg 711ns/call sub File::Spec::Unix::CORE:subst; # opcode