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