1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4	@INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use CompTestUtils;
15
16BEGIN {
17    # use Test::NoWarnings, if available
18    my $extra = 0 ;
19    $extra = 1
20        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
21
22    plan tests => 77 + $extra ;
23
24    use_ok('IO::Compress::Zip', qw(:all)) ;
25    use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
26
27    eval {
28           require IO::Compress::Bzip2 ;
29           import  IO::Compress::Bzip2 2.010 ;
30           require IO::Uncompress::Bunzip2 ;
31           import  IO::Uncompress::Bunzip2 2.010 ;
32         } ;
33
34}
35
36
37sub getContent
38{
39    my $filename = shift;
40
41    my $u = new IO::Uncompress::Unzip $filename, Append => 1
42        or die "Cannot open $filename: $UnzipError";
43
44    isa_ok $u, "IO::Uncompress::Unzip";
45
46    my @content;
47    my $status ;
48
49    for ($status = 1; ! $u->eof(); $status = $u->nextStream())
50    {
51        my $name = $u->getHeaderInfo()->{Name};
52        #warn "Processing member $name\n" ;
53
54        my $buff = '';
55        1 while ($status = $u->read($buff)) ;
56
57        push @content, $buff;
58        last unless $status == 0;
59    }
60
61    die "Error processing $filename: $status $!\n"
62        if $status < 0 ;
63
64    return @content;
65}
66
67
68{
69    title "Create a simple zip - All Deflate";
70
71    my $lex = new LexFile my $file1;
72
73    my @content = (
74                   'hello',
75                   '',
76                   'goodbye ',
77                   );
78
79    my $zip = new IO::Compress::Zip $file1,
80                    Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
81    isa_ok $zip, "IO::Compress::Zip";
82
83    is $zip->write($content[0]), length($content[0]), "write";
84    $zip->newStream(Name=> "two", Method => ZIP_CM_DEFLATE);
85    is $zip->write($content[1]), length($content[1]), "write";
86    $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
87    is $zip->write($content[2]), length($content[2]), "write";
88    ok $zip->close(), "closed";
89
90    my @got = getContent($file1);
91
92    is $got[0], $content[0], "Got 1st entry";
93    is $got[1], $content[1], "Got 2nd entry";
94    is $got[2], $content[2], "Got 3nd entry";
95}
96
97SKIP:
98{
99    title "Create a simple zip - All Bzip2";
100
101    skip "IO::Compress::Bzip2 not available", 9
102        unless defined $IO::Compress::Bzip2::VERSION;
103
104    my $lex = new LexFile my $file1;
105
106    my @content = (
107                   'hello',
108                   '',
109                   'goodbye ',
110                   );
111
112    my $zip = new IO::Compress::Zip $file1,
113                    Name => "one", Method => ZIP_CM_BZIP2, Stream => 0;
114    isa_ok $zip, "IO::Compress::Zip";
115
116    is $zip->write($content[0]), length($content[0]), "write";
117    $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
118    is $zip->write($content[1]), length($content[1]), "write";
119    $zip->newStream(Name=> "three", Method => ZIP_CM_BZIP2);
120    is $zip->write($content[2]), length($content[2]), "write";
121    ok $zip->close(), "closed";
122
123    my @got = getContent($file1);
124
125    is $got[0], $content[0], "Got 1st entry";
126    is $got[1], $content[1], "Got 2nd entry";
127    is $got[2], $content[2], "Got 3nd entry";
128}
129
130SKIP:
131{
132    title "Create a simple zip - Deflate + Bzip2";
133
134    skip "IO::Compress::Bzip2 not available", 9
135        unless $IO::Compress::Bzip2::VERSION;
136
137    my $lex = new LexFile my $file1;
138
139    my @content = (
140                   'hello',
141                   'and',
142                   'goodbye ',
143                   );
144
145    my $zip = new IO::Compress::Zip $file1,
146                    Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
147    isa_ok $zip, "IO::Compress::Zip";
148
149    is $zip->write($content[0]), length($content[0]), "write";
150    $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
151    is $zip->write($content[1]), length($content[1]), "write";
152    $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
153    is $zip->write($content[2]), length($content[2]), "write";
154    ok $zip->close(), "closed";
155
156    my @got = getContent($file1);
157
158    is $got[0], $content[0], "Got 1st entry";
159    is $got[1], $content[1], "Got 2nd entry";
160    is $got[2], $content[2], "Got 3nd entry";
161}
162
163{
164    title "Create a simple zip - All STORE";
165
166    my $lex = new LexFile my $file1;
167
168    my @content = (
169                   'hello',
170                   '',
171                   'goodbye ',
172                   );
173
174    my $zip = new IO::Compress::Zip $file1,
175                    Name => "one", Method => ZIP_CM_STORE, Stream => 0;
176    isa_ok $zip, "IO::Compress::Zip";
177
178    is $zip->write($content[0]), length($content[0]), "write";
179    $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
180    is $zip->write($content[1]), length($content[1]), "write";
181    $zip->newStream(Name=> "three", Method => ZIP_CM_STORE);
182    is $zip->write($content[2]), length($content[2]), "write";
183    ok $zip->close(), "closed";
184
185    my @got = getContent($file1);
186
187    is $got[0], $content[0], "Got 1st entry";
188    is $got[1], $content[1], "Got 2nd entry";
189    is $got[2], $content[2], "Got 3nd entry";
190}
191
192{
193    title "Create a simple zip - Deflate + STORE";
194
195    my $lex = new LexFile my $file1;
196
197    my @content = qw(
198                   hello
199                       and
200                   goodbye
201                   );
202
203    my $zip = new IO::Compress::Zip $file1,
204                    Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
205    isa_ok $zip, "IO::Compress::Zip";
206
207    is $zip->write($content[0]), length($content[0]), "write";
208    $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
209    is $zip->write($content[1]), length($content[1]), "write";
210    $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
211    is $zip->write($content[2]), length($content[2]), "write";
212    ok $zip->close(), "closed";
213
214    my @got = getContent($file1);
215
216    is $got[0], $content[0], "Got 1st entry";
217    is $got[1], $content[1], "Got 2nd entry";
218    is $got[2], $content[2], "Got 3nd entry";
219}
220
221{
222    title "Create a simple zip - Deflate + zero length STORE";
223
224    my $lex = new LexFile my $file1;
225
226    my @content = (
227                   'hello ',
228                   '',
229                   'goodbye ',
230                   );
231
232    my $zip = new IO::Compress::Zip $file1,
233                    Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
234    isa_ok $zip, "IO::Compress::Zip";
235
236    is $zip->write($content[0]), length($content[0]), "write";
237    $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
238    is $zip->write($content[1]), length($content[1]), "write";
239    $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
240    is $zip->write($content[2]), length($content[2]), "write";
241    ok $zip->close(), "closed";
242
243    my @got = getContent($file1);
244
245    is $got[0], $content[0], "Got 1st entry";
246    ok $got[1] eq $content[1], "Got 2nd entry";
247    is $got[2], $content[2], "Got 3nd entry";
248}
249
250
251SKIP:
252for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2)
253{
254    title "Read a line from zip, Method $method";
255
256    skip "IO::Compress::Bzip2 not available", 14
257        unless defined $IO::Compress::Bzip2::VERSION;
258
259    my $content = "a single line\n";
260    my $zip ;
261
262    my $status = zip \$content => \$zip,
263                    Method => $method,
264                    Stream => 0,
265                    Name => "123";
266    is $status, 1, "  Created a zip file";
267
268    my $u = new IO::Uncompress::Unzip \$zip;
269    isa_ok $u, "IO::Uncompress::Unzip";
270
271    is $u->getline, $content, "  Read first line ok";
272    ok ! $u->getline, "  Second line doesn't exist";
273
274
275}
276