← Index
NYTProf Performance Profile   « line view »
For t/optimization.t
  Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:06 2015

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