[p5sagit/p5-mst-13.2.git] / lib / Archive / Extract / t / 01_Archive-Extract.t

BEGIN { 
    if( $ENV{PERL_CORE} ) {
        chdir '../lib/Archive/Extract' if -d '../lib/Archive/Extract';
        unshift @INC, '../../..', '../../../..';
    }
}    

BEGIN { chdir 't' if -d 't' };
BEGIN { mkdir 'out' unless -d 'out' };

use strict;
use lib qw[../lib];

use constant IS_WIN32   => $^O eq 'MSWin32' ? 1 : 0;
use constant IS_CYGWIN  => $^O eq 'cygwin'  ? 1 : 0;

use Cwd                         qw[cwd];
use Test::More                  qw[no_plan];
use File::Spec;
use File::Spec::Unix;
use File::Path;
use Data::Dumper;
use File::Basename              qw[basename];
use Module::Load::Conditional   qw[check_install];

### uninitialized value in File::Spec warnings come from A::Zip:
# t/01_Archive-Extract....ok 135/0Use of uninitialized value in concatenation (.) or string at /opt/lib/perl5/5.8.3/File/Spec/Unix.pm line 313.
#         File::Spec::Unix::catpath('File::Spec','','','undef') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 473
#         Archive::Zip::_asLocalName('') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 652
#         Archive::Zip::Archive::extractMember('Archive::Zip::Archive=HASH(0x9679c8)','Archive::Zip::ZipFileMember=HASH(0x9678fc)') called at ../lib/Archive/Extract.pm line 753
#         Archive::Extract::_unzip_az('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 674
#         Archive::Extract::_unzip('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 275
#         Archive::Extract::extract('Archive::Extract=HASH(0x966eac)','to','/Users/kane/sources/p4/other/archive-extract/t/out') called at t/01_Archive-Extract.t line 180
#BEGIN { $SIG{__WARN__} = sub { require Carp; Carp::cluck(@_) } };

if ((IS_WIN32 or IS_CYGWIN) && ! $ENV{PERL_CORE}) {
    diag( "Older versions of Archive::Zip may cause File::Spec warnings" );
    diag( "See bug #19713 in rt.cpan.org. It is safe to ignore them" );
}

my $Debug   = $ARGV[0] ? 1 : 0;
my $Me      = basename( $0 );
my $Class   = 'Archive::Extract';
my $Self    = File::Spec->rel2abs( 
                    IS_WIN32 ? &Win32::GetShortPathName( cwd() ) : cwd() 
                );
my $SrcDir  = File::Spec->catdir( $Self,'src' );
my $OutDir  = File::Spec->catdir( $Self,'out' );

use_ok($Class);

### set verbose if debug is on ###
### stupid stupid silly stupid warnings silly! ###
$Archive::Extract::VERBOSE  = $Archive::Extract::VERBOSE = $Debug;
$Archive::Extract::WARN     = $Archive::Extract::WARN    = $Debug ? 1 : 0;

my $tmpl = {
    ### plain files
    'x.bz2' => {    programs    => [qw[bunzip2]],
                    modules     => [qw[IO::Uncompress::Bunzip2]],
                    method      => 'is_bz2',
                    outfile     => 'a',
                },
    'x.tgz' => {    programs    => [qw[gzip tar]],
                    modules     => [qw[Archive::Tar IO::Zlib]],
                    method      => 'is_tgz',
                    outfile     => 'a',
                },
    'x.tar.gz' => { programs    => [qw[gzip tar]],
                    modules     => [qw[Archive::Tar IO::Zlib]],
                    method      => 'is_tgz',
                    outfile     => 'a',
                },
    'x.tar' => {    programs    => [qw[tar]],
                    modules     => [qw[Archive::Tar]],
                    method      => 'is_tar',
                    outfile     => 'a',
                },
    'x.gz' => {     programs    => [qw[gzip]],
                    modules     => [qw[Compress::Zlib]],
                    method      => 'is_gz',
                    outfile     => 'a',
                },
    'x.zip' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'a',
                },
    'x.jar' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'a',
                },                
    'x.par' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'a',
                },                
    ### with a directory
    'y.tbz'     => {    programs    => [qw[bunzip2 tar]],
                        modules     => [qw[Archive::Tar 
                                           IO::Uncompress::Bunzip2]],
                        method      => 'is_tbz',
                        outfile     => 'z',
                        outdir      => 'y',
                    },
    'y.tar.bz2' => {    programs    => [qw[bunzip2 tar]],
                        modules     => [qw[Archive::Tar 
                                           IO::Uncompress::Bunzip2]],
                        method      => 'is_tbz',
                        outfile     => 'z',
                        outdir      => 'y'
                    },    
    'y.tgz'     => {    programs    => [qw[gzip tar]],
                        modules     => [qw[Archive::Tar IO::Zlib]],
                        method      => 'is_tgz',
                        outfile     => 'z',
                        outdir      => 'y'
                    },
    'y.tar.gz' => {     programs    => [qw[gzip tar]],
                        modules     => [qw[Archive::Tar IO::Zlib]],
                        method      => 'is_tgz',
                        outfile     => 'z',
                        outdir      => 'y'
                    },
    'y.tar' => {    programs    => [qw[tar]],
                    modules     => [qw[Archive::Tar]],
                    method      => 'is_tar',
                    outfile     => 'z',
                    outdir      => 'y'
                },
    'y.zip' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'z',
                    outdir      => 'y'
                },
    'y.par' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'z',
                    outdir      => 'y'
                },
    'y.jar' => {    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'z',
                    outdir      => 'y'
                },
    ### with non-same top dir
    'double_dir.zip' => {
                    programs    => [qw[unzip]],
                    modules     => [qw[Archive::Zip]],
                    method      => 'is_zip',
                    outfile     => 'w',
                    outdir      => 'x'
                },
};

### show us the tools IPC::Cmd will use to run binary programs
if( $Debug ) {
    diag( "IPC::Run enabled: $IPC::Cmd::USE_IPC_RUN " );
    diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run );
    diag( "IPC::Run vesion: $IPC::Run::VERSION" );
    diag( "IPC::Open3 enabled: $IPC::Cmd::USE_IPC_OPEN3 " );
    diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 );
    diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" );
}

### test all type specifications to new()
### this tests bug #24578: Wrong check for `type' argument
{   my $meth = 'types';

    can_ok( $Class, $meth );

    my @types = $Class->$meth;
    ok( scalar(@types),         "   Got a list of types" );
    
    for my $type ( @types ) {
        my $obj = $Class->new( archive => $Me, type => $type );
        ok( $obj,               "   Object created based on '$type'" );
        ok( !$obj->error,       "       No error logged" );
    }
}    

### XXX whitebox test
### test __get_extract_dir 
{   my $meth = '__get_extract_dir';

    ### get the right seperator -- File::Spec does clean ups for
    ### paths, so we need to join ourselves.
    my $sep  = [ split '', File::Spec->catfile( 'a', 'b' ) ]->[1];
    
    ### bug #23999: Attempt to generate Makefile.PL gone awry
    ### showed that dirs in the style of './dir/' were reported
    ### to be unpacked in '.' rather than in 'dir'. here we test
    ### for this.
    for my $prefix ( '', '.' ) {
        my $dir = basename( $SrcDir );

        ### build a list like [dir, dir/file] and [./dir ./dir/file]
        ### where the dir and file actually exist, which is important
        ### for the method call
        my @files = map { length $prefix 
                                ? join $sep, $prefix, $_
                                : $_
                      } $dir, File::Spec->catfile( $dir, [keys %$tmpl]->[0] );
        
        my $res = $Class->$meth( \@files );
        $res = &Win32::GetShortPathName( $res ) if IS_WIN32;

        ok( $res,               "Found extraction dir '$res'" );
        is( $res, $SrcDir,      "   Is expected dir '$SrcDir'" );
    }        
}

for my $switch (0,1) {

    local $Archive::Extract::PREFER_BIN = $switch;
    diag("Running extract with PREFER_BIN = $Archive::Extract::PREFER_BIN")
        if $Debug;

    for my $archive (keys %$tmpl) {

        diag("Extracting $archive") if $Debug;

        ### check first if we can do the proper

        my $ae = Archive::Extract->new(
                        archive => File::Spec->catfile($SrcDir,$archive) );

        isa_ok( $ae, $Class );

        my $method = $tmpl->{$archive}->{method};
        ok( $ae->$method(),         "Archive type recognized properly" );

    ### 10 tests from here on down ###
    SKIP: {
        my $file        = $tmpl->{$archive}->{outfile};
        my $dir         = $tmpl->{$archive}->{outdir};  # can be undef
        my $rel_path    = File::Spec->catfile( grep { defined } $dir, $file );
        my $abs_path    = File::Spec->catfile( $OutDir, $rel_path );
        my $abs_dir     = File::Spec->catdir( 
                            grep { defined } $OutDir, $dir );
        my $nix_path    = File::Spec::Unix->catfile(
                            grep { defined } $dir, $file );

        ### check if we can run this test ###
        my $pgm_fail; my $mod_fail;
        for my $pgm ( @{$tmpl->{$archive}->{programs}} ) {
            ### no binary extract method
            $pgm_fail++, next unless $pgm;

            ### we dont have the program
            $pgm_fail++ unless $Archive::Extract::PROGRAMS->{$pgm} &&
                               $Archive::Extract::PROGRAMS->{$pgm};

        }

        for my $mod ( @{$tmpl->{$archive}->{modules}} ) {
            ### no module extract method
            $mod_fail++, next unless $mod;

            ### we dont have the module
            $mod_fail++ unless check_install( module => $mod );
        }

        ### where to extract to -- try both dir and file for gz files
        ### XXX test me!
        #my @outs = $ae->is_gz ? ($abs_path, $OutDir) : ($OutDir);
        my @outs = $ae->is_gz || $ae->is_bz2 ? ($abs_path) : ($OutDir);

        skip "No binaries or modules to extract ".$archive, 
            (10 * scalar @outs) if $mod_fail && $pgm_fail;


        ### we dont warnings spewed about missing modules, that might
        ### be a problem...
        local $IPC::Cmd::WARN = 0;
        local $IPC::Cmd::WARN = 0;
        
        for my $use_buffer ( IPC::Cmd->can_capture_buffer , 0 ) {

            ### test buffers ###
            my $turn_off = !$use_buffer && !$pgm_fail &&
                            $Archive::Extract::PREFER_BIN;

            ### whitebox test ###
            ### stupid warnings ###
            local $IPC::Cmd::USE_IPC_RUN    = 0 if $turn_off;
            local $IPC::Cmd::USE_IPC_RUN    = 0 if $turn_off;
            local $IPC::Cmd::USE_IPC_OPEN3  = 0 if $turn_off;
            local $IPC::Cmd::USE_IPC_OPEN3  = 0 if $turn_off;


            ### try extracting ###
            for my $to ( @outs ) {

                diag("Extracting to: $to")                  if $Debug;
                diag("Buffers enabled: ".!$turn_off)        if $Debug;
    
                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,
                        if ( $turn_off || !IPC::Cmd->can_capture_buffer)
                            && $err =~ $re;

                    ### if we /should/ have buffers, there should be
                    ### no errors complaining we dont have them...
                    unlike( $err, $re,
                                    "No errors capturing buffers" );
    
                    ### might be 1 or 2, depending wether we extracted 
                    ### a dir too
                    my $file_cnt = grep { defined } $file, $dir;
                    is( scalar @{ $ae->files || []}, $file_cnt,
                                    "Found correct number of output files" );
                    is( $ae->files->[-1], $nix_path,
                                    "Found correct output file '$nix_path'" );
    
                    ok( -e $abs_path,
                                    "Output file '$abs_path' exists" );
                    ok( $ae->extract_path,
                                    "Extract dir found" );
                    ok( -d $ae->extract_path,
                                    "Extract dir exists" );
                    is( $ae->extract_path, $abs_dir,
                                    "Extract dir is expected '$abs_dir'" );
                }

                SKIP: {
                    skip "Unlink tests are unreliable on Win32", 3 if IS_WIN32;

                    1 while unlink $abs_path;
                    ok( !(-e $abs_path), "Output file successfully removed" );
        
                    SKIP: {
                        skip "No extract path captured, can't remove paths", 2
                            unless $ae->extract_path;
        
                        eval { rmtree( $ae->extract_path ) }; 
                        ok( !$@,        "   rmtree gave no error" );
                        ok( !(-d $ae->extract_path ),
                                        "   Extract dir succesfully removed" );
                    }
                }
            }
        }
    } }
}
Commit	Line	Data
520c99e2	1	BEGIN {
	2	if( $ENV{PERL_CORE} ) {
	3	chdir '../lib/Archive/Extract' if -d '../lib/Archive/Extract';
	4	unshift @INC, '../../..', '../../../..';
	5	}
	6	}
	7
	8	BEGIN { chdir 't' if -d 't' };
	9	BEGIN { mkdir 'out' unless -d 'out' };
	10
	11	use strict;
	12	use lib qw[../lib];
	13
	14	use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0;
	15	use constant IS_CYGWIN => $^O eq 'cygwin' ? 1 : 0;
	16
	17	use Cwd qw[cwd];
	18	use Test::More qw[no_plan];
	19	use File::Spec;
	20	use File::Spec::Unix;
	21	use File::Path;
	22	use Data::Dumper;
	23	use File::Basename qw[basename];
	24	use Module::Load::Conditional qw[check_install];
	25
	26	### uninitialized value in File::Spec warnings come from A::Zip:
	27	# t/01_Archive-Extract....ok 135/0Use of uninitialized value in concatenation (.) or string at /opt/lib/perl5/5.8.3/File/Spec/Unix.pm line 313.
	28	# File::Spec::Unix::catpath('File::Spec','','','undef') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 473
	29	# Archive::Zip::_asLocalName('') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 652
	30	# Archive::Zip::Archive::extractMember('Archive::Zip::Archive=HASH(0x9679c8)','Archive::Zip::ZipFileMember=HASH(0x9678fc)') called at ../lib/Archive/Extract.pm line 753
	31	# Archive::Extract::_unzip_az('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 674
	32	# Archive::Extract::_unzip('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 275
	33	# Archive::Extract::extract('Archive::Extract=HASH(0x966eac)','to','/Users/kane/sources/p4/other/archive-extract/t/out') called at t/01_Archive-Extract.t line 180
	34	#BEGIN { $SIG{__WARN__} = sub { require Carp; Carp::cluck(@_) } };
	35
03998fa0	36	if ((IS_WIN32 or IS_CYGWIN) && ! $ENV{PERL_CORE}) {
520c99e2	37	diag( "Older versions of Archive::Zip may cause File::Spec warnings" );
	38	diag( "See bug #19713 in rt.cpan.org. It is safe to ignore them" );
	39	}
	40
	41	my $Debug = $ARGV[0] ? 1 : 0;
	42	my $Me = basename( $0 );
	43	my $Class = 'Archive::Extract';
	44	my $Self = File::Spec->rel2abs(
	45	IS_WIN32 ? &Win32::GetShortPathName( cwd() ) : cwd()
	46	);
	47	my $SrcDir = File::Spec->catdir( $Self,'src' );
	48	my $OutDir = File::Spec->catdir( $Self,'out' );
	49
	50	use_ok($Class);
	51
	52	### set verbose if debug is on ###
	53	### stupid stupid silly stupid warnings silly! ###
	54	$Archive::Extract::VERBOSE = $Archive::Extract::VERBOSE = $Debug;
	55	$Archive::Extract::WARN = $Archive::Extract::WARN = $Debug ? 1 : 0;
	56
	57	my $tmpl = {
	58	### plain files
	59	'x.bz2' => { programs => [qw[bunzip2]],
	60	modules => [qw[IO::Uncompress::Bunzip2]],
	61	method => 'is_bz2',
	62	outfile => 'a',
	63	},
	64	'x.tgz' => { programs => [qw[gzip tar]],
	65	modules => [qw[Archive::Tar IO::Zlib]],
	66	method => 'is_tgz',
	67	outfile => 'a',
	68	},
	69	'x.tar.gz' => { programs => [qw[gzip tar]],
	70	modules => [qw[Archive::Tar IO::Zlib]],
	71	method => 'is_tgz',
	72	outfile => 'a',
	73	},
	74	'x.tar' => { programs => [qw[tar]],
	75	modules => [qw[Archive::Tar]],
	76	method => 'is_tar',
	77	outfile => 'a',
	78	},
	79	'x.gz' => { programs => [qw[gzip]],
	80	modules => [qw[Compress::Zlib]],
	81	method => 'is_gz',
	82	outfile => 'a',
	83	},
	84	'x.zip' => { programs => [qw[unzip]],
	85	modules => [qw[Archive::Zip]],
	86	method => 'is_zip',
	87	outfile => 'a',
	88	},
	89	'x.jar' => { programs => [qw[unzip]],
	90	modules => [qw[Archive::Zip]],
	91	method => 'is_zip',
	92	outfile => 'a',
	93	},
	94	'x.par' => { programs => [qw[unzip]],
	95	modules => [qw[Archive::Zip]],
	96	method => 'is_zip',
	97	outfile => 'a',
	98	},
	99	### with a directory
	100	'y.tbz' => { programs => [qw[bunzip2 tar]],
101	modules => [qw[Archive::Tar
102	IO::Uncompress::Bunzip2]],
103	method => 'is_tbz',
104	outfile => 'z',
105	outdir => 'y',
106	},
107	'y.tar.bz2' => { programs => [qw[bunzip2 tar]],
108	modules => [qw[Archive::Tar
109	IO::Uncompress::Bunzip2]],
110	method => 'is_tbz',
111	outfile => 'z',
112	outdir => 'y'
113	},
114	'y.tgz' => { programs => [qw[gzip tar]],
115	modules => [qw[Archive::Tar IO::Zlib]],
116	method => 'is_tgz',
117	outfile => 'z',
118	outdir => 'y'
119	},
120	'y.tar.gz' => { programs => [qw[gzip tar]],
121	modules => [qw[Archive::Tar IO::Zlib]],
122	method => 'is_tgz',
123	outfile => 'z',
124	outdir => 'y'
125	},
126	'y.tar' => { programs => [qw[tar]],
127	modules => [qw[Archive::Tar]],
128	method => 'is_tar',
129	outfile => 'z',
130	outdir => 'y'
131	},
132	'y.zip' => { programs => [qw[unzip]],
133	modules => [qw[Archive::Zip]],
134	method => 'is_zip',
135	outfile => 'z',
136	outdir => 'y'
137	},
138	'y.par' => { programs => [qw[unzip]],
139	modules => [qw[Archive::Zip]],
140	method => 'is_zip',
141	outfile => 'z',
142	outdir => 'y'
143	},
144	'y.jar' => { programs => [qw[unzip]],
145	modules => [qw[Archive::Zip]],
146	method => 'is_zip',
147	outfile => 'z',
148	outdir => 'y'
149	},
150	### with non-same top dir
151	'double_dir.zip' => {
152	programs => [qw[unzip]],
153	modules => [qw[Archive::Zip]],
154	method => 'is_zip',
155	outfile => 'w',
156	outdir => 'x'
157	},
158	};
159
160	### show us the tools IPC::Cmd will use to run binary programs
161	if( $Debug ) {
162	diag( "IPC::Run enabled: $IPC::Cmd::USE_IPC_RUN " );
163	diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run );
164	diag( "IPC::Run vesion: $IPC::Run::VERSION" );
165	diag( "IPC::Open3 enabled: $IPC::Cmd::USE_IPC_OPEN3 " );
166	diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 );
167	diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" );
168	}
169
170	### test all type specifications to new()
171	### this tests bug #24578: Wrong check for `type' argument
172	{ my $meth = 'types';
173
174	can_ok( $Class, $meth );
175
176	my @types = $Class->$meth;
177	ok( scalar(@types), " Got a list of types" );
178
179	for my $type ( @types ) {
180	my $obj = $Class->new( archive => $Me, type => $type );
181	ok( $obj, " Object created based on '$type'" );
182	ok( !$obj->error, " No error logged" );
183	}
184	}
185
186	### XXX whitebox test
187	### test __get_extract_dir
188	{ my $meth = '__get_extract_dir';
189
190	### get the right seperator -- File::Spec does clean ups for
191	### paths, so we need to join ourselves.
192	my $sep = [ split '', File::Spec->catfile( 'a', 'b' ) ]->[1];
193
194	### bug #23999: Attempt to generate Makefile.PL gone awry
195	### showed that dirs in the style of './dir/' were reported
196	### to be unpacked in '.' rather than in 'dir'. here we test
197	### for this.
198	for my $prefix ( '', '.' ) {
199	my $dir = basename( $SrcDir );
200
201	### build a list like [dir, dir/file] and [./dir ./dir/file]
202	### where the dir and file actually exist, which is important
203	### for the method call
204	my @files = map { length $prefix
205	? join $sep, $prefix, $_
206	: $_
207	} $dir, File::Spec->catfile( $dir, [keys %$tmpl]->[0] );
208
209	my $res = $Class->$meth( \@files );
210	$res = &Win32::GetShortPathName( $res ) if IS_WIN32;
211
212	ok( $res, "Found extraction dir '$res'" );
213	is( $res, $SrcDir, " Is expected dir '$SrcDir'" );
214	}
215	}
216
217	for my $switch (0,1) {
218
219	local $Archive::Extract::PREFER_BIN = $switch;
220	diag("Running extract with PREFER_BIN = $Archive::Extract::PREFER_BIN")
221	if $Debug;
222
223	for my $archive (keys %$tmpl) {
224
225	diag("Extracting $archive") if $Debug;
226
227	### check first if we can do the proper
228
229	my $ae = Archive::Extract->new(
230	archive => File::Spec->catfile($SrcDir,$archive) );
231
232	isa_ok( $ae, $Class );
233
234	my $method = $tmpl->{$archive}->{method};
235	ok( $ae->$method(), "Archive type recognized properly" );
236
237	### 10 tests from here on down ###
238	SKIP: {
239	my $file = $tmpl->{$archive}->{outfile};
240	my $dir = $tmpl->{$archive}->{outdir}; # can be undef
241	my $rel_path = File::Spec->catfile( grep { defined } $dir, $file );
242	my $abs_path = File::Spec->catfile( $OutDir, $rel_path );
243	my $abs_dir = File::Spec->catdir(
244	grep { defined } $OutDir, $dir );
245	my $nix_path = File::Spec::Unix->catfile(
246	grep { defined } $dir, $file );
247
248	### check if we can run this test ###
249	my $pgm_fail; my $mod_fail;
250	for my $pgm ( @{$tmpl->{$archive}->{programs}} ) {
251	### no binary extract method
252	$pgm_fail++, next unless $pgm;
253
254	### we dont have the program
255	$pgm_fail++ unless $Archive::Extract::PROGRAMS->{$pgm} &&
256	$Archive::Extract::PROGRAMS->{$pgm};
257
258	}
259
260	for my $mod ( @{$tmpl->{$archive}->{modules}} ) {
261	### no module extract method
262	$mod_fail++, next unless $mod;
263
264	### we dont have the module
265	$mod_fail++ unless check_install( module => $mod );
266	}
267
268	### where to extract to -- try both dir and file for gz files
269	### XXX test me!
270	#my @outs = $ae->is_gz ? ($abs_path, $OutDir) : ($OutDir);
271	my @outs = $ae->is_gz \|\| $ae->is_bz2 ? ($abs_path) : ($OutDir);
272
273	skip "No binaries or modules to extract ".$archive,
274	(10 * scalar @outs) if $mod_fail && $pgm_fail;
275
276
277	### we dont warnings spewed about missing modules, that might
278	### be a problem...
279	local $IPC::Cmd::WARN = 0;
280	local $IPC::Cmd::WARN = 0;
281
282	for my $use_buffer ( IPC::Cmd->can_capture_buffer , 0 ) {
283
284	### test buffers ###
285	my $turn_off = !$use_buffer && !$pgm_fail &&
286	$Archive::Extract::PREFER_BIN;
287
288	### whitebox test ###
289	### stupid warnings ###
290	local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off;
291	local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off;
292	local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off;
293	local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off;
294
295
296	### try extracting ###
297	for my $to ( @outs ) {
298
299	diag("Extracting to: $to") if $Debug;
300	diag("Buffers enabled: ".!$turn_off) if $Debug;
301
302	my $rv = $ae->extract( to => $to );
303
304	ok( $rv, "extract() for '$archive' reports success");
305
306	diag("Extractor was: " . $ae->_extractor) if $Debug;
307
308	SKIP: {
309	my $re = qr/^No buffer captured/;
310	my $err = $ae->error \|\| '';
311
312	### skip buffer tests if we dont have buffers or
313	### explicitly turned them off
314	skip "No buffers available", 7,
315	if ( $turn_off \|\| !IPC::Cmd->can_capture_buffer)
316	&& $err =~ $re;
317
318	### if we /should/ have buffers, there should be
319	### no errors complaining we dont have them...
320	unlike( $err, $re,
321	"No errors capturing buffers" );
322
323	### might be 1 or 2, depending wether we extracted
324	### a dir too
325	my $file_cnt = grep { defined } $file, $dir;
326	is( scalar @{ $ae->files \|\| []}, $file_cnt,
327	"Found correct number of output files" );
328	is( $ae->files->[-1], $nix_path,
329	"Found correct output file '$nix_path'" );
330
331	ok( -e $abs_path,
332	"Output file '$abs_path' exists" );
333	ok( $ae->extract_path,
334	"Extract dir found" );
335	ok( -d $ae->extract_path,
336	"Extract dir exists" );
337	is( $ae->extract_path, $abs_dir,
338	"Extract dir is expected '$abs_dir'" );
339	}
340
341	SKIP: {
342	skip "Unlink tests are unreliable on Win32", 3 if IS_WIN32;
343
344	1 while unlink $abs_path;
345	ok( !(-e $abs_path), "Output file successfully removed" );
346
347	SKIP: {
348	skip "No extract path captured, can't remove paths", 2
349	unless $ae->extract_path;
350
351	eval { rmtree( $ae->extract_path ) };
352	ok( !$@, " rmtree gave no error" );
353	ok( !(-d $ae->extract_path ),
354	" Extract dir succesfully removed" );
355	}
356	}
357	}
358	}
359	} }
360	}