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