comptestutils.pm

source of perl for linux application,

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 uncompressBuffer
{
    my $compWith = shift ;
    my $buffer = shift ;

    my %mapping = ( 'IO::Compress::Gzip'                     => 'IO::Uncompress::Gunzip',
                    'IO::Compress::Gzip::gzip'               => 'IO::Uncompress::Gunzip',
                    'IO::Compress::Deflate'                  => 'IO::Uncompress::Inflate',
                    'IO::Compress::Deflate::deflate'         => 'IO::Uncompress::Inflate',
                    'IO::Compress::RawDeflate'               => 'IO::Uncompress::RawInflate',
                    'IO::Compress::RawDeflate::rawdeflate'   => 'IO::Uncompress::RawInflate',
                    'IO::Compress::Bzip2'                    => 'IO::Uncompress::Bunzip2',
                    'IO::Compress::Bzip2::bzip2'             => 'IO::Uncompress::Bunzip2',
                    'IO::Compress::Zip'                      => 'IO::Uncompress::Unzip',
                    'IO::Compress::Zip::zip'                 => 'IO::Uncompress::Unzip',
                    'IO::Compress::Lzop'                     => 'IO::Uncompress::UnLzop',
                    'IO::Compress::Lzop::lzop'               => 'IO::Uncompress::UnLzop',
                    'IO::Compress::Lzf'                      => 'IO::Uncompress::UnLzf' ,
                    'IO::Compress::Lzf::lzf'                 => 'IO::Uncompress::UnLzf',
                    'IO::Compress::DummyComp'                => 'IO::Uncompress::DummyUncomp',
                    'IO::Compress::DummyComp::dummycomp'     => 'IO::Uncompress::DummyUncomp',
                );

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

}

my %ErrorMap = (    'IO::Compress::Gzip'                => \$IO::Compress::Gzip::GzipError,
                    'IO::Compress::Gzip::gzip'          => \$IO::Compress::Gzip::GzipError,
                    'IO::Uncompress::Gunzip'            => \$IO::Uncompress::Gunzip::GunzipError,
                    'IO::Uncompress::Gunzip::gunzip'    => \$IO::Uncompress::Gunzip::GunzipError,
                    'IO::Uncompress::Inflate'           => \$IO::Uncompress::Inflate::InflateError,
                    'IO::Uncompress::Inflate::inflate'  => \$IO::Uncompress::Inflate::InflateError,
                    'IO::Compress::Deflate'             => \$IO::Compress::Deflate::DeflateError,
                    'IO::Compress::Deflate::deflate'    => \$IO::Compress::Deflate::DeflateError,
                    'IO::Uncompress::RawInflate'        => \$IO::Uncompress::RawInflate::RawInflateError,
                    'IO::Uncompress::RawInflate::rawinflate'  => \$IO::Uncompress::RawInflate::RawInflateError,
                    'IO::Uncompress::AnyInflate'        => \$IO::Uncompress::AnyInflate::AnyInflateError,
                    'IO::Uncompress::AnyInflate::anyinflate'  => \$IO::Uncompress::AnyInflate::AnyInflateError,
                    'IO::Uncompress::AnyUncompress'        => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
                    'IO::Uncompress::AnyUncompress::anyUncompress'  => \$IO::Uncompress::AnyUncompress::AnyUncompressError,
                    'IO::Compress::RawDeflate'          => \$IO::Compress::RawDeflate::RawDeflateError,
                    'IO::Compress::RawDeflate::rawdeflate'  => \$IO::Compress::RawDeflate::RawDeflateError,
                    'IO::Compress::Bzip2'               => \$IO::Compress::Bzip2::Bzip2Error,
                    'IO::Compress::Bzip2::bzip2'        => \$IO::Compress::Bzip2::Bzip2Error,
                    'IO::Uncompress::Bunzip2'           => \$IO::Uncompress::Bunzip2::Bunzip2Error,
                    'IO::Uncompress::Bunzip2::bunzip2'  => \$IO::Uncompress::Bunzip2::Bunzip2Error,
                    'IO::Compress::Zip'                 => \$IO::Compress::Zip::ZipError,
                    'IO::Compress::Zip::zip'            => \$IO::Compress::Zip::ZipError,
                    'IO::Uncompress::Unzip'             => \$IO::Uncompress::Unzip::UnzipError,
                    'IO::Uncompress::Unzip::unzip'      => \$IO::Uncompress::Unzip::UnzipError,
                    'IO::Compress::Lzop'                => \$IO::Compress::Lzop::LzopError,
                    'IO::Compress::Lzop::lzop'          => \$IO::Compress::Lzop::LzopError,
                    'IO::Uncompress::UnLzop'            => \$IO::Uncompress::UnLzop::UnLzopError,
                    'IO::Uncompress::UnLzop::unlzop'    => \$IO::Uncompress::UnLzop::UnLzopError,
                    'IO::Compress::Lzf'                 => \$IO::Compress::Lzf::LzfError,
                    'IO::Compress::Lzf::lzf'            => \$IO::Compress::Lzf::LzfError,
                    'IO::Uncompress::UnLzf'             => \$IO::Uncompress::UnLzf::UnLzfError,
                    'IO::Uncompress::UnLzf::unlzf'      => \$IO::Uncompress::UnLzf::UnLzfError,

                    'IO::Compress::DummyComp'           => \$IO::Compress::DummyComp::DummyCompError,
                    'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError,
                    'IO::Uncompress::DummyUncomp'       => \$IO::Uncompress::DummyUncomp::DummyUncompError,
                    'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError,
               );

my %TopFuncMap = (  'IO::Compress::Gzip'          => 'IO::Compress::Gzip::gzip',
                    'IO::Uncompress::Gunzip'      => 'IO::Uncompress::Gunzip::gunzip',

                    'IO::Compress::Deflate'       => 'IO::Compress::Deflate::deflate',
                    'IO::Uncompress::Inflate'     => 'IO::Uncompress::Inflate::inflate',

                    'IO::Compress::RawDeflate'    => 'IO::Compress::RawDeflate::rawdeflate',
                    'IO::Uncompress::RawInflate'  => 'IO::Uncompress::RawInflate::rawinflate',

                    'IO::Uncompress::AnyInflate'  => 'IO::Uncompress::AnyInflate::anyinflate',
                    'IO::Uncompress::AnyUncompress'  => 'IO::Uncompress::AnyUncompress::anyuncompress',

                    'IO::Compress::Bzip2'         => 'IO::Compress::Bzip2::bzip2',
                    'IO::Uncompress::Bunzip2'     => 'IO::Uncompress::Bunzip2::bunzip2',

                    'IO::Compress::Zip'           => 'IO::Compress::Zip::zip',
                    'IO::Uncompress::Unzip'       => 'IO::Uncompress::Unzip::unzip',
                    'IO::Compress::Lzop'          => 'IO::Compress::Lzop::lzop',
                    'IO::Uncompress::UnLzop'      => 'IO::Uncompress::UnLzop::unlzop',
                    'IO::Compress::Lzf'           => 'IO::Compress::Lzf::lzf',
                    'IO::Uncompress::UnLzf'       => 'IO::Uncompress::UnLzf::unlzf',
                    'IO::Compress::DummyComp'     => 'IO::Compress::DummyComp::dummyuncomp',
                    'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp',
                 );

   %TopFuncMap = map { ($_              => $TopFuncMap{$_}, 
                        $TopFuncMap{$_} => $TopFuncMap{$_}) } 
                 keys %TopFuncMap ;

 #%TopFuncMap = map { ($_              => \&{ $TopFuncMap{$_} ) } 
                 #keys %TopFuncMap ;


my %inverse  = ( 'IO::Compress::Gzip'                    => 'IO::Uncompress::Gunzip',
                 'IO::Compress::Gzip::gzip'              => 'IO::Uncompress::Gunzip::gunzip',
                 'IO::Compress::Deflate'                 => 'IO::Uncompress::Inflate',
                 'IO::Compress::Deflate::deflate'        => 'IO::Uncompress::Inflate::inflate',
                 'IO::Compress::RawDeflate'              => 'IO::Uncompress::RawInflate',
                 'IO::Compress::RawDeflate::rawdeflate'  => 'IO::Uncompress::RawInflate::rawinflate',
                 'IO::Compress::Bzip2::bzip2'            => 'IO::Uncompress::Bunzip2::bunzip2',
                 'IO::Compress::Bzip2'                   => 'IO::Uncompress::Bunzip2',
                 'IO::Compress::Zip::zip'                => 'IO::Uncompress::Unzip::unzip',
                 'IO::Compress::Zip'                     => 'IO::Uncompress::Unzip',
                 'IO::Compress::Lzop::lzop'              => 'IO::Uncompress::UnLzop::unlzop',
                 'IO::Compress::Lzop'                    => 'IO::Uncompress::UnLzop',
                 'IO::Compress::Lzf::lzf'                => 'IO::Uncompress::UnLzf::unlzf',
                 'IO::Compress::Lzf'                     => 'IO::Uncompress::UnLzf',
                 'IO::Compress::DummyComp::dummycomp'    => 'IO::Uncompress::DummyUncomp::dummyuncomp',
                 'IO::Compress::DummyComp'               => 'IO::Uncompress::DummyUncomp',
             );