1 package File::Spec::Win32;
6 use vars qw(@ISA $VERSION);
7 require File::Spec::Unix;
11 @ISA = qw(File::Spec::Unix);
15 File::Spec::Win32 - methods for Win32 file specs
19 require File::Spec::Win32; # Done internally by File::Spec if needed
23 See File::Spec::Unix for a documentation of the methods provided
24 there. This package overrides the implementation of these methods, not
31 Returns a string representation of the null device.
41 Returns a string representation of the first existing directory
42 from the following list:
52 The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
53 is used also for NetWare).
55 Since Perl 5.8.0, if running under taint mode, and if the environment
56 variables are tainted, they are not used.
62 return $tmpdir if defined $tmpdir;
64 $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
75 sub file_name_is_absolute {
76 my ($self,$file) = @_;
77 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
82 Concatenate one or more directory names and a filename to form a
83 complete path ending with a filename
89 my $file = $self->canonpath(pop @_);
90 return $file unless @_;
91 my $dir = $self->catdir(@_);
92 $dir .= "\\" unless substr($dir,-1) eq "\\";
97 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
98 my @path = split(';',$path);
99 foreach (@path) { $_ = '.' if $_ eq '' }
105 No physical check on the filesystem, but a logical cleanup of a
106 path. On UNIX eliminated successive slashes and successive "/.".
109 dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
110 dir1\dir2\dir3\...\dir4 -> \dir\dir4
115 my ($self,$path) = @_;
116 my $orig_path = $path;
117 $path =~ s/^([a-z]:)/\u$1/s;
119 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
120 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
121 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
122 $path =~ s|\\\Z(?!\n)||
123 unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx\ -> xx
124 # xx1/xx2/xx3/../../xx -> xx1/xx
125 $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
126 $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
127 return $path if $path =~ m|^\.\.|; # skip relative paths
128 return $path unless $path =~ /\.\./; # too few .'s to cleanup
129 return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
130 return $path if $orig_path =~ m|^\Q/../\E|
131 and $orig_path =~ m|\/$|; # don't do /../dirs/
132 # when called from rel2abs()
134 my ($vol,$dirs,$file) = $self->splitpath($path);
135 my @dirs = $self->splitdir($dirs);
136 my (@base_dirs, @path_dirs);
137 my $dest = \@base_dirs;
139 $dest = \@path_dirs if $dir eq $self->updir;
142 # for each .. in @path_dirs pop one item from
144 while (my $dir = shift @path_dirs){
145 unless ($dir eq $self->updir){
146 unshift @path_dirs, $dir;
151 $path = $self->catpath(
153 $self->catdir(@base_dirs, @path_dirs),
161 ($volume,$directories,$file) = File::Spec->splitpath( $path );
162 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
164 Splits a path into volume, directory, and filename portions. Assumes that
165 the last file is a path unless the path ends in '\\', '\\.', '\\..'
166 or $no_file is true. On Win32 this means that $no_file true makes this return
167 ( $volume, $path, '' ).
169 Separators accepted are \ and /.
171 Volumes can be drive letters or UNC sharenames (\\server\share).
173 The results can be passed to L</catpath> to get back a path equivalent to
174 (usually identical to) the original path.
179 my ($self,$path, $nofile) = @_;
180 my ($volume,$directory,$file) = ('','','');
183 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
191 m{^ ( (?: [a-zA-Z]: |
192 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
195 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
203 return ($volume,$directory,$file);
209 The opposite of L<catdir()|File::Spec/catdir()>.
211 @dirs = File::Spec->splitdir( $directories );
213 $directories must be only the directory portion of the path on systems
214 that have the concept of a volume or that have path syntax that differentiates
215 files from directories.
217 Unlike just splitting the directories on the separator, leading empty and
218 trailing directory entries can be returned, because these are significant
221 File::Spec->splitdir( "/a/b/c" );
225 ( '', 'a', 'b', '', 'c', '' )
230 my ($self,$directories) = @_ ;
232 # split() likes to forget about trailing null fields, so here we
233 # check to be sure that there will not be any before handling the
236 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
237 return split( m|[\\/]|, $directories );
241 # since there was a trailing separator, add a file name to the end,
242 # then do the split, then replace it with ''.
244 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
245 $directories[ $#directories ]= '' ;
246 return @directories ;
253 Takes volume, directory and file portions and returns an entire path. Under
254 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
255 the $volume become significant.
260 my ($self,$volume,$directory,$file) = @_;
262 # If it's UNC, make sure the glue separator is there, reusing
263 # whatever separator is first in the $volume
265 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
266 $directory =~ m@^[^\\/]@s
269 $volume .= $directory ;
271 # If the volume is not just A:, make sure the glue separator is
272 # there, reusing whatever separator is first in the $volume if possible.
273 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
274 $volume =~ m@[^\\/]\Z(?!\n)@ &&
277 $volume =~ m@([\\/])@ ;
278 my $sep = $1 ? $1 : '\\' ;
289 my($self,$path,$base) = @_;
292 if ( ! $self->file_name_is_absolute( $path ) ) {
293 $path = $self->rel2abs( $path ) ;
296 $path = $self->canonpath( $path ) ;
299 # Figure out the effective $base and clean it up.
300 if ( !defined( $base ) || $base eq '' ) {
303 elsif ( ! $self->file_name_is_absolute( $base ) ) {
304 $base = $self->rel2abs( $base ) ;
307 $base = $self->canonpath( $base ) ;
311 my ( undef, $path_directories, $path_file ) =
312 $self->splitpath( $path, 1 ) ;
314 my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
316 # Now, remove all leading components that are the same
317 my @pathchunks = $self->splitdir( $path_directories );
318 my @basechunks = $self->splitdir( $base_directories );
320 while ( @pathchunks &&
322 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
328 # No need to catdir, we know these are well formed.
329 $path_directories = CORE::join( '\\', @pathchunks );
330 $base_directories = CORE::join( '\\', @basechunks );
332 # $base_directories now contains the directories the resulting relative
333 # path must ascend out of before it can descend to $path_directory. So,
334 # replace all names with $parentDir
336 #FA Need to replace between backslashes...
337 $base_directories =~ s|[^\\]+|..|g ;
339 # Glue the two together, using a separator if necessary, and preventing an
342 #FA Must check that new directories are not empty.
343 if ( $path_directories ne '' && $base_directories ne '' ) {
344 $path_directories = "$base_directories\\$path_directories" ;
346 $path_directories = "$base_directories$path_directories" ;
349 return $self->canonpath(
350 $self->catpath( "", $path_directories, $path_file )
356 my ($self,$path,$base ) = @_;
358 if ( ! $self->file_name_is_absolute( $path ) ) {
360 if ( !defined( $base ) || $base eq '' ) {
363 elsif ( ! $self->file_name_is_absolute( $base ) ) {
364 $base = $self->rel2abs( $base ) ;
367 $base = $self->canonpath( $base ) ;
370 my ( $path_directories, $path_file ) =
371 ($self->splitpath( $path, 1 ))[1,2] ;
373 my ( $base_volume, $base_directories ) =
374 $self->splitpath( $base, 1 ) ;
376 $path = $self->catpath(
378 $self->catdir( $base_directories, $path_directories ),
383 return $self->canonpath( $path ) ;
388 =head2 Note For File::Spec::Win32 Maintainers
390 Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.