From: Nicholas Clark Date: Sun, 16 Sep 2007 09:40:45 +0000 (+0000) Subject: Upgrade to Archive::Tar 1.36 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f5afd28d716f3f7def49a49cd690ce11e9685fb0;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Archive::Tar 1.36 (Portability fixes for VMS, as offered by Craig Berry) p4raw-id: //depot/perl@31874 --- diff --git a/lib/Archive/Tar.pm b/lib/Archive/Tar.pm index 21d71bd..2b57b59 100644 --- a/lib/Archive/Tar.pm +++ b/lib/Archive/Tar.pm @@ -14,7 +14,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "1.34_01"; +$VERSION = "1.36"; $CHOWN = 1; $CHMOD = 1; $DO_NOT_USE_PREFIX = 0; @@ -547,20 +547,39 @@ sub _extract_file { ### 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 ): + ### 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; diff --git a/lib/Archive/Tar/Constant.pm b/lib/Archive/Tar/Constant.pm index 8cd56a4..00416d5 100644 --- a/lib/Archive/Tar/Constant.pm +++ b/lib/Archive/Tar/Constant.pm @@ -10,7 +10,7 @@ BEGIN { 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"; @@ -73,5 +73,6 @@ use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/; 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; diff --git a/lib/Archive/Tar/t/src/long/bar.tar.packed b/lib/Archive/Tar/t/src/long/bar.tar.packed index 2e86525..85e4706 100644 --- a/lib/Archive/Tar/t/src/long/bar.tar.packed +++ b/lib/Archive/Tar/t/src/long/bar.tar.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Tar/t/src/long/bar.tar lib/Archive/Tar/t/src/long/bar.tar.packed -Created at Wed Aug 15 15:56:07 2007 +Created at Sun Sep 16 10:56:54 2007 ######################################################################### __UU__ M8P`````````````````````````````````````````````````````````` diff --git a/lib/Archive/Tar/t/src/long/foo.tgz.packed b/lib/Archive/Tar/t/src/long/foo.tgz.packed index 8ea6684..f7b9adc 100644 --- a/lib/Archive/Tar/t/src/long/foo.tgz.packed +++ b/lib/Archive/Tar/t/src/long/foo.tgz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Tar/t/src/long/foo.tgz lib/Archive/Tar/t/src/long/foo.tgz.packed -Created at Wed Aug 15 15:56:07 2007 +Created at Sun Sep 16 10:56:54 2007 ######################################################################### __UU__ M'XL(`````````^W72VZ#,!`&8*]S"BY`F,$/MCT`ET")25`