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