1 package File::Spec::Epoc;
8 require File::Spec::Unix;
9 @ISA = qw(File::Spec::Unix);
13 File::Spec::Epoc - methods for Epoc file specs
17 require File::Spec::Epoc; # Done internally by File::Spec if needed
21 See File::Spec::Unix for a documentation of the methods provided
22 there. This package overrides the implementation of these methods, not
25 This package is still work in progress ;-)
33 Returns a string representation of the null device.
43 Returns a string representation of a temporay directory:
49 return "C:/System/temp";
56 sub file_name_is_absolute {
57 my ($self,$file) = @_;
58 return scalar($file =~ m{^([a-z?]:)?[\\/]}is);
63 Takes no argument, returns the environment variable PATH as an array. Since
64 there is no search path supported, it returns undef, sorry.
74 No physical check on the filesystem, but a logical cleanup of a
75 path. On UNIX eliminated successive slashes and successive "/.".
80 my ($self,$path) = @_;
81 $path =~ s/^([a-z]:)/\u$1/s;
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
93 ($volume,$directories,$file) = File::Spec->splitpath( $path );
94 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
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 ).
101 Separators accepted are \ and /.
103 The results can be passed to L</catpath> to get back a path equivalent to
104 (usually identical to) the original path.
109 my ($self,$path, $nofile) = @_;
110 my ($volume,$directory,$file) = ('','','');
113 m{^( (?:[a-zA-Z?]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
121 m{^ ( (?: [a-zA-Z?]: |
122 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
125 ( (?:.*[\\\\/](?:\.\.?\z)?)? )
133 return ($volume,$directory,$file);
139 The opposite of L<catdir()|File::Spec/catdir()>.
141 @dirs = File::Spec->splitdir( $directories );
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.
147 Unlike just splitting the directories on the separator, leading empty and
148 trailing directory entries can be returned, because these are significant
151 File::Spec->splitdir( "/a/b/c" );
155 ( '', 'a', 'b', '', 'c', '' )
160 my ($self,$directories) = @_ ;
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
166 if ( $directories !~ m|[\\/]\z| ) {
167 return split( m|[\\/]|, $directories );
171 # since there was a trailing separator, add a file name to the end,
172 # then do the split, then replace it with ''.
174 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
175 $directories[ $#directories ]= '' ;
176 return @directories ;
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.
190 my ($self,$volume,$directory,$file) = @_;
192 # If it's UNC, make sure the glue separator is there, reusing
193 # whatever separator is first in the $volume
195 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
196 $directory =~ m@^[^\\/]@s
199 $volume .= $directory ;
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@ &&
207 $volume =~ m@([\\/])@ ;
208 my $sep = $1 ? $1 : '\\' ;
220 Takes a destination path and an optional base path returns a relative path
221 from the base path to the destination path:
223 $rel_path = File::Spec->abs2rel( $destination ) ;
224 $rel_path = File::Spec->abs2rel( $destination, $base ) ;
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>.
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.
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
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>.
240 Based on code written by Shigio Yamaguchi.
242 No checks against the filesystem are made.
247 my($self,$path,$base) = @_;
250 if ( ! $self->file_name_is_absolute( $path ) ) {
251 $path = $self->rel2abs( $path ) ;
254 $path = $self->canonpath( $path ) ;
257 # Figure out the effective $base and clean it up.
258 if ( ! $self->file_name_is_absolute( $base ) ) {
259 $base = $self->rel2abs( $base ) ;
261 elsif ( !defined( $base ) || $base eq '' ) {
265 $base = $self->canonpath( $base ) ;
269 my ( $path_volume, $path_directories, $path_file ) =
270 $self->splitpath( $path, 1 ) ;
272 my ( undef, $base_directories, undef ) =
273 $self->splitpath( $base, 1 ) ;
275 # Now, remove all leading components that are the same
276 my @pathchunks = $self->splitdir( $path_directories );
277 my @basechunks = $self->splitdir( $base_directories );
279 while ( @pathchunks &&
281 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
287 # No need to catdir, we know these are well formed.
288 $path_directories = CORE::join( '\\', @pathchunks );
289 $base_directories = CORE::join( '\\', @basechunks );
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
295 #FA Need to replace between backslashes...
296 $base_directories =~ s|[^\\]+|..|g ;
298 # Glue the two together, using a separator if necessary, and preventing an
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" ;
305 $path_directories = "$base_directories$path_directories" ;
308 # It makes no sense to add a relative path to a UNC volume
309 $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
311 return $self->canonpath(
312 $self->catpath($path_volume, $path_directories, $path_file )
318 Converts a relative path to an absolute path.
320 $abs_path = File::Spec->rel2abs( $destination ) ;
321 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
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>.
327 Assumes that both paths are on the $base volume, and ignores the
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
334 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
336 Based on code written by Shigio Yamaguchi.
338 No checks against the filesystem are made.
343 my ($self,$path,$base ) = @_;
345 if ( ! $self->file_name_is_absolute( $path ) ) {
347 if ( !defined( $base ) || $base eq '' ) {
350 elsif ( ! $self->file_name_is_absolute( $base ) ) {
351 $base = $self->rel2abs( $base ) ;
354 $base = $self->canonpath( $base ) ;
357 my ( undef, $path_directories, $path_file ) =
358 $self->splitpath( $path, 1 ) ;
360 my ( $base_volume, $base_directories, undef ) =
361 $self->splitpath( $base, 1 ) ;
363 $path = $self->catpath(
365 $self->catdir( $base_directories, $path_directories ),
370 return $self->canonpath( $path ) ;