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:
51 The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
52 is used also for NetWare).
54 Since Perl 5.8.0, if running under taint mode, and if the environment
55 variables are tainted, they are not used.
61 return $tmpdir if defined $tmpdir;
63 $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
74 sub file_name_is_absolute {
75 my ($self,$file) = @_;
76 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
81 Concatenate one or more directory names and a filename to form a
82 complete path ending with a filename
88 my $file = $self->canonpath(pop @_);
89 return $file unless @_;
90 my $dir = $self->catdir(@_);
91 $dir .= "\\" unless substr($dir,-1) eq "\\";
96 my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
97 my @path = split(';',$path);
98 foreach (@path) { $_ = '.' if $_ eq '' }
104 No physical check on the filesystem, but a logical cleanup of a
105 path. On UNIX eliminated successive slashes and successive "/.".
108 dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
109 dir1\dir2\dir3\...\dir4 -> \dir\dir4
114 my ($self,$path) = @_;
115 my $orig_path = $path;
116 $path =~ s/^([a-z]:)/\u$1/s;
118 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
119 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
120 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
121 $path =~ s|\\\Z(?!\n)||
122 unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
123 # xx1/xx2/xx3/../../xx -> xx1/xx
124 $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
125 $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
126 return $path if $path =~ m|^\.\.|; # skip relative paths
127 return $path unless $path =~ /\.\./; # too few .'s to cleanup
128 return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
129 return $path if $orig_path =~ m|^\Q/../\E|
130 and $orig_path =~ m|\/$|; # don't do /../dirs/ when called
131 # from rel2abs() for ../dirs/
132 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
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) = @_;
290 $base = $self->cwd() unless defined $base and length $base;
293 $_ = $self->canonpath($self->rel2abs($_));
295 my ($path_volume, $path_directories) = $self->splitpath($path, 1) ;
296 my ($base_volume, $base_directories) = $self->splitpath($base, 1);
298 if ($path_volume and not $base_volume) {
299 ($base_volume) = $self->splitpath($self->cwd);
302 # Can't relativize across volumes
303 return $path unless $path_volume eq $base_volume;
305 # Now, remove all leading components that are the same
306 my @pathchunks = $self->splitdir( $path_directories );
307 my @basechunks = $self->splitdir( $base_directories );
309 while ( @pathchunks &&
311 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
317 my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
319 return $self->canonpath( $self->catpath('', $result_dirs, '') );
324 my ($self,$path,$base ) = @_;
326 if ( ! $self->file_name_is_absolute( $path ) ) {
328 if ( !defined( $base ) || $base eq '' ) {
329 $base = $self->cwd() ;
331 elsif ( ! $self->file_name_is_absolute( $base ) ) {
332 $base = $self->rel2abs( $base ) ;
335 $base = $self->canonpath( $base ) ;
338 my ( $path_directories, $path_file ) =
339 ($self->splitpath( $path, 1 ))[1,2] ;
341 my ( $base_volume, $base_directories ) =
342 $self->splitpath( $base, 1 ) ;
344 $path = $self->catpath(
346 $self->catdir( $base_directories, $path_directories ),
351 return $self->canonpath( $path ) ;
356 =head2 Note For File::Spec::Win32 Maintainers
358 Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
362 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
363 implementation of these methods, not the semantics.