1 package File::Spec::Win32;
5 use vars qw(@ISA $VERSION);
6 require File::Spec::Unix;
10 @ISA = qw(File::Spec::Unix);
12 # Some regexes we use for path splitting
13 my $DRIVE_RX = '[a-zA-Z]:';
14 my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
15 my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
20 File::Spec::Win32 - methods for Win32 file specs
24 require File::Spec::Win32; # Done internally by File::Spec if needed
28 See File::Spec::Unix for a documentation of the methods provided
29 there. This package overrides the implementation of these methods, not
36 Returns a string representation of the null device.
44 sub rootdir () { '\\' }
49 Returns a string representation of the first existing directory
50 from the following list:
61 The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
62 for Symbian (the File::Spec::Win32 is used also for those platforms).
64 Since Perl 5.8.0, if running under taint mode, and if the environment
65 variables are tainted, they are not used.
71 return $tmpdir if defined $tmpdir;
72 $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
84 sub file_name_is_absolute {
85 # As of right now, this returns 2 if the path is absolute with a
86 # volume, 1 if it's absolute with no volume, 0 otherwise.
88 my ($self,$file) = @_;
90 if ($file =~ m{^($VOL_RX)}o) {
92 return ($vol =~ m{^$UNC_RX}o ? 2
93 : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
96 return $file =~ m{^[\\/]} ? 1 : 0;
101 Concatenate one or more directory names and a filename to form a
102 complete path ending with a filename
108 my $file = $self->canonpath(pop @_);
109 return $file unless @_;
110 my $dir = $self->catdir(@_);
111 $dir .= "\\" unless substr($dir,-1) eq "\\";
120 # append a backslash to each argument unless it has one there
121 $_ .= "\\" unless m{\\$};
123 return $self->canonpath(join('', @args));
127 my @path = split(';', $ENV{PATH});
129 @path = grep length, @path;
136 No physical check on the filesystem, but a logical cleanup of a
137 path. On UNIX eliminated successive slashes and successive "/.".
140 dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
141 dir1\dir2\dir3\...\dir4 -> \dir\dir4
146 my ($self,$path) = @_;
148 $path =~ s/^([a-z]:)/\u$1/s;
150 $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
151 $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
152 $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
153 $path =~ s|\\\Z(?!\n)||
154 unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
155 # xx1/xx2/xx3/../../xx -> xx1/xx
156 $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
157 $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
158 return $path if $path =~ m|^\.\.|; # skip relative paths
159 return $path unless $path =~ /\.\./; # too few .'s to cleanup
160 return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
161 $path =~ s{^\\\.\.$}{\\}; # \.. -> \
162 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
164 return $self->_collapse($path);
169 ($volume,$directories,$file) = File::Spec->splitpath( $path );
170 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
172 Splits a path into volume, directory, and filename portions. Assumes that
173 the last file is a path unless the path ends in '\\', '\\.', '\\..'
174 or $no_file is true. On Win32 this means that $no_file true makes this return
175 ( $volume, $path, '' ).
177 Separators accepted are \ and /.
179 Volumes can be drive letters or UNC sharenames (\\server\share).
181 The results can be passed to L</catpath> to get back a path equivalent to
182 (usually identical to) the original path.
187 my ($self,$path, $nofile) = @_;
188 my ($volume,$directory,$file) = ('','','');
191 m{^ ( $VOL_RX ? ) (.*) }sox;
198 ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
206 return ($volume,$directory,$file);
212 The opposite of L<catdir()|File::Spec/catdir()>.
214 @dirs = File::Spec->splitdir( $directories );
216 $directories must be only the directory portion of the path on systems
217 that have the concept of a volume or that have path syntax that differentiates
218 files from directories.
220 Unlike just splitting the directories on the separator, leading empty and
221 trailing directory entries can be returned, because these are significant
224 File::Spec->splitdir( "/a/b/c" );
228 ( '', 'a', 'b', '', 'c', '' )
233 my ($self,$directories) = @_ ;
235 # split() likes to forget about trailing null fields, so here we
236 # check to be sure that there will not be any before handling the
239 if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
240 return split( m|[\\/]|, $directories );
244 # since there was a trailing separator, add a file name to the end,
245 # then do the split, then replace it with ''.
247 my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
248 $directories[ $#directories ]= '' ;
249 return @directories ;
256 Takes volume, directory and file portions and returns an entire path. Under
257 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
258 the $volume become significant.
263 my ($self,$volume,$directory,$file) = @_;
265 # If it's UNC, make sure the glue separator is there, reusing
266 # whatever separator is first in the $volume
269 if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
270 $directory =~ m@^[^\\/]@s
273 $volume .= $directory ;
275 # If the volume is not just A:, make sure the glue separator is
276 # there, reusing whatever separator is first in the $volume if possible.
277 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
278 $volume =~ m@[^\\/]\Z(?!\n)@ &&
281 $volume =~ m@([\\/])@ ;
282 my $sep = $1 ? $1 : '\\' ;
292 lc($_[1]) eq lc($_[2]);
296 my ($self,$path,$base ) = @_;
298 my $is_abs = $self->file_name_is_absolute($path);
300 # Check for volume (should probably document the '2' thing...)
301 return $self->canonpath( $path ) if $is_abs == 2;
304 # It's missing a volume, add one
305 my $vol = ($self->splitpath( $self->_cwd() ))[0];
306 return $self->canonpath( $vol . $path );
309 if ( !defined( $base ) || $base eq '' ) {
311 $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
312 $base = $self->_cwd() unless defined $base ;
314 elsif ( ! $self->file_name_is_absolute( $base ) ) {
315 $base = $self->rel2abs( $base ) ;
318 $base = $self->canonpath( $base ) ;
321 my ( $path_directories, $path_file ) =
322 ($self->splitpath( $path, 1 ))[1,2] ;
324 my ( $base_volume, $base_directories ) =
325 $self->splitpath( $base, 1 ) ;
327 $path = $self->catpath(
329 $self->catdir( $base_directories, $path_directories ),
333 return $self->canonpath( $path ) ;
338 =head2 Note For File::Spec::Win32 Maintainers
340 Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
344 Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
346 This program is free software; you can redistribute it and/or modify
347 it under the same terms as Perl itself.
351 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
352 implementation of these methods, not the semantics.