1package CompTestUtils;
2
3package main ;
4
5use strict ;
6use warnings;
7use bytes;
8
9#use lib qw(t t/compress);
10
11use Carp ;
12#use Test::More ;
13
14
15
16sub title
17{
18    #diag "" ;
19    ok(1, $_[0]) ;
20    #diag "" ;
21}
22
23sub like_eval
24{
25    like $@, @_ ;
26}
27
28BEGIN {
29    eval {
30       require File::Temp;
31     } ;
32
33}
34
35sub test_zlib_header_matches_library
36{
37SKIP: {
38    skip "TEST_SKIP_VERSION_CHECK is set", 1
39        if $ENV{TEST_SKIP_VERSION_CHECK};
40
41    if (Compress::Raw::Zlib::is_zlibng_native())
42    {
43        my $zlibng_h = Compress::Raw::Zlib::ZLIBNG_VERSION ;
44        my $libzng   = Compress::Raw::Zlib::zlibng_version();
45        is($zlibng_h, $libzng, "ZLIBNG_VERSION ($zlibng_h) matches Compress::Raw::Zlib::zlibng_version")
46            or diag <<EOM;
47
48The version of zlib-ng.h does not match the version of libz-ng
49
50You have zlib-ng.h version $zlibng_h
51     and libz-ng   version $libzng
52
53You probably have two versions of zlib-ng installed on your system.
54Try removing the one you don't want to use and rebuild.
55EOM
56    }
57    else
58    {
59        my $zlib_h = ZLIB_VERSION ;
60        my $libz   = Compress::Raw::Zlib::zlib_version();
61        is($zlib_h, $libz, "ZLIB_VERSION ($zlib_h) matches Compress::Raw::Zlib::zlib_version")
62            or diag <<EOM;
63
64The version of zlib.h does not match the version of libz
65
66You have zlib.h version $zlib_h
67     and libz   version $libz
68
69You probably have two versions of zlib installed on your system.
70Try removing the one you don't want to use and rebuild.
71EOM
72    }
73    }
74}
75
76
77{
78    package LexFile ;
79
80    our ($index);
81    $index = '00000';
82
83    sub new
84    {
85        my $self = shift ;
86        foreach (@_)
87        {
88            Carp::croak "NO!!!!" if defined $_;
89            # autogenerate the name if none supplied
90            $_ = "tst" . $$ . "X" . $index ++ . ".tmp"
91                unless defined $_;
92        }
93        chmod 0777, @_;
94        for (@_) { 1 while unlink $_ } ;
95        bless [ @_ ], $self ;
96    }
97
98    sub DESTROY
99    {
100        my $self = shift ;
101        chmod 0777, @{ $self } ;
102        for (@$self) { 1 while unlink $_ } ;
103    }
104
105}
106
107{
108    package LexDir ;
109
110    use File::Path;
111
112    our ($index);
113    $index = '00000';
114    our ($useTempFile);
115    our ($useTempDir);
116
117    sub new
118    {
119        my $self = shift ;
120
121        if ( $useTempDir)
122        {
123            foreach (@_)
124            {
125                Carp::croak "NO!!!!" if defined $_;
126                $_ = File::Temp->newdir(DIR => '.');
127                # Subsequent manipulations assume Unix syntax, metacharacters, etc.
128                if ($^O eq 'VMS')
129                {
130                    $_->{DIRNAME} = VMS::Filespec::unixify($_->{DIRNAME});
131                    $_->{DIRNAME} =~ s/\/$//;
132                }
133            }
134            bless [ @_ ], $self ;
135        }
136        elsif ( $useTempFile)
137        {
138            foreach (@_)
139            {
140                Carp::croak "NO!!!!" if defined $_;
141                $_ = File::Temp::tempdir(DIR => '.', CLEANUP => 1);
142                # Subsequent manipulations assume Unix syntax, metacharacters, etc.
143                if ($^O eq 'VMS')
144                {
145                    $_ = VMS::Filespec::unixify($_);
146                    $_ =~ s/\/$//;
147                }
148            }
149            bless [ @_ ], $self ;
150        }
151        else
152        {
153            foreach (@_)
154            {
155                Carp::croak "NO!!!!" if defined $_;
156                # autogenerate the name if none supplied
157                $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ;
158            }
159            foreach (@_)
160            {
161                rmtree $_, {verbose => 0, safe => 1}
162                    if -d $_;
163                mkdir $_, 0777
164            }
165            bless [ @_ ], $self ;
166        }
167
168    }
169
170    sub DESTROY
171    {
172        if (! $useTempFile)
173        {
174            my $self = shift ;
175            foreach (@$self)
176            {
177                rmtree $_, {verbose => 0, safe => 1}
178                    if -d $_ ;
179            }
180        }
181    }
182}
183
184sub readFile
185{
186    my $f = shift ;
187
188    my @strings ;
189
190    if (IO::Compress::Base::Common::isaFilehandle($f))
191    {
192        my $pos = tell($f);
193        seek($f, 0,0);
194        @strings = <$f> ;
195        seek($f, 0, $pos);
196    }
197    else
198    {
199        open (F, "<$f")
200            or croak "Cannot open $f: $!\n" ;
201        binmode F;
202        @strings = <F> ;
203        close F ;
204    }
205
206    return @strings if wantarray ;
207    return join "", @strings ;
208}
209
210sub touch
211{
212    foreach (@_) { writeFile($_, '') }
213}
214
215sub writeFile
216{
217    my($filename, @strings) = @_ ;
218    1 while unlink $filename ;
219    open (F, ">$filename")
220        or croak "Cannot open $filename: $!\n" ;
221    binmode F;
222    foreach (@strings) {
223        no warnings ;
224        print F $_ ;
225    }
226    close F ;
227}
228
229sub GZreadFile
230{
231    my ($filename) = shift ;
232
233    my ($uncomp) = "" ;
234    my $line = "" ;
235    my $fil = gzopen($filename, "rb")
236        or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ;
237
238    $uncomp .= $line
239        while $fil->gzread($line) > 0;
240
241    $fil->gzclose ;
242    return $uncomp ;
243}
244
245sub hexDump
246{
247    my $d = shift ;
248
249    if (IO::Compress::Base::Common::isaFilehandle($d))
250    {
251        $d = readFile($d);
252    }
253    elsif (IO::Compress::Base::Common::isaFilename($d))
254    {
255        $d = readFile($d);
256    }
257    else
258    {
259        $d = $$d ;
260    }
261
262    my $offset = 0 ;
263
264    $d = '' unless defined $d ;
265    #while (read(STDIN, $data, 16)) {
266    while (my $data = substr($d, 0, 16)) {
267        substr($d, 0, 16) = '' ;
268        printf "# %8.8lx    ", $offset;
269        $offset += 16;
270
271        my @array = unpack('C*', $data);
272        foreach (@array) {
273            printf('%2.2x ', $_);
274        }
275        print "   " x (16 - @array)
276            if @array < 16 ;
277        $data =~ tr/\0-\37\177-\377/./;
278        print "  $data\n";
279    }
280
281}
282
283sub readHeaderInfo
284{
285    my $name = shift ;
286    my %opts = @_ ;
287
288    my $string = <<EOM;
289some text
290EOM
291
292    ok my $x = new IO::Compress::Gzip $name, %opts
293        or diag "GzipError is $IO::Compress::Gzip::GzipError" ;
294    ok $x->write($string) ;
295    ok $x->close ;
296
297    #is GZreadFile($name), $string ;
298
299    ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0
300        or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
301    ok my $hdr = $gunz->getHeaderInfo();
302    my $uncomp ;
303    ok $gunz->read($uncomp) ;
304    ok $uncomp eq $string;
305    ok $gunz->close ;
306
307    return $hdr ;
308}
309
310sub cmpFile
311{
312    my ($filename, $uue) = @_ ;
313    return readFile($filename) eq unpack("u", $uue) ;
314}
315
316#sub isRawFormat
317#{
318#    my $class = shift;
319#    # TODO -- add Lzma here?
320#    my %raw = map { $_ => 1 } qw( RawDeflate );
321#
322#    return defined $raw{$class};
323#}
324
325
326
327my %TOP = (
328    'IO::Uncompress::AnyInflate' => { Inverse  => 'IO::Compress::Gzip',
329                                      Error    => 'AnyInflateError',
330                                      TopLevel => 'anyinflate',
331                                      Raw      => 0,
332                            },
333
334    'IO::Uncompress::AnyUncompress' => { Inverse  => 'IO::Compress::Gzip',
335                                         Error    => 'AnyUncompressError',
336                                         TopLevel => 'anyuncompress',
337                                         Raw      => 0,
338                            },
339
340    'IO::Compress::Gzip' => { Inverse  => 'IO::Uncompress::Gunzip',
341                              Error    => 'GzipError',
342                              TopLevel => 'gzip',
343                              Raw      => 0,
344                            },
345    'IO::Uncompress::Gunzip' => { Inverse  => 'IO::Compress::Gzip',
346                                  Error    => 'GunzipError',
347                                  TopLevel => 'gunzip',
348                                  Raw      => 0,
349                            },
350
351    'IO::Compress::Deflate' => { Inverse  => 'IO::Uncompress::Inflate',
352                                 Error    => 'DeflateError',
353                                 TopLevel => 'deflate',
354                                 Raw      => 0,
355                            },
356    'IO::Uncompress::Inflate' => { Inverse  => 'IO::Compress::Deflate',
357                                   Error    => 'InflateError',
358                                   TopLevel => 'inflate',
359                                   Raw      => 0,
360                            },
361
362    'IO::Compress::RawDeflate' => { Inverse  => 'IO::Uncompress::RawInflate',
363                                    Error    => 'RawDeflateError',
364                                    TopLevel => 'rawdeflate',
365                                    Raw      => 1,
366                            },
367    'IO::Uncompress::RawInflate' => { Inverse  => 'IO::Compress::RawDeflate',
368                                      Error    => 'RawInflateError',
369                                      TopLevel => 'rawinflate',
370                                      Raw      => 1,
371                            },
372
373    'IO::Compress::Zip' => { Inverse  => 'IO::Uncompress::Unzip',
374                             Error    => 'ZipError',
375                             TopLevel => 'zip',
376                             Raw      => 0,
377                            },
378    'IO::Uncompress::Unzip' => { Inverse  => 'IO::Compress::Zip',
379                                 Error    => 'UnzipError',
380                                 TopLevel => 'unzip',
381                                 Raw      => 0,
382                            },
383
384    'IO::Compress::Bzip2' => { Inverse  => 'IO::Uncompress::Bunzip2',
385                               Error    => 'Bzip2Error',
386                               TopLevel => 'bzip2',
387                               Raw      => 0,
388                            },
389    'IO::Uncompress::Bunzip2' => { Inverse  => 'IO::Compress::Bzip2',
390                                   Error    => 'Bunzip2Error',
391                                   TopLevel => 'bunzip2',
392                                   Raw      => 0,
393                            },
394
395    'IO::Compress::Lzop' => { Inverse  => 'IO::Uncompress::UnLzop',
396                              Error    => 'LzopError',
397                              TopLevel => 'lzop',
398                              Raw      => 0,
399                            },
400    'IO::Uncompress::UnLzop' => { Inverse  => 'IO::Compress::Lzop',
401                                  Error    => 'UnLzopError',
402                                  TopLevel => 'unlzop',
403                                  Raw      => 0,
404                            },
405
406    'IO::Compress::Lzf' => { Inverse  => 'IO::Uncompress::UnLzf',
407                             Error    => 'LzfError',
408                             TopLevel => 'lzf',
409                             Raw      => 0,
410                            },
411    'IO::Uncompress::UnLzf' => { Inverse  => 'IO::Compress::Lzf',
412                                 Error    => 'UnLzfError',
413                                 TopLevel => 'unlzf',
414                                 Raw      => 0,
415                            },
416
417    'IO::Compress::Lzma' => { Inverse  => 'IO::Uncompress::UnLzma',
418                              Error    => 'LzmaError',
419                              TopLevel => 'lzma',
420                              Raw      => 1,
421                            },
422    'IO::Uncompress::UnLzma' => { Inverse  => 'IO::Compress::Lzma',
423                                  Error    => 'UnLzmaError',
424                                  TopLevel => 'unlzma',
425                                  Raw      => 1,
426                                },
427
428    'IO::Compress::Xz' => { Inverse  => 'IO::Uncompress::UnXz',
429                            Error    => 'XzError',
430                            TopLevel => 'xz',
431                            Raw      => 0,
432                          },
433    'IO::Uncompress::UnXz' => { Inverse  => 'IO::Compress::Xz',
434                                Error    => 'UnXzError',
435                                TopLevel => 'unxz',
436                                Raw      => 0,
437                              },
438
439    'IO::Compress::Lzip' => { Inverse  => 'IO::Uncompress::UnLzip',
440                            Error    => 'LzipError',
441                            TopLevel => 'lzip',
442                            Raw      => 0,
443                          },
444    'IO::Uncompress::UnLzip' => { Inverse  => 'IO::Compress::Lzip',
445                                Error    => 'UnLzipError',
446                                TopLevel => 'unlzip',
447                                Raw      => 0,
448                              },
449
450    'IO::Compress::PPMd' => { Inverse  => 'IO::Uncompress::UnPPMd',
451                              Error    => 'PPMdError',
452                              TopLevel => 'ppmd',
453                              Raw      => 0,
454                            },
455    'IO::Uncompress::UnPPMd' => { Inverse  => 'IO::Compress::PPMd',
456                                  Error    => 'UnPPMdError',
457                                  TopLevel => 'unppmd',
458                                  Raw      => 0,
459                                },
460    'IO::Compress::Zstd' => { Inverse  => 'IO::Uncompress::UnZstd',
461                              Error    => 'ZstdError',
462                              TopLevel => 'zstd',
463                              Raw      => 0,
464                            },
465    'IO::Uncompress::UnZstd' => { Inverse  => 'IO::Compress::Zstd',
466                                  Error    => 'UnZstdError',
467                                  TopLevel => 'unzstd',
468                                  Raw      => 0,
469                                },
470
471    'IO::Compress::DummyComp' => { Inverse  => 'IO::Uncompress::DummyUnComp',
472                                   Error    => 'DummyCompError',
473                                   TopLevel => 'dummycomp',
474                                   Raw      => 0,
475                                 },
476    'IO::Uncompress::DummyUnComp' => { Inverse  => 'IO::Compress::DummyComp',
477                                       Error    => 'DummyUnCompError',
478                                       TopLevel => 'dummyunComp',
479                                       Raw      => 0,
480                                     },
481);
482
483
484for my $key (keys %TOP)
485{
486    no strict;
487    no warnings;
488    $TOP{$key}{Error}    = \${ $key . '::' . $TOP{$key}{Error}    };
489    $TOP{$key}{TopLevel} =     $key . '::' . $TOP{$key}{TopLevel}  ;
490
491    # Silence used once warning in really old perl
492    my $dummy            = \${ $key . '::' . $TOP{$key}{Error}    };
493
494    #$TOP{$key . "::" . $TOP{$key}{TopLevel} } = $TOP{$key};
495}
496
497sub uncompressBuffer
498{
499    my $compWith = shift ;
500    my $buffer = shift ;
501
502
503    my $out ;
504    my $obj = $TOP{$compWith}{Inverse}->new( \$buffer, -Append => 1);
505    1 while $obj->read($out) > 0 ;
506    return $out ;
507
508}
509
510
511sub getInverse
512{
513    my $class = shift ;
514
515    return $TOP{$class}{Inverse};
516}
517
518sub getErrorRef
519{
520    my $class = shift ;
521
522    return $TOP{$class}{Error};
523}
524
525sub getTopFuncRef
526{
527    my $class = shift ;
528
529    die "Cannot find $class"
530        if ! defined $TOP{$class}{TopLevel};
531    return \&{ $TOP{$class}{TopLevel} } ;
532}
533
534sub getTopFuncName
535{
536    my $class = shift ;
537
538    return $TOP{$class}{TopLevel} ;
539}
540
541sub compressBuffer
542{
543    my $compWith = shift ;
544    my $buffer = shift ;
545
546
547    my $out ;
548    die "Cannot find $compWith"
549        if ! defined $TOP{$compWith}{Inverse};
550    my $obj = $TOP{$compWith}{Inverse}->new( \$out);
551    $obj->write($buffer) ;
552    $obj->close();
553    return $out ;
554}
555
556our ($AnyUncompressError);
557BEGIN
558{
559    eval ' use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError); ';
560}
561
562sub anyUncompress
563{
564    my $buffer = shift ;
565    my $already = shift;
566
567    my @opts = ();
568    if (ref $buffer && ref $buffer eq 'ARRAY')
569    {
570        @opts = @$buffer;
571        $buffer = shift @opts;
572    }
573
574    if (ref $buffer)
575    {
576        croak "buffer is undef" unless defined $$buffer;
577        croak "buffer is empty" unless length $$buffer;
578
579    }
580
581
582    my $data ;
583    if (IO::Compress::Base::Common::isaFilehandle($buffer))
584    {
585        $data = readFile($buffer);
586    }
587    elsif (IO::Compress::Base::Common::isaFilename($buffer))
588    {
589        $data = readFile($buffer);
590    }
591    else
592    {
593        $data = $$buffer ;
594    }
595
596    if (defined $already && length $already)
597    {
598
599        my $got = substr($data, 0, length($already));
600        substr($data, 0, length($already)) = '';
601
602        is $got, $already, '  Already OK' ;
603    }
604
605    my $out = '';
606    my $o = new IO::Uncompress::AnyUncompress \$data,
607                    Append => 1,
608                    Transparent => 0,
609                    RawInflate => 1,
610                    UnLzma     => 1,
611                    @opts
612        or croak "Cannot open buffer/file: $AnyUncompressError" ;
613
614    1 while $o->read($out) > 0 ;
615
616    croak "Error uncompressing -- " . $o->error()
617        if $o->error() ;
618
619    return $out ;
620}
621
622sub getHeaders
623{
624    my $buffer = shift ;
625    my $already = shift;
626
627    my @opts = ();
628    if (ref $buffer && ref $buffer eq 'ARRAY')
629    {
630        @opts = @$buffer;
631        $buffer = shift @opts;
632    }
633
634    if (ref $buffer)
635    {
636        croak "buffer is undef" unless defined $$buffer;
637        croak "buffer is empty" unless length $$buffer;
638
639    }
640
641
642    my $data ;
643    if (IO::Compress::Base::Common::isaFilehandle($buffer))
644    {
645        $data = readFile($buffer);
646    }
647    elsif (IO::Compress::Base::Common::isaFilename($buffer))
648    {
649        $data = readFile($buffer);
650    }
651    else
652    {
653        $data = $$buffer ;
654    }
655
656    if (defined $already && length $already)
657    {
658
659        my $got = substr($data, 0, length($already));
660        substr($data, 0, length($already)) = '';
661
662        is $got, $already, '  Already OK' ;
663    }
664
665    my $out = '';
666    my $o = new IO::Uncompress::AnyUncompress \$data,
667                MultiStream => 1,
668                Append => 1,
669                Transparent => 0,
670                RawInflate => 1,
671                UnLzma     => 1,
672                @opts
673        or croak "Cannot open buffer/file: $AnyUncompressError" ;
674
675    1 while $o->read($out) > 0 ;
676
677    croak "Error uncompressing -- " . $o->error()
678        if $o->error() ;
679
680    return ($o->getHeaderInfo()) ;
681
682}
683
684sub mkComplete
685{
686    my $class = shift ;
687    my $data = shift;
688    my $Error = getErrorRef($class);
689
690    my $buffer ;
691    my %params = ();
692
693    if ($class eq 'IO::Compress::Gzip') {
694        %params = (
695            Name       => "My name",
696            Comment    => "a comment",
697            ExtraField => ['ab' => "extra"],
698            HeaderCRC  => 1);
699    }
700    elsif ($class eq 'IO::Compress::Zip'){
701        %params = (
702            Name              => "My name",
703            Comment           => "a comment",
704            ZipComment        => "last comment",
705            exTime            => [100, 200, 300],
706            ExtraFieldLocal   => ["ab" => "extra1"],
707            ExtraFieldCentral => ["cd" => "extra2"],
708        );
709    }
710
711    my $z = new $class( \$buffer, %params)
712        or croak "Cannot create $class object: $$Error";
713    $z->write($data);
714    $z->close();
715
716    my $unc = getInverse($class);
717    anyUncompress(\$buffer) eq $data
718        or die "bad bad bad";
719    my $u = new $unc( \$buffer);
720    my $info = $u->getHeaderInfo() ;
721
722
723    return wantarray ? ($info, $buffer) : $buffer ;
724}
725
726sub mkErr
727{
728    my $string = shift ;
729    my ($dummy, $file, $line) = caller ;
730    -- $line ;
731
732    $file = quotemeta($file);
733
734    #return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
735    return "/$string\\s+at /" ;
736}
737
738sub mkEvalErr
739{
740    my $string = shift ;
741
742    #return "/$string\\s+at \\(eval /" if $] > 5.006 ;
743    return "/$string\\s+at /" ;
744}
745
746sub dumpObj
747{
748    my $obj = shift ;
749
750    my ($dummy, $file, $line) = caller ;
751
752    if (@_)
753    {
754        print "#\n# dumpOBJ from $file line $line @_\n" ;
755    }
756    else
757    {
758        print "#\n# dumpOBJ from $file line $line \n" ;
759    }
760
761    my $max = 0 ;;
762    foreach my $k (keys %{ *$obj })
763    {
764        $max = length $k if length $k > $max ;
765    }
766
767    foreach my $k (sort keys %{ *$obj })
768    {
769        my $v = $obj->{$k} ;
770        $v = '-undef-' unless defined $v;
771        my $pad = ' ' x ($max - length($k) + 2) ;
772        print "# $k$pad: [$v]\n";
773    }
774    print "#\n" ;
775}
776
777
778sub getMultiValues
779{
780    my $class = shift ;
781
782    return (0,0) if $class =~ /lzf|lzma|zstd/i;
783    return (1,0);
784}
785
786
787sub gotScalarUtilXS
788{
789    eval ' use Scalar::Util "dualvar" ';
790    return $@ ? 0 : 1 ;
791}
792
793package CompTestUtils;
794
7951;
796__END__
797	t/Test/Builder.pm
798	t/Test/More.pm
799	t/Test/Simple.pm
800	t/compress/CompTestUtils.pm
801	t/compress/any.pl
802	t/compress/anyunc.pl
803	t/compress/destroy.pl
804	t/compress/generic.pl
805	t/compress/merge.pl
806	t/compress/multi.pl
807	t/compress/newtied.pl
808	t/compress/oneshot.pl
809	t/compress/prime.pl
810	t/compress/tied.pl
811	t/compress/truncate.pl
812	t/compress/zlib-generic.plParsing config.in...
813Building Zlib enabled
814Auto Detect Gzip OS Code..
815Setting Gzip OS Code to 3 [Unix/Default]
816Looks Good.
817