lib/File/Spec/Unix.pm

   1 package File::Spec::Unix;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = '1.5';
   7
   8 =head1 NAME
   9
  10 File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
  11
  12 =head1 SYNOPSIS
  13
  14  require File::Spec::Unix; # Done automatically by File::Spec
  15
  16 =head1 DESCRIPTION
  17
  18 Methods for manipulating file specifications.  Other File::Spec
  19 modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
  20 override specific methods.
  21
  22 =head1 METHODS
  23
  24 =over 2
  25
  26 =item canonpath()
  27
  28 No physical check on the filesystem, but a logical cleanup of a
  29 path. On UNIX eliminates successive slashes and successive "/.".
  30
  31     $cpath = File::Spec->canonpath( $path ) ;
  32
  33 =cut
  34
  35 sub canonpath {
  36     my ($self,$path) = @_;
  37
  38     # Handle POSIX-style node names beginning with double slash (qnx, nto)
  39     # Handle network path names beginning with double slash (cygwin)
  40     # (POSIX says: "a pathname that begins with two successive slashes
  41     # may be interpreted in an implementation-defined manner, although
  42     # more than two leading slashes shall be treated as a single slash.")
  43     my $node = '';
  44     if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
  45       $node = $1;
  46     }
  47     # This used to be
  48     # $path =~ s|/+|/|g unless($^O eq 'cygwin');
  49     # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
  50     # (Mainly because trailing "" directories didn't get stripped).
  51     # Why would cygwin avoid collapsing multiple slashes into one? --jhi
  52     $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
  53     $path =~ s@(/\.)+(/|\Z(?!\n))@/@g;             # xx/././xx -> xx/xx
  54     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
  55     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
  56     $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
  57     return "$node$path";
  58 }
  59
  60 =item catdir()
  61
  62 Concatenate two or more directory names to form a complete path ending
  63 with a directory. But remove the trailing slash from the resulting
  64 string, because it doesn't look good, isn't necessary and confuses
  65 OS2. Of course, if this is the root directory, don't cut off the
  66 trailing slash :-)
  67
  68 =cut
  69
  70 sub catdir {
  71     my $self = shift;
  72
  73     $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
  74 }
  75
  76 =item catfile
  77
  78 Concatenate one or more directory names and a filename to form a
  79 complete path ending with a filename
  80
  81 =cut
  82
  83 sub catfile {
  84     my $self = shift;
  85     my $file = $self->canonpath(pop @_);
  86     return $file unless @_;
  87     my $dir = $self->catdir(@_);
  88     $dir .= "/" unless substr($dir,-1) eq "/";
  89     return $dir.$file;
  90 }
  91
  92 =item curdir
  93
  94 Returns a string representation of the current directory.  "." on UNIX.
  95
  96 =cut
  97
  98 sub curdir () { '.' }
  99
 100 =item devnull
 101
 102 Returns a string representation of the null device. "/dev/null" on UNIX.
 103
 104 =cut
 105
 106 sub devnull () { '/dev/null' }
 107
 108 =item rootdir
 109
 110 Returns a string representation of the root directory.  "/" on UNIX.
 111
 112 =cut
 113
 114 sub rootdir () { '/' }
 115
 116 =item tmpdir
 117
 118 Returns a string representation of the first writable directory from
 119 the following list or the current directory if none from the list are
 120 writable:
 121
 122     $ENV{TMPDIR}
 123     /tmp
 124
 125 Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
 126 is tainted, it is not used.
 127
 128 =cut
 129
 130 my $tmpdir;
 131 sub _tmpdir {
 132     return $tmpdir if defined $tmpdir;
 133     my $self = shift;
 134     my @dirlist = @_;
 135     {
 136         no strict 'refs';
 137         if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
 138             require Scalar::Util;
 139             @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
 140         }
 141     }
 142     foreach (@dirlist) {
 143         next unless defined && -d && -w _;
 144         $tmpdir = $_;
 145         last;
 146     }
 147     $tmpdir = $self->curdir unless defined $tmpdir;
 148     $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
 149     return $tmpdir;
 150 }
 151
 152 sub tmpdir {
 153     return $tmpdir if defined $tmpdir;
 154     my $self = shift;
 155     $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" );
 156 }
 157
 158 =item updir
 159
 160 Returns a string representation of the parent directory.  ".." on UNIX.
 161
 162 =cut
 163
 164 sub updir () { '..' }
 165
 166 =item no_upwards
 167
 168 Given a list of file names, strip out those that refer to a parent
 169 directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 170
 171 =cut
 172
 173 sub no_upwards {
 174     my $self = shift;
 175     return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
 176 }
 177
 178 =item case_tolerant
 179
 180 Returns a true or false value indicating, respectively, that alphabetic
 181 is not or is significant when comparing file specifications.
 182
 183 =cut
 184
 185 sub case_tolerant () { 0 }
 186
 187 =item file_name_is_absolute
 188
 189 Takes as argument a path and returns true if it is an absolute path.
 190
 191 This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
 192 OS (Classic).  It does consult the working environment for VMS (see
 193 L<File::Spec::VMS/file_name_is_absolute>).
 194
 195 =cut
 196
 197 sub file_name_is_absolute {
 198     my ($self,$file) = @_;
 199     return scalar($file =~ m:^/:s);
 200 }
 201
 202 =item path
 203
 204 Takes no argument, returns the environment variable PATH as an array.
 205
 206 =cut
 207
 208 sub path {
 209     return () unless exists $ENV{PATH};
 210     my @path = split(':', $ENV{PATH});
 211     foreach (@path) { $_ = '.' if $_ eq '' }
 212     return @path;
 213 }
 214
 215 =item join
 216
 217 join is the same as catfile.
 218
 219 =cut
 220
 221 sub join {
 222     my $self = shift;
 223     return $self->catfile(@_);
 224 }
 225
 226 =item splitpath
 227
 228     ($volume,$directories,$file) = File::Spec->splitpath( $path );
 229     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
 230
 231 Splits a path into volume, directory, and filename portions. On systems
 232 with no concept of volume, returns '' for volume.
 233
 234 For systems with no syntax differentiating filenames from directories,
 235 assumes that the last file is a path unless $no_file is true or a
 236 trailing separator or /. or /.. is present. On Unix this means that $no_file
 237 true makes this return ( '', $path, '' ).
 238
 239 The directory portion may or may not be returned with a trailing '/'.
 240
 241 The results can be passed to L</catpath()> to get back a path equivalent to
 242 (usually identical to) the original path.
 243
 244 =cut
 245
 246 sub splitpath {
 247     my ($self,$path, $nofile) = @_;
 248
 249     my ($volume,$directory,$file) = ('','','');
 250
 251     if ( $nofile ) {
 252         $directory = $path;
 253     }
 254     else {
 255         $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
 256         $directory = $1;
 257         $file      = $2;
 258     }
 259
 260     return ($volume,$directory,$file);
 261 }
 262
 263
 264 =item splitdir
 265
 266 The opposite of L</catdir()>.
 267
 268     @dirs = File::Spec->splitdir( $directories );
 269
 270 $directories must be only the directory portion of the path on systems
 271 that have the concept of a volume or that have path syntax that differentiates
 272 files from directories.
 273
 274 Unlike just splitting the directories on the separator, empty
 275 directory names (C<''>) can be returned, because these are significant
 276 on some OSs.
 277
 278 On Unix,
 279
 280     File::Spec->splitdir( "/a/b//c/" );
 281
 282 Yields:
 283
 284     ( '', 'a', 'b', '', 'c', '' )
 285
 286 =cut
 287
 288 sub splitdir {
 289     return split m|/|, $_[1], -1;  # Preserve trailing fields
 290 }
 291
 292
 293 =item catpath()
 294
 295 Takes volume, directory and file portions and returns an entire path. Under
 296 Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
 297 inserted if needed (though if the directory portion doesn't start with
 298 '/' it is not added).  On other OSs, $volume is significant.
 299
 300 =cut
 301
 302 sub catpath {
 303     my ($self,$volume,$directory,$file) = @_;
 304
 305     if ( $directory ne ''                &&
 306          $file ne ''                     &&
 307          substr( $directory, -1 ) ne '/' &&
 308          substr( $file, 0, 1 ) ne '/'
 309     ) {
 310         $directory .= "/$file" ;
 311     }
 312     else {
 313         $directory .= $file ;
 314     }
 315
 316     return $directory ;
 317 }
 318
 319 =item abs2rel
 320
 321 Takes a destination path and an optional base path returns a relative path
 322 from the base path to the destination path:
 323
 324     $rel_path = File::Spec->abs2rel( $path ) ;
 325     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 326
 327 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
 328 relative, then it is converted to absolute form using
 329 L</rel2abs()>. This means that it is taken to be relative to
 330 L<cwd()|Cwd>.
 331
 332 On systems that have a grammar that indicates filenames, this ignores the
 333 $base filename. Otherwise all path components are assumed to be
 334 directories.
 335
 336 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 337 This means that it is taken to be relative to L<cwd()|Cwd>.
 338
 339 No checks against the filesystem are made.  On VMS, there is
 340 interaction with the working environment, as logicals and
 341 macros are expanded.
 342
 343 Based on code written by Shigio Yamaguchi.
 344
 345 =cut
 346
 347 sub abs2rel {
 348     my($self,$path,$base) = @_;
 349
 350     # Clean up $path
 351     if ( ! $self->file_name_is_absolute( $path ) ) {
 352         $path = $self->rel2abs( $path ) ;
 353     }
 354     else {
 355         $path = $self->canonpath( $path ) ;
 356     }
 357
 358     # Figure out the effective $base and clean it up.
 359     if ( !defined( $base ) || $base eq '' ) {
 360         $base = $self->_cwd();
 361     }
 362     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 363         $base = $self->rel2abs( $base ) ;
 364     }
 365     else {
 366         $base = $self->canonpath( $base ) ;
 367     }
 368
 369     # Now, remove all leading components that are the same
 370     my @pathchunks = $self->splitdir( $path);
 371     my @basechunks = $self->splitdir( $base);
 372
 373     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
 374         shift @pathchunks ;
 375         shift @basechunks ;
 376     }
 377
 378     $path = CORE::join( '/', @pathchunks );
 379     $base = CORE::join( '/', @basechunks );
 380
 381     # $base now contains the directories the resulting relative path
 382     # must ascend out of before it can descend to $path_directory.  So,
 383     # replace all names with $parentDir
 384     $base =~ s|[^/]+|..|g ;
 385
 386     # Glue the two together, using a separator if necessary, and preventing an
 387     # empty result.
 388     if ( $path ne '' && $base ne '' ) {
 389         $path = "$base/$path" ;
 390     } else {
 391         $path = "$base$path" ;
 392     }
 393
 394     return $self->canonpath( $path ) ;
 395 }
 396
 397 =item rel2abs()
 398
 399 Converts a relative path to an absolute path.
 400
 401     $abs_path = File::Spec->rel2abs( $path ) ;
 402     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 403
 404 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
 405 relative, then it is converted to absolute form using
 406 L</rel2abs()>. This means that it is taken to be relative to
 407 L<cwd()|Cwd>.
 408
 409 On systems that have a grammar that indicates filenames, this ignores
 410 the $base filename. Otherwise all path components are assumed to be
 411 directories.
 412
 413 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 414
 415 No checks against the filesystem are made.  On VMS, there is
 416 interaction with the working environment, as logicals and
 417 macros are expanded.
 418
 419 Based on code written by Shigio Yamaguchi.
 420
 421 =cut
 422
 423 sub rel2abs {
 424     my ($self,$path,$base ) = @_;
 425
 426     # Clean up $path
 427     if ( ! $self->file_name_is_absolute( $path ) ) {
 428         # Figure out the effective $base and clean it up.
 429         if ( !defined( $base ) || $base eq '' ) {
 430             $base = $self->_cwd();
 431         }
 432         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 433             $base = $self->rel2abs( $base ) ;
 434         }
 435         else {
 436             $base = $self->canonpath( $base ) ;
 437         }
 438
 439         # Glom them together
 440         $path = $self->catdir( $base, $path ) ;
 441     }
 442
 443     return $self->canonpath( $path ) ;
 444 }
 445
 446 =back
 447
 448 =head1 COPYRIGHT
 449
 450 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
 451
 452 This program is free software; you can redistribute it and/or modify
 453 it under the same terms as Perl itself.
 454
 455 =head1 SEE ALSO
 456
 457 L<File::Spec>
 458
 459 =cut
 460
 461 # Internal routine to File::Spec, no point in making this public since
 462 # it is the standard Cwd interface.  Most of the platform-specific
 463 # File::Spec subclasses use this.
 464 sub _cwd {
 465     require Cwd;
 466     Cwd::cwd();
 467 }
 468
 469 1;