use constant ZIP => 'zip';
use constant BZ2 => 'bz2';
use constant TBZ => 'tbz';
+use constant Z => 'Z';
use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
-$VERSION = '0.18';
+$VERSION = '0.22_01';
$PREFER_BIN = 0;
$WARN = 1;
$DEBUG = 0;
-my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ ); # same as all constants
+my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants
local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
Archive::Extract is a generic archive extraction mechanism.
It allows you to extract any archive file of the type .tar, .tar.gz,
-.gz, tar.bz2, .tbz, .bz2 or .zip without having to worry how it does
-so, or use different interfaces for each type by using either perl
-modules, or commandline tools on your system.
+.gz, .Z, tar.bz2, .tbz, .bz2 or .zip without having to worry how it
+does so, or use different interfaces for each type by using either
+perl modules, or commandline tools on your system.
See the C<HOW IT WORKS> section further down for details.
### see what /bin/programs are available ###
$PROGRAMS = {};
-for my $pgm (qw[tar unzip gzip bunzip2]) {
+for my $pgm (qw[tar unzip gzip bunzip2 uncompress]) {
$PROGRAMS->{$pgm} = can_run($pgm);
}
is_zip => '_unzip',
is_tbz => '_untar',
is_bz2 => '_bunzip2',
+ is_Z => '_uncompress',
};
{
Gzip compressed file, as produced by, for example C</bin/gzip>.
Corresponds to a C<.gz> suffix.
+=item Z
+
+Lempel-Ziv compressed file, as produced by, for example C</bin/compress>.
+Corresponds to a C<.Z> suffix.
+
=item zip
Zip compressed file, as produced by, for example C</bin/zip>.
$ar =~ /.+?\.(zip|jar|par)$/i ? ZIP :
$ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i ? TBZ :
$ar =~ /.+?\.bz2$/i ? BZ2 :
+ $ar =~ /.+?\.Z$/ ? Z :
'';
}
### to.
my $dir;
{ ### a foo.gz file
- if( $self->is_gz or $self->is_bz2 ) {
+ if( $self->is_gz or $self->is_bz2 or $self->is_Z) {
- my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2)$//i;
+ my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2|Z)$//i;
### to is a dir?
if ( -d $to ) {
Returns true if the file is of type C<.gz>.
See the C<new()> method for details.
+=head2 $ae->is_Z
+
+Returns true if the file is of type C<.Z>.
+See the C<new()> method for details.
+
=head2 $ae->is_zip
Returns true if the file is of type C<.zip>.
sub is_zip { return $_[0]->type eq ZIP }
sub is_tbz { return $_[0]->type eq TBZ }
sub is_bz2 { return $_[0]->type eq BZ2 }
+sub is_Z { return $_[0]->type eq Z }
=pod
=cut
### paths to commandline tools ###
-sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} }
-sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} }
-sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} }
-sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
+sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} }
+sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} }
+sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} }
+sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
+sub bin_uncompress { return $PROGRAMS->{'uncompress'}
+ if $PROGRAMS->{'uncompress'} }
#################################
#
#################################
#
+# Uncompress code
+#
+#################################
+
+
+### untar wrapper... goes to either Archive::Tar or /bin/tar
+### depending on $PREFER_BIN
+sub _uncompress {
+ my $self = shift;
+
+ my @methods = qw[_gunzip_cz _uncompress_bin];
+ @methods = reverse @methods if $PREFER_BIN;
+
+ for my $method (@methods) {
+ $self->_extractor($method) && return 1 if $self->$method();
+ }
+
+ return $self->_error(loc("Unable to untar file '%1'", $self->archive));
+}
+
+sub _uncompress_bin {
+ my $self = shift;
+
+ ### check for /bin/gzip -- we need it ###
+ return $self->_error(loc("No '%1' program found", '/bin/uncompress'))
+ unless $self->bin_uncompress;
+
+
+ my $fh = FileHandle->new('>'. $self->_gunzip_to) or
+ return $self->_error(loc("Could not open '%1' for writing: %2",
+ $self->_gunzip_to, $! ));
+
+ my $cmd = [ $self->bin_uncompress, '-c', $self->archive ];
+
+ my $buffer;
+ unless( scalar run( command => $cmd,
+ verbose => $DEBUG,
+ buffer => \$buffer )
+ ) {
+ return $self->_error(loc("Unable to uncompress '%1': %2",
+ $self->archive, $buffer));
+ }
+
+ ### no buffers available?
+ if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
+ $self->_error( $self->_no_buffer_content( $self->archive ) );
+ }
+
+ print $fh $buffer if defined $buffer;
+
+ close $fh;
+
+ ### set what files where extract, and where they went ###
+ $self->files( [$self->_gunzip_to] );
+ $self->extract_path( File::Spec->rel2abs(cwd()) );
+
+ return 1;
+}
+
+
+#################################
+#
# Unzip code
#
#################################
C<new()> method, you will have to specify the type explicitly, or
C<Archive::Extract> will not be able to extract the archive for you.
-=head2 Bzip2 Support
-
-There's currently no very reliable pure perl Bzip2 implementation
-available, so C<Archive::Extract> can only extract C<bzip2>
-compressed archives if you have a C</bin/bunzip2> program.
-
=head1 GLOBAL VARIABLES
=head2 $Archive::Extract::DEBUG
Maybe this module should use something like C<File::Type> to determine
the type, rather than blindly trust the suffix.
+=back
+
=head1 BUG REPORTS
Please report bugs or other issues to E<lt>bug-archive-extract@rt.cpan.org<gt>.
projects / p5sagit/p5-mst-13.2.git / blobdiff