1 package Archive::Extract;
7 use IPC::Cmd qw[run can_run];
9 use File::Path qw[mkpath];
11 use File::Basename qw[dirname basename];
12 use Params::Check qw[check];
13 use Module::Load::Conditional qw[can_load check_install];
14 use Locale::Maketext::Simple Style => 'gettext';
16 ### solaris has silly /bin/tar output ###
17 use constant ON_SOLARIS => $^O eq 'solaris' ? 1 : 0;
18 use constant FILE_EXISTS => sub { -e $_[0] ? 1 : 0 };
20 ### If these are changed, update @TYPES and the new() POD
21 use constant TGZ => 'tgz';
22 use constant TAR => 'tar';
23 use constant GZ => 'gz';
24 use constant ZIP => 'zip';
25 use constant BZ2 => 'bz2';
26 use constant TBZ => 'tbz';
28 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
34 my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ ); # same as all constants
36 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
42 Archive::Extract - A generic archive extracting mechanism
48 ### build an Archive::Extract object ###
49 my $ae = Archive::Extract->new( archive => 'foo.tgz' );
51 ### extract to cwd() ###
52 my $ok = $ae->extract;
54 ### extract to /tmp ###
55 my $ok = $ae->extract( to => '/tmp' );
57 ### what if something went wrong?
58 my $ok = $ae->extract or die $ae->error;
60 ### files from the archive ###
61 my $files = $ae->files;
63 ### dir that was extracted to ###
64 my $outdir = $ae->extract_path;
67 ### quick check methods ###
68 $ae->is_tar # is it a .tar file?
69 $ae->is_tgz # is it a .tar.gz or .tgz file?
70 $ae->is_gz; # is it a .gz file?
71 $ae->is_zip; # is it a .zip file?
72 $ae->is_bz2; # is it a .bz2 file?
73 $ae->is_tbz; # is it a .tar.bz2 or .tbz file?
75 ### absolute path to the archive you provided ###
78 ### commandline tools, if found ###
79 $ae->bin_tar # path to /bin/tar, if found
80 $ae->bin_gzip # path to /bin/gzip, if found
81 $ae->bin_unzip # path to /bin/unzip, if found
82 $ae->bin_bunzip2 # path to /bin/bunzip2 if found
86 Archive::Extract is a generic archive extraction mechanism.
88 It allows you to extract any archive file of the type .tar, .tar.gz,
89 .gz, tar.bz2, .tbz, .bz2 or .zip without having to worry how it does
90 so, or use different interfaces for each type by using either perl
91 modules, or commandline tools on your system.
93 See the C<HOW IT WORKS> section further down for details.
98 ### see what /bin/programs are available ###
100 for my $pgm (qw[tar unzip gzip bunzip2]) {
101 $PROGRAMS->{$pgm} = can_run($pgm);
104 ### mapping from types to extractor methods ###
111 is_bz2 => '_bunzip2',
116 archive => { required => 1, allow => FILE_EXISTS },
117 type => { default => '', allow => [ @Types ] },
120 ### build accesssors ###
121 for my $method( keys %$tmpl,
122 qw[_extractor _gunzip_to files extract_path],
123 qw[_error_msg _error_msg_long]
128 $self->{$method} = $_[0] if @_;
129 return $self->{$method};
135 =head2 $ae = Archive::Extract->new(archive => '/path/to/archive',[type => TYPE])
137 Creates a new C<Archive::Extract> object based on the archive file you
138 passed it. Automatically determines the type of archive based on the
139 extension, but you can override that by explicitly providing the
142 Valid values for C<type> are:
148 Standard tar files, as produced by, for example, C</bin/tar>.
149 Corresponds to a C<.tar> suffix.
153 Gzip compressed tar files, as produced by, for example C</bin/tar -z>.
154 Corresponds to a C<.tgz> or C<.tar.gz> suffix.
158 Gzip compressed file, as produced by, for example C</bin/gzip>.
159 Corresponds to a C<.gz> suffix.
163 Zip compressed file, as produced by, for example C</bin/zip>.
164 Corresponds to a C<.zip>, C<.jar> or C<.par> suffix.
168 Bzip2 compressed file, as produced by, for example, C</bin/bzip2>.
169 Corresponds to a C<.bz2> suffix.
173 Bzip2 compressed tar file, as produced by, for exmample C</bin/tar -j>.
174 Corresponds to a C<.tbz> or C<.tar.bz2> suffix.
178 Returns a C<Archive::Extract> object on success, or false on failure.
187 my $parsed = check( $tmpl, \%hash ) or return;
189 ### make sure we have an absolute path ###
190 my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} );
192 ### figure out the type, if it wasn't already specified ###
193 unless ( $parsed->{type} ) {
195 $ar =~ /.+?\.(?:tar\.gz)|tgz$/i ? TGZ :
196 $ar =~ /.+?\.gz$/i ? GZ :
197 $ar =~ /.+?\.tar$/i ? TAR :
198 $ar =~ /.+?\.(zip|jar|par)$/i ? ZIP :
199 $ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i ? TBZ :
200 $ar =~ /.+?\.bz2$/i ? BZ2 :
205 ### don't know what type of file it is ###
206 return __PACKAGE__->_error(loc("Cannot determine file type for '%1'",
207 $parsed->{archive} )) unless $parsed->{type};
209 return bless $parsed, $class;
213 =head2 $ae->extract( [to => '/output/path'] )
215 Extracts the archive represented by the C<Archive::Extract> object to
216 the path of your choice as specified by the C<to> argument. Defaults to
219 Since C<.gz> files never hold a directory, but only a single file; if
220 the C<to> argument is an existing directory, the file is extracted
221 there, with it's C<.gz> suffix stripped.
222 If the C<to> argument is not an existing directory, the C<to> argument
223 is understood to be a filename, if the archive type is C<gz>.
224 In the case that you did not specify a C<to> argument, the output
225 file will be the name of the archive file, stripped from it's C<.gz>
226 suffix, in the current working directory.
228 C<extract> will try a pure perl solution first, and then fall back to
229 commandline tools if they are available. See the C<GLOBAL VARIABLES>
230 section below on how to alter this behaviour.
232 It will return true on success, and false on failure.
234 On success, it will also set the follow attributes in the object:
238 =item $ae->extract_path
240 This is the directory that the files where extracted to.
244 This is an array ref with the paths of all the files in the archive,
245 relative to the C<to> argument you specified.
246 To get the full path to an extracted file, you would use:
248 File::Spec->catfile( $to, $ae->files->[0] );
250 Note that all files from a tar archive will be in unix format, as per
251 the tar specification.
263 to => { default => '.', store => \$to }
266 check( $tmpl, \%hash ) or return;
268 ### so 'to' could be a file or a dir, depending on whether it's a .gz
269 ### file, or basically anything else.
270 ### so, check that, then act accordingly.
271 ### set an accessor specifically so _gunzip can know what file to extract
275 if( $self->is_gz or $self->is_bz2 ) {
277 my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2)$//i;
282 $self->_gunzip_to( basename($cp) );
284 ### then it's a filename
287 $self->_gunzip_to( basename($to) );
290 ### not a foo.gz file
296 ### make the dir if it doesn't exist ###
298 eval { mkpath( $dir ) };
300 return $self->_error(loc("Could not create path '%1': %2", $dir, $@))
304 ### get the current dir, to restore later ###
310 ### chdir to the target dir ###
311 unless( chdir $dir ) {
312 $self->_error(loc("Could not chdir to '%1': %2", $dir, $!));
313 $ok = 0; last EXTRACT;
316 ### set files to an empty array ref, so there's always an array
317 ### ref IN the accessor, to avoid errors like:
318 ### Can't use an undefined value as an ARRAY reference at
319 ### ../lib/Archive/Extract.pm line 742. (rt #19815)
322 ### find what extractor method to use ###
323 while( my($type,$method) = each %$Mapping ) {
325 ### call the corresponding method if the type is OK ###
327 $ok = $self->$method();
331 ### warn something went wrong if we didn't get an OK ###
332 $self->_error(loc("Extract failed, no extractor found"))
337 ### and chdir back ###
338 unless( chdir $cwd ) {
339 $self->_error(loc("Could not chdir back to start dir '%1': %2'",
350 =head2 $ae->error([BOOL])
352 Returns the last encountered error as string.
353 Pass it a true value to get the C<Carp::longmess()> output instead.
355 =head2 $ae->extract_path
357 This is the directory the archive got extracted to.
358 See C<extract()> for details.
362 This is an array ref holding all the paths from the archive.
363 See C<extract()> for details.
367 This is the full path to the archive file represented by this
368 C<Archive::Extract> object.
372 This is the type of archive represented by this C<Archive::Extract>
373 object. See accessors below for an easier way to use this.
374 See the C<new()> method for details.
378 Returns a list of all known C<types> for C<Archive::Extract>'s
383 sub types { return @Types }
387 Returns true if the file is of type C<.tar.gz>.
388 See the C<new()> method for details.
392 Returns true if the file is of type C<.tar>.
393 See the C<new()> method for details.
397 Returns true if the file is of type C<.gz>.
398 See the C<new()> method for details.
402 Returns true if the file is of type C<.zip>.
403 See the C<new()> method for details.
407 ### quick check methods ###
408 sub is_tgz { return $_[0]->type eq TGZ }
409 sub is_tar { return $_[0]->type eq TAR }
410 sub is_gz { return $_[0]->type eq GZ }
411 sub is_zip { return $_[0]->type eq ZIP }
412 sub is_tbz { return $_[0]->type eq TBZ }
413 sub is_bz2 { return $_[0]->type eq BZ2 }
419 Returns the full path to your tar binary, if found.
423 Returns the full path to your gzip binary, if found
425 =head2 $ae->bin_unzip
427 Returns the full path to your unzip binary, if found
431 ### paths to commandline tools ###
432 sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} }
433 sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} }
434 sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} }
435 sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
437 #################################
441 #################################
444 ### untar wrapper... goes to either Archive::Tar or /bin/tar
445 ### depending on $PREFER_BIN
449 ### bzip2 support in A::T via IO::Uncompress::Bzip2
450 my @methods = qw[_untar_at _untar_bin];
451 @methods = reverse @methods unless $PREFER_BIN;
453 for my $method (@methods) {
454 $self->_extractor($method) && return 1 if $self->$method();
457 return $self->_error(loc("Unable to untar file '%1'", $self->archive));
460 ### use /bin/tar to extract ###
464 ### check for /bin/tar ###
465 return $self->_error(loc("No '%1' program found", '/bin/tar'))
466 unless $self->bin_tar;
468 ### check for /bin/gzip if we need it ###
469 return $self->_error(loc("No '%1' program found", '/bin/gzip'))
470 if $self->is_tgz && !$self->bin_gzip;
472 return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
473 if $self->is_tbz && !$self->bin_bunzip2;
475 ### XXX figure out how to make IPC::Run do this in one call --
476 ### currently i don't know how to get output of a command after a pipe
477 ### trapped in a scalar. Mailed barries about this 5th of june 2004.
481 ### see what command we should run, based on whether
482 ### it's a .tgz or .tar
484 ### XXX solaris tar and bsdtar are having different outputs
485 ### depending whether you run with -x or -t
486 ### compensate for this insanity by running -t first, then -x
488 $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
489 $self->bin_tar, '-tf', '-'] :
490 $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|',
491 $self->bin_tar, '-tf', '-'] :
492 [$self->bin_tar, '-tf', $self->archive];
494 ### run the command ###
496 unless( scalar run( command => $cmd,
500 return $self->_error(loc(
501 "Error listing contents of archive '%1': %2",
502 $self->archive, $buffer ));
505 ### no buffers available?
506 if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
507 $self->_error( $self->_no_buffer_files( $self->archive ) );
510 ### if we're on solaris we /might/ be using /bin/tar, which has
511 ### a weird output format... we might also be using
512 ### /usr/local/bin/tar, which is gnu tar, which is perfectly
513 ### fine... so we have to do some guessing here =/
514 my @files = map { chomp;
516 : (m|^ x \s+ # 'xtract' -- sigh
517 (.+?), # the actual file name
518 \s+ [\d,.]+ \s bytes,
519 \s+ [\d,.]+ \s tape \s blocks
524 ### store the files that are in the archive ###
525 $self->files(\@files);
529 ### now actually extract it ###
531 $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
532 $self->bin_tar, '-xf', '-'] :
533 $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|',
534 $self->bin_tar, '-xf', '-'] :
535 [$self->bin_tar, '-xf', $self->archive];
538 unless( scalar run( command => $cmd,
542 return $self->_error(loc("Error extracting archive '%1': %2",
543 $self->archive, $buffer ));
546 ### we might not have them, due to lack of buffers
548 ### now that we've extracted, figure out where we extracted to
549 my $dir = $self->__get_extract_dir( $self->files );
551 ### store the extraction dir ###
552 $self->extract_path( $dir );
556 ### we got here, no error happened
560 ### use archive::tar to extract ###
564 ### we definitely need A::T, so load that first
565 { my $use_list = { 'Archive::Tar' => '0.0' };
567 unless( can_load( modules => $use_list ) ) {
569 return $self->_error(loc("You do not have '%1' installed - " .
570 "Please install it as soon as possible.",
575 ### we might pass it a filehandle if it's a .tbz file..
576 my $fh_to_read = $self->archive;
578 ### we will need Compress::Zlib too, if it's a tgz... and IO::Zlib
579 ### if A::T's version is 0.99 or higher
580 if( $self->is_tgz ) {
581 my $use_list = { 'Compress::Zlib' => '0.0' };
582 $use_list->{ 'IO::Zlib' } = '0.0'
583 if $Archive::Tar::VERSION >= '0.99';
585 unless( can_load( modules => $use_list ) ) {
586 my $which = join '/', sort keys %$use_list;
588 return $self->_error(loc(
589 "You do not have '%1' installed - Please ".
590 "install it as soon as possible.", $which));
593 } elsif ( $self->is_tbz ) {
594 my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
595 unless( can_load( modules => $use_list ) ) {
596 return $self->_error(loc(
597 "You do not have '%1' installed - Please " .
598 "install it as soon as possible.",
599 'IO::Uncompress::Bunzip2'));
602 my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
603 return $self->_error(loc("Unable to open '%1': %2",
605 $IO::Uncompress::Bunzip2::Bunzip2Error));
610 my $tar = Archive::Tar->new();
612 ### only tell it it's compressed if it's a .tgz, as we give it a file
613 ### handle if it's a .tbz
614 unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) {
615 return $self->_error(loc("Unable to read '%1': %2", $self->archive,
616 $Archive::Tar::error));
619 ### workaround to prevent Archive::Tar from setting uid, which
620 ### is a potential security hole. -autrijus
621 ### have to do it here, since A::T needs to be /loaded/ first ###
622 { no strict 'refs'; local $^W;
624 ### older versions of archive::tar <= 0.23
625 *Archive::Tar::chown = sub {};
628 ### for version of archive::tar > 1.04
629 local $Archive::Tar::Constant::CHOWN = 0;
631 { local $^W; # quell 'splice() offset past end of array' warnings
632 # on older versions of A::T
634 ### older archive::tar always returns $self, return value slightly
635 ### fux0r3d because of it.
637 or return $self->_error(loc("Unable to extract '%1': %2",
638 $self->archive, $Archive::Tar::error ));
641 my @files = $tar->list_files;
642 my $dir = $self->__get_extract_dir( \@files );
644 ### store the files that are in the archive ###
645 $self->files(\@files);
647 ### store the extraction dir ###
648 $self->extract_path( $dir );
650 ### check if the dir actually appeared ###
651 return 1 if -d $self->extract_path;
653 ### no dir, we failed ###
654 return $self->_error(loc("Unable to extract '%1': %2",
655 $self->archive, $Archive::Tar::error ));
658 #################################
662 #################################
664 ### gunzip wrapper... goes to either Compress::Zlib or /bin/gzip
665 ### depending on $PREFER_BIN
669 my @methods = qw[_gunzip_cz _gunzip_bin];
670 @methods = reverse @methods if $PREFER_BIN;
672 for my $method (@methods) {
673 $self->_extractor($method) && return 1 if $self->$method();
676 return $self->_error(loc("Unable to gunzip file '%1'", $self->archive));
682 ### check for /bin/gzip -- we need it ###
683 return $self->_error(loc("No '%1' program found", '/bin/gzip'))
684 unless $self->bin_gzip;
687 my $fh = FileHandle->new('>'. $self->_gunzip_to) or
688 return $self->_error(loc("Could not open '%1' for writing: %2",
689 $self->_gunzip_to, $! ));
691 my $cmd = [ $self->bin_gzip, '-cdf', $self->archive ];
694 unless( scalar run( command => $cmd,
698 return $self->_error(loc("Unable to gunzip '%1': %2",
699 $self->archive, $buffer));
702 ### no buffers available?
703 if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
704 $self->_error( $self->_no_buffer_content( $self->archive ) );
707 print $fh $buffer if defined $buffer;
711 ### set what files where extract, and where they went ###
712 $self->files( [$self->_gunzip_to] );
713 $self->extract_path( File::Spec->rel2abs(cwd()) );
721 my $use_list = { 'Compress::Zlib' => '0.0' };
722 unless( can_load( modules => $use_list ) ) {
723 return $self->_error(loc("You do not have '%1' installed - Please " .
724 "install it as soon as possible.", 'Compress::Zlib'));
727 my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or
728 return $self->_error(loc("Unable to open '%1': %2",
729 $self->archive, $Compress::Zlib::gzerrno));
731 my $fh = FileHandle->new('>'. $self->_gunzip_to) or
732 return $self->_error(loc("Could not open '%1' for writing: %2",
733 $self->_gunzip_to, $! ));
736 $fh->print($buffer) while $gz->gzread($buffer) > 0;
739 ### set what files where extract, and where they went ###
740 $self->files( [$self->_gunzip_to] );
741 $self->extract_path( File::Spec->rel2abs(cwd()) );
746 #################################
750 #################################
752 ### unzip wrapper... goes to either Archive::Zip or /bin/unzip
753 ### depending on $PREFER_BIN
757 my @methods = qw[_unzip_az _unzip_bin];
758 @methods = reverse @methods if $PREFER_BIN;
760 for my $method (@methods) {
761 $self->_extractor($method) && return 1 if $self->$method();
764 return $self->_error(loc("Unable to gunzip file '%1'", $self->archive));
770 ### check for /bin/gzip if we need it ###
771 return $self->_error(loc("No '%1' program found", '/bin/unzip'))
772 unless $self->bin_unzip;
775 ### first, get the files.. it must be 2 different commands with 'unzip' :(
776 { my $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ];
779 unless( scalar run( command => $cmd,
783 return $self->_error(loc("Unable to unzip '%1': %2",
784 $self->archive, $buffer));
787 ### no buffers available?
788 if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
789 $self->_error( $self->_no_buffer_files( $self->archive ) );
792 $self->files( [split $/, $buffer] );
796 ### now, extract the archive ###
797 { my $cmd = [ $self->bin_unzip, '-qq', '-o', $self->archive ];
800 unless( scalar run( command => $cmd,
804 return $self->_error(loc("Unable to unzip '%1': %2",
805 $self->archive, $buffer));
808 if( scalar @{$self->files} ) {
809 my $files = $self->files;
810 my $dir = $self->__get_extract_dir( $files );
812 $self->extract_path( $dir );
822 my $use_list = { 'Archive::Zip' => '0.0' };
823 unless( can_load( modules => $use_list ) ) {
824 return $self->_error(loc("You do not have '%1' installed - Please " .
825 "install it as soon as possible.", 'Archive::Zip'));
828 my $zip = Archive::Zip->new();
830 unless( $zip->read( $self->archive ) == &Archive::Zip::AZ_OK ) {
831 return $self->_error(loc("Unable to read '%1'", $self->archive));
835 ### have to extract every memeber individually ###
836 for my $member ($zip->members) {
837 push @files, $member->{fileName};
839 unless( $zip->extractMember($member) == &Archive::Zip::AZ_OK ) {
840 return $self->_error(loc("Extraction of '%1' from '%2' failed",
841 $member->{fileName}, $self->archive ));
845 my $dir = $self->__get_extract_dir( \@files );
847 ### set what files where extract, and where they went ###
848 $self->files( \@files );
849 $self->extract_path( File::Spec->rel2abs($dir) );
854 sub __get_extract_dir {
856 my $files = shift || [];
858 return unless scalar @$files;
861 for my $aref ( [ \$dir1, 0 ], [ \$dir2, -1 ] ) {
862 my($dir,$pos) = @$aref;
864 ### add a catdir(), so that any trailing slashes get
865 ### take care of (removed)
866 ### also, a catdir() normalises './dir/foo' to 'dir/foo';
867 ### which was the problem in bug #23999
868 my $res = -d $files->[$pos]
869 ? File::Spec->catdir( $files->[$pos], '' )
870 : File::Spec->catdir( dirname( $files->[$pos] ) );
875 ### if the first and last dir don't match, make sure the
876 ### dirname is not set wrongly
879 ### dirs are the same, so we know for sure what the extract dir is
880 if( $dir1 eq $dir2 ) {
883 ### dirs are different.. do they share the base dir?
884 ### if so, use that, if not, fall back to '.'
886 my $base1 = [ File::Spec->splitdir( $dir1 ) ]->[0];
887 my $base2 = [ File::Spec->splitdir( $dir2 ) ]->[0];
889 $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' );
892 return File::Spec->rel2abs( $dir );
895 #################################
899 #################################
901 ### bunzip2 wrapper...
905 my @methods = qw[_bunzip2_cz2 _bunzip2_bin];
906 @methods = reverse @methods if $PREFER_BIN;
908 for my $method (@methods) {
909 $self->_extractor($method) && return 1 if $self->$method();
912 return $self->_error(loc("Unable to bunzip2 file '%1'", $self->archive));
918 ### check for /bin/gzip -- we need it ###
919 return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
920 unless $self->bin_bunzip2;
923 my $fh = FileHandle->new('>'. $self->_gunzip_to) or
924 return $self->_error(loc("Could not open '%1' for writing: %2",
925 $self->_gunzip_to, $! ));
927 my $cmd = [ $self->bin_bunzip2, '-c', $self->archive ];
930 unless( scalar run( command => $cmd,
934 return $self->_error(loc("Unable to bunzip2 '%1': %2",
935 $self->archive, $buffer));
938 ### no buffers available?
939 if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
940 $self->_error( $self->_no_buffer_content( $self->archive ) );
943 print $fh $buffer if defined $buffer;
947 ### set what files where extract, and where they went ###
948 $self->files( [$self->_gunzip_to] );
949 $self->extract_path( File::Spec->rel2abs(cwd()) );
954 ### using cz2, the compact versions... this we use mainly in archive::tar
959 # my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
960 # unless( can_load( modules => $use_list ) ) {
961 # return $self->_error(loc("You do not have '%1' installed - Please " .
962 # "install it as soon as possible.",
963 # 'IO::Uncompress::Bunzip2'));
966 # my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
967 # return $self->_error(loc("Unable to open '%1': %2",
969 # $IO::Uncompress::Bunzip2::Bunzip2Error));
971 # my $fh = FileHandle->new('>'. $self->_gunzip_to) or
972 # return $self->_error(loc("Could not open '%1' for writing: %2",
973 # $self->_gunzip_to, $! ));
976 # $fh->print($buffer) while $bz->read($buffer) > 0;
979 # ### set what files where extract, and where they went ###
980 # $self->files( [$self->_gunzip_to] );
981 # $self->extract_path( File::Spec->rel2abs(cwd()) );
989 my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
990 unless( can_load( modules => $use_list ) ) {
991 return $self->_error(loc("You do not have '%1' installed - Please " .
992 "install it as soon as possible.",
993 'IO::Uncompress::Bunzip2'));
996 IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to)
997 or return $self->_error(loc("Unable to uncompress '%1': %2",
999 $IO::Uncompress::Bunzip2::Bunzip2Error));
1001 ### set what files where extract, and where they went ###
1002 $self->files( [$self->_gunzip_to] );
1003 $self->extract_path( File::Spec->rel2abs(cwd()) );
1009 #################################
1013 #################################
1019 $self->_error_msg( $error );
1020 $self->_error_msg_long( Carp::longmess($error) );
1022 ### set $Archive::Extract::WARN to 0 to disable printing
1025 carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
1033 return shift() ? $self->_error_msg_long : $self->_error_msg;
1036 sub _no_buffer_files {
1038 my $file = shift or return;
1039 return loc("No buffer captured, unable to tell ".
1040 "extracted files or extraction dir for '%1'", $file);
1043 sub _no_buffer_content {
1045 my $file = shift or return;
1046 return loc("No buffer captured, unable to get content for '%1'", $file);
1054 C<Archive::Extract> tries first to determine what type of archive you
1055 are passing it, by inspecting its suffix. It does not do this by using
1056 Mime magic, or something related. See C<CAVEATS> below.
1058 Once it has determined the file type, it knows which extraction methods
1059 it can use on the archive. It will try a perl solution first, then fall
1060 back to a commandline tool if that fails. If that also fails, it will
1061 return false, indicating it was unable to extract the archive.
1062 See the section on C<GLOBAL VARIABLES> to see how to alter this order.
1066 =head2 File Extensions
1068 C<Archive::Extract> trusts on the extension of the archive to determine
1069 what type it is, and what extractor methods therefore can be used. If
1070 your archives do not have any of the extensions as described in the
1071 C<new()> method, you will have to specify the type explicitly, or
1072 C<Archive::Extract> will not be able to extract the archive for you.
1074 =head2 Bzip2 Support
1076 There's currently no very reliable pure perl Bzip2 implementation
1077 available, so C<Archive::Extract> can only extract C<bzip2>
1078 compressed archives if you have a C</bin/bunzip2> program.
1080 =head1 GLOBAL VARIABLES
1082 =head2 $Archive::Extract::DEBUG
1084 Set this variable to C<true> to have all calls to command line tools
1085 be printed out, including all their output.
1086 This also enables C<Carp::longmess> errors, instead of the regular
1089 Good for tracking down why things don't work with your particular
1092 Defaults to C<false>.
1094 =head2 $Archive::Extract::WARN
1096 This variable controls whether errors encountered internally by
1097 C<Archive::Extract> should be C<carp>'d or not.
1099 Set to false to silence warnings. Inspect the output of the C<error()>
1100 method manually to see what went wrong.
1102 Defaults to C<true>.
1104 =head2 $Archive::Extract::PREFER_BIN
1106 This variables controls whether C<Archive::Extract> should prefer the
1107 use of perl modules, or commandline tools to extract archives.
1109 Set to C<true> to have C<Archive::Extract> prefer commandline tools.
1111 Defaults to C<false>.
1117 =item Mime magic support
1119 Maybe this module should use something like C<File::Type> to determine
1120 the type, rather than blindly trust the suffix.
1125 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1130 copyright (c) 2004-2007 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1131 All rights reserved.
1133 This library is free software;
1134 you may redistribute and/or modify it under the same
1135 terms as Perl itself.
1140 # c-indentation-style: bsd
1142 # indent-tabs-mode: nil
1144 # vim: expandtab shiftwidth=4: