lib/File/Spec/Epoc.pm

   1 package File::Spec::Epoc;
   2
   3 our $VERSION = '1.00';
   4
   5 use strict;
   6 use Cwd;
   7 use vars qw(@ISA);
   8 require File::Spec::Unix;
   9 @ISA = qw(File::Spec::Unix);
  10
  11 =head1 NAME
  12
  13 File::Spec::Epoc - methods for Epoc file specs
  14
  15 =head1 SYNOPSIS
  16
  17  require File::Spec::Epoc; # Done internally by File::Spec if needed
  18
  19 =head1 DESCRIPTION
  20
  21 See File::Spec::Unix for a documentation of the methods provided
  22 there. This package overrides the implementation of these methods, not
  23 the semantics.
  24
  25 This package is still work in progress ;-)
  26 o.flebbe@gmx.de
  27
  28
  29 =over 4
  30
  31 =item devnull
  32
  33 Returns a string representation of the null device.
  34
  35 =cut
  36
  37 sub devnull {
  38     return "nul:";
  39 }
  40
  41 =item tmpdir
  42
  43 Returns a string representation of a temporay directory:
  44
  45 =cut
  46
  47 my $tmpdir;
  48 sub tmpdir {
  49     return "C:/System/temp";
  50 }
  51
  52 sub case_tolerant {
  53     return 1;
  54 }
  55
  56 sub file_name_is_absolute {
  57     my ($self,$file) = @_;
  58     return scalar($file =~ m{^([a-z?]:)?[\\/]}is);
  59 }
  60
  61 =item path
  62
  63 Takes no argument, returns the environment variable PATH as an array. Since
  64 there is no search path supported, it returns undef, sorry.
  65
  66 =cut
  67
  68 sub path {
  69     return undef;
  70 }
  71
  72 =item canonpath()
  73
  74 No physical check on the filesystem, but a logical cleanup of a
  75 path. On UNIX eliminated successive slashes and successive "/.".
  76
  77 =cut
  78
  79 sub canonpath {
  80     my ($self,$path) = @_;
  81     $path =~ s/^([a-z]:)/\u$1/s;
  82
  83     $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
  84     $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
  85     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
  86     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
  87     $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
  88     return $path;
  89 }
  90
  91 =item splitpath
  92
  93     ($volume,$directories,$file) = File::Spec->splitpath( $path );
  94     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
  95
  96 Splits a path in to volume, directory, and filename portions. Assumes that
  97 the last file is a path unless the path ends in '\\', '\\.', '\\..'
  98 or $no_file is true.  On Win32 this means that $no_file true makes this return
  99 ( $volume, $path, undef ).
 100
 101 Separators accepted are \ and /.
 102
 103 The results can be passed to L</catpath> to get back a path equivalent to
 104 (usually identical to) the original path.
 105
 106 =cut
 107
 108 sub splitpath {
 109     my ($self,$path, $nofile) = @_;
 110     my ($volume,$directory,$file) = ('','','');
 111     if ( $nofile ) {
 112         $path =~
 113             m{^( (?:[a-zA-Z?]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
 114                  (.*)
 115              }xs;
 116         $volume    = $1;
 117         $directory = $2;
 118     }
 119     else {
 120         $path =~
 121             m{^ ( (?: [a-zA-Z?]: |
 122                       (?:\\\\|//)[^\\/]+[\\/][^\\/]+
 123                   )?
 124                 )
 125                 ( (?:.*[\\\\/](?:\.\.?\z)?)? )
 126                 (.*)
 127              }xs;
 128         $volume    = $1;
 129         $directory = $2;
 130         $file      = $3;
 131     }
 132
 133     return ($volume,$directory,$file);
 134 }
 135
 136
 137 =item splitdir
 138
 139 The opposite of L<catdir()|File::Spec/catdir()>.
 140
 141     @dirs = File::Spec->splitdir( $directories );
 142
 143 $directories must be only the directory portion of the path on systems
 144 that have the concept of a volume or that have path syntax that differentiates
 145 files from directories.
 146
 147 Unlike just splitting the directories on the separator, leading empty and
 148 trailing directory entries can be returned, because these are significant
 149 on some OSs. So,
 150
 151     File::Spec->splitdir( "/a/b/c" );
 152
 153 Yields:
 154
 155     ( '', 'a', 'b', '', 'c', '' )
 156
 157 =cut
 158
 159 sub splitdir {
 160     my ($self,$directories) = @_ ;
 161     #
 162     # split() likes to forget about trailing null fields, so here we
 163     # check to be sure that there will not be any before handling the
 164     # simple case.
 165     #
 166     if ( $directories !~ m|[\\/]\z| ) {
 167         return split( m|[\\/]|, $directories );
 168     }
 169     else {
 170         #
 171         # since there was a trailing separator, add a file name to the end,
 172         # then do the split, then replace it with ''.
 173         #
 174         my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
 175         $directories[ $#directories ]= '' ;
 176         return @directories ;
 177     }
 178 }
 179
 180
 181 =item catpath
 182
 183 Takes volume, directory and file portions and returns an entire path. Under
 184 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
 185 the $volume become significant.
 186
 187 =cut
 188
 189 sub catpath {
 190     my ($self,$volume,$directory,$file) = @_;
 191
 192     # If it's UNC, make sure the glue separator is there, reusing
 193     # whatever separator is first in the $volume
 194     $volume .= $1
 195         if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
 196              $directory =~ m@^[^\\/]@s
 197            ) ;
 198
 199     $volume .= $directory ;
 200
 201     # If the volume is not just A:, make sure the glue separator is
 202     # there, reusing whatever separator is first in the $volume if possible.
 203     if ( $volume !~ m@^[a-zA-Z]:\z@s &&
 204          $volume =~ m@[^\\/]\z@      &&
 205          $file   =~ m@[^\\/]@
 206        ) {
 207         $volume =~ m@([\\/])@ ;
 208         my $sep = $1 ? $1 : '\\' ;
 209         $volume .= $sep ;
 210     }
 211
 212     $volume .= $file ;
 213
 214     return $volume ;
 215 }
 216
 217
 218 =item abs2rel
 219
 220 Takes a destination path and an optional base path returns a relative path
 221 from the base path to the destination path:
 222
 223     $rel_path = File::Spec->abs2rel( $destination ) ;
 224     $rel_path = File::Spec->abs2rel( $destination, $base ) ;
 225
 226 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 227 then it is converted to absolute form using L</rel2abs()>. This means that it
 228 is taken to be relative to L<cwd()|Cwd>.
 229
 230 On systems with the concept of a volume, this assumes that both paths
 231 are on the $destination volume, and ignores the $base volume.
 232
 233 On systems that have a grammar that indicates filenames, this ignores the
 234 $base filename as well. Otherwise all path components are assumed to be
 235 directories.
 236
 237 If $path is relative, it is converted to absolute form using L</rel2abs()>.
 238 This means that it is taken to be relative to L<cwd()|Cwd>.
 239
 240 Based on code written by Shigio Yamaguchi.
 241
 242 No checks against the filesystem are made.
 243
 244 =cut
 245
 246 sub abs2rel {
 247     my($self,$path,$base) = @_;
 248
 249     # Clean up $path
 250     if ( ! $self->file_name_is_absolute( $path ) ) {
 251         $path = $self->rel2abs( $path ) ;
 252     }
 253     else {
 254         $path = $self->canonpath( $path ) ;
 255     }
 256
 257     # Figure out the effective $base and clean it up.
 258     if ( ! $self->file_name_is_absolute( $base ) ) {
 259         $base = $self->rel2abs( $base ) ;
 260     }
 261     elsif ( !defined( $base ) || $base eq '' ) {
 262         $base = cwd() ;
 263     }
 264     else {
 265         $base = $self->canonpath( $base ) ;
 266     }
 267
 268     # Split up paths
 269     my ( $path_volume, $path_directories, $path_file ) =
 270         $self->splitpath( $path, 1 ) ;
 271
 272     my ( undef, $base_directories, undef ) =
 273         $self->splitpath( $base, 1 ) ;
 274
 275     # Now, remove all leading components that are the same
 276     my @pathchunks = $self->splitdir( $path_directories );
 277     my @basechunks = $self->splitdir( $base_directories );
 278
 279     while ( @pathchunks &&
 280             @basechunks &&
 281             lc( $pathchunks[0] ) eq lc( $basechunks[0] )
 282           ) {
 283         shift @pathchunks ;
 284         shift @basechunks ;
 285     }
 286
 287     # No need to catdir, we know these are well formed.
 288     $path_directories = CORE::join( '\\', @pathchunks );
 289     $base_directories = CORE::join( '\\', @basechunks );
 290
 291     # $base_directories now contains the directories the resulting relative
 292     # path must ascend out of before it can descend to $path_directory.  So,
 293     # replace all names with $parentDir
 294
 295     #FA Need to replace between backslashes...
 296     $base_directories =~ s|[^\\]+|..|g ;
 297
 298     # Glue the two together, using a separator if necessary, and preventing an
 299     # empty result.
 300
 301     #FA Must check that new directories are not empty.
 302     if ( $path_directories ne '' && $base_directories ne '' ) {
 303         $path_directories = "$base_directories\\$path_directories" ;
 304     } else {
 305         $path_directories = "$base_directories$path_directories" ;
 306     }
 307
 308     # It makes no sense to add a relative path to a UNC volume
 309     $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
 310
 311     return $self->canonpath(
 312         $self->catpath($path_volume, $path_directories, $path_file )
 313     ) ;
 314 }
 315
 316 =item rel2abs()
 317
 318 Converts a relative path to an absolute path.
 319
 320     $abs_path = File::Spec->rel2abs( $destination ) ;
 321     $abs_path = File::Spec->rel2abs( $destination, $base ) ;
 322
 323 If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative,
 324 then it is converted to absolute form using L</rel2abs()>. This means that it
 325 is taken to be relative to L<cwd()|Cwd>.
 326
 327 Assumes that both paths are on the $base volume, and ignores the
 328 $destination volume.
 329
 330 On systems that have a grammar that indicates filenames, this ignores the
 331 $base filename as well. Otherwise all path components are assumed to be
 332 directories.
 333
 334 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 335
 336 Based on code written by Shigio Yamaguchi.
 337
 338 No checks against the filesystem are made.
 339
 340 =cut
 341
 342 sub rel2abs($;$;) {
 343     my ($self,$path,$base ) = @_;
 344
 345     if ( ! $self->file_name_is_absolute( $path ) ) {
 346
 347         if ( !defined( $base ) || $base eq '' ) {
 348             $base = cwd() ;
 349         }
 350         elsif ( ! $self->file_name_is_absolute( $base ) ) {
 351             $base = $self->rel2abs( $base ) ;
 352         }
 353         else {
 354             $base = $self->canonpath( $base ) ;
 355         }
 356
 357         my ( undef, $path_directories, $path_file ) =
 358             $self->splitpath( $path, 1 ) ;
 359
 360         my ( $base_volume, $base_directories, undef ) =
 361             $self->splitpath( $base, 1 ) ;
 362
 363         $path = $self->catpath(
 364             $base_volume,
 365             $self->catdir( $base_directories, $path_directories ),
 366             $path_file
 367         ) ;
 368     }
 369
 370     return $self->canonpath( $path ) ;
 371 }
 372
 373 =back
 374
 375 =head1 SEE ALSO
 376
 377 L<File::Spec>
 378
 379 =cut
 380
 381 1;