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