Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/darwin-2level/File/Spec/Unix.pm |
Statements | Executed 16179 statements in 28.8ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
141 | 1 | 1 | 15.0ms | 23.8ms | abs2rel | File::Spec::Unix::
831 | 6 | 3 | 3.44ms | 4.35ms | splitpath | File::Spec::Unix::
1833 | 2 | 1 | 1.79ms | 1.79ms | _same | File::Spec::Unix::
1646 | 8 | 4 | 1.58ms | 1.58ms | canonpath (xsub) | File::Spec::Unix::
564 | 2 | 1 | 1.52ms | 1.85ms | file_name_is_absolute | File::Spec::Unix::
567 | 4 | 3 | 1.50ms | 1.50ms | splitdir | File::Spec::Unix::
282 | 1 | 1 | 1.31ms | 2.46ms | rel2abs | File::Spec::Unix::
1028 | 3 | 1 | 1.29ms | 1.29ms | CORE:match (opcode) | File::Spec::Unix::
305 | 4 | 3 | 930µs | 1.13ms | catdir (xsub) | File::Spec::Unix::
161 | 1 | 1 | 791µs | 1.41ms | catfile (xsub) | File::Spec::Unix::
141 | 1 | 1 | 356µs | 356µs | catpath | File::Spec::Unix::
18 | 1 | 1 | 296µs | 349µs | no_upwards | File::Spec::Unix::
141 | 1 | 1 | 143µs | 143µs | rootdir | File::Spec::Unix::
1 | 1 | 1 | 14µs | 26µs | BEGIN@3 | File::Spec::Unix::
1 | 1 | 1 | 10µs | 45µs | BEGIN@220 | File::Spec::Unix::
5 | 1 | 1 | 10µs | 10µs | _fn_catdir (xsub) | File::Spec::Unix::
1 | 1 | 1 | 9µs | 42µs | BEGIN@136 | File::Spec::Unix::
1 | 1 | 1 | 8µs | 27µs | BEGIN@179 | File::Spec::Unix::
1 | 1 | 1 | 7µs | 50µs | BEGIN@127 | File::Spec::Unix::
1 | 1 | 1 | 7µs | 42µs | BEGIN@145 | File::Spec::Unix::
1 | 1 | 1 | 6µs | 50µs | BEGIN@242 | File::Spec::Unix::
1 | 1 | 1 | 6µs | 22µs | BEGIN@4 | File::Spec::Unix::
1 | 1 | 1 | 2µs | 2µs | curdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _cache_tmpdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _cached_tmpdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _collapse | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _cwd | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _pp_canonpath | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _pp_catdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _pp_catfile | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | _tmpdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | case_tolerant | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | devnull | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | join | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | path | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | tmpdir | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | updir | File::Spec::Unix::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::Spec::Unix; | ||||
2 | |||||
3 | 2 | 22µs | 2 | 38µs | # spent 26µs (14+12) within File::Spec::Unix::BEGIN@3 which was called:
# once (14µs+12µs) by Pod::Usage::BEGIN@21 at line 3 # spent 26µs making 1 call to File::Spec::Unix::BEGIN@3
# spent 12µs making 1 call to strict::import |
4 | 2 | 356µs | 2 | 39µs | # spent 22µs (6+16) within File::Spec::Unix::BEGIN@4 which was called:
# once (6µs+16µs) by Pod::Usage::BEGIN@21 at line 4 # spent 22µs making 1 call to File::Spec::Unix::BEGIN@4
# spent 16µs making 1 call to vars::import |
5 | |||||
6 | 1 | 700ns | $VERSION = '3.47'; | ||
7 | 1 | 300ns | my $xs_version = $VERSION; | ||
8 | 1 | 300ns | $VERSION =~ tr/_//; | ||
9 | |||||
10 | 1 | 3µs | unless (defined &canonpath) { | ||
11 | 1 | 200ns | eval { | ||
12 | 1 | 900ns | if ( $] >= 5.006 ) { | ||
13 | 1 | 500ns | require XSLoader; | ||
14 | 1 | 168µs | 1 | 55µs | XSLoader::load("Cwd", $xs_version); # spent 55µs making 1 call to XSLoader::load |
15 | } else { | ||||
16 | require Cwd; | ||||
17 | } | ||||
18 | }; | ||||
19 | } | ||||
20 | |||||
21 | =head1 NAME | ||||
22 | |||||
23 | File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules | ||||
24 | |||||
25 | =head1 SYNOPSIS | ||||
26 | |||||
27 | require File::Spec::Unix; # Done automatically by File::Spec | ||||
28 | |||||
29 | =head1 DESCRIPTION | ||||
30 | |||||
31 | Methods for manipulating file specifications. Other File::Spec | ||||
32 | modules, such as File::Spec::Mac, inherit from File::Spec::Unix and | ||||
33 | override specific methods. | ||||
34 | |||||
35 | =head1 METHODS | ||||
36 | |||||
37 | =over 2 | ||||
38 | |||||
39 | =item canonpath() | ||||
40 | |||||
41 | No physical check on the filesystem, but a logical cleanup of a | ||||
42 | path. On UNIX eliminates successive slashes and successive "/.". | ||||
43 | |||||
44 | $cpath = File::Spec->canonpath( $path ) ; | ||||
45 | |||||
46 | Note that this does *not* collapse F<x/../y> sections into F<y>. This | ||||
47 | is by design. If F</foo> on your system is a symlink to F</bar/baz>, | ||||
48 | then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive | ||||
49 | F<../>-removal would give you. If you want to do this kind of | ||||
50 | processing, you probably want C<Cwd>'s C<realpath()> function to | ||||
51 | actually traverse the filesystem cleaning up paths like this. | ||||
52 | |||||
53 | =cut | ||||
54 | |||||
55 | sub _pp_canonpath { | ||||
56 | my ($self,$path) = @_; | ||||
57 | return unless defined $path; | ||||
58 | |||||
59 | # Handle POSIX-style node names beginning with double slash (qnx, nto) | ||||
60 | # (POSIX says: "a pathname that begins with two successive slashes | ||||
61 | # may be interpreted in an implementation-defined manner, although | ||||
62 | # more than two leading slashes shall be treated as a single slash.") | ||||
63 | my $node = ''; | ||||
64 | my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto'; | ||||
65 | |||||
66 | |||||
67 | if ( $double_slashes_special | ||||
68 | && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) { | ||||
69 | $node = $1; | ||||
70 | } | ||||
71 | # This used to be | ||||
72 | # $path =~ s|/+|/|g unless ($^O eq 'cygwin'); | ||||
73 | # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail | ||||
74 | # (Mainly because trailing "" directories didn't get stripped). | ||||
75 | # Why would cygwin avoid collapsing multiple slashes into one? --jhi | ||||
76 | $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx | ||||
77 | $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx | ||||
78 | $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx | ||||
79 | $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx | ||||
80 | $path =~ s|^/\.\.$|/|; # /.. -> / | ||||
81 | $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx | ||||
82 | return "$node$path"; | ||||
83 | } | ||||
84 | 1 | 300ns | *canonpath = \&_pp_canonpath unless defined &canonpath; | ||
85 | |||||
86 | =item catdir() | ||||
87 | |||||
88 | Concatenate two or more directory names to form a complete path ending | ||||
89 | with a directory. But remove the trailing slash from the resulting | ||||
90 | string, because it doesn't look good, isn't necessary and confuses | ||||
91 | OS2. Of course, if this is the root directory, don't cut off the | ||||
92 | trailing slash :-) | ||||
93 | |||||
94 | =cut | ||||
95 | |||||
96 | sub _pp_catdir { | ||||
97 | my $self = shift; | ||||
98 | |||||
99 | $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' | ||||
100 | } | ||||
101 | 1 | 100ns | *catdir = \&_pp_catdir unless defined &catdir; | ||
102 | |||||
103 | =item catfile | ||||
104 | |||||
105 | Concatenate one or more directory names and a filename to form a | ||||
106 | complete path ending with a filename | ||||
107 | |||||
108 | =cut | ||||
109 | |||||
110 | sub _pp_catfile { | ||||
111 | my $self = shift; | ||||
112 | my $file = $self->canonpath(pop @_); | ||||
113 | return $file unless @_; | ||||
114 | my $dir = $self->catdir(@_); | ||||
115 | $dir .= "/" unless substr($dir,-1) eq "/"; | ||||
116 | return $dir.$file; | ||||
117 | } | ||||
118 | 1 | 100ns | *catfile = \&_pp_catfile unless defined &catfile; | ||
119 | |||||
120 | =item curdir | ||||
121 | |||||
122 | Returns a string representation of the current directory. "." on UNIX. | ||||
123 | |||||
124 | =cut | ||||
125 | |||||
126 | 1 | 4µs | # spent 2µs within File::Spec::Unix::curdir which was called:
# once (2µs+0s) by Module::Pluggable::Object::BEGIN@4 at line 1103 of File/Find.pm | ||
127 | 2 | 42µs | 2 | 92µs | # spent 50µs (7+42) within File::Spec::Unix::BEGIN@127 which was called:
# once (7µs+42µs) by Pod::Usage::BEGIN@21 at line 127 # spent 50µs making 1 call to File::Spec::Unix::BEGIN@127
# spent 42µs making 1 call to constant::import |
128 | |||||
129 | =item devnull | ||||
130 | |||||
131 | Returns a string representation of the null device. "/dev/null" on UNIX. | ||||
132 | |||||
133 | =cut | ||||
134 | |||||
135 | sub devnull { '/dev/null' } | ||||
136 | 2 | 33µs | 2 | 74µs | # spent 42µs (9+33) within File::Spec::Unix::BEGIN@136 which was called:
# once (9µs+33µs) by Pod::Usage::BEGIN@21 at line 136 # spent 42µs making 1 call to File::Spec::Unix::BEGIN@136
# spent 32µs making 1 call to constant::import |
137 | |||||
138 | =item rootdir | ||||
139 | |||||
140 | Returns a string representation of the root directory. "/" on UNIX. | ||||
141 | |||||
142 | =cut | ||||
143 | |||||
144 | 141 | 237µs | # spent 143µs within File::Spec::Unix::rootdir which was called 141 times, avg 1µs/call:
# 141 times (143µs+0s) by File::Spec::Unix::abs2rel at line 445, avg 1µs/call | ||
145 | 2 | 132µs | 2 | 76µs | # spent 42µs (7+35) within File::Spec::Unix::BEGIN@145 which was called:
# once (7µs+35µs) by Pod::Usage::BEGIN@21 at line 145 # spent 42µs making 1 call to File::Spec::Unix::BEGIN@145
# spent 35µs making 1 call to constant::import |
146 | |||||
147 | =item tmpdir | ||||
148 | |||||
149 | Returns a string representation of the first writable directory from | ||||
150 | the following list or the current directory if none from the list are | ||||
151 | writable: | ||||
152 | |||||
153 | $ENV{TMPDIR} | ||||
154 | /tmp | ||||
155 | |||||
156 | If running under taint mode, and if $ENV{TMPDIR} | ||||
157 | is tainted, it is not used. | ||||
158 | |||||
159 | =cut | ||||
160 | |||||
161 | 1 | 100ns | my ($tmpdir, %tmpenv); | ||
162 | # Cache and return the calculated tmpdir, recording which env vars | ||||
163 | # determined it. | ||||
164 | sub _cache_tmpdir { | ||||
165 | @tmpenv{@_[2..$#_]} = @ENV{@_[2..$#_]}; | ||||
166 | return $tmpdir = $_[1]; | ||||
167 | } | ||||
168 | # Retrieve the cached tmpdir, checking first whether relevant env vars have | ||||
169 | # changed and invalidated the cache. | ||||
170 | sub _cached_tmpdir { | ||||
171 | shift; | ||||
172 | local $^W; | ||||
173 | return if grep $ENV{$_} ne $tmpenv{$_}, @_; | ||||
174 | return $tmpdir; | ||||
175 | } | ||||
176 | sub _tmpdir { | ||||
177 | my $self = shift; | ||||
178 | my @dirlist = @_; | ||||
179 | 2 | 221µs | 2 | 46µs | # spent 27µs (8+19) within File::Spec::Unix::BEGIN@179 which was called:
# once (8µs+19µs) by Pod::Usage::BEGIN@21 at line 179 # spent 27µs making 1 call to File::Spec::Unix::BEGIN@179
# spent 19µs making 1 call to strict::unimport |
180 | if ($taint) { # Check for taint mode on perl >= 5.8.0 | ||||
181 | require Scalar::Util; | ||||
182 | @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; | ||||
183 | } | ||||
184 | elsif ($] < 5.007) { # No ${^TAINT} before 5.8 | ||||
185 | @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist; | ||||
186 | } | ||||
187 | |||||
188 | foreach (@dirlist) { | ||||
189 | next unless defined && -d && -w _; | ||||
190 | $tmpdir = $_; | ||||
191 | last; | ||||
192 | } | ||||
193 | $tmpdir = $self->curdir unless defined $tmpdir; | ||||
194 | $tmpdir = defined $tmpdir && $self->canonpath($tmpdir); | ||||
195 | if ( !$self->file_name_is_absolute($tmpdir) ) { | ||||
196 | # See [perl #120593] for the full details | ||||
197 | # If possible, return a full path, rather than '.' or 'lib', but | ||||
198 | # jump through some hoops to avoid returning a tainted value. | ||||
199 | ($tmpdir) = grep { | ||||
200 | $taint ? ! Scalar::Util::tainted($_) : | ||||
201 | $] < 5.007 ? eval { eval('1'.substr $_,0,0) } : 1 | ||||
202 | } $self->rel2abs($tmpdir), $tmpdir; | ||||
203 | } | ||||
204 | return $tmpdir; | ||||
205 | } | ||||
206 | |||||
207 | sub tmpdir { | ||||
208 | my $cached = $_[0]->_cached_tmpdir('TMPDIR'); | ||||
209 | return $cached if defined $cached; | ||||
210 | $_[0]->_cache_tmpdir($_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ), 'TMPDIR'); | ||||
211 | } | ||||
212 | |||||
213 | =item updir | ||||
214 | |||||
215 | Returns a string representation of the parent directory. ".." on UNIX. | ||||
216 | |||||
217 | =cut | ||||
218 | |||||
219 | sub updir { '..' } | ||||
220 | 2 | 69µs | 2 | 79µs | # spent 45µs (10+34) within File::Spec::Unix::BEGIN@220 which was called:
# once (10µs+34µs) by Pod::Usage::BEGIN@21 at line 220 # spent 45µs making 1 call to File::Spec::Unix::BEGIN@220
# spent 34µs making 1 call to constant::import |
221 | |||||
222 | =item no_upwards | ||||
223 | |||||
224 | Given a list of file names, strip out those that refer to a parent | ||||
225 | directory. (Does not strip symlinks, only '.', '..', and equivalents.) | ||||
226 | |||||
227 | =cut | ||||
228 | |||||
229 | # spent 349µs (296+53) within File::Spec::Unix::no_upwards which was called 18 times, avg 19µs/call:
# 18 times (296µs+53µs) by Perl::Critic::Utils::all_perl_files at line 1103 of Perl/Critic/Utils.pm, avg 19µs/call | ||||
230 | 18 | 7µs | my $self = shift; | ||
231 | 18 | 348µs | 197 | 53µs | return grep(!/^\.{1,2}\z/s, @_); # spent 53µs making 197 calls to File::Spec::Unix::CORE:match, avg 270ns/call |
232 | } | ||||
233 | |||||
234 | =item case_tolerant | ||||
235 | |||||
236 | Returns a true or false value indicating, respectively, that alphabetic | ||||
237 | is not or is significant when comparing file specifications. | ||||
238 | |||||
239 | =cut | ||||
240 | |||||
241 | sub case_tolerant { 0 } | ||||
242 | 2 | 814µs | 2 | 93µs | # spent 50µs (6+43) within File::Spec::Unix::BEGIN@242 which was called:
# once (6µs+43µs) by Pod::Usage::BEGIN@21 at line 242 # spent 50µs making 1 call to File::Spec::Unix::BEGIN@242
# spent 43µs making 1 call to constant::import |
243 | |||||
244 | =item file_name_is_absolute | ||||
245 | |||||
246 | Takes as argument a path and returns true if it is an absolute path. | ||||
247 | |||||
248 | This does not consult the local filesystem on Unix, Win32, OS/2 or Mac | ||||
249 | OS (Classic). It does consult the working environment for VMS (see | ||||
250 | L<File::Spec::VMS/file_name_is_absolute>). | ||||
251 | |||||
252 | =cut | ||||
253 | |||||
254 | sub file_name_is_absolute { | ||||
255 | 564 | 97µs | my ($self,$file) = @_; | ||
256 | 564 | 2.08ms | 564 | 327µs | return scalar($file =~ m:^/:s); # spent 327µs making 564 calls to File::Spec::Unix::CORE:match, avg 580ns/call |
257 | } | ||||
258 | |||||
259 | =item path | ||||
260 | |||||
261 | Takes no argument, returns the environment variable PATH as an array. | ||||
262 | |||||
263 | =cut | ||||
264 | |||||
265 | sub path { | ||||
266 | return () unless exists $ENV{PATH}; | ||||
267 | my @path = split(':', $ENV{PATH}); | ||||
268 | foreach (@path) { $_ = '.' if $_ eq '' } | ||||
269 | return @path; | ||||
270 | } | ||||
271 | |||||
272 | =item join | ||||
273 | |||||
274 | join is the same as catfile. | ||||
275 | |||||
276 | =cut | ||||
277 | |||||
278 | sub join { | ||||
279 | my $self = shift; | ||||
280 | return $self->catfile(@_); | ||||
281 | } | ||||
282 | |||||
283 | =item splitpath | ||||
284 | |||||
285 | ($volume,$directories,$file) = File::Spec->splitpath( $path ); | ||||
286 | ($volume,$directories,$file) = File::Spec->splitpath( $path, | ||||
287 | $no_file ); | ||||
288 | |||||
289 | Splits a path into volume, directory, and filename portions. On systems | ||||
290 | with no concept of volume, returns '' for volume. | ||||
291 | |||||
292 | For systems with no syntax differentiating filenames from directories, | ||||
293 | assumes that the last file is a path unless $no_file is true or a | ||||
294 | trailing separator or /. or /.. is present. On Unix this means that $no_file | ||||
295 | true makes this return ( '', $path, '' ). | ||||
296 | |||||
297 | The directory portion may or may not be returned with a trailing '/'. | ||||
298 | |||||
299 | The results can be passed to L</catpath()> to get back a path equivalent to | ||||
300 | (usually identical to) the original path. | ||||
301 | |||||
302 | =cut | ||||
303 | |||||
304 | # spent 4.35ms (3.44+907µs) within File::Spec::Unix::splitpath which was called 831 times, avg 5µs/call:
# 144 times (1.62ms+642µs) by Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage::violates at line 59 of Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm, avg 16µs/call
# 141 times (325µs+0s) by File::Spec::Unix::abs2rel at line 419, avg 2µs/call
# 141 times (269µs+0s) by File::Spec::Unix::abs2rel at line 420, avg 2µs/call
# 141 times (260µs+0s) by File::Spec::Unix::abs2rel at line 425, avg 2µs/call
# 141 times (255µs+0s) by File::Spec::Unix::abs2rel at line 426, avg 2µs/call
# 123 times (708µs+265µs) by Path::Tiny::_splitpath at line 374 of Path/Tiny.pm, avg 8µs/call | ||||
305 | 831 | 276µs | my ($self,$path, $nofile) = @_; | ||
306 | |||||
307 | 831 | 261µs | my ($volume,$directory,$file) = ('','',''); | ||
308 | |||||
309 | 831 | 161µs | if ( $nofile ) { | ||
310 | $directory = $path; | ||||
311 | } | ||||
312 | else { | ||||
313 | 267 | 1.54ms | 267 | 907µs | $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; # spent 907µs making 267 calls to File::Spec::Unix::CORE:match, avg 3µs/call |
314 | 267 | 309µs | $directory = $1; | ||
315 | 267 | 211µs | $file = $2; | ||
316 | } | ||||
317 | |||||
318 | 831 | 1.91ms | return ($volume,$directory,$file); | ||
319 | } | ||||
320 | |||||
321 | |||||
322 | =item splitdir | ||||
323 | |||||
324 | The opposite of L</catdir()>. | ||||
325 | |||||
326 | @dirs = File::Spec->splitdir( $directories ); | ||||
327 | |||||
328 | $directories must be only the directory portion of the path on systems | ||||
329 | that have the concept of a volume or that have path syntax that differentiates | ||||
330 | files from directories. | ||||
331 | |||||
332 | Unlike just splitting the directories on the separator, empty | ||||
333 | directory names (C<''>) can be returned, because these are significant | ||||
334 | on some OSs. | ||||
335 | |||||
336 | On Unix, | ||||
337 | |||||
338 | File::Spec->splitdir( "/a/b//c/" ); | ||||
339 | |||||
340 | Yields: | ||||
341 | |||||
342 | ( '', 'a', 'b', '', 'c', '' ) | ||||
343 | |||||
344 | =cut | ||||
345 | |||||
346 | # spent 1.50ms within File::Spec::Unix::splitdir which was called 567 times, avg 3µs/call:
# 144 times (500µs+0s) by Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage::violates at line 63 of Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm, avg 3µs/call
# 141 times (451µs+0s) by File::Spec::Unix::abs2rel at line 442, avg 3µs/call
# 141 times (372µs+0s) by File::Spec::Unix::abs2rel at line 443, avg 3µs/call
# 141 times (177µs+0s) by File::Spec::Functions::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/darwin-2level/File/Spec/Functions.pm:62] at line 62 of File/Spec/Functions.pm, avg 1µs/call | ||||
347 | 567 | 1.98ms | return split m|/|, $_[1], -1; # Preserve trailing fields | ||
348 | } | ||||
349 | |||||
350 | |||||
351 | =item catpath() | ||||
352 | |||||
353 | Takes volume, directory and file portions and returns an entire path. Under | ||||
354 | Unix, $volume is ignored, and directory and file are concatenated. A '/' is | ||||
355 | inserted if needed (though if the directory portion doesn't start with | ||||
356 | '/' it is not added). On other OSs, $volume is significant. | ||||
357 | |||||
358 | =cut | ||||
359 | |||||
360 | # spent 356µs within File::Spec::Unix::catpath which was called 141 times, avg 3µs/call:
# 141 times (356µs+0s) by File::Spec::Unix::abs2rel at line 479, avg 3µs/call | ||||
361 | 141 | 56µs | my ($self,$volume,$directory,$file) = @_; | ||
362 | |||||
363 | 141 | 64µs | if ( $directory ne '' && | ||
364 | $file ne '' && | ||||
365 | substr( $directory, -1 ) ne '/' && | ||||
366 | substr( $file, 0, 1 ) ne '/' | ||||
367 | ) { | ||||
368 | $directory .= "/$file" ; | ||||
369 | } | ||||
370 | else { | ||||
371 | 141 | 33µs | $directory .= $file ; | ||
372 | } | ||||
373 | |||||
374 | 141 | 272µs | return $directory ; | ||
375 | } | ||||
376 | |||||
377 | =item abs2rel | ||||
378 | |||||
379 | Takes a destination path and an optional base path returns a relative path | ||||
380 | from the base path to the destination path: | ||||
381 | |||||
382 | $rel_path = File::Spec->abs2rel( $path ) ; | ||||
383 | $rel_path = File::Spec->abs2rel( $path, $base ) ; | ||||
384 | |||||
385 | If $base is not present or '', then L<cwd()|Cwd> is used. If $base is | ||||
386 | relative, then it is converted to absolute form using | ||||
387 | L</rel2abs()>. This means that it is taken to be relative to | ||||
388 | L<cwd()|Cwd>. | ||||
389 | |||||
390 | On systems that have a grammar that indicates filenames, this ignores the | ||||
391 | $base filename. Otherwise all path components are assumed to be | ||||
392 | directories. | ||||
393 | |||||
394 | If $path is relative, it is converted to absolute form using L</rel2abs()>. | ||||
395 | This means that it is taken to be relative to L<cwd()|Cwd>. | ||||
396 | |||||
397 | No checks against the filesystem are made, so the result may not be correct if | ||||
398 | C<$base> contains symbolic links. (Apply | ||||
399 | L<Cwd::abs_path()|Cwd/abs_path> beforehand if that | ||||
400 | is a concern.) On VMS, there is interaction with the working environment, as | ||||
401 | logicals and macros are expanded. | ||||
402 | |||||
403 | Based on code written by Shigio Yamaguchi. | ||||
404 | |||||
405 | =cut | ||||
406 | |||||
407 | # spent 23.8ms (15.0+8.75) within File::Spec::Unix::abs2rel which was called 141 times, avg 168µs/call:
# 141 times (15.0ms+8.75ms) by File::Spec::Functions::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/darwin-2level/File/Spec/Functions.pm:62] at line 62 of File/Spec/Functions.pm, avg 168µs/call | ||||
408 | 141 | 64µs | my($self,$path,$base) = @_; | ||
409 | 141 | 51µs | $base = $self->_cwd() unless defined $base and length $base; | ||
410 | |||||
411 | 141 | 1.17ms | 282 | 364µs | ($path, $base) = map $self->canonpath($_), $path, $base; # spent 364µs making 282 calls to File::Spec::Unix::canonpath, avg 1µs/call |
412 | |||||
413 | 141 | 15µs | my $path_directories; | ||
414 | 141 | 2µs | my $base_directories; | ||
415 | |||||
416 | 141 | 421µs | 282 | 996µs | if (grep $self->file_name_is_absolute($_), $path, $base) { # spent 996µs making 282 calls to File::Spec::Unix::file_name_is_absolute, avg 4µs/call |
417 | 141 | 492µs | 282 | 2.46ms | ($path, $base) = map $self->rel2abs($_), $path, $base; # spent 2.46ms making 282 calls to File::Spec::Unix::rel2abs, avg 9µs/call |
418 | |||||
419 | 141 | 227µs | 141 | 325µs | my ($path_volume) = $self->splitpath($path, 1); # spent 325µs making 141 calls to File::Spec::Unix::splitpath, avg 2µs/call |
420 | 141 | 191µs | 141 | 269µs | my ($base_volume) = $self->splitpath($base, 1); # spent 269µs making 141 calls to File::Spec::Unix::splitpath, avg 2µs/call |
421 | |||||
422 | # Can't relativize across volumes | ||||
423 | 141 | 31µs | return $path unless $path_volume eq $base_volume; | ||
424 | |||||
425 | 141 | 212µs | 141 | 260µs | $path_directories = ($self->splitpath($path, 1))[1]; # spent 260µs making 141 calls to File::Spec::Unix::splitpath, avg 2µs/call |
426 | 141 | 197µs | 141 | 255µs | $base_directories = ($self->splitpath($base, 1))[1]; # spent 255µs making 141 calls to File::Spec::Unix::splitpath, avg 2µs/call |
427 | |||||
428 | # For UNC paths, the user might give a volume like //foo/bar that | ||||
429 | # strictly speaking has no directory portion. Treat it as if it | ||||
430 | # had the root directory for that volume. | ||||
431 | 141 | 78µs | if (!length($base_directories) and $self->file_name_is_absolute($base)) { | ||
432 | $base_directories = $self->rootdir; | ||||
433 | } | ||||
434 | } | ||||
435 | else { | ||||
436 | my $wd= ($self->splitpath($self->_cwd(), 1))[1]; | ||||
437 | $path_directories = $self->catdir($wd, $path); | ||||
438 | $base_directories = $self->catdir($wd, $base); | ||||
439 | } | ||||
440 | |||||
441 | # Now, remove all leading components that are the same | ||||
442 | 141 | 334µs | 141 | 451µs | my @pathchunks = $self->splitdir( $path_directories ); # spent 451µs making 141 calls to File::Spec::Unix::splitdir, avg 3µs/call |
443 | 141 | 279µs | 141 | 372µs | my @basechunks = $self->splitdir( $base_directories ); # spent 372µs making 141 calls to File::Spec::Unix::splitdir, avg 3µs/call |
444 | |||||
445 | 141 | 178µs | 141 | 143µs | if ($base_directories eq $self->rootdir) { # spent 143µs making 141 calls to File::Spec::Unix::rootdir, avg 1µs/call |
446 | return $self->curdir if $path_directories eq $self->rootdir; | ||||
447 | shift @pathchunks; | ||||
448 | return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); | ||||
449 | } | ||||
450 | |||||
451 | 141 | 16µs | my @common; | ||
452 | 141 | 266µs | 141 | 155µs | while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { # spent 155µs making 141 calls to File::Spec::Unix::_same, avg 1µs/call |
453 | 1833 | 486µs | push @common, shift @pathchunks ; | ||
454 | 1833 | 2.47ms | 1692 | 1.64ms | shift @basechunks ; # spent 1.64ms making 1692 calls to File::Spec::Unix::_same, avg 967ns/call |
455 | } | ||||
456 | 141 | 16µs | return $self->curdir unless @pathchunks || @basechunks; | ||
457 | |||||
458 | # @basechunks now contains the directories the resulting relative path | ||||
459 | # must ascend out of before it can descend to $path_directory. If there | ||||
460 | # are updir components, we must descend into the corresponding directories | ||||
461 | # (this only works if they are no symlinks). | ||||
462 | 141 | 13µs | my @reverse_base; | ||
463 | 141 | 62µs | while( defined(my $dir= shift @basechunks) ) { | ||
464 | if( $dir ne $self->updir ) { | ||||
465 | unshift @reverse_base, $self->updir; | ||||
466 | push @common, $dir; | ||||
467 | } | ||||
468 | elsif( @common ) { | ||||
469 | if( @reverse_base && $reverse_base[0] eq $self->updir ) { | ||||
470 | shift @reverse_base; | ||||
471 | pop @common; | ||||
472 | } | ||||
473 | else { | ||||
474 | unshift @reverse_base, pop @common; | ||||
475 | } | ||||
476 | } | ||||
477 | } | ||||
478 | 141 | 925µs | 282 | 692µs | my $result_dirs = $self->catdir( @reverse_base, @pathchunks ); # spent 597µs making 141 calls to File::Spec::Unix::catdir, avg 4µs/call
# spent 95µs making 141 calls to File::Spec::Unix::canonpath, avg 672ns/call |
479 | 141 | 4.42ms | 282 | 472µs | return $self->canonpath( $self->catpath('', $result_dirs, '') ); # spent 356µs making 141 calls to File::Spec::Unix::catpath, avg 3µs/call
# spent 116µs making 141 calls to File::Spec::Unix::canonpath, avg 825ns/call |
480 | } | ||||
481 | |||||
482 | sub _same { | ||||
483 | 1833 | 2.99ms | $_[1] eq $_[2]; | ||
484 | } | ||||
485 | |||||
486 | =item rel2abs() | ||||
487 | |||||
488 | Converts a relative path to an absolute path. | ||||
489 | |||||
490 | $abs_path = File::Spec->rel2abs( $path ) ; | ||||
491 | $abs_path = File::Spec->rel2abs( $path, $base ) ; | ||||
492 | |||||
493 | If $base is not present or '', then L<cwd()|Cwd> is used. If $base is | ||||
494 | relative, then it is converted to absolute form using | ||||
495 | L</rel2abs()>. This means that it is taken to be relative to | ||||
496 | L<cwd()|Cwd>. | ||||
497 | |||||
498 | On systems that have a grammar that indicates filenames, this ignores | ||||
499 | the $base filename. Otherwise all path components are assumed to be | ||||
500 | directories. | ||||
501 | |||||
502 | If $path is absolute, it is cleaned up and returned using L</canonpath()>. | ||||
503 | |||||
504 | No checks against the filesystem are made. On VMS, there is | ||||
505 | interaction with the working environment, as logicals and | ||||
506 | macros are expanded. | ||||
507 | |||||
508 | Based on code written by Shigio Yamaguchi. | ||||
509 | |||||
510 | =cut | ||||
511 | |||||
512 | # spent 2.46ms (1.31+1.15) within File::Spec::Unix::rel2abs which was called 282 times, avg 9µs/call:
# 282 times (1.31ms+1.15ms) by File::Spec::Unix::abs2rel at line 417, avg 9µs/call | ||||
513 | 282 | 79µs | my ($self,$path,$base ) = @_; | ||
514 | |||||
515 | # Clean up $path | ||||
516 | 282 | 258µs | 282 | 853µs | if ( ! $self->file_name_is_absolute( $path ) ) { # spent 853µs making 282 calls to File::Spec::Unix::file_name_is_absolute, avg 3µs/call |
517 | # Figure out the effective $base and clean it up. | ||||
518 | if ( !defined( $base ) || $base eq '' ) { | ||||
519 | $base = $self->_cwd(); | ||||
520 | } | ||||
521 | elsif ( ! $self->file_name_is_absolute( $base ) ) { | ||||
522 | $base = $self->rel2abs( $base ) ; | ||||
523 | } | ||||
524 | else { | ||||
525 | $base = $self->canonpath( $base ) ; | ||||
526 | } | ||||
527 | |||||
528 | # Glom them together | ||||
529 | $path = $self->catdir( $base, $path ) ; | ||||
530 | } | ||||
531 | |||||
532 | 282 | 1.12ms | 282 | 298µs | return $self->canonpath( $path ) ; # spent 298µs making 282 calls to File::Spec::Unix::canonpath, avg 1µs/call |
533 | } | ||||
534 | |||||
535 | =back | ||||
536 | |||||
537 | =head1 COPYRIGHT | ||||
538 | |||||
539 | Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. | ||||
540 | |||||
541 | This program is free software; you can redistribute it and/or modify | ||||
542 | it under the same terms as Perl itself. | ||||
543 | |||||
544 | Please submit bug reports and patches to perlbug@perl.org. | ||||
545 | |||||
546 | =head1 SEE ALSO | ||||
547 | |||||
548 | L<File::Spec> | ||||
549 | |||||
550 | =cut | ||||
551 | |||||
552 | # Internal routine to File::Spec, no point in making this public since | ||||
553 | # it is the standard Cwd interface. Most of the platform-specific | ||||
554 | # File::Spec subclasses use this. | ||||
555 | sub _cwd { | ||||
556 | require Cwd; | ||||
557 | Cwd::getcwd(); | ||||
558 | } | ||||
559 | |||||
560 | |||||
561 | # Internal method to reduce xx\..\yy -> yy | ||||
562 | sub _collapse { | ||||
563 | my($fs, $path) = @_; | ||||
564 | |||||
565 | my $updir = $fs->updir; | ||||
566 | my $curdir = $fs->curdir; | ||||
567 | |||||
568 | my($vol, $dirs, $file) = $fs->splitpath($path); | ||||
569 | my @dirs = $fs->splitdir($dirs); | ||||
570 | pop @dirs if @dirs && $dirs[-1] eq ''; | ||||
571 | |||||
572 | my @collapsed; | ||||
573 | foreach my $dir (@dirs) { | ||||
574 | if( $dir eq $updir and # if we have an updir | ||||
575 | @collapsed and # and something to collapse | ||||
576 | length $collapsed[-1] and # and its not the rootdir | ||||
577 | $collapsed[-1] ne $updir and # nor another updir | ||||
578 | $collapsed[-1] ne $curdir # nor the curdir | ||||
579 | ) | ||||
580 | { # then | ||||
581 | pop @collapsed; # collapse | ||||
582 | } | ||||
583 | else { # else | ||||
584 | push @collapsed, $dir; # just hang onto it | ||||
585 | } | ||||
586 | } | ||||
587 | |||||
588 | return $fs->catpath($vol, | ||||
589 | $fs->catdir(@collapsed), | ||||
590 | $file | ||||
591 | ); | ||||
592 | } | ||||
593 | |||||
594 | |||||
595 | 1 | 8µs | 1; | ||
# spent 1.29ms within File::Spec::Unix::CORE:match which was called 1028 times, avg 1µs/call:
# 564 times (327µs+0s) by File::Spec::Unix::file_name_is_absolute at line 256, avg 580ns/call
# 267 times (907µs+0s) by File::Spec::Unix::splitpath at line 313, avg 3µs/call
# 197 times (53µs+0s) by File::Spec::Unix::no_upwards at line 231, avg 270ns/call | |||||
# spent 10µs within File::Spec::Unix::_fn_catdir which was called 5 times, avg 2µs/call:
# 5 times (10µs+0s) by Module::Pluggable::Object::search_paths at line 181 of Module/Pluggable/Object.pm, avg 2µs/call | |||||
# spent 1.58ms within File::Spec::Unix::canonpath which was called 1646 times, avg 962ns/call:
# 475 times (499µs+0s) by Path::Tiny::path at line 224 of Path/Tiny.pm, avg 1µs/call
# 322 times (208µs+0s) by File::Spec::Unix::catdir or File::Spec::Unix::catfile at line 1105 of Perl/Critic/Utils.pm, avg 645ns/call
# 282 times (364µs+0s) by File::Spec::Unix::abs2rel at line 411, avg 1µs/call
# 282 times (298µs+0s) by File::Spec::Unix::rel2abs at line 532, avg 1µs/call
# 141 times (116µs+0s) by File::Spec::Unix::abs2rel at line 479, avg 825ns/call
# 141 times (95µs+0s) by File::Spec::Unix::catdir at line 478, avg 672ns/call
# 2 times (2µs+0s) by File::Spec::Unix::catdir at line 187 of File/ShareDir.pm, avg 950ns/call
# once (800ns+0s) by File::Spec::Unix::catdir at line 180 of File/ShareDir.pm | |||||
# spent 1.13ms (930µs+197µs) within File::Spec::Unix::catdir which was called 305 times, avg 4µs/call:
# 161 times (413µs+99µs) by File::Spec::Unix::catfile at line 1105 of Perl/Critic/Utils.pm, avg 3µs/call
# 141 times (503µs+95µs) by File::Spec::Unix::abs2rel at line 478, avg 4µs/call
# 2 times (8µs+2µs) by File::ShareDir::_dist_dir_new at line 187 of File/ShareDir.pm, avg 5µs/call
# once (7µs+800ns) by File::ShareDir::_dist_dir_new at line 180 of File/ShareDir.pm | |||||
# spent 1.41ms (791µs+621µs) within File::Spec::Unix::catfile which was called 161 times, avg 9µs/call:
# 161 times (791µs+621µs) by Perl::Critic::Utils::all_perl_files at line 1105 of Perl/Critic/Utils.pm, avg 9µs/call |