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 Cwd::sys_cwd();
41 Returns a string representation of the first existing directory
42 from the following list:
50 Since Perl 5.8.0, if running under taint mode, and if the environment
51 variables are tainted, they are not used.
57 return $tmpdir if defined $tmpdir;
59 $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
66 No physical check on the filesystem, but a logical cleanup of a
67 path. On UNIX eliminated successive slashes and successive "/.".
72 my ($self,$path) = @_;
73 $path =~ s/^([a-z]:)/\l$1/s;
75 $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
76 $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
77 $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx
78 $path =~ s|/\Z(?!\n)||
79 unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx
85 ($volume,$directories,$file) = File::Spec->splitpath( $path );
86 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
88 Splits a path into volume, directory, and filename portions. Assumes that
89 the last file is a path unless the path ends in '/', '/.', '/..'
90 or $no_file is true. On Win32 this means that $no_file true makes this return
91 ( $volume, $path, '' ).
93 Separators accepted are \ and /.
95 Volumes can be drive letters or UNC sharenames (\\server\share).
97 The results can be passed to L</catpath> to get back a path equivalent to
98 (usually identical to) the original path.
103 my ($self,$path, $nofile) = @_;
104 my ($volume,$directory,$file) = ('','','');
107 m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
115 m{^ ( (?: [a-zA-Z]: |
116 (?:\\\\|//)[^\\/]+[\\/][^\\/]+
119 ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
127 return ($volume,$directory,$file);
133 The opposite of L<catdir()|File::Spec/catdir()>.
135 @dirs = File::Spec->splitdir( $directories );
137 $directories must be only the directory portion of the path on systems
138 that have the concept of a volume or that have path syntax that differentiates
139 files from directories.
141 Unlike just splitting the directories on the separator, leading empty and
142 trailing directory entries can be returned, because these are significant
145 File::Spec->splitdir( "/a/b//c/" );
149 ( '', 'a', 'b', '', 'c', '' )
154 my ($self,$directories) = @_ ;
155 split m|[\\/]|, $directories, -1;
161 Takes volume, directory and file portions and returns an entire path. Under
162 Unix, $volume is ignored, and this is just like catfile(). On other OSs,
163 the $volume become significant.
168 my ($self,$volume,$directory,$file) = @_;
170 # If it's UNC, make sure the glue separator is there, reusing
171 # whatever separator is first in the $volume
173 if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
174 $directory =~ m@^[^\\/]@s
177 $volume .= $directory ;
179 # If the volume is not just A:, make sure the glue separator is
180 # there, reusing whatever separator is first in the $volume if possible.
181 if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
182 $volume =~ m@[^\\/]\Z(?!\n)@ &&
185 $volume =~ m@([\\/])@ ;
186 my $sep = $1 ? $1 : '/' ;
197 my($self,$path,$base) = @_;
200 if ( ! $self->file_name_is_absolute( $path ) ) {
201 $path = $self->rel2abs( $path ) ;
203 $path = $self->canonpath( $path ) ;
206 # Figure out the effective $base and clean it up.
207 if ( !defined( $base ) || $base eq '' ) {
208 $base = $self->cwd();
209 } elsif ( ! $self->file_name_is_absolute( $base ) ) {
210 $base = $self->rel2abs( $base ) ;
212 $base = $self->canonpath( $base ) ;
216 my ( undef, $path_directories, $path_file ) =
217 $self->splitpath( $path, 1 ) ;
219 my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
221 # Now, remove all leading components that are the same
222 my @pathchunks = $self->splitdir( $path_directories );
223 my @basechunks = $self->splitdir( $base_directories );
225 while ( @pathchunks &&
227 lc( $pathchunks[0] ) eq lc( $basechunks[0] )
233 # No need to catdir, we know these are well formed.
234 $path_directories = CORE::join( '/', @pathchunks );
235 $base_directories = CORE::join( '/', @basechunks );
237 # $base_directories now contains the directories the resulting relative
238 # path must ascend out of before it can descend to $path_directory. So,
239 # replace all names with $parentDir
241 #FA Need to replace between backslashes...
242 $base_directories =~ s|[^\\/]+|..|g ;
244 # Glue the two together, using a separator if necessary, and preventing an
247 #FA Must check that new directories are not empty.
248 if ( $path_directories ne '' && $base_directories ne '' ) {
249 $path_directories = "$base_directories/$path_directories" ;
251 $path_directories = "$base_directories$path_directories" ;
254 return $self->canonpath(
255 $self->catpath( "", $path_directories, $path_file )
261 my ($self,$path,$base ) = @_;
263 if ( ! $self->file_name_is_absolute( $path ) ) {
265 if ( !defined( $base ) || $base eq '' ) {
266 $base = $self->cwd();
268 elsif ( ! $self->file_name_is_absolute( $base ) ) {
269 $base = $self->rel2abs( $base ) ;
272 $base = $self->canonpath( $base ) ;
275 my ( $path_directories, $path_file ) =
276 ($self->splitpath( $path, 1 ))[1,2] ;
278 my ( $base_volume, $base_directories ) =
279 $self->splitpath( $base, 1 ) ;
281 $path = $self->catpath(
283 $self->catdir( $base_directories, $path_directories ),
288 return $self->canonpath( $path ) ;
296 File::Spec::OS2 - methods for OS/2 file specs
300 require File::Spec::OS2; # Done internally by File::Spec if needed
304 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
305 implementation of these methods, not the semantics.