This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to File::Spec 0.85_03.
[perl5.git] / lib / File / Spec / Unix.pm
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 SEE ALSO
449
450 L<File::Spec>
451
452 =cut
453
454 # Internal routine to File::Spec, no point in making this public since
455 # it is the standard Cwd interface.  Most of the platform-specific
456 # File::Spec subclasses use this.
457 sub _cwd {
458     require Cwd;
459     Cwd::cwd();
460 }
461
462 1;