From: Jos I. Boumans <kane@dwim.org>
Date: Sat, 13 Dec 2008 17:36:13 +0000 (+0100)
Subject: Update Archive::Extract to 0.28
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=83285295780b6718141d6f5bf054a2e6da464e39;p=p5sagit%2Fp5-mst-13.2.git

Update Archive::Extract to 0.28
From: "Jos I. Boumans" <jos@dwim.org>
Message-Id: <A6FBAEE4-A1F3-41BE-A051-ABF03540E9F1@dwim.org>

p4raw-id: //depot/perl@35105
---

diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index d0cba4e..c7486bd 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -20,6 +20,10 @@ use constant FILE_EXISTS    => sub { -e $_[0] ? 1 : 0 };
 ### VMS may require quoting upper case command options
 use constant ON_VMS         => $^O eq 'VMS' ? 1 : 0;
 
+### we can't use this extraction method, because of missing
+### modules/binaries:
+use constant METHOD_NA      => []; 
+
 ### If these are changed, update @TYPES and the new() POD
 use constant TGZ            => 'tgz';
 use constant TAR            => 'tar';
@@ -30,13 +34,19 @@ use constant TBZ            => 'tbz';
 use constant Z              => 'Z';
 use constant LZMA           => 'lzma';
 
-use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
+use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG 
+            $_ALLOW_BIN $_ALLOW_PURE_PERL
+         ];
+
+$VERSION            = '0.28';
+$PREFER_BIN         = 0;
+$WARN               = 1;
+$DEBUG              = 0;
+$_ALLOW_PURE_PERL   = 1;    # allow pure perl extractors
+$_ALLOW_BIN         = 1;    # allow binary extractors
 
-$VERSION        = '0.26';
-$PREFER_BIN     = 0;
-$WARN           = 1;
-$DEBUG          = 0;
-my @Types       = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); # same as all constants
+# same as all constants
+my @Types           = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); 
 
 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
 
@@ -109,27 +119,30 @@ for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma]) {
 }
 
 ### mapping from types to extractor methods ###
-my $Mapping = {
-    is_tgz  => '_untar',
-    is_tar  => '_untar',
-    is_gz   => '_gunzip',
-    is_zip  => '_unzip',
-    is_tbz  => '_untar',
-    is_bz2  => '_bunzip2',
-    is_Z    => '_uncompress',
-    is_lzma => '_unlzma',
+my $Mapping = {  # binary program           # pure perl module
+    is_tgz  => { bin => '_untar_bin',       pp => '_untar_at'   },
+    is_tar  => { bin => '_untar_bin',       pp => '_untar_at'   },
+    is_gz   => { bin => '_gunzip_bin',      pp => '_gunzip_cz'  },
+    is_zip  => { bin => '_unzip_bin',       pp => '_unzip_az'   },
+    is_tbz  => { bin => '_untar_bin',       pp => '_untar_at'   },
+    is_bz2  => { bin => '_bunzip2_bin',     pp => '_bunzip2_bz2'},
+    is_Z    => { bin => '_uncompress_bin',  pp => '_gunzip_cz'  },
+    is_lzma => { bin => '_unlzma_bin',      pp => '_unlzma_cz'  },
 };
 
-{
+{   ### use subs so we re-generate array refs etc for the no-overide flags
+    ### if we don't, then we reuse the same arrayref, meaning objects store
+    ### previous errors
     my $tmpl = {
-        archive => { required => 1, allow => FILE_EXISTS },
-        type    => { default => '', allow => [ @Types ] },
+        archive         => sub { { required => 1, allow => FILE_EXISTS }    },
+        type            => sub { { default => '', allow => [ @Types ] }     },
+        _error_msg      => sub { { no_override => 1, default => [] }        },
+        _error_msg_long => sub { { no_override => 1, default => [] }        },
     };
 
     ### build accesssors ###
     for my $method( keys %$tmpl, 
                     qw[_extractor _gunzip_to files extract_path],
-                    qw[_error_msg _error_msg_long]
     ) {
         no strict 'refs';
         *$method = sub {
@@ -202,8 +215,12 @@ Returns a C<Archive::Extract> object on success, or false on failure.
     sub new {
         my $class   = shift;
         my %hash    = @_;
+        
+        ### see above why we use subs here and generate the template;
+        ### it's basically to not re-use arrayrefs
+        my %utmpl   = map { $_ => $tmpl->{$_}->() } keys %$tmpl;
 
-        my $parsed = check( $tmpl, \%hash ) or return;
+        my $parsed = check( \%utmpl, \%hash ) or return;
 
         ### make sure we have an absolute path ###
         my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} );
@@ -223,11 +240,13 @@ Returns a C<Archive::Extract> object on success, or false on failure.
 
         }
 
-        ### don't know what type of file it is ###
-        return __PACKAGE__->_error(loc("Cannot determine file type for '%1'",
-                                $parsed->{archive} )) unless $parsed->{type};
+        bless $parsed, $class;
 
-        return bless $parsed, $class;
+        ### don't know what type of file it is 
+        ### XXX this *has* to be an object call, not a package call
+        return $parsed->_error(loc("Cannot determine file type for '%1'",
+                                $parsed->{archive} )) unless $parsed->{type};
+        return $parsed;
     }
 }
 
@@ -239,11 +258,11 @@ C<cwd()>.
 
 Since C<.gz> files never hold a directory, but only a single file; if 
 the C<to> argument is an existing directory, the file is extracted 
-there, with it's C<.gz> suffix stripped. 
+there, with its C<.gz> suffix stripped. 
 If the C<to> argument is not an existing directory, the C<to> argument 
 is understood to be a filename, if the archive type is C<gz>. 
 In the case that you did not specify a C<to> argument, the output
-file will be the name of the archive file, stripped from it's C<.gz>
+file will be the name of the archive file, stripped from its C<.gz>
 suffix, in the current working directory.
 
 C<extract> will try a pure perl solution first, and then fall back to
@@ -279,6 +298,10 @@ sub extract {
     my $self = shift;
     my %hash = @_;
 
+    ### reset error messages
+    $self->_error_msg( [] );
+    $self->_error_msg_long( [] );
+
     my $to;
     my $tmpl = {
         to  => { default => '.', store => \$to }
@@ -340,19 +363,50 @@ sub extract {
         ### ../lib/Archive/Extract.pm line 742. (rt #19815)
         $self->files( [] );
 
-        ### find what extractor method to use ###
-        while( my($type,$method) = each %$Mapping ) {
+        ### find out the dispatch methods needed for this type of 
+        ### archive. Do a $self->is_XXX to figure out the type, then
+        ### get the hashref with bin + pure perl dispatchers.
+        my ($map) = map { $Mapping->{$_} } grep { $self->$_ } keys %$Mapping;
 
-            ### call the corresponding method if the type is OK ###
-            if( $self->$type) {
-                $ok = $self->$method();
-            }
-        }
+        ### add pure perl extractor if allowed & add bin extractor if allowed
+        my @methods;
+        push @methods, $map->{'pp'}  if $_ALLOW_PURE_PERL;
+        push @methods, $map->{'bin'} if $_ALLOW_BIN;
+        
+        ### reverse it if we prefer bin extractors
+        @methods = reverse @methods if $PREFER_BIN;
 
-        ### warn something went wrong if we didn't get an OK ###
-        $self->_error(loc("Extract failed, no extractor found"))
-            unless $ok;
+        my($na, $fail);
+        for my $method (@methods) {
+            print "# Extracting with ->$method\n" if $DEBUG;
+        
+            my $rv = $self->$method;
+            
+            ### a positive extraction
+            if( $rv and $rv ne METHOD_NA ) {
+                print "# Extraction succeeded\n" if $DEBUG;
+                $self->_extractor($method);
+                last;
+            
+            ### method is not available
+            } elsif ( $rv and $rv eq METHOD_NA ) {               
+                print "# Extraction method not available\n" if $DEBUG;
+                $na++;                
+            } else {
+                print "# Extraction method failed\n" if $DEBUG;
+                $fail++;
+            }                
+        }
 
+        ### warn something went wrong if we didn't get an extractor
+        unless( $self->_extractor ) {
+            my $diag = $fail ? loc("Extract failed due to errors") :
+                       $na   ? loc("Extract failed; no extractors available") :
+                       '';
+                       
+            $self->_error($diag);
+            $ok = 0;
+        }                   
     }
 
     ### and chdir back ###
@@ -504,7 +558,7 @@ sub have_old_bunzip2 {
     ### double hateful: bunzip2 --version also hangs if input is a pipe
     ### See #32370: Archive::Extract will hang if stdin is a pipe [+PATCH]
     ### So, we have to provide *another* argument which is a fake filename,
-    ### just so it wont try to read from stdin to print it's version..
+    ### just so it wont try to read from stdin to print its version..
     ### *sigh*
     ### Even if the file exists, it won't clobber or change it.
     my $buffer;
@@ -529,43 +583,32 @@ sub have_old_bunzip2 {
 #
 #################################
 
-### untar wrapper... goes to either Archive::Tar or /bin/tar
-### depending on $PREFER_BIN
-sub _untar {
-    my $self = shift;
-
-    ### bzip2 support in A::T via IO::Uncompress::Bzip2
-    my   @methods = qw[_untar_at _untar_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));
-}
 
 ### use /bin/tar to extract ###
 sub _untar_bin {
     my $self = shift;
 
     ### check for /bin/tar ###
-    return $self->_error(loc("No '%1' program found", '/bin/tar'))
-        unless $self->bin_tar;
-
     ### check for /bin/gzip if we need it ###
-    return $self->_error(loc("No '%1' program found", '/bin/gzip'))
-        if $self->is_tgz && !$self->bin_gzip;
-
-    return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
-        if $self->is_tbz && !$self->bin_bunzip2;
+    ### if any of the binaries are not available, return NA
+    {   my $diag =  not $self->bin_tar ? 
+                        loc("No '%1' program found", '/bin/tar') :
+                    $self->is_tgz && !$self->bin_gzip ? 
+                        loc("No '%1' program found", '/bin/gzip') :
+                    $self->is_tbz && !$self->bin_bunzip2 ?
+                        loc("No '%1' program found", '/bin/bunzip2') :
+                    '';
+                    
+        if( $diag ) {
+            $self->_error( $diag );
+            return METHOD_NA;
+        }
+    }        
 
     ### XXX figure out how to make IPC::Run do this in one call --
     ### currently i don't know how to get output of a command after a pipe
     ### trapped in a scalar. Mailed barries about this 5th of june 2004.
 
-
-
     ### see what command we should run, based on whether
     ### it's a .tgz or .tar
 
@@ -649,14 +692,25 @@ sub _untar_bin {
 sub _untar_at {
     my $self = shift;
 
-    ### we definitely need A::T, so load that first
+    ### Loading Archive::Tar is going to set it to 1, so make it local
+    ### within this block, starting with its initial value. Whatever
+    ### Achive::Tar does will be undone when we return.
+    ###
+    ### Also, later, set $Archive::Tar::WARN to $Archive::Extract::WARN
+    ### so users don't have to even think about this variable. If they
+    ### do, they still get their set value outside of this call.
+    local $Archive::Tar::WARN = $Archive::Tar::WARN;
+   
+    ### we definitely need Archive::Tar, so load that first
     {   my $use_list = { 'Archive::Tar' => '0.0' };
 
         unless( can_load( modules => $use_list ) ) {
 
-            return $self->_error(loc("You do not have '%1' installed - " .
-                                 "Please install it as soon as possible.",
-                                 'Archive::Tar'));
+            $self->_error(loc("You do not have '%1' installed - " .
+                              "Please install it as soon as possible.",
+                              'Archive::Tar'));
+    
+            return METHOD_NA;
         }
     }
 
@@ -673,18 +727,24 @@ sub _untar_at {
         unless( can_load( modules => $use_list ) ) {
             my $which = join '/', sort keys %$use_list;
 
-            return $self->_error(loc(
-                                "You do not have '%1' installed - Please ".
-                                "install it as soon as possible.", $which));
-
+            $self->_error(loc(
+                "You do not have '%1' installed - Please ".
+                "install it as soon as possible.", $which)
+            );
+            
+            return METHOD_NA;
         }
+
     } elsif ( $self->is_tbz ) {
         my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
         unless( can_load( modules => $use_list ) ) {
-            return $self->_error(loc(
-                    "You do not have '%1' installed - Please " .
-                    "install it as soon as possible.", 
-                     'IO::Uncompress::Bunzip2'));
+            $self->_error(loc(
+                "You do not have '%1' installed - Please " .
+                "install it as soon as possible.", 
+                'IO::Uncompress::Bunzip2')
+            );
+            
+            return METHOD_NA;
         }
 
         my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
@@ -695,6 +755,10 @@ sub _untar_at {
         $fh_to_read = $bz;
     }
 
+    ### $Archive::Tar::WARN is 1 by default in Archive::Tar, but we've
+    ### 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
@@ -713,8 +777,8 @@ sub _untar_at {
         *Archive::Tar::chown = sub {};
     }
 
-    ### for version of archive::tar > 1.04
-    local $Archive::Tar::Constant::CHOWN = 0;
+    ### 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
@@ -749,28 +813,14 @@ sub _untar_at {
 #
 #################################
 
-### gunzip wrapper... goes to either Compress::Zlib or /bin/gzip
-### depending on $PREFER_BIN
-sub _gunzip {
-    my $self = shift;
-
-    my @methods = qw[_gunzip_cz _gunzip_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 gunzip file '%1'", $self->archive));
-}
-
 sub _gunzip_bin {
     my $self = shift;
 
     ### check for /bin/gzip -- we need it ###
-    return $self->_error(loc("No '%1' program found", '/bin/gzip'))
-        unless $self->bin_gzip;
-
+    unless( $self->bin_gzip ) {
+        $self->_error(loc("No '%1' program found", '/bin/gzip'));
+        return METHOD_NA;
+    }
 
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
         return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -808,8 +858,9 @@ sub _gunzip_cz {
 
     my $use_list = { 'Compress::Zlib' => '0.0' };
     unless( can_load( modules => $use_list ) ) {
-        return $self->_error(loc("You do not have '%1' installed - Please " .
-                        "install it as soon as possible.", 'Compress::Zlib'));
+        $self->_error(loc("You do not have '%1' installed - Please " .
+                    "install it as soon as possible.", 'Compress::Zlib'));
+        return METHOD_NA;
     }
 
     my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or
@@ -837,29 +888,14 @@ sub _gunzip_cz {
 #
 #################################
 
-
-### 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;
-
+    unless( $self->bin_uncompress ) {
+        $self->_error(loc("No '%1' program found", '/bin/uncompress'));
+        return METHOD_NA;
+    }
 
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
         return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -899,28 +935,15 @@ sub _uncompress_bin {
 #
 #################################
 
-### unzip wrapper... goes to either Archive::Zip or /bin/unzip
-### depending on $PREFER_BIN
-sub _unzip {
-    my $self = shift;
-
-    my @methods = qw[_unzip_az _unzip_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 gunzip file '%1'", $self->archive));
-}
 
 sub _unzip_bin {
     my $self = shift;
 
     ### check for /bin/gzip if we need it ###
-    return $self->_error(loc("No '%1' program found", '/bin/unzip'))
-        unless $self->bin_unzip;
-
+    unless( $self->bin_unzip ) {
+        $self->_error(loc("No '%1' program found", '/bin/unzip'));
+        return METHOD_NA;
+    }        
 
     ### first, get the files.. it must be 2 different commands with 'unzip' :(
     {   ### on VMS, capital letter options have to be quoted. This is
@@ -975,8 +998,9 @@ sub _unzip_az {
 
     my $use_list = { 'Archive::Zip' => '0.0' };
     unless( can_load( modules => $use_list ) ) {
-        return $self->_error(loc("You do not have '%1' installed - Please " .
-                        "install it as soon as possible.", 'Archive::Zip'));
+        $self->_error(loc("You do not have '%1' installed - Please " .
+                      "install it as soon as possible.", 'Archive::Zip'));
+        return METHOD_NA;                      
     }
 
     my $zip = Archive::Zip->new();
@@ -1052,27 +1076,14 @@ sub __get_extract_dir {
 #
 #################################
 
-### bunzip2 wrapper... 
-sub _bunzip2 {
-    my $self = shift;
-
-    my @methods = qw[_bunzip2_cz2 _bunzip2_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 bunzip2 file '%1'", $self->archive));
-}
-
 sub _bunzip2_bin {
     my $self = shift;
 
     ### check for /bin/gzip -- we need it ###
-    return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
-        unless $self->bin_bunzip2;
-
+    unless( $self->bin_bunzip2 ) {
+        $self->_error(loc("No '%1' program found", '/bin/bunzip2'));
+        return METHOD_NA;
+    }        
 
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
         return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -1145,14 +1156,15 @@ sub _bunzip2_bin {
 #     return 1;
 # }
 
-sub _bunzip2_cz2 {
+sub _bunzip2_bz2 {
     my $self = shift;
 
     my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' };
     unless( can_load( modules => $use_list ) ) {
-        return $self->_error(loc("You do not have '%1' installed - Please " .
-                        "install it as soon as possible.",
-                        'IO::Uncompress::Bunzip2'));
+        $self->_error(loc("You do not have '%1' installed - Please " .
+                          "install it as soon as possible.",
+                          'IO::Uncompress::Bunzip2'));
+        return METHOD_NA;                          
     }
 
     IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to)
@@ -1174,27 +1186,14 @@ sub _bunzip2_cz2 {
 #
 #################################
 
-### unlzma wrapper... goes to either Compress::unLZMA or /bin/unlzma
-### depending on $PREFER_BIN
-sub _unlzma {
-    my $self = shift;
-
-    my @methods = qw[_unlzma_cz _unlzma_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 unlzma file '%1'", $self->archive));
-}
-
 sub _unlzma_bin {
     my $self = shift;
 
     ### check for /bin/unlzma -- we need it ###
-    return $self->_error(loc("No '%1' program found", '/bin/unlzma'))
-        unless $self->bin_unlzma;
+    unless( $self->bin_unlzma ) {
+        $self->_error(loc("No '%1' program found", '/bin/unlzma'));
+        return METHOD_NA;
+    }        
 
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
         return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -1232,8 +1231,9 @@ sub _unlzma_cz {
 
     my $use_list = { 'Compress::unLZMA' => '0.0' };
     unless( can_load( modules => $use_list ) ) {
-        return $self->_error(loc("You do not have '%1' installed - Please " .
-                       "install it as soon as possible.", 'Compress::unLZMA'));
+        $self->_error(loc("You do not have '%1' installed - Please " .
+                    "install it as soon as possible.", 'Compress::unLZMA'));
+        return METHOD_NA;                    
     }
 
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
@@ -1267,14 +1267,15 @@ sub _unlzma_cz {
 sub _error {
     my $self    = shift;
     my $error   = shift;
-    
-    $self->_error_msg( $error );
-    $self->_error_msg_long( Carp::longmess($error) );
+    my $lerror  = Carp::longmess($error);
+
+    push @{$self->_error_msg},      $error;
+    push @{$self->_error_msg_long}, $lerror;
     
     ### set $Archive::Extract::WARN to 0 to disable printing
     ### of errors
     if( $WARN ) {
-        carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
+        carp $DEBUG ? $lerror : $error;
     }
 
     return;
@@ -1282,7 +1283,15 @@ sub _error {
 
 sub error {
     my $self = shift;
-    return shift() ? $self->_error_msg_long : $self->_error_msg;
+
+    ### make sure we have a fallback aref
+    my $aref = do { 
+        shift() 
+            ? $self->_error_msg_long 
+            : $self->_error_msg 
+    } || [];
+   
+    return join $/, @$aref;
 }
 
 sub _no_buffer_files {
diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t
index 90abf20..5aa941c 100644
--- a/lib/Archive/Extract/t/01_Archive-Extract.t
+++ b/lib/Archive/Extract/t/01_Archive-Extract.t
@@ -207,8 +207,53 @@ if( $Debug ) {
         ok( $obj,               "   Object created based on '$type'" );
         ok( !$obj->error,       "       No error logged" );
     }
+    
+    ### test unknown type
+    {   ### must turn on warnings to catch error here
+        local $Archive::Extract::WARN = 1;
+        
+        my $warnings;
+        local $SIG{__WARN__} = sub { $warnings .= "@_" };
+        
+        my $ae = $Class->new( archive => $Me );
+        ok( !$ae,               "   No archive created based on '$Me'" );
+        ok( !$Class->error,     "       Error not captured in class method" );
+        ok( $warnings,          "       Error captured as warning" );
+        like( $warnings, qr/Cannot determine file type for/,
+                                "           Error is: unknown file type" );
+    }                                
 }    
 
+### test multiple errors
+### XXX whitebox test
+{   ### grab a random file from the template, so we can make an object
+    my $ae = Archive::Extract->new( 
+                archive =>  File::Spec->catfile($SrcDir,[keys %$tmpl]->[0]) 
+             );
+    ok( $ae,                    "Archive created" );
+    ok( not($ae->error),        "   No errors yet" );
+
+    ### log a few errors
+    {   local $Archive::Extract::WARN = 0;
+        $ae->_error( $_ ) for 1..5;
+    }
+
+    my $err = $ae->error;
+    ok( $err,                   "   Errors retrieved" );
+    
+    my $expect = join $/, 1..5;
+    is( $err, $expect,          "       As expected" );
+
+    ### this resets the errors
+    ### override the 'check' routine to return false, so we bail out of 
+    ### extract() early and just run the error reset code;
+    {   no warnings qw[once redefine];
+        local *Archive::Extract::check = sub { return }; 
+        $ae->extract;
+    }
+    ok( not($ae->error),        "   Errors erased after ->extract() call" );
+}
+
 ### XXX whitebox test
 ### test __get_extract_dir 
 SKIP: {   my $meth = '__get_extract_dir';
@@ -243,15 +288,18 @@ SKIP: {   my $meth = '__get_extract_dir';
     }        
 }
 
-for my $switch (0,1) {
+### configuration to run in: allow perl or allow binaries
+for my $switch ( [0,1], [1,0] ) {
+    my $cfg = "PP: $switch->[0] Bin: $switch->[1]";
 
-    local $Archive::Extract::PREFER_BIN = $switch;
-    diag("Running extract with PREFER_BIN = $Archive::Extract::PREFER_BIN")
-        if $Debug;
+    local $Archive::Extract::_ALLOW_PURE_PERL   = $switch->[0];
+    local $Archive::Extract::_ALLOW_BIN         = $switch->[1];
+    
+    diag("Running extract with configuration: $cfg") if $Debug;
 
     for my $archive (keys %$tmpl) {
 
-        diag("Extracting $archive") if $Debug;
+        diag("Extracting $archive in config $cfg") if $Debug;
 
         ### check first if we can do the proper
 
@@ -313,7 +361,7 @@ for my $switch (0,1) {
 
             ### test buffers ###
             my $turn_off = !$use_buffer && !$pgm_fail &&
-                            $Archive::Extract::PREFER_BIN;
+                            $Archive::Extract::_ALLOW_BIN;
 
             ### whitebox test ###
             ### stupid warnings ###
@@ -331,20 +379,24 @@ for my $switch (0,1) {
   
                 my $rv = $ae->extract( to => $to );
     
-                ok( $rv, "extract() for '$archive' reports success");
-    
-                diag("Extractor was: " . $ae->_extractor)   if $Debug;
-    
                 SKIP: {
                     my $re  = qr/^No buffer captured/;
                     my $err = $ae->error || '';
               
                     ### skip buffer tests if we dont have buffers or
                     ### explicitly turned them off
-                    skip "No buffers available", 7,
+                    skip "No buffers available", 8
                         if ( $turn_off || !IPC::Cmd->can_capture_buffer)
                             && $err =~ $re;
 
+                    ### skip tests if we dont have an extractor
+                    skip "No extractor available", 8 
+                        if $err =~ /Extract failed; no extractors available/;
+    
+                    ok( $rv, "extract() for '$archive' reports success ($cfg)");
+    
+                    diag("Extractor was: " . $ae->_extractor)   if $Debug;
+    
                     ### if we /should/ have buffers, there should be
                     ### no errors complaining we dont have them...
                     unlike( $err, $re,
@@ -352,10 +404,16 @@ for my $switch (0,1) {
     
                     ### might be 1 or 2, depending wether we extracted 
                     ### a dir too
+                    my $files    = $ae->files || [];
                     my $file_cnt = grep { defined } $file, $dir;
-                    is( scalar @{ $ae->files || []}, $file_cnt,
+                    is( scalar @$files, $file_cnt,
                                     "Found correct number of output files" );
-                    is( $ae->files->[-1], $nix_path,
+                    
+                    ### due to prototypes on is(), if there's no -1 index on
+                    ### the array ref, it'll give a fatal exception:
+                    ### "Modification of non-creatable array value attempted,
+                    ### subscript -1 at -e line 1." So wrap it in do { }
+                    is( do { $files->[-1] }, $nix_path,
                                     "Found correct output file '$nix_path'" );
     
                     ok( -e $abs_path,
diff --git a/lib/Archive/Extract/t/src/double_dir.zip.packed b/lib/Archive/Extract/t/src/double_dir.zip.packed
index dc32f2c..fdfe6ae 100644
--- a/lib/Archive/Extract/t/src/double_dir.zip.packed
+++ b/lib/Archive/Extract/t/src/double_dir.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/double_dir.zip lib/Archive/Extract/t/src/double_dir.zip.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H``````&QH,S0````````````````%`!4`>"]Y+WI55`D``PR`ST,,
diff --git a/lib/Archive/Extract/t/src/x.Z.packed b/lib/Archive/Extract/t/src/x.Z.packed
index c23bfba..9f80e84 100644
--- a/lib/Archive/Extract/t/src/x.Z.packed
+++ b/lib/Archive/Extract/t/src/x.Z.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.Z lib/Archive/Extract/t/src/x.Z.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 ''YV0>`(J````
diff --git a/lib/Archive/Extract/t/src/x.bz2.packed b/lib/Archive/Extract/t/src/x.bz2.packed
index ce2b505..93337dd 100644
--- a/lib/Archive/Extract/t/src/x.bz2.packed
+++ b/lib/Archive/Extract/t/src/x.bz2.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.bz2 lib/Archive/Extract/t/src/x.bz2.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 .0EIH.1=R13A0D```````
diff --git a/lib/Archive/Extract/t/src/x.gz.packed b/lib/Archive/Extract/t/src/x.gz.packed
index 9ec46e1..ab6d42e 100644
--- a/lib/Archive/Extract/t/src/x.gz.packed
+++ b/lib/Archive/Extract/t/src/x.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.gz lib/Archive/Extract/t/src/x.gz.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 6'XL("+F;6D8``W@``P``````````````
diff --git a/lib/Archive/Extract/t/src/x.jar.packed b/lib/Archive/Extract/t/src/x.jar.packed
index c04e4d1..1d415e0 100644
--- a/lib/Archive/Extract/t/src/x.jar.packed
+++ b/lib/Archive/Extract/t/src/x.jar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.jar lib/Archive/Extract/t/src/x.jar.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/x.lzma.packed b/lib/Archive/Extract/t/src/x.lzma.packed
index 9174f44..83e2c8a 100644
--- a/lib/Archive/Extract/t/src/x.lzma.packed
+++ b/lib/Archive/Extract/t/src/x.lzma.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.lzma lib/Archive/Extract/t/src/x.lzma.packed
 
-Created at Tue Mar  4 00:26:10 2008
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 270``@```````````````````
diff --git a/lib/Archive/Extract/t/src/x.par.packed b/lib/Archive/Extract/t/src/x.par.packed
index daac16f..2e9c462 100644
--- a/lib/Archive/Extract/t/src/x.par.packed
+++ b/lib/Archive/Extract/t/src/x.par.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.par lib/Archive/Extract/t/src/x.par.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/x.tar.gz.packed b/lib/Archive/Extract/t/src/x.tar.gz.packed
index fc3e40f..ff83349 100644
--- a/lib/Archive/Extract/t/src/x.tar.gz.packed
+++ b/lib/Archive/Extract/t/src/x.tar.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tar.gz lib/Archive/Extract/t/src/x.tar.gz.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@
diff --git a/lib/Archive/Extract/t/src/x.tar.packed b/lib/Archive/Extract/t/src/x.tar.packed
index 1683ed1..658aff3 100644
--- a/lib/Archive/Extract/t/src/x.tar.packed
+++ b/lib/Archive/Extract/t/src/x.tar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tar lib/Archive/Extract/t/src/x.tar.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M80``````````````````````````````````````````````````````````
diff --git a/lib/Archive/Extract/t/src/x.tgz.packed b/lib/Archive/Extract/t/src/x.tgz.packed
index 949b59b..114142e 100644
--- a/lib/Archive/Extract/t/src/x.tgz.packed
+++ b/lib/Archive/Extract/t/src/x.tgz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tgz lib/Archive/Extract/t/src/x.tgz.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@
diff --git a/lib/Archive/Extract/t/src/x.zip.packed b/lib/Archive/Extract/t/src/x.zip.packed
index 543440a..f51b79e 100644
--- a/lib/Archive/Extract/t/src/x.zip.packed
+++ b/lib/Archive/Extract/t/src/x.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.zip lib/Archive/Extract/t/src/x.zip.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/y.jar.packed b/lib/Archive/Extract/t/src/y.jar.packed
index 796cd2f..d2911e3 100644
--- a/lib/Archive/Extract/t/src/y.jar.packed
+++ b/lib/Archive/Extract/t/src/y.jar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.jar lib/Archive/Extract/t/src/y.jar.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U
diff --git a/lib/Archive/Extract/t/src/y.par.packed b/lib/Archive/Extract/t/src/y.par.packed
index ad44f35..a6acdda 100644
--- a/lib/Archive/Extract/t/src/y.par.packed
+++ b/lib/Archive/Extract/t/src/y.par.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.par lib/Archive/Extract/t/src/y.par.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:49 2008
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U
diff --git a/lib/Archive/Extract/t/src/y.tar.bz2.packed b/lib/Archive/Extract/t/src/y.tar.bz2.packed
index 183c1a3..23845ac 100644
--- a/lib/Archive/Extract/t/src/y.tar.bz2.packed
+++ b/lib/Archive/Extract/t/src/y.tar.bz2.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.bz2 lib/Archive/Extract/t/src/y.tar.bz2.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:50 2008
 #########################################################################
 __UU__
 M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4]
diff --git a/lib/Archive/Extract/t/src/y.tar.gz.packed b/lib/Archive/Extract/t/src/y.tar.gz.packed
index 1b68ddf..5afbb48 100644
--- a/lib/Archive/Extract/t/src/y.tar.gz.packed
+++ b/lib/Archive/Extract/t/src/y.tar.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.gz lib/Archive/Extract/t/src/y.tar.gz.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:51 2008
 #########################################################################
 __UU__
 M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,I2J4.!`4Y?JH@5J4,JH?[?
diff --git a/lib/Archive/Extract/t/src/y.tar.packed b/lib/Archive/Extract/t/src/y.tar.packed
index d11c6d2..89ea8c2 100644
--- a/lib/Archive/Extract/t/src/y.tar.packed
+++ b/lib/Archive/Extract/t/src/y.tar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar lib/Archive/Extract/t/src/y.tar.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:50 2008
 #########################################################################
 __UU__
 M>2\`````````````````````````````````````````````````````````
diff --git a/lib/Archive/Extract/t/src/y.tbz.packed b/lib/Archive/Extract/t/src/y.tbz.packed
index 14ae9a5..5424d8c 100644
--- a/lib/Archive/Extract/t/src/y.tbz.packed
+++ b/lib/Archive/Extract/t/src/y.tbz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tbz lib/Archive/Extract/t/src/y.tbz.packed
 
-Created at Thu Sep 20 15:38:01 2007
+Created at Sat Dec 13 17:18:51 2008
 #########################################################################
 __UU__
 M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4]
diff --git a/lib/Archive/Extract/t/src/y.tgz.packed b/lib/Archive/Extract/t/src/y.tgz.packed
index ed3e405..5b09cfb 100644
--- a/lib/Archive/Extract/t/src/y.tgz.packed
+++ b/lib/Archive/Extract/t/src/y.tgz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tgz lib/Archive/Extract/t/src/y.tgz.packed
 
-Created at Thu Sep 20 15:38:02 2007
+Created at Sat Dec 13 17:18:51 2008
 #########################################################################
 __UU__
 M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,I2J4.!`4Y?JH@5J4,JH?[?
diff --git a/lib/Archive/Extract/t/src/y.zip.packed b/lib/Archive/Extract/t/src/y.zip.packed
index 75d7f1e..8abcb53 100644
--- a/lib/Archive/Extract/t/src/y.zip.packed
+++ b/lib/Archive/Extract/t/src/y.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.zip lib/Archive/Extract/t/src/y.zip.packed
 
-Created at Thu Sep 20 15:38:02 2007
+Created at Sat Dec 13 17:18:51 2008
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U