lib/File/Spec/Unix.pm

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