oneshot.pl

source of perl for linux application,

use lib 't';
use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;

BEGIN {
    plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
        if $] < 5.005 ;


    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };

    plan tests => 970 + $extra ;

    use_ok('IO::Uncompress::AnyUncompress', qw(anyuncompress $AnyUncompressError)) ;

}

sub run
{

    my $CompressClass   = identify();
    my $UncompressClass = getInverse($CompressClass);
    my $Error           = getErrorRef($CompressClass);
    my $UnError         = getErrorRef($UncompressClass);
    my $TopFuncName     = getTopFuncName($CompressClass);


    my @MultiValues     = getMultiValues($CompressClass);

    foreach my $bit ($CompressClass, $UncompressClass,
                     'IO::Uncompress::AnyUncompress',
                    )
    {
        my $Error = getErrorRef($bit);
        my $Func = getTopFuncRef($bit);
        my $TopType = getTopFuncName($bit);

        title "Testing $TopType Error Cases";

        my $a;
        my $x ;

        eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ;
        like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), '  Illegal Parameters';

        eval { $a = $Func->() ;} ;
        like $@, "/^$TopType: expected at least 1 parameters/", '  No Parameters';

        eval { $a = $Func->(\$x, \1) ;} ;
        like $$Error, "/^$TopType: output buffer is read-only/", '  Output is read-only' ;

        my $in ;
        eval { $a = $Func->($in, \$x) ;} ;
        like $@, mkErr("^$TopType: input filename is undef or null string"), 
            '  Input filename undef' ;

        $in = '';    
        eval { $a = $Func->($in, \$x) ;} ;
        like $@, mkErr("^$TopType: input filename is undef or null string"), 
            '  Input filename empty' ;

        {
            my $lex1 = new LexFile my $in ;
            writeFile($in, "abc");
            my $out = $in ;
            eval { $a = $Func->($in, $out) ;} ;
            like $@, mkErr("^$TopType: input and output filename are identical"),
                '  Input and Output filename are the same';
        }

        {
            my $dir = "tmpdir";
            my $lex = new LexDir $dir ;
            mkdir $dir, 0777 ;

            $a = $Func->($dir, \$x) ;
            is $a, undef, "  $TopType returned undef";
            like $$Error, "/input file '$dir' is a directory/",
                '  Input filename is a directory';

            $a = $Func->(\$x, $dir) ;
            is $a, undef, "  $TopType returned undef";
            like $$Error, "/output file '$dir' is a directory/",
                '  Output filename is a directory';
        }

        eval { $a = $Func->(\$in, \$in) ;} ;
        like $@, mkErr("^$TopType: input and output buffer are identical"),
            '  Input and Output buffer are the same';
            
        SKIP:
        {
            # Threaded 5.6.x seems to have a problem comparing filehandles.
            use Config;

            skip 'Cannot compare filehandles with threaded $]', 2
                if $] >= 5.006  && $] < 5.007 && $Config{useithreads};

            my $lex = new LexFile my $out_file ;
            open OUT, ">$out_file" ;
            eval { $a = $Func->(\*OUT, \*OUT) ;} ;
            like $@, mkErr("^$TopType: input and output handle are identical"),
                '  Input and Output handle are the same';
                
            close OUT;
            is -s $out_file, 0, "  File zero length" ;
        }

        {
            my %x = () ;
            my $object = bless \%x, "someClass" ;

            # Buffer not a scalar reference
            #eval { $a = $Func->(\$x, \%x) ;} ;
            eval { $a = $Func->(\$x, $object) ;} ;
            like $@, mkErr("^$TopType: illegal output parameter"),
                '  Bad Output Param';
                
            # Buffer not a scalar reference
            eval { $a = $Func->(\$x, \%x) ;} ;
            like $@, mkErr("^$TopType: illegal output parameter"),
                '  Bad Output Param';
                

            eval { $a = $Func->(\%x, \$x) ;} ;
            like $@, mkErr("^$TopType: illegal input parameter"),
                '  Bad Input Param';

            #eval { $a = $Func->(\%x, \$x) ;} ;
            eval { $a = $Func->($object, \$x) ;} ;
            like $@, mkErr("^$TopType: illegal input parameter"),
                '  Bad Input Param';
        }

        my $filename = 'abc.def';
        ok ! -e $filename, "  input file '$filename' does not exist";
        $a = $Func->($filename, \$x) ;
        is $a, undef, "  $TopType returned undef";
        like $$Error, "/^input file '$filename' does not exist\$/", "  input File '$filename' does not exist";
            
        $filename = '/tmp/abd/abc.def';
        ok ! -e $filename, "  output File '$filename' does not exist";
        $a = $Func->(\$x, $filename) ;
        is $a, undef, "  $TopType returned undef";
        like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), "  output File '$filename' does not exist";
            
        eval { $a = $Func->(\$x, '<abc>') } ;
        like $$Error, "/Need input fileglob for outout fileglob/",
                '  Output fileglob with no input fileglob';
        is $a, undef, "  $TopType returned undef";

        $a = $Func->('<abc)>', '<abc>') ;
        is $a, undef, "  $TopType returned undef";
        like $$Error, "/Unmatched \\) in input fileglob/",
                "  Unmatched ) in input fileglob";
    }

    foreach my $bit ($UncompressClass,
                     'IO::Uncompress::AnyUncompress',
                    )
    {
        my $Error = getErrorRef($bit);
        my $Func = getTopFuncRef($bit);
        my $TopType = getTopFuncName($bit);

        {
            my $in ;
            my $out ;
            my @x ;

            SKIP:
            {
                use Config;

                skip 'readonly + threads', 1
                    if $Config{useithreads};

                
                eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ;
                like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"),
                    '  TrailingData output not writable';
            }

            eval { $a = $Func->(\$in, \$out, TrailingData => \@x) ;} ;
            like $@, mkErr("^$TopType: Parameter 'TrailingData' not a scalar reference"),
                '  TrailingData output not scaral reference';
        }
    }

    foreach my $bit ($UncompressClass,
                     'IO::Uncompress::AnyUncompress',
                    )
    {
        my $Error = getErrorRef($bit);
        my $Func = getTopFuncRef($bit);
        my $TopType = getTopFuncName($bit);

        my $data = "mary had a little lamb" ;
        my $keep = $data ;

        for my $trans ( 0, 1)
        {
            title "Non-compressed data with $TopType, Transparent => $trans ";
            my $a;
            my $x ;
            my $out = '' ;

            $a = $Func->(\$data, \$out, Transparent => $trans) ;

            is $data, $keep, "  Input buffer not changed" ;

            if ($trans)
            {
                ok $a, "  $TopType returned true" ;
                is $out, $data, "  got expected output" ;
                ok ! $$Error, "  no error [$$Error]" ;
            }
            else
            {
                ok ! $a, "  $TopType returned false" ;
                #like $$Error, '/xxx/', "  error" ;
                ok $$Error, "  error is '$$Error'" ;
            }
        }
    }

    foreach my $bit ($CompressClass
                    )
    {
        my $Error = getErrorRef($bit);
        my $Func = getTopFuncRef($bit);
        my $TopType = getTopFuncName($bit);
        my $TopTypeInverse = getInverse($bit);
        my $FuncInverse = getTopFuncRef($TopTypeInverse);
        my $ErrorInverse = getErrorRef($TopTypeInverse);

        title "$TopTypeInverse - corrupt data";

        my $data = "abcd" x 100 ;
        my $out;

        ok $Func->(\$data, \$out), "  $TopType ok";

        # corrupt the compressed data
        #substr($out, -10, 10) = "x" x 10 ;
        substr($out, int(length($out)/3), 10) = 'abcdeabcde';

        my $result;
        ok ! $FuncInverse->(\$out => \$result, Transparent => 0), "  $TopTypeInverse ok";
        ok $$ErrorInverse, "  Got error '$$ErrorInverse'" ;

        #is $result, $data, "  data ok";

        ok ! anyuncompress(\$out => \$result, Transparent => 0), "anyuncompress ok";
        ok $AnyUncompressError, "  Got error '$AnyUncompressError'" ;
    }


    foreach my $bit ($CompressClass
                    )
    {
        my $Error = getErrorRef($bit);
        my $Func = getTopFuncRef($bit);
        my $TopType = getTopFuncName($bit);
        my $TopTypeInverse = getInverse($bit);
        my $FuncInverse = getTopFuncRef($TopTypeInverse);

        my @opts = ();
        @opts = (RawInflate => 1)
            if $CompressClass eq 'IO::Compress::RawInflate';

        for my $append ( 1, 0 )
        {
            my $already = '';
            $already = 'abcde' if $append ;

            for my $buffer ( undef, '', "abcde" )
            {

                my $disp_content = defined $buffer ? $buffer : '<undef>' ;

                my $keep = $buffer;
                my $out_file = "abcde.out";
                my $in_file = "abcde.in";

                {
                    title "$TopType - From Buff to Buff content '$disp_content' Append $append" ;

                    my $output = $already;
                    ok &$Func(\$buffer, \$output, Append => $append), '  Compressed ok' ;

                    is $keep, $buffer, "  Input buffer not changed" ;
                    my $got = anyUncompress(\$output, $already);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";

                }

                {
                    title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ;

                    my @output = ('first') ;
                    ok &$Func(\$buffer, \@output, Append => $append), '  Compressed ok' ;

                    is $output[0], 'first', "  Array[0] unchanged";
                    is $keep, $buffer, "  Input buffer not changed" ;
                    my $got = anyUncompress($output[1]);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";
                }

                {
                    title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ;

                    my $lex = new LexFile my $in_file ;
                    writeFile($in_file, $buffer);
                    my @output = ('first') ;
                    my @input = ($in_file);
                    ok &$Func(\@input, \@output, Append => $append), '  Compressed ok' ;

                    is $output[0], 'first', "  Array[0] unchanged";
                    my $got = anyUncompress($output[1]);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";
                }

                {
                    title "$TopType - From Buff to Filename content '$disp_content' Append $append" ;

                    my $lex = new LexFile my $out_file ;
                    ok ! -e $out_file, "  Output file does not exist";
                    writeFile($out_file, $already);

                    ok &$Func(\$buffer, $out_file, Append => $append), '  Compressed ok' ;

                    ok -e $out_file, "  Created output file";
                    my $got = anyUncompress($out_file, $already);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";
                }

                {
                    title "$TopType - From Buff to Handle content '$disp_content' Append $append" ;

                    my $lex = new LexFile my $out_file ;

                    ok ! -e $out_file, "  Output file does not exist";
                    writeFile($out_file, $already);
                    my $of = new IO::File ">>$out_file" ;
                    ok $of, "  Created output filehandle" ;

                    ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), '  Compressed ok' ;

                    ok -e $out_file, "  Created output file";
                    my $got = anyUncompress($out_file, $already);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";
                }


                {
                    title "$TopType - From Filename to Filename content '$disp_content' Append $append" ;

                    my $lex = new LexFile(my $in_file, my $out_file) ;
                    writeFile($in_file, $buffer);

                    ok ! -e $out_file, "  Output file does not exist";
                    writeFile($out_file, $already);

                    ok &$Func($in_file => $out_file, Append => $append), '  Compressed ok' ;

                    ok -e $out_file, "  Created output file";
                    my $got = anyUncompress($out_file, $already);
                    $got = undef if ! defined $buffer && $got eq '' ;
                    is $got, $buffer, "  Uncompressed matches original";

                }

                {
                    title "$TopType - From Filename to Handle content '$disp_content' Append $append" ;

                    my $lex = new LexFile(my $in_file, my $out_file) ;
                    writeFile($in_file, $buffer);