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:
51 return $tmpdir if defined $tmpdir;
53 foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
54 next unless defined && -d;
58 $tmpdir = '' unless defined $tmpdir;
59 $tmpdir = $self->canonpath($tmpdir);
67 sub file_name_is_absolute {
68 my ($self,$file) = @_;
69 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
74 Concatenate one or more directory names and a filename to form a
75 complete path ending with a filename
82 return $file unless @_;
83 my $dir = $self->catdir(@_);
84 $dir .= "\\" unless substr($dir,-1) eq "\\";
89 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
90 my @path = split(';',$path);
91 foreach (@path) { $_ = '.' if $_ eq '' }
97 No physical check on the filesystem, but a logical cleanup of a
98 path. On UNIX eliminated successive slashes and successive "/.".
103 my ($self,$path) = @_;
104 $path =~ s/^([a-z]:)/\u$1/s;
106 $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx
107 $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx
108 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx
109 $path =~ s|\\\Z(?!\n)||
110 unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx/ -> xx
116 ($volume,$directories,$file) = File::Spec->splitpath( $path );
117 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
119 Splits a path in to volume, directory, and filename portions. Assumes that
120 the last file is a path unless the path ends in '\\', '\\.', '\\..'
121 or $no_file is true. On Win32 this means that $no_file true makes this return
122 ( $volume, $path, undef ).
124 Separators accepted are \ and /.
126 Volumes can be drive letters or UNC sharenames (\\server\share).
128 The results can be passed to L</catpath> to get back a path equivalent to
129 (usually identical to) the original path.
134 my ($self,$path, $nofile) = @_;
135 my ($volume,$directory,$file) = ('','','');
138 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
146 m{^ ( (?: [a-zA-Z]: |
147 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
150 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
158 return ($volume,$directory,$file);
164 The opposite of L</catdir()>.
166 @dirs = File::Spec->splitdir( $directories );
168 $directories must be only the directory portion of the path on systems
169 that have the concept of a volume or that have path syntax that differentiates
170 files from directories.
172 Unlike just splitting the directories on the separator, leading empty and
173 trailing directory entries can be returned, because these are significant
176 File::Spec->splitdir( "/a/b/c" );
180 ( '', 'a', 'b', '', 'c', '' )
185 my ($self,$directories) = @_ ;
187 # split() likes to forget about trailing null fields, so here we
188 # check to be sure that there will not be any before handling the
191 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
192 return split( m|[\\/]|, $directories );
196 # since there was a trailing separator, add a file name to the end,
197 # then do the split, then replace it with ''.
199 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
200 $directories[ $#directories ]= '' ;
201 return @directories ;
208 Takes volume, directory and file portions and returns an entire path. Under
209 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
210 the $volume become significant.
215 my ($self,$volume,$directory,$file) = @_;
217 # If it's UNC, make sure the glue separator is there, reusing
218 # whatever separator is first in the $volume
220 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
221 $directory =~ m@^[^\\/]@s
224 $volume .= $directory ;
226 # If the volume is not just A:, make sure the glue separator is
227 # there, reusing whatever separator is first in the $volume if possible.
228 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
229 $volume =~ m@[^\\/]\Z(?!\n)@ &&
232 $volume =~ m@([\\/])@ ;
233 my $sep = $1 ? $1 : '\\' ;
245 Takes a destination path and an optional base path returns a relative path
246 from the base path to the destination path:
248 $rel_path = File::Spec->abs2rel( $destination ) ;
249 $rel_path = File::Spec->abs2rel( $destination, $base ) ;
251 If $base is not present or '', then L</cwd()> is used. If $base is relative,
252 then it is converted to absolute form using L</rel2abs()>. This means that it
253 is taken to be relative to L<cwd()>.
255 On systems with the concept of a volume, this assumes that both paths
256 are on the $destination volume, and ignores the $base volume.
258 On systems that have a grammar that indicates filenames, this ignores the
259 $base filename as well. Otherwise all path components are assumed to be
262 If $path is relative, it is converted to absolute form using L</rel2abs()>.
263 This means that it is taken to be relative to L</cwd()>.
265 Based on code written by Shigio Yamaguchi.
267 No checks against the filesystem are made.
272 my($self,$path,$base) = @_;
275 if ( ! $self->file_name_is_absolute( $path ) ) {
276 $path = $self->rel2abs( $path ) ;
279 $path = $self->canonpath( $path ) ;
282 # Figure out the effective $base and clean it up.
283 if ( ! $self->file_name_is_absolute( $base ) ) {
284 $base = $self->rel2abs( $base ) ;
286 elsif ( !defined( $base ) || $base eq '' ) {
290 $base = $self->canonpath( $base ) ;
294 my ( $path_volume, $path_directories, $path_file ) =
295 $self->splitpath( $path, 1 ) ;
297 my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
299 # Now, remove all leading components that are the same
300 my @pathchunks = $self->splitdir( $path_directories );
301 my @basechunks = $self->splitdir( $base_directories );
303 while ( @pathchunks &&
305 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
311 # No need to catdir, we know these are well formed.
312 $path_directories = CORE::join( '\\', @pathchunks );
313 $base_directories = CORE::join( '\\', @basechunks );
315 # $base_directories now contains the directories the resulting relative
316 # path must ascend out of before it can descend to $path_directory. So,
317 # replace all names with $parentDir
319 #FA Need to replace between backslashes...
320 $base_directories =~ s|[^\\]+|..|g ;
322 # Glue the two together, using a separator if necessary, and preventing an
325 #FA Must check that new directories are not empty.
326 if ( $path_directories ne '' && $base_directories ne '' ) {
327 $path_directories = "$base_directories\\$path_directories" ;
329 $path_directories = "$base_directories$path_directories" ;
332 # It makes no sense to add a relative path to a UNC volume
333 $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
335 return $self->canonpath(
336 $self->catpath($path_volume, $path_directories, $path_file )
342 Converts a relative path to an absolute path.
344 $abs_path = File::Spec->rel2abs( $destination ) ;
345 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
347 If $base is not present or '', then L<cwd()> is used. If $base is relative,
348 then it is converted to absolute form using L</rel2abs()>. This means that it
349 is taken to be relative to L</cwd()>.
351 Assumes that both paths are on the $base volume, and ignores the
354 On systems that have a grammar that indicates filenames, this ignores the
355 $base filename as well. Otherwise all path components are assumed to be
358 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
360 Based on code written by Shigio Yamaguchi.
362 No checks against the filesystem are made.
367 my ($self,$path,$base ) = @_;
369 if ( ! $self->file_name_is_absolute( $path ) ) {
371 if ( !defined( $base ) || $base eq '' ) {
374 elsif ( ! $self->file_name_is_absolute( $base ) ) {
375 $base = $self->rel2abs( $base ) ;
378 $base = $self->canonpath( $base ) ;
381 my ( $path_directories, $path_file ) =
382 ($self->splitpath( $path, 1 ))[1,2] ;
384 my ( $base_volume, $base_directories ) =
385 $self->splitpath( $base, 1 ) ;
387 $path = $self->catpath(
389 $self->catdir( $base_directories, $path_directories ),
394 return $self->canonpath( $path ) ;