proposal [perl #34301]: IO::Socket calls getpeername far too often
[p5sagit/p5-mst-13.2.git] / ext / Compress / Zlib / t / 16oneshot.t
CommitLineData
642e522c 1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use ZlibTestUtils;
9
10BEGIN {
11 plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
12 if $] < 5.005 ;
13
14
15 # use Test::NoWarnings, if available
16 my $extra = 0 ;
17 $extra = 1
18 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
19
20 plan tests => 2526 + $extra ;
21
22 use_ok('Compress::Zlib', 2) ;
23
24 use_ok('IO::Compress::Gzip', qw(gzip $GzipError)) ;
25 use_ok('IO::Uncompress::Gunzip', qw(gunzip $GunzipError)) ;
26
27 use_ok('IO::Compress::Deflate', qw(deflate $DeflateError)) ;
28 use_ok('IO::Uncompress::Inflate', qw(inflate $InflateError)) ;
29
30 use_ok('IO::Compress::RawDeflate', qw(rawdeflate $RawDeflateError)) ;
31 use_ok('IO::Uncompress::RawInflate', qw(rawinflate $RawInflateError)) ;
32
33 use_ok('IO::Uncompress::AnyInflate', qw(anyinflate $AnyInflateError)) ;
34
35}
36
37
38# Check zlib_version and ZLIB_VERSION are the same.
39is Compress::Zlib::zlib_version, ZLIB_VERSION,
40 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
41
42
43
44foreach my $bit ('IO::Compress::Gzip',
45 'IO::Uncompress::Gunzip',
46 'IO::Compress::Deflate',
47 'IO::Uncompress::Inflate',
48 'IO::Compress::RawDeflate',
49 'IO::Uncompress::RawInflate',
50 'IO::Uncompress::AnyInflate',
51 )
52{
53 my $Error = getErrorRef($bit);
54 my $Func = getTopFuncRef($bit);
55 my $TopType = getTopFuncName($bit);
56
57 title "Testing $TopType Error Cases";
58
59 my $a;
60 my $x ;
61
62 eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ;
63 like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), ' Illegal Parameters';
64
65 eval { $a = $Func->() ;} ;
66 like $@, mkErr("^$TopType: expected at least 1 parameters"), ' No Parameters';
67
68 eval { $a = $Func->(\$x, \1) ;} ;
69 like $@, mkErr("^$TopType: output buffer is read-only"), ' Output is read-only' ;
70
71 my $in ;
72 eval { $a = $Func->($in, \$x) ;} ;
73 like $@, mkErr("^$TopType: input filename is undef or null string"),
74 ' Input filename undef' ;
75
76 $in = '';
77 eval { $a = $Func->($in, \$x) ;} ;
78 like $@, mkErr("^$TopType: input filename is undef or null string"),
79 ' Input filename empty' ;
80
81 $in = 'abc';
82 my $lex1 = new LexFile($in) ;
83 writeFile($in, "abc");
84 my $out = $in ;
85 eval { $a = $Func->($in, $out) ;} ;
86 like $@, mkErr("^$TopType: input and output filename are identical"),
87 ' Input and Output filename are the same';
88
89 eval { $a = $Func->(\$in, \$in) ;} ;
90 like $@, mkErr("^$TopType: input and output buffer are identical"),
91 ' Input and Output buffer are the same';
92
93 my $out_file = "abcde.out";
94 my $lex = new LexFile($out_file) ;
95 open OUT, ">$out_file" ;
96 eval { $a = $Func->(\*OUT, \*OUT) ;} ;
97 like $@, mkErr("^$TopType: input and output handle are identical"),
98 ' Input and Output handle are the same';
99
100 close OUT;
101 is -s $out_file, 0, " File zero length" ;
102 {
103 my %x = () ;
104 my $object = bless \%x, "someClass" ;
105
106 # Buffer not a scalar reference
107 #eval { $a = $Func->(\$x, \%x) ;} ;
108 eval { $a = $Func->(\$x, $object) ;} ;
109 like $@, mkErr("^$TopType: illegal output parameter"),
110 ' Bad Output Param';
111
112
113 #eval { $a = $Func->(\%x, \$x) ;} ;
114 eval { $a = $Func->($object, \$x) ;} ;
115 like $@, mkErr("^$TopType: illegal input parameter"),
116 ' Bad Input Param';
117 }
118
119 my $filename = 'abc.def';
120 ok ! -e $filename, " input file '$filename' does not exist";
121 $a = $Func->($filename, \$x) ;
122 is $a, undef, " $TopType returned undef";
123 like $$Error, "/^input file '$filename' does not exist\$/", " input File '$filename' does not exist";
124
125 $filename = '/tmp/abd/abc.def';
126 ok ! -e $filename, " output File '$filename' does not exist";
127 $a = $Func->(\$x, $filename) ;
128 is $a, undef, " $TopType returned undef";
129 like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), " output File '$filename' does not exist";
130
131 $a = $Func->(\$x, '<abc>') ;
132 is $a, undef, " $TopType returned undef";
133 like $$Error, "/Need input fileglob for outout fileglob/",
134 ' Output fileglob with no input fileglob';
135
136 $a = $Func->('<abc)>', '<abc>') ;
137 is $a, undef, " $TopType returned undef";
138 like $$Error, "/Unmatched \\) in input fileglob/",
139 " Unmatched ) in input fileglob";
140}
141
142foreach my $bit ('IO::Uncompress::Gunzip',
143 'IO::Uncompress::Inflate',
144 'IO::Uncompress::RawInflate',
145 'IO::Uncompress::AnyInflate',
146 )
147{
148 my $Error = getErrorRef($bit);
149 my $Func = getTopFuncRef($bit);
150 my $TopType = getTopFuncName($bit);
151
152 my $data = "mary had a little lamb" ;
153 my $keep = $data ;
154
155 for my $trans ( 0, 1)
156 {
157 title "Non-compressed data with $TopType, Transparent => $trans ";
158 my $a;
159 my $x ;
160 my $out = '' ;
161
162 $a = $Func->(\$data, \$out, Transparent => $trans) ;
163
164 is $data, $keep, " Input buffer not changed" ;
165
166 if ($trans)
167 {
168 ok $a, " $TopType returned true" ;
169 is $out, $data, " got expected output" ;
170 ok ! $$Error, " no error [$$Error]" ;
171 }
172 else
173 {
174 ok ! $a, " $TopType returned false" ;
175 #like $$Error, '/xxx/', " error" ;
176 ok $$Error, " error is '$$Error'" ;
177 }
178 }
179}
180
181foreach my $bit ('IO::Compress::Gzip',
182 'IO::Compress::Deflate',
183 'IO::Compress::RawDeflate',
184 )
185{
186 my $Error = getErrorRef($bit);
187 my $Func = getTopFuncRef($bit);
188 my $TopType = getTopFuncName($bit);
189 my $TopTypeInverse = getInverse($bit);
190 my $FuncInverse = getTopFuncRef($TopTypeInverse);
191 my $ErrorInverse = getErrorRef($TopTypeInverse);
192
193 title "$TopTypeInverse - corrupt data";
194
195 my $data = "abcd" x 100 ;
196 my $out;
197
198 ok $Func->(\$data, \$out), " $TopType ok";
199
200 # corrupt the compressed data
201 substr($out, -10, 10) = "x" x 10 ;
202
203 my $result;
204 ok ! $FuncInverse->(\$out => \$result, Transparent => 0), " $TopTypeInverse ok";
205 ok $$ErrorInverse, " Got error '$$ErrorInverse'" ;
206
207 #is $result, $data, " data ok";
208
209 ok ! anyinflate(\$out => \$result, Transparent => 0), " anyinflate ok";
210 ok $AnyInflateError, " Got error '$AnyInflateError'" ;
211}
212
213
214foreach my $bit ('IO::Compress::Gzip',
215 'IO::Compress::Deflate',
216 'IO::Compress::RawDeflate',
217 )
218{
219 my $Error = getErrorRef($bit);
220 my $Func = getTopFuncRef($bit);
221 my $TopType = getTopFuncName($bit);
222 my $TopTypeInverse = getInverse($bit);
223 my $FuncInverse = getTopFuncRef($TopTypeInverse);
224
225 for my $append ( 1, 0 )
226 {
227 my $already = '';
228 $already = 'abcde' if $append ;
229
230 for my $buffer ( undef, '', "abcde" )
231 {
232
233 my $disp_content = defined $buffer ? $buffer : '<undef>' ;
234
235 my $keep = $buffer;
236 my $out_file = "abcde.out";
237 my $in_file = "abcde.in";
238
239 {
240 title "$TopType - From Buff to Buff content '$disp_content' Append $append" ;
241
242 my $output = $already;
243 ok &$Func(\$buffer, \$output, Append => $append), ' Compressed ok' ;
244
245 is $keep, $buffer, " Input buffer not changed" ;
246 my $got = anyUncompress(\$output, $already);
247 $got = undef if ! defined $buffer && $got eq '' ;
248 is $got, $buffer, " Uncompressed matches original";
249
250 }
251
252 {
253 title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ;
254
255 my @output = ('first') ;
256 ok &$Func(\$buffer, \@output, Append => $append), ' Compressed ok' ;
257
258 is $output[0], 'first', " Array[0] unchanged";
259 is $keep, $buffer, " Input buffer not changed" ;
260 my $got = anyUncompress($output[1]);
261 $got = undef if ! defined $buffer && $got eq '' ;
262 is $got, $buffer, " Uncompressed matches original";
263 }
264
265 {
266 title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ;
267
268 my @output = ('first') ;
269 my @input = ( \$buffer);
270 ok &$Func(\@input, \@output, Append => $append), ' Compressed ok' ;
271
272 is $output[0], 'first', " Array[0] unchanged";
273 is $keep, $buffer, " Input buffer not changed" ;
274 my $got = anyUncompress($output[1]);
275 $got = undef if ! defined $buffer && $got eq '' ;
276 is $got, $buffer, " Uncompressed matches original";
277
278 }
279
280 {
281 title "$TopType - From Buff to Filename content '$disp_content' Append $append" ;
282
283 my $lex = new LexFile($out_file) ;
284 ok ! -e $out_file, " Output file does not exist";
285 writeFile($out_file, $already);
286
287 ok &$Func(\$buffer, $out_file, Append => $append), ' Compressed ok' ;
288
289 ok -e $out_file, " Created output file";
290 my $got = anyUncompress($out_file, $already);
291 $got = undef if ! defined $buffer && $got eq '' ;
292 is $got, $buffer, " Uncompressed matches original";
293 }
294
295 {
296 title "$TopType - From Buff to Handle content '$disp_content' Append $append" ;
297
298 my $lex = new LexFile($out_file) ;
299
300 ok ! -e $out_file, " Output file does not exist";
301 writeFile($out_file, $already);
302 my $of = new IO::File ">>$out_file" ;
303 ok $of, " Created output filehandle" ;
304
305 ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), ' Compressed ok' ;
306
307 ok -e $out_file, " Created output file";
308 my $got = anyUncompress($out_file, $already);
309 $got = undef if ! defined $buffer && $got eq '' ;
310 is $got, $buffer, " Uncompressed matches original";
311 }
312
313
314 {
315 title "$TopType - From Filename to Filename content '$disp_content' Append $append" ;
316
317 my $lex = new LexFile($in_file, $out_file) ;
318 writeFile($in_file, $buffer);
319
320 ok ! -e $out_file, " Output file does not exist";
321 writeFile($out_file, $already);
322
323 ok &$Func($in_file => $out_file, Append => $append), ' Compressed ok' ;
324
325 ok -e $out_file, " Created output file";
326 my $got = anyUncompress($out_file, $already);
327 $got = undef if ! defined $buffer && $got eq '' ;
328 is $got, $buffer, " Uncompressed matches original";
329
330 }
331
332 {
333 title "$TopType - From Filename to Handle content '$disp_content' Append $append" ;
334
335 my $lex = new LexFile($in_file, $out_file) ;
336 writeFile($in_file, $buffer);
337
338 ok ! -e $out_file, " Output file does not exist";
339 writeFile($out_file, $already);
340 my $out = new IO::File ">>$out_file" ;
341
342 ok &$Func($in_file, $out, AutoClose => 1, Append => $append), ' Compressed ok' ;
343
344 ok -e $out_file, " Created output file";
345 my $got = anyUncompress($out_file, $already);
346 $got = undef if ! defined $buffer && $got eq '' ;
347 is $got, $buffer, " Uncompressed matches original";
348
349 }
350
351 {
352 title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ;
353
354 my $lex = new LexFile($in_file, $out_file) ;
355 writeFile($in_file, $buffer);
356
357 my $out = $already;
358
359 ok &$Func($in_file => \$out, Append => $append), ' Compressed ok' ;
360
361 my $got = anyUncompress(\$out, $already);
362 $got = undef if ! defined $buffer && $got eq '' ;
363 is $got, $buffer, " Uncompressed matches original";
364
365 }
366
367 {
368 title "$TopType - From Handle to Filename content '$disp_content' Append $append" ;
369
370 my $lex = new LexFile($in_file, $out_file) ;
371 writeFile($in_file, $buffer);
372 my $in = new IO::File "<$in_file" ;
373
374 ok ! -e $out_file, " Output file does not exist";
375 writeFile($out_file, $already);
376
377 ok &$Func($in, $out_file, Append => $append), ' Compressed ok'
378 or diag "error is $GzipError" ;
379
380 ok -e $out_file, " Created output file";
381 my $got = anyUncompress($out_file, $already);
382 $got = undef if ! defined $buffer && $got eq '' ;
383 is $buffer, $got, " Uncompressed matches original";
384
385 }
386
387 {
388 title "$TopType - From Handle to Handle content '$disp_content' Append $append" ;
389
390 my $lex = new LexFile($in_file, $out_file) ;
391 writeFile($in_file, $buffer);
392 my $in = new IO::File "<$in_file" ;
393
394 ok ! -e $out_file, " Output file does not exist";
395 writeFile($out_file, $already);
396 my $out = new IO::File ">>$out_file" ;
397
398 ok &$Func($in, $out, AutoClose => 1, Append => $append), ' Compressed ok' ;
399
400 ok -e $out_file, " Created output file";
401 my $got = anyUncompress($out_file, $already);
402 $got = undef if ! defined $buffer && $got eq '' ;
403 is $buffer, $got, " Uncompressed matches original";
404
405 }
406
407 {
408 title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ;
409
410 my $lex = new LexFile($in_file, $out_file) ;
411 writeFile($in_file, $buffer);
412 my $in = new IO::File "<$in_file" ;
413
414 my $out = $already ;
415
416 ok &$Func($in, \$out, Append => $append), ' Compressed ok' ;
417
418 my $got = anyUncompress(\$out, $already);
419 $got = undef if ! defined $buffer && $got eq '' ;
420 is $buffer, $got, " Uncompressed matches original";
421
422 }
423
424 {
425 title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ;
426
427 my $lex = new LexFile($in_file, $out_file) ;
428 writeFile($in_file, $buffer);
429
430 open(SAVEIN, "<&STDIN");
431 my $dummy = fileno SAVEIN ;
432 ok open(STDIN, "<$in_file"), " redirect STDIN";
433
434 my $out = $already;
435
436 ok &$Func('-', \$out, Append => $append), ' Compressed ok'
437 or diag $$Error ;
438
439 open(STDIN, "<&SAVEIN");
440
441 my $got = anyUncompress(\$out, $already);
442 $got = undef if ! defined $buffer && $got eq '' ;
443 is $buffer, $got, " Uncompressed matches original";
444
445 }
446
447 }
448 }
449}
450
451foreach my $bit ('IO::Compress::Gzip',
452 'IO::Compress::Deflate',
453 'IO::Compress::RawDeflate',
454 )
455{
456 my $Error = getErrorRef($bit);
457 my $Func = getTopFuncRef($bit);
458 my $TopType = getTopFuncName($bit);
459
460 my $TopTypeInverse = getInverse($bit);
461 my $FuncInverse = getTopFuncRef($TopTypeInverse);
462
463 my ($file1, $file2) = ("file1", "file2");
464 my $lex = new LexFile($file1, $file2) ;
465
466 writeFile($file1, "data1");
467 writeFile($file2, "data2");
468 my $of = new IO::File "<$file1" ;
469 ok $of, " Created output filehandle" ;
470
471 my @input = ( undef, "", $file2, \undef, \'', \"abcde", $of) ;
472 my @expected = ("", "", $file2, "", "", "abcde", "data1");
473 my @uexpected = ("", "", "data2", "", "", "abcde", "data1");
474
475 my @keep = @input ;
476
477 {
478 title "$TopType - From Array Ref to Array Ref" ;
479
480 my @output = ('first') ;
481 ok &$Func(\@input, \@output, AutoClose => 0), ' Compressed ok' ;
482
483 is $output[0], 'first', " Array[0] unchanged";
484
485 is_deeply \@input, \@keep, " Input array not changed" ;
486 my @got = shift @output;
487 foreach (@output) { push @got, anyUncompress($_) }
488
489 is_deeply \@got, ['first', @expected], " Got Expected uncompressed data";
490
491 }
492
493 {
494 title "$TopType - From Array Ref to Buffer" ;
495
496 # rewind the filehandle
497 $of->open("<$file1") ;
498
499 my $output ;
500 ok &$Func(\@input, \$output, AutoClose => 0), ' Compressed ok' ;
501
502 my $got = anyUncompress(\$output);
503
504 is $got, join('', @expected), " Got Expected uncompressed data";
505 }
506
507 {
508 title "$TopType - From Array Ref to Filename" ;
509
510 my ($file3) = ("file3");
511 my $lex = new LexFile($file3) ;
512
513 # rewind the filehandle
514 $of->open("<$file1") ;
515
516 my $output ;
517 ok &$Func(\@input, $file3, AutoClose => 0), ' Compressed ok' ;
518
519 my $got = anyUncompress($file3);
520
521 is $got, join('', @expected), " Got Expected uncompressed data";
522 }
523
524 {
525 title "$TopType - From Array Ref to Filehandle" ;
526
527 my ($file3) = ("file3");
528 my $lex = new LexFile($file3) ;
529
530 my $fh3 = new IO::File ">$file3";
531
532 # rewind the filehandle
533 $of->open("<$file1") ;
534
535 my $output ;
536 ok &$Func(\@input, $fh3, AutoClose => 0), ' Compressed ok' ;
537
538 $fh3->close();
539
540 my $got = anyUncompress($file3);
541
542 is $got, join('', @expected), " Got Expected uncompressed data";
543 }
544}
545
546foreach my $bit ('IO::Compress::Gzip',
547 'IO::Compress::Deflate',
548 'IO::Compress::RawDeflate',
549 )
550{
551 my $Error = getErrorRef($bit);
552 my $Func = getTopFuncRef($bit);
553 my $TopType = getTopFuncName($bit);
554
555 my $TopTypeInverse = getInverse($bit);
556 my $FuncInverse = getTopFuncRef($TopTypeInverse);
557
558 my @inFiles = map { "in$_.tmp" } 1..4;
559 my @outFiles = map { "out$_.tmp" } 1..4;
560 my $lex = new LexFile(@inFiles, @outFiles);
561
562 writeFile($_, "data $_") foreach @inFiles ;
563
564 {
565 title "$TopType - Hash Ref: to filename" ;
566
567 my $output ;
568 ok &$Func( { $inFiles[0] => $outFiles[0],
569 $inFiles[1] => $outFiles[1],
570 $inFiles[2] => $outFiles[2] } ), ' Compressed ok' ;
571
572 foreach (0 .. 2)
573 {
574 my $got = anyUncompress($outFiles[$_]);
575 is $got, "data $inFiles[$_]", " Uncompressed $_ matches original";
576 }
577 }
578
579 {
580 title "$TopType - Hash Ref: to buffer" ;
581
582 my @buffer ;
583 ok &$Func( { $inFiles[0] => \$buffer[0],
584 $inFiles[1] => \$buffer[1],
585 $inFiles[2] => \$buffer[2] } ), ' Compressed ok' ;
586
587 foreach (0 .. 2)
588 {
589 my $got = anyUncompress(\$buffer[$_]);
590 is $got, "data $inFiles[$_]", " Uncompressed $_ matches original";
591 }
592 }
593
594 {
595 title "$TopType - Hash Ref: to undef" ;
596
597 my @buffer ;
598 my %hash = ( $inFiles[0] => undef,
599 $inFiles[1] => undef,
600 $inFiles[2] => undef,
601 );
602
603 ok &$Func( \%hash ), ' Compressed ok' ;
604
605 foreach (keys %hash)
606 {
607 my $got = anyUncompress(\$hash{$_});
608 is $got, "data $_", " Uncompressed $_ matches original";
609 }
610 }
611
612 {
613 title "$TopType - Filename to Hash Ref" ;
614
615 my %output ;
616 ok &$Func( $inFiles[0] => \%output), ' Compressed ok' ;
617
618 is keys %output, 1, " one pair in hash" ;
619 my ($k, $v) = each %output;
620 is $k, $inFiles[0], " key is '$inFiles[0]'";
621 my $got = anyUncompress($v);
622 is $got, "data $inFiles[0]", " Uncompressed matches original";
623 }
624
625 {
626 title "$TopType - File Glob to Hash Ref" ;
627
628 my %output ;
629 ok &$Func( '<in*.tmp>' => \%output), ' Compressed ok' ;
630
631 is keys %output, 4, " four pairs in hash" ;
632 foreach my $fil (@inFiles)
633 {
634 ok exists $output{$fil}, " key '$fil' exists" ;
635 my $got = anyUncompress($output{$fil});
636 is $got, "data $fil", " Uncompressed matches original";
637 }
638 }
639
640
641# if (0)
642# {
643# title "$TopType - Hash Ref to Array Ref" ;
644#
645# my @output = ('first') ;
646# ok &$Func( { \@input, \@output } , AutoClose => 0), ' Compressed ok' ;
647#
648# is $output[0], 'first', " Array[0] unchanged";
649#
650# is_deeply \@input, \@keep, " Input array not changed" ;
651# my @got = shift @output;
652# foreach (@output) { push @got, anyUncompress($_) }
653#
654# is_deeply \@got, ['first', @expected], " Got Expected uncompressed data";
655#
656# }
657#
658# if (0)
659# {
660# title "$TopType - From Array Ref to Buffer" ;
661#
662# # rewind the filehandle
663# $of->open("<$file1") ;
664#
665# my $output ;
666# ok &$Func(\@input, \$output, AutoClose => 0), ' Compressed ok' ;
667#
668# my $got = anyUncompress(\$output);
669#
670# is $got, join('', @expected), " Got Expected uncompressed data";
671# }
672#
673# if (0)
674# {
675# title "$TopType - From Array Ref to Filename" ;
676#
677# my ($file3) = ("file3");
678# my $lex = new LexFile($file3) ;
679#
680# # rewind the filehandle
681# $of->open("<$file1") ;
682#
683# my $output ;
684# ok &$Func(\@input, $file3, AutoClose => 0), ' Compressed ok' ;
685#
686# my $got = anyUncompress($file3);
687#
688# is $got, join('', @expected), " Got Expected uncompressed data";
689# }
690#
691# if (0)
692# {
693# title "$TopType - From Array Ref to Filehandle" ;
694#
695# my ($file3) = ("file3");
696# my $lex = new LexFile($file3) ;
697#
698# my $fh3 = new IO::File ">$file3";
699#
700# # rewind the filehandle
701# $of->open("<$file1") ;
702#
703# my $output ;
704# ok &$Func(\@input, $fh3, AutoClose => 0), ' Compressed ok' ;
705#
706# $fh3->close();
707#
708# my $got = anyUncompress($file3);
709#
710# is $got, join('', @expected), " Got Expected uncompressed data";
711# }
712}
713
714foreach my $bit ('IO::Compress::Gzip',
715 'IO::Compress::Deflate',
716 'IO::Compress::RawDeflate',
717 )
718{
719 my $Error = getErrorRef($bit);
720 my $Func = getTopFuncRef($bit);
721 my $TopType = getTopFuncName($bit);
722
723 for my $files ( [qw(a1)], [qw(a1 a2 a3)] )
724 {
725
726 my $tmpDir1 = 'tmpdir1';
727 my $tmpDir2 = 'tmpdir2';
728 my $lex = new LexDir($tmpDir1, $tmpDir2) ;
729
730 mkdir $tmpDir1, 0777;
731 mkdir $tmpDir2, 0777;
732
733 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
734 #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
735
736 my @files = map { "$tmpDir1/$_.tmp" } @$files ;
737 foreach (@files) { writeFile($_, "abc $_") }
738
739 my @expected = map { "abc $_" } @files ;
740 my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
741
742 {
743 title "$TopType - From FileGlob to FileGlob files [@$files]" ;
744
745 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok'
746 or diag $$Error ;
747
748 my @copy = @expected;
749 for my $file (@outFiles)
750 {
751 is anyUncompress($file), shift @copy, " got expected from $file" ;
752 }
753
754 is @copy, 0, " got all files";
755 }
756
757 {
758 title "$TopType - From FileGlob to Array files [@$files]" ;
759
760 my @buffer = ('first') ;
761 ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok'
762 or diag $$Error ;
763
764 is shift @buffer, 'first';
765
766 my @copy = @expected;
767 for my $buffer (@buffer)
768 {
769 is anyUncompress($buffer), shift @copy, " got expected " ;
770 }
771
772 is @copy, 0, " got all files";
773 }
774
775 {
776 title "$TopType - From FileGlob to Buffer files [@$files]" ;
777
778 my $buffer ;
779 ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer), ' Compressed ok'
780 or diag $$Error ;
781
782 #hexDump(\$buffer);
783
784 my $got = anyUncompress([ \$buffer, MultiStream => 1 ]);
785
786 is $got, join("", @expected), " got expected" ;
787 }
788
789 {
790 title "$TopType - From FileGlob to Filename files [@$files]" ;
791
792 my $filename = "abcde";
793 my $lex = new LexFile($filename) ;
794
795 ok &$Func("<$tmpDir1/a*.tmp>" => $filename), ' Compressed ok'
796 or diag $$Error ;
797
798 #hexDump(\$buffer);
799
800 my $got = anyUncompress([$filename, MultiStream => 1]);
801
802 is $got, join("", @expected), " got expected" ;
803 }
804
805 {
806 title "$TopType - From FileGlob to Filehandle files [@$files]" ;
807
808 my $filename = "abcde";
809 my $lex = new LexFile($filename) ;
810 my $fh = new IO::File ">$filename";
811
812 ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1), ' Compressed ok'
813 or diag $$Error ;
814
815 #hexDump(\$buffer);
816
817 my $got = anyUncompress([$filename, MultiStream => 1]);
818
819 is $got, join("", @expected), " got expected" ;
820 }
821 }
822
823}
824
825foreach my $bit ('IO::Uncompress::Gunzip',
826 'IO::Uncompress::Inflate',
827 'IO::Uncompress::RawInflate',
828 'IO::Uncompress::AnyInflate',
829 )
830{
831 my $Error = getErrorRef($bit);
832 my $Func = getTopFuncRef($bit);
833 my $TopType = getTopFuncName($bit);
834
835 my $buffer = "abcde" ;
836 my $buffer2 = "ABCDE" ;
837 my $keep_orig = $buffer;
838
839 my $comp = compressBuffer($TopType, $buffer) ;
840 my $comp2 = compressBuffer($TopType, $buffer2) ;
841 my $keep_comp = $comp;
842
843 my $incumbent = "incumbent data" ;
844
845 for my $append (0, 1)
846 {
847 my $expected = $buffer ;
848 $expected = $incumbent . $buffer if $append ;
849
850 {
851 title "$TopType - From Buff to Buff, Append($append)" ;
852
853 my $output ;
854 $output = $incumbent if $append ;
855 ok &$Func(\$comp, \$output, Append => $append), ' Uncompressed ok' ;
856
857 is $keep_comp, $comp, " Input buffer not changed" ;
858 is $output, $expected, " Uncompressed matches original";
859 }
860
861 {
862 title "$TopType - From Buff to Array, Append($append)" ;
863
864 my @output = ('first');
865 #$output = $incumbent if $append ;
866 ok &$Func(\$comp, \@output, Append => $append), ' Uncompressed ok' ;
867
868 is $keep_comp, $comp, " Input buffer not changed" ;
869 is $output[0], 'first', " Uncompressed matches original";
870 is ${ $output[1] }, $buffer, " Uncompressed matches original"
871 or diag $output[1] ;
872 is @output, 2, " only 2 elements in the array" ;
873 }
874
875 {
876 title "$TopType - From Buff to Filename, Append($append)" ;
877
878 my $out_file = "abcde";
879 my $lex = new LexFile($out_file) ;
880 if ($append)
881 { writeFile($out_file, $incumbent) }
882 else
883 { ok ! -e $out_file, " Output file does not exist" }
884
885 ok &$Func(\$comp, $out_file, Append => $append), ' Uncompressed ok' ;
886
887 ok -e $out_file, " Created output file";
888 my $content = readFile($out_file) ;
889
890 is $keep_comp, $comp, " Input buffer not changed" ;
891 is $content, $expected, " Uncompressed matches original";
892 }
893
894 {
895 title "$TopType - From Buff to Handle, Append($append)" ;
896
897 my $out_file = "abcde";
898 my $lex = new LexFile($out_file) ;
899 my $of ;
900 if ($append) {
901 writeFile($out_file, $incumbent) ;
902 $of = new IO::File "+< $out_file" ;
903 }
904 else {
905 ok ! -e $out_file, " Output file does not exist" ;
906 $of = new IO::File "> $out_file" ;
907 }
908 isa_ok $of, 'IO::File', ' $of' ;
909
910 ok &$Func(\$comp, $of, Append => $append, AutoClose => 1), ' Uncompressed ok' ;
911
912 ok -e $out_file, " Created output file";
913 my $content = readFile($out_file) ;
914
915 is $keep_comp, $comp, " Input buffer not changed" ;
916 is $content, $expected, " Uncompressed matches original";
917 }
918
919 {
920 title "$TopType - From Filename to Filename, Append($append)" ;
921
922 my $out_file = "abcde.out";
923 my $in_file = "abcde.in";
924 my $lex = new LexFile($in_file, $out_file) ;
925 if ($append)
926 { writeFile($out_file, $incumbent) }
927 else
928 { ok ! -e $out_file, " Output file does not exist" }
929
930 writeFile($in_file, $comp);
931
932 ok &$Func($in_file, $out_file, Append => $append), ' Uncompressed ok' ;
933
934 ok -e $out_file, " Created output file";
935 my $content = readFile($out_file) ;
936
937 is $keep_comp, $comp, " Input buffer not changed" ;
938 is $content, $expected, " Uncompressed matches original";
939 }
940
941 {
942 title "$TopType - From Filename to Handle, Append($append)" ;
943
944 my $out_file = "abcde.out";
945 my $in_file = "abcde.in";
946 my $lex = new LexFile($in_file, $out_file) ;
947 my $out ;
948 if ($append) {
949 writeFile($out_file, $incumbent) ;
950 $out = new IO::File "+< $out_file" ;
951 }
952 else {
953 ok ! -e $out_file, " Output file does not exist" ;
954 $out = new IO::File "> $out_file" ;
955 }
956 isa_ok $out, 'IO::File', ' $out' ;
957
958 writeFile($in_file, $comp);
959
960 ok &$Func($in_file, $out, Append => $append, AutoClose => 1), ' Uncompressed ok' ;
961
962 ok -e $out_file, " Created output file";
963 my $content = readFile($out_file) ;
964
965 is $keep_comp, $comp, " Input buffer not changed" ;
966 is $content, $expected, " Uncompressed matches original";
967 }
968
969 {
970 title "$TopType - From Filename to Buffer, Append($append)" ;
971
972 my $in_file = "abcde.in";
973 my $lex = new LexFile($in_file) ;
974 writeFile($in_file, $comp);
975
976 my $output ;
977 $output = $incumbent if $append ;
978
979 ok &$Func($in_file, \$output, Append => $append), ' Uncompressed ok' ;
980
981 is $keep_comp, $comp, " Input buffer not changed" ;
982 is $output, $expected, " Uncompressed matches original";
983 }
984
985 {
986 title "$TopType - From Handle to Filename, Append($append)" ;
987
988 my $out_file = "abcde.out";
989 my $in_file = "abcde.in";
990 my $lex = new LexFile($in_file, $out_file) ;
991 if ($append)
992 { writeFile($out_file, $incumbent) }
993 else
994 { ok ! -e $out_file, " Output file does not exist" }
995
996 writeFile($in_file, $comp);
997 my $in = new IO::File "<$in_file" ;
998
999 ok &$Func($in, $out_file, Append => $append), ' Uncompressed ok' ;
1000
1001 ok -e $out_file, " Created output file";
1002 my $content = readFile($out_file) ;
1003
1004 is $keep_comp, $comp, " Input buffer not changed" ;
1005 is $content, $expected, " Uncompressed matches original";
1006 }
1007
1008 {
1009 title "$TopType - From Handle to Handle, Append($append)" ;
1010
1011 my $out_file = "abcde.out";
1012 my $in_file = "abcde.in";
1013 my $lex = new LexFile($in_file, $out_file) ;
1014 my $out ;
1015 if ($append) {
1016 writeFile($out_file, $incumbent) ;
1017 $out = new IO::File "+< $out_file" ;
1018 }
1019 else {
1020 ok ! -e $out_file, " Output file does not exist" ;
1021 $out = new IO::File "> $out_file" ;
1022 }
1023 isa_ok $out, 'IO::File', ' $out' ;
1024
1025 writeFile($in_file, $comp);
1026 my $in = new IO::File "<$in_file" ;
1027
1028 ok &$Func($in, $out, Append => $append, AutoClose => 1), ' Uncompressed ok' ;
1029
1030 ok -e $out_file, " Created output file";
1031 my $content = readFile($out_file) ;
1032
1033 is $keep_comp, $comp, " Input buffer not changed" ;
1034 is $content, $expected, " Uncompressed matches original";
1035 }
1036
1037 {
1038 title "$TopType - From Filename to Buffer, Append($append)" ;
1039
1040 my $in_file = "abcde.in";
1041 my $lex = new LexFile($in_file) ;
1042 writeFile($in_file, $comp);
1043 my $in = new IO::File "<$in_file" ;
1044
1045 my $output ;
1046 $output = $incumbent if $append ;
1047
1048 ok &$Func($in, \$output, Append => $append), ' Uncompressed ok' ;
1049
1050 is $keep_comp, $comp, " Input buffer not changed" ;
1051 is $output, $expected, " Uncompressed matches original";
1052 }
1053
1054 {
1055 title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ;
1056
1057 my $in_file = "abcde.in";
1058 my $lex = new LexFile($in_file) ;
1059 writeFile($in_file, $comp);
1060
1061 ok open(SAVEIN, "<&STDIN"), " save STDIN";
1062 my $dummy = fileno SAVEIN ;
1063 ok open(STDIN, "<$in_file"), " redirect STDIN";
1064
1065 my $output ;
1066 $output = $incumbent if $append ;
1067
1068 ok &$Func('-', \$output, Append => $append), ' Uncompressed ok'
1069 or diag $$Error ;
1070
1071 ok open(STDIN, "<&SAVEIN"), " put STDIN back";
1072
1073 is $keep_comp, $comp, " Input buffer not changed" ;
1074 is $output, $expected, " Uncompressed matches original";
1075 }
1076 }
1077
1078 {
1079 title "$TopType - From Handle to Buffer, InputLength" ;
1080
1081 my $out_file = "abcde.out";
1082 my $in_file = "abcde.in";
1083 my $lex = new LexFile($in_file, $out_file) ;
1084 my $out ;
1085
1086 my $expected = $buffer ;
1087 my $appended = 'appended';
1088 my $len_appended = length $appended;
1089 writeFile($in_file, $comp . $appended . $comp . $appended) ;
1090 my $in = new IO::File "<$in_file" ;
1091
1092 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), ' Uncompressed ok' ;
1093
1094 is $out, $expected, " Uncompressed matches original";
1095
1096 my $buff;
1097 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok";
1098 is $buff, $appended, " Appended data ok";
1099
1100 $out = '';
1101 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), ' Uncompressed ok' ;
1102
1103 is $out, $expected, " Uncompressed matches original";
1104
1105 $buff = '';
1106 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok";
1107 is $buff, $appended, " Appended data ok";
1108 }
1109
1110 for my $stdin ('-', *STDIN) # , \*STDIN)
1111 {
1112 title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ;
1113
1114 my $in_file = "abcde.in";
1115 my $lex = new LexFile($in_file) ;
1116 my $expected = $buffer ;
1117 my $appended = 'appended';
1118 my $len_appended = length $appended;
1119 writeFile($in_file, $comp . $appended . $comp . $appended) ;
1120
1121 ok open(SAVEIN, "<&STDIN"), " save STDIN";
1122 my $dummy = fileno SAVEIN ;
1123 ok open(STDIN, "<$in_file"), " redirect STDIN";
1124
1125 my $output ;
1126
1127 ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp), ' Uncompressed ok'
1128 or diag $$Error ;
1129
1130 my $buff ;
1131 is read(STDIN, $buff, $len_appended), $len_appended, " Length of Appended data ok";
1132
1133 is $output, $expected, " Uncompressed matches original";
1134 is $buff, $appended, " Appended data ok";
1135
1136 $output = '';
1137 ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp), ' Uncompressed ok'
1138 or diag $$Error ;
1139
1140 $buff = '';
1141 is read(STDIN, $buff, $len_appended), $len_appended, " Length of Appended data ok"
1142 or diag "read failed $!";
1143
1144 is $output, $expected, " Uncompressed matches original";
1145 is $buff, $appended, " Appended data ok";
1146
1147 ok open(STDIN, "<&SAVEIN"), " put STDIN back";
1148 }
1149}
1150
1151foreach my $bit ('IO::Uncompress::Gunzip',
1152 'IO::Uncompress::Inflate',
1153 'IO::Uncompress::RawInflate',
1154 'IO::Uncompress::AnyInflate',
1155 )
1156{
1157 # TODO -- Add Append mode tests
1158
1159 my $Error = getErrorRef($bit);
1160 my $Func = getTopFuncRef($bit);
1161 my $TopType = getTopFuncName($bit);
1162
1163 my $buffer = "abcde" ;
1164 my $keep_orig = $buffer;
1165
1166
1167 my $null = compressBuffer($TopType, "") ;
1168 my $undef = compressBuffer($TopType, undef) ;
1169 my $comp = compressBuffer($TopType, $buffer) ;
1170 my $keep_comp = $comp;
1171
1172 my $incumbent = "incumbent data" ;
1173
1174 my ($file1, $file2) = ("file1", "file2");
1175 my $lex = new LexFile($file1, $file2) ;
1176
1177 writeFile($file1, compressBuffer($TopType,"data1"));
1178 writeFile($file2, compressBuffer($TopType,"data2"));
1179
1180 my $of = new IO::File "<$file1" ;
1181 ok $of, " Created output filehandle" ;
1182
1183 my @input = ($file2, \$undef, \$null, \$comp, $of) ;
1184 my @expected = ('data2', '', '', 'abcde', 'data1');
1185
1186 my @keep = @input ;
1187
1188 {
1189 title "$TopType - From ArrayRef to Buffer" ;
1190
1191 my $output ;
1192 ok &$Func(\@input, \$output, AutoClose => 0), ' UnCompressed ok' ;
1193
1194 is $output, join('', @expected)
1195 }
1196
1197 {
1198 title "$TopType - From ArrayRef to Filename" ;
1199
1200 my $output = 'abc';
1201 my $lex = new LexFile $output;
1202 $of->open("<$file1") ;
1203
1204 ok &$Func(\@input, $output, AutoClose => 0), ' UnCompressed ok' ;
1205
1206 is readFile($output), join('', @expected)
1207 }
1208
1209 {
1210 title "$TopType - From ArrayRef to Filehandle" ;
1211
1212 my $output = 'abc';
1213 my $lex = new LexFile $output;
1214 my $fh = new IO::File ">$output" ;
1215 $of->open("<$file1") ;
1216
1217 ok &$Func(\@input, $fh, AutoClose => 0), ' UnCompressed ok' ;
1218 $fh->close;
1219
1220 is readFile($output), join('', @expected)
1221 }
1222
1223 {
1224 title "$TopType - From Array Ref to Array Ref" ;
1225
1226 my @output = (\'first') ;
1227 $of->open("<$file1") ;
1228 ok &$Func(\@input, \@output, AutoClose => 0), ' UnCompressed ok' ;
1229
1230 is_deeply \@input, \@keep, " Input array not changed" ;
1231 is_deeply [map { defined $$_ ? $$_ : "" } @output],
1232 ['first', @expected],
1233 " Got Expected uncompressed data";
1234
1235 }
1236}
1237
1238foreach my $bit ('IO::Uncompress::Gunzip',
1239 'IO::Uncompress::Inflate',
1240 'IO::Uncompress::RawInflate',
1241 'IO::Uncompress::AnyInflate',
1242 )
1243{
1244 # TODO -- Add Append mode tests
1245
1246 my $Error = getErrorRef($bit);
1247 my $Func = getTopFuncRef($bit);
1248 my $TopType = getTopFuncName($bit);
1249
1250 my $tmpDir1 = 'tmpdir1';
1251 my $tmpDir2 = 'tmpdir2';
1252 my $lex = new LexDir($tmpDir1, $tmpDir2) ;
1253
1254 mkdir $tmpDir1, 0777;
1255 mkdir $tmpDir2, 0777;
1256
1257 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
1258 #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
1259
1260 my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ;
1261 foreach (@files) { writeFile($_, compressBuffer($TopType, "abc $_")) }
1262
1263 my @expected = map { "abc $_" } @files ;
1264 my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
1265
1266 {
1267 title "$TopType - From FileGlob to FileGlob" ;
1268
1269 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' UnCompressed ok'
1270 or diag $$Error ;
1271
1272 my @copy = @expected;
1273 for my $file (@outFiles)
1274 {
1275 is readFile($file), shift @copy, " got expected from $file" ;
1276 }
1277
1278 is @copy, 0, " got all files";
1279 }
1280
1281 {
1282 title "$TopType - From FileGlob to Arrayref" ;
1283
1284 my @output = (\'first');
1285 ok &$Func("<$tmpDir1/a*.tmp>" => \@output), ' UnCompressed ok'
1286 or diag $$Error ;
1287
1288 my @copy = ('first', @expected);
1289 for my $data (@output)
1290 {
1291 is $$data, shift @copy, " got expected data" ;
1292 }
1293
1294 is @copy, 0, " got all files";
1295 }
1296
1297 {
1298 title "$TopType - From FileGlob to Buffer" ;
1299
1300 my $output ;
1301 ok &$Func("<$tmpDir1/a*.tmp>" => \$output), ' UnCompressed ok'
1302 or diag $$Error ;
1303
1304 is $output, join('', @expected), " got expected uncompressed data";
1305 }
1306
1307 {
1308 title "$TopType - From FileGlob to Filename" ;
1309
1310 my $output = 'abc' ;
1311 my $lex = new LexFile $output ;
1312 ok ! -e $output, " $output does not exist" ;
1313 ok &$Func("<$tmpDir1/a*.tmp>" => $output), ' UnCompressed ok'
1314 or diag $$Error ;
1315
1316 ok -e $output, " $output does exist" ;
1317 is readFile($output), join('', @expected), " got expected uncompressed data";
1318 }
1319
1320 {
1321 title "$TopType - From FileGlob to Filehandle" ;
1322
1323 my $output = 'abc' ;
1324 my $lex = new LexFile $output ;
1325 my $fh = new IO::File ">$output" ;
1326 ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1), ' UnCompressed ok'
1327 or diag $$Error ;
1328
1329 ok -e $output, " $output does exist" ;
1330 is readFile($output), join('', @expected), " got expected uncompressed data";
1331 }
1332
1333}
1334
1335foreach my $TopType ('IO::Compress::Gzip::gzip',
1336 'IO::Compress::Deflate',
1337 'IO::Compress::RawDeflate',
1338 # TODO -- add the inflate classes
1339 )
1340{
1341 my $Error = getErrorRef($TopType);
1342 my $Func = getTopFuncRef($TopType);
1343 my $Name = getTopFuncName($TopType);
1344
1345 title "More write tests" ;
1346
1347 my $file1 = "file1" ;
1348 my $file2 = "file2" ;
1349 my $file3 = "file3" ;
1350 my $lex = new LexFile $file1, $file2, $file3 ;
1351
1352 writeFile($file1, "F1");
1353 writeFile($file2, "F2");
1354 writeFile($file3, "F3");
1355
1356 my @data = (
1357 [ '[]', "" ],
1358 [ '[\""]', "" ],
1359 [ '[\undef]', "" ],
1360 [ '[\"abcd"]', "abcd" ],
1361 [ '[\"ab", \"cd"]', "abcd" ],
1362
1363 [ '$fh2', "F2" ],
1364 [ '[\"a", $fh1, \"bc"]', "aF1bc"],
1365 ) ;
1366
1367
1368 foreach my $data (@data)
1369 {
1370 my ($send, $get) = @$data ;
1371
1372 my $fh1 = new IO::File "< $file1" ;
1373 my $fh2 = new IO::File "< $file2" ;
1374 my $fh3 = new IO::File "< $file3" ;
1375
1376 title "$send";
1377 my $copy;
1378 eval "\$copy = $send";
1379 my $Answer ;
1380 ok &$Func($copy, \$Answer), " $Name ok";
1381
1382 my $got = anyUncompress(\$Answer);
1383 is $got, $get, " got expected output" ;
1384 cmp_ok $$Error, '==', 0, " no error";
1385
1386
1387 }
1388
1389 title "Array Input Error tests" ;
1390
1391 @data = (
1392 '[[]]',
1393 '[[[]]]',
1394 '[[\"ab"], [\"cd"]]',
1395 ) ;
1396
1397
1398 foreach my $send (@data)
1399 {
1400 my $fh1 = new IO::File "< $file1" ;
1401 my $fh2 = new IO::File "< $file2" ;
1402 my $fh3 = new IO::File "< $file3" ;
1403
1404 title "$send";
1405 my $copy;
1406 eval "\$copy = $send";
1407 my $Answer ;
1408 ok ! &$Func($copy, \$Answer), " $Name fails";
1409
1410 is $$Error, "unknown input parameter", " got error message";
1411
1412 }
1413}
1414
1415sub gzipGetHeader
1416{
1417 my $in = shift;
1418 my $content = shift ;
1419 my %opts = @_ ;
1420
1421 my $out ;
1422 my $got ;
1423
1424 ok IO::Compress::Gzip::gzip($in, \$out, %opts), " gzip ok" ;
1425 ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok"
1426 or diag $GunzipError ;
1427 is $got, $content, " got expected content" ;
1428
1429 my $gunz = new IO::Uncompress::Gunzip \$out, Strict => 0
1430 or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
1431 ok $gunz, " Created IO::Uncompress::Gunzip object";
1432 my $hdr = $gunz->getHeaderInfo();
1433 ok $hdr, " got Header info";
1434 my $uncomp ;
1435 ok $gunz->read($uncomp), " read ok" ;
1436 is $uncomp, $content, " got expected content";
1437 ok $gunz->close, " closed ok" ;
1438
1439 return $hdr ;
1440
1441}
1442
1443{
1444 title "Check gzip header default NAME & MTIME settings" ;
1445
1446 my $file1 = "file1" ;
1447 my $lex = new LexFile $file1;
1448
1449 my $content = "hello ";
1450 my $hdr ;
1451 my $mtime ;
1452
1453 writeFile($file1, $content);
1454 $mtime = (stat($file1))[8];
1455 # make sure that the gzip file isn't created in the same
1456 # second as the input file
1457 sleep 3 ;
1458 $hdr = gzipGetHeader($file1, $content);
1459
1460 is $hdr->{Name}, $file1, " Name is '$file1'";
1461 is $hdr->{Time}, $mtime, " Time is ok";
1462
1463 title "Override Name" ;
1464
1465 writeFile($file1, $content);
1466 $mtime = (stat($file1))[8];
1467 sleep 3 ;
1468 $hdr = gzipGetHeader($file1, $content, Name => "abcde");
1469
1470 is $hdr->{Name}, "abcde", " Name is 'abcde'" ;
1471 is $hdr->{Time}, $mtime, " Time is ok";
1472
1473 title "Override Time" ;
1474
1475 writeFile($file1, $content);
1476 $hdr = gzipGetHeader($file1, $content, Time => 1234);
1477
1478 is $hdr->{Name}, $file1, " Name is '$file1'" ;
1479 is $hdr->{Time}, 1234, " Time is 1234";
1480
1481 title "Override Name and Time" ;
1482
1483 writeFile($file1, $content);
1484 $hdr = gzipGetHeader($file1, $content, Time => 4321, Name => "abcde");
1485
1486 is $hdr->{Name}, "abcde", " Name is 'abcde'" ;
1487 is $hdr->{Time}, 4321, " Time is 4321";
1488
1489 title "Filehandle doesn't have default Name or Time" ;
1490 my $fh = new IO::File "< $file1"
1491 or diag "Cannot open '$file1': $!\n" ;
1492 sleep 3 ;
1493 my $before = time ;
1494 $hdr = gzipGetHeader($fh, $content);
1495 my $after = time ;
1496
1497 ok ! defined $hdr->{Name}, " Name is undef";
1498 cmp_ok $hdr->{Time}, '>=', $before, " Time is ok";
1499 cmp_ok $hdr->{Time}, '<=', $after, " Time is ok";
1500
1501 $fh->close;
1502
1503 title "Buffer doesn't have default Name or Time" ;
1504 my $buffer = $content;
1505 $before = time ;
1506 $hdr = gzipGetHeader(\$buffer, $content);
1507 $after = time ;
1508
1509 ok ! defined $hdr->{Name}, " Name is undef";
1510 cmp_ok $hdr->{Time}, '>=', $before, " Time is ok";
1511 cmp_ok $hdr->{Time}, '<=', $after, " Time is ok";
1512}
1513
1514# TODO add more error cases
1515