| Subject: | Use Archive::Tar iter to keep from read the tar into memory |
Archive::Tar implements a streaming reader in version 1.40+ that enables
the archive to be extracted without reading the entire archive into
memory. An example patch is included for use against Archive-Extract-0.32
| Subject: | Extract.patch |
--- lib/Archive/Extract.pm Wed Jun 17 12:38:19 2009
+++ lib/Archive/Extract.pm Wed Jun 17 12:58:18 2009
@@ -786,15 +786,6 @@
### localized $Archive::Tar::WARN already.
$Archive::Tar::WARN = $Archive::Extract::WARN;
- my $tar = Archive::Tar->new();
-
- ### only tell it it's compressed if it's a .tgz, as we give it a file
- ### handle if it's a .tbz
- unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) {
- return $self->_error(loc("Unable to read '%1': %2", $self->archive,
- $Archive::Tar::error));
- }
-
### workaround to prevent Archive::Tar from setting uid, which
### is a potential security hole. -autrijus
### have to do it here, since A::T needs to be /loaded/ first ###
@@ -807,17 +798,50 @@
### for version of Archive::Tar > 1.04
local $Archive::Tar::CHOWN = 0;
- { local $^W; # quell 'splice() offset past end of array' warnings
- # on older versions of A::T
+ my @files;
+
+ if (eval 'my $v = Archive::Tar->VERSION; defined $v && $v > 1.40;') {
+ ### unroll the tar using the iterator interface as not to load
+ ### the entire tarball into memory
+ my $next = Archive::Tar->iter( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) );
+
+ if ( !defined $next ) {
+ return $self->_error(loc("Unable to read '%1': %2", $self->archive,
+ $Archive::Tar::error));
+ }
+
+ ### extract the tarball
+ while ( my $file = $next->() ) {
+ push @files, $file->full_path;
+
+ $file->extract()
+ or return $self->_error(loc("Unable to extract '%1': %2",
+ $self->archive, $Archive::Tar::error ));
+ }
+ }
+ else {
+ my $tar = Archive::Tar->new();
+
+ ### only tell it it's compressed if it's a .tgz, as we give it a file
+ ### handle if it's a .tbz
+ unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) {
+ return $self->_error(loc("Unable to read '%1': %2", $self->archive,
+ $Archive::Tar::error));
+ }
+
+ { local $^W; # quell 'splice() offset past end of array' warnings
+ # on older versions of A::T
+
+ ### older archive::tar always returns $self, return value slightly
+ ### fux0r3d because of it.
+ $tar->extract()
+ or return $self->_error(loc("Unable to extract '%1': %2",
+ $self->archive, $Archive::Tar::error ));
+ }
- ### older archive::tar always returns $self, return value slightly
- ### fux0r3d because of it.
- $tar->extract()
- or return $self->_error(loc("Unable to extract '%1': %2",
- $self->archive, $Archive::Tar::error ));
+ @files = $tar->list_files;
}
- my @files = $tar->list_files;
my $dir = $self->__get_extract_dir( \@files );
### store the files that are in the archive ###