lib/File/Spec/Unix.pm

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