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