← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:02 2010

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