1 package File::Spec::OS2;
4 use vars qw(@ISA $VERSION);
5 require File::Spec::Unix;
9 @ISA = qw(File::Spec::Unix);
19 sub file_name_is_absolute {
20 my ($self,$file) = @_;
21 return scalar($file =~ m{^([a-z]:)?[\\/]}is);
25 my $path = $ENV{PATH};
27 my @path = split(';',$path);
28 foreach (@path) { $_ = '.' if $_ eq '' }
34 return $tmpdir if defined $tmpdir;
36 my @dirlist = ( @ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /) );
39 if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
41 @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
45 next unless defined && -d;
49 $tmpdir = '' unless defined $tmpdir;
51 $tmpdir = $self->canonpath($tmpdir);
57 No physical check on the filesystem, but a logical cleanup of a
58 path. On UNIX eliminated successive slashes and successive "/.".
63 my ($self,$path) = @_;
64 $path =~ s/^([a-z]:)/\l$1/s;
66 $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
67 $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
68 $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx
69 $path =~ s|/\Z(?!\n)||
70 unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx
76 ($volume,$directories,$file) = File::Spec->splitpath( $path );
77 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
79 Splits a path into volume, directory, and filename portions. Assumes that
80 the last file is a path unless the path ends in '/', '/.', '/..'
81 or $no_file is true. On Win32 this means that $no_file true makes this return
82 ( $volume, $path, '' ).
84 Separators accepted are \ and /.
86 Volumes can be drive letters or UNC sharenames (\\server\share).
88 The results can be passed to L</catpath> to get back a path equivalent to
89 (usually identical to) the original path.
94 my ($self,$path, $nofile) = @_;
95 my ($volume,$directory,$file) = ('','','');
98 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
106 m{^ ( (?: [a-zA-Z]: |
107 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
110 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
118 return ($volume,$directory,$file);
124 The opposite of L<catdir()|File::Spec/catdir()>.
126 @dirs = File::Spec->splitdir( $directories );
128 $directories must be only the directory portion of the path on systems
129 that have the concept of a volume or that have path syntax that differentiates
130 files from directories.
132 Unlike just splitting the directories on the separator, leading empty and
133 trailing directory entries can be returned, because these are significant
136 File::Spec->splitdir( "/a/b//c/" );
140 ( '', 'a', 'b', '', 'c', '' )
145 my ($self,$directories) = @_ ;
146 split m|[\\/]|, $directories, -1;
152 Takes volume, directory and file portions and returns an entire path. Under
153 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
154 the $volume become significant.
159 my ($self,$volume,$directory,$file) = @_;
161 # If it's UNC, make sure the glue separator is there, reusing
162 # whatever separator is first in the $volume
164 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
165 $directory =~ m@^[^\\/]@s
168 $volume .= $directory ;
170 # If the volume is not just A:, make sure the glue separator is
171 # there, reusing whatever separator is first in the $volume if possible.
172 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
173 $volume =~ m@[^\\/]\Z(?!\n)@ &&
176 $volume =~ m@([\\/])@ ;
177 my $sep = $1 ? $1 : '/' ;
188 my($self,$path,$base) = @_;
191 if ( ! $self->file_name_is_absolute( $path ) ) {
192 $path = $self->rel2abs( $path ) ;
194 $path = $self->canonpath( $path ) ;
197 # Figure out the effective $base and clean it up.
198 if ( !defined( $base ) || $base eq '' ) {
199 $base = Cwd::sys_cwd() ;
200 } elsif ( ! $self->file_name_is_absolute( $base ) ) {
201 $base = $self->rel2abs( $base ) ;
203 $base = $self->canonpath( $base ) ;
207 my ( undef, $path_directories, $path_file ) =
208 $self->splitpath( $path, 1 ) ;
210 my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
212 # Now, remove all leading components that are the same
213 my @pathchunks = $self->splitdir( $path_directories );
214 my @basechunks = $self->splitdir( $base_directories );
216 while ( @pathchunks &&
218 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
224 # No need to catdir, we know these are well formed.
225 $path_directories = CORE::join( '/', @pathchunks );
226 $base_directories = CORE::join( '/', @basechunks );
228 # $base_directories now contains the directories the resulting relative
229 # path must ascend out of before it can descend to $path_directory. So,
230 # replace all names with $parentDir
232 #FA Need to replace between backslashes...
233 $base_directories =~ s|[^\\/]+|..|g ;
235 # Glue the two together, using a separator if necessary, and preventing an
238 #FA Must check that new directories are not empty.
239 if ( $path_directories ne '' && $base_directories ne '' ) {
240 $path_directories = "$base_directories/$path_directories" ;
242 $path_directories = "$base_directories$path_directories" ;
245 return $self->canonpath(
246 $self->catpath( "", $path_directories, $path_file )
252 my ($self,$path,$base ) = @_;
254 if ( ! $self->file_name_is_absolute( $path ) ) {
256 if ( !defined( $base ) || $base eq '' ) {
257 $base = Cwd::sys_cwd() ;
259 elsif ( ! $self->file_name_is_absolute( $base ) ) {
260 $base = $self->rel2abs( $base ) ;
263 $base = $self->canonpath( $base ) ;
266 my ( $path_directories, $path_file ) =
267 ($self->splitpath( $path, 1 ))[1,2] ;
269 my ( $base_volume, $base_directories ) =
270 $self->splitpath( $base, 1 ) ;
272 $path = $self->catpath(
274 $self->catdir( $base_directories, $path_directories ),
279 return $self->canonpath( $path ) ;
287 File::Spec::OS2 - methods for OS/2 file specs
291 require File::Spec::OS2; # Done internally by File::Spec if needed
295 See File::Spec::Unix for a documentation of the methods provided
296 there. This package overrides the implementation of these methods, not