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 = File::Spec->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
 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     return () unless exists $ENV{PATH};
 217     my @path = split(':', $ENV{PATH});
 218     foreach (@path) { $_ = '.' if $_ eq '' }
 219     return @path;
 220 }
 221
 222 =item join
 223
 224 join is the same as catfile.
 225
 226 =cut
 227
 228 sub join {
 229     my $self = shift;
 230     return $self->catfile(@_);
 231 }
 232
 233 =item splitpath
 234
 235     ($volume,$directories,$file) = File::Spec->splitpath( $path );
 236     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
 237
 238 Splits a path into volume, directory, and filename portions. On systems
 239 with no concept of volume, returns '' for volume.
 240
 241 For systems with no syntax differentiating filenames from directories,
 242 assumes that the last file is a path unless $no_file is true or a
 243 trailing separator or /. or /.. is present. On Unix this means that $no_file
 244 true makes this return ( '', $path, '' ).
 245
 246 The directory portion may or may not be returned with a trailing '/'.
 247
 248 The results can be passed to L</catpath()> to get back a path equivalent to
 249 (usually identical to) the original path.
 250
 251 =cut
 252
 253 sub splitpath {
 254     my ($self,$path, $nofile) = @_;
 255
 256     my ($volume,$directory,$file) = ('','','');
 257
 258     if ( $nofile ) {
 259         $directory = $path;
 260     }
 261     else {
 262         $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
 263         $directory = $1;
 264         $file      = $2;
 265     }
 266
 267     return ($volume,$directory,$file);
 268 }
 269
 270
 271 =item splitdir
 272
 273 The opposite of L</catdir()>.
 274
 275     @dirs = File::Spec->splitdir( $directories );
 276
 277 $directories must be only the directory portion of the path on systems
 278 that have the concept of a volume or that have path syntax that differentiates
 279 files from directories.
 280
 281 Unlike just splitting the directories on the separator, empty
 282 directory names (C<''>) can be returned, because these are significant
 283 on some OSs.
 284
 285 On Unix,
 286
 287     File::Spec->splitdir( "/a/b//c/" );
 288
 289 Yields:
 290
 291     ( '', 'a', 'b', '', 'c', '' )
 292
 293 =cut
 294
 295 sub splitdir {
 296     my ($self,$directories) = @_ ;
 297     #
 298     # split() likes to forget about trailing null fields, so here we
 299     # check to be sure that there will not be any before handling the
 300     # simple case.
 301     #
 302     if ( $directories !~ m|/\Z(?!\n)| ) {
 303         return split( m|/|, $directories );
 304     }
 305     else {
 306         #
 307         # since there was a trailing separator, add a file name to the end,
 308         # then do the split, then replace it with ''.
 309         #
 310         my( @directories )= split( m|/|, "${directories}dummy" ) ;
 311         $directories[ $#directories ]= '' ;
 312         return @directories ;
 313     }
 314 }
 315
 316
 317 =item catpath()
 318
 319 Takes volume, directory and file portions and returns an entire path. Under
 320 Unix, $volume is ignored, and directory and file are catenated.  A '/' is
 321 inserted if needed (though if the directory portion doesn't start with
 322 '/' it is not added).  On other OSs, $volume is significant.
 323
 324 =cut
 325
 326 sub catpath {
 327     my ($self,$volume,$directory,$file) = @_;
 328
 329     if ( $directory ne ''                &&
 330          $file ne ''                     &&
 331          substr( $directory, -1 ) ne '/' &&
 332          substr( $file, 0, 1 ) ne '/'
 333     ) {
 334         $directory .= "/$file" ;
 335     }
 336     else {
 337         $directory .= $file ;
 338     }
 339
 340     return $directory ;
 341 }
 342
 343 =item abs2rel
 344
 345 Takes a destination path and an optional base path returns a relative path
 346 from the base path to the destination path:
 347
 348     $rel_path = File::Spec->abs2rel( $path ) ;
 349     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 350
 351 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 352 then it is converted to absolute form using L</rel2abs()>. This means that it
 353 is taken to be relative to L<cwd()|Cwd>.
 354
 355 On systems with the concept of a volume, this assumes that both paths
 356 are on the $destination volume, and ignores the $base volume.
 357
 358 On systems that have a grammar that indicates filenames, this ignores the
 359 $base filename as well. Otherwise all path components are assumed to be
 360 directories.
 361
 362 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 363 This means that it is taken to be relative to L<cwd()|Cwd>.
 364
 365 No checks against the filesystem are made.  On VMS, there is
 366 interaction with the working environment, as logicals and
 367 macros are expanded.
 368
 369 Based on code written by Shigio Yamaguchi.
 370
 371 =cut
 372
 373 sub abs2rel {
 374     my($self,$path,$base) = @_;
 375
 376     # Clean up $path
 377     if ( ! $self->file_name_is_absolute( $path ) ) {
 378         $path = $self->rel2abs( $path ) ;
 379     }
 380     else {
 381         $path = $self->canonpath( $path ) ;
 382     }
 383
 384     # Figure out the effective $base and clean it up.
 385     if ( !defined( $base ) || $base eq '' ) {
 386         $base = cwd() ;
 387     }
 388     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 389         $base = $self->rel2abs( $base ) ;
 390     }
 391     else {
 392         $base = $self->canonpath( $base ) ;
 393     }
 394
 395     # Now, remove all leading components that are the same
 396     my @pathchunks = $self->splitdir( $path);
 397     my @basechunks = $self->splitdir( $base);
 398
 399     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
 400         shift @pathchunks ;
 401         shift @basechunks ;
 402     }
 403
 404     $path = CORE::join( '/', @pathchunks );
 405     $base = CORE::join( '/', @basechunks );
 406
 407     # $base now contains the directories the resulting relative path
 408     # must ascend out of before it can descend to $path_directory.  So,
 409     # replace all names with $parentDir
 410     $base =~ s|[^/]+|..|g ;
 411
 412     # Glue the two together, using a separator if necessary, and preventing an
 413     # empty result.
 414     if ( $path ne '' && $base ne '' ) {
 415         $path = "$base/$path" ;
 416     } else {
 417         $path = "$base$path" ;
 418     }
 419
 420     return $self->canonpath( $path ) ;
 421 }
 422
 423 =item rel2abs()
 424
 425 Converts a relative path to an absolute path.
 426
 427     $abs_path = File::Spec->rel2abs( $path ) ;
 428     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 429
 430 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 431 then it is converted to absolute form using L</rel2abs()>. This means that it
 432 is taken to be relative to L<cwd()|Cwd>.
 433
 434 On systems with the concept of a volume, this assumes that both paths
 435 are on the $base volume, and ignores the $path volume.
 436
 437 On systems that have a grammar that indicates filenames, this ignores the
 438 $base filename as well. Otherwise all path components are assumed to be
 439 directories.
 440
 441 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 442
 443 No checks against the filesystem are made.  On VMS, there is
 444 interaction with the working environment, as logicals and
 445 macros are expanded.
 446
 447 Based on code written by Shigio Yamaguchi.
 448
 449 =cut
 450
 451 sub rel2abs {
 452     my ($self,$path,$base ) = @_;
 453
 454     # Clean up $path
 455     if ( ! $self->file_name_is_absolute( $path ) ) {
 456         # Figure out the effective $base and clean it up.
 457         if ( !defined( $base ) || $base eq '' ) {
 458             $base = cwd() ;
 459         }
 460         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 461             $base = $self->rel2abs( $base ) ;
 462         }
 463         else {
 464             $base = $self->canonpath( $base ) ;
 465         }
 466
 467         # Glom them together
 468         $path = $self->catdir( $base, $path ) ;
 469     }
 470
 471     return $self->canonpath( $path ) ;
 472 }
 473
 474
 475 =back
 476
 477 =head1 SEE ALSO
 478
 479 L<File::Spec>
 480
 481 =cut
 482
 483 1;