Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/File/Spec/Unix.pm |
Statements | Executed 8588 statements in 11.4ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
45 | 1 | 1 | 3.50ms | 8.82ms | abs2rel | File::Spec::Unix::
322 | 5 | 1 | 3.16ms | 3.72ms | canonpath | File::Spec::Unix::
1928 | 6 | 1 | 562µs | 562µs | CORE:subst (opcode) | File::Spec::Unix::
630 | 2 | 1 | 543µs | 543µs | _same | File::Spec::Unix::
182 | 3 | 2 | 468µs | 575µs | file_name_is_absolute | File::Spec::Unix::
90 | 1 | 1 | 405µs | 1.64ms | rel2abs | File::Spec::Unix::
180 | 4 | 1 | 358µs | 358µs | splitpath | File::Spec::Unix::
93 | 7 | 3 | 297µs | 1.46ms | catdir | File::Spec::Unix::
131 | 3 | 2 | 273µs | 273µs | splitdir | File::Spec::Unix::
41 | 1 | 1 | 108µs | 108µs | catpath | File::Spec::Unix::
182 | 1 | 1 | 107µs | 107µs | CORE:match (opcode) | File::Spec::Unix::
8 | 3 | 3 | 80µs | 329µs | catfile | File::Spec::Unix::
50 | 3 | 3 | 47µs | 47µs | curdir | File::Spec::Unix::
45 | 1 | 1 | 40µs | 40µs | rootdir | File::Spec::Unix::
41 | 1 | 1 | 37µs | 37µs | updir | File::Spec::Unix::
1 | 1 | 1 | 11µs | 13µs | BEGIN@3 | File::Spec::Unix::
1 | 1 | 1 | 7µs | 21µs | BEGIN@149 | File::Spec::Unix::
1 | 1 | 1 | 5µs | 20µs | BEGIN@4 | 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 | _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 | no_upwards | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | path | File::Spec::Unix::
0 | 0 | 0 | 0s | 0s | tmpdir | File::Spec::Unix::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::Spec::Unix; | ||||
2 | |||||
3 | 3 | 18µs | 2 | 15µs | # spent 13µs (11+2) within File::Spec::Unix::BEGIN@3 which was called:
# once (11µs+2µs) by Log::Log4perl::Util::BEGIN@3 at line 3 # spent 13µs making 1 call to File::Spec::Unix::BEGIN@3
# spent 2µs making 1 call to strict::import |
4 | 3 | 364µs | 2 | 35µs | # spent 20µs (5+15) within File::Spec::Unix::BEGIN@4 which was called:
# once (5µs+15µs) by Log::Log4perl::Util::BEGIN@3 at line 4 # spent 20µs making 1 call to File::Spec::Unix::BEGIN@4
# spent 15µs making 1 call to vars::import |
5 | |||||
6 | 1 | 500ns | $VERSION = '3.33'; | ||
7 | 1 | 14µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
8 | |||||
9 | =head1 NAME | ||||
10 | |||||
11 | File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules | ||||
12 | |||||
13 | =head1 SYNOPSIS | ||||
14 | |||||
15 | require File::Spec::Unix; # Done automatically by File::Spec | ||||
16 | |||||
17 | =head1 DESCRIPTION | ||||
18 | |||||
19 | Methods for manipulating file specifications. Other File::Spec | ||||
20 | modules, such as File::Spec::Mac, inherit from File::Spec::Unix and | ||||
21 | override specific methods. | ||||
22 | |||||
23 | =head1 METHODS | ||||
24 | |||||
25 | =over 2 | ||||
26 | |||||
27 | =item canonpath() | ||||
28 | |||||
29 | No physical check on the filesystem, but a logical cleanup of a | ||||
30 | path. On UNIX eliminates successive slashes and successive "/.". | ||||
31 | |||||
32 | $cpath = File::Spec->canonpath( $path ) ; | ||||
33 | |||||
34 | Note that this does *not* collapse F<x/../y> sections into F<y>. This | ||||
35 | is by design. If F</foo> on your system is a symlink to F</bar/baz>, | ||||
36 | then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive | ||||
37 | F<../>-removal would give you. If you want to do this kind of | ||||
38 | processing, you probably want C<Cwd>'s C<realpath()> function to | ||||
39 | actually traverse the filesystem cleaning up paths like this. | ||||
40 | |||||
41 | =cut | ||||
42 | |||||
43 | # spent 3.72ms (3.16+562µs) within File::Spec::Unix::canonpath which was called 322 times, avg 12µs/call:
# 93 times (955µs+207µs) by File::Spec::Unix::catdir at line 86, avg 12µs/call
# 90 times (867µs+140µs) by File::Spec::Unix::abs2rel at line 363, avg 11µs/call
# 90 times (843µs+132µs) by File::Spec::Unix::rel2abs at line 460, avg 11µs/call
# 41 times (382µs+66µs) by File::Spec::Unix::abs2rel at line 407, avg 11µs/call
# 8 times (111µs+17µs) by File::Spec::Unix::catfile at line 98, avg 16µs/call | ||||
44 | 322 | 134µs | my ($self,$path) = @_; | ||
45 | 322 | 46µs | return unless defined $path; | ||
46 | |||||
47 | # Handle POSIX-style node names beginning with double slash (qnx, nto) | ||||
48 | # (POSIX says: "a pathname that begins with two successive slashes | ||||
49 | # may be interpreted in an implementation-defined manner, although | ||||
50 | # more than two leading slashes shall be treated as a single slash.") | ||||
51 | 322 | 67µs | my $node = ''; | ||
52 | 322 | 216µs | my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto'; | ||
53 | |||||
54 | |||||
55 | 322 | 51µs | if ( $double_slashes_special | ||
56 | && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) { | ||||
57 | $node = $1; | ||||
58 | } | ||||
59 | # This used to be | ||||
60 | # $path =~ s|/+|/|g unless ($^O eq 'cygwin'); | ||||
61 | # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail | ||||
62 | # (Mainly because trailing "" directories didn't get stripped). | ||||
63 | # Why would cygwin avoid collapsing multiple slashes into one? --jhi | ||||
64 | 322 | 558µs | 322 | 127µs | $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx # spent 127µs making 322 calls to File::Spec::Unix::CORE:subst, avg 395ns/call |
65 | 322 | 468µs | 322 | 104µs | $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx # spent 104µs making 322 calls to File::Spec::Unix::CORE:subst, avg 324ns/call |
66 | 322 | 439µs | 318 | 75µs | $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx # spent 75µs making 318 calls to File::Spec::Unix::CORE:subst, avg 237ns/call |
67 | 322 | 428µs | 322 | 83µs | $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx # spent 83µs making 322 calls to File::Spec::Unix::CORE:subst, avg 257ns/call |
68 | 322 | 403µs | 322 | 62µs | $path =~ s|^/\.\.$|/|; # /.. -> / # spent 62µs making 322 calls to File::Spec::Unix::CORE:subst, avg 193ns/call |
69 | 322 | 489µs | 322 | 110µs | $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx # spent 110µs making 322 calls to File::Spec::Unix::CORE:subst, avg 342ns/call |
70 | 322 | 625µs | return "$node$path"; | ||
71 | } | ||||
72 | |||||
73 | =item catdir() | ||||
74 | |||||
75 | Concatenate two or more directory names to form a complete path ending | ||||
76 | with a directory. But remove the trailing slash from the resulting | ||||
77 | string, because it doesn't look good, isn't necessary and confuses | ||||
78 | OS2. Of course, if this is the root directory, don't cut off the | ||||
79 | trailing slash :-) | ||||
80 | |||||
81 | =cut | ||||
82 | |||||
83 | # spent 1.46ms (297µs+1.16) within File::Spec::Unix::catdir which was called 93 times, avg 16µs/call:
# 41 times (121µs+489µs) by File::Spec::Unix::abs2rel at line 406, avg 15µs/call
# 24 times (70µs+284µs) by Module::Find::_find at line 186 of Module/Find.pm, avg 15µs/call
# 12 times (37µs+142µs) by File::ShareDir::_module_dir_new at line 261 of File/ShareDir.pm, avg 15µs/call
# 8 times (28µs+94µs) by File::Spec::Unix::catfile at line 100, avg 15µs/call
# 4 times (20µs+77µs) by Module::Find::_find at line 179 of Module/Find.pm, avg 24µs/call
# 2 times (14µs+48µs) by File::ShareDir::_module_dir_new at line 253 of File/ShareDir.pm, avg 31µs/call
# 2 times (7µs+28µs) by File::ShareDir::_module_dir_old at line 279 of File/ShareDir.pm, avg 17µs/call | ||||
84 | 93 | 29µs | my $self = shift; | ||
85 | |||||
86 | 93 | 266µs | 93 | 1.16ms | $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' # spent 1.16ms making 93 calls to File::Spec::Unix::canonpath, avg 12µs/call |
87 | } | ||||
88 | |||||
89 | =item catfile | ||||
90 | |||||
91 | Concatenate one or more directory names and a filename to form a | ||||
92 | complete path ending with a filename | ||||
93 | |||||
94 | =cut | ||||
95 | |||||
96 | # spent 329µs (80+250) within File::Spec::Unix::catfile which was called 8 times, avg 41µs/call:
# 4 times (51µs+146µs) by DBIx::Class::Schema::ddl_filename at line 1211 of DBIx/Class/Schema.pm, avg 49µs/call
# 2 times (12µs+54µs) by File::ShareDir::module_file at line 392 of File/ShareDir.pm, avg 33µs/call
# 2 times (16µs+49µs) by Class::Inspector::filename at line 164 of Class/Inspector.pm, avg 33µs/call | ||||
97 | 8 | 5µs | my $self = shift; | ||
98 | 8 | 19µs | 8 | 127µs | my $file = $self->canonpath(pop @_); # spent 127µs making 8 calls to File::Spec::Unix::canonpath, avg 16µs/call |
99 | 8 | 2µs | return $file unless @_; | ||
100 | 8 | 16µs | 8 | 122µs | my $dir = $self->catdir(@_); # spent 122µs making 8 calls to File::Spec::Unix::catdir, avg 15µs/call |
101 | 8 | 8µs | $dir .= "/" unless substr($dir,-1) eq "/"; | ||
102 | 8 | 22µs | return $dir.$file; | ||
103 | } | ||||
104 | |||||
105 | =item curdir | ||||
106 | |||||
107 | Returns a string representation of the current directory. "." on UNIX. | ||||
108 | |||||
109 | =cut | ||||
110 | |||||
111 | 50 | 79µs | # spent 47µs within File::Spec::Unix::curdir which was called 50 times, avg 946ns/call:
# 45 times (40µs+0s) by Module::Find::_wanted at line 157 of Module/Find.pm, avg 884ns/call
# 4 times (4µs+0s) by File::Spec::Unix::abs2rel at line 402, avg 1µs/call
# once (3µs+0s) by Module::Find::BEGIN@8 at line 1324 of File/Find.pm | ||
112 | |||||
113 | =item devnull | ||||
114 | |||||
115 | Returns a string representation of the null device. "/dev/null" on UNIX. | ||||
116 | |||||
117 | =cut | ||||
118 | |||||
119 | sub devnull { '/dev/null' } | ||||
120 | |||||
121 | =item rootdir | ||||
122 | |||||
123 | Returns a string representation of the root directory. "/" on UNIX. | ||||
124 | |||||
125 | =cut | ||||
126 | |||||
127 | 45 | 71µs | # spent 40µs within File::Spec::Unix::rootdir which was called 45 times, avg 878ns/call:
# 45 times (40µs+0s) by File::Spec::Unix::abs2rel at line 393, avg 878ns/call | ||
128 | |||||
129 | =item tmpdir | ||||
130 | |||||
131 | Returns a string representation of the first writable directory from | ||||
132 | the following list or the current directory if none from the list are | ||||
133 | writable: | ||||
134 | |||||
135 | $ENV{TMPDIR} | ||||
136 | /tmp | ||||
137 | |||||
138 | Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} | ||||
139 | is tainted, it is not used. | ||||
140 | |||||
141 | =cut | ||||
142 | |||||
143 | 1 | 200ns | my $tmpdir; | ||
144 | sub _tmpdir { | ||||
145 | return $tmpdir if defined $tmpdir; | ||||
146 | my $self = shift; | ||||
147 | my @dirlist = @_; | ||||
148 | { | ||||
149 | 3 | 861µs | 2 | 36µs | # spent 21µs (7+14) within File::Spec::Unix::BEGIN@149 which was called:
# once (7µs+14µs) by Log::Log4perl::Util::BEGIN@3 at line 149 # spent 21µs making 1 call to File::Spec::Unix::BEGIN@149
# spent 14µs making 1 call to strict::unimport |
150 | if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0 | ||||
151 | require Scalar::Util; | ||||
152 | @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; | ||||
153 | } | ||||
154 | } | ||||
155 | foreach (@dirlist) { | ||||
156 | next unless defined && -d && -w _; | ||||
157 | $tmpdir = $_; | ||||
158 | last; | ||||
159 | } | ||||
160 | $tmpdir = $self->curdir unless defined $tmpdir; | ||||
161 | $tmpdir = defined $tmpdir && $self->canonpath($tmpdir); | ||||
162 | return $tmpdir; | ||||
163 | } | ||||
164 | |||||
165 | sub tmpdir { | ||||
166 | return $tmpdir if defined $tmpdir; | ||||
167 | $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ); | ||||
168 | } | ||||
169 | |||||
170 | =item updir | ||||
171 | |||||
172 | Returns a string representation of the parent directory. ".." on UNIX. | ||||
173 | |||||
174 | =cut | ||||
175 | |||||
176 | 41 | 64µs | # spent 37µs within File::Spec::Unix::updir which was called 41 times, avg 907ns/call:
# 41 times (37µs+0s) by File::Spec::Unix::abs2rel at line 406, avg 907ns/call | ||
177 | |||||
178 | =item no_upwards | ||||
179 | |||||
180 | Given a list of file names, strip out those that refer to a parent | ||||
181 | directory. (Does not strip symlinks, only '.', '..', and equivalents.) | ||||
182 | |||||
183 | =cut | ||||
184 | |||||
185 | sub no_upwards { | ||||
186 | my $self = shift; | ||||
187 | return grep(!/^\.{1,2}\z/s, @_); | ||||
188 | } | ||||
189 | |||||
190 | =item case_tolerant | ||||
191 | |||||
192 | Returns a true or false value indicating, respectively, that alphabetic | ||||
193 | is not or is significant when comparing file specifications. | ||||
194 | |||||
195 | =cut | ||||
196 | |||||
197 | sub case_tolerant { 0 } | ||||
198 | |||||
199 | =item file_name_is_absolute | ||||
200 | |||||
201 | Takes as argument a path and returns true if it is an absolute path. | ||||
202 | |||||
203 | This does not consult the local filesystem on Unix, Win32, OS/2 or Mac | ||||
204 | OS (Classic). It does consult the working environment for VMS (see | ||||
205 | L<File::Spec::VMS/file_name_is_absolute>). | ||||
206 | |||||
207 | =cut | ||||
208 | |||||
209 | # spent 575µs (468+107) within File::Spec::Unix::file_name_is_absolute which was called 182 times, avg 3µs/call:
# 90 times (241µs+60µs) by File::Spec::Unix::abs2rel at line 365, avg 3µs/call
# 90 times (213µs+47µs) by File::Spec::Unix::rel2abs at line 444, avg 3µs/call
# 2 times (14µs+1µs) by File::ShareDir::_FILE at line 538 of File/ShareDir.pm, avg 8µs/call | ||||
210 | 182 | 62µs | my ($self,$file) = @_; | ||
211 | 182 | 636µs | 182 | 107µs | return scalar($file =~ m:^/:s); # spent 107µs making 182 calls to File::Spec::Unix::CORE:match, avg 590ns/call |
212 | } | ||||
213 | |||||
214 | =item path | ||||
215 | |||||
216 | Takes no argument, returns the environment variable PATH as an array. | ||||
217 | |||||
218 | =cut | ||||
219 | |||||
220 | sub path { | ||||
221 | return () unless exists $ENV{PATH}; | ||||
222 | my @path = split(':', $ENV{PATH}); | ||||
223 | foreach (@path) { $_ = '.' if $_ eq '' } | ||||
224 | return @path; | ||||
225 | } | ||||
226 | |||||
227 | =item join | ||||
228 | |||||
229 | join is the same as catfile. | ||||
230 | |||||
231 | =cut | ||||
232 | |||||
233 | sub join { | ||||
234 | my $self = shift; | ||||
235 | return $self->catfile(@_); | ||||
236 | } | ||||
237 | |||||
238 | =item splitpath | ||||
239 | |||||
240 | ($volume,$directories,$file) = File::Spec->splitpath( $path ); | ||||
241 | ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); | ||||
242 | |||||
243 | Splits a path into volume, directory, and filename portions. On systems | ||||
244 | with no concept of volume, returns '' for volume. | ||||
245 | |||||
246 | For systems with no syntax differentiating filenames from directories, | ||||
247 | assumes that the last file is a path unless $no_file is true or a | ||||
248 | trailing separator or /. or /.. is present. On Unix this means that $no_file | ||||
249 | true makes this return ( '', $path, '' ). | ||||
250 | |||||
251 | The directory portion may or may not be returned with a trailing '/'. | ||||
252 | |||||
253 | The results can be passed to L</catpath()> to get back a path equivalent to | ||||
254 | (usually identical to) the original path. | ||||
255 | |||||
256 | =cut | ||||
257 | |||||
258 | # spent 358µs within File::Spec::Unix::splitpath which was called 180 times, avg 2µs/call:
# 45 times (103µs+0s) by File::Spec::Unix::abs2rel at line 373, avg 2µs/call
# 45 times (87µs+0s) by File::Spec::Unix::abs2rel at line 374, avg 2µs/call
# 45 times (84µs+0s) by File::Spec::Unix::abs2rel at line 380, avg 2µs/call
# 45 times (84µs+0s) by File::Spec::Unix::abs2rel at line 379, avg 2µs/call | ||||
259 | 180 | 71µs | my ($self,$path, $nofile) = @_; | ||
260 | |||||
261 | 180 | 57µs | my ($volume,$directory,$file) = ('','',''); | ||
262 | |||||
263 | 180 | 40µs | if ( $nofile ) { | ||
264 | $directory = $path; | ||||
265 | } | ||||
266 | else { | ||||
267 | $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; | ||||
268 | $directory = $1; | ||||
269 | $file = $2; | ||||
270 | } | ||||
271 | |||||
272 | 180 | 318µs | return ($volume,$directory,$file); | ||
273 | } | ||||
274 | |||||
275 | |||||
276 | =item splitdir | ||||
277 | |||||
278 | The opposite of L</catdir()>. | ||||
279 | |||||
280 | @dirs = File::Spec->splitdir( $directories ); | ||||
281 | |||||
282 | $directories must be only the directory portion of the path on systems | ||||
283 | that have the concept of a volume or that have path syntax that differentiates | ||||
284 | files from directories. | ||||
285 | |||||
286 | Unlike just splitting the directories on the separator, empty | ||||
287 | directory names (C<''>) can be returned, because these are significant | ||||
288 | on some OSs. | ||||
289 | |||||
290 | On Unix, | ||||
291 | |||||
292 | File::Spec->splitdir( "/a/b//c/" ); | ||||
293 | |||||
294 | Yields: | ||||
295 | |||||
296 | ( '', 'a', 'b', '', 'c', '' ) | ||||
297 | |||||
298 | =cut | ||||
299 | |||||
300 | # spent 273µs within File::Spec::Unix::splitdir which was called 131 times, avg 2µs/call:
# 45 times (126µs+0s) by File::Spec::Unix::abs2rel at line 390, avg 3µs/call
# 45 times (97µs+0s) by File::Spec::Unix::abs2rel at line 391, avg 2µs/call
# 41 times (51µs+0s) by Module::Find::_wanted at line 167 of Module/Find.pm, avg 1µs/call | ||||
301 | 131 | 374µs | return split m|/|, $_[1], -1; # Preserve trailing fields | ||
302 | } | ||||
303 | |||||
304 | |||||
305 | =item catpath() | ||||
306 | |||||
307 | Takes volume, directory and file portions and returns an entire path. Under | ||||
308 | Unix, $volume is ignored, and directory and file are concatenated. A '/' is | ||||
309 | inserted if needed (though if the directory portion doesn't start with | ||||
310 | '/' it is not added). On other OSs, $volume is significant. | ||||
311 | |||||
312 | =cut | ||||
313 | |||||
314 | # spent 108µs within File::Spec::Unix::catpath which was called 41 times, avg 3µs/call:
# 41 times (108µs+0s) by File::Spec::Unix::abs2rel at line 407, avg 3µs/call | ||||
315 | 41 | 27µs | my ($self,$volume,$directory,$file) = @_; | ||
316 | |||||
317 | 41 | 23µs | if ( $directory ne '' && | ||
318 | $file ne '' && | ||||
319 | substr( $directory, -1 ) ne '/' && | ||||
320 | substr( $file, 0, 1 ) ne '/' | ||||
321 | ) { | ||||
322 | $directory .= "/$file" ; | ||||
323 | } | ||||
324 | else { | ||||
325 | 41 | 12µs | $directory .= $file ; | ||
326 | } | ||||
327 | |||||
328 | 41 | 71µs | return $directory ; | ||
329 | } | ||||
330 | |||||
331 | =item abs2rel | ||||
332 | |||||
333 | Takes a destination path and an optional base path returns a relative path | ||||
334 | from the base path to the destination path: | ||||
335 | |||||
336 | $rel_path = File::Spec->abs2rel( $path ) ; | ||||
337 | $rel_path = File::Spec->abs2rel( $path, $base ) ; | ||||
338 | |||||
339 | If $base is not present or '', then L<cwd()|Cwd> is used. If $base is | ||||
340 | relative, then it is converted to absolute form using | ||||
341 | L</rel2abs()>. This means that it is taken to be relative to | ||||
342 | L<cwd()|Cwd>. | ||||
343 | |||||
344 | On systems that have a grammar that indicates filenames, this ignores the | ||||
345 | $base filename. Otherwise all path components are assumed to be | ||||
346 | directories. | ||||
347 | |||||
348 | If $path is relative, it is converted to absolute form using L</rel2abs()>. | ||||
349 | This means that it is taken to be relative to L<cwd()|Cwd>. | ||||
350 | |||||
351 | No checks against the filesystem are made. On VMS, there is | ||||
352 | interaction with the working environment, as logicals and | ||||
353 | macros are expanded. | ||||
354 | |||||
355 | Based on code written by Shigio Yamaguchi. | ||||
356 | |||||
357 | =cut | ||||
358 | |||||
359 | # spent 8.82ms (3.50+5.32) within File::Spec::Unix::abs2rel which was called 45 times, avg 196µs/call:
# 45 times (3.50ms+5.32ms) by Module::Find::_wanted at line 156 of Module/Find.pm, avg 196µs/call | ||||
360 | 45 | 25µs | my($self,$path,$base) = @_; | ||
361 | 45 | 14µs | $base = $self->_cwd() unless defined $base and length $base; | ||
362 | |||||
363 | 45 | 139µs | 90 | 1.01ms | ($path, $base) = map $self->canonpath($_), $path, $base; # spent 1.01ms making 90 calls to File::Spec::Unix::canonpath, avg 11µs/call |
364 | |||||
365 | 45 | 138µs | 90 | 300µs | if (grep $self->file_name_is_absolute($_), $path, $base) { # spent 300µs making 90 calls to File::Spec::Unix::file_name_is_absolute, avg 3µs/call |
366 | 45 | 134µs | 90 | 1.64ms | ($path, $base) = map $self->rel2abs($_), $path, $base; # spent 1.64ms making 90 calls to File::Spec::Unix::rel2abs, avg 18µs/call |
367 | } | ||||
368 | else { | ||||
369 | # save a couple of cwd()s if both paths are relative | ||||
370 | ($path, $base) = map $self->catdir('/', $_), $path, $base; | ||||
371 | } | ||||
372 | |||||
373 | 45 | 66µs | 45 | 103µs | my ($path_volume) = $self->splitpath($path, 1); # spent 103µs making 45 calls to File::Spec::Unix::splitpath, avg 2µs/call |
374 | 45 | 57µs | 45 | 87µs | my ($base_volume) = $self->splitpath($base, 1); # spent 87µs making 45 calls to File::Spec::Unix::splitpath, avg 2µs/call |
375 | |||||
376 | # Can't relativize across volumes | ||||
377 | 45 | 10µs | return $path unless $path_volume eq $base_volume; | ||
378 | |||||
379 | 45 | 58µs | 45 | 84µs | my $path_directories = ($self->splitpath($path, 1))[1]; # spent 84µs making 45 calls to File::Spec::Unix::splitpath, avg 2µs/call |
380 | 45 | 57µs | 45 | 84µs | my $base_directories = ($self->splitpath($base, 1))[1]; # spent 84µs making 45 calls to File::Spec::Unix::splitpath, avg 2µs/call |
381 | |||||
382 | # For UNC paths, the user might give a volume like //foo/bar that | ||||
383 | # strictly speaking has no directory portion. Treat it as if it | ||||
384 | # had the root directory for that volume. | ||||
385 | 45 | 14µs | if (!length($base_directories) and $self->file_name_is_absolute($base)) { | ||
386 | $base_directories = $self->rootdir; | ||||
387 | } | ||||
388 | |||||
389 | # Now, remove all leading components that are the same | ||||
390 | 45 | 261µs | 45 | 126µs | my @pathchunks = $self->splitdir( $path_directories ); # spent 126µs making 45 calls to File::Spec::Unix::splitdir, avg 3µs/call |
391 | 45 | 226µs | 45 | 97µs | my @basechunks = $self->splitdir( $base_directories ); # spent 97µs making 45 calls to File::Spec::Unix::splitdir, avg 2µs/call |
392 | |||||
393 | 45 | 56µs | 45 | 40µs | if ($base_directories eq $self->rootdir) { # spent 40µs making 45 calls to File::Spec::Unix::rootdir, avg 878ns/call |
394 | shift @pathchunks; | ||||
395 | return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); | ||||
396 | } | ||||
397 | |||||
398 | 45 | 81µs | 45 | 45µs | while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { # spent 45µs making 45 calls to File::Spec::Unix::_same, avg 1µs/call |
399 | 630 | 116µs | shift @pathchunks ; | ||
400 | 630 | 885µs | 585 | 497µs | shift @basechunks ; # spent 497µs making 585 calls to File::Spec::Unix::_same, avg 850ns/call |
401 | } | ||||
402 | 45 | 25µs | 4 | 4µs | return $self->curdir unless @pathchunks || @basechunks; # spent 4µs making 4 calls to File::Spec::Unix::curdir, avg 1µs/call |
403 | |||||
404 | # $base now contains the directories the resulting relative path | ||||
405 | # must ascend out of before it can descend to $path_directory. | ||||
406 | 41 | 108µs | 82 | 647µs | my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks ); # spent 610µs making 41 calls to File::Spec::Unix::catdir, avg 15µs/call
# spent 37µs making 41 calls to File::Spec::Unix::updir, avg 907ns/call |
407 | 41 | 160µs | 82 | 557µs | return $self->canonpath( $self->catpath('', $result_dirs, '') ); # spent 448µs making 41 calls to File::Spec::Unix::canonpath, avg 11µs/call
# spent 108µs making 41 calls to File::Spec::Unix::catpath, avg 3µs/call |
408 | } | ||||
409 | |||||
410 | sub _same { | ||||
411 | 630 | 942µs | $_[1] eq $_[2]; | ||
412 | } | ||||
413 | |||||
414 | =item rel2abs() | ||||
415 | |||||
416 | Converts a relative path to an absolute path. | ||||
417 | |||||
418 | $abs_path = File::Spec->rel2abs( $path ) ; | ||||
419 | $abs_path = File::Spec->rel2abs( $path, $base ) ; | ||||
420 | |||||
421 | If $base is not present or '', then L<cwd()|Cwd> is used. If $base is | ||||
422 | relative, then it is converted to absolute form using | ||||
423 | L</rel2abs()>. This means that it is taken to be relative to | ||||
424 | L<cwd()|Cwd>. | ||||
425 | |||||
426 | On systems that have a grammar that indicates filenames, this ignores | ||||
427 | the $base filename. Otherwise all path components are assumed to be | ||||
428 | directories. | ||||
429 | |||||
430 | If $path is absolute, it is cleaned up and returned using L</canonpath()>. | ||||
431 | |||||
432 | No checks against the filesystem are made. On VMS, there is | ||||
433 | interaction with the working environment, as logicals and | ||||
434 | macros are expanded. | ||||
435 | |||||
436 | Based on code written by Shigio Yamaguchi. | ||||
437 | |||||
438 | =cut | ||||
439 | |||||
440 | # spent 1.64ms (405µs+1.23) within File::Spec::Unix::rel2abs which was called 90 times, avg 18µs/call:
# 90 times (405µs+1.23ms) by File::Spec::Unix::abs2rel at line 366, avg 18µs/call | ||||
441 | 90 | 43µs | my ($self,$path,$base ) = @_; | ||
442 | |||||
443 | # Clean up $path | ||||
444 | 90 | 90µs | 90 | 260µs | if ( ! $self->file_name_is_absolute( $path ) ) { # spent 260µs making 90 calls to File::Spec::Unix::file_name_is_absolute, avg 3µs/call |
445 | # Figure out the effective $base and clean it up. | ||||
446 | if ( !defined( $base ) || $base eq '' ) { | ||||
447 | $base = $self->_cwd(); | ||||
448 | } | ||||
449 | elsif ( ! $self->file_name_is_absolute( $base ) ) { | ||||
450 | $base = $self->rel2abs( $base ) ; | ||||
451 | } | ||||
452 | else { | ||||
453 | $base = $self->canonpath( $base ) ; | ||||
454 | } | ||||
455 | |||||
456 | # Glom them together | ||||
457 | $path = $self->catdir( $base, $path ) ; | ||||
458 | } | ||||
459 | |||||
460 | 90 | 207µs | 90 | 975µs | return $self->canonpath( $path ) ; # spent 975µs making 90 calls to File::Spec::Unix::canonpath, avg 11µs/call |
461 | } | ||||
462 | |||||
463 | =back | ||||
464 | |||||
465 | =head1 COPYRIGHT | ||||
466 | |||||
467 | Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. | ||||
468 | |||||
469 | This program is free software; you can redistribute it and/or modify | ||||
470 | it under the same terms as Perl itself. | ||||
471 | |||||
472 | =head1 SEE ALSO | ||||
473 | |||||
474 | L<File::Spec> | ||||
475 | |||||
476 | =cut | ||||
477 | |||||
478 | # Internal routine to File::Spec, no point in making this public since | ||||
479 | # it is the standard Cwd interface. Most of the platform-specific | ||||
480 | # File::Spec subclasses use this. | ||||
481 | sub _cwd { | ||||
482 | require Cwd; | ||||
483 | Cwd::getcwd(); | ||||
484 | } | ||||
485 | |||||
486 | |||||
487 | # Internal method to reduce xx\..\yy -> yy | ||||
488 | sub _collapse { | ||||
489 | my($fs, $path) = @_; | ||||
490 | |||||
491 | my $updir = $fs->updir; | ||||
492 | my $curdir = $fs->curdir; | ||||
493 | |||||
494 | my($vol, $dirs, $file) = $fs->splitpath($path); | ||||
495 | my @dirs = $fs->splitdir($dirs); | ||||
496 | pop @dirs if @dirs && $dirs[-1] eq ''; | ||||
497 | |||||
498 | my @collapsed; | ||||
499 | foreach my $dir (@dirs) { | ||||
500 | if( $dir eq $updir and # if we have an updir | ||||
501 | @collapsed and # and something to collapse | ||||
502 | length $collapsed[-1] and # and its not the rootdir | ||||
503 | $collapsed[-1] ne $updir and # nor another updir | ||||
504 | $collapsed[-1] ne $curdir # nor the curdir | ||||
505 | ) | ||||
506 | { # then | ||||
507 | pop @collapsed; # collapse | ||||
508 | } | ||||
509 | else { # else | ||||
510 | push @collapsed, $dir; # just hang onto it | ||||
511 | } | ||||
512 | } | ||||
513 | |||||
514 | return $fs->catpath($vol, | ||||
515 | $fs->catdir(@collapsed), | ||||
516 | $file | ||||
517 | ); | ||||
518 | } | ||||
519 | |||||
520 | |||||
521 | 1 | 3µs | 1; | ||
# spent 107µs within File::Spec::Unix::CORE:match which was called 182 times, avg 590ns/call:
# 182 times (107µs+0s) by File::Spec::Unix::file_name_is_absolute at line 211, avg 590ns/call | |||||
# spent 562µs within File::Spec::Unix::CORE:subst which was called 1928 times, avg 291ns/call:
# 322 times (127µs+0s) by File::Spec::Unix::canonpath at line 64, avg 395ns/call
# 322 times (110µs+0s) by File::Spec::Unix::canonpath at line 69, avg 342ns/call
# 322 times (104µs+0s) by File::Spec::Unix::canonpath at line 65, avg 324ns/call
# 322 times (83µs+0s) by File::Spec::Unix::canonpath at line 67, avg 257ns/call
# 322 times (62µs+0s) by File::Spec::Unix::canonpath at line 68, avg 193ns/call
# 318 times (75µs+0s) by File::Spec::Unix::canonpath at line 66, avg 237ns/call |