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     return split m|/|, $_[1], -1;  # Preserve trailing fields
 306 }
 307
 308
 309 =item catpath()
 310
 311 Takes volume, directory and file portions and returns an entire path. Under
 312 Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
 313 inserted if needed (though if the directory portion doesn't start with
 314 '/' it is not added).  On other OSs, $volume is significant.
 315
 316 =cut
 317
 318 sub catpath {
 319     my ($self,$volume,$directory,$file) = @_;
 320
 321     if ( $directory ne ''                &&
 322          $file ne ''                     &&
 323          substr( $directory, -1 ) ne '/' &&
 324          substr( $file, 0, 1 ) ne '/'
 325     ) {
 326         $directory .= "/$file" ;
 327     }
 328     else {
 329         $directory .= $file ;
 330     }
 331
 332     return $directory ;
 333 }
 334
 335 =item abs2rel
 336
 337 Takes a destination path and an optional base path returns a relative path
 338 from the base path to the destination path:
 339
 340     $rel_path = File::Spec->abs2rel( $path ) ;
 341     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 342
 343 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 344 then it is converted to absolute form using L</rel2abs()>. This means that it
 345 is taken to be relative to L<cwd()|Cwd>.
 346
 347 On systems with the concept of a volume, this assumes that both paths
 348 are on the $destination volume, and ignores the $base volume.
 349
 350 On systems that have a grammar that indicates filenames, this ignores the
 351 $base filename as well. Otherwise all path components are assumed to be
 352 directories.
 353
 354 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 355 This means that it is taken to be relative to L<cwd()|Cwd>.
 356
 357 No checks against the filesystem are made.  On VMS, there is
 358 interaction with the working environment, as logicals and
 359 macros are expanded.
 360
 361 Based on code written by Shigio Yamaguchi.
 362
 363 =cut
 364
 365 sub abs2rel {
 366     my($self,$path,$base) = @_;
 367
 368     # Clean up $path
 369     if ( ! $self->file_name_is_absolute( $path ) ) {
 370         $path = $self->rel2abs( $path ) ;
 371     }
 372     else {
 373         $path = $self->canonpath( $path ) ;
 374     }
 375
 376     # Figure out the effective $base and clean it up.
 377     if ( !defined( $base ) || $base eq '' ) {
 378         $base = cwd() ;
 379     }
 380     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 381         $base = $self->rel2abs( $base ) ;
 382     }
 383     else {
 384         $base = $self->canonpath( $base ) ;
 385     }
 386
 387     # Now, remove all leading components that are the same
 388     my @pathchunks = $self->splitdir( $path);
 389     my @basechunks = $self->splitdir( $base);
 390
 391     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
 392         shift @pathchunks ;
 393         shift @basechunks ;
 394     }
 395
 396     $path = CORE::join( '/', @pathchunks );
 397     $base = CORE::join( '/', @basechunks );
 398
 399     # $base now contains the directories the resulting relative path
 400     # must ascend out of before it can descend to $path_directory.  So,
 401     # replace all names with $parentDir
 402     $base =~ s|[^/]+|..|g ;
 403
 404     # Glue the two together, using a separator if necessary, and preventing an
 405     # empty result.
 406     if ( $path ne '' && $base ne '' ) {
 407         $path = "$base/$path" ;
 408     } else {
 409         $path = "$base$path" ;
 410     }
 411
 412     return $self->canonpath( $path ) ;
 413 }
 414
 415 =item rel2abs()
 416
 417 Converts a relative path to an absolute path.
 418
 419     $abs_path = File::Spec->rel2abs( $path ) ;
 420     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 421
 422 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 423 then it is converted to absolute form using L</rel2abs()>. This means that it
 424 is taken to be relative to L<cwd()|Cwd>.
 425
 426 On systems with the concept of a volume, this assumes that both paths
 427 are on the $base volume, and ignores the $path volume.
 428
 429 On systems that have a grammar that indicates filenames, this ignores the
 430 $base filename as well. Otherwise all path components are assumed to be
 431 directories.
 432
 433 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 434
 435 No checks against the filesystem are made.  On VMS, there is
 436 interaction with the working environment, as logicals and
 437 macros are expanded.
 438
 439 Based on code written by Shigio Yamaguchi.
 440
 441 =cut
 442
 443 sub rel2abs {
 444     my ($self,$path,$base ) = @_;
 445
 446     # Clean up $path
 447     if ( ! $self->file_name_is_absolute( $path ) ) {
 448         # Figure out the effective $base and clean it up.
 449         if ( !defined( $base ) || $base eq '' ) {
 450             $base = cwd() ;
 451         }
 452         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 453             $base = $self->rel2abs( $base ) ;
 454         }
 455         else {
 456             $base = $self->canonpath( $base ) ;
 457         }
 458
 459         # Glom them together
 460         $path = $self->catdir( $base, $path ) ;
 461     }
 462
 463     return $self->canonpath( $path ) ;
 464 }
 465
 466
 467 =back
 468
 469 =head1 SEE ALSO
 470
 471 L<File::Spec>
 472
 473 =cut
 474
 475 1;