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( map( $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 = split(';', $ENV{PATH});
113 @path = grep length, @path;
120 No physical check on the filesystem, but a logical cleanup of a
121 path. On UNIX eliminated successive slashes and successive "/.".
124 dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
125 dir1\dir2\dir3\...\dir4 -> \dir\dir4
130 my ($self,$path) = @_;
132 $path =~ s/^([a-z]:)/\u$1/s;
134 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
135 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
136 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
137 $path =~ s|\\\Z(?!\n)||
138 unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
139 # xx1/xx2/xx3/../../xx -> xx1/xx
140 $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
141 $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
142 return $path if $path =~ m|^\.\.|; # skip relative paths
143 return $path unless $path =~ /\.\./; # too few .'s to cleanup
144 return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
145 $path =~ s{^\\\.\.$}{\\}; # \.. -> \
146 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
148 return $self->_collapse($path);
153 ($volume,$directories,$file) = File::Spec->splitpath( $path );
154 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
156 Splits a path into volume, directory, and filename portions. Assumes that
157 the last file is a path unless the path ends in '\\', '\\.', '\\..'
158 or $no_file is true. On Win32 this means that $no_file true makes this return
159 ( $volume, $path, '' ).
161 Separators accepted are \ and /.
163 Volumes can be drive letters or UNC sharenames (\\server\share).
165 The results can be passed to L</catpath> to get back a path equivalent to
166 (usually identical to) the original path.
171 my ($self,$path, $nofile) = @_;
172 my ($volume,$directory,$file) = ('','','');
175 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
183 m{^ ( (?: [a-zA-Z]: |
184 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
187 ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
195 return ($volume,$directory,$file);
201 The opposite of L<catdir()|File::Spec/catdir()>.
203 @dirs = File::Spec->splitdir( $directories );
205 $directories must be only the directory portion of the path on systems
206 that have the concept of a volume or that have path syntax that differentiates
207 files from directories.
209 Unlike just splitting the directories on the separator, leading empty and
210 trailing directory entries can be returned, because these are significant
213 File::Spec->splitdir( "/a/b/c" );
217 ( '', 'a', 'b', '', 'c', '' )
222 my ($self,$directories) = @_ ;
224 # split() likes to forget about trailing null fields, so here we
225 # check to be sure that there will not be any before handling the
228 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
229 return split( m|[\\/]|, $directories );
233 # since there was a trailing separator, add a file name to the end,
234 # then do the split, then replace it with ''.
236 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
237 $directories[ $#directories ]= '' ;
238 return @directories ;
245 Takes volume, directory and file portions and returns an entire path. Under
246 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
247 the $volume become significant.
252 my ($self,$volume,$directory,$file) = @_;
254 # If it's UNC, make sure the glue separator is there, reusing
255 # whatever separator is first in the $volume
258 if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
259 $directory =~ m@^[^\\/]@s
262 $volume .= $directory ;
264 # If the volume is not just A:, make sure the glue separator is
265 # there, reusing whatever separator is first in the $volume if possible.
266 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
267 $volume =~ m@[^\\/]\Z(?!\n)@ &&
270 $volume =~ m@([\\/])@ ;
271 my $sep = $1 ? $1 : '\\' ;
281 lc($_[1]) eq lc($_[2]);
285 my ($self,$path,$base ) = @_;
287 if ( ! $self->file_name_is_absolute( $path ) ) {
289 if ( !defined( $base ) || $base eq '' ) {
291 $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
292 $base = $self->_cwd() unless defined $base ;
294 elsif ( ! $self->file_name_is_absolute( $base ) ) {
295 $base = $self->rel2abs( $base ) ;
298 $base = $self->canonpath( $base ) ;
301 my ( $path_directories, $path_file ) =
302 ($self->splitpath( $path, 1 ))[1,2] ;
304 my ( $base_volume, $base_directories ) =
305 $self->splitpath( $base, 1 ) ;
307 $path = $self->catpath(
309 $self->catdir( $base_directories, $path_directories ),
314 return $self->canonpath( $path ) ;
319 =head2 Note For File::Spec::Win32 Maintainers
321 Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
325 Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
327 This program is free software; you can redistribute it and/or modify
328 it under the same terms as Perl itself.
332 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
333 implementation of these methods, not the semantics.