lib/File/Spec/Unix.pm

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