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