generic.pl

source of perl for linux application,

use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;

use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);

our ($UncompressClass);
BEGIN 
{ 
    # use Test::NoWarnings, if available
    my $extra = 0 ;

    my $st = eval { require Test::NoWarnings ;  import Test::NoWarnings; 1; };
    $extra = 1
        if $st ;

    plan(tests => 670 + $extra) ;
}

sub myGZreadFile
{
    my $filename = shift ;
    my $init = shift ;


    my $fil = new $UncompressClass $filename,
                                    -Strict   => 0,
                                    -Append   => 1
                                    ;

    my $data = '';
    $data = $init if defined $init ;
    1 while $fil->read($data) > 0;

    $fil->close ;
    return $data ;
}

sub run
{
    my $CompressClass   = identify();
    $UncompressClass = getInverse($CompressClass);
    my $Error           = getErrorRef($CompressClass);
    my $UnError         = getErrorRef($UncompressClass);

    {

        title "Testing $CompressClass Errors";

        # Buffer not writable
        eval qq[\$a = new $CompressClass(\\1) ;] ;
        like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ;
            
        my($out, $gz);
        $out = "" ;
        eval qq[\$a = new $CompressClass ] . '$out ;' ;
        like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
            
        $out = undef ;
        eval qq[\$a = new $CompressClass \$out ;] ;
        like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
            
        my $x ;
        $gz = new $CompressClass(\$x); 

        foreach my $name (qw(read readline getc))
        {
            eval " \$gz->$name() " ;
            like $@, mkEvalErr("^$name Not Available: File opened only for output");
        }

        eval ' $gz->write({})' ;
        like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference");
        #like $@, mkEvalErr("^${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref");

        eval ' $gz->syswrite("abc", 1, 5)' ;
        like $@, mkEvalErr("^${CompressClass}::write: offset outside string");

        eval ' $gz->syswrite("abc", 1, -4)' ;
        like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
    }


    {
        title "Testing $UncompressClass Errors";

        my $out = "" ;
        eval qq[\$a = new $UncompressClass \$out ;] ;
        like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
        $out = undef ;
        eval qq[\$a = new $UncompressClass \$out ;] ;
        like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");

        my $lex = new LexFile my $name ;

        ok ! -e $name, "  $name does not exist";
        
        eval qq[\$a = new $UncompressClass "$name" ;] ;
        is $$UnError, "input file '$name' does not exist";

        my $gc ;
        my $guz = new $CompressClass(\$gc); 
        $guz->write("abc") ;
        $guz->close();

        my $x ;
        my $gz = new $UncompressClass(\$gc); 

        foreach my $name (qw(print printf write))
        {
            eval " \$gz->$name() " ;
            like $@, mkEvalErr("^$name Not Available: File opened only for intput");
        }

    }

    {
        title "Testing $CompressClass and $UncompressClass";

        {
            my ($a, $x, @x) = ("","","") ;

            # Buffer not a scalar reference
            eval qq[\$a = new $CompressClass \\\@x ;] ;
            like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref");
                
            # Buffer not a scalar reference
            eval qq[\$a = new $UncompressClass \\\@x ;] ;
            like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref");
        }
            
        foreach my $Type ( $CompressClass, $UncompressClass)
        {
            # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate

            my ($a, $x, @x) = ("","","") ;

            # Odd number of parameters
            eval qq[\$a = new $Type "abc", -Output ] ;
            like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1");

            # Unknown parameter
            eval qq[\$a = new $Type  "anc", -Fred => 123 ;] ;
            like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred");

            # no in or out param
            eval qq[\$a = new $Type ;] ;
            like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter");

        }    


        {
            # write a very simple compressed file 
            # and read back 
            #========================================


            my $lex = new LexFile my $name ;
            #my $name = "/tmp/try.lzf";

            my $hello = <<EOM ;
hello world
this is a test
EOM

            {
              my $x ;
              ok $x = new $CompressClass $name  ;
              is $x->autoflush(1), 0, "autoflush";
              is $x->autoflush(1), 1, "autoflush";
              ok $x->opened(), "opened";

              ok $x->write($hello), "write" ;
              ok $x->flush(), "flush";
              ok $x->close, "close" ;
              ok ! $x->opened(), "! opened";
            }

            {
              my $uncomp;
              ok my $x = new $UncompressClass $name, -Append => 1  ;
              ok $x->opened(), "opened";

              my $len ;
              1 while ($len = $x->read($uncomp)) > 0 ;

              is $len, 0, "read returned 0"
                or diag $$UnError ;

              ok $x->close ;
              is $uncomp, $hello ;
              ok !$x->opened(), "! opened";
            }
        }

        {
            # write a very simple compressed file 
            # and read back 
            #========================================


            my $lex = new LexFile my $name ;

            my $hello = <<EOM ;
hello world
this is a test
EOM

            {
              my $x ;
              ok $x = new $CompressClass $name  ;

              is $x->write(''), 0, "Write empty string is ok";
              is $x->write(undef), 0, "Write undef is ok";
              ok $x->write($hello), "Write ok" ;
              ok $x->close, "Close ok" ;
            }

            {
              my $uncomp;
              my $x = new $UncompressClass $name  ;
              ok $x, "creates $UncompressClass $name"  ;

              my $data = '';
              $data .= $uncomp while $x->read($uncomp) > 0 ;

              ok $x->close, "close ok" ;
              is $data, $hello, "expected output" ;
            }
        }


        {
            # write a very simple file with using an IO filehandle
            # and read back 
            #========================================


            my $lex = new LexFile my $name ;

            my $hello = <<EOM ;
hello world
this is a test
EOM

            {
              my $fh = new IO::File ">$name" ;
              ok $fh, "opened file $name ok";
              my $x = new $CompressClass $fh  ;
              ok $x, " created $CompressClass $fh"  ;

              is $x->fileno(), fileno($fh), "fileno match" ;
              is $x->write(''), 0, "Write empty string is ok";
              is $x->write(undef), 0, "Write undef is ok";
              ok $x->write($hello), "write ok" ;
              ok $x->flush(), "flush";
              ok $x->close,"close" ;
              $fh->close() ;
            }

            my $uncomp;
            {
              my $x ;
              ok my $fh1 = new IO::File "<$name" ;
              ok $x = new $UncompressClass $fh1, -Append => 1  ;
              ok $x->fileno() == fileno $fh1 ;

              1 while $x->read($uncomp) > 0 ;

              ok $x->close ;
            }

            ok $hello eq $uncomp ;
        }

        {
            # write a very simple file with using a glob filehandle
            # and read back 
            #========================================


            my $lex = new LexFile my $name ;
            #my $name  = "/tmp/fred";

            my $hello = <<EOM ;
hello world
this is a test
EOM

            {
              title "$CompressClass: Input from typeglob filehandle";  
              ok open FH, ">$name" ;
     
              my $x = new $CompressClass *FH  ;
              ok $x, "  create $CompressClass"  ;

              is $x->fileno(), fileno(*FH), "  fileno" ;
              is $x->write(''), 0, "  Write empty string is ok";
              is $x->write(undef), 0, "  Write undef is ok";
              ok $x->write($hello), "  Write ok" ;
              ok $x->flush(), "  Flush";
              ok $x->close, "  Close" ;
              close FH;
            }


            my $uncomp;
            {
              title "$UncompressClass: Input from typeglob filehandle, append output";  
              my $x ;
              ok open FH, "<$name" ;
              ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0
                or diag $$UnError ;
              is $x->fileno(), fileno FH, "  fileno ok" ;

              1 while $x->read($uncomp) > 0 ;

              ok $x->close, "  close" ;
            }
            #exit;

            is $uncomp, $hello, "  expected output" ;
        }

        {
            my $lex = new LexFile my $name ;
            #my $name = "/tmp/fred";

            my $hello = <<EOM ;
hello world
this is a test
EOM

            {
              title "Outout to stdout via '-'" ;

              open(SAVEOUT, ">&STDOUT");
              my $dummy = fileno SAVEOUT;
              open STDOUT, ">$name" ;
     
              my $x = new $CompressClass '-'  ;
              $x->write($hello);
              $x->close;

              open(STDOUT, ">&SAVEOUT");

              ok 1, "  wrote to stdout" ;
            }
            is myGZreadFile($name), $hello, "  wrote OK";
            #hexDump($name);

            {
              title "Input from stdin via filename '-'";  

              my $x ;
              my $uncomp ;
              my $stdinFileno = fileno(STDIN);
              # open below doesn't return 1 sometines on XP
                 open(SAVEIN, "<&STDIN");
              ok open(STDIN, "<$name"), "  redirect STDIN";
              my $dummy = fileno SAVEIN;
              $x = new $UncompressClass '-', Append => 1, Transparent => 0
                    or diag $$UnError ;
              ok $x, "  created object" ;
              is $x->fileno(), $stdinFileno, "  fileno ok" ;

              1 while $x->read($uncomp) > 0 ;

              ok $x->close, "  close" ;
                 open(STDIN, "<&SAVEIN");
              is $uncomp, $hello, "  expected output" ;
            }
        }

        {
            # write a compressed file to memory 
            # and read back 
            #========================================

            #my $name = "test.gz" ;
            my $lex = new LexFile my $name ;

            my $hello = <<EOM ;
hello world
this is a test
EOM

            my $buffer ;
            {
              my $x ;
              ok $x = new $CompressClass(\$buffer) ;
          
              ok ! defined $x->autoflush(1) ;
              ok ! defined $x->autoflush(1) ;
              ok ! defined $x->fileno() ;
              is $x->write(''), 0, "Write empty string is ok";
              is $x->write(undef), 0, "Write undef is ok";