1# this test is borrowed from Archive::Any to secure compatibility 2 3use strict; 4use warnings; 5use Test::More 'no_plan'; 6 7use Archive::Any::Lite; 8use File::Spec::Functions qw(updir); 9 10my %tests = ( 11 't/lib.zip' => { 12 impolite=> 0, 13 naughty => 0, 14 handler => 'Archive::Any::Lite::Zip', 15 type => 'zip', 16 files => [qw( 17 lib/ 18 lib/Archive/ 19 lib/Archive/Any.pm 20 lib/Archive/Any/ 21 lib/Archive/Any/Tar.pm 22 lib/Archive/Any/Zip.pm 23 lib/Archive/Any/Zip.pm~ 24 lib/Archive/Any/Tar.pm~ 25 lib/Archive/Any.pm~ 26 )], 27 }, 28 't/lib.tgz' => { 29 impolite => 0, 30 naughty => 0, 31 handler => 'Archive::Any::Lite::Tar', 32 type => 'tar', 33 files => [qw( 34 lib/ 35 lib/Archive/ 36 lib/Archive/Any.pm 37 lib/Archive/Any/ 38 lib/Archive/Any/Tar.pm 39 lib/Archive/Any/Zip.pm 40 lib/Archive/Any/Zip.pm~ 41 lib/Archive/Any/Tar.pm~ 42 lib/Archive/Any.pm~ 43 )], 44 }, 45 't/impolite.tar.gz' => { 46 impolite => 1, 47 naughty => 0, 48 handler => 'Archive::Any::Lite::Tar', 49 type => 'tar', 50 files => [qw( 51 type.t 52 Any.t 53 00compile.t 54 fail.t 55 )], 56 }, 57 't/naughty.tar' => { 58 impolite => 0, 59 naughty => 1, 60 handler => 'Archive::Any::Lite::Tar', 61 type => 'tar', 62 files => [qw( 63 /tmp/lib/ 64 /tmp/lib/Archive/ 65 /tmp/lib/Archive/Any/ 66 /tmp/lib/Archive/Any/Tar.pm 67 /tmp/lib/Archive/Any/Zip.pm 68 /tmp/lib/Archive/Any.pm 69 )], 70 }, 71); 72 73 74while( my($file, $expect) = each %tests ) { 75 # Test it once with type auto-discover and once with the type 76 # forced. Forced typing was broken until 0.05. 77 test_archive($file, $expect); 78 test_archive($file, $expect, $expect->{type}); 79} 80 81sub test_archive { 82 my($file, $expect, $type) = @_; 83 84 my $archive = Archive::Any::Lite->new($file, $type); 85 86 # And now we chdir out from under it. This causes serious problems 87 # if we're not careful to use absolute paths internally. 88 chdir('t'); 89 90 ok( defined $archive, "new($file)" ); 91 ok( $archive->isa('Archive::Any::Lite'), " it's an object" ); 92 93 ok( eq_set([$archive->files], $expect->{files}), 94 ' lists the right files' ); 95 ok( $archive->type(), "backwards compatibility" ); 96 97# is( $archive->handler, $expect->{handler}, ' right handler' ); 98 99 is( $archive->is_impolite, $expect->{impolite}, " impolite?" ); 100 is( $archive->is_naughty, $expect->{naughty}, " naughty?" ); 101 102 unless( $archive->is_impolite || $archive->is_naughty ) { 103 ok($archive->extract(), "extract($file)"); 104 foreach my $file (reverse $archive->files) { 105 ok( -e $file, " $file" ); 106 -d $file ? rmdir $file : unlink $file; 107 } 108 } 109 110 chdir(updir); 111} 112