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