← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:09 2010

File /usr/lib/perl5/File/Spec/Unix.pm
Statements Executed 44
Total Time 0.001901 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
22136µs36µsFile::Spec::Unix::::canonpathFile::Spec::Unix::canonpath
11122µs69µsFile::Spec::Unix::::catfileFile::Spec::Unix::catfile
11111µs28µsFile::Spec::Unix::::catdirFile::Spec::Unix::catdir
0000s0sFile::Spec::Unix::::BEGINFile::Spec::Unix::BEGIN
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::::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
LineStmts.Exclusive
Time
Avg.Code
1package File::Spec::Unix;
2
3328µs9µsuse strict;
# spent 9µs making 1 call to strict::import
43458µs153µsuse vars qw($VERSION);
# spent 20µs making 1 call to vars::import
5
61800ns800ns$VERSION = '3.2701';
7
8=head1 NAME
9
10File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
11
12=head1 SYNOPSIS
13
14 require File::Spec::Unix; # Done automatically by File::Spec
15
16=head1 DESCRIPTION
17
18Methods for manipulating file specifications. Other File::Spec
19modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
20override specific methods.
21
22=head1 METHODS
23
24=over 2
25
26=item canonpath()
27
28No physical check on the filesystem, but a logical cleanup of a
29path. On UNIX eliminates successive slashes and successive "/.".
30
31 $cpath = File::Spec->canonpath( $path ) ;
32
33Note that this does *not* collapse F<x/../y> sections into F<y>. This
34is by design. If F</foo> on your system is a symlink to F</bar/baz>,
35then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
36F<../>-removal would give you. If you want to do this kind of
37processing, you probably want C<Cwd>'s C<realpath()> function to
38actually traverse the filesystem cleaning up paths like this.
39
40=cut
41
42
# spent 36µs within File::Spec::Unix::canonpath which was called 2 times, avg 18µs/call: # once (19µs+0s) by File::Spec::Unix::catfile at line 94 # once (18µs+0s) by File::Spec::Unix::catdir at line 82
sub canonpath {
432429µs1µs 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
71Concatenate two or more directory names to form a complete path ending
72with a directory. But remove the trailing slash from the resulting
73string, because it doesn't look good, isn't necessary and confuses
74OS2. Of course, if this is the root directory, don't cut off the
75trailing slash :-)
76
77=cut
78
79
# spent 28µs (11+18) within File::Spec::Unix::catdir which was called # once (11µs+18µs) by File::Spec::Unix::catfile at line 96
sub catdir {
8029µs4µs my $self = shift;
81
82 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
# spent 18µs making 1 call to File::Spec::Unix::canonpath
83}
84
85=item catfile
86
87Concatenate one or more directory names and a filename to form a
88complete path ending with a filename
89
90=cut
91
92
# spent 69µs (22+47) within File::Spec::Unix::catfile which was called # once (22µs+47µs) by XML::SAX::load_parsers at line 61 of /usr/share/perl5/XML/SAX.pm
sub catfile {
93626µs4µs my $self = shift;
94 my $file = $self->canonpath(pop @_);
# spent 19µs making 1 call to File::Spec::Unix::canonpath
95 return $file unless @_;
96 my $dir = $self->catdir(@_);
# spent 28µs making 1 call to File::Spec::Unix::catdir
97 $dir .= "/" unless substr($dir,-1) eq "/";
98 return $dir.$file;
99}
100
101=item curdir
102
103Returns a string representation of the current directory. "." on UNIX.
104
105=cut
106
107sub curdir () { '.' }
108
109=item devnull
110
111Returns a string representation of the null device. "/dev/null" on UNIX.
112
113=cut
114
115sub devnull () { '/dev/null' }
116
117=item rootdir
118
119Returns a string representation of the root directory. "/" on UNIX.
120
121=cut
122
123sub rootdir () { '/' }
124
125=item tmpdir
126
127Returns a string representation of the first writable directory from
128the following list or the current directory if none from the list are
129writable:
130
131 $ENV{TMPDIR}
132 /tmp
133
134Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
135is tainted, it is not used.
136
137=cut
138
1391300ns300nsmy $tmpdir;
140sub _tmpdir {
141 return $tmpdir if defined $tmpdir;
142 my $self = shift;
143 my @dirlist = @_;
144 {
14531.35ms449µs no strict 'refs';
# spent 23µ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
168Returns a string representation of the parent directory. ".." on UNIX.
169
170=cut
171
172sub updir () { '..' }
173
174=item no_upwards
175
176Given a list of file names, strip out those that refer to a parent
177directory. (Does not strip symlinks, only '.', '..', and equivalents.)
178
179=cut
180
181sub no_upwards {
182 my $self = shift;
183 return grep(!/^\.{1,2}\z/s, @_);
184}
185
186=item case_tolerant
187
188Returns a true or false value indicating, respectively, that alphabetic
189is not or is significant when comparing file specifications.
190
191=cut
192
193sub case_tolerant () { 0 }
194
195=item file_name_is_absolute
196
197Takes as argument a path and returns true if it is an absolute path.
198
199This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
200OS (Classic). It does consult the working environment for VMS (see
201L<File::Spec::VMS/file_name_is_absolute>).
202
203=cut
204
205sub file_name_is_absolute {
206 my ($self,$file) = @_;
207 return scalar($file =~ m:^/:s);
208}
209
210=item path
211
212Takes no argument, returns the environment variable PATH as an array.
213
214=cut
215
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
225join is the same as catfile.
226
227=cut
228
229sub join {
230 my $self = shift;
231 return $self->catfile(@_);
232}
233
234=item splitpath
235
236 ($volume,$directories,$file) = File::Spec->splitpath( $path );
237 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
238
239Splits a path into volume, directory, and filename portions. On systems
240with no concept of volume, returns '' for volume.
241
242For systems with no syntax differentiating filenames from directories,
243assumes that the last file is a path unless $no_file is true or a
244trailing separator or /. or /.. is present. On Unix this means that $no_file
245true makes this return ( '', $path, '' ).
246
247The directory portion may or may not be returned with a trailing '/'.
248
249The results can be passed to L</catpath()> to get back a path equivalent to
250(usually identical to) the original path.
251
252=cut
253
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
274The opposite of L</catdir()>.
275
276 @dirs = File::Spec->splitdir( $directories );
277
278$directories must be only the directory portion of the path on systems
279that have the concept of a volume or that have path syntax that differentiates
280files from directories.
281
282Unlike just splitting the directories on the separator, empty
283directory names (C<''>) can be returned, because these are significant
284on some OSs.
285
286On Unix,
287
288 File::Spec->splitdir( "/a/b//c/" );
289
290Yields:
291
292 ( '', 'a', 'b', '', 'c', '' )
293
294=cut
295
296sub splitdir {
297 return split m|/|, $_[1], -1; # Preserve trailing fields
298}
299
300
301=item catpath()
302
303Takes volume, directory and file portions and returns an entire path. Under
304Unix, $volume is ignored, and directory and file are concatenated. A '/' is
305inserted if needed (though if the directory portion doesn't start with
306'/' it is not added). On other OSs, $volume is significant.
307
308=cut
309
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
329Takes a destination path and an optional base path returns a relative path
330from the base path to the destination path:
331
332 $rel_path = File::Spec->abs2rel( $path ) ;
333 $rel_path = File::Spec->abs2rel( $path, $base ) ;
334
335If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
336relative, then it is converted to absolute form using
337L</rel2abs()>. This means that it is taken to be relative to
338L<cwd()|Cwd>.
339
340On systems that have a grammar that indicates filenames, this ignores the
341$base filename. Otherwise all path components are assumed to be
342directories.
343
344If $path is relative, it is converted to absolute form using L</rel2abs()>.
345This means that it is taken to be relative to L<cwd()|Cwd>.
346
347No checks against the filesystem are made. On VMS, there is
348interaction with the working environment, as logicals and
349macros are expanded.
350
351Based on code written by Shigio Yamaguchi.
352
353=cut
354
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
412Converts a relative path to an absolute path.
413
414 $abs_path = File::Spec->rel2abs( $path ) ;
415 $abs_path = File::Spec->rel2abs( $path, $base ) ;
416
417If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
418relative, then it is converted to absolute form using
419L</rel2abs()>. This means that it is taken to be relative to
420L<cwd()|Cwd>.
421
422On systems that have a grammar that indicates filenames, this ignores
423the $base filename. Otherwise all path components are assumed to be
424directories.
425
426If $path is absolute, it is cleaned up and returned using L</canonpath()>.
427
428No checks against the filesystem are made. On VMS, there is
429interaction with the working environment, as logicals and
430macros are expanded.
431
432Based on code written by Shigio Yamaguchi.
433
434=cut
435
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
461=head1 COPYRIGHT
462
463Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
464
465This program is free software; you can redistribute it and/or modify
466it under the same terms as Perl itself.
467
468=head1 SEE ALSO
469
470L<File::Spec>
471
472=cut
473
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µs4µs1;