Change 31788 by [EMAIL PROTECTED] on 2007/09/03 19:36:39
Portability tweaks for Archive::Tar::_extract_file.
Affected files ...
... //depot/perl/lib/Archive/Tar.pm#14 edit
Differences ...
==== //depot/perl/lib/Archive/Tar.pm#14 (text) ====
Index: perl/lib/Archive/Tar.pm
--- perl/lib/Archive/Tar.pm#13~31722~ 2007-08-15 07:58:57.000000000 -0700
+++ perl/lib/Archive/Tar.pm 2007-09-03 12:36:39.000000000 -0700
@@ -14,7 +14,7 @@
$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.34";
+$VERSION = "1.34_01";
$CHOWN = 1;
$CHMOD = 1;
$DO_NOT_USE_PREFIX = 0;
@@ -496,7 +496,7 @@
=head2 $tar->extract_file( $file, [$extract_path] )
Write an entry, whose name is equivalent to the file name provided to
-disk. Optionally takes a second parameter, which is the full (unix)
+disk. Optionally takes a second parameter, which is the full native
path (including filename) the entry will be written to.
For example:
@@ -547,9 +547,18 @@
### it's a relative path ###
} else {
my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd());
- my @dirs = File::Spec::Unix->splitdir( $dirs );
- my @cwd = File::Spec->splitdir( $cwd );
- $dir = File::Spec->catdir( @cwd, @dirs );
+ 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 ($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
unless ( defined $dir ) {
End of Patch.
