lib/File/Spec/Unix.pm

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