lib/File/Spec/Unix.pm

   1 package File::Spec::Unix;
   2
   3 use strict;
   4 use vars qw($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 = $self->canonpath(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 from
 131 the following list or the current directory if none from the list are
 132 writable:
 133
 134     $ENV{TMPDIR}
 135     /tmp
 136
 137 Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
 138 is tainted, it is not used.
 139
 140 =cut
 141
 142 my $tmpdir;
 143 sub _tmpdir {
 144     return $tmpdir if defined $tmpdir;
 145     my $self = shift;
 146     my @dirlist = @_;
 147     {
 148         no strict 'refs';
 149         if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
 150             require Scalar::Util;
 151             @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
 152         }
 153     }
 154     foreach (@dirlist) {
 155         next unless defined && -d && -w _;
 156         $tmpdir = $_;
 157         last;
 158     }
 159     $tmpdir = $self->curdir unless defined $tmpdir;
 160     $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
 161     return $tmpdir;
 162 }
 163
 164 sub tmpdir {
 165     return $tmpdir if defined $tmpdir;
 166     my $self = shift;
 167     $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" );
 168 }
 169
 170 =item updir
 171
 172 Returns a string representation of the parent directory.  ".." on UNIX.
 173
 174 =cut
 175
 176 sub updir {
 177     return "..";
 178 }
 179
 180 =item no_upwards
 181
 182 Given a list of file names, strip out those that refer to a parent
 183 directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 184
 185 =cut
 186
 187 sub no_upwards {
 188     my $self = shift;
 189     return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
 190 }
 191
 192 =item case_tolerant
 193
 194 Returns a true or false value indicating, respectively, that alphabetic
 195 is not or is significant when comparing file specifications.
 196
 197 =cut
 198
 199 sub case_tolerant {
 200     return 0;
 201 }
 202
 203 =item file_name_is_absolute
 204
 205 Takes as argument a path and returns true if it is an absolute path.
 206
 207 This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
 208 OS (Classic).  It does consult the working environment for VMS (see
 209 L<File::Spec::VMS/file_name_is_absolute>).
 210
 211 =cut
 212
 213 sub file_name_is_absolute {
 214     my ($self,$file) = @_;
 215     return scalar($file =~ m:^/:s);
 216 }
 217
 218 =item path
 219
 220 Takes no argument, returns the environment variable PATH as an array.
 221
 222 =cut
 223
 224 sub path {
 225     return () unless exists $ENV{PATH};
 226     my @path = split(':', $ENV{PATH});
 227     foreach (@path) { $_ = '.' if $_ eq '' }
 228     return @path;
 229 }
 230
 231 =item join
 232
 233 join is the same as catfile.
 234
 235 =cut
 236
 237 sub join {
 238     my $self = shift;
 239     return $self->catfile(@_);
 240 }
 241
 242 =item splitpath
 243
 244     ($volume,$directories,$file) = File::Spec->splitpath( $path );
 245     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
 246
 247 Splits a path into volume, directory, and filename portions. On systems
 248 with no concept of volume, returns '' for volume.
 249
 250 For systems with no syntax differentiating filenames from directories,
 251 assumes that the last file is a path unless $no_file is true or a
 252 trailing separator or /. or /.. is present. On Unix this means that $no_file
 253 true makes this return ( '', $path, '' ).
 254
 255 The directory portion may or may not be returned with a trailing '/'.
 256
 257 The results can be passed to L</catpath()> to get back a path equivalent to
 258 (usually identical to) the original path.
 259
 260 =cut
 261
 262 sub splitpath {
 263     my ($self,$path, $nofile) = @_;
 264
 265     my ($volume,$directory,$file) = ('','','');
 266
 267     if ( $nofile ) {
 268         $directory = $path;
 269     }
 270     else {
 271         $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
 272         $directory = $1;
 273         $file      = $2;
 274     }
 275
 276     return ($volume,$directory,$file);
 277 }
 278
 279
 280 =item splitdir
 281
 282 The opposite of L</catdir()>.
 283
 284     @dirs = File::Spec->splitdir( $directories );
 285
 286 $directories must be only the directory portion of the path on systems
 287 that have the concept of a volume or that have path syntax that differentiates
 288 files from directories.
 289
 290 Unlike just splitting the directories on the separator, empty
 291 directory names (C<''>) can be returned, because these are significant
 292 on some OSs.
 293
 294 On Unix,
 295
 296     File::Spec->splitdir( "/a/b//c/" );
 297
 298 Yields:
 299
 300     ( '', 'a', 'b', '', 'c', '' )
 301
 302 =cut
 303
 304 sub splitdir {
 305     my ($self,$directories) = @_ ;
 306     #
 307     # split() likes to forget about trailing null fields, so here we
 308     # check to be sure that there will not be any before handling the
 309     # simple case.
 310     #
 311     if ( $directories !~ m|/\Z(?!\n)| ) {
 312         return split( m|/|, $directories );
 313     }
 314     else {
 315         #
 316         # since there was a trailing separator, add a file name to the end,
 317         # then do the split, then replace it with ''.
 318         #
 319         my( @directories )= split( m|/|, "${directories}dummy" ) ;
 320         $directories[ $#directories ]= '' ;
 321         return @directories ;
 322     }
 323 }
 324
 325
 326 =item catpath()
 327
 328 Takes volume, directory and file portions and returns an entire path. Under
 329 Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
 330 inserted if needed (though if the directory portion doesn't start with
 331 '/' it is not added).  On other OSs, $volume is significant.
 332
 333 =cut
 334
 335 sub catpath {
 336     my ($self,$volume,$directory,$file) = @_;
 337
 338     if ( $directory ne ''                &&
 339          $file ne ''                     &&
 340          substr( $directory, -1 ) ne '/' &&
 341          substr( $file, 0, 1 ) ne '/'
 342     ) {
 343         $directory .= "/$file" ;
 344     }
 345     else {
 346         $directory .= $file ;
 347     }
 348
 349     return $directory ;
 350 }
 351
 352 =item abs2rel
 353
 354 Takes a destination path and an optional base path returns a relative path
 355 from the base path to the destination path:
 356
 357     $rel_path = File::Spec->abs2rel( $path ) ;
 358     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 359
 360 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 361 then it is converted to absolute form using L</rel2abs()>. This means that it
 362 is taken to be relative to L<cwd()|Cwd>.
 363
 364 On systems with the concept of a volume, this assumes that both paths
 365 are on the $destination volume, and ignores the $base volume.
 366
 367 On systems that have a grammar that indicates filenames, this ignores the
 368 $base filename as well. Otherwise all path components are assumed to be
 369 directories.
 370
 371 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 372 This means that it is taken to be relative to L<cwd()|Cwd>.
 373
 374 No checks against the filesystem are made.  On VMS, there is
 375 interaction with the working environment, as logicals and
 376 macros are expanded.
 377
 378 Based on code written by Shigio Yamaguchi.
 379
 380 =cut
 381
 382 sub abs2rel {
 383     my($self,$path,$base) = @_;
 384
 385     # Clean up $path
 386     if ( ! $self->file_name_is_absolute( $path ) ) {
 387         $path = $self->rel2abs( $path ) ;
 388     }
 389     else {
 390         $path = $self->canonpath( $path ) ;
 391     }
 392
 393     # Figure out the effective $base and clean it up.
 394     if ( !defined( $base ) || $base eq '' ) {
 395         $base = cwd() ;
 396     }
 397     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 398         $base = $self->rel2abs( $base ) ;
 399     }
 400     else {
 401         $base = $self->canonpath( $base ) ;
 402     }
 403
 404     # Now, remove all leading components that are the same
 405     my @pathchunks = $self->splitdir( $path);
 406     my @basechunks = $self->splitdir( $base);
 407
 408     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
 409         shift @pathchunks ;
 410         shift @basechunks ;
 411     }
 412
 413     $path = CORE::join( '/', @pathchunks );
 414     $base = CORE::join( '/', @basechunks );
 415
 416     # $base now contains the directories the resulting relative path
 417     # must ascend out of before it can descend to $path_directory.  So,
 418     # replace all names with $parentDir
 419     $base =~ s|[^/]+|..|g ;
 420
 421     # Glue the two together, using a separator if necessary, and preventing an
 422     # empty result.
 423     if ( $path ne '' && $base ne '' ) {
 424         $path = "$base/$path" ;
 425     } else {
 426         $path = "$base$path" ;
 427     }
 428
 429     return $self->canonpath( $path ) ;
 430 }
 431
 432 =item rel2abs()
 433
 434 Converts a relative path to an absolute path.
 435
 436     $abs_path = File::Spec->rel2abs( $path ) ;
 437     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 438
 439 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 440 then it is converted to absolute form using L</rel2abs()>. This means that it
 441 is taken to be relative to L<cwd()|Cwd>.
 442
 443 On systems with the concept of a volume, this assumes that both paths
 444 are on the $base volume, and ignores the $path volume.
 445
 446 On systems that have a grammar that indicates filenames, this ignores the
 447 $base filename as well. Otherwise all path components are assumed to be
 448 directories.
 449
 450 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 451
 452 No checks against the filesystem are made.  On VMS, there is
 453 interaction with the working environment, as logicals and
 454 macros are expanded.
 455
 456 Based on code written by Shigio Yamaguchi.
 457
 458 =cut
 459
 460 sub rel2abs {
 461     my ($self,$path,$base ) = @_;
 462
 463     # Clean up $path
 464     if ( ! $self->file_name_is_absolute( $path ) ) {
 465         # Figure out the effective $base and clean it up.
 466         if ( !defined( $base ) || $base eq '' ) {
 467             $base = cwd() ;
 468         }
 469         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 470             $base = $self->rel2abs( $base ) ;
 471         }
 472         else {
 473             $base = $self->canonpath( $base ) ;
 474         }
 475
 476         # Glom them together
 477         $path = $self->catdir( $base, $path ) ;
 478     }
 479
 480     return $self->canonpath( $path ) ;
 481 }
 482
 483
 484 =back
 485
 486 =head1 SEE ALSO
 487
 488 L<File::Spec>
 489
 490 =cut
 491
 492 1;