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