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.
38 sub rootdir () { '\\' }
43 Returns a string representation of the first existing directory
44 from the following list:
55 The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
56 for Symbian (the File::Spec::Win32 is used also for those platforms).
58 Since Perl 5.8.0, if running under taint mode, and if the environment
59 variables are tainted, they are not used.
65 return $tmpdir if defined $tmpdir;
66 $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
78 sub file_name_is_absolute {
79 my ($self,$file) = @_;
80 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
85 Concatenate one or more directory names and a filename to form a
86 complete path ending with a filename
92 my $file = $self->canonpath(pop @_);
93 return $file unless @_;
94 my $dir = $self->catdir(@_);
95 $dir .= "\\" unless substr($dir,-1) eq "\\";
104 # append a backslash to each argument unless it has one there
105 $_ .= "\\" unless m{\\$};
107 return $self->canonpath(join('', @args));
111 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
112 my @path = split(';',$path);
113 foreach (@path) { $_ = '.' if $_ eq '' }
119 No physical check on the filesystem, but a logical cleanup of a
120 path. On UNIX eliminated successive slashes and successive "/.".
123 dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
124 dir1\dir2\dir3\...\dir4 -> \dir\dir4
129 my ($self,$path) = @_;
130 my $orig_path = $path;
131 $path =~ s/^([a-z]:)/\u$1/s;
133 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
134 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
135 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
136 $path =~ s|\\\Z(?!\n)||
137 unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
138 # xx1/xx2/xx3/../../xx -> xx1/xx
139 $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
140 $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
141 return $path if $path =~ m|^\.\.|; # skip relative paths
142 return $path unless $path =~ /\.\./; # too few .'s to cleanup
143 return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
144 $path =~ s{^\\\.\.$}{\\}; # \.. -> \
145 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
147 my ($vol,$dirs,$file) = $self->splitpath($path);
148 my @dirs = $self->splitdir($dirs);
149 my (@base_dirs, @path_dirs);
150 my $dest = \@base_dirs;
152 $dest = \@path_dirs if $dir eq $self->updir;
155 # for each .. in @path_dirs pop one item from
157 while (my $dir = shift @path_dirs){
158 unless ($dir eq $self->updir){
159 unshift @path_dirs, $dir;
164 $path = $self->catpath(
166 $self->catdir(@base_dirs, @path_dirs),
174 ($volume,$directories,$file) = File::Spec->splitpath( $path );
175 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
177 Splits a path into volume, directory, and filename portions. Assumes that
178 the last file is a path unless the path ends in '\\', '\\.', '\\..'
179 or $no_file is true. On Win32 this means that $no_file true makes this return
180 ( $volume, $path, '' ).
182 Separators accepted are \ and /.
184 Volumes can be drive letters or UNC sharenames (\\server\share).
186 The results can be passed to L</catpath> to get back a path equivalent to
187 (usually identical to) the original path.
192 my ($self,$path, $nofile) = @_;
193 my ($volume,$directory,$file) = ('','','');
196 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
204 m{^ ( (?: [a-zA-Z]: |
205 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
208 ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
216 return ($volume,$directory,$file);
222 The opposite of L<catdir()|File::Spec/catdir()>.
224 @dirs = File::Spec->splitdir( $directories );
226 $directories must be only the directory portion of the path on systems
227 that have the concept of a volume or that have path syntax that differentiates
228 files from directories.
230 Unlike just splitting the directories on the separator, leading empty and
231 trailing directory entries can be returned, because these are significant
234 File::Spec->splitdir( "/a/b/c" );
238 ( '', 'a', 'b', '', 'c', '' )
243 my ($self,$directories) = @_ ;
245 # split() likes to forget about trailing null fields, so here we
246 # check to be sure that there will not be any before handling the
249 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
250 return split( m|[\\/]|, $directories );
254 # since there was a trailing separator, add a file name to the end,
255 # then do the split, then replace it with ''.
257 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
258 $directories[ $#directories ]= '' ;
259 return @directories ;
266 Takes volume, directory and file portions and returns an entire path. Under
267 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
268 the $volume become significant.
273 my ($self,$volume,$directory,$file) = @_;
275 # If it's UNC, make sure the glue separator is there, reusing
276 # whatever separator is first in the $volume
278 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
279 $directory =~ m@^[^\\/]@s
282 $volume .= $directory ;
284 # If the volume is not just A:, make sure the glue separator is
285 # there, reusing whatever separator is first in the $volume if possible.
286 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
287 $volume =~ m@[^\\/]\Z(?!\n)@ &&
290 $volume =~ m@([\\/])@ ;
291 my $sep = $1 ? $1 : '\\' ;
302 my($self,$path,$base) = @_;
303 $base = $self->_cwd() unless defined $base and length $base;
305 for ($path, $base) { $_ = $self->canonpath($_) }
307 my ($path_volume) = $self->splitpath($path, 1);
308 my ($base_volume) = $self->splitpath($base, 1);
310 # Can't relativize across volumes
311 return $path unless $path_volume eq $base_volume;
313 for ($path, $base) { $_ = $self->rel2abs($_) }
315 my $path_directories = ($self->splitpath($path, 1))[1];
316 my $base_directories = ($self->splitpath($base, 1))[1];
318 # Now, remove all leading components that are the same
319 my @pathchunks = $self->splitdir( $path_directories );
320 my @basechunks = $self->splitdir( $base_directories );
322 while ( @pathchunks &&
324 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
330 my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
332 return $self->canonpath( $self->catpath('', $result_dirs, '') );
337 my ($self,$path,$base ) = @_;
339 if ( ! $self->file_name_is_absolute( $path ) ) {
341 if ( !defined( $base ) || $base eq '' ) {
343 $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
344 $base = $self->_cwd() unless defined $base ;
346 elsif ( ! $self->file_name_is_absolute( $base ) ) {
347 $base = $self->rel2abs( $base ) ;
350 $base = $self->canonpath( $base ) ;
353 my ( $path_directories, $path_file ) =
354 ($self->splitpath( $path, 1 ))[1,2] ;
356 my ( $base_volume, $base_directories ) =
357 $self->splitpath( $base, 1 ) ;
359 $path = $self->catpath(
361 $self->catdir( $base_directories, $path_directories ),
366 return $self->canonpath( $path ) ;
371 =head2 Note For File::Spec::Win32 Maintainers
373 Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
377 Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
379 This program is free software; you can redistribute it and/or modify
380 it under the same terms as Perl itself.
384 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
385 implementation of these methods, not the semantics.