Commit | Line | Data |
25f0751f |
1 | package CompTestUtils; |
2 | |
3 | package main ; |
4 | |
5 | use strict ; |
6 | use warnings; |
7 | use bytes; |
8 | |
258133d1 |
9 | #use lib qw(t t/compress); |
10 | |
25f0751f |
11 | use Carp ; |
258133d1 |
12 | #use Test::More ; |
13 | |
25f0751f |
14 | |
15 | |
16 | sub title |
17 | { |
18 | #diag "" ; |
19 | ok 1, $_[0] ; |
20 | #diag "" ; |
21 | } |
22 | |
23 | sub like_eval |
24 | { |
25 | like $@, @_ ; |
26 | } |
27 | |
28 | { |
29 | package LexFile ; |
30 | |
31 | our ($index); |
32 | $index = '00000'; |
33 | |
34 | sub new |
35 | { |
36 | my $self = shift ; |
37 | foreach (@_) |
38 | { |
39 | # autogenerate the name unless if none supplied |
40 | $_ = "tst" . $index ++ . ".tmp" |
41 | unless defined $_; |
42 | } |
43 | chmod 0777, @_; |
44 | for (@_) { 1 while unlink $_ } ; |
45 | bless [ @_ ], $self ; |
46 | } |
47 | |
48 | sub DESTROY |
49 | { |
50 | my $self = shift ; |
51 | chmod 0777, @{ $self } ; |
52 | for (@$self) { 1 while unlink $_ } ; |
53 | } |
54 | |
55 | } |
56 | |
57 | { |
58 | package LexDir ; |
59 | |
60 | use File::Path; |
61 | sub new |
62 | { |
63 | my $self = shift ; |
64 | foreach (@_) { rmtree $_ } |
65 | bless [ @_ ], $self ; |
66 | } |
67 | |
68 | sub DESTROY |
69 | { |
70 | my $self = shift ; |
71 | foreach (@$self) { rmtree $_ } |
72 | } |
73 | } |
74 | sub readFile |
75 | { |
76 | my $f = shift ; |
77 | |
78 | my @strings ; |
79 | |
80 | if (IO::Compress::Base::Common::isaFilehandle($f)) |
81 | { |
82 | my $pos = tell($f); |
83 | seek($f, 0,0); |
84 | @strings = <$f> ; |
85 | seek($f, 0, $pos); |
86 | } |
87 | else |
88 | { |
89 | open (F, "<$f") |
90 | or croak "Cannot open $f: $!\n" ; |
91 | binmode F; |
92 | @strings = <F> ; |
93 | close F ; |
94 | } |
95 | |
96 | return @strings if wantarray ; |
97 | return join "", @strings ; |
98 | } |
99 | |
100 | sub touch |
101 | { |
102 | foreach (@_) { writeFile($_, '') } |
103 | } |
104 | |
105 | sub writeFile |
106 | { |
107 | my($filename, @strings) = @_ ; |
108 | 1 while unlink $filename ; |
109 | open (F, ">$filename") |
110 | or croak "Cannot open $filename: $!\n" ; |
111 | binmode F; |
112 | foreach (@strings) { |
113 | no warnings ; |
114 | print F $_ ; |
115 | } |
116 | close F ; |
117 | } |
118 | |
119 | sub GZreadFile |
120 | { |
121 | my ($filename) = shift ; |
122 | |
123 | my ($uncomp) = "" ; |
124 | my $line = "" ; |
125 | my $fil = gzopen($filename, "rb") |
126 | or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; |
127 | |
128 | $uncomp .= $line |
129 | while $fil->gzread($line) > 0; |
130 | |
131 | $fil->gzclose ; |
132 | return $uncomp ; |
133 | } |
134 | |
135 | sub hexDump |
136 | { |
137 | my $d = shift ; |
138 | |
139 | if (IO::Compress::Base::Common::isaFilehandle($d)) |
140 | { |
141 | $d = readFile($d); |
142 | } |
143 | elsif (IO::Compress::Base::Common::isaFilename($d)) |
144 | { |
145 | $d = readFile($d); |
146 | } |
147 | else |
148 | { |
149 | $d = $$d ; |
150 | } |
151 | |
152 | my $offset = 0 ; |
153 | |
154 | $d = '' unless defined $d ; |
155 | #while (read(STDIN, $data, 16)) { |
156 | while (my $data = substr($d, 0, 16)) { |
157 | substr($d, 0, 16) = '' ; |
158 | printf "# %8.8lx ", $offset; |
159 | $offset += 16; |
160 | |
161 | my @array = unpack('C*', $data); |
162 | foreach (@array) { |
163 | printf('%2.2x ', $_); |
164 | } |
165 | print " " x (16 - @array) |
166 | if @array < 16 ; |
167 | $data =~ tr/\0-\37\177-\377/./; |
168 | print " $data\n"; |
169 | } |
170 | |
171 | } |
172 | |
173 | sub readHeaderInfo |
174 | { |
175 | my $name = shift ; |
176 | my %opts = @_ ; |
177 | |
178 | my $string = <<EOM; |
179 | some text |
180 | EOM |
181 | |
182 | ok my $x = new IO::Compress::Gzip $name, %opts |
183 | or diag "GzipError is $IO::Compress::Gzip::GzipError" ; |
184 | ok $x->write($string) ; |
185 | ok $x->close ; |
186 | |
187 | #is GZreadFile($name), $string ; |
188 | |
189 | ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0 |
190 | or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; |
191 | ok my $hdr = $gunz->getHeaderInfo(); |
192 | my $uncomp ; |
193 | ok $gunz->read($uncomp) ; |
194 | ok $uncomp eq $string; |
195 | ok $gunz->close ; |
196 | |
197 | return $hdr ; |
198 | } |
199 | |
200 | sub cmpFile |
201 | { |
202 | my ($filename, $uue) = @_ ; |
203 | return readFile($filename) eq unpack("u", $uue) ; |
204 | } |
205 | |
d54256af |
206 | sub isRawFormat |
207 | { |
208 | my $class = shift; |
209 | my %raw = map { $_ => 1 } qw( RawDeflate ); |
210 | |
211 | return defined $raw{$class}; |
212 | } |
213 | |
25f0751f |
214 | sub uncompressBuffer |
215 | { |
216 | my $compWith = shift ; |
217 | my $buffer = shift ; |
218 | |
219 | my %mapping = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', |
220 | 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip', |
221 | 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', |
222 | 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate', |
223 | 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', |
224 | 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate', |
225 | 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', |
226 | 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2', |
227 | 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', |
228 | 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip', |
229 | 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', |
230 | 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop', |
258133d1 |
231 | 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf' , |
232 | 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf', |
d54256af |
233 | 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd' , |
234 | 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd', |
25f0751f |
235 | 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', |
236 | 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp', |
237 | ); |
238 | |
239 | my $out ; |
240 | my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1); |
241 | 1 while $obj->read($out) > 0 ; |
242 | return $out ; |
243 | |
244 | } |
245 | |
246 | my %ErrorMap = ( 'IO::Compress::Gzip' => \$IO::Compress::Gzip::GzipError, |
247 | 'IO::Compress::Gzip::gzip' => \$IO::Compress::Gzip::GzipError, |
248 | 'IO::Uncompress::Gunzip' => \$IO::Uncompress::Gunzip::GunzipError, |
249 | 'IO::Uncompress::Gunzip::gunzip' => \$IO::Uncompress::Gunzip::GunzipError, |
250 | 'IO::Uncompress::Inflate' => \$IO::Uncompress::Inflate::InflateError, |
251 | 'IO::Uncompress::Inflate::inflate' => \$IO::Uncompress::Inflate::InflateError, |
252 | 'IO::Compress::Deflate' => \$IO::Compress::Deflate::DeflateError, |
253 | 'IO::Compress::Deflate::deflate' => \$IO::Compress::Deflate::DeflateError, |
254 | 'IO::Uncompress::RawInflate' => \$IO::Uncompress::RawInflate::RawInflateError, |
255 | 'IO::Uncompress::RawInflate::rawinflate' => \$IO::Uncompress::RawInflate::RawInflateError, |
256 | 'IO::Uncompress::AnyInflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, |
257 | 'IO::Uncompress::AnyInflate::anyinflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, |
258 | 'IO::Uncompress::AnyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, |
259 | 'IO::Uncompress::AnyUncompress::anyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, |
260 | 'IO::Compress::RawDeflate' => \$IO::Compress::RawDeflate::RawDeflateError, |
261 | 'IO::Compress::RawDeflate::rawdeflate' => \$IO::Compress::RawDeflate::RawDeflateError, |
262 | 'IO::Compress::Bzip2' => \$IO::Compress::Bzip2::Bzip2Error, |
263 | 'IO::Compress::Bzip2::bzip2' => \$IO::Compress::Bzip2::Bzip2Error, |
264 | 'IO::Uncompress::Bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, |
265 | 'IO::Uncompress::Bunzip2::bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, |
266 | 'IO::Compress::Zip' => \$IO::Compress::Zip::ZipError, |
267 | 'IO::Compress::Zip::zip' => \$IO::Compress::Zip::ZipError, |
268 | 'IO::Uncompress::Unzip' => \$IO::Uncompress::Unzip::UnzipError, |
269 | 'IO::Uncompress::Unzip::unzip' => \$IO::Uncompress::Unzip::UnzipError, |
270 | 'IO::Compress::Lzop' => \$IO::Compress::Lzop::LzopError, |
271 | 'IO::Compress::Lzop::lzop' => \$IO::Compress::Lzop::LzopError, |
272 | 'IO::Uncompress::UnLzop' => \$IO::Uncompress::UnLzop::UnLzopError, |
273 | 'IO::Uncompress::UnLzop::unlzop' => \$IO::Uncompress::UnLzop::UnLzopError, |
258133d1 |
274 | 'IO::Compress::Lzf' => \$IO::Compress::Lzf::LzfError, |
275 | 'IO::Compress::Lzf::lzf' => \$IO::Compress::Lzf::LzfError, |
276 | 'IO::Uncompress::UnLzf' => \$IO::Uncompress::UnLzf::UnLzfError, |
277 | 'IO::Uncompress::UnLzf::unlzf' => \$IO::Uncompress::UnLzf::UnLzfError, |
d54256af |
278 | 'IO::Compress::PPMd' => \$IO::Compress::PPMd::PPMdError, |
279 | 'IO::Compress::PPMd::ppmd' => \$IO::Compress::PPMd::PPMdError, |
280 | 'IO::Uncompress::UnPPMd' => \$IO::Uncompress::UnPPMd::UnPPMdError, |
281 | 'IO::Uncompress::UnPPMd::unppmd' => \$IO::Uncompress::UnPPMd::UnPPMdError, |
25f0751f |
282 | |
283 | 'IO::Compress::DummyComp' => \$IO::Compress::DummyComp::DummyCompError, |
284 | 'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError, |
285 | 'IO::Uncompress::DummyUncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, |
286 | 'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, |
287 | ); |
288 | |
289 | my %TopFuncMap = ( 'IO::Compress::Gzip' => 'IO::Compress::Gzip::gzip', |
290 | 'IO::Uncompress::Gunzip' => 'IO::Uncompress::Gunzip::gunzip', |
291 | |
292 | 'IO::Compress::Deflate' => 'IO::Compress::Deflate::deflate', |
293 | 'IO::Uncompress::Inflate' => 'IO::Uncompress::Inflate::inflate', |
294 | |
295 | 'IO::Compress::RawDeflate' => 'IO::Compress::RawDeflate::rawdeflate', |
296 | 'IO::Uncompress::RawInflate' => 'IO::Uncompress::RawInflate::rawinflate', |
297 | |
298 | 'IO::Uncompress::AnyInflate' => 'IO::Uncompress::AnyInflate::anyinflate', |
299 | 'IO::Uncompress::AnyUncompress' => 'IO::Uncompress::AnyUncompress::anyuncompress', |
300 | |
301 | 'IO::Compress::Bzip2' => 'IO::Compress::Bzip2::bzip2', |
302 | 'IO::Uncompress::Bunzip2' => 'IO::Uncompress::Bunzip2::bunzip2', |
303 | |
304 | 'IO::Compress::Zip' => 'IO::Compress::Zip::zip', |
305 | 'IO::Uncompress::Unzip' => 'IO::Uncompress::Unzip::unzip', |
306 | 'IO::Compress::Lzop' => 'IO::Compress::Lzop::lzop', |
307 | 'IO::Uncompress::UnLzop' => 'IO::Uncompress::UnLzop::unlzop', |
258133d1 |
308 | 'IO::Compress::Lzf' => 'IO::Compress::Lzf::lzf', |
309 | 'IO::Uncompress::UnLzf' => 'IO::Uncompress::UnLzf::unlzf', |
d54256af |
310 | 'IO::Compress::PPMd' => 'IO::Compress::PPMd::ppmd', |
311 | 'IO::Uncompress::UnPPMd' => 'IO::Uncompress::UnPPMd::unppmd', |
25f0751f |
312 | 'IO::Compress::DummyComp' => 'IO::Compress::DummyComp::dummyuncomp', |
313 | 'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', |
314 | ); |
315 | |
316 | %TopFuncMap = map { ($_ => $TopFuncMap{$_}, |
317 | $TopFuncMap{$_} => $TopFuncMap{$_}) } |
318 | keys %TopFuncMap ; |
319 | |
320 | #%TopFuncMap = map { ($_ => \&{ $TopFuncMap{$_} ) } |
321 | #keys %TopFuncMap ; |
322 | |
323 | |
324 | my %inverse = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', |
325 | 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip::gunzip', |
326 | 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', |
327 | 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate::inflate', |
328 | 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', |
329 | 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate::rawinflate', |
330 | 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2::bunzip2', |
331 | 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', |
332 | 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip::unzip', |
333 | 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', |
334 | 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop::unlzop', |
335 | 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', |
258133d1 |
336 | 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf::unlzf', |
337 | 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf', |
d54256af |
338 | 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd::unppmd', |
339 | 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd', |
25f0751f |
340 | 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', |
341 | 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', |
342 | ); |
343 | |
344 | %inverse = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse; |
345 | |
346 | sub getInverse |
347 | { |
348 | my $class = shift ; |
349 | |
350 | return $inverse{$class} ; |
351 | } |
352 | |
353 | sub getErrorRef |
354 | { |
355 | my $class = shift ; |
356 | |
357 | return $ErrorMap{$class} ; |
358 | } |
359 | |
360 | sub getTopFuncRef |
361 | { |
362 | my $class = shift ; |
363 | |
364 | return \&{ $TopFuncMap{$class} } ; |
365 | } |
366 | |
367 | sub getTopFuncName |
368 | { |
369 | my $class = shift ; |
370 | |
371 | return $TopFuncMap{$class} ; |
372 | } |
373 | |
374 | sub compressBuffer |
375 | { |
376 | my $compWith = shift ; |
377 | my $buffer = shift ; |
378 | |
379 | my %mapping = ( 'IO::Uncompress::Gunzip' => 'IO::Compress::Gzip', |
380 | 'IO::Uncompress::Gunzip::gunzip' => 'IO::Compress::Gzip', |
381 | 'IO::Uncompress::Inflate' => 'IO::Compress::Deflate', |
382 | 'IO::Uncompress::Inflate::inflate' => 'IO::Compress::Deflate', |
383 | 'IO::Uncompress::RawInflate' => 'IO::Compress::RawDeflate', |
384 | 'IO::Uncompress::RawInflate::rawinflate' => 'IO::Compress::RawDeflate', |
385 | 'IO::Uncompress::Bunzip2' => 'IO::Compress::Bzip2', |
386 | 'IO::Uncompress::Bunzip2::bunzip2' => 'IO::Compress::Bzip2', |
387 | 'IO::Uncompress::Unzip' => 'IO::Compress::Zip', |
388 | 'IO::Uncompress::Unzip::unzip' => 'IO::Compress::Zip', |
389 | 'IO::Uncompress::UnLzop' => 'IO::Compress::Lzop', |
390 | 'IO::Uncompress::UnLzop::unlzop' => 'IO::Compress::Lzop', |
258133d1 |
391 | 'IO::Uncompress::UnLzp' => 'IO::Compress::Lzf', |
392 | 'IO::Uncompress::UnLzf::unlzf' => 'IO::Compress::Lzf', |
d54256af |
393 | 'IO::Uncompress::UnPPMd' => 'IO::Compress::PPMd', |
394 | 'IO::Uncompress::UnPPMd::unppmd' => 'IO::Compress::PPMd', |
25f0751f |
395 | 'IO::Uncompress::AnyInflate' => 'IO::Compress::Gzip', |
396 | 'IO::Uncompress::AnyInflate::anyinflate' => 'IO::Compress::Gzip', |
397 | 'IO::Uncompress::AnyUncompress' => 'IO::Compress::Gzip', |
398 | 'IO::Uncompress::AnyUncompress::anyuncompress' => 'IO::Compress::Gzip', |
399 | 'IO::Uncompress::DummyUncomp' => 'IO::Compress::DummyComp', |
400 | 'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp', |
401 | ); |
402 | |
403 | my $out ; |
404 | my $obj = $mapping{$compWith}->new( \$out); |
405 | $obj->write($buffer) ; |
406 | $obj->close(); |
407 | return $out ; |
408 | } |
409 | |
410 | our ($AnyUncompressError); |
411 | BEGIN |
412 | { |
258133d1 |
413 | eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); '; |
25f0751f |
414 | } |
415 | |
416 | sub anyUncompress |
417 | { |
418 | my $buffer = shift ; |
419 | my $already = shift; |
420 | |
421 | my @opts = (); |
422 | if (ref $buffer && ref $buffer eq 'ARRAY') |
423 | { |
424 | @opts = @$buffer; |
425 | $buffer = shift @opts; |
426 | } |
427 | |
428 | if (ref $buffer) |
429 | { |
430 | croak "buffer is undef" unless defined $$buffer; |
431 | croak "buffer is empty" unless length $$buffer; |
432 | |
433 | } |
434 | |
435 | |
436 | my $data ; |
437 | if (IO::Compress::Base::Common::isaFilehandle($buffer)) |
438 | { |
439 | $data = readFile($buffer); |
440 | } |
441 | elsif (IO::Compress::Base::Common::isaFilename($buffer)) |
442 | { |
443 | $data = readFile($buffer); |
444 | } |
445 | else |
446 | { |
447 | $data = $$buffer ; |
448 | } |
449 | |
450 | if (defined $already && length $already) |
451 | { |
452 | |
453 | my $got = substr($data, 0, length($already)); |
454 | substr($data, 0, length($already)) = ''; |
455 | |
456 | is $got, $already, ' Already OK' ; |
457 | } |
458 | |
459 | my $out = ''; |
6ecef415 |
460 | my $o = new IO::Uncompress::AnyUncompress \$data, |
461 | Append => 1, |
462 | Transparent => 0, |
463 | RawInflate => 1, |
464 | @opts |
25f0751f |
465 | or croak "Cannot open buffer/file: $AnyUncompressError" ; |
466 | |
467 | 1 while $o->read($out) > 0 ; |
468 | |
469 | croak "Error uncompressing -- " . $o->error() |
470 | if $o->error() ; |
471 | |
472 | return $out ; |
473 | |
474 | } |
475 | |
476 | sub getHeaders |
477 | { |
478 | my $buffer = shift ; |
479 | my $already = shift; |
480 | |
481 | my @opts = (); |
482 | if (ref $buffer && ref $buffer eq 'ARRAY') |
483 | { |
484 | @opts = @$buffer; |
485 | $buffer = shift @opts; |
486 | } |
487 | |
488 | if (ref $buffer) |
489 | { |
490 | croak "buffer is undef" unless defined $$buffer; |
491 | croak "buffer is empty" unless length $$buffer; |
492 | |
493 | } |
494 | |
495 | |
496 | my $data ; |
497 | if (IO::Compress::Base::Common::isaFilehandle($buffer)) |
498 | { |
499 | $data = readFile($buffer); |
500 | } |
501 | elsif (IO::Compress::Base::Common::isaFilename($buffer)) |
502 | { |
503 | $data = readFile($buffer); |
504 | } |
505 | else |
506 | { |
507 | $data = $$buffer ; |
508 | } |
509 | |
510 | if (defined $already && length $already) |
511 | { |
512 | |
513 | my $got = substr($data, 0, length($already)); |
514 | substr($data, 0, length($already)) = ''; |
515 | |
516 | is $got, $already, ' Already OK' ; |
517 | } |
518 | |
519 | my $out = ''; |
6ecef415 |
520 | my $o = new IO::Uncompress::AnyUncompress \$data, |
521 | MultiStream => 1, |
522 | Append => 1, |
523 | Transparent => 0, |
524 | RawInflate => 1, |
525 | @opts |
25f0751f |
526 | or croak "Cannot open buffer/file: $AnyUncompressError" ; |
527 | |
528 | 1 while $o->read($out) > 0 ; |
529 | |
530 | croak "Error uncompressing -- " . $o->error() |
531 | if $o->error() ; |
532 | |
533 | return ($o->getHeaderInfo()) ; |
534 | |
535 | } |
536 | |
537 | sub mkComplete |
538 | { |
539 | my $class = shift ; |
540 | my $data = shift; |
541 | my $Error = getErrorRef($class); |
542 | |
543 | my $buffer ; |
544 | my %params = (); |
545 | |
546 | if ($class eq 'IO::Compress::Gzip') { |
547 | %params = ( |
c70c1701 |
548 | Name => "My name", |
549 | Comment => "a comment", |
550 | ExtraField => ['ab' => "extra"], |
551 | HeaderCRC => 1); |
25f0751f |
552 | } |
553 | elsif ($class eq 'IO::Compress::Zip'){ |
554 | %params = ( |
c70c1701 |
555 | Name => "My name", |
556 | Comment => "a comment", |
557 | ZipComment => "last comment", |
558 | exTime => [100, 200, 300], |
559 | ExtraFieldLocal => ["ab" => "extra1"], |
560 | ExtraFieldCentral => ["cd" => "extra2"], |
25f0751f |
561 | ); |
562 | } |
563 | |
564 | my $z = new $class( \$buffer, %params) |
565 | or croak "Cannot create $class object: $$Error"; |
566 | $z->write($data); |
567 | $z->close(); |
568 | |
569 | my $unc = getInverse($class); |
570 | anyUncompress(\$buffer) eq $data |
571 | or die "bad bad bad"; |
572 | my $u = new $unc( \$buffer); |
573 | my $info = $u->getHeaderInfo() ; |
574 | |
575 | |
576 | return wantarray ? ($info, $buffer) : $buffer ; |
577 | } |
578 | |
579 | sub mkErr |
580 | { |
581 | my $string = shift ; |
582 | my ($dummy, $file, $line) = caller ; |
583 | -- $line ; |
584 | |
585 | $file = quotemeta($file); |
586 | |
587 | return "/$string\\s+at $file line $line/" if $] >= 5.006 ; |
588 | return "/$string\\s+at /" ; |
589 | } |
590 | |
591 | sub mkEvalErr |
592 | { |
593 | my $string = shift ; |
594 | |
595 | return "/$string\\s+at \\(eval /" if $] > 5.006 ; |
596 | return "/$string\\s+at /" ; |
597 | } |
598 | |
599 | sub dumpObj |
600 | { |
601 | my $obj = shift ; |
602 | |
603 | my ($dummy, $file, $line) = caller ; |
604 | |
605 | if (@_) |
606 | { |
607 | print "#\n# dumpOBJ from $file line $line @_\n" ; |
608 | } |
609 | else |
610 | { |
611 | print "#\n# dumpOBJ from $file line $line \n" ; |
612 | } |
613 | |
614 | my $max = 0 ;; |
615 | foreach my $k (keys %{ *$obj }) |
616 | { |
617 | $max = length $k if length $k > $max ; |
618 | } |
619 | |
620 | foreach my $k (sort keys %{ *$obj }) |
621 | { |
622 | my $v = $obj->{$k} ; |
623 | $v = '-undef-' unless defined $v; |
624 | my $pad = ' ' x ($max - length($k) + 2) ; |
625 | print "# $k$pad: [$v]\n"; |
626 | } |
627 | print "#\n" ; |
628 | } |
629 | |
630 | |
258133d1 |
631 | sub getMultiValues |
632 | { |
633 | my $class = shift ; |
634 | |
635 | return (0,0) if $class =~ /lzf/i; |
636 | return (1,0); |
637 | } |
638 | |
f6fd7794 |
639 | |
640 | sub gotScalarUtilXS |
641 | { |
642 | eval ' use Scalar::Util "dualvar" '; |
643 | return $@ ? 0 : 1 ; |
644 | } |
645 | |
25f0751f |
646 | package CompTestUtils; |
647 | |
648 | 1; |
258133d1 |
649 | __END__ |
650 | t/Test/Builder.pm |
651 | t/Test/More.pm |
652 | t/Test/Simple.pm |
653 | t/compress/CompTestUtils.pm |
654 | t/compress/any.pl |
655 | t/compress/anyunc.pl |
656 | t/compress/destroy.pl |
657 | t/compress/generic.pl |
658 | t/compress/merge.pl |
659 | t/compress/multi.pl |
660 | t/compress/newtied.pl |
661 | t/compress/oneshot.pl |
662 | t/compress/prime.pl |
663 | t/compress/tied.pl |
664 | t/compress/truncate.pl |
665 | t/compress/zlib-generic.plParsing config.in... |
666 | Building Zlib enabled |
667 | Auto Detect Gzip OS Code.. |
668 | Setting Gzip OS Code to 3 [Unix/Default] |
669 | Looks Good. |