"Fossies" - the Fresh Open Source Software Archive 
Member "perl-5.32.1/cpan/IO-Compress/t/006zip.t" (18 Dec 2020, 10955 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1 BEGIN {
2 if ($ENV{PERL_CORE}) {
3 chdir 't' if -d 't';
4 @INC = ("../lib", "lib/compress");
5 }
6 }
7
8 use lib qw(t t/compress);
9 use strict;
10 use warnings;
11 use bytes;
12
13 use Test::More ;
14 use CompTestUtils;
15
16 BEGIN {
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 => 108 + $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
37 sub 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; $status > 0 ; $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 {
70 title "Create a simple zip - All Deflate";
71
72 my $lex = new LexFile my $file1;
73
74 my @content = (
75 'hello',
76 '',
77 'goodbye ',
78 );
79
80 my $zip = new IO::Compress::Zip $file1,
81 Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
82 isa_ok $zip, "IO::Compress::Zip";
83
84 is $zip->write($content[0]), length($content[0]), "write";
85 $zip->newStream(Name=> "two", Method => ZIP_CM_DEFLATE);
86 is $zip->write($content[1]), length($content[1]), "write";
87 $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
88 is $zip->write($content[2]), length($content[2]), "write";
89 ok $zip->close(), "closed";
90
91 my @got = getContent($file1);
92
93 is $got[0], $content[0], "Got 1st entry";
94 is $got[1], $content[1], "Got 2nd entry";
95 is $got[2], $content[2], "Got 3nd entry";
96 }
97
98 SKIP:
99 {
100 title "Create a simple zip - All Bzip2";
101
102 skip "IO::Compress::Bzip2 not available", 9
103 unless defined $IO::Compress::Bzip2::VERSION;
104
105 my $lex = new LexFile my $file1;
106
107 my @content = (
108 'hello',
109 '',
110 'goodbye ',
111 );
112
113 my $zip = new IO::Compress::Zip $file1,
114 Name => "one", Method => ZIP_CM_BZIP2, Stream => 0;
115 isa_ok $zip, "IO::Compress::Zip";
116
117 is $zip->write($content[0]), length($content[0]), "write";
118 $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
119 is $zip->write($content[1]), length($content[1]), "write";
120 $zip->newStream(Name=> "three", Method => ZIP_CM_BZIP2);
121 is $zip->write($content[2]), length($content[2]), "write";
122 ok $zip->close(), "closed";
123
124 my @got = getContent($file1);
125
126 is $got[0], $content[0], "Got 1st entry";
127 is $got[1], $content[1], "Got 2nd entry";
128 is $got[2], $content[2], "Got 3nd entry";
129 }
130
131 SKIP:
132 {
133 title "Create a simple zip - Deflate + Bzip2";
134
135 skip "IO::Compress::Bzip2 not available", 9
136 unless $IO::Compress::Bzip2::VERSION;
137
138 my $lex = new LexFile my $file1;
139
140 my @content = (
141 'hello',
142 'and',
143 'goodbye ',
144 );
145
146 my $zip = new IO::Compress::Zip $file1,
147 Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
148 isa_ok $zip, "IO::Compress::Zip";
149
150 is $zip->write($content[0]), length($content[0]), "write";
151 $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2);
152 is $zip->write($content[1]), length($content[1]), "write";
153 $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
154 is $zip->write($content[2]), length($content[2]), "write";
155 ok $zip->close(), "closed";
156
157 my @got = getContent($file1);
158
159 is $got[0], $content[0], "Got 1st entry";
160 is $got[1], $content[1], "Got 2nd entry";
161 is $got[2], $content[2], "Got 3nd entry";
162 }
163
164 {
165 title "Create a simple zip - All STORE";
166
167 my $lex = new LexFile my $file1;
168
169 my @content = (
170 'hello',
171 '',
172 'goodbye ',
173 );
174
175 my $zip = new IO::Compress::Zip $file1,
176 Name => "one", Method => ZIP_CM_STORE, Stream => 0;
177 isa_ok $zip, "IO::Compress::Zip";
178
179 is $zip->write($content[0]), length($content[0]), "write";
180 $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
181 is $zip->write($content[1]), length($content[1]), "write";
182 $zip->newStream(Name=> "three", Method => ZIP_CM_STORE);
183 is $zip->write($content[2]), length($content[2]), "write";
184 ok $zip->close(), "closed";
185
186 my @got = getContent($file1);
187
188 is $got[0], $content[0], "Got 1st entry";
189 is $got[1], $content[1], "Got 2nd entry";
190 is $got[2], $content[2], "Got 3nd entry";
191 }
192
193 {
194 title "Create a simple zip - Deflate + STORE";
195
196 my $lex = new LexFile my $file1;
197
198 my @content = qw(
199 hello
200 and
201 goodbye
202 );
203
204 my $zip = new IO::Compress::Zip $file1,
205 Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
206 isa_ok $zip, "IO::Compress::Zip";
207
208 is $zip->write($content[0]), length($content[0]), "write";
209 $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
210 is $zip->write($content[1]), length($content[1]), "write";
211 $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
212 is $zip->write($content[2]), length($content[2]), "write";
213 ok $zip->close(), "closed";
214
215 my @got = getContent($file1);
216
217 is $got[0], $content[0], "Got 1st entry";
218 is $got[1], $content[1], "Got 2nd entry";
219 is $got[2], $content[2], "Got 3nd entry";
220 }
221
222 {
223 title "Create a simple zip - Deflate + zero length STORE";
224
225 my $lex = new LexFile my $file1;
226
227 my @content = (
228 'hello ',
229 '',
230 'goodbye ',
231 );
232
233 my $zip = new IO::Compress::Zip $file1,
234 Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0;
235 isa_ok $zip, "IO::Compress::Zip";
236
237 is $zip->write($content[0]), length($content[0]), "write";
238 $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
239 is $zip->write($content[1]), length($content[1]), "write";
240 $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE);
241 is $zip->write($content[2]), length($content[2]), "write";
242 ok $zip->close(), "closed";
243
244 my @got = getContent($file1);
245
246 is $got[0], $content[0], "Got 1st entry";
247 ok $got[1] eq $content[1], "Got 2nd entry";
248 is $got[2], $content[2], "Got 3nd entry";
249 }
250
251 {
252 title "RT #72548";
253
254 my $lex = new LexFile my $file1;
255
256 my $blockSize = 1024 * 16;
257
258 my @content = (
259 'hello',
260 "x" x ($blockSize + 1)
261 );
262
263 my $zip = new IO::Compress::Zip $file1,
264 Name => "one", Method => ZIP_CM_STORE, Stream => 0;
265 isa_ok $zip, "IO::Compress::Zip";
266
267 is $zip->write($content[0]), length($content[0]), "write";
268
269 $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
270 is $zip->write($content[1]), length($content[1]), "write";
271
272 ok $zip->close(), "closed";
273
274 my @got = getContent($file1, BlockSize => $blockSize);
275
276 is $got[0], $content[0], "Got 1st entry";
277 is $got[1], $content[1], "Got 2nd entry";
278 }
279
280 {
281 title "Zip file with a single zero-length file";
282
283 my $lex = new LexFile my $file1;
284
285
286 my $zip = new IO::Compress::Zip $file1,
287 Name => "one", Method => ZIP_CM_STORE, Stream => 0;
288 isa_ok $zip, "IO::Compress::Zip";
289
290 $zip->newStream(Name=> "two", Method => ZIP_CM_STORE);
291 ok $zip->close(), "closed";
292
293 my @got = getContent($file1);
294
295 is $got[0], "", "no content";
296 is $got[1], "", "no content";
297 }
298
299 SKIP:
300 for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2)
301 {
302 title "Read a line from zip, Method $method";
303
304 skip "IO::Compress::Bzip2 not available", 14
305 unless defined $IO::Compress::Bzip2::VERSION;
306
307 my $content = "a single line\n";
308 my $zip ;
309
310 my $status = zip \$content => \$zip,
311 Method => $method,
312 Stream => 0,
313 Name => "123";
314 is $status, 1, " Created a zip file";
315
316 my $u = new IO::Uncompress::Unzip \$zip;
317 isa_ok $u, "IO::Uncompress::Unzip";
318
319 is $u->getline, $content, " Read first line ok";
320 ok ! $u->getline, " Second line doesn't exist";
321
322
323 }
324
325 {
326 title "isMethodAvailable" ;
327
328 ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available";
329 ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_DEFLATE), "ZIP_CM_DEFLATE available";
330 #ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available";
331
332 ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available";
333 }
334
335 {
336 title "Member & Comment 0";
337
338 my $lex = new LexFile my $file1;
339
340 my $content = 'hello' ;
341
342
343 my $zip = new IO::Compress::Zip $file1,
344 Name => "0", Comment => "0" ;
345 isa_ok $zip, "IO::Compress::Zip";
346
347 is $zip->write($content), length($content), "write";
348
349 ok $zip->close(), "closed";
350
351
352
353 my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_
354 or die "Cannot open $file1: $UnzipError";
355
356 isa_ok $u, "IO::Uncompress::Unzip";
357
358 my $name = $u->getHeaderInfo()->{Name};
359
360 is $u->getHeaderInfo()->{Name}, "0", "Name is '0'";
361 }
362
363
364 {
365 title "nexStream regression";
366 # https://github.com/pmqs/IO-Compress/issues/3
367
368 my $lex = new LexFile my $file1;
369
370 my $content1 = qq["organisation_path","collection_occasion_key","episode_key"\n] ;
371
372 my $zip = new IO::Compress::Zip $file1,
373 Name => "one";
374 isa_ok $zip, "IO::Compress::Zip";
375
376 print $zip $content1;
377
378 $zip->newStream(Name=> "two");
379
380 my $content2 = <<EOM;
381 "key","value"
382 "version","2"
383 "type","PMHC"
384 EOM
385 print $zip $content2;
386
387 ok $zip->close(), "closed";
388
389
390 my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_
391 or die "Cannot open $file1: $UnzipError";
392
393 isa_ok $u, "IO::Uncompress::Unzip";
394
395 my $name = $u->getHeaderInfo()->{Name};
396
397 is $u->getHeaderInfo()->{Name}, "one", "Name is 'one'";
398
399 ok $u->nextStream(), "nextStream OK";
400
401 my $line = <$u>;
402
403 is $line, qq["key","value"\n], "got line 1 from second member";
404 }