use strict;
use Cwd;
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
require File::Spec::Unix;
+
+$VERSION = '1.3';
+
@ISA = qw(File::Spec::Unix);
=head1 NAME
there. This package overrides the implementation of these methods, not
the semantics.
-=over
+=over 4
=item devnull
$ENV{TMPDIR}
$ENV{TEMP}
$ENV{TMP}
+ C:/temp
/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(/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;
return $tmpdir;
}
+sub case_tolerant {
+ return 1;
+}
+
sub file_name_is_absolute {
my ($self,$file) = @_;
- return scalar($file =~ m{^([a-z]:)?[\\/]}i);
+ return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}
=item catfile
}
sub path {
- local $^W = 1;
my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
my @path = split(';',$path);
foreach (@path) { $_ = '.' if $_ eq '' }
=cut
sub canonpath {
- my ($self,$path,$reduce_ricochet) = @_;
- $path =~ s/^([a-z]:)/\u$1/;
+ 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|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx
- $path =~ s|\\$||
- unless $path =~ m#^([A-Z]:)?\\$#; # 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
return $path;
}
Volumes can be drive letters or UNC sharenames (\\server\share).
-The results can be passed to L</catpath()> to get back a path equivalent to
+The results can be passed to L</catpath> to get back a path equivalent to
(usually identical to) the original path.
=cut
my ($volume,$directory,$file) = ('','','');
if ( $nofile ) {
$path =~
- m@^( (?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+)? )
+ m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
(.*)
- @x;
+ }xs;
$volume = $1;
$directory = $2;
}
else {
$path =~
- m@^ ( (?: [a-zA-Z]: |
- (?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+
+ m{^ ( (?: [a-zA-Z]: |
+ (?:\\\\|//)[^\\/]+[\\/][^\\/]+
)?
)
- ( (?:.*[\\\\/](?:\.\.?$)?)? )
+ ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
(.*)
- @x;
+ }xs;
$volume = $1;
$directory = $2;
$file = $3;
=item splitdir
-The opposite of L</catdir()>.
+The opposite of L<catdir()|File::Spec/catdir()>.
@dirs = File::Spec->splitdir( $directories );
# check to be sure that there will not be any before handling the
# simple case.
#
- if ( $directories !~ m|[\\/]$| ) {
+ if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
return split( m|[\\/]|, $directories );
}
else {
# If it's UNC, make sure the glue separator is there, reusing
# whatever separator is first in the $volume
$volume .= $1
- if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+$@ &&
- $directory =~ m@^[^\\/]@
+ if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
+ $directory =~ m@^[^\\/]@s
) ;
$volume .= $directory ;
# If the volume is not just A:, make sure the glue separator is
# there, reusing whatever separator is first in the $volume if possible.
- if ( $volume !~ m@^[a-zA-Z]:$@ &&
- $volume !~ m@[\\/]$@ &&
- $file !~ m@^[\\/]@
+ if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
+ $volume =~ m@[^\\/]\Z(?!\n)@ &&
+ $file =~ m@[^\\/]@
) {
$volume =~ m@([\\/])@ ;
my $sep = $1 ? $1 : '\\' ;
}
-=item abs2rel
-
-Takes a destination path and an optional base path returns a relative path
-from the base path to the destination path:
-
- $rel_path = File::Spec->abs2rel( $destination ) ;
- $rel_path = File::Spec->abs2rel( $destination, $base ) ;
-
-If $base is not present or '', then L</cwd()> is used. If $base is relative,
-then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
-
-On systems with the concept of a volume, this assumes that both paths
-are on the $destination volume, and ignores the $base volume.
-
-On systems that have a grammar that indicates filenames, this ignores the
-$base filename as well. Otherwise all path components are assumed to be
-directories.
-
-If $path is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L</cwd()>.
-
-Based on code written by Shigio Yamaguchi.
-
-No checks against the filesystem are made.
-
-=cut
-
sub abs2rel {
my($self,$path,$base) = @_;
}
# Split up paths
- my ( $path_volume, $path_directories, $path_file ) =
+ my ( undef, $path_directories, $path_file ) =
$self->splitpath( $path, 1 ) ;
- my ( undef, $base_directories, undef ) =
- $self->splitpath( $base, 1 ) ;
+ my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
# Now, remove all leading components that are the same
my @pathchunks = $self->splitdir( $path_directories );
$path_directories = CORE::join( '\\', @pathchunks );
$base_directories = CORE::join( '\\', @basechunks );
- # $base now contains the directories the resulting relative path
- # must ascend out of before it can descend to $path_directory. So,
+ # $base_directories now contains the directories the resulting relative
+ # path must ascend out of before it can descend to $path_directory. So,
# replace all names with $parentDir
- $base_directories =~ s|[^/]+|..|g ;
+
+ #FA Need to replace between backslashes...
+ $base_directories =~ s|[^\\]+|..|g ;
# Glue the two together, using a separator if necessary, and preventing an
# empty result.
- if ( $path ne '' && $base ne '' ) {
+
+ #FA Must check that new directories are not empty.
+ if ( $path_directories ne '' && $base_directories ne '' ) {
$path_directories = "$base_directories\\$path_directories" ;
} else {
$path_directories = "$base_directories$path_directories" ;
}
return $self->canonpath(
- $self->catpath( $path_volume, $path_directories, $path_file )
+ $self->catpath( "", $path_directories, $path_file )
) ;
}
-=item rel2abs
-
-Converts a relative path to an absolute path.
-
- $abs_path = $File::Spec->rel2abs( $destination ) ;
- $abs_path = $File::Spec->rel2abs( $destination, $base ) ;
-
-If $base is not present or '', then L<cwd()> is used. If $base is relative,
-then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L</cwd()>.
-
-Assumes that both paths are on the $base volume, and ignores the
-$destination volume.
-
-On systems that have a grammar that indicates filenames, this ignores the
-$base filename as well. Otherwise all path components are assumed to be
-directories.
-
-If $path is absolute, it is cleaned up and returned using L</canonpath()>.
-Based on code written by Shigio Yamaguchi.
-
-No checks against the filesystem are made.
-
-=cut
-
-sub rel2abs($;$;) {
+sub rel2abs {
my ($self,$path,$base ) = @_;
- # Clean up and split up $path
if ( ! $self->file_name_is_absolute( $path ) ) {
- # Figure out the effective $base and clean it up.
- if ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- }
- elsif ( !defined( $base ) || $base eq '' ) {
+ if ( !defined( $base ) || $base eq '' ) {
$base = cwd() ;
}
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
else {
$base = $self->canonpath( $base ) ;
}
- # Split up paths
- my ( undef, $path_directories, $path_file ) =
- $self->splitpath( $path, 1 ) ;
+ my ( $path_directories, $path_file ) =
+ ($self->splitpath( $path, 1 ))[1,2] ;
- my ( $base_volume, $base_directories, undef ) =
+ my ( $base_volume, $base_directories ) =
$self->splitpath( $base, 1 ) ;
$path = $self->catpath(
projects / p5sagit/p5-mst-13.2.git / blobdiff