ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/staticperl/perl/lib/File/Spec/Unix.pm
Revision: 1.1
Committed: Thu Jun 30 14:27:12 2005 UTC (21 years, 3 months ago) by root
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

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