This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump $VERSION due to #31686
[perl5.git] / lib / File / Spec / Unix.pm
CommitLineData
270d1e39
GS
1package File::Spec::Unix;
2
270d1e39 3use strict;
07824bd1 4use vars qw($VERSION);
b4296952 5
42ad0bbf 6$VERSION = '1.5_01';
270d1e39
GS
7
8=head1 NAME
9
6fad8743 10File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
270d1e39
GS
11
12=head1 SYNOPSIS
13
cbc7acb0 14 require File::Spec::Unix; # Done automatically by File::Spec
270d1e39
GS
15
16=head1 DESCRIPTION
17
6fad8743
RK
18Methods for manipulating file specifications. Other File::Spec
19modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
20override specific methods.
270d1e39
GS
21
22=head1 METHODS
23
24=over 2
25
59605c55 26=item canonpath()
270d1e39
GS
27
28No physical check on the filesystem, but a logical cleanup of a
6fad8743 29path. On UNIX eliminates successive slashes and successive "/.".
270d1e39 30
c27914c9 31 $cpath = File::Spec->canonpath( $path ) ;
c27914c9 32
60598624
RGS
33Note that this does *not* collapse F<x/../y> sections into F<y>. This
34is by design. If F</foo> on your system is a symlink to F</bar/baz>,
35then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
36F<../>-removal would give you. If you want to do this kind of
37processing, you probably want C<Cwd>'s C<realpath()> function to
38actually traverse the filesystem cleaning up paths like this.
39
270d1e39
GS
40=cut
41
42sub canonpath {
0994714a 43 my ($self,$path) = @_;
89bb8afa 44
04ca015e 45 # Handle POSIX-style node names beginning with double slash (qnx, nto)
04ca015e
MC
46 # (POSIX says: "a pathname that begins with two successive slashes
47 # may be interpreted in an implementation-defined manner, although
48 # more than two leading slashes shall be treated as a single slash.")
89bb8afa 49 my $node = '';
e9475de8
SP
50 my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
51 if ( $double_slashes_special && $path =~ s{^(//[^/]+)(?:/|\z)}{/}s ) {
89bb8afa
NA
52 $node = $1;
53 }
7aa86a29 54 # This used to be
9d5071ba 55 # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
7aa86a29
JH
56 # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
57 # (Mainly because trailing "" directories didn't get stripped).
58 # Why would cygwin avoid collapsing multiple slashes into one? --jhi
e9475de8
SP
59 $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
60 $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
61 $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
62 $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
9596c75c 63 $path =~ s|^/\.\.$|/|; # /.. -> /
e9475de8 64 $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
89bb8afa 65 return "$node$path";
270d1e39
GS
66}
67
59605c55 68=item catdir()
270d1e39
GS
69
70Concatenate two or more directory names to form a complete path ending
71with a directory. But remove the trailing slash from the resulting
72string, because it doesn't look good, isn't necessary and confuses
73OS2. Of course, if this is the root directory, don't cut off the
74trailing slash :-)
75
76=cut
77
270d1e39 78sub catdir {
cbc7acb0 79 my $self = shift;
638113eb
JH
80
81 $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
270d1e39
GS
82}
83
84=item catfile
85
86Concatenate one or more directory names and a filename to form a
87complete path ending with a filename
88
89=cut
90
91sub catfile {
cbc7acb0 92 my $self = shift;
63c6dcc1 93 my $file = $self->canonpath(pop @_);
270d1e39
GS
94 return $file unless @_;
95 my $dir = $self->catdir(@_);
cbc7acb0 96 $dir .= "/" unless substr($dir,-1) eq "/";
270d1e39
GS
97 return $dir.$file;
98}
99
100=item curdir
101
cbc7acb0 102Returns a string representation of the current directory. "." on UNIX.
270d1e39
GS
103
104=cut
105
638113eb 106sub curdir () { '.' }
270d1e39 107
99804bbb
GS
108=item devnull
109
cbc7acb0 110Returns a string representation of the null device. "/dev/null" on UNIX.
99804bbb
GS
111
112=cut
113
638113eb 114sub devnull () { '/dev/null' }
99804bbb 115
270d1e39
GS
116=item rootdir
117
cbc7acb0 118Returns a string representation of the root directory. "/" on UNIX.
270d1e39
GS
119
120=cut
121
638113eb 122sub rootdir () { '/' }
270d1e39 123
cbc7acb0
JD
124=item tmpdir
125
07824bd1
JH
126Returns a string representation of the first writable directory from
127the following list or the current directory if none from the list are
128writable:
cbc7acb0
JD
129
130 $ENV{TMPDIR}
131 /tmp
132
b4c5e263
RGS
133Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
134is tainted, it is not used.
135
cbc7acb0
JD
136=cut
137
138my $tmpdir;
07824bd1 139sub _tmpdir {
cbc7acb0 140 return $tmpdir if defined $tmpdir;
07824bd1
JH
141 my $self = shift;
142 my @dirlist = @_;
5b577f92
JH
143 {
144 no strict 'refs';
145 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
146 require Scalar::Util;
07824bd1 147 @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
5b577f92 148 }
b4c5e263
RGS
149 }
150 foreach (@dirlist) {
cbc7acb0
JD
151 next unless defined && -d && -w _;
152 $tmpdir = $_;
153 last;
154 }
07824bd1
JH
155 $tmpdir = $self->curdir unless defined $tmpdir;
156 $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
cbc7acb0
JD
157 return $tmpdir;
158}
159
07824bd1
JH
160sub tmpdir {
161 return $tmpdir if defined $tmpdir;
60598624 162 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
07824bd1
JH
163}
164
270d1e39
GS
165=item updir
166
cbc7acb0 167Returns a string representation of the parent directory. ".." on UNIX.
270d1e39
GS
168
169=cut
170
638113eb 171sub updir () { '..' }
270d1e39
GS
172
173=item no_upwards
174
175Given a list of file names, strip out those that refer to a parent
176directory. (Does not strip symlinks, only '.', '..', and equivalents.)
177
178=cut
179
180sub no_upwards {
cbc7acb0 181 my $self = shift;
e9475de8 182 return grep(!/^\.{1,2}\z/s, @_);
270d1e39
GS
183}
184
46726cbe
CB
185=item case_tolerant
186
187Returns a true or false value indicating, respectively, that alphabetic
188is not or is significant when comparing file specifications.
189
190=cut
191
638113eb 192sub case_tolerant () { 0 }
46726cbe 193
270d1e39
GS
194=item file_name_is_absolute
195
3c32ced9
BS
196Takes as argument a path and returns true if it is an absolute path.
197
2586ba89
JH
198This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
199OS (Classic). It does consult the working environment for VMS (see
3c32ced9 200L<File::Spec::VMS/file_name_is_absolute>).
270d1e39
GS
201
202=cut
203
204sub file_name_is_absolute {
cbc7acb0 205 my ($self,$file) = @_;
1b1e14d3 206 return scalar($file =~ m:^/:s);
270d1e39
GS
207}
208
209=item path
210
211Takes no argument, returns the environment variable PATH as an array.
212
213=cut
214
215sub path {
802aa3ba 216 return () unless exists $ENV{PATH};
cbc7acb0
JD
217 my @path = split(':', $ENV{PATH});
218 foreach (@path) { $_ = '.' if $_ eq '' }
219 return @path;
270d1e39
GS
220}
221
222=item join
223
224join is the same as catfile.
225
226=cut
227
228sub join {
cbc7acb0
JD
229 my $self = shift;
230 return $self->catfile(@_);
270d1e39
GS
231}
232
c27914c9
BS
233=item splitpath
234
235 ($volume,$directories,$file) = File::Spec->splitpath( $path );
236 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
237
40d020d9
RGS
238Splits a path into volume, directory, and filename portions. On systems
239with no concept of volume, returns '' for volume.
c27914c9
BS
240
241For systems with no syntax differentiating filenames from directories,
242assumes that the last file is a path unless $no_file is true or a
243trailing separator or /. or /.. is present. On Unix this means that $no_file
244true makes this return ( '', $path, '' ).
245
246The directory portion may or may not be returned with a trailing '/'.
247
248The results can be passed to L</catpath()> to get back a path equivalent to
249(usually identical to) the original path.
250
251=cut
252
253sub splitpath {
254 my ($self,$path, $nofile) = @_;
255
256 my ($volume,$directory,$file) = ('','','');
257
258 if ( $nofile ) {
259 $directory = $path;
260 }
261 else {
e9475de8 262 $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
c27914c9
BS
263 $directory = $1;
264 $file = $2;
265 }
266
267 return ($volume,$directory,$file);
268}
269
270
271=item splitdir
272
273The opposite of L</catdir()>.
274
275 @dirs = File::Spec->splitdir( $directories );
276
277$directories must be only the directory portion of the path on systems
278that have the concept of a volume or that have path syntax that differentiates
279files from directories.
280
200f06d0
GS
281Unlike just splitting the directories on the separator, empty
282directory names (C<''>) can be returned, because these are significant
2586ba89 283on some OSs.
c27914c9 284
200f06d0
GS
285On Unix,
286
287 File::Spec->splitdir( "/a/b//c/" );
c27914c9
BS
288
289Yields:
290
291 ( '', 'a', 'b', '', 'c', '' )
292
293=cut
294
295sub splitdir {
e021ab8e 296 return split m|/|, $_[1], -1; # Preserve trailing fields
c27914c9
BS
297}
298
299
59605c55 300=item catpath()
c27914c9
BS
301
302Takes volume, directory and file portions and returns an entire path. Under
3099fc99 303Unix, $volume is ignored, and directory and file are concatenated. A '/' is
529a1a84
SB
304inserted if needed (though if the directory portion doesn't start with
305'/' it is not added). On other OSs, $volume is significant.
c27914c9
BS
306
307=cut
308
309sub catpath {
310 my ($self,$volume,$directory,$file) = @_;
311
312 if ( $directory ne '' &&
313 $file ne '' &&
314 substr( $directory, -1 ) ne '/' &&
315 substr( $file, 0, 1 ) ne '/'
316 ) {
317 $directory .= "/$file" ;
318 }
319 else {
320 $directory .= $file ;
321 }
322
323 return $directory ;
324}
325
326=item abs2rel
327
328Takes a destination path and an optional base path returns a relative path
329from the base path to the destination path:
330
3c32ced9
BS
331 $rel_path = File::Spec->abs2rel( $path ) ;
332 $rel_path = File::Spec->abs2rel( $path, $base ) ;
c27914c9 333
c063e98f
JH
334If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
335relative, then it is converted to absolute form using
336L</rel2abs()>. This means that it is taken to be relative to
337L<cwd()|Cwd>.
c27914c9 338
c27914c9 339On systems that have a grammar that indicates filenames, this ignores the
638113eb 340$base filename. Otherwise all path components are assumed to be
c27914c9
BS
341directories.
342
343If $path is relative, it is converted to absolute form using L</rel2abs()>.
59605c55 344This means that it is taken to be relative to L<cwd()|Cwd>.
c27914c9 345
2586ba89 346No checks against the filesystem are made. On VMS, there is
3c32ced9
BS
347interaction with the working environment, as logicals and
348macros are expanded.
c27914c9 349
3c32ced9 350Based on code written by Shigio Yamaguchi.
c27914c9
BS
351
352=cut
353
354sub abs2rel {
355 my($self,$path,$base) = @_;
9d5071ba 356 $base = $self->_cwd() unless defined $base and length $base;
c27914c9 357
81a4c762 358 ($path, $base) = map $self->canonpath($_), $path, $base;
c27914c9 359
e0dc0ff1 360 if (grep $self->file_name_is_absolute($_), $path, $base) {
81a4c762 361 ($path, $base) = map $self->rel2abs($_), $path, $base;
e0dc0ff1
BD
362 }
363 else {
364 # save a couple of cwd()s if both paths are relative
81a4c762 365 ($path, $base) = map $self->catdir('/', $_), $path, $base;
e0dc0ff1 366 }
9d5071ba 367
110c90cc
SP
368 my ($path_volume) = $self->splitpath($path, 1);
369 my ($base_volume) = $self->splitpath($base, 1);
370
371 # Can't relativize across volumes
372 return $path unless $path_volume eq $base_volume;
373
9d5071ba
SP
374 my $path_directories = ($self->splitpath($path, 1))[1];
375 my $base_directories = ($self->splitpath($base, 1))[1];
c27914c9 376
fa52125f
SP
377 # For UNC paths, the user might give a volume like //foo/bar that
378 # strictly speaking has no directory portion. Treat it as if it
379 # had the root directory for that volume.
380 if (!length($base_directories) and $self->file_name_is_absolute($base)) {
381 $base_directories = $self->rootdir;
382 }
383
c27914c9 384 # Now, remove all leading components that are the same
9d5071ba
SP
385 my @pathchunks = $self->splitdir( $path_directories );
386 my @basechunks = $self->splitdir( $base_directories );
6fd19b73 387
fa52125f
SP
388 if ($base_directories eq $self->rootdir) {
389 shift @pathchunks;
390 return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
391 }
392
9d5071ba 393 while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
c27914c9
BS
394 shift @pathchunks ;
395 shift @basechunks ;
396 }
9d5071ba 397 return $self->curdir unless @pathchunks || @basechunks;
6fd19b73
CB
398
399 # $base now contains the directories the resulting relative path
9d5071ba
SP
400 # must ascend out of before it can descend to $path_directory.
401 my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
402 return $self->canonpath( $self->catpath('', $result_dirs, '') );
403}
c27914c9 404
9d5071ba
SP
405sub _same {
406 $_[1] eq $_[2];
c27914c9
BS
407}
408
59605c55 409=item rel2abs()
c27914c9
BS
410
411Converts a relative path to an absolute path.
412
3c32ced9
BS
413 $abs_path = File::Spec->rel2abs( $path ) ;
414 $abs_path = File::Spec->rel2abs( $path, $base ) ;
c27914c9 415
0fab864c
JH
416If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
417relative, then it is converted to absolute form using
418L</rel2abs()>. This means that it is taken to be relative to
419L<cwd()|Cwd>.
c27914c9 420
638113eb
JH
421On systems that have a grammar that indicates filenames, this ignores
422the $base filename. Otherwise all path components are assumed to be
c27914c9
BS
423directories.
424
425If $path is absolute, it is cleaned up and returned using L</canonpath()>.
426
2586ba89 427No checks against the filesystem are made. On VMS, there is
3c32ced9
BS
428interaction with the working environment, as logicals and
429macros are expanded.
c27914c9 430
3c32ced9 431Based on code written by Shigio Yamaguchi.
c27914c9
BS
432
433=cut
434
786b702f 435sub rel2abs {
c27914c9
BS
436 my ($self,$path,$base ) = @_;
437
438 # Clean up $path
439 if ( ! $self->file_name_is_absolute( $path ) ) {
440 # Figure out the effective $base and clean it up.
441 if ( !defined( $base ) || $base eq '' ) {
0fab864c 442 $base = $self->_cwd();
c27914c9
BS
443 }
444 elsif ( ! $self->file_name_is_absolute( $base ) ) {
445 $base = $self->rel2abs( $base ) ;
446 }
447 else {
448 $base = $self->canonpath( $base ) ;
449 }
450
451 # Glom them together
6fd19b73 452 $path = $self->catdir( $base, $path ) ;
c27914c9
BS
453 }
454
455 return $self->canonpath( $path ) ;
456}
457
270d1e39
GS
458=back
459
99f36a73
RGS
460=head1 COPYRIGHT
461
462Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
463
464This program is free software; you can redistribute it and/or modify
465it under the same terms as Perl itself.
466
270d1e39
GS
467=head1 SEE ALSO
468
469L<File::Spec>
470
471=cut
472
0fab864c
JH
473# Internal routine to File::Spec, no point in making this public since
474# it is the standard Cwd interface. Most of the platform-specific
475# File::Spec subclasses use this.
476sub _cwd {
c063e98f 477 require Cwd;
7241d76a 478 Cwd::getcwd();
c063e98f
JH
479}
480
9596c75c
RGS
481
482# Internal method to reduce xx\..\yy -> yy
483sub _collapse {
484 my($fs, $path) = @_;
485
486 my $updir = $fs->updir;
487 my $curdir = $fs->curdir;
488
489 my($vol, $dirs, $file) = $fs->splitpath($path);
490 my @dirs = $fs->splitdir($dirs);
c47834cd 491 pop @dirs if @dirs && $dirs[-1] eq '';
9596c75c
RGS
492
493 my @collapsed;
494 foreach my $dir (@dirs) {
495 if( $dir eq $updir and # if we have an updir
496 @collapsed and # and something to collapse
497 length $collapsed[-1] and # and its not the rootdir
498 $collapsed[-1] ne $updir and # nor another updir
499 $collapsed[-1] ne $curdir # nor the curdir
500 )
501 { # then
502 pop @collapsed; # collapse
503 }
504 else { # else
505 push @collapsed, $dir; # just hang onto it
506 }
507 }
508
509 return $fs->catpath($vol,
510 $fs->catdir(@collapsed),
511 $file
512 );
513}
514
515
270d1e39 5161;