lib/Archive/Extract.pm

   1 package Archive::Extract;
   2
   3 use strict;
   4
   5 use Cwd                         qw[cwd];
   6 use Carp                        qw[carp];
   7 use IPC::Cmd                    qw[run can_run];
   8 use FileHandle;
   9 use File::Path                  qw[mkpath];
  10 use File::Spec;
  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';
  15
  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 };
  19
  20 ### VMS may require quoting upper case command options
  21 use constant ON_VMS         => $^O eq 'VMS' ? 1 : 0;
  22
  23 ### we can't use this extraction method, because of missing
  24 ### modules/binaries:
  25 use constant METHOD_NA      => [];
  26
  27 ### If these are changed, update @TYPES and the new() POD
  28 use constant TGZ            => 'tgz';
  29 use constant TAR            => 'tar';
  30 use constant GZ             => 'gz';
  31 use constant ZIP            => 'zip';
  32 use constant BZ2            => 'bz2';
  33 use constant TBZ            => 'tbz';
  34 use constant Z              => 'Z';
  35 use constant LZMA           => 'lzma';
  36
  37 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG
  38             $_ALLOW_BIN $_ALLOW_PURE_PERL
  39          ];
  40
  41 $VERSION            = '0.28';
  42 $PREFER_BIN         = 0;
  43 $WARN               = 1;
  44 $DEBUG              = 0;
  45 $_ALLOW_PURE_PERL   = 1;    # allow pure perl extractors
  46 $_ALLOW_BIN         = 1;    # allow binary extractors
  47
  48 # same as all constants
  49 my @Types           = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA );
  50
  51 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
  52
  53 =pod
  54
  55 =head1 NAME
  56
  57 Archive::Extract - A generic archive extracting mechanism
  58
  59 =head1 SYNOPSIS
  60
  61     use Archive::Extract;
  62
  63     ### build an Archive::Extract object ###
  64     my $ae = Archive::Extract->new( archive => 'foo.tgz' );
  65
  66     ### extract to cwd() ###
  67     my $ok = $ae->extract;
  68
  69     ### extract to /tmp ###
  70     my $ok = $ae->extract( to => '/tmp' );
  71
  72     ### what if something went wrong?
  73     my $ok = $ae->extract or die $ae->error;
  74
  75     ### files from the archive ###
  76     my $files   = $ae->files;
  77
  78     ### dir that was extracted to ###
  79     my $outdir  = $ae->extract_path;
  80
  81
  82     ### quick check methods ###
  83     $ae->is_tar     # is it a .tar file?
  84     $ae->is_tgz     # is it a .tar.gz or .tgz file?
  85     $ae->is_gz;     # is it a .gz file?
  86     $ae->is_zip;    # is it a .zip file?
  87     $ae->is_bz2;    # is it a .bz2 file?
  88     $ae->is_tbz;    # is it a .tar.bz2 or .tbz file?
  89     $ae->is_lzma;   # is it a .lzma file?
  90
  91     ### absolute path to the archive you provided ###
  92     $ae->archive;
  93
  94     ### commandline tools, if found ###
  95     $ae->bin_tar     # path to /bin/tar, if found
  96     $ae->bin_gzip    # path to /bin/gzip, if found
  97     $ae->bin_unzip   # path to /bin/unzip, if found
  98     $ae->bin_bunzip2 # path to /bin/bunzip2 if found
  99     $ae->bin_unlzma  # path to /bin/unlzma if found
 100
 101 =head1 DESCRIPTION
 102
 103 Archive::Extract is a generic archive extraction mechanism.
 104
 105 It allows you to extract any archive file of the type .tar, .tar.gz,
 106 .gz, .Z, tar.bz2, .tbz, .bz2, .zip or .lzma without having to worry how it
 107 does so, or use different interfaces for each type by using either
 108 perl modules, or commandline tools on your system.
 109
 110 See the C<HOW IT WORKS> section further down for details.
 111
 112 =cut
 113
 114
 115 ### see what /bin/programs are available ###
 116 $PROGRAMS = {};
 117 for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma]) {
 118     $PROGRAMS->{$pgm} = can_run($pgm);
 119 }
 120
 121 ### mapping from types to extractor methods ###
 122 my $Mapping = {  # binary program           # pure perl module
 123     is_tgz  => { bin => '_untar_bin',       pp => '_untar_at'   },
 124     is_tar  => { bin => '_untar_bin',       pp => '_untar_at'   },
 125     is_gz   => { bin => '_gunzip_bin',      pp => '_gunzip_cz'  },
 126     is_zip  => { bin => '_unzip_bin',       pp => '_unzip_az'   },
 127     is_tbz  => { bin => '_untar_bin',       pp => '_untar_at'   },
 128     is_bz2  => { bin => '_bunzip2_bin',     pp => '_bunzip2_bz2'},
 129     is_Z    => { bin => '_uncompress_bin',  pp => '_gunzip_cz'  },
 130     is_lzma => { bin => '_unlzma_bin',      pp => '_unlzma_cz'  },
 131 };
 132
 133 {   ### use subs so we re-generate array refs etc for the no-overide flags
 134     ### if we don't, then we reuse the same arrayref, meaning objects store
 135     ### previous errors
 136     my $tmpl = {
 137         archive         => sub { { required => 1, allow => FILE_EXISTS }    },
 138         type            => sub { { default => '', allow => [ @Types ] }     },
 139         _error_msg      => sub { { no_override => 1, default => [] }        },
 140         _error_msg_long => sub { { no_override => 1, default => [] }        },
 141     };
 142
 143     ### build accesssors ###
 144     for my $method( keys %$tmpl,
 145                     qw[_extractor _gunzip_to files extract_path],
 146     ) {
 147         no strict 'refs';
 148         *$method = sub {
 149                         my $self = shift;
 150                         $self->{$method} = $_[0] if @_;
 151                         return $self->{$method};
 152                     }
 153     }
 154
 155 =head1 METHODS
 156
 157 =head2 $ae = Archive::Extract->new(archive => '/path/to/archive',[type => TYPE])
 158
 159 Creates a new C<Archive::Extract> object based on the archive file you
 160 passed it. Automatically determines the type of archive based on the
 161 extension, but you can override that by explicitly providing the
 162 C<type> argument.
 163
 164 Valid values for C<type> are:
 165
 166 =over 4
 167
 168 =item tar
 169
 170 Standard tar files, as produced by, for example, C</bin/tar>.
 171 Corresponds to a C<.tar> suffix.
 172
 173 =item tgz
 174
 175 Gzip compressed tar files, as produced by, for example C</bin/tar -z>.
 176 Corresponds to a C<.tgz> or C<.tar.gz> suffix.
 177
 178 =item gz
 179
 180 Gzip compressed file, as produced by, for example C</bin/gzip>.
 181 Corresponds to a C<.gz> suffix.
 182
 183 =item Z
 184
 185 Lempel-Ziv compressed file, as produced by, for example C</bin/compress>.
 186 Corresponds to a C<.Z> suffix.
 187
 188 =item zip
 189
 190 Zip compressed file, as produced by, for example C</bin/zip>.
 191 Corresponds to a C<.zip>, C<.jar> or C<.par> suffix.
 192
 193 =item bz2
 194
 195 Bzip2 compressed file, as produced by, for example, C</bin/bzip2>.
 196 Corresponds to a C<.bz2> suffix.
 197
 198 =item tbz
 199
 200 Bzip2 compressed tar file, as produced by, for exmample C</bin/tar -j>.
 201 Corresponds to a C<.tbz> or C<.tar.bz2> suffix.
 202
 203 =item lzma
 204
 205 Lzma compressed file, as produced by C</bin/lzma>.
 206 Corresponds to a C<.lzma> suffix.
 207
 208 =back
 209
 210 Returns a C<Archive::Extract> object on success, or false on failure.
 211
 212 =cut
 213
 214     ### constructor ###
 215     sub new {
 216         my $class   = shift;
 217         my %hash    = @_;
 218
 219         ### see above why we use subs here and generate the template;
 220         ### it's basically to not re-use arrayrefs
 221         my %utmpl   = map { $_ => $tmpl->{$_}->() } keys %$tmpl;
 222
 223         my $parsed = check( \%utmpl, \%hash ) or return;
 224
 225         ### make sure we have an absolute path ###
 226         my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} );
 227
 228         ### figure out the type, if it wasn't already specified ###
 229         unless ( $parsed->{type} ) {
 230             $parsed->{type} =
 231                 $ar =~ /.+?\.(?:tar\.gz|tgz)$/i     ? TGZ   :
 232                 $ar =~ /.+?\.gz$/i                  ? GZ    :
 233                 $ar =~ /.+?\.tar$/i                 ? TAR   :
 234                 $ar =~ /.+?\.(zip|jar|par)$/i       ? ZIP   :
 235                 $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ   :
 236                 $ar =~ /.+?\.bz2$/i                 ? BZ2   :
 237                 $ar =~ /.+?\.Z$/                    ? Z     :
 238                 $ar =~ /.+?\.lzma$/                 ? LZMA  :
 239                 '';
 240
 241         }
 242
 243         bless $parsed, $class;
 244
 245         ### don't know what type of file it is
 246         ### XXX this *has* to be an object call, not a package call
 247         return $parsed->_error(loc("Cannot determine file type for '%1'",
 248                                 $parsed->{archive} )) unless $parsed->{type};
 249         return $parsed;
 250     }
 251 }
 252
 253 =head2 $ae->extract( [to => '/output/path'] )
 254
 255 Extracts the archive represented by the C<Archive::Extract> object to
 256 the path of your choice as specified by the C<to> argument. Defaults to
 257 C<cwd()>.
 258
 259 Since C<.gz> files never hold a directory, but only a single file; if
 260 the C<to> argument is an existing directory, the file is extracted
 261 there, with its C<.gz> suffix stripped.
 262 If the C<to> argument is not an existing directory, the C<to> argument
 263 is understood to be a filename, if the archive type is C<gz>.
 264 In the case that you did not specify a C<to> argument, the output
 265 file will be the name of the archive file, stripped from its C<.gz>
 266 suffix, in the current working directory.
 267
 268 C<extract> will try a pure perl solution first, and then fall back to
 269 commandline tools if they are available. See the C<GLOBAL VARIABLES>
 270 section below on how to alter this behaviour.
 271
 272 It will return true on success, and false on failure.
 273
 274 On success, it will also set the follow attributes in the object:
 275
 276 =over 4
 277
 278 =item $ae->extract_path
 279
 280 This is the directory that the files where extracted to.
 281
 282 =item $ae->files
 283
 284 This is an array ref with the paths of all the files in the archive,
 285 relative to the C<to> argument you specified.
 286 To get the full path to an extracted file, you would use:
 287
 288     File::Spec->catfile( $to, $ae->files->[0] );
 289
 290 Note that all files from a tar archive will be in unix format, as per
 291 the tar specification.
 292
 293 =back
 294
 295 =cut
 296
 297 sub extract {
 298     my $self = shift;
 299     my %hash = @_;
 300
 301     ### reset error messages
 302     $self->_error_msg( [] );
 303     $self->_error_msg_long( [] );
 304
 305     my $to;
 306     my $tmpl = {
 307         to  => { default => '.', store => \$to }
 308     };
 309
 310     check( $tmpl, \%hash ) or return;
 311
 312     ### so 'to' could be a file or a dir, depending on whether it's a .gz
 313     ### file, or basically anything else.
 314     ### so, check that, then act accordingly.
 315     ### set an accessor specifically so _gunzip can know what file to extract
 316     ### to.
 317     my $dir;
 318     {   ### a foo.gz file
 319         if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma ) {
 320
 321             my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma)$//i;
 322
 323             ### to is a dir?
 324             if ( -d $to ) {
 325                 $dir = $to;
 326                 $self->_gunzip_to( basename($cp) );
 327
 328             ### then it's a filename
 329             } else {
 330                 $dir = dirname($to);
 331                 $self->_gunzip_to( basename($to) );
 332             }
 333
 334         ### not a foo.gz file
 335         } else {
 336             $dir = $to;
 337         }
 338     }
 339
 340     ### make the dir if it doesn't exist ###
 341     unless( -d $dir ) {
 342         eval { mkpath( $dir ) };
 343
 344         return $self->_error(loc("Could not create path '%1': %2", $dir, $@))
 345             if $@;
 346     }
 347
 348     ### get the current dir, to restore later ###
 349     my $cwd = cwd();
 350
 351     my $ok = 1;
 352     EXTRACT: {
 353
 354         ### chdir to the target dir ###
 355         unless( chdir $dir ) {
 356             $self->_error(loc("Could not chdir to '%1': %2", $dir, $!));
 357             $ok = 0; last EXTRACT;
 358         }
 359
 360         ### set files to an empty array ref, so there's always an array
 361         ### ref IN the accessor, to avoid errors like:
 362         ### Can't use an undefined value as an ARRAY reference at
 363         ### ../lib/Archive/Extract.pm line 742. (rt #19815)
 364         $self->files( [] );
 365
 366         ### find out the dispatch methods needed for this type of
 367         ### archive. Do a $self->is_XXX to figure out the type, then
 368         ### get the hashref with bin + pure perl dispatchers.
 369         my ($map) = map { $Mapping->{$_} } grep { $self->$_ } keys %$Mapping;
 370
 371         ### add pure perl extractor if allowed & add bin extractor if allowed
 372         my @methods;
 373         push @methods, $map->{'pp'}  if $_ALLOW_PURE_PERL;
 374         push @methods, $map->{'bin'} if $_ALLOW_BIN;
 375
 376         ### reverse it if we prefer bin extractors
 377         @methods = reverse @methods if $PREFER_BIN;
 378
 379         my($na, $fail);
 380         for my $method (@methods) {
 381             print "# Extracting with ->$method\n" if $DEBUG;
 382
 383             my $rv = $self->$method;
 384
 385             ### a positive extraction
 386             if( $rv and $rv ne METHOD_NA ) {
 387                 print "# Extraction succeeded\n" if $DEBUG;
 388                 $self->_extractor($method);
 389                 last;
 390
 391             ### method is not available
 392             } elsif ( $rv and $rv eq METHOD_NA ) {
 393                 print "# Extraction method not available\n" if $DEBUG;
 394                 $na++;
 395             } else {
 396                 print "# Extraction method failed\n" if $DEBUG;
 397                 $fail++;
 398             }
 399         }
 400
 401         ### warn something went wrong if we didn't get an extractor
 402         unless( $self->_extractor ) {
 403             my $diag = $fail ? loc("Extract failed due to errors") :
 404                        $na   ? loc("Extract failed; no extractors available") :
 405                        '';
 406
 407             $self->_error($diag);
 408             $ok = 0;
 409         }
 410     }
 411
 412     ### and chdir back ###
 413     unless( chdir $cwd ) {
 414         $self->_error(loc("Could not chdir back to start dir '%1': %2'",
 415                             $cwd, $!));
 416     }
 417
 418     return $ok;
 419 }
 420
 421 =pod
 422
 423 =head1 ACCESSORS
 424
 425 =head2 $ae->error([BOOL])
 426
 427 Returns the last encountered error as string.
 428 Pass it a true value to get the C<Carp::longmess()> output instead.
 429
 430 =head2 $ae->extract_path
 431
 432 This is the directory the archive got extracted to.
 433 See C<extract()> for details.
 434
 435 =head2 $ae->files
 436
 437 This is an array ref holding all the paths from the archive.
 438 See C<extract()> for details.
 439
 440 =head2 $ae->archive
 441
 442 This is the full path to the archive file represented by this
 443 C<Archive::Extract> object.
 444
 445 =head2 $ae->type
 446
 447 This is the type of archive represented by this C<Archive::Extract>
 448 object. See accessors below for an easier way to use this.
 449 See the C<new()> method for details.
 450
 451 =head2 $ae->types
 452
 453 Returns a list of all known C<types> for C<Archive::Extract>'s
 454 C<new> method.
 455
 456 =cut
 457
 458 sub types { return @Types }
 459
 460 =head2 $ae->is_tgz
 461
 462 Returns true if the file is of type C<.tar.gz>.
 463 See the C<new()> method for details.
 464
 465 =head2 $ae->is_tar
 466
 467 Returns true if the file is of type C<.tar>.
 468 See the C<new()> method for details.
 469
 470 =head2 $ae->is_gz
 471
 472 Returns true if the file is of type C<.gz>.
 473 See the C<new()> method for details.
 474
 475 =head2 $ae->is_Z
 476
 477 Returns true if the file is of type C<.Z>.
 478 See the C<new()> method for details.
 479
 480 =head2 $ae->is_zip
 481
 482 Returns true if the file is of type C<.zip>.
 483 See the C<new()> method for details.
 484
 485 =head2 $ae->is_lzma
 486
 487 Returns true if the file is of type C<.lzma>.
 488 See the C<new()> method for details.
 489
 490 =cut
 491
 492 ### quick check methods ###
 493 sub is_tgz  { return $_[0]->type eq TGZ }
 494 sub is_tar  { return $_[0]->type eq TAR }
 495 sub is_gz   { return $_[0]->type eq GZ  }
 496 sub is_zip  { return $_[0]->type eq ZIP }
 497 sub is_tbz  { return $_[0]->type eq TBZ }
 498 sub is_bz2  { return $_[0]->type eq BZ2 }
 499 sub is_Z    { return $_[0]->type eq Z   }
 500 sub is_lzma { return $_[0]->type eq LZMA }
 501
 502 =pod
 503
 504 =head2 $ae->bin_tar
 505
 506 Returns the full path to your tar binary, if found.
 507
 508 =head2 $ae->bin_gzip
 509
 510 Returns the full path to your gzip binary, if found
 511
 512 =head2 $ae->bin_unzip
 513
 514 Returns the full path to your unzip binary, if found
 515
 516 =head2 $ae->bin_unlzma
 517
 518 Returns the full path to your unlzma binary, if found
 519
 520 =cut
 521
 522 ### paths to commandline tools ###
 523 sub bin_gzip        { return $PROGRAMS->{'gzip'}    if $PROGRAMS->{'gzip'}  }
 524 sub bin_unzip       { return $PROGRAMS->{'unzip'}   if $PROGRAMS->{'unzip'} }
 525 sub bin_tar         { return $PROGRAMS->{'tar'}     if $PROGRAMS->{'tar'}   }
 526 sub bin_bunzip2     { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
 527 sub bin_uncompress  { return $PROGRAMS->{'uncompress'}
 528                                                  if $PROGRAMS->{'uncompress'} }
 529 sub bin_unlzma      { return $PROGRAMS->{'unlzma'}  if $PROGRAMS->{'unlzma'} }
 530
 531 =head2 $bool = $ae->have_old_bunzip2
 532
 533 Older versions of C</bin/bunzip2>, from before the C<bunzip2 1.0> release,
 534 require all archive names to end in C<.bz2> or it will not extract
 535 them. This method checks if you have a recent version of C<bunzip2>
 536 that allows any extension, or an older one that doesn't.
 537
 538 =cut
 539
 540 sub have_old_bunzip2 {
 541     my $self = shift;
 542
 543     ### no bunzip2? no old bunzip2 either :)
 544     return unless $self->bin_bunzip2;
 545
 546     ### if we can't run this, we can't be sure if it's too old or not
 547     ### XXX stupid stupid stupid bunzip2 doesn't understand --version
 548     ### is not a request to extract data:
 549     ### $ bunzip2 --version
 550     ### bzip2, a block-sorting file compressor.  Version 1.0.2, 30-Dec-2001.
 551     ### [...]
 552     ### bunzip2: I won't read compressed data from a terminal.
 553     ### bunzip2: For help, type: `bunzip2 --help'.
 554     ### $ echo $?
 555     ### 1
 556     ### HATEFUL!
 557
 558     ### double hateful: bunzip2 --version also hangs if input is a pipe
 559     ### See #32370: Archive::Extract will hang if stdin is a pipe [+PATCH]
 560     ### So, we have to provide *another* argument which is a fake filename,
 561     ### just so it wont try to read from stdin to print its version..
 562     ### *sigh*
 563     ### Even if the file exists, it won't clobber or change it.
 564     my $buffer;
 565     scalar run(
 566          command => [$self->bin_bunzip2, '--version', 'NoSuchFile'],
 567          verbose => 0,
 568          buffer  => \$buffer
 569     );
 570
 571     ### no output
 572     return unless $buffer;
 573
 574     my ($version) = $buffer =~ /version \s+ (\d+)/ix;
 575
 576     return 1 if $version < 1;
 577     return;
 578 }
 579
 580 #################################
 581 #
 582 # Untar code
 583 #
 584 #################################
 585
 586
 587 ### use /bin/tar to extract ###
 588 sub _untar_bin {
 589     my $self = shift;
 590
 591     ### check for /bin/tar ###
 592     ### check for /bin/gzip if we need it ###
 593     ### if any of the binaries are not available, return NA
 594     {   my $diag =  not $self->bin_tar ?
 595                         loc("No '%1' program found", '/bin/tar') :
 596                     $self->is_tgz && !$self->bin_gzip ?
 597                         loc("No '%1' program found", '/bin/gzip') :
 598                     $self->is_tbz && !$self->bin_bunzip2 ?
 599                         loc("No '%1' program found", '/bin/bunzip2') :
 600                     '';
 601
 602         if( $diag ) {
 603             $self->_error( $diag );
 604             return METHOD_NA;
 605         }
 606     }
 607
 608     ### XXX figure out how to make IPC::Run do this in one call --
 609     ### currently i don't know how to get output of a command after a pipe
 610     ### trapped in a scalar. Mailed barries about this 5th of june 2004.
 611
 612     ### see what command we should run, based on whether
 613     ### it's a .tgz or .tar
 614
 615     ### XXX solaris tar and bsdtar are having different outputs
 616     ### depending whether you run with -x or -t
 617     ### compensate for this insanity by running -t first, then -x
 618     {    my $cmd =
 619             $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
 620                              $self->bin_tar, '-tf', '-'] :
 621             $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',
 622                              $self->bin_tar, '-tf', '-'] :
 623             [$self->bin_tar, '-tf', $self->archive];
 624
 625         ### run the command ###
 626         my $buffer = '';
 627         unless( scalar run( command => $cmd,
 628                             buffer  => \$buffer,
 629                             verbose => $DEBUG )
 630         ) {
 631             return $self->_error(loc(
 632                             "Error listing contents of archive '%1': %2",
 633                             $self->archive, $buffer ));
 634         }
 635
 636         ### no buffers available?
 637         if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
 638             $self->_error( $self->_no_buffer_files( $self->archive ) );
 639
 640         } else {
 641             ### if we're on solaris we /might/ be using /bin/tar, which has
 642             ### a weird output format... we might also be using
 643             ### /usr/local/bin/tar, which is gnu tar, which is perfectly
 644             ### fine... so we have to do some guessing here =/
 645             my @files = map { chomp;
 646                           !ON_SOLARIS ? $_
 647                                       : (m|^ x \s+  # 'xtract' -- sigh
 648                                             (.+?),  # the actual file name
 649                                             \s+ [\d,.]+ \s bytes,
 650                                             \s+ [\d,.]+ \s tape \s blocks
 651                                         |x ? $1 : $_);
 652
 653                     } split $/, $buffer;
 654
 655             ### store the files that are in the archive ###
 656             $self->files(\@files);
 657         }
 658     }
 659
 660     ### now actually extract it ###
 661     {   my $cmd =
 662             $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
 663                              $self->bin_tar, '-xf', '-'] :
 664             $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',
 665                              $self->bin_tar, '-xf', '-'] :
 666             [$self->bin_tar, '-xf', $self->archive];
 667
 668         my $buffer = '';
 669         unless( scalar run( command => $cmd,
 670                             buffer  => \$buffer,
 671                             verbose => $DEBUG )
 672         ) {
 673             return $self->_error(loc("Error extracting archive '%1': %2",
 674                             $self->archive, $buffer ));
 675         }
 676
 677         ### we might not have them, due to lack of buffers
 678         if( $self->files ) {
 679             ### now that we've extracted, figure out where we extracted to
 680             my $dir = $self->__get_extract_dir( $self->files );
 681
 682             ### store the extraction dir ###
 683             $self->extract_path( $dir );
 684         }
 685     }
 686
 687     ### we got here, no error happened
 688     return 1;
 689 }
 690
 691 ### use archive::tar to extract ###
 692 sub _untar_at {
 693     my $self = shift;
 694
 695     ### Loading Archive::Tar is going to set it to 1, so make it local
 696     ### within this block, starting with its initial value. Whatever
 697     ### Achive::Tar does will be undone when we return.
 698     ###
 699     ### Also, later, set $Archive::Tar::WARN to $Archive::Extract::WARN
 700     ### so users don't have to even think about this variable. If they
 701     ### do, they still get their set value outside of this call.
 702     local $Archive::Tar::WARN = $Archive::Tar::WARN;
 703
 704     ### we definitely need Archive::Tar, so load that first
 705     {   my $use_list = { 'Archive::Tar' => '0.0' };
 706
 707         unless( can_load( modules => $use_list ) ) {
 708
 709             $self->_error(loc("You do not have '%1' installed - " .
 710                               "Please install it as soon as possible.",
 711                               'Archive::Tar'));
 712
 713             return METHOD_NA;
 714         }
 715     }
 716
 717     ### we might pass it a filehandle if it's a .tbz file..
 718     my $fh_to_read = $self->archive;
 719
 720     ### we will need Compress::Zlib too, if it's a tgz... and IO::Zlib
 721     ### if A::T's version is 0.99 or higher
 722     if( $self->is_tgz ) {
 723         my $use_list = { 'Compress::Zlib' => '0.0' };
 724            $use_list->{ 'IO::Zlib' } = '0.0'
 725                 if $Archive::Tar::VERSION >= '0.99';
 726
 727         unless( can_load( modules => $use_list ) ) {
 728             my $which = join '/', sort keys %$use_list;
 729
 730             $self->_error(loc(
 731                 "You do not have '%1' installed - Please ".
 732                 "install it as soon as possible.", $which)
 733             );
 734
 735             return METHOD_NA;
 736         }
 737
 738     } elsif ( $self->is_tbz ) {
 739         my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
 740         unless( can_load( modules => $use_list ) ) {
 741             $self->_error(loc(
 742                 "You do not have '%1' installed - Please " .
 743                 "install it as soon as possible.",
 744                 'IO::Uncompress::Bunzip2')
 745             );
 746
 747             return METHOD_NA;
 748         }
 749
 750         my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
 751             return $self->_error(loc("Unable to open '%1': %2",
 752                             $self->archive,
 753                             $IO::Uncompress::Bunzip2::Bunzip2Error));
 754
 755         $fh_to_read = $bz;
 756     }
 757
 758     ### $Archive::Tar::WARN is 1 by default in Archive::Tar, but we've
 759     ### localized $Archive::Tar::WARN already.
 760     $Archive::Tar::WARN = $Archive::Extract::WARN;
 761
 762     my $tar = Archive::Tar->new();
 763
 764     ### only tell it it's compressed if it's a .tgz, as we give it a file
 765     ### handle if it's a .tbz
 766     unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) {
 767         return $self->_error(loc("Unable to read '%1': %2", $self->archive,
 768                                     $Archive::Tar::error));
 769     }
 770
 771     ### workaround to prevent Archive::Tar from setting uid, which
 772     ### is a potential security hole. -autrijus
 773     ### have to do it here, since A::T needs to be /loaded/ first ###
 774     {   no strict 'refs'; local $^W;
 775
 776         ### older versions of archive::tar <= 0.23
 777         *Archive::Tar::chown = sub {};
 778     }
 779
 780     ### for version of Archive::Tar > 1.04
 781     local $Archive::Tar::CHOWN = 0;
 782
 783     {   local $^W;  # quell 'splice() offset past end of array' warnings
 784                     # on older versions of A::T
 785
 786         ### older archive::tar always returns $self, return value slightly
 787         ### fux0r3d because of it.
 788         $tar->extract()
 789             or return $self->_error(loc("Unable to extract '%1': %2",
 790                                     $self->archive, $Archive::Tar::error ));
 791     }
 792
 793     my @files   = $tar->list_files;
 794     my $dir     = $self->__get_extract_dir( \@files );
 795
 796     ### store the files that are in the archive ###
 797     $self->files(\@files);
 798
 799     ### store the extraction dir ###
 800     $self->extract_path( $dir );
 801
 802     ### check if the dir actually appeared ###
 803     return 1 if -d $self->extract_path;
 804
 805     ### no dir, we failed ###
 806     return $self->_error(loc("Unable to extract '%1': %2",
 807                                 $self->archive, $Archive::Tar::error ));
 808 }
 809
 810 #################################
 811 #
 812 # Gunzip code
 813 #
 814 #################################
 815
 816 sub _gunzip_bin {
 817     my $self = shift;
 818
 819     ### check for /bin/gzip -- we need it ###
 820     unless( $self->bin_gzip ) {
 821         $self->_error(loc("No '%1' program found", '/bin/gzip'));
 822         return METHOD_NA;
 823     }
 824
 825     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
 826         return $self->_error(loc("Could not open '%1' for writing: %2",
 827                             $self->_gunzip_to, $! ));
 828
 829     my $cmd = [ $self->bin_gzip, '-cdf', $self->archive ];
 830
 831     my $buffer;
 832     unless( scalar run( command => $cmd,
 833                         verbose => $DEBUG,
 834                         buffer  => \$buffer )
 835     ) {
 836         return $self->_error(loc("Unable to gunzip '%1': %2",
 837                                     $self->archive, $buffer));
 838     }
 839
 840     ### no buffers available?
 841     if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
 842         $self->_error( $self->_no_buffer_content( $self->archive ) );
 843     }
 844
 845     print $fh $buffer if defined $buffer;
 846
 847     close $fh;
 848
 849     ### set what files where extract, and where they went ###
 850     $self->files( [$self->_gunzip_to] );
 851     $self->extract_path( File::Spec->rel2abs(cwd()) );
 852
 853     return 1;
 854 }
 855
 856 sub _gunzip_cz {
 857     my $self = shift;
 858
 859     my $use_list = { 'Compress::Zlib' => '0.0' };
 860     unless( can_load( modules => $use_list ) ) {
 861         $self->_error(loc("You do not have '%1' installed - Please " .
 862                     "install it as soon as possible.", 'Compress::Zlib'));
 863         return METHOD_NA;
 864     }
 865
 866     my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or
 867                 return $self->_error(loc("Unable to open '%1': %2",
 868                             $self->archive, $Compress::Zlib::gzerrno));
 869
 870     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
 871         return $self->_error(loc("Could not open '%1' for writing: %2",
 872                             $self->_gunzip_to, $! ));
 873
 874     my $buffer;
 875     $fh->print($buffer) while $gz->gzread($buffer) > 0;
 876     $fh->close;
 877
 878     ### set what files where extract, and where they went ###
 879     $self->files( [$self->_gunzip_to] );
 880     $self->extract_path( File::Spec->rel2abs(cwd()) );
 881
 882     return 1;
 883 }
 884
 885 #################################
 886 #
 887 # Uncompress code
 888 #
 889 #################################
 890
 891 sub _uncompress_bin {
 892     my $self = shift;
 893
 894     ### check for /bin/gzip -- we need it ###
 895     unless( $self->bin_uncompress ) {
 896         $self->_error(loc("No '%1' program found", '/bin/uncompress'));
 897         return METHOD_NA;
 898     }
 899
 900     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
 901         return $self->_error(loc("Could not open '%1' for writing: %2",
 902                             $self->_gunzip_to, $! ));
 903
 904     my $cmd = [ $self->bin_uncompress, '-c', $self->archive ];
 905
 906     my $buffer;
 907     unless( scalar run( command => $cmd,
 908                         verbose => $DEBUG,
 909                         buffer  => \$buffer )
 910     ) {
 911         return $self->_error(loc("Unable to uncompress '%1': %2",
 912                                     $self->archive, $buffer));
 913     }
 914
 915     ### no buffers available?
 916     if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
 917         $self->_error( $self->_no_buffer_content( $self->archive ) );
 918     }
 919
 920     print $fh $buffer if defined $buffer;
 921
 922     close $fh;
 923
 924     ### set what files where extract, and where they went ###
 925     $self->files( [$self->_gunzip_to] );
 926     $self->extract_path( File::Spec->rel2abs(cwd()) );
 927
 928     return 1;
 929 }
 930
 931
 932 #################################
 933 #
 934 # Unzip code
 935 #
 936 #################################
 937
 938
 939 sub _unzip_bin {
 940     my $self = shift;
 941
 942     ### check for /bin/gzip if we need it ###
 943     unless( $self->bin_unzip ) {
 944         $self->_error(loc("No '%1' program found", '/bin/unzip'));
 945         return METHOD_NA;
 946     }
 947
 948     ### first, get the files.. it must be 2 different commands with 'unzip' :(
 949     {   ### on VMS, capital letter options have to be quoted. This is
 950         ### peported by John Malmberg on P5P Tue 21 Aug 2007 05:05:11
 951         ### Subject: [patch@31735]Archive Extract fix on VMS.
 952         my $opt = ON_VMS ? '"-Z"' : '-Z';
 953         my $cmd = [ $self->bin_unzip, $opt, '-1', $self->archive ];
 954
 955         my $buffer = '';
 956         unless( scalar run( command => $cmd,
 957                             verbose => $DEBUG,
 958                             buffer  => \$buffer )
 959         ) {
 960             return $self->_error(loc("Unable to unzip '%1': %2",
 961                                         $self->archive, $buffer));
 962         }
 963
 964         ### no buffers available?
 965         if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
 966             $self->_error( $self->_no_buffer_files( $self->archive ) );
 967
 968         } else {
 969             $self->files( [split $/, $buffer] );
 970         }
 971     }
 972
 973     ### now, extract the archive ###
 974     {   my $cmd = [ $self->bin_unzip, '-qq', '-o', $self->archive ];
 975
 976         my $buffer;
 977         unless( scalar run( command => $cmd,
 978                             verbose => $DEBUG,
 979                             buffer  => \$buffer )
 980         ) {
 981             return $self->_error(loc("Unable to unzip '%1': %2",
 982                                         $self->archive, $buffer));
 983         }
 984
 985         if( scalar @{$self->files} ) {
 986             my $files   = $self->files;
 987             my $dir     = $self->__get_extract_dir( $files );
 988
 989             $self->extract_path( $dir );
 990         }
 991     }
 992
 993     return 1;
 994 }
 995
 996 sub _unzip_az {
 997     my $self = shift;
 998
 999     my $use_list = { 'Archive::Zip' => '0.0' };
1000     unless( can_load( modules => $use_list ) ) {
1001         $self->_error(loc("You do not have '%1' installed - Please " .
1002                       "install it as soon as possible.", 'Archive::Zip'));
1003         return METHOD_NA;
1004     }
1005
1006     my $zip = Archive::Zip->new();
1007
1008     unless( $zip->read( $self->archive ) == &Archive::Zip::AZ_OK ) {
1009         return $self->_error(loc("Unable to read '%1'", $self->archive));
1010     }
1011
1012     my @files;
1013     ### have to extract every memeber individually ###
1014     for my $member ($zip->members) {
1015         push @files, $member->{fileName};
1016
1017         unless( $zip->extractMember($member) == &Archive::Zip::AZ_OK ) {
1018             return $self->_error(loc("Extraction of '%1' from '%2' failed",
1019                         $member->{fileName}, $self->archive ));
1020         }
1021     }
1022
1023     my $dir = $self->__get_extract_dir( \@files );
1024
1025     ### set what files where extract, and where they went ###
1026     $self->files( \@files );
1027     $self->extract_path( File::Spec->rel2abs($dir) );
1028
1029     return 1;
1030 }
1031
1032 sub __get_extract_dir {
1033     my $self    = shift;
1034     my $files   = shift || [];
1035
1036     return unless scalar @$files;
1037
1038     my($dir1, $dir2);
1039     for my $aref ( [ \$dir1, 0 ], [ \$dir2, -1 ] ) {
1040         my($dir,$pos) = @$aref;
1041
1042         ### add a catdir(), so that any trailing slashes get
1043         ### take care of (removed)
1044         ### also, a catdir() normalises './dir/foo' to 'dir/foo';
1045         ### which was the problem in bug #23999
1046         my $res = -d $files->[$pos]
1047                     ? File::Spec->catdir( $files->[$pos], '' )
1048                     : File::Spec->catdir( dirname( $files->[$pos] ) );
1049
1050         $$dir = $res;
1051     }
1052
1053     ### if the first and last dir don't match, make sure the
1054     ### dirname is not set wrongly
1055     my $dir;
1056
1057     ### dirs are the same, so we know for sure what the extract dir is
1058     if( $dir1 eq $dir2 ) {
1059         $dir = $dir1;
1060
1061     ### dirs are different.. do they share the base dir?
1062     ### if so, use that, if not, fall back to '.'
1063     } else {
1064         my $base1 = [ File::Spec->splitdir( $dir1 ) ]->[0];
1065         my $base2 = [ File::Spec->splitdir( $dir2 ) ]->[0];
1066
1067         $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' );
1068     }
1069
1070     return File::Spec->rel2abs( $dir );
1071 }
1072
1073 #################################
1074 #
1075 # Bunzip2 code
1076 #
1077 #################################
1078
1079 sub _bunzip2_bin {
1080     my $self = shift;
1081
1082     ### check for /bin/gzip -- we need it ###
1083     unless( $self->bin_bunzip2 ) {
1084         $self->_error(loc("No '%1' program found", '/bin/bunzip2'));
1085         return METHOD_NA;
1086     }
1087
1088     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
1089         return $self->_error(loc("Could not open '%1' for writing: %2",
1090                             $self->_gunzip_to, $! ));
1091
1092     ### guard against broken bunzip2. See ->have_old_bunzip2()
1093     ### for details
1094     if( $self->have_old_bunzip2 and $self->archive !~ /\.bz2$/i ) {
1095         return $self->_error(loc("Your bunzip2 version is too old and ".
1096                                  "can only extract files ending in '%1'",
1097                                  '.bz2'));
1098     }
1099
1100     my $cmd = [ $self->bin_bunzip2, '-cd', $self->archive ];
1101
1102     my $buffer;
1103     unless( scalar run( command => $cmd,
1104                         verbose => $DEBUG,
1105                         buffer  => \$buffer )
1106     ) {
1107         return $self->_error(loc("Unable to bunzip2 '%1': %2",
1108                                     $self->archive, $buffer));
1109     }
1110
1111     ### no buffers available?
1112     if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
1113         $self->_error( $self->_no_buffer_content( $self->archive ) );
1114     }
1115
1116     print $fh $buffer if defined $buffer;
1117
1118     close $fh;
1119
1120     ### set what files where extract, and where they went ###
1121     $self->files( [$self->_gunzip_to] );
1122     $self->extract_path( File::Spec->rel2abs(cwd()) );
1123
1124     return 1;
1125 }
1126
1127 ### using cz2, the compact versions... this we use mainly in archive::tar
1128 ### extractor..
1129 # sub _bunzip2_cz1 {
1130 #     my $self = shift;
1131 #
1132 #     my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
1133 #     unless( can_load( modules => $use_list ) ) {
1134 #         return $self->_error(loc("You do not have '%1' installed - Please " .
1135 #                         "install it as soon as possible.",
1136 #                         'IO::Uncompress::Bunzip2'));
1137 #     }
1138 #
1139 #     my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
1140 #                 return $self->_error(loc("Unable to open '%1': %2",
1141 #                             $self->archive,
1142 #                             $IO::Uncompress::Bunzip2::Bunzip2Error));
1143 #
1144 #     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
1145 #         return $self->_error(loc("Could not open '%1' for writing: %2",
1146 #                             $self->_gunzip_to, $! ));
1147 #
1148 #     my $buffer;
1149 #     $fh->print($buffer) while $bz->read($buffer) > 0;
1150 #     $fh->close;
1151 #
1152 #     ### set what files where extract, and where they went ###
1153 #     $self->files( [$self->_gunzip_to] );
1154 #     $self->extract_path( File::Spec->rel2abs(cwd()) );
1155 #
1156 #     return 1;
1157 # }
1158
1159 sub _bunzip2_bz2 {
1160     my $self = shift;
1161
1162     my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
1163     unless( can_load( modules => $use_list ) ) {
1164         $self->_error(loc("You do not have '%1' installed - Please " .
1165                           "install it as soon as possible.",
1166                           'IO::Uncompress::Bunzip2'));
1167         return METHOD_NA;
1168     }
1169
1170     IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to)
1171         or return $self->_error(loc("Unable to uncompress '%1': %2",
1172                             $self->archive,
1173                             $IO::Uncompress::Bunzip2::Bunzip2Error));
1174
1175     ### set what files where extract, and where they went ###
1176     $self->files( [$self->_gunzip_to] );
1177     $self->extract_path( File::Spec->rel2abs(cwd()) );
1178
1179     return 1;
1180 }
1181
1182
1183 #################################
1184 #
1185 # unlzma code
1186 #
1187 #################################
1188
1189 sub _unlzma_bin {
1190     my $self = shift;
1191
1192     ### check for /bin/unlzma -- we need it ###
1193     unless( $self->bin_unlzma ) {
1194         $self->_error(loc("No '%1' program found", '/bin/unlzma'));
1195         return METHOD_NA;
1196     }
1197
1198     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
1199         return $self->_error(loc("Could not open '%1' for writing: %2",
1200                             $self->_gunzip_to, $! ));
1201
1202     my $cmd = [ $self->bin_unlzma, '-c', $self->archive ];
1203
1204     my $buffer;
1205     unless( scalar run( command => $cmd,
1206                         verbose => $DEBUG,
1207                         buffer  => \$buffer )
1208     ) {
1209         return $self->_error(loc("Unable to unlzma '%1': %2",
1210                                     $self->archive, $buffer));
1211     }
1212
1213     ### no buffers available?
1214     if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
1215         $self->_error( $self->_no_buffer_content( $self->archive ) );
1216     }
1217
1218     print $fh $buffer if defined $buffer;
1219
1220     close $fh;
1221
1222     ### set what files where extract, and where they went ###
1223     $self->files( [$self->_gunzip_to] );
1224     $self->extract_path( File::Spec->rel2abs(cwd()) );
1225
1226     return 1;
1227 }
1228
1229 sub _unlzma_cz {
1230     my $self = shift;
1231
1232     my $use_list = { 'Compress::unLZMA' => '0.0' };
1233     unless( can_load( modules => $use_list ) ) {
1234         $self->_error(loc("You do not have '%1' installed - Please " .
1235                     "install it as soon as possible.", 'Compress::unLZMA'));
1236         return METHOD_NA;
1237     }
1238
1239     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
1240         return $self->_error(loc("Could not open '%1' for writing: %2",
1241                             $self->_gunzip_to, $! ));
1242
1243     my $buffer;
1244     $buffer = Compress::unLZMA::uncompressfile( $self->archive );
1245     unless ( defined $buffer ) {
1246         return $self->_error(loc("Could not unlzma '%1': %2",
1247                                     $self->archive, $@));
1248     }
1249
1250     print $fh $buffer if defined $buffer;
1251
1252     close $fh;
1253
1254     ### set what files where extract, and where they went ###
1255     $self->files( [$self->_gunzip_to] );
1256     $self->extract_path( File::Spec->rel2abs(cwd()) );
1257
1258     return 1;
1259 }
1260
1261 #################################
1262 #
1263 # Error code
1264 #
1265 #################################
1266
1267 sub _error {
1268     my $self    = shift;
1269     my $error   = shift;
1270     my $lerror  = Carp::longmess($error);
1271
1272     push @{$self->_error_msg},      $error;
1273     push @{$self->_error_msg_long}, $lerror;
1274
1275     ### set $Archive::Extract::WARN to 0 to disable printing
1276     ### of errors
1277     if( $WARN ) {
1278         carp $DEBUG ? $lerror : $error;
1279     }
1280
1281     return;
1282 }
1283
1284 sub error {
1285     my $self = shift;
1286
1287     ### make sure we have a fallback aref
1288     my $aref = do {
1289         shift()
1290             ? $self->_error_msg_long
1291             : $self->_error_msg
1292     } || [];
1293
1294     return join $/, @$aref;
1295 }
1296
1297 sub _no_buffer_files {
1298     my $self = shift;
1299     my $file = shift or return;
1300     return loc("No buffer captured, unable to tell ".
1301                "extracted files or extraction dir for '%1'", $file);
1302 }
1303
1304 sub _no_buffer_content {
1305     my $self = shift;
1306     my $file = shift or return;
1307     return loc("No buffer captured, unable to get content for '%1'", $file);
1308 }
1309 1;
1310
1311 =pod
1312
1313 =head1 HOW IT WORKS
1314
1315 C<Archive::Extract> tries first to determine what type of archive you
1316 are passing it, by inspecting its suffix. It does not do this by using
1317 Mime magic, or something related. See C<CAVEATS> below.
1318
1319 Once it has determined the file type, it knows which extraction methods
1320 it can use on the archive. It will try a perl solution first, then fall
1321 back to a commandline tool if that fails. If that also fails, it will
1322 return false, indicating it was unable to extract the archive.
1323 See the section on C<GLOBAL VARIABLES> to see how to alter this order.
1324
1325 =head1 CAVEATS
1326
1327 =head2 File Extensions
1328
1329 C<Archive::Extract> trusts on the extension of the archive to determine
1330 what type it is, and what extractor methods therefore can be used. If
1331 your archives do not have any of the extensions as described in the
1332 C<new()> method, you will have to specify the type explicitly, or
1333 C<Archive::Extract> will not be able to extract the archive for you.
1334
1335 =head2 Supporting Very Large Files
1336
1337 C<Archive::Extract> can use either pure perl modules or command line
1338 programs under the hood. Some of the pure perl modules (like
1339 C<Archive::Tar> and Compress::unLZMA) take the entire contents of the archive into memory,
1340 which may not be feasible on your system. Consider setting the global
1341 variable C<$Archive::Extract::PREFER_BIN> to C<1>, which will prefer
1342 the use of command line programs and won't consume so much memory.
1343
1344 See the C<GLOBAL VARIABLES> section below for details.
1345
1346 =head2 Bunzip2 support of arbitrary extensions.
1347
1348 Older versions of C</bin/bunzip2> do not support arbitrary file
1349 extensions and insist on a C<.bz2> suffix. Although we do our best
1350 to guard against this, if you experience a bunzip2 error, it may
1351 be related to this. For details, please see the C<have_old_bunzip2>
1352 method.
1353
1354 =head1 GLOBAL VARIABLES
1355
1356 =head2 $Archive::Extract::DEBUG
1357
1358 Set this variable to C<true> to have all calls to command line tools
1359 be printed out, including all their output.
1360 This also enables C<Carp::longmess> errors, instead of the regular
1361 C<carp> errors.
1362
1363 Good for tracking down why things don't work with your particular
1364 setup.
1365
1366 Defaults to C<false>.
1367
1368 =head2 $Archive::Extract::WARN
1369
1370 This variable controls whether errors encountered internally by
1371 C<Archive::Extract> should be C<carp>'d or not.
1372
1373 Set to false to silence warnings. Inspect the output of the C<error()>
1374 method manually to see what went wrong.
1375
1376 Defaults to C<true>.
1377
1378 =head2 $Archive::Extract::PREFER_BIN
1379
1380 This variables controls whether C<Archive::Extract> should prefer the
1381 use of perl modules, or commandline tools to extract archives.
1382
1383 Set to C<true> to have C<Archive::Extract> prefer commandline tools.
1384
1385 Defaults to C<false>.
1386
1387 =head1 TODO
1388
1389 =over 4
1390
1391 =item Mime magic support
1392
1393 Maybe this module should use something like C<File::Type> to determine
1394 the type, rather than blindly trust the suffix.
1395
1396 =back
1397
1398 =head1 BUG REPORTS
1399
1400 Please report bugs or other issues to E<lt>bug-archive-extract@rt.cpan.org<gt>.
1401
1402 =head1 AUTHOR
1403
1404 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1405
1406 =head1 COPYRIGHT
1407
1408 This library is free software; you may redistribute and/or modify it
1409 under the same terms as Perl itself.
1410
1411 =cut
1412
1413 # Local variables:
1414 # c-indentation-style: bsd
1415 # c-basic-offset: 4
1416 # indent-tabs-mode: nil
1417 # End:
1418 # vim: expandtab shiftwidth=4:
1419