1 package File::Spec::Win32;
5 use vars qw(@ISA $VERSION);
6 require File::Spec::Unix;
10 @ISA = qw(File::Spec::Unix);
14 File::Spec::Win32 - methods for Win32 file specs
18 require File::Spec::Win32; # Done internally by File::Spec if needed
22 See File::Spec::Unix for a documentation of the methods provided
23 there. This package overrides the implementation of these methods, not
30 Returns a string representation of the null device.
40 Returns a string representation of the first existing directory
41 from the following list:
50 Since perl 5.8.0, if running under taint mode, and if the environment
51 variables are tainted, they are not used.
57 return $tmpdir if defined $tmpdir;
59 my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /));
62 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
64 @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
68 next unless defined && -d;
72 $tmpdir = '' unless defined $tmpdir;
73 $tmpdir = $self->canonpath($tmpdir);
81 sub file_name_is_absolute {
82 my ($self,$file) = @_;
83 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
88 Concatenate one or more directory names and a filename to form a
89 complete path ending with a filename
96 return $file unless @_;
97 my $dir = $self->catdir(@_);
98 $dir .= "\\" unless substr($dir,-1) eq "\\";
103 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
104 my @path = split(';',$path);
105 foreach (@path) { $_ = '.' if $_ eq '' }
111 No physical check on the filesystem, but a logical cleanup of a
112 path. On UNIX eliminated successive slashes and successive "/.".
117 my ($self,$path) = @_;
118 $path =~ s/^([a-z]:)/\u$1/s;
120 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
121 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
122 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
123 $path =~ s|\\\Z(?!\n)||
124 unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx\ -> xx
130 ($volume,$directories,$file) = File::Spec->splitpath( $path );
131 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
133 Splits a path in to volume, directory, and filename portions. Assumes that
134 the last file is a path unless the path ends in '\\', '\\.', '\\..'
135 or $no_file is true. On Win32 this means that $no_file true makes this return
136 ( $volume, $path, undef ).
138 Separators accepted are \ and /.
140 Volumes can be drive letters or UNC sharenames (\\server\share).
142 The results can be passed to L</catpath> to get back a path equivalent to
143 (usually identical to) the original path.
148 my ($self,$path, $nofile) = @_;
149 my ($volume,$directory,$file) = ('','','');
152 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
160 m{^ ( (?: [a-zA-Z]: |
161 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
164 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
172 return ($volume,$directory,$file);
178 The opposite of L<catdir()|File::Spec/catdir()>.
180 @dirs = File::Spec->splitdir( $directories );
182 $directories must be only the directory portion of the path on systems
183 that have the concept of a volume or that have path syntax that differentiates
184 files from directories.
186 Unlike just splitting the directories on the separator, leading empty and
187 trailing directory entries can be returned, because these are significant
190 File::Spec->splitdir( "/a/b/c" );
194 ( '', 'a', 'b', '', 'c', '' )
199 my ($self,$directories) = @_ ;
201 # split() likes to forget about trailing null fields, so here we
202 # check to be sure that there will not be any before handling the
205 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
206 return split( m|[\\/]|, $directories );
210 # since there was a trailing separator, add a file name to the end,
211 # then do the split, then replace it with ''.
213 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
214 $directories[ $#directories ]= '' ;
215 return @directories ;
222 Takes volume, directory and file portions and returns an entire path. Under
223 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
224 the $volume become significant.
229 my ($self,$volume,$directory,$file) = @_;
231 # If it's UNC, make sure the glue separator is there, reusing
232 # whatever separator is first in the $volume
234 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
235 $directory =~ m@^[^\\/]@s
238 $volume .= $directory ;
240 # If the volume is not just A:, make sure the glue separator is
241 # there, reusing whatever separator is first in the $volume if possible.
242 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
243 $volume =~ m@[^\\/]\Z(?!\n)@ &&
246 $volume =~ m@([\\/])@ ;
247 my $sep = $1 ? $1 : '\\' ;
258 my($self,$path,$base) = @_;
261 if ( ! $self->file_name_is_absolute( $path ) ) {
262 $path = $self->rel2abs( $path ) ;
265 $path = $self->canonpath( $path ) ;
268 # Figure out the effective $base and clean it up.
269 if ( !defined( $base ) || $base eq '' ) {
272 elsif ( ! $self->file_name_is_absolute( $base ) ) {
273 $base = $self->rel2abs( $base ) ;
276 $base = $self->canonpath( $base ) ;
280 my ( undef, $path_directories, $path_file ) =
281 $self->splitpath( $path, 1 ) ;
283 my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
285 # Now, remove all leading components that are the same
286 my @pathchunks = $self->splitdir( $path_directories );
287 my @basechunks = $self->splitdir( $base_directories );
289 while ( @pathchunks &&
291 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
297 # No need to catdir, we know these are well formed.
298 $path_directories = CORE::join( '\\', @pathchunks );
299 $base_directories = CORE::join( '\\', @basechunks );
301 # $base_directories now contains the directories the resulting relative
302 # path must ascend out of before it can descend to $path_directory. So,
303 # replace all names with $parentDir
305 #FA Need to replace between backslashes...
306 $base_directories =~ s|[^\\]+|..|g ;
308 # Glue the two together, using a separator if necessary, and preventing an
311 #FA Must check that new directories are not empty.
312 if ( $path_directories ne '' && $base_directories ne '' ) {
313 $path_directories = "$base_directories\\$path_directories" ;
315 $path_directories = "$base_directories$path_directories" ;
318 return $self->canonpath(
319 $self->catpath( "", $path_directories, $path_file )
325 my ($self,$path,$base ) = @_;
327 if ( ! $self->file_name_is_absolute( $path ) ) {
329 if ( !defined( $base ) || $base eq '' ) {
332 elsif ( ! $self->file_name_is_absolute( $base ) ) {
333 $base = $self->rel2abs( $base ) ;
336 $base = $self->canonpath( $base ) ;
339 my ( $path_directories, $path_file ) =
340 ($self->splitpath( $path, 1 ))[1,2] ;
342 my ( $base_volume, $base_directories ) =
343 $self->splitpath( $base, 1 ) ;
345 $path = $self->catpath(
347 $self->catdir( $base_directories, $path_directories ),
352 return $self->canonpath( $path ) ;