lib/File/Spec/Unix.pm

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