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