← Index
NYTProf Performance Profile   « block view • line view • sub view »
For conv.pl
  Run on Sun Nov 14 22:50:31 2010
Reported on Sun Nov 14 22:51:22 2010

Filename/usr/lib/perl5/File/Spec/Unix.pm
StatementsExecuted 12 statements in 2.10ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11123µs30µsFile::Spec::Unix::::BEGIN@3File::Spec::Unix::BEGIN@3
11117µs46µsFile::Spec::Unix::::BEGIN@145File::Spec::Unix::BEGIN@145
11113µs54µ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::::catdirFile::Spec::Unix::catdir
0000s0sFile::Spec::Unix::::catfileFile::Spec::Unix::catfile
0000s0sFile::Spec::Unix::::catpathFile::Spec::Unix::catpath
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::::splitdirFile::Spec::Unix::splitdir
0000s0sFile::Spec::Unix::::splitpathFile::Spec::Unix::splitpath
0000s0sFile::Spec::Unix::::tmpdirFile::Spec::Unix::tmpdir
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
3345µs237µs
# spent 30µs (23+7) within File::Spec::Unix::BEGIN@3 which was called: # once (23µs+7µs) by charnames::BEGIN@4 at line 3
use strict;
# spent 30µs making 1 call to File::Spec::Unix::BEGIN@3 # spent 7µs making 1 call to strict::import
43548µs295µs
# spent 54µs (13+41) within File::Spec::Unix::BEGIN@4 which was called: # once (13µs+41µs) by charnames::BEGIN@4 at line 4
use vars qw($VERSION);
# spent 54µs making 1 call to File::Spec::Unix::BEGIN@4 # spent 41µs making 1 call to vars::import
5
612µs$VERSION = '3.2701';
7
8=head1 NAME
9
- -
42sub canonpath {
43 my ($self,$path) = @_;
44 return unless defined $path;
45
46 # Handle POSIX-style node names beginning with double slash (qnx, nto)
47 # (POSIX says: "a pathname that begins with two successive slashes
48 # may be interpreted in an implementation-defined manner, although
49 # more than two leading slashes shall be treated as a single slash.")
50 my $node = '';
51 my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
52 if ( $double_slashes_special && $path =~ s{^(//[^/]+)(?:/|\z)}{/}s ) {
53 $node = $1;
54 }
55 # This used to be
56 # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
57 # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
58 # (Mainly because trailing "" directories didn't get stripped).
59 # Why would cygwin avoid collapsing multiple slashes into one? --jhi
60 $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
61 $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
62 $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
63 $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
64 $path =~ s|^/\.\.$|/|; # /.. -> /
65 $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
66 return "$node$path";
67}
68
69=item catdir()
70
- -
79sub catdir {
80 my $self = shift;
81
82 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
83}
84
85=item catfile
86
- -
92sub catfile {
93 my $self = shift;
94 my $file = $self->canonpath(pop @_);
95 return $file unless @_;
96 my $dir = $self->catdir(@_);
97 $dir .= "/" unless substr($dir,-1) eq "/";
98 return $dir.$file;
99}
100
101=item curdir
102
- -
107sub curdir () { '.' }
108
109=item devnull
110
- -
115sub devnull () { '/dev/null' }
116
117=item rootdir
118
- -
123sub rootdir () { '/' }
124
125=item tmpdir
126
- -
13911µsmy $tmpdir;
140sub _tmpdir {
141 return $tmpdir if defined $tmpdir;
142 my $self = shift;
143 my @dirlist = @_;
144 {
14531.51ms275µs
# spent 46µs (17+29) within File::Spec::Unix::BEGIN@145 which was called: # once (17µs+29µs) by charnames::BEGIN@4 at line 145
no strict 'refs';
# spent 46µs making 1 call to File::Spec::Unix::BEGIN@145 # spent 29µs making 1 call to strict::unimport
146 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
147 require Scalar::Util;
148 @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
149 }
150 }
151 foreach (@dirlist) {
152 next unless defined && -d && -w _;
153 $tmpdir = $_;
154 last;
155 }
156 $tmpdir = $self->curdir unless defined $tmpdir;
157 $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
158 return $tmpdir;
159}
160
161sub tmpdir {
162 return $tmpdir if defined $tmpdir;
163 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
164}
165
166=item updir
167
- -
172sub updir () { '..' }
173
174=item no_upwards
175
- -
181sub no_upwards {
182 my $self = shift;
183 return grep(!/^\.{1,2}\z/s, @_);
184}
185
186=item case_tolerant
187
- -
193sub case_tolerant () { 0 }
194
195=item file_name_is_absolute
196
- -
205sub file_name_is_absolute {
206 my ($self,$file) = @_;
207 return scalar($file =~ m:^/:s);
208}
209
210=item path
211
- -
216sub path {
217 return () unless exists $ENV{PATH};
218 my @path = split(':', $ENV{PATH});
219 foreach (@path) { $_ = '.' if $_ eq '' }
220 return @path;
221}
222
223=item join
224
- -
229sub join {
230 my $self = shift;
231 return $self->catfile(@_);
232}
233
234=item splitpath
235
- -
254sub splitpath {
255 my ($self,$path, $nofile) = @_;
256
257 my ($volume,$directory,$file) = ('','','');
258
259 if ( $nofile ) {
260 $directory = $path;
261 }
262 else {
263 $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
264 $directory = $1;
265 $file = $2;
266 }
267
268 return ($volume,$directory,$file);
269}
270
271
272=item splitdir
273
- -
296sub splitdir {
297 return split m|/|, $_[1], -1; # Preserve trailing fields
298}
299
300
301=item catpath()
302
- -
310sub catpath {
311 my ($self,$volume,$directory,$file) = @_;
312
313 if ( $directory ne '' &&
314 $file ne '' &&
315 substr( $directory, -1 ) ne '/' &&
316 substr( $file, 0, 1 ) ne '/'
317 ) {
318 $directory .= "/$file" ;
319 }
320 else {
321 $directory .= $file ;
322 }
323
324 return $directory ;
325}
326
327=item abs2rel
328
- -
355sub abs2rel {
356 my($self,$path,$base) = @_;
357 $base = $self->_cwd() unless defined $base and length $base;
358
359 ($path, $base) = map $self->canonpath($_), $path, $base;
360
361 if (grep $self->file_name_is_absolute($_), $path, $base) {
362 ($path, $base) = map $self->rel2abs($_), $path, $base;
363 }
364 else {
365 # save a couple of cwd()s if both paths are relative
366 ($path, $base) = map $self->catdir('/', $_), $path, $base;
367 }
368
369 my ($path_volume) = $self->splitpath($path, 1);
370 my ($base_volume) = $self->splitpath($base, 1);
371
372 # Can't relativize across volumes
373 return $path unless $path_volume eq $base_volume;
374
375 my $path_directories = ($self->splitpath($path, 1))[1];
376 my $base_directories = ($self->splitpath($base, 1))[1];
377
378 # For UNC paths, the user might give a volume like //foo/bar that
379 # strictly speaking has no directory portion. Treat it as if it
380 # had the root directory for that volume.
381 if (!length($base_directories) and $self->file_name_is_absolute($base)) {
382 $base_directories = $self->rootdir;
383 }
384
385 # Now, remove all leading components that are the same
386 my @pathchunks = $self->splitdir( $path_directories );
387 my @basechunks = $self->splitdir( $base_directories );
388
389 if ($base_directories eq $self->rootdir) {
390 shift @pathchunks;
391 return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
392 }
393
394 while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
395 shift @pathchunks ;
396 shift @basechunks ;
397 }
398 return $self->curdir unless @pathchunks || @basechunks;
399
400 # $base now contains the directories the resulting relative path
401 # must ascend out of before it can descend to $path_directory.
402 my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
403 return $self->canonpath( $self->catpath('', $result_dirs, '') );
404}
405
406sub _same {
407 $_[1] eq $_[2];
408}
409
410=item rel2abs()
411
- -
436sub rel2abs {
437 my ($self,$path,$base ) = @_;
438
439 # Clean up $path
440 if ( ! $self->file_name_is_absolute( $path ) ) {
441 # Figure out the effective $base and clean it up.
442 if ( !defined( $base ) || $base eq '' ) {
443 $base = $self->_cwd();
444 }
445 elsif ( ! $self->file_name_is_absolute( $base ) ) {
446 $base = $self->rel2abs( $base ) ;
447 }
448 else {
449 $base = $self->canonpath( $base ) ;
450 }
451
452 # Glom them together
453 $path = $self->catdir( $base, $path ) ;
454 }
455
456 return $self->canonpath( $path ) ;
457}
458
459=back
460
- -
474# Internal routine to File::Spec, no point in making this public since
475# it is the standard Cwd interface. Most of the platform-specific
476# File::Spec subclasses use this.
477sub _cwd {
478 require Cwd;
479 Cwd::getcwd();
480}
481
482
483# Internal method to reduce xx\..\yy -> yy
484sub _collapse {
485 my($fs, $path) = @_;
486
487 my $updir = $fs->updir;
488 my $curdir = $fs->curdir;
489
490 my($vol, $dirs, $file) = $fs->splitpath($path);
491 my @dirs = $fs->splitdir($dirs);
492 pop @dirs if @dirs && $dirs[-1] eq '';
493
494 my @collapsed;
495 foreach my $dir (@dirs) {
496 if( $dir eq $updir and # if we have an updir
497 @collapsed and # and something to collapse
498 length $collapsed[-1] and # and its not the rootdir
499 $collapsed[-1] ne $updir and # nor another updir
500 $collapsed[-1] ne $curdir # nor the curdir
501 )
502 { # then
503 pop @collapsed; # collapse
504 }
505 else { # else
506 push @collapsed, $dir; # just hang onto it
507 }
508 }
509
510 return $fs->catpath($vol,
511 $fs->catdir(@collapsed),
512 $file
513 );
514}
515
516
51714µs1;
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.