[p5sagit/p5-mst-13.2.git] / cpan / IO-Compress / t / compress / CompTestUtils.pm

package CompTestUtils;

package main ;

use strict ;
use warnings;
use bytes;

#use lib qw(t t/compress);

use Carp ;
#use Test::More ; 


sub title
{
    #diag "" ; 
    ok 1, $_[0] ;
    #diag "" ;
}

sub like_eval
{
    like $@, @_ ;
}

{
    package LexFile ;

    our ($index);
    $index = '00000';
    
    sub new
    {
        my $self = shift ;
        foreach (@_)
        {
            # autogenerate the name unless if none supplied
            $_ = "tst" . $index ++ . ".tmp"
                unless defined $_;
        }
        chmod 0777, @_;
        for (@_) { 1 while unlink $_ } ;
        bless [ @_ ], $self ;
    }

    sub DESTROY
    {
        my $self = shift ;
        chmod 0777, @{ $self } ;
        for (@$self) { 1 while unlink $_ } ;
    }

}

{
    package LexDir ;

    use File::Path;
    sub new
    {
        my $self = shift ;
        foreach (@_) { rmtree $_ }
        bless [ @_ ], $self ;
    }

    sub DESTROY
    {
        my $self = shift ;
        foreach (@$self) { rmtree $_ }
    }
}
sub readFile
{
    my $f = shift ;

    my @strings ;

    if (IO::Compress::Base::Common::isaFilehandle($f))
    {
        my $pos = tell($f);
        seek($f, 0,0);
        @strings = <$f> ;	
        seek($f, 0, $pos);
    }
    else
    {
        open (F, "<$f") 
            or croak "Cannot open $f: $!\n" ;
        binmode F;
        @strings = <F> ;	
        close F ;
    }

    return @strings if wantarray ;
    return join "", @strings ;
}

sub touch
{
    foreach (@_) { writeFile($_, '') }
}

sub writeFile
{
    my($filename, @strings) = @_ ;
    1 while unlink $filename ;
    open (F, ">$filename") 
        or croak "Cannot open $filename: $!\n" ;
    binmode F;
    foreach (@strings) {
        no warnings ;
        print F $_ ;
    }
    close F ;
}

sub GZreadFile
{
    my ($filename) = shift ;

    my ($uncomp) = "" ;
    my $line = "" ;
    my $fil = gzopen($filename, "rb") 
        or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ;

    $uncomp .= $line 
        while $fil->gzread($line) > 0;

    $fil->gzclose ;
    return $uncomp ;
}

sub hexDump
{
    my $d = shift ;

    if (IO::Compress::Base::Common::isaFilehandle($d))
    {
        $d = readFile($d);
    }
    elsif (IO::Compress::Base::Common::isaFilename($d))
    {
        $d = readFile($d);
    }
    else
    {
        $d = $$d ;
    }

    my $offset = 0 ;

    $d = '' unless defined $d ;
    #while (read(STDIN, $data, 16)) {
    while (my $data = substr($d, 0, 16)) {
        substr($d, 0, 16) = '' ;
        printf "# %8.8lx    ", $offset;
        $offset += 16;

        my @array = unpack('C*', $data);
        foreach (@array) {
            printf('%2.2x ', $_);
        }
        print "   " x (16 - @array)
            if @array < 16 ;
        $data =~ tr/\0-\37\177-\377/./;
        print "  $data\n";
    }

}

sub readHeaderInfo
{
    my $name = shift ;
    my %opts = @_ ;

    my $string = <<EOM;
some text
EOM

    ok my $x = new IO::Compress::Gzip $name, %opts 
        or diag "GzipError is $IO::Compress::Gzip::GzipError" ;
    ok $x->write($string) ;
    ok $x->close ;

    #is GZreadFile($name), $string ;

    ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0
        or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
    ok my $hdr = $gunz->getHeaderInfo();
    my $uncomp ;
    ok $gunz->read($uncomp) ;
    ok $uncomp eq $string;
    ok $gunz->close ;

    return $hdr ;
}

sub cmpFile
{
    my ($filename, $uue) = @_ ;
    return readFile($filename) eq unpack("u", $uue) ;
}

#sub isRawFormat
#{
#    my $class = shift;
#    # TODO -- add Lzma here?
#    my %raw = map { $_ => 1 } qw( RawDeflate );
#
#    return defined $raw{$class};
#}


my %TOP = (
    'IO::Uncompress::AnyInflate' => { Inverse  => 'IO::Compress::Gzip',
                                      Error    => 'AnyInflateError',
                                      TopLevel => 'anyinflate',
                                      Raw      => 0,
                            },

    'IO::Uncompress::AnyUncompress' => { Inverse  => 'IO::Compress::Gzip',
                                         Error    => 'AnyUncompressError',
                                         TopLevel => 'anyuncompress',
                                         Raw      => 0,
                            },

    'IO::Compress::Gzip' => { Inverse  => 'IO::Uncompress::Gunzip',
                              Error    => 'GzipError',
                              TopLevel => 'gzip',
                              Raw      => 0,
                            },
    'IO::Uncompress::Gunzip' => { Inverse  => 'IO::Compress::Gzip',
                                  Error    => 'GunzipError',
                                  TopLevel => 'gunzip',
                                  Raw      => 0,
                            },

    'IO::Compress::Deflate' => { Inverse  => 'IO::Uncompress::Inflate',
                                 Error    => 'DeflateError',
                                 TopLevel => 'deflate',
                                 Raw      => 0,
                            },
    'IO::Uncompress::Inflate' => { Inverse  => 'IO::Compress::Deflate',
                                   Error    => 'InflateError',
                                   TopLevel => 'inflate',
                                   Raw      => 0,
                            },

    'IO::Compress::RawDeflate' => { Inverse  => 'IO::Uncompress::RawInflate',
                                    Error    => 'RawDeflateError',
                                    TopLevel => 'rawdeflate',
                                    Raw      => 1,
                            },
    'IO::Uncompress::RawInflate' => { Inverse  => 'IO::Compress::RawDeflate',
                                      Error    => 'RawInflateError',
                                      TopLevel => 'rawinflate',
                                      Raw      => 1,
                            },

    'IO::Compress::Zip' => { Inverse  => 'IO::Uncompress::Unzip',
                             Error    => 'ZipError',
                             TopLevel => 'zip',
                             Raw      => 0,
                            },
    'IO::Uncompress::Unzip' => { Inverse  => 'IO::Compress::Zip',
                                 Error    => 'UnzipError',
                                 TopLevel => 'unzip',
                                 Raw      => 0,
                            },

    'IO::Compress::Bzip2' => { Inverse  => 'IO::Uncompress::Bunzip2',
                               Error    => 'Bzip2Error',
                               TopLevel => 'bzip2',
                               Raw      => 0,
                            },
    'IO::Uncompress::Bunzip2' => { Inverse  => 'IO::Compress::Bzip2',
                                   Error    => 'Bunzip2Error',
                                   TopLevel => 'bunzip2',
                                   Raw      => 0,
                            },

    'IO::Compress::Lzop' => { Inverse  => 'IO::Uncompress::UnLzop',
                              Error    => 'LzopError',
                              TopLevel => 'lzop',
                              Raw      => 0,
                            },
    'IO::Uncompress::UnLzop' => { Inverse  => 'IO::Compress::Lzop',
                                  Error    => 'UnLzopError',
                                  TopLevel => 'unlzop',
                                  Raw      => 0,
                            },

    'IO::Compress::Lzf' => { Inverse  => 'IO::Uncompress::UnLzf',
                             Error    => 'LzfError',
                             TopLevel => 'lzf',
                             Raw      => 0,
                            },
    'IO::Uncompress::UnLzf' => { Inverse  => 'IO::Compress::Lzf',
                                 Error    => 'UnLzfError',
                                 TopLevel => 'unlzf',
                                 Raw      => 0,
                            },

    'IO::Compress::Lzma' => { Inverse  => 'IO::Uncompress::UnLzma',
                              Error    => 'LzmaError',
                              TopLevel => 'lzma',
                              Raw      => 1,
                            },
    'IO::Uncompress::UnLzma' => { Inverse  => 'IO::Compress::Lzma',
                                  Error    => 'UnLzmaError',
                                  TopLevel => 'unlzma',
                                  Raw      => 1,
                                },

    'IO::Compress::Xz' => { Inverse  => 'IO::Uncompress::UnXz',
                            Error    => 'XzError',
                            TopLevel => 'xz',
                            Raw      => 0,
                          },
    'IO::Uncompress::UnXz' => { Inverse  => 'IO::Compress::Xz',
                                Error    => 'UnXzError',
                                TopLevel => 'unxz',
                                Raw      => 0,
                              },

    'IO::Compress::PPMd' => { Inverse  => 'IO::Uncompress::UnPPMd',
                              Error    => 'PPMdError',
                              TopLevel => 'ppmd',
                              Raw      => 0,
                            },
    'IO::Uncompress::UnPPMd' => { Inverse  => 'IO::Compress::PPMd',
                                  Error    => 'UnPPMdError',
                                  TopLevel => 'unppmd',
                                  Raw      => 0,
                                },

    'IO::Compress::DummyComp' => { Inverse  => 'IO::Uncompress::DummyUnComp',
                                   Error    => 'DummyCompError',
                                   TopLevel => 'dummycomp',
                                   Raw      => 0,
                                 },
    'IO::Uncompress::DummyUnComp' => { Inverse  => 'IO::Compress::DummyComp',
                                       Error    => 'DummyUnCompError',
                                       TopLevel => 'dummyunComp',
                                       Raw      => 0,
                                     },
);


for my $key (keys %TOP)
{
    no strict;
    no warnings;
    $TOP{$key}{Error}    = \${ $key . '::' . $TOP{$key}{Error}    };
    $TOP{$key}{TopLevel} =     $key . '::' . $TOP{$key}{TopLevel}  ;

    # Silence used once warning in really old perl
    my $dummy            = \${ $key . '::' . $TOP{$key}{Error}    };

    #$TOP{$key . "::" . $TOP{$key}{TopLevel} } = $TOP{$key};
}

sub uncompressBuffer
{
    my $compWith = shift ;
    my $buffer = shift ;


    my $out ;
    my $obj = $TOP{$compWith}{Inverse}->new( \$buffer, -Append => 1);
    1 while $obj->read($out) > 0 ;
    return $out ;

}


sub getInverse
{
    my $class = shift ;

    return $TOP{$class}{Inverse};
}

sub getErrorRef
{
    my $class = shift ;

    return $TOP{$class}{Error};
}

sub getTopFuncRef
{
    my $class = shift ;

    die "Cannot find $class"
        if ! defined $TOP{$class}{TopLevel};
    return \&{ $TOP{$class}{TopLevel} } ;
}

sub getTopFuncName
{
    my $class = shift ;

    return $TOP{$class}{TopLevel} ;
}

sub compressBuffer
{
    my $compWith = shift ;
    my $buffer = shift ;


    my $out ;
    die "Cannot find $compWith"
        if ! defined $TOP{$compWith}{Inverse};
    my $obj = $TOP{$compWith}{Inverse}->new( \$out);
    $obj->write($buffer) ;
    $obj->close();
    return $out ;
}

our ($AnyUncompressError);
BEGIN
{
    eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); ';
}

sub anyUncompress
{
    my $buffer = shift ;
    my $already = shift;

    my @opts = ();
    if (ref $buffer && ref $buffer eq 'ARRAY')
    {
        @opts = @$buffer;
        $buffer = shift @opts;
    }

    if (ref $buffer)
    {
        croak "buffer is undef" unless defined $$buffer;
        croak "buffer is empty" unless length $$buffer;

    }


    my $data ;
    if (IO::Compress::Base::Common::isaFilehandle($buffer))
    {
        $data = readFile($buffer);
    }
    elsif (IO::Compress::Base::Common::isaFilename($buffer))
    {
        $data = readFile($buffer);
    }
    else
    {
        $data = $$buffer ;
    }

    if (defined $already && length $already)
    {

        my $got = substr($data, 0, length($already));
        substr($data, 0, length($already)) = '';

        is $got, $already, '  Already OK' ;
    }

    my $out = '';
    my $o = new IO::Uncompress::AnyUncompress \$data, 
                    Append => 1, 
                    Transparent => 0, 
                    RawInflate => 1,
                    @opts
        or croak "Cannot open buffer/file: $AnyUncompressError" ;

    1 while $o->read($out) > 0 ;

    croak "Error uncompressing -- " . $o->error()
        if $o->error() ;

    return $out ;

}

sub getHeaders
{
    my $buffer = shift ;
    my $already = shift;

    my @opts = ();
    if (ref $buffer && ref $buffer eq 'ARRAY')
    {
        @opts = @$buffer;
        $buffer = shift @opts;
    }

    if (ref $buffer)
    {
        croak "buffer is undef" unless defined $$buffer;
        croak "buffer is empty" unless length $$buffer;

    }


    my $data ;
    if (IO::Compress::Base::Common::isaFilehandle($buffer))
    {
        $data = readFile($buffer);
    }
    elsif (IO::Compress::Base::Common::isaFilename($buffer))
    {
        $data = readFile($buffer);
    }
    else
    {
        $data = $$buffer ;
    }

    if (defined $already && length $already)
    {

        my $got = substr($data, 0, length($already));
        substr($data, 0, length($already)) = '';

        is $got, $already, '  Already OK' ;
    }

    my $out = '';
    my $o = new IO::Uncompress::AnyUncompress \$data, 
                MultiStream => 1, 
                Append => 1, 
                Transparent => 0, 
                RawInflate => 1,
                @opts
        or croak "Cannot open buffer/file: $AnyUncompressError" ;

    1 while $o->read($out) > 0 ;

    croak "Error uncompressing -- " . $o->error()
        if $o->error() ;

    return ($o->getHeaderInfo()) ;

}

sub mkComplete
{
    my $class = shift ;
    my $data = shift;
    my $Error = getErrorRef($class);

    my $buffer ;
    my %params = ();

    if ($class eq 'IO::Compress::Gzip') {
        %params = (
            Name       => "My name",
            Comment    => "a comment",
            ExtraField => ['ab' => "extra"],
            HeaderCRC  => 1);
    }
    elsif ($class eq 'IO::Compress::Zip'){
        %params = (
            Name              => "My name",
            Comment           => "a comment",
            ZipComment        => "last comment",
            exTime            => [100, 200, 300],
            ExtraFieldLocal   => ["ab" => "extra1"],
            ExtraFieldCentral => ["cd" => "extra2"],
        );
    }

    my $z = new $class( \$buffer, %params)
        or croak "Cannot create $class object: $$Error";
    $z->write($data);
    $z->close();

    my $unc = getInverse($class);
    anyUncompress(\$buffer) eq $data
        or die "bad bad bad";
    my $u = new $unc( \$buffer);
    my $info = $u->getHeaderInfo() ;


    return wantarray ? ($info, $buffer) : $buffer ;
}

sub mkErr
{
    my $string = shift ;
    my ($dummy, $file, $line) = caller ;
    -- $line ;

    $file = quotemeta($file);

    #return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
    return "/$string\\s+at /" ;
}

sub mkEvalErr
{
    my $string = shift ;

    #return "/$string\\s+at \\(eval /" if $] > 5.006 ;
    return "/$string\\s+at /" ;
}

sub dumpObj
{
    my $obj = shift ;

    my ($dummy, $file, $line) = caller ;

    if (@_)
    {
        print "#\n# dumpOBJ from $file line $line @_\n" ;
    }
    else
    {
        print "#\n# dumpOBJ from $file line $line \n" ;
    }

    my $max = 0 ;;
    foreach my $k (keys %{ *$obj })
    {
        $max = length $k if length $k > $max ;
    }

    foreach my $k (sort keys %{ *$obj })
    {
        my $v = $obj->{$k} ;
        $v = '-undef-' unless defined $v;
        my $pad = ' ' x ($max - length($k) + 2) ;
        print "# $k$pad: [$v]\n";
    }
    print "#\n" ;
}


sub getMultiValues
{
    my $class = shift ;

    return (0,0) if $class =~ /lzf/i;
    return (1,0);
}


sub gotScalarUtilXS
{
    eval ' use Scalar::Util "dualvar" ';
    return $@ ? 0 : 1 ;
}

package CompTestUtils;

1;
__END__
	t/Test/Builder.pm
	t/Test/More.pm
	t/Test/Simple.pm
	t/compress/CompTestUtils.pm
	t/compress/any.pl
	t/compress/anyunc.pl
	t/compress/destroy.pl
	t/compress/generic.pl
	t/compress/merge.pl
	t/compress/multi.pl
	t/compress/newtied.pl
	t/compress/oneshot.pl
	t/compress/prime.pl
	t/compress/tied.pl
	t/compress/truncate.pl
	t/compress/zlib-generic.plParsing config.in...
Building Zlib enabled
Auto Detect Gzip OS Code..
Setting Gzip OS Code to 3 [Unix/Default]
Looks Good.
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);
258133d1	10
25f0751f	11	use Carp ;
258133d1	12	#use Test::More ;
258133d1	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
10c2b2bb	206	#sub isRawFormat
	207	#{
	208	# my $class = shift;
	209	# # TODO -- add Lzma here?
	210	# my %raw = map { $_ => 1 } qw( RawDeflate );
	211	#
	212	# return defined $raw{$class};
	213	#}
	214
	215
	216
	217	my %TOP = (
	218	'IO::Uncompress::AnyInflate' => { Inverse => 'IO::Compress::Gzip',
	219	Error => 'AnyInflateError',
	220	TopLevel => 'anyinflate',
	221	Raw => 0,
	222	},
	223
	224	'IO::Uncompress::AnyUncompress' => { Inverse => 'IO::Compress::Gzip',
	225	Error => 'AnyUncompressError',
	226	TopLevel => 'anyuncompress',
	227	Raw => 0,
	228	},
	229
	230	'IO::Compress::Gzip' => { Inverse => 'IO::Uncompress::Gunzip',
	231	Error => 'GzipError',
	232	TopLevel => 'gzip',
	233	Raw => 0,
	234	},
	235	'IO::Uncompress::Gunzip' => { Inverse => 'IO::Compress::Gzip',
	236	Error => 'GunzipError',
	237	TopLevel => 'gunzip',
	238	Raw => 0,
	239	},
	240
	241	'IO::Compress::Deflate' => { Inverse => 'IO::Uncompress::Inflate',
	242	Error => 'DeflateError',
	243	TopLevel => 'deflate',
	244	Raw => 0,
	245	},
	246	'IO::Uncompress::Inflate' => { Inverse => 'IO::Compress::Deflate',
	247	Error => 'InflateError',
	248	TopLevel => 'inflate',
	249	Raw => 0,
	250	},
	251
	252	'IO::Compress::RawDeflate' => { Inverse => 'IO::Uncompress::RawInflate',
	253	Error => 'RawDeflateError',
	254	TopLevel => 'rawdeflate',
	255	Raw => 1,
	256	},
	257	'IO::Uncompress::RawInflate' => { Inverse => 'IO::Compress::RawDeflate',
	258	Error => 'RawInflateError',
	259	TopLevel => 'rawinflate',
	260	Raw => 1,
	261	},
	262
	263	'IO::Compress::Zip' => { Inverse => 'IO::Uncompress::Unzip',
	264	Error => 'ZipError',
	265	TopLevel => 'zip',
	266	Raw => 0,
	267	},
	268	'IO::Uncompress::Unzip' => { Inverse => 'IO::Compress::Zip',
	269	Error => 'UnzipError',
270	TopLevel => 'unzip',
271	Raw => 0,
272	},
273
274	'IO::Compress::Bzip2' => { Inverse => 'IO::Uncompress::Bunzip2',
275	Error => 'Bzip2Error',
276	TopLevel => 'bzip2',
277	Raw => 0,
278	},
279	'IO::Uncompress::Bunzip2' => { Inverse => 'IO::Compress::Bzip2',
280	Error => 'Bunzip2Error',
281	TopLevel => 'bunzip2',
282	Raw => 0,
283	},
284
285	'IO::Compress::Lzop' => { Inverse => 'IO::Uncompress::UnLzop',
286	Error => 'LzopError',
287	TopLevel => 'lzop',
288	Raw => 0,
289	},
290	'IO::Uncompress::UnLzop' => { Inverse => 'IO::Compress::Lzop',
291	Error => 'UnLzopError',
292	TopLevel => 'unlzop',
293	Raw => 0,
294	},
295
296	'IO::Compress::Lzf' => { Inverse => 'IO::Uncompress::UnLzf',
297	Error => 'LzfError',
298	TopLevel => 'lzf',
299	Raw => 0,
300	},
301	'IO::Uncompress::UnLzf' => { Inverse => 'IO::Compress::Lzf',
302	Error => 'UnLzfError',
303	TopLevel => 'unlzf',
304	Raw => 0,
305	},
306
307	'IO::Compress::Lzma' => { Inverse => 'IO::Uncompress::UnLzma',
308	Error => 'LzmaError',
309	TopLevel => 'lzma',
310	Raw => 1,
311	},
312	'IO::Uncompress::UnLzma' => { Inverse => 'IO::Compress::Lzma',
313	Error => 'UnLzmaError',
314	TopLevel => 'unlzma',
315	Raw => 1,
316	},
317
318	'IO::Compress::Xz' => { Inverse => 'IO::Uncompress::UnXz',
319	Error => 'XzError',
320	TopLevel => 'xz',
321	Raw => 0,
322	},
323	'IO::Uncompress::UnXz' => { Inverse => 'IO::Compress::Xz',
324	Error => 'UnXzError',
325	TopLevel => 'unxz',
326	Raw => 0,
327	},
328
329	'IO::Compress::PPMd' => { Inverse => 'IO::Uncompress::UnPPMd',
330	Error => 'PPMdError',
331	TopLevel => 'ppmd',
332	Raw => 0,
333	},
334	'IO::Uncompress::UnPPMd' => { Inverse => 'IO::Compress::PPMd',
335	Error => 'UnPPMdError',
336	TopLevel => 'unppmd',
337	Raw => 0,
338	},
339
340	'IO::Compress::DummyComp' => { Inverse => 'IO::Uncompress::DummyUnComp',
341	Error => 'DummyCompError',
342	TopLevel => 'dummycomp',
343	Raw => 0,
344	},
345	'IO::Uncompress::DummyUnComp' => { Inverse => 'IO::Compress::DummyComp',
346	Error => 'DummyUnCompError',
347	TopLevel => 'dummyunComp',
348	Raw => 0,
349	},
350	);
351
352
353	for my $key (keys %TOP)
d54256af	354	{
10c2b2bb	355	no strict;
	356	no warnings;
	357	$TOP{$key}{Error} = \${ $key . '::' . $TOP{$key}{Error} };
	358	$TOP{$key}{TopLevel} = $key . '::' . $TOP{$key}{TopLevel} ;
d54256af	359
10c2b2bb	360	# Silence used once warning in really old perl
	361	my $dummy = \${ $key . '::' . $TOP{$key}{Error} };
	362
	363	#$TOP{$key . "::" . $TOP{$key}{TopLevel} } = $TOP{$key};
d54256af	364	}
d54256af	365
25f0751f	366	sub uncompressBuffer
	367	{
	368	my $compWith = shift ;
	369	my $buffer = shift ;
	370
25f0751f	371
25f0751f	372	my $out ;
10c2b2bb	373	my $obj = $TOP{$compWith}{Inverse}->new( \$buffer, -Append => 1);
25f0751f	374	1 while $obj->read($out) > 0 ;
	375	return $out ;
	376
	377	}
	378
25f0751f	379
	380	sub getInverse
	381	{
	382	my $class = shift ;
	383
10c2b2bb	384	return $TOP{$class}{Inverse};
25f0751f	385	}
	386
	387	sub getErrorRef
	388	{
	389	my $class = shift ;
	390
10c2b2bb	391	return $TOP{$class}{Error};
25f0751f	392	}
	393
	394	sub getTopFuncRef
	395	{
	396	my $class = shift ;
	397
10c2b2bb	398	die "Cannot find $class"
	399	if ! defined $TOP{$class}{TopLevel};
	400	return \&{ $TOP{$class}{TopLevel} } ;
25f0751f	401	}
	402
	403	sub getTopFuncName
	404	{
	405	my $class = shift ;
	406
10c2b2bb	407	return $TOP{$class}{TopLevel} ;
25f0751f	408	}
	409
	410	sub compressBuffer
	411	{
	412	my $compWith = shift ;
	413	my $buffer = shift ;
	414
25f0751f	415
25f0751f	416	my $out ;
10c2b2bb	417	die "Cannot find $compWith"
	418	if ! defined $TOP{$compWith}{Inverse};
	419	my $obj = $TOP{$compWith}{Inverse}->new( \$out);
25f0751f	420	$obj->write($buffer) ;
	421	$obj->close();
	422	return $out ;
	423	}
	424
	425	our ($AnyUncompressError);
	426	BEGIN
	427	{
258133d1	428	eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); ';
25f0751f	429	}
	430
	431	sub anyUncompress
	432	{
	433	my $buffer = shift ;
	434	my $already = shift;
	435
	436	my @opts = ();
	437	if (ref $buffer && ref $buffer eq 'ARRAY')
	438	{
	439	@opts = @$buffer;
	440	$buffer = shift @opts;
	441	}
	442
	443	if (ref $buffer)
	444	{
	445	croak "buffer is undef" unless defined $$buffer;
	446	croak "buffer is empty" unless length $$buffer;
	447
	448	}
	449
	450
	451	my $data ;
	452	if (IO::Compress::Base::Common::isaFilehandle($buffer))
	453	{
	454	$data = readFile($buffer);
	455	}
	456	elsif (IO::Compress::Base::Common::isaFilename($buffer))
	457	{
	458	$data = readFile($buffer);
	459	}
	460	else
	461	{
	462	$data = $$buffer ;
	463	}
	464
	465	if (defined $already && length $already)
	466	{
	467
	468	my $got = substr($data, 0, length($already));
	469	substr($data, 0, length($already)) = '';
	470
	471	is $got, $already, ' Already OK' ;
	472	}
	473
	474	my $out = '';
6ecef415	475	my $o = new IO::Uncompress::AnyUncompress \$data,
	476	Append => 1,
	477	Transparent => 0,
	478	RawInflate => 1,
	479	@opts
25f0751f	480	or croak "Cannot open buffer/file: $AnyUncompressError" ;
	481
	482	1 while $o->read($out) > 0 ;
	483
	484	croak "Error uncompressing -- " . $o->error()
	485	if $o->error() ;
	486
	487	return $out ;
	488
	489	}
	490
	491	sub getHeaders
	492	{
	493	my $buffer = shift ;
	494	my $already = shift;
	495
	496	my @opts = ();
	497	if (ref $buffer && ref $buffer eq 'ARRAY')
	498	{
	499	@opts = @$buffer;
	500	$buffer = shift @opts;
	501	}
	502
	503	if (ref $buffer)
	504	{
	505	croak "buffer is undef" unless defined $$buffer;
	506	croak "buffer is empty" unless length $$buffer;
	507
	508	}
	509
	510
	511	my $data ;
	512	if (IO::Compress::Base::Common::isaFilehandle($buffer))
	513	{
	514	$data = readFile($buffer);
	515	}
	516	elsif (IO::Compress::Base::Common::isaFilename($buffer))
	517	{
	518	$data = readFile($buffer);
	519	}
	520	else
	521	{
	522	$data = $$buffer ;
	523	}
	524
	525	if (defined $already && length $already)
	526	{
	527
	528	my $got = substr($data, 0, length($already));
	529	substr($data, 0, length($already)) = '';
	530
	531	is $got, $already, ' Already OK' ;
	532	}
	533
	534	my $out = '';
6ecef415	535	my $o = new IO::Uncompress::AnyUncompress \$data,
	536	MultiStream => 1,
	537	Append => 1,
	538	Transparent => 0,
	539	RawInflate => 1,
	540	@opts
25f0751f	541	or croak "Cannot open buffer/file: $AnyUncompressError" ;
	542
	543	1 while $o->read($out) > 0 ;
	544
	545	croak "Error uncompressing -- " . $o->error()
	546	if $o->error() ;
	547
	548	return ($o->getHeaderInfo()) ;
	549
	550	}
	551
	552	sub mkComplete
	553	{
	554	my $class = shift ;
	555	my $data = shift;
	556	my $Error = getErrorRef($class);
	557
	558	my $buffer ;
	559	my %params = ();
	560
	561	if ($class eq 'IO::Compress::Gzip') {
	562	%params = (
c70c1701	563	Name => "My name",
	564	Comment => "a comment",
	565	ExtraField => ['ab' => "extra"],
	566	HeaderCRC => 1);
25f0751f	567	}
	568	elsif ($class eq 'IO::Compress::Zip'){
	569	%params = (
c70c1701	570	Name => "My name",
	571	Comment => "a comment",
	572	ZipComment => "last comment",
	573	exTime => [100, 200, 300],
	574	ExtraFieldLocal => ["ab" => "extra1"],
	575	ExtraFieldCentral => ["cd" => "extra2"],
25f0751f	576	);
	577	}
	578
	579	my $z = new $class( \$buffer, %params)
	580	or croak "Cannot create $class object: $$Error";
	581	$z->write($data);
	582	$z->close();
	583
	584	my $unc = getInverse($class);
	585	anyUncompress(\$buffer) eq $data
	586	or die "bad bad bad";
	587	my $u = new $unc( \$buffer);
	588	my $info = $u->getHeaderInfo() ;
	589
	590
	591	return wantarray ? ($info, $buffer) : $buffer ;
	592	}
	593
	594	sub mkErr
	595	{
	596	my $string = shift ;
	597	my ($dummy, $file, $line) = caller ;
	598	-- $line ;
	599
	600	$file = quotemeta($file);
	601
10c2b2bb	602	#return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
25f0751f	603	return "/$string\\s+at /" ;
	604	}
	605
	606	sub mkEvalErr
	607	{
	608	my $string = shift ;
	609
10c2b2bb	610	#return "/$string\\s+at \\(eval /" if $] > 5.006 ;
25f0751f	611	return "/$string\\s+at /" ;
	612	}
	613
	614	sub dumpObj
	615	{
	616	my $obj = shift ;
	617
	618	my ($dummy, $file, $line) = caller ;
	619
	620	if (@_)
	621	{
	622	print "#\n# dumpOBJ from $file line $line @_\n" ;
	623	}
	624	else
	625	{
	626	print "#\n# dumpOBJ from $file line $line \n" ;
	627	}
	628
	629	my $max = 0 ;;
	630	foreach my $k (keys %{ *$obj })
	631	{
	632	$max = length $k if length $k > $max ;
	633	}
	634
	635	foreach my $k (sort keys %{ *$obj })
	636	{
	637	my $v = $obj->{$k} ;
	638	$v = '-undef-' unless defined $v;
	639	my $pad = ' ' x ($max - length($k) + 2) ;
	640	print "# $k$pad: [$v]\n";
	641	}
	642	print "#\n" ;
	643	}
	644
	645
258133d1	646	sub getMultiValues
	647	{
	648	my $class = shift ;
	649
	650	return (0,0) if $class =~ /lzf/i;
	651	return (1,0);
	652	}
	653
f6fd7794	654
	655	sub gotScalarUtilXS
	656	{
	657	eval ' use Scalar::Util "dualvar" ';
	658	return $@ ? 0 : 1 ;
	659	}
	660
25f0751f	661	package CompTestUtils;
	662
	663	1;
258133d1	664	__END__
	665	t/Test/Builder.pm
	666	t/Test/More.pm
	667	t/Test/Simple.pm
	668	t/compress/CompTestUtils.pm
	669	t/compress/any.pl
	670	t/compress/anyunc.pl
	671	t/compress/destroy.pl
	672	t/compress/generic.pl
	673	t/compress/merge.pl
	674	t/compress/multi.pl
	675	t/compress/newtied.pl
	676	t/compress/oneshot.pl
	677	t/compress/prime.pl
	678	t/compress/tied.pl
	679	t/compress/truncate.pl
	680	t/compress/zlib-generic.plParsing config.in...
	681	Building Zlib enabled
	682	Auto Detect Gzip OS Code..
	683	Setting Gzip OS Code to 3 [Unix/Default]
	684	Looks Good.