1 package File::Spec::Epoc;
6 require File::Spec::Unix;
7 @ISA = qw(File::Spec::Unix);
11 File::Spec::Epoc - methods for Epoc file specs
15 require File::Spec::Epoc; # Done internally by File::Spec if needed
19 See File::Spec::Unix for a documentation of the methods provided
20 there. This package overrides the implementation of these methods, not
23 This package is still work in progress ;-)
31 Returns a string representation of the null device.
41 Returns a string representation of a temporay directory:
47 return "C:/System/temp";
54 sub file_name_is_absolute {
55 my ($self,$file) = @_;
56 return scalar($file =~ m{^([a-z?]:)?[\\/]}is);
61 Takes no argument, returns the environment variable PATH as an array. Since
62 there is no search path supported, it returns undef, sorry.
72 No physical check on the filesystem, but a logical cleanup of a
73 path. On UNIX eliminated successive slashes and successive "/.".
78 my ($self,$path) = @_;
79 $path =~ s/^([a-z]:)/\u$1/s;
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
91 ($volume,$directories,$file) = File::Spec->splitpath( $path );
92 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
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 ).
99 Separators accepted are \ and /.
101 The results can be passed to L</catpath> to get back a path equivalent to
102 (usually identical to) the original path.
107 my ($self,$path, $nofile) = @_;
108 my ($volume,$directory,$file) = ('','','');
111 m{^( (?:[a-zA-Z?]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
119 m{^ ( (?: [a-zA-Z?]: |
120 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
123 ( (?:.*[\\\\/](?:\.\.?\z)?)? )
131 return ($volume,$directory,$file);
137 The opposite of L</catdir()>.
139 @dirs = File::Spec->splitdir( $directories );
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.
145 Unlike just splitting the directories on the separator, leading empty and
146 trailing directory entries can be returned, because these are significant
149 File::Spec->splitdir( "/a/b/c" );
153 ( '', 'a', 'b', '', 'c', '' )
158 my ($self,$directories) = @_ ;
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
164 if ( $directories !~ m|[\\/]\z| ) {
165 return split( m|[\\/]|, $directories );
169 # since there was a trailing separator, add a file name to the end,
170 # then do the split, then replace it with ''.
172 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
173 $directories[ $#directories ]= '' ;
174 return @directories ;
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.
188 my ($self,$volume,$directory,$file) = @_;
190 # If it's UNC, make sure the glue separator is there, reusing
191 # whatever separator is first in the $volume
193 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
194 $directory =~ m@^[^\\/]@s
197 $volume .= $directory ;
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@ &&
205 $volume =~ m@([\\/])@ ;
206 my $sep = $1 ? $1 : '\\' ;
218 Takes a destination path and an optional base path returns a relative path
219 from the base path to the destination path:
221 $rel_path = File::Spec->abs2rel( $destination ) ;
222 $rel_path = File::Spec->abs2rel( $destination, $base ) ;
224 If $base is not present or '', then L</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()>.
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.
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
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()>.
238 Based on code written by Shigio Yamaguchi.
240 No checks against the filesystem are made.
245 my($self,$path,$base) = @_;
248 if ( ! $self->file_name_is_absolute( $path ) ) {
249 $path = $self->rel2abs( $path ) ;
252 $path = $self->canonpath( $path ) ;
255 # Figure out the effective $base and clean it up.
256 if ( ! $self->file_name_is_absolute( $base ) ) {
257 $base = $self->rel2abs( $base ) ;
259 elsif ( !defined( $base ) || $base eq '' ) {
263 $base = $self->canonpath( $base ) ;
267 my ( $path_volume, $path_directories, $path_file ) =
268 $self->splitpath( $path, 1 ) ;
270 my ( undef, $base_directories, undef ) =
271 $self->splitpath( $base, 1 ) ;
273 # Now, remove all leading components that are the same
274 my @pathchunks = $self->splitdir( $path_directories );
275 my @basechunks = $self->splitdir( $base_directories );
277 while ( @pathchunks &&
279 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
285 # No need to catdir, we know these are well formed.
286 $path_directories = CORE::join( '\\', @pathchunks );
287 $base_directories = CORE::join( '\\', @basechunks );
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
293 #FA Need to replace between backslashes...
294 $base_directories =~ s|[^\\]+|..|g ;
296 # Glue the two together, using a separator if necessary, and preventing an
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" ;
303 $path_directories = "$base_directories$path_directories" ;
306 # It makes no sense to add a relative path to a UNC volume
307 $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
309 return $self->canonpath(
310 $self->catpath($path_volume, $path_directories, $path_file )
316 Converts a relative path to an absolute path.
318 $abs_path = File::Spec->rel2abs( $destination ) ;
319 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
321 If $base is not present or '', then L<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()>.
325 Assumes that both paths are on the $base volume, and ignores the
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
332 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
334 Based on code written by Shigio Yamaguchi.
336 No checks against the filesystem are made.
341 my ($self,$path,$base ) = @_;
343 if ( ! $self->file_name_is_absolute( $path ) ) {
345 if ( !defined( $base ) || $base eq '' ) {
348 elsif ( ! $self->file_name_is_absolute( $base ) ) {
349 $base = $self->rel2abs( $base ) ;
352 $base = $self->canonpath( $base ) ;
355 my ( undef, $path_directories, $path_file ) =
356 $self->splitpath( $path, 1 ) ;
358 my ( $base_volume, $base_directories, undef ) =
359 $self->splitpath( $base, 1 ) ;
361 $path = $self->catpath(
363 $self->catdir( $base_directories, $path_directories ),
368 return $self->canonpath( $path ) ;