lib/File/Spec/Epoc.pm

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