lib/File/Spec/Unix.pm

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