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.
 348
 349 On systems that have a grammar that indicates filenames, this ignores the
 350 $base filename as well. Otherwise all path components are assumed to be
 351 directories.
 352
 353 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 354 This means that it is taken to be relative to L<cwd()|Cwd>.
 355
 356 No checks against the filesystem are made.  On VMS, there is
 357 interaction with the working environment, as logicals and
 358 macros are expanded.
 359
 360 Based on code written by Shigio Yamaguchi.
 361
 362 =cut
 363
 364 sub abs2rel {
 365     my($self,$path,$base) = @_;
 366
 367     # Clean up $path
 368     if ( ! $self->file_name_is_absolute( $path ) ) {
 369         $path = $self->rel2abs( $path ) ;
 370     }
 371     else {
 372         $path = $self->canonpath( $path ) ;
 373     }
 374
 375     # Figure out the effective $base and clean it up.
 376     if ( !defined( $base ) || $base eq '' ) {
 377         $base = $self->cwd();
 378     }
 379     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 380         $base = $self->rel2abs( $base ) ;
 381     }
 382     else {
 383         $base = $self->canonpath( $base ) ;
 384     }
 385
 386     # Now, remove all leading components that are the same
 387     my @pathchunks = $self->splitdir( $path);
 388     my @basechunks = $self->splitdir( $base);
 389
 390     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
 391         shift @pathchunks ;
 392         shift @basechunks ;
 393     }
 394
 395     $path = CORE::join( '/', @pathchunks );
 396     $base = CORE::join( '/', @basechunks );
 397
 398     # $base now contains the directories the resulting relative path
 399     # must ascend out of before it can descend to $path_directory.  So,
 400     # replace all names with $parentDir
 401     $base =~ s|[^/]+|..|g ;
 402
 403     # Glue the two together, using a separator if necessary, and preventing an
 404     # empty result.
 405     if ( $path ne '' && $base ne '' ) {
 406         $path = "$base/$path" ;
 407     } else {
 408         $path = "$base$path" ;
 409     }
 410
 411     return $self->canonpath( $path ) ;
 412 }
 413
 414 =item rel2abs()
 415
 416 Converts a relative path to an absolute path.
 417
 418     $abs_path = File::Spec->rel2abs( $path ) ;
 419     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 420
 421 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 422 then it is converted to absolute form using L</rel2abs()>. This means that it
 423 is taken to be relative to L<cwd()|Cwd>.
 424
 425 On systems with the concept of a volume, this assumes that both paths
 426 are on the $base volume, and ignores the $path volume.
 427
 428 On systems that have a grammar that indicates filenames, this ignores the
 429 $base filename as well. Otherwise all path components are assumed to be
 430 directories.
 431
 432 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 433
 434 No checks against the filesystem are made.  On VMS, there is
 435 interaction with the working environment, as logicals and
 436 macros are expanded.
 437
 438 Based on code written by Shigio Yamaguchi.
 439
 440 =cut
 441
 442 sub rel2abs {
 443     my ($self,$path,$base ) = @_;
 444
 445     # Clean up $path
 446     if ( ! $self->file_name_is_absolute( $path ) ) {
 447         # Figure out the effective $base and clean it up.
 448         if ( !defined( $base ) || $base eq '' ) {
 449             $base = $self->cwd();
 450         }
 451         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 452             $base = $self->rel2abs( $base ) ;
 453         }
 454         else {
 455             $base = $self->canonpath( $base ) ;
 456         }
 457
 458         # Glom them together
 459         $path = $self->catdir( $base, $path ) ;
 460     }
 461
 462     return $self->canonpath( $path ) ;
 463 }
 464
 465 =back
 466
 467 =head1 SEE ALSO
 468
 469 L<File::Spec>
 470
 471 =cut
 472
 473 # Internal routine to File::Spec, no point in publicly documenting
 474 # this interface since it's the standard Cwd interface.  Some of the
 475 # platform-specific File::Spec subclasses use this.
 476 sub cwd {
 477     require Cwd;
 478     Cwd::cwd();
 479 }
 480
 481 1;