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