use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.2';
+$VERSION = '1.3';
@ISA = qw(File::Spec::Unix);
there. This package overrides the implementation of these methods, not
the semantics.
-=over
+=over 4
=item devnull
/tmp
/
+Since perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
=cut
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
my $self = shift;
- foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) {
+ my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /));
+ {
+ no strict 'refs';
+ if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
+ require Scalar::Util;
+ @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
+ }
+ }
+ foreach (@dirlist) {
next unless defined && -d;
$tmpdir = $_;
last;
my ($self,$path) = @_;
$path =~ s/^([a-z]:)/\u$1/s;
$path =~ s|/|\\|g;
- $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx
- $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx
- $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx
+ $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
+ $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
+ $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
$path =~ s|\\\Z(?!\n)||
- unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx/ -> xx
+ unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx\ -> xx
return $path;
}
=item splitdir
-The opposite of L</catdir()>.
+The opposite of L<catdir()|File::Spec/catdir()>.
@dirs = File::Spec->splitdir( $directories );
}
# Split up paths
- my ( $path_volume, $path_directories, $path_file ) =
+ my ( undef, $path_directories, $path_file ) =
$self->splitpath( $path, 1 ) ;
my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
$path_directories = "$base_directories$path_directories" ;
}
- # It makes no sense to add a relative path to a UNC volume
- $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
-
return $self->canonpath(
- $self->catpath($path_volume, $path_directories, $path_file )
+ $self->catpath( "", $path_directories, $path_file )
) ;
}
-sub rel2abs($$;$;) {
+sub rel2abs {
my ($self,$path,$base ) = @_;
if ( ! $self->file_name_is_absolute( $path ) ) {