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