lib/File/Spec/Unix.pm

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