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