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:
54 return $tmpdir if defined $tmpdir;
56 foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
57 next unless defined && -d;
61 $tmpdir = '' unless defined $tmpdir;
62 $tmpdir = $self->canonpath($tmpdir);
70 sub file_name_is_absolute {
71 my ($self,$file) = @_;
72 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
77 Concatenate one or more directory names and a filename to form a
78 complete path ending with a filename
85 return $file unless @_;
86 my $dir = $self->catdir(@_);
87 $dir .= "\\" unless substr($dir,-1) eq "\\";
92 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
93 my @path = split(';',$path);
94 foreach (@path) { $_ = '.' if $_ eq '' }
100 No physical check on the filesystem, but a logical cleanup of a
101 path. On UNIX eliminated successive slashes and successive "/.".
106 my ($self,$path) = @_;
107 $path =~ s/^([a-z]:)/\u$1/s;
109 $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx
110 $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx
111 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx
112 $path =~ s|\\\Z(?!\n)||
113 unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx/ -> xx
119 ($volume,$directories,$file) = File::Spec->splitpath( $path );
120 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
122 Splits a path in to volume, directory, and filename portions. Assumes that
123 the last file is a path unless the path ends in '\\', '\\.', '\\..'
124 or $no_file is true. On Win32 this means that $no_file true makes this return
125 ( $volume, $path, undef ).
127 Separators accepted are \ and /.
129 Volumes can be drive letters or UNC sharenames (\\server\share).
131 The results can be passed to L</catpath> to get back a path equivalent to
132 (usually identical to) the original path.
137 my ($self,$path, $nofile) = @_;
138 my ($volume,$directory,$file) = ('','','');
141 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
149 m{^ ( (?: [a-zA-Z]: |
150 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
153 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
161 return ($volume,$directory,$file);
167 The opposite of L</catdir()>.
169 @dirs = File::Spec->splitdir( $directories );
171 $directories must be only the directory portion of the path on systems
172 that have the concept of a volume or that have path syntax that differentiates
173 files from directories.
175 Unlike just splitting the directories on the separator, leading empty and
176 trailing directory entries can be returned, because these are significant
179 File::Spec->splitdir( "/a/b/c" );
183 ( '', 'a', 'b', '', 'c', '' )
188 my ($self,$directories) = @_ ;
190 # split() likes to forget about trailing null fields, so here we
191 # check to be sure that there will not be any before handling the
194 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
195 return split( m|[\\/]|, $directories );
199 # since there was a trailing separator, add a file name to the end,
200 # then do the split, then replace it with ''.
202 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
203 $directories[ $#directories ]= '' ;
204 return @directories ;
211 Takes volume, directory and file portions and returns an entire path. Under
212 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
213 the $volume become significant.
218 my ($self,$volume,$directory,$file) = @_;
220 # If it's UNC, make sure the glue separator is there, reusing
221 # whatever separator is first in the $volume
223 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
224 $directory =~ m@^[^\\/]@s
227 $volume .= $directory ;
229 # If the volume is not just A:, make sure the glue separator is
230 # there, reusing whatever separator is first in the $volume if possible.
231 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
232 $volume =~ m@[^\\/]\Z(?!\n)@ &&
235 $volume =~ m@([\\/])@ ;
236 my $sep = $1 ? $1 : '\\' ;
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 $base_directories = ($self->splitpath( $base, 1 ))[1] ;
274 # Now, remove all leading components that are the same
275 my @pathchunks = $self->splitdir( $path_directories );
276 my @basechunks = $self->splitdir( $base_directories );
278 while ( @pathchunks &&
280 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
286 # No need to catdir, we know these are well formed.
287 $path_directories = CORE::join( '\\', @pathchunks );
288 $base_directories = CORE::join( '\\', @basechunks );
290 # $base_directories now contains the directories the resulting relative
291 # path must ascend out of before it can descend to $path_directory. So,
292 # replace all names with $parentDir
294 #FA Need to replace between backslashes...
295 $base_directories =~ s|[^\\]+|..|g ;
297 # Glue the two together, using a separator if necessary, and preventing an
300 #FA Must check that new directories are not empty.
301 if ( $path_directories ne '' && $base_directories ne '' ) {
302 $path_directories = "$base_directories\\$path_directories" ;
304 $path_directories = "$base_directories$path_directories" ;
307 # It makes no sense to add a relative path to a UNC volume
308 $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
310 return $self->canonpath(
311 $self->catpath($path_volume, $path_directories, $path_file )
317 my ($self,$path,$base ) = @_;
319 if ( ! $self->file_name_is_absolute( $path ) ) {
321 if ( !defined( $base ) || $base eq '' ) {
324 elsif ( ! $self->file_name_is_absolute( $base ) ) {
325 $base = $self->rel2abs( $base ) ;
328 $base = $self->canonpath( $base ) ;
331 my ( $path_directories, $path_file ) =
332 ($self->splitpath( $path, 1 ))[1,2] ;
334 my ( $base_volume, $base_directories ) =
335 $self->splitpath( $base, 1 ) ;
337 $path = $self->catpath(
339 $self->catdir( $base_directories, $path_directories ),
344 return $self->canonpath( $path ) ;