Browse files

Archive::Extract 0.52 0.58

  • Loading branch information...
1 parent 44fb146 commit 67ea890c56efb654817afccd600d0ada8b15cf50 @szabgab szabgab committed Feb 6, 2012
Showing with 52 additions and 22 deletions.
  1. +30 −22 perl/lib/Archive/Extract.pm
  2. +22 −0 perl/lib/perllocal.pod
View
52 perl/lib/Archive/Extract.pm
@@ -45,7 +45,7 @@ use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG
$_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER
];
-$VERSION = '0.52';
+$VERSION = '0.58';
$PREFER_BIN = 0;
$WARN = 1;
$DEBUG = 0;
@@ -258,16 +258,16 @@ Returns a C<Archive::Extract> object on success, or false on failure.
### figure out the type, if it wasn't already specified ###
unless ( $parsed->{type} ) {
$parsed->{type} =
- $ar =~ /.+?\.(?:tar\.gz|tgz)$/i ? TGZ :
- $ar =~ /.+?\.gz$/i ? GZ :
- $ar =~ /.+?\.tar$/i ? TAR :
- $ar =~ /.+?\.(zip|jar|par)$/i ? ZIP :
- $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ :
- $ar =~ /.+?\.bz2$/i ? BZ2 :
- $ar =~ /.+?\.Z$/ ? Z :
- $ar =~ /.+?\.lzma$/ ? LZMA :
- $ar =~ /.+?\.(?:txz|tar\.xz)$/i ? TXZ :
- $ar =~ /.+?\.xz$/ ? XZ :
+ $ar =~ /.+?\.(?:tar\.gz|tgz)$/i ? TGZ :
+ $ar =~ /.+?\.gz$/i ? GZ :
+ $ar =~ /.+?\.tar$/i ? TAR :
+ $ar =~ /.+?\.(zip|jar|ear|war|par)$/i ? ZIP :
+ $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ :
+ $ar =~ /.+?\.bz2$/i ? BZ2 :
+ $ar =~ /.+?\.Z$/ ? Z :
+ $ar =~ /.+?\.lzma$/ ? LZMA :
+ $ar =~ /.+?\.(?:txz|tar\.xz)$/i ? TXZ :
+ $ar =~ /.+?\.xz$/ ? XZ :
'';
}
@@ -670,17 +670,21 @@ sub have_old_bunzip2 {
### see what command we should run, based on whether
### it's a .tgz or .tar
+ ### GNU tar can't handled VMS filespecs, but VMSTAR can handle Unix filespecs.
+ my $archive = $self->archive;
+ $archive = VMS::Filespec::unixify($archive) if ON_VMS;
+
### XXX solaris tar and bsdtar are having different outputs
### depending whether you run with -x or -t
### compensate for this insanity by running -t first, then -x
{ my $cmd =
- $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
+ $self->is_tgz ? [$self->bin_gzip, '-cdf', $archive, '|',
$self->bin_tar, '-tf', '-'] :
- $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',
+ $self->is_tbz ? [$self->bin_bunzip2, '-cd', $archive, '|',
$self->bin_tar, '-tf', '-'] :
- $self->is_txz ? [$self->bin_unxz, '-cd', $self->archive, '|',
+ $self->is_txz ? [$self->bin_unxz, '-cd', $archive, '|',
$self->bin_tar, '-tf', '-'] :
- [$self->bin_tar, @ExtraTarFlags, '-tf', $self->archive];
+ [$self->bin_tar, @ExtraTarFlags, '-tf', $archive];
### run the command
### newer versions of 'tar' (1.21 and up) now print record size
@@ -697,12 +701,12 @@ sub have_old_bunzip2 {
unless( $out[0] ) {
return $self->_error(loc(
"Error listing contents of archive '%1': %2",
- $self->archive, $buffer ));
+ $archive, $buffer ));
}
### no buffers available?
if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
- $self->_error( $self->_no_buffer_files( $self->archive ) );
+ $self->_error( $self->_no_buffer_files( $archive ) );
} else {
### if we're on solaris we /might/ be using /bin/tar, which has
@@ -729,21 +733,21 @@ sub have_old_bunzip2 {
### now actually extract it ###
{ my $cmd =
- $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
+ $self->is_tgz ? [$self->bin_gzip, '-cdf', $archive, '|',
$self->bin_tar, '-xf', '-'] :
- $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',
+ $self->is_tbz ? [$self->bin_bunzip2, '-cd', $archive, '|',
$self->bin_tar, '-xf', '-'] :
- $self->is_txz ? [$self->bin_unxz, '-cd', $self->archive, '|',
+ $self->is_txz ? [$self->bin_unxz, '-cd', $archive, '|',
$self->bin_tar, '-xf', '-'] :
- [$self->bin_tar, @ExtraTarFlags, '-xf', $self->archive];
+ [$self->bin_tar, @ExtraTarFlags, '-xf', $archive];
my $buffer = '';
unless( scalar run( command => $cmd,
buffer => \$buffer,
verbose => $DEBUG )
) {
return $self->_error(loc("Error extracting archive '%1': %2",
- $self->archive, $buffer ));
+ $archive, $buffer ));
}
### we might not have them, due to lack of buffers
@@ -1087,6 +1091,10 @@ sub _unzip_bin {
$self->_error( $self->_no_buffer_files( $self->archive ) );
} else {
+ ### Annoyingly, pesky MSWin32 can either have 'native' tools
+ ### which have \r\n line endings or Cygwin-based tools which
+ ### have \n line endings. Jan Dubois suggested using this fix
+ local $/ = ON_WIN32 ? qr/\r?\n/ : "\n";
$self->files( [split $/, $buffer] );
}
}
View
22 perl/lib/perllocal.pod
@@ -8072,3 +8072,25 @@ C<EXE_FILES: bin/pm-uninstall>
=back
+=head2 Mon Feb 6 16:27:57 2012: C<Module> L<Archive::Extract|Archive::Extract>
+
+=over 4
+
+=item *
+
+C<installed into: C:\strawberry\perl\lib>
+
+=item *
+
+C<LINKTYPE: dynamic>
+
+=item *
+
+C<VERSION: 0.58>
+
+=item *
+
+C<EXE_FILES: >
+
+=back
+

0 comments on commit 67ea890

Please sign in to comment.