← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:45:27 2015

Filename/Users/ap13/perl5/lib/perl5/darwin-2level/File/Spec/Unix.pm
StatementsExecuted 79 statements in 2.21ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
92298µs154µsFile::Spec::Unix::::catfileFile::Spec::Unix::catfile (xsub)
114353µs63µsFile::Spec::Unix::::catdirFile::Spec::Unix::catdir (xsub)
11133µs63µsFile::Spec::Unix::::_tmpdirFile::Spec::Unix::_tmpdir
215431µs31µsFile::Spec::Unix::::canonpathFile::Spec::Unix::canonpath (xsub)
33228µs28µsFile::Spec::Unix::::splitpathFile::Spec::Unix::splitpath
11122µs99µsFile::Spec::Unix::::tmpdirFile::Spec::Unix::tmpdir
33216µs16µsFile::Spec::Unix::::splitdirFile::Spec::Unix::splitdir
32215µs15µsFile::Spec::Unix::::curdirFile::Spec::Unix::curdir
22214µs17µsFile::Spec::Unix::::file_name_is_absoluteFile::Spec::Unix::file_name_is_absolute
11114µs27µsFile::Spec::Unix::::BEGIN@3File::Spec::Unix::BEGIN@3
11111µs64µsFile::Spec::Unix::::BEGIN@127File::Spec::Unix::BEGIN@127
2119µs9µsFile::Spec::Unix::::updirFile::Spec::Unix::updir
1119µs38µsFile::Spec::Unix::::BEGIN@242File::Spec::Unix::BEGIN@242
1118µs20µsFile::Spec::Unix::::BEGIN@179File::Spec::Unix::BEGIN@179
1118µs8µsFile::Spec::Unix::::_cache_tmpdirFile::Spec::Unix::_cache_tmpdir
1118µs36µsFile::Spec::Unix::::BEGIN@220File::Spec::Unix::BEGIN@220
1118µs35µsFile::Spec::Unix::::BEGIN@136File::Spec::Unix::BEGIN@136
1117µs7µsFile::Spec::Unix::::CORE:ftdirFile::Spec::Unix::CORE:ftdir (opcode)
1117µs31µsFile::Spec::Unix::::BEGIN@145File::Spec::Unix::BEGIN@145
1117µs25µsFile::Spec::Unix::::BEGIN@4File::Spec::Unix::BEGIN@4
1116µs6µsFile::Spec::Unix::::_cached_tmpdirFile::Spec::Unix::_cached_tmpdir
1115µs5µsFile::Spec::Unix::::catpathFile::Spec::Unix::catpath
2113µs3µsFile::Spec::Unix::::CORE:matchFile::Spec::Unix::CORE:match (opcode)
1112µs2µsFile::Spec::Unix::::rootdirFile::Spec::Unix::rootdir
1111µs1µsFile::Spec::Unix::::CORE:ftewriteFile::Spec::Unix::CORE:ftewrite (opcode)
0000s0sFile::Spec::Unix::::_collapseFile::Spec::Unix::_collapse
0000s0sFile::Spec::Unix::::_cwdFile::Spec::Unix::_cwd
0000s0sFile::Spec::Unix::::_pp_canonpathFile::Spec::Unix::_pp_canonpath
0000s0sFile::Spec::Unix::::_pp_catdirFile::Spec::Unix::_pp_catdir
0000s0sFile::Spec::Unix::::_pp_catfileFile::Spec::Unix::_pp_catfile
0000s0sFile::Spec::Unix::::_sameFile::Spec::Unix::_same
0000s0sFile::Spec::Unix::::abs2relFile::Spec::Unix::abs2rel
0000s0sFile::Spec::Unix::::case_tolerantFile::Spec::Unix::case_tolerant
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
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
3226µs240µs
# spent 27µs (14+13) within File::Spec::Unix::BEGIN@3 which was called: # once (14µs+13µs) by File::Copy::BEGIN@13 at line 3
use strict;
# spent 27µs making 1 call to File::Spec::Unix::BEGIN@3 # spent 13µs making 1 call to strict::import
42427µs244µs
# spent 25µs (7+18) within File::Spec::Unix::BEGIN@4 which was called: # once (7µs+18µs) by File::Copy::BEGIN@13 at line 4
use vars qw($VERSION);
# spent 25µs making 1 call to File::Spec::Unix::BEGIN@4 # spent 18µs making 1 call to vars::import
5
61700ns$VERSION = '3.47';
71300nsmy $xs_version = $VERSION;
81400ns$VERSION =~ tr/_//;
9
1014µsunless (defined &canonpath) {
111300ns eval {
1212µs if ( $] >= 5.006 ) {
131700ns require XSLoader;
14164µs156µs XSLoader::load("Cwd", $xs_version);
# spent 56µs making 1 call to XSLoader::load
15 } else {
16 require Cwd;
17 }
18 };
19}
20
21=head1 NAME
22
23File::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
31Methods for manipulating file specifications. Other File::Spec
32modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
33override specific methods.
34
35=head1 METHODS
36
37=over 2
38
39=item canonpath()
40
41No physical check on the filesystem, but a logical cleanup of a
42path. On UNIX eliminates successive slashes and successive "/.".
43
44 $cpath = File::Spec->canonpath( $path ) ;
45
46Note that this does *not* collapse F<x/../y> sections into F<y>. This
47is by design. If F</foo> on your system is a symlink to F</bar/baz>,
48then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
49F<../>-removal would give you. If you want to do this kind of
50processing, you probably want C<Cwd>'s C<realpath()> function to
51actually traverse the filesystem cleaning up paths like this.
52
53=cut
54
55sub _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}
841300ns*canonpath = \&_pp_canonpath unless defined &canonpath;
85
86=item catdir()
87
88Concatenate two or more directory names to form a complete path ending
89with a directory. But remove the trailing slash from the resulting
90string, because it doesn't look good, isn't necessary and confuses
91OS2. Of course, if this is the root directory, don't cut off the
92trailing slash :-)
93
94=cut
95
96sub _pp_catdir {
97 my $self = shift;
98
99 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
100}
1011100ns*catdir = \&_pp_catdir unless defined &catdir;
102
103=item catfile
104
105Concatenate one or more directory names and a filename to form a
106complete path ending with a filename
107
108=cut
109
110sub _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}
1181200ns*catfile = \&_pp_catfile unless defined &catfile;
119
120=item curdir
121
122Returns a string representation of the current directory. "." on UNIX.
123
124=cut
125
126319µs
# spent 15µs within File::Spec::Unix::curdir which was called 3 times, avg 5µs/call: # 2 times (13µs+0s) by File::Path::_rmtree at line 262 of File/Path.pm, avg 7µs/call # once (2µs+0s) by File::Find::Rule::BEGIN@9 at line 1094 of File/Find.pm
sub curdir { '.' }
127263µs2116µs
# spent 64µs (11+52) within File::Spec::Unix::BEGIN@127 which was called: # once (11µs+52µs) by File::Copy::BEGIN@13 at line 127
use constant _fn_curdir => ".";
# spent 64µs making 1 call to File::Spec::Unix::BEGIN@127 # spent 52µs making 1 call to constant::import
128
129=item devnull
130
131Returns a string representation of the null device. "/dev/null" on UNIX.
132
133=cut
134
135sub devnull { '/dev/null' }
136237µs262µs
# spent 35µs (8+27) within File::Spec::Unix::BEGIN@136 which was called: # once (8µs+27µs) by File::Copy::BEGIN@13 at line 136
use constant _fn_devnull => "/dev/null";
# spent 35µs making 1 call to File::Spec::Unix::BEGIN@136 # spent 27µs making 1 call to constant::import
137
138=item rootdir
139
140Returns a string representation of the root directory. "/" on UNIX.
141
142=cut
143
14414µs
# spent 2µs within File::Spec::Unix::rootdir which was called: # once (2µs+0s) by Bio::Root::IO::BEGIN@75 at line 113 of Bio/Root/IO.pm
sub rootdir { '/' }
1452127µs255µs
# spent 31µs (7+24) within File::Spec::Unix::BEGIN@145 which was called: # once (7µs+24µs) by File::Copy::BEGIN@13 at line 145
use constant _fn_rootdir => "/";
# spent 31µs making 1 call to File::Spec::Unix::BEGIN@145 # spent 24µs making 1 call to constant::import
146
147=item tmpdir
148
149Returns a string representation of the first writable directory from
150the following list or the current directory if none from the list are
151writable:
152
153 $ENV{TMPDIR}
154 /tmp
155
156If running under taint mode, and if $ENV{TMPDIR}
157is tainted, it is not used.
158
159=cut
160
1611300nsmy ($tmpdir, %tmpenv);
162# Cache and return the calculated tmpdir, recording which env vars
163# determined it.
164
# spent 8µs within File::Spec::Unix::_cache_tmpdir which was called: # once (8µs+0s) by File::Spec::Unix::tmpdir at line 210
sub _cache_tmpdir {
16529µs @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
# spent 6µs within File::Spec::Unix::_cached_tmpdir which was called: # once (6µs+0s) by File::Spec::Unix::tmpdir at line 208
sub _cached_tmpdir {
17138µs shift;
172 local $^W;
173 return if grep $ENV{$_} ne $tmpenv{$_}, @_;
174 return $tmpdir;
175}
176
# spent 63µs (33+30) within File::Spec::Unix::_tmpdir which was called: # once (33µs+30µs) by File::Spec::Unix::tmpdir at line 210
sub _tmpdir {
1771350µs my $self = shift;
178 my @dirlist = @_;
1792258µs231µs
# spent 20µs (8+11) within File::Spec::Unix::BEGIN@179 which was called: # once (8µs+11µs) by File::Copy::BEGIN@13 at line 179
my $taint = do { no strict 'refs'; ${"\cTAINT"} };
# spent 20µs making 1 call to File::Spec::Unix::BEGIN@179 # spent 11µ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) {
18928µs next unless defined && -d && -w _;
# spent 7µs making 1 call to File::Spec::Unix::CORE:ftdir # spent 1µs making 1 call to File::Spec::Unix::CORE:ftewrite
190 $tmpdir = $_;
191 last;
192 }
193 $tmpdir = $self->curdir unless defined $tmpdir;
194111µs $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
# spent 11µs making 1 call to File::Spec::Unix::canonpath
195110µs if ( !$self->file_name_is_absolute($tmpdir) ) {
# spent 10µs making 1 call to File::Spec::Unix::file_name_is_absolute
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
# spent 99µs (22+77) within File::Spec::Unix::tmpdir which was called: # once (22µs+77µs) by Bio::Root::IO::BEGIN@75 at line 112 of Bio/Root/IO.pm
sub tmpdir {
208318µs16µs my $cached = $_[0]->_cached_tmpdir('TMPDIR');
# spent 6µs making 1 call to File::Spec::Unix::_cached_tmpdir
209 return $cached if defined $cached;
210271µs $_[0]->_cache_tmpdir($_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ), 'TMPDIR');
# spent 63µs making 1 call to File::Spec::Unix::_tmpdir # spent 8µs making 1 call to File::Spec::Unix::_cache_tmpdir
211}
212
213=item updir
214
215Returns a string representation of the parent directory. ".." on UNIX.
216
217=cut
218
21927µs
# spent 9µs within File::Spec::Unix::updir which was called 2 times, avg 5µs/call: # 2 times (9µs+0s) by File::Path::_rmtree at line 263 of File/Path.pm, avg 5µs/call
sub updir { '..' }
220292µs264µs
# spent 36µs (8+28) within File::Spec::Unix::BEGIN@220 which was called: # once (8µs+28µs) by File::Copy::BEGIN@13 at line 220
use constant _fn_updir => "..";
# spent 36µs making 1 call to File::Spec::Unix::BEGIN@220 # spent 28µs making 1 call to constant::import
221
222=item no_upwards
223
224Given a list of file names, strip out those that refer to a parent
225directory. (Does not strip symlinks, only '.', '..', and equivalents.)
226
227=cut
228
229sub no_upwards {
230 my $self = shift;
231 return grep(!/^\.{1,2}\z/s, @_);
232}
233
234=item case_tolerant
235
236Returns a true or false value indicating, respectively, that alphabetic
237is not or is significant when comparing file specifications.
238
239=cut
240
241sub case_tolerant { 0 }
2422896µs267µs
# spent 38µs (9+29) within File::Spec::Unix::BEGIN@242 which was called: # once (9µs+29µs) by File::Copy::BEGIN@13 at line 242
use constant _fn_case_tolerant => 0;
# spent 38µs making 1 call to File::Spec::Unix::BEGIN@242 # spent 29µs making 1 call to constant::import
243
244=item file_name_is_absolute
245
246Takes as argument a path and returns true if it is an absolute path.
247
248This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
249OS (Classic). It does consult the working environment for VMS (see
250L<File::Spec::VMS/file_name_is_absolute>).
251
252=cut
253
254
# spent 17µs (14+3) within File::Spec::Unix::file_name_is_absolute which was called 2 times, avg 9µs/call: # once (8µs+2µs) by File::Spec::Unix::_tmpdir at line 195 # once (6µs+1000ns) by FindBin::init at line 137 of FindBin.pm
sub file_name_is_absolute {
255423µs my ($self,$file) = @_;
25623µs return scalar($file =~ m:^/:s);
# spent 3µs making 2 calls to File::Spec::Unix::CORE:match, avg 2µs/call
257}
258
259=item path
260
261Takes no argument, returns the environment variable PATH as an array.
262
263=cut
264
265sub 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
274join is the same as catfile.
275
276=cut
277
278sub 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
289Splits a path into volume, directory, and filename portions. On systems
290with no concept of volume, returns '' for volume.
291
292For systems with no syntax differentiating filenames from directories,
293assumes that the last file is a path unless $no_file is true or a
294trailing separator or /. or /.. is present. On Unix this means that $no_file
295true makes this return ( '', $path, '' ).
296
297The directory portion may or may not be returned with a trailing '/'.
298
299The 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 28µs within File::Spec::Unix::splitpath which was called 3 times, avg 9µs/call: # once (18µs+0s) by File::Path::_is_subdir at line 172 of File/Path.pm # once (6µs+0s) by File::Temp::_gettemp at line 279 of File/Temp.pm # once (3µs+0s) by File::Path::_is_subdir at line 173 of File/Path.pm
sub splitpath {
3051228µs my ($self,$path, $nofile) = @_;
306
307 my ($volume,$directory,$file) = ('','','');
308
309 if ( $nofile ) {
310 $directory = $path;
311 }
312 else {
313 $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
314 $directory = $1;
315 $file = $2;
316 }
317
318 return ($volume,$directory,$file);
319}
320
321
322=item splitdir
323
324The 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
329that have the concept of a volume or that have path syntax that differentiates
330files from directories.
331
332Unlike just splitting the directories on the separator, empty
333directory names (C<''>) can be returned, because these are significant
334on some OSs.
335
336On Unix,
337
338 File::Spec->splitdir( "/a/b//c/" );
339
340Yields:
341
342 ( '', 'a', 'b', '', 'c', '' )
343
344=cut
345
346
# spent 16µs within File::Spec::Unix::splitdir which was called 3 times, avg 5µs/call: # once (9µs+0s) by File::Path::_is_subdir at line 178 of File/Path.pm # once (4µs+0s) by File::Temp::_gettemp at line 283 of File/Temp.pm # once (2µs+0s) by File::Path::_is_subdir at line 179 of File/Path.pm
sub splitdir {
347322µs return split m|/|, $_[1], -1; # Preserve trailing fields
348}
349
350
351=item catpath()
352
353Takes volume, directory and file portions and returns an entire path. Under
354Unix, $volume is ignored, and directory and file are concatenated. A '/' is
355inserted 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 5µs within File::Spec::Unix::catpath which was called: # once (5µs+0s) by File::Temp::_gettemp at line 300 of File/Temp.pm
sub catpath {
36146µs my ($self,$volume,$directory,$file) = @_;
362
363 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 $directory .= $file ;
372 }
373
374 return $directory ;
375}
376
377=item abs2rel
378
379Takes a destination path and an optional base path returns a relative path
380from the base path to the destination path:
381
382 $rel_path = File::Spec->abs2rel( $path ) ;
383 $rel_path = File::Spec->abs2rel( $path, $base ) ;
384
385If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
386relative, then it is converted to absolute form using
387L</rel2abs()>. This means that it is taken to be relative to
388L<cwd()|Cwd>.
389
390On systems that have a grammar that indicates filenames, this ignores the
391$base filename. Otherwise all path components are assumed to be
392directories.
393
394If $path is relative, it is converted to absolute form using L</rel2abs()>.
395This means that it is taken to be relative to L<cwd()|Cwd>.
396
397No checks against the filesystem are made, so the result may not be correct if
398C<$base> contains symbolic links. (Apply
399L<Cwd::abs_path()|Cwd/abs_path> beforehand if that
400is a concern.) On VMS, there is interaction with the working environment, as
401logicals and macros are expanded.
402
403Based on code written by Shigio Yamaguchi.
404
405=cut
406
407sub abs2rel {
408 my($self,$path,$base) = @_;
409 $base = $self->_cwd() unless defined $base and length $base;
410
411 ($path, $base) = map $self->canonpath($_), $path, $base;
412
413 my $path_directories;
414 my $base_directories;
415
416 if (grep $self->file_name_is_absolute($_), $path, $base) {
417 ($path, $base) = map $self->rel2abs($_), $path, $base;
418
419 my ($path_volume) = $self->splitpath($path, 1);
420 my ($base_volume) = $self->splitpath($base, 1);
421
422 # Can't relativize across volumes
423 return $path unless $path_volume eq $base_volume;
424
425 $path_directories = ($self->splitpath($path, 1))[1];
426 $base_directories = ($self->splitpath($base, 1))[1];
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 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 my @pathchunks = $self->splitdir( $path_directories );
443 my @basechunks = $self->splitdir( $base_directories );
444
445 if ($base_directories eq $self->rootdir) {
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 my @common;
452 while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
453 push @common, shift @pathchunks ;
454 shift @basechunks ;
455 }
456 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 my @reverse_base;
463 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 my $result_dirs = $self->catdir( @reverse_base, @pathchunks );
479 return $self->canonpath( $self->catpath('', $result_dirs, '') );
480}
481
482sub _same {
483 $_[1] eq $_[2];
484}
485
486=item rel2abs()
487
488Converts a relative path to an absolute path.
489
490 $abs_path = File::Spec->rel2abs( $path ) ;
491 $abs_path = File::Spec->rel2abs( $path, $base ) ;
492
493If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
494relative, then it is converted to absolute form using
495L</rel2abs()>. This means that it is taken to be relative to
496L<cwd()|Cwd>.
497
498On systems that have a grammar that indicates filenames, this ignores
499the $base filename. Otherwise all path components are assumed to be
500directories.
501
502If $path is absolute, it is cleaned up and returned using L</canonpath()>.
503
504No checks against the filesystem are made. On VMS, there is
505interaction with the working environment, as logicals and
506macros are expanded.
507
508Based on code written by Shigio Yamaguchi.
509
510=cut
511
512sub rel2abs {
513 my ($self,$path,$base ) = @_;
514
515 # Clean up $path
516 if ( ! $self->file_name_is_absolute( $path ) ) {
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 return $self->canonpath( $path ) ;
533}
534
535=back
536
537=head1 COPYRIGHT
538
539Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
540
541This program is free software; you can redistribute it and/or modify
542it under the same terms as Perl itself.
543
544Please submit bug reports and patches to perlbug@perl.org.
545
546=head1 SEE ALSO
547
548L<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.
555sub _cwd {
556 require Cwd;
557 Cwd::getcwd();
558}
559
560
561# Internal method to reduce xx\..\yy -> yy
562sub _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
595118µs1;
 
# spent 7µs within File::Spec::Unix::CORE:ftdir which was called: # once (7µs+0s) by File::Spec::Unix::_tmpdir at line 189
sub File::Spec::Unix::CORE:ftdir; # opcode
# spent 1µs within File::Spec::Unix::CORE:ftewrite which was called: # once (1µs+0s) by File::Spec::Unix::_tmpdir at line 189
sub File::Spec::Unix::CORE:ftewrite; # opcode
# spent 3µs within File::Spec::Unix::CORE:match which was called 2 times, avg 2µs/call: # 2 times (3µs+0s) by File::Spec::Unix::file_name_is_absolute at line 256, avg 2µs/call
sub File::Spec::Unix::CORE:match; # opcode
# spent 31µs within File::Spec::Unix::canonpath which was called 21 times, avg 1µs/call: # 16 times (15µs+0s) by File::Spec::Unix::catdir or File::Spec::Unix::catfile at line 274 of File/Path.pm, avg 944ns/call # 2 times (2µs+0s) by File::Spec::Unix::catdir or File::Spec::Unix::catfile at line 137 of FindBin.pm, avg 1µs/call # once (11µs+0s) by File::Spec::Unix::_tmpdir at line 194 # once (2µs+0s) by File::Spec::Unix::catdir at line 1192 of File/Temp.pm # once (1µs+0s) by File::Spec::Unix::catdir at line 297 of File/Temp.pm
sub File::Spec::Unix::canonpath; # xsub
# spent 63µs (53+10) within File::Spec::Unix::catdir which was called 11 times, avg 6µs/call: # 8 times (31µs+7µs) by File::Spec::Unix::catfile at line 274 of File/Path.pm, avg 5µs/call # once (9µs+2µs) by File::Temp::tempdir at line 1192 of File/Temp.pm # once (8µs+800ns) by File::Spec::Unix::catfile at line 137 of FindBin.pm # once (5µs+1µs) by File::Temp::_gettemp at line 297 of File/Temp.pm
sub File::Spec::Unix::catdir; # xsub
# spent 154µs (98+56) within File::Spec::Unix::catfile which was called 9 times, avg 17µs/call: # 8 times (76µs+46µs) by File::Path::_rmtree at line 274 of File/Path.pm, avg 15µs/call # once (22µs+10µs) by FindBin::init at line 137 of FindBin.pm
sub File::Spec::Unix::catfile; # xsub