1 package File::Spec::Win32;
6 require File::Spec::Unix;
7 @ISA = qw(File::Spec::Unix);
11 File::Spec::Win32 - methods for Win32 file specs
15 require File::Spec::Win32; # 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
27 Returns a string representation of the null device.
37 Returns a string representation of the first existing directory
38 from the following list:
50 return $tmpdir if defined $tmpdir;
52 foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
53 next unless defined && -d;
57 $tmpdir = '' unless defined $tmpdir;
58 $tmpdir = $self->canonpath($tmpdir);
62 sub file_name_is_absolute {
63 my ($self,$file) = @_;
64 return scalar($file =~ m{^([a-z]:)?[\\/]}i);
69 Concatenate one or more directory names and a filename to form a
70 complete path ending with a filename
77 return $file unless @_;
78 my $dir = $self->catdir(@_);
79 $dir .= "\\" unless substr($dir,-1) eq "\\";
84 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
85 my @path = split(';',$path);
86 foreach (@path) { $_ = '.' if $_ eq '' }
92 No physical check on the filesystem, but a logical cleanup of a
93 path. On UNIX eliminated successive slashes and successive "/.".
98 my ($self,$path,$reduce_ricochet) = @_;
99 $path =~ s/^([a-z]:)/\u$1/;
101 $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx
102 $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx
103 $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx
105 unless $path =~ m#^([A-Z]:)?\\$#; # xx/ -> xx
111 ($volume,$directories,$file) = File::Spec->splitpath( $path );
112 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
114 Splits a path in to volume, directory, and filename portions. Assumes that
115 the last file is a path unless the path ends in '\\', '\\.', '\\..'
116 or $no_file is true. On Win32 this means that $no_file true makes this return
117 ( $volume, $path, undef ).
119 Separators accepted are \ and /.
121 Volumes can be drive letters or UNC sharenames (\\server\share).
123 The results can be passed to L</catpath()> to get back a path equivalent to
124 (usually identical to) the original path.
129 my ($self,$path, $nofile) = @_;
130 my ($volume,$directory,$file) = ('','','');
133 m@^( (?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+)? )
141 m@^ ( (?: [a-zA-Z]: |
142 (?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+
145 ( (?:.*[\\\\/](?:\.\.?$)?)? )
153 return ($volume,$directory,$file);
159 The opposite of L</catdir()>.
161 @dirs = File::Spec->splitdir( $directories );
163 $directories must be only the directory portion of the path on systems
164 that have the concept of a volume or that have path syntax that differentiates
165 files from directories.
167 Unlike just splitting the directories on the separator, leading empty and
168 trailing directory entries can be returned, because these are significant
171 File::Spec->splitdir( "/a/b/c" );
175 ( '', 'a', 'b', '', 'c', '' )
180 my ($self,$directories) = @_ ;
182 # split() likes to forget about trailing null fields, so here we
183 # check to be sure that there will not be any before handling the
186 if ( $directories !~ m|[\\/]$| ) {
187 return split( m|[\\/]|, $directories );
191 # since there was a trailing separator, add a file name to the end,
192 # then do the split, then replace it with ''.
194 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
195 $directories[ $#directories ]= '' ;
196 return @directories ;
203 Takes volume, directory and file portions and returns an entire path. Under
204 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
205 the $volume become significant.
210 my ($self,$volume,$directory,$file) = @_;
212 # If it's UNC, make sure the glue separator is there, reusing
213 # whatever separator is first in the $volume
215 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+$@ &&
216 $directory =~ m@^[^\\/]@
219 $volume .= $directory ;
221 # If the volume is not just A:, make sure the glue separator is
222 # there, reusing whatever separator is first in the $volume if possible.
223 if ( $volume !~ m@^[a-zA-Z]:$@ &&
224 $volume !~ m@[\\/]$@ &&
227 $volume =~ m@([\\/])@ ;
228 my $sep = $1 ? $1 : '\\' ;
240 Takes a destination path and an optional base path returns a relative path
241 from the base path to the destination path:
243 $rel_path = File::Spec->abs2rel( $destination ) ;
244 $rel_path = File::Spec->abs2rel( $destination, $base ) ;
246 If $base is not present or '', then L</cwd()> is used. If $base is relative,
247 then it is converted to absolute form using L</rel2abs()>. This means that it
248 is taken to be relative to L<cwd()>.
250 On systems with the concept of a volume, this assumes that both paths
251 are on the $destination volume, and ignores the $base volume.
253 On systems that have a grammar that indicates filenames, this ignores the
254 $base filename as well. Otherwise all path components are assumed to be
257 If $path is relative, it is converted to absolute form using L</rel2abs()>.
258 This means that it is taken to be relative to L</cwd()>.
260 Based on code written by Shigio Yamaguchi.
262 No checks against the filesystem are made.
267 my($self,$path,$base) = @_;
270 if ( ! $self->file_name_is_absolute( $path ) ) {
271 $path = $self->rel2abs( $path ) ;
274 $path = $self->canonpath( $path ) ;
277 # Figure out the effective $base and clean it up.
278 if ( ! $self->file_name_is_absolute( $base ) ) {
279 $base = $self->rel2abs( $base ) ;
281 elsif ( !defined( $base ) || $base eq '' ) {
285 $base = $self->canonpath( $base ) ;
289 my ( $path_volume, $path_directories, $path_file ) =
290 $self->splitpath( $path, 1 ) ;
292 my ( undef, $base_directories, undef ) =
293 $self->splitpath( $base, 1 ) ;
295 # Now, remove all leading components that are the same
296 my @pathchunks = $self->splitdir( $path_directories );
297 my @basechunks = $self->splitdir( $base_directories );
299 while ( @pathchunks &&
301 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
307 # No need to catdir, we know these are well formed.
308 $path_directories = CORE::join( '\\', @pathchunks );
309 $base_directories = CORE::join( '\\', @basechunks );
311 # $base_directories now contains the directories the resulting relative
312 # path must ascend out of before it can descend to $path_directory. So,
313 # replace all names with $parentDir
315 #FA Need to replace between backslashes...
316 $base_directories =~ s|[^\\]+|..|g ;
318 # Glue the two together, using a separator if necessary, and preventing an
321 #FA Must check that new directories are not empty.
322 if ( $path_directories ne '' && $base_directories ne '' ) {
323 $path_directories = "$base_directories\\$path_directories" ;
325 $path_directories = "$base_directories$path_directories" ;
328 return $self->canonpath(
329 $self->catpath( $path_volume, $path_directories, $path_file )
335 Converts a relative path to an absolute path.
337 $abs_path = $File::Spec->rel2abs( $destination ) ;
338 $abs_path = $File::Spec->rel2abs( $destination, $base ) ;
340 If $base is not present or '', then L<cwd()> is used. If $base is relative,
341 then it is converted to absolute form using L</rel2abs()>. This means that it
342 is taken to be relative to L</cwd()>.
344 Assumes that both paths are on the $base volume, and ignores the
347 On systems that have a grammar that indicates filenames, this ignores the
348 $base filename as well. Otherwise all path components are assumed to be
351 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
353 Based on code written by Shigio Yamaguchi.
355 No checks against the filesystem are made.
360 my ($self,$path,$base ) = @_;
362 # Clean up and split up $path
363 if ( ! $self->file_name_is_absolute( $path ) ) {
365 # Figure out the effective $base and clean it up.
366 if ( ! $self->file_name_is_absolute( $base ) ) {
367 $base = $self->rel2abs( $base ) ;
369 elsif ( !defined( $base ) || $base eq '' ) {
373 $base = $self->canonpath( $base ) ;
377 my ( undef, $path_directories, $path_file ) =
378 $self->splitpath( $path, 1 ) ;
380 my ( $base_volume, $base_directories, undef ) =
381 $self->splitpath( $base, 1 ) ;
383 $path = $self->catpath(
385 $self->catdir( $base_directories, $path_directories ),
390 return $self->canonpath( $path ) ;