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