$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.34_01";
+$VERSION = "1.36";
$CHOWN = 1;
$CHMOD = 1;
$DO_NOT_USE_PREFIX = 0;
### it's a relative path ###
} else {
my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd());
- my @dirs;
- if ( defined $alt ) { # It's a local-OS path
- @dirs = File::Spec->splitdir( $dirs );
- } else { # it's UNIX-style, likely straight from the tarball
- @dirs = File::Spec::Unix->splitdir( $dirs );
- }
- map tr/\./_/, @dirs if $^O eq 'VMS'; # '.' is the directory delimiter
+
+
+
+ my @dirs = defined $alt
+ ? File::Spec->splitdir( $dirs ) # It's a local-OS path
+ : File::Spec::Unix->splitdir( $dirs ); # it's UNIX-style, likely
+ # straight from the tarball
+
+ ### '.' is the directory delimiter, of which the first one has to
+ ### be escaped/changed.
+ map tr/\./_/, @dirs if ON_VMS;
+
my ($cwd_vol,$cwd_dir,$cwd_file)
= File::Spec->splitpath( $cwd );
my @cwd = File::Spec->splitdir( $cwd_dir );
push @cwd, $cwd_file if length $cwd_file;
- $dir = File::Spec->catpath( $cwd_vol, File::Spec->catdir( @cwd, @dirs ) );
- # catdir() returns undef if the path is longer than 255 chars on VMS
+ ### We need to pass '' as the last elemant to catpath. Craig Berry
+ ### explains why (msgid <p0624083dc311ae541393@[172.16.52.1]>):
+ ### The root problem is that splitpath on UNIX always returns the
+ ### final path element as a file even if it is a directory, and of
+ ### course there is no way it can know the difference without checking
+ ### against the filesystem, which it is documented as not doing. When
+ ### you turn around and call catpath, on VMS you have to know which bits
+ ### are directory bits and which bits are file bits. In this case we
+ ### know the result should be a directory. I had thought you could omit
+ ### the file argument to catpath in such a case, but apparently on UNIX
+ ### you can't.
+ $dir = File::Spec->catpath(
+ $cwd_vol, File::Spec->catdir( @cwd, @dirs ), ''
+ );
+
+ ### catdir() returns undef if the path is longer than 255 chars on VMS
unless ( defined $dir ) {
$^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
return;
BLOCK_SIZE TAR_PAD TAR_END ON_UNIX BLOCK CAN_READLINK MAGIC
TAR_VERSION UNAME GNAME CAN_CHOWN MODE CHECK_SUM UID GID
GZIP_MAGIC_NUM MODE_READ LONGLINK LONGLINK_NAME PREFIX_LENGTH
- LABEL NAME_LENGTH STRIP_MODE
+ LABEL NAME_LENGTH STRIP_MODE ON_VMS
];
require Time::Local if $^O eq "MacOS";
use constant CAN_CHOWN => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
use constant CAN_READLINK => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
+use constant ON_VMS => $^O eq 'VMS';
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff