integrate cfgperl and vmsperl contents into mainline
[p5sagit/p5-mst-13.2.git] / lib / File / Spec / Unix.pm
1 package File::Spec::Unix;
2
3 use strict;
4
5 use Cwd;
6
7 =head1 NAME
8
9 File::Spec::Unix - methods used by File::Spec
10
11 =head1 SYNOPSIS
12
13  require File::Spec::Unix; # Done automatically by File::Spec
14
15 =head1 DESCRIPTION
16
17 Methods for manipulating file specifications.
18
19 =head1 METHODS
20
21 =over 2
22
23 =item canonpath
24
25 No physical check on the filesystem, but a logical cleanup of a
26 path. On UNIX eliminated successive slashes and successive "/.".
27
28     $cpath = File::Spec->canonpath( $path ) ;
29
30 =cut
31
32 sub canonpath {
33     my ($self,$path) = @_;
34     $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
35     $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
36     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
37     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
38     $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
39     return $path;
40 }
41
42 =item catdir
43
44 Concatenate two or more directory names to form a complete path ending
45 with a directory. But remove the trailing slash from the resulting
46 string, because it doesn't look good, isn't necessary and confuses
47 OS2. Of course, if this is the root directory, don't cut off the
48 trailing slash :-)
49
50 =cut
51
52 sub catdir {
53     my $self = shift;
54     my @args = @_;
55     foreach (@args) {
56         # append a slash to each argument unless it has one there
57         $_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
58     }
59     return $self->canonpath(join('', @args));
60 }
61
62 =item catfile
63
64 Concatenate one or more directory names and a filename to form a
65 complete path ending with a filename
66
67 =cut
68
69 sub catfile {
70     my $self = shift;
71     my $file = pop @_;
72     return $file unless @_;
73     my $dir = $self->catdir(@_);
74     $dir .= "/" unless substr($dir,-1) eq "/";
75     return $dir.$file;
76 }
77
78 =item curdir
79
80 Returns a string representation of the current directory.  "." on UNIX.
81
82 =cut
83
84 sub curdir {
85     return ".";
86 }
87
88 =item devnull
89
90 Returns a string representation of the null device. "/dev/null" on UNIX.
91
92 =cut
93
94 sub devnull {
95     return "/dev/null";
96 }
97
98 =item rootdir
99
100 Returns a string representation of the root directory.  "/" on UNIX.
101
102 =cut
103
104 sub rootdir {
105     return "/";
106 }
107
108 =item tmpdir
109
110 Returns a string representation of the first writable directory
111 from the following list or "" if none are writable:
112
113     $ENV{TMPDIR}
114     /tmp
115
116 =cut
117
118 my $tmpdir;
119 sub tmpdir {
120     return $tmpdir if defined $tmpdir;
121     foreach ($ENV{TMPDIR}, "/tmp") {
122         next unless defined && -d && -w _;
123         $tmpdir = $_;
124         last;
125     }
126     $tmpdir = '' unless defined $tmpdir;
127     return $tmpdir;
128 }
129
130 =item updir
131
132 Returns a string representation of the parent directory.  ".." on UNIX.
133
134 =cut
135
136 sub updir {
137     return "..";
138 }
139
140 =item no_upwards
141
142 Given a list of file names, strip out those that refer to a parent
143 directory. (Does not strip symlinks, only '.', '..', and equivalents.)
144
145 =cut
146
147 sub no_upwards {
148     my $self = shift;
149     return grep(!/^\.{1,2}\z/s, @_);
150 }
151
152 =item case_tolerant
153
154 Returns a true or false value indicating, respectively, that alphabetic
155 is not or is significant when comparing file specifications.
156
157 =cut
158
159 sub case_tolerant {
160     return 0;
161 }
162
163 =item file_name_is_absolute
164
165 Takes as argument a path and returns true, if it is an absolute path.
166
167 =cut
168
169 sub file_name_is_absolute {
170     my ($self,$file) = @_;
171     return scalar($file =~ m:^/:s);
172 }
173
174 =item path
175
176 Takes no argument, returns the environment variable PATH as an array.
177
178 =cut
179
180 sub path {
181     my @path = split(':', $ENV{PATH});
182     foreach (@path) { $_ = '.' if $_ eq '' }
183     return @path;
184 }
185
186 =item join
187
188 join is the same as catfile.
189
190 =cut
191
192 sub join {
193     my $self = shift;
194     return $self->catfile(@_);
195 }
196
197 =item splitpath
198
199     ($volume,$directories,$file) = File::Spec->splitpath( $path );
200     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
201
202 Splits a path in to volume, directory, and filename portions. On systems
203 with no concept of volume, returns undef for volume. 
204
205 For systems with no syntax differentiating filenames from directories, 
206 assumes that the last file is a path unless $no_file is true or a 
207 trailing separator or /. or /.. is present. On Unix this means that $no_file
208 true makes this return ( '', $path, '' ).
209
210 The directory portion may or may not be returned with a trailing '/'.
211
212 The results can be passed to L</catpath()> to get back a path equivalent to
213 (usually identical to) the original path.
214
215 =cut
216
217 sub splitpath {
218     my ($self,$path, $nofile) = @_;
219
220     my ($volume,$directory,$file) = ('','','');
221
222     if ( $nofile ) {
223         $directory = $path;
224     }
225     else {
226         $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
227         $directory = $1;
228         $file      = $2;
229     }
230
231     return ($volume,$directory,$file);
232 }
233
234
235 =item splitdir
236
237 The opposite of L</catdir()>.
238
239     @dirs = File::Spec->splitdir( $directories );
240
241 $directories must be only the directory portion of the path on systems 
242 that have the concept of a volume or that have path syntax that differentiates
243 files from directories.
244
245 Unlike just splitting the directories on the separator, empty
246 directory names (C<''>) can be returned, because these are significant
247 on some OSs (e.g. MacOS).
248
249 On Unix,
250
251     File::Spec->splitdir( "/a/b//c/" );
252
253 Yields:
254
255     ( '', 'a', 'b', '', 'c', '' )
256
257 =cut
258
259 sub splitdir {
260     my ($self,$directories) = @_ ;
261     #
262     # split() likes to forget about trailing null fields, so here we
263     # check to be sure that there will not be any before handling the
264     # simple case.
265     #
266     if ( $directories !~ m|/\z| ) {
267         return split( m|/|, $directories );
268     }
269     else {
270         #
271         # since there was a trailing separator, add a file name to the end, 
272         # then do the split, then replace it with ''.
273         #
274         my( @directories )= split( m|/|, "${directories}dummy" ) ;
275         $directories[ $#directories ]= '' ;
276         return @directories ;
277     }
278 }
279
280
281 =item catpath
282
283 Takes volume, directory and file portions and returns an entire path. Under
284 Unix, $volume is ignored, and directory and file are catenated.  A '/' is
285 inserted if need be.  On other OSs, $volume is significant.
286
287 =cut
288
289 sub catpath {
290     my ($self,$volume,$directory,$file) = @_;
291
292     if ( $directory ne ''                && 
293          $file ne ''                     && 
294          substr( $directory, -1 ) ne '/' && 
295          substr( $file, 0, 1 ) ne '/' 
296     ) {
297         $directory .= "/$file" ;
298     }
299     else {
300         $directory .= $file ;
301     }
302
303     return $directory ;
304 }
305
306 =item abs2rel
307
308 Takes a destination path and an optional base path returns a relative path
309 from the base path to the destination path:
310
311     $rel_path = File::Spec->abs2rel( $destination ) ;
312     $rel_path = File::Spec->abs2rel( $destination, $base ) ;
313
314 If $base is not present or '', then L<cwd()> is used. If $base is relative, 
315 then it is converted to absolute form using L</rel2abs()>. This means that it
316 is taken to be relative to L<cwd()>.
317
318 On systems with the concept of a volume, this assumes that both paths 
319 are on the $destination volume, and ignores the $base volume. 
320
321 On systems that have a grammar that indicates filenames, this ignores the 
322 $base filename as well. Otherwise all path components are assumed to be
323 directories.
324
325 If $path is relative, it is converted to absolute form using L</rel2abs()>.
326 This means that it is taken to be relative to L<cwd()>.
327
328 Based on code written by Shigio Yamaguchi.
329
330 No checks against the filesystem are made. 
331
332 =cut
333
334 sub abs2rel {
335     my($self,$path,$base) = @_;
336
337     # Clean up $path
338     if ( ! $self->file_name_is_absolute( $path ) ) {
339         $path = $self->rel2abs( $path ) ;
340     }
341     else {
342         $path = $self->canonpath( $path ) ;
343     }
344
345     # Figure out the effective $base and clean it up.
346     if ( !defined( $base ) || $base eq '' ) {
347         $base = cwd() ;
348     }
349     elsif ( ! $self->file_name_is_absolute( $base ) ) {
350         $base = $self->rel2abs( $base ) ;
351     }
352     else {
353         $base = $self->canonpath( $base ) ;
354     }
355
356     # Now, remove all leading components that are the same
357     my @pathchunks = $self->splitdir( $path);
358     my @basechunks = $self->splitdir( $base);
359
360     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
361         shift @pathchunks ;
362         shift @basechunks ;
363     }
364
365     $path = CORE::join( '/', @pathchunks );
366     $base = CORE::join( '/', @basechunks );
367
368     # $base now contains the directories the resulting relative path 
369     # must ascend out of before it can descend to $path_directory.  So, 
370     # replace all names with $parentDir
371     $base =~ s|[^/]+|..|g ;
372
373     # Glue the two together, using a separator if necessary, and preventing an
374     # empty result.
375     if ( $path ne '' && $base ne '' ) {
376         $path = "$base/$path" ;
377     } else {
378         $path = "$base$path" ;
379     }
380
381     return $self->canonpath( $path ) ;
382 }
383
384 =item rel2abs
385
386 Converts a relative path to an absolute path. 
387
388     $abs_path = File::Spec->rel2abs( $destination ) ;
389     $abs_path = File::Spec->rel2abs( $destination, $base ) ;
390
391 If $base is not present or '', then L<cwd()> is used. If $base is relative, 
392 then it is converted to absolute form using L</rel2abs()>. This means that it
393 is taken to be relative to L<cwd()>.
394
395 On systems with the concept of a volume, this assumes that both paths 
396 are on the $base volume, and ignores the $destination volume. 
397
398 On systems that have a grammar that indicates filenames, this ignores the 
399 $base filename as well. Otherwise all path components are assumed to be
400 directories.
401
402 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
403
404 Based on code written by Shigio Yamaguchi.
405
406 No checks against the filesystem are made. 
407
408 =cut
409
410 sub rel2abs($;$;) {
411     my ($self,$path,$base ) = @_;
412
413     # Clean up $path
414     if ( ! $self->file_name_is_absolute( $path ) ) {
415         # Figure out the effective $base and clean it up.
416         if ( !defined( $base ) || $base eq '' ) {
417             $base = cwd() ;
418         }
419         elsif ( ! $self->file_name_is_absolute( $base ) ) {
420             $base = $self->rel2abs( $base ) ;
421         }
422         else {
423             $base = $self->canonpath( $base ) ;
424         }
425
426         # Glom them together
427         $path = $self->catdir( $base, $path ) ;
428     }
429
430     return $self->canonpath( $path ) ;
431 }
432
433
434 =back
435
436 =head1 SEE ALSO
437
438 L<File::Spec>
439
440 =cut
441
442 1;