generic.pl

source of perl for linux application,

                    my $a = new $CompressClass($output, Append => $append)  ;
                    ok $a, "  Created $CompressClass";
                    my $string = "appended";
                    $a->write($string);
                    $a->close ;

                    my $data ; 
                    if ($fb eq 'buffer')
                    {
                        $data = $buffer;
                    }
                    else
                    {
                        $output->close
                            if $fb eq 'filehandle';
                        $data = readFile($name);
                    }

                    if ($append || $fb eq 'filehandle')
                    {
                        is substr($data, 0, length($already)), $already, "  got prefix";
                        substr($data, 0, length($already)) = '';
                    }


                    my $uncomp;
                    my $x = new $UncompressClass(\$data, Append => 1)  ;
                    ok $x, "  created $UncompressClass";

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

                    $x->close ;
                    is $uncomp, $string, '  Got uncompressed data' ;
                    
                }
            }
        }

        foreach my $type (qw(buffer filename filehandle))
        {
            foreach my $good (0, 1)
            {
                title "$UncompressClass -- InputLength, read from $type, good data => $good";

                my $compressed ; 
                my $string = "some data";
                my $appended = "append";

                if ($good)
                {
                    my $c = new $CompressClass(\$compressed);
                    $c->write($string);
                    $c->close();
                }
                else
                {
                    $compressed = $string ;
                }

                my $comp_len = length $compressed;
                $compressed .= $appended;

                my $lex = new LexFile my $name ;
                my $input ;
                writeFile ($name, $compressed);

                if ($type eq 'buffer')
                {
                    $input = \$compressed;
                }
                if ($type eq 'filename')
                {
                    $input = $name;
                }
                elsif ($type eq 'filehandle')
                {
                    my $fh = new IO::File "<$name" ;
                    ok $fh, "opened file $name ok";
                    $input = $fh ;
                }

                my $x = new $UncompressClass($input, 
                                             InputLength => $comp_len,
                                             Transparent => 1)  ;
                ok $x, "  created $UncompressClass";

                my $len ;
                my $output;
                $len = $x->read($output, 100);

                is $len, length($string);
                is $output, $string;

                if ($type eq 'filehandle')
                {
                    my $rest ;
                    $input->read($rest, 1000);
                    is $rest, $appended;
                }
            }


        }
        
        foreach my $append (0, 1)
        {
            title "$UncompressClass -- Append $append" ;

            my $lex = new LexFile my $name ;

            my $string = "appended";
            my $compressed ; 
            my $c = new $CompressClass(\$compressed);
            $c->write($string);
            $c->close();

            my $x = new $UncompressClass(\$compressed, Append => $append)  ;
            ok $x, "  created $UncompressClass";

            my $already = 'already';
            my $output = $already;

            my $len ;
            $len = $x->read($output, 100);
            is $len, length($string);

            $x->close ;

            if ($append)
            {
                is substr($output, 0, length($already)), $already, "  got prefix";
                substr($output, 0, length($already)) = '';
            }
            is $output, $string, '  Got uncompressed data' ;
        }
        

        foreach my $file (0, 1)
        {
            foreach my $trans (0, 1)
            {
                title "ungetc, File $file, Transparent $trans" ;

                my $lex = new LexFile my $name ;

                my $string = 'abcdeABCDE';
                my $b ;
                if ($trans)
                {
                    $b = $string ;
                }
                else
                {
                    my $a = new $CompressClass(\$b)  ;
                    $a->write($string);
                    $a->close ;
                }

                my $from ;
                if ($file)
                {
                    writeFile($name, $b);
                    $from = $name ;
                }
                else
                {
                    $from = \$b ;
                }

                my $u = $UncompressClass->new($from, Transparent => 1)  ;
                my $first;
                my $buff ;

                # do an ungetc before reading
                $u->ungetc("X");
                $first = $u->getc();
                is $first, 'X';

                $first = $u->getc();
                is $first, substr($string, 0,1);
                $u->ungetc($first);
                $first = $u->getc();
                is $first, substr($string, 0,1);
                $u->ungetc($first);

                is $u->read($buff, 5), 5 ;
                is $buff, substr($string, 0, 5);

                $u->ungetc($buff) ;
                is $u->read($buff, length($string)), length($string) ;
                is $buff, $string;

                is $u->read($buff, 1), 0;
                ok $u->eof() ;

                my $extra = 'extra';
                $u->ungetc($extra);
                ok ! $u->eof();
                is $u->read($buff), length($extra) ;
                is $buff, $extra;
                
                is $u->read($buff, 1), 0;
                ok $u->eof() ;

                # getc returns undef on eof
                is $u->getc(), undef;
                $u->close();

            }
        }


        {
            title "write tests - invalid data" ;

            #my $lex = new LexFile my $name1 ;
            my($Answer);

            #ok ! -e $name1, "  File $name1 does not exist";

            my @data = (
                [ '{ }',         "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
                [ '[ { } ]',     "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
                [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 
                [ '[ "" ]',      "${CompressClass}::write: input filename is undef or null string" ], 
                [ '[ undef ]',   "${CompressClass}::write: input filename is undef or null string" ], 
                [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], 
                #[ "not readable", 'xx' ], 
                # same filehandle twice, 'xx'
               ) ;

            foreach my $data (@data)
            {
                my ($send, $get) = @$data ;
                title "${CompressClass}::write( $send )";
                my($copy);
                eval "\$copy = $send";
                my $x = new $CompressClass(\$Answer);
                ok $x, "  Created $CompressClass object";
                eval { $x->write($copy) } ;
                #like $@, "/^$get/", "  error - $get";
                like $@, "/not a scalar reference /", "  error - not a scalar reference";
            }

    #        @data = (
    #            [ '[ $name1 ]',  "input file '$name1' does not exist" ], 
    #            #[ "not readable", 'xx' ], 
    #            # same filehandle twice, 'xx'
    #           ) ;
    #
    #        foreach my $data (@data)
    #        {
    #            my ($send, $get) = @$data ;
    #            title "${CompressClass}::write( $send )";
    #            my $copy;
    #            eval "\$copy = $send";
    #            my $x = new $CompressClass(\$Answer);
    #            ok $x, "  Created $CompressClass object";
    #            ok ! $x->write($copy), "  write fails"  ;
    #            like $$Error, "/^$get/", "  error - $get";
    #        }

            #exit;
            
        }


    #    sub deepCopy
    #    {
    #        if (! ref $_[0] || ref $_[0] eq 'SCALAR')
    #        {
    #            return $_[0] ;
    #        }
    #
    #        if (ref $_[0] eq 'ARRAY')
    #        {
    #            my @a ;
    #            for my $x ( @{ $_[0] })
    #            {
    #                push @a, deepCopy($x);
    #            }
    #
    #            return \@a ;
    #        }
    #
    #        croak "bad! $_[0]";
    #
    #    }
    #
    #    sub deepSubst
    #    {
    #        #my $data = shift ;
    #        my $from = $_[1] ;
    #        my $to   = $_[2] ;
    #
    #        if (! ref $_[0])
    #        {
    #            $_[0] = $to 
    #                if $_[0] eq $from ;
    #            return ;    
    #
    #        }
    #
    #        if (ref $_[0] eq 'SCALAR')
    #        {
    #            $_[0] = \$to 
    #                if defined ${ $_[0] } && ${ $_[0] } eq $from ;
    #            return ;    
    #
    #        }
    #
    #        if (ref $_[0] eq 'ARRAY')
    #        {
    #            for my $x ( @{ $_[0] })
    #            {
    #                deepSubst($x, $from, $to);
    #            }
    #            return ;
    #        }
    #        #croak "bad! $_[0]";
    #    }

    #    {
    #        title "More write tests" ;
    #
    #        my $file1 = "file1" ;
    #        my $file2 = "file2" ;
    #        my $file3 = "file3" ;
    #        my $lex = new LexFile $file1, $file2, $file3 ;
    #
    #        writeFile($file1, "F1");
    #        writeFile($file2, "F2");
    #        writeFile($file3, "F3");
    #
    #        my @data = (
    #              [ '""',                                   ""      ],
    #              [ 'undef',                                ""      ],
    #              [ '"abcd"',                               "abcd"  ],
    #
    #              [ '\""',                                   ""     ],
    #              [ '\undef',                                ""     ],
    #              [ '\"abcd"',                               "abcd" ],
    #
    #              [ '[]',                                    ""     ],
    #              [ '[[]]',                                  ""     ],
    #              [ '[[[]]]',                                ""     ],
    #              [ '[\""]',                                 ""     ],
    #              [ '[\undef]',                              ""     ],
    #              [ '[\"abcd"]',                             "abcd" ],
    #              [ '[\"ab", \"cd"]',                        "abcd" ],
    #              [ '[[\"ab"], [\"cd"]]',                    "abcd" ],
    #
    #              [ '$file1',                                $file1 ],
    #              [ '$fh2',                                  "F2"   ],
    #              [ '[$file1, \"abc"]',                      "F1abc"],
    #              [ '[\"a", $file1, \"bc"]',                 "aF1bc"],
    #              [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
    #              [ '[\"a", $fh1, \"bc", $file2]',           "aF1bcF2"],
    #              [ '[\"a", $fh1, \"bc", $file2, $fh3]',     "aF1bcF2F3"],
    #            ) ;
    #
    #
    #        foreach my $data (@data)
    #        {
    #            my ($send, $get) = @$data ;
    #
    #            my $fh1 = new IO::File "< $file1" ;
    #            my $fh2 = new IO::File "< $file2" ;
    #            my $fh3 = new IO::File "< $file3" ;
    #
    #            title "${CompressClass}::write( $send )";
    #            my $copy;
    #            eval "\$copy = $send";
    #            my $Answer ;
    #            my $x = new $CompressClass(\$Answer);
    #            ok $x, "  Created $CompressClass object";
    #            my $len = length $get;
    #            is $x->write($copy), length($get), "  write $len bytes";
    #            ok $x->close(), "  close ok" ;
    #
    #            is myGZreadFile(\$Answer), $get, "  got expected output" ;
    #            cmp_ok $$Error, '==', 0, "  no error";
    #
    #
    #        }
    #        
    #    }
    }

}

1;