Update for IO::Uncompress::Base
authorPaul Marquess <paul.marquess@btinternet.com>
Wed, 28 Jun 2006 14:22:46 +0000 (15:22 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 28 Jun 2006 14:37:03 +0000 (14:37 +0000)
From: "Paul Marquess" <paul.marquess@ntlworld.com>
Message-ID: <001701c69ab5$f4d5d3d0$2405140a@myopwv.com>

p4raw-id: //depot/perl@28445

ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm
ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm
t/lib/compress/CompTestUtils.pm
t/lib/compress/any.pl
t/lib/compress/anyunc.pl
t/lib/compress/multi.pl
t/lib/compress/oneshot.pl

index c7c71d7..3c30c52 100644 (file)
@@ -53,7 +53,8 @@ sub anyuncompress
 
 sub getExtraParams
 {
-    return ();
+    use IO::Compress::Base::Common qw(:Parse);
+    return ( 'RawInflate' => [1, 1, Parse_boolean,  0] ) ;
 }
 
 sub ckParams
@@ -86,17 +87,20 @@ sub mkUncomp
 
         *$self->{Uncomp} = $obj;
         
-         $magic = $self->ckMagic( qw( RawInflate Inflate Gunzip Unzip ) ); 
+        my @possible = qw( Inflate Gunzip Unzip );
+        unshift @possible, 'RawInflate' 
+            if $got->value('RawInflate');
 
-         if ($magic) {
+        $magic = $self->ckMagic( @possible );
+        
+        if ($magic) {
             *$self->{Info} = $self->readHeader($magic)
                 or return undef ;
 
             return 1;
-         }
+        }
      }
 
-     #foreach my $type ( qw( Bunzip2 UnLzop ) ) {
      if (defined $IO::Uncompress::Bunzip2::VERSION and
          $magic = $self->ckMagic('Bunzip2')) {
         *$self->{Info} = $self->readHeader($magic)
@@ -111,7 +115,8 @@ sub mkUncomp
 
          return 1;
      }
-     elsif (defined $IO::Uncompress::UnLzop::VERSION and
+
+     if (defined $IO::Uncompress::UnLzop::VERSION and
             $magic = $self->ckMagic('UnLzop')) {
 
         *$self->{Info} = $self->readHeader($magic)
index 8b64879..038feb2 100644 (file)
@@ -39,17 +39,20 @@ sub smartRead
     my $offset = 0 ;
 
 
-    if (defined *$self->{InputLength} && 
-                *$self->{InputLengthRemaining} <= 0) {
-        return 0 ;
+    if (defined *$self->{InputLength}) {
+        return 0
+            if *$self->{InputLengthRemaining} <= 0 ;
+        $size = min($size, *$self->{InputLengthRemaining});
     }
 
     if ( length *$self->{Prime} ) {
         #$$out = substr(*$self->{Prime}, 0, $size, '') ;
         $$out = substr(*$self->{Prime}, 0, $size) ;
         substr(*$self->{Prime}, 0, $size) =  '' ;
-        if (length $$out == $size || defined *$self->{InputLength}) {
-            *$self->{InputLengthRemaining} -= length $$out;
+        if (length $$out == $size) {
+            *$self->{InputLengthRemaining} -= length $$out
+                if defined *$self->{InputLength};
+
             return length $$out ;
         }
         $offset = length $$out ;
@@ -57,9 +60,9 @@ sub smartRead
 
     my $get_size = $size - $offset ;
 
-    if ( defined *$self->{InputLength} ) {
-        $get_size = min($get_size, *$self->{InputLengthRemaining});
-    }
+    #if ( defined *$self->{InputLength} ) {
+    #    $get_size = min($get_size, *$self->{InputLengthRemaining});
+    #}
 
     if (defined *$self->{FH})
       { *$self->{FH}->read($$out, $get_size, $offset) }
@@ -90,7 +93,8 @@ sub smartRead
          { *$self->{BufferOffset} += length($$out) - $offset }
     }
 
-    *$self->{InputLengthRemaining} -= length $$out;
+    *$self->{InputLengthRemaining} -= length($$out) #- $offset 
+        if defined *$self->{InputLength};
         
     $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ;
 
@@ -892,13 +896,19 @@ sub gotoNextStream
     *$self->{UnCompSize}->reset();
     *$self->{CompSize}->reset();
 
-    return 0
-        unless  my $magic = $self->ckMagic();
-    *$self->{Info} = $self->readHeader($magic);
+    my $magic = $self->ckMagic();
 
-    return -1 
-        unless defined *$self->{Info} ;
+    if ( ! $magic) {
+        *$self->{EndStream} = 1 ;
+        return 0;
+    }
 
+    *$self->{Info} = $self->readHeader($magic);
+
+    if ( ! defined *$self->{Info} ) {
+        *$self->{EndStream} = 1 ;
+        return -1;
+    }
 
     push @{ *$self->{InfoList} }, *$self->{Info} ;
 
index 8c6be98..d4a0882 100644 (file)
@@ -48,7 +48,8 @@ sub anyinflate
 
 sub getExtraParams
 {
-    return ();
+    use IO::Compress::Base::Common qw(:Parse);
+    return ( 'RawInflate' => [1, 1, Parse_boolean,  0] ) ;
 }
 
 sub ckParams
@@ -76,7 +77,11 @@ sub mkUncomp
 
     *$self->{Uncomp} = $obj;
     
-     my $magic = $self->ckMagic( qw( RawInflate Inflate Gunzip Unzip ) ); 
+     my @possible = qw( Inflate Gunzip Unzip );
+     unshift @possible, 'RawInflate' 
+        if 1 || $got->value('RawInflate');
+
+     my $magic = $self->ckMagic( @possible );
 
      if ($magic) {
         *$self->{Info} = $self->readHeader($magic)
index d86aba5..7e583a0 100644 (file)
@@ -422,7 +422,11 @@ sub anyUncompress
     }
 
     my $out = '';
-    my $o = new IO::Uncompress::AnyUncompress \$data, -Append => 1, Transparent => 0, @opts
+    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 ;
@@ -478,7 +482,12 @@ sub getHeaders
     }
 
     my $out = '';
-    my $o = new IO::Uncompress::AnyUncompress \$data, MultiStream => 1, -Append => 1, Transparent => 0, @opts
+    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 ;
index 74f4925..d95766b 100644 (file)
@@ -14,7 +14,7 @@ BEGIN {
     $extra = 1
         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
 
-    plan tests => 36 + $extra ;
+    plan tests => 48 + $extra ;
 
 }
 
@@ -35,7 +35,7 @@ sub run
         for my $file ( 0, 1 )
         {
             title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
-            my $string = "some text";
+            my $string = "some text" x 100 ;
 
             my $buffer ;
             my $x = new $CompressClass(\$buffer) ;
@@ -54,19 +54,43 @@ sub run
                 $input = \$buffer;
             }
 
-            my $unc = new $AnyConstruct $input, Transparent => $trans  ;
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                           RawInflate => 1,
+                                           Append => 1  ;
 
-            ok $unc, "  Created $AnyClass object" 
-                or print "# $$AnyError\n";
-            my $uncomp ;
-            ok $unc->read($uncomp) > 0 
-                or print "# $$AnyError\n";
-            my $y;
-            is $unc->read($y, 1), 0, "  at eof" ;
-            ok $unc->eof(), "  at eof" ;
-            #ok $unc->type eq $Type;
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while  $unc->read($uncomp) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
 
-            is $uncomp, $string, "  expected output" ;
+                is $uncomp, $string, "  expected output" ;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                           RawInflate => 1,
+                                           Append => 1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while  $unc->read($uncomp, 100) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
         }
     }
 }
index d79ff22..2860e25 100644 (file)
@@ -34,7 +34,7 @@ sub run
         for my $file ( 0, 1 )
         {
             title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
-            my $string = "some text";
+            my $string = "some text" x 100 ;
 
             my $buffer ;
             my $x = new $CompressClass(\$buffer) ;
@@ -53,19 +53,39 @@ sub run
                 $input = \$buffer;
             }
 
-            my $unc = new $AnyConstruct $input, Transparent => $trans  ;
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans
+                                                    Append => 1  ;
 
-            ok $unc, "  Created $AnyClass object" 
-                or print "# $$AnyError\n";
-            my $uncomp ;
-            ok $unc->read($uncomp) > 0 
-                or print "# $$AnyError\n";
-            my $y;
-            is $unc->read($y, 1), 0, "  at eof" ;
-            ok $unc->eof(), "  at eof" ;
-            #ok $unc->type eq $Type;
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while $unc->read($uncomp) > 0 ;
+                #ok $unc->read($uncomp) > 0 
+                #    or print "# $$AnyError\n";
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
 
-            is $uncomp, $string, "  expected output" ;
+                is $uncomp, $string, "  expected output" ;
+            }
+
+            {
+                my $unc = new $AnyConstruct $input, Transparent => $trans,
+                                                     Append =>1  ;
+
+                ok $unc, "  Created $AnyClass object" 
+                    or print "# $$AnyError\n";
+                my $uncomp ;
+                1 while $unc->read($uncomp, 10) > 0 ;
+                my $y;
+                is $unc->read($y, 1), 0, "  at eof" ;
+                ok $unc->eof(), "  at eof" ;
+                #ok $unc->type eq $Type;
+
+                is $uncomp, $string, "  expected output" ;
+            }
         }
     }
 }
index 259447c..c6aaa7d 100644 (file)
@@ -107,7 +107,11 @@ EOM
                     {
                         $cc = new IO::File "<$name" ;
                     }
+                    my @opts = $unc ne $UncompressClass 
+                                    ? (RawInflate => 1)
+                                    : ();
                     my $gz = new $unc($cc,
+                                   @opts,
                                    Strict      => 1,
                                    AutoClose   => 1,
                                    Append      => 1,
@@ -138,7 +142,11 @@ EOM
                     {
                         $cc = new IO::File "<$name" ;
                     }
+                    my @opts = $unc ne $UncompressClass 
+                                    ? (RawInflate => 1)
+                                    : ();
                     my $gz = new $unc($cc,
+                                   @opts,
                                    Strict      => 1,
                                    AutoClose   => 1,
                                    Append      => 1,
index 3ef6bb2..50425df 100644 (file)
@@ -229,6 +229,10 @@ sub run
         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 = '';
@@ -885,6 +889,10 @@ sub run
 
         my $incumbent = "incumbent data" ;
 
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
         for my $append (0, 1)
         {
             my $expected = $buffer ;
@@ -895,7 +903,7 @@ sub run
 
                 my $output ;
                 $output = $incumbent if $append ;
-                ok &$Func(\$comp, \$output, Append => $append), '  Uncompressed ok' ;
+                ok &$Func(\$comp, \$output, Append => $append, @opts), '  Uncompressed ok' ;
 
                 is $keep_comp, $comp, "  Input buffer not changed" ;
                 is $output, $expected, "  Uncompressed matches original";
@@ -906,7 +914,7 @@ sub run
 
                 my @output = ('first');
                 #$output = $incumbent if $append ;
-                ok &$Func(\$comp, \@output, Append => $append), '  Uncompressed ok' ;
+                ok &$Func(\$comp, \@output, Append => $append, @opts), '  Uncompressed ok' ;
 
                 is $keep_comp, $comp, "  Input buffer not changed" ;
                 is $output[0], 'first', "  Uncompressed matches original";
@@ -924,7 +932,7 @@ sub run
                 else
                   { ok ! -e $out_file, "  Output file does not exist" }
 
-                ok &$Func(\$comp, $out_file, Append => $append), '  Uncompressed ok' ;
+                ok &$Func(\$comp, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -948,7 +956,7 @@ sub run
                 }
                 isa_ok $of, 'IO::File', '  $of' ;
 
-                ok &$Func(\$comp, $of, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
+                ok &$Func(\$comp, $of, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -968,7 +976,7 @@ sub run
 
                 writeFile($in_file, $comp);
 
-                ok &$Func($in_file, $out_file, Append => $append), '  Uncompressed ok' ;
+                ok &$Func($in_file, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -994,7 +1002,7 @@ sub run
 
                 writeFile($in_file, $comp);
 
-                ok &$Func($in_file, $out, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
+                ok &$Func($in_file, $out, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -1012,7 +1020,7 @@ sub run
                 my $output ;
                 $output = $incumbent if $append ;
 
-                ok &$Func($in_file, \$output, Append => $append), '  Uncompressed ok' ;
+                ok &$Func($in_file, \$output, Append => $append, @opts), '  Uncompressed ok' ;
 
                 is $keep_comp, $comp, "  Input buffer not changed" ;
                 is $output, $expected, "  Uncompressed matches original";
@@ -1030,7 +1038,7 @@ sub run
                 writeFile($in_file, $comp);
                 my $in = new IO::File "<$in_file" ;
 
-                ok &$Func($in, $out_file, Append => $append), '  Uncompressed ok' ;
+                ok &$Func($in, $out_file, Append => $append, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -1057,7 +1065,7 @@ sub run
                 writeFile($in_file, $comp);
                 my $in = new IO::File "<$in_file" ;
 
-                ok &$Func($in, $out, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
+                ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), '  Uncompressed ok' ;
 
                 ok -e $out_file, "  Created output file";
                 my $content = readFile($out_file) ;
@@ -1076,7 +1084,7 @@ sub run
                 my $output ;
                 $output = $incumbent if $append ;
 
-                ok &$Func($in, \$output, Append => $append), '  Uncompressed ok' ;
+                ok &$Func($in, \$output, Append => $append, @opts), '  Uncompressed ok' ;
 
                 is $keep_comp, $comp, "  Input buffer not changed" ;
                 is $output, $expected, "  Uncompressed matches original";
@@ -1095,7 +1103,7 @@ sub run
                 my $output ;
                 $output = $incumbent if $append ;
 
-                ok &$Func('-', \$output, Append => $append), '  Uncompressed ok' 
+                ok &$Func('-', \$output, Append => $append, @opts), '  Uncompressed ok' 
                     or diag $$Error ;
 
                    open(STDIN, "<&SAVEIN");
@@ -1117,7 +1125,7 @@ sub run
             writeFile($in_file, $comp . $appended . $comp . $appended) ;
             my $in = new IO::File "<$in_file" ;
 
-            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), '  Uncompressed ok' ;
+            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' ;
 
             is $out, $expected, "  Uncompressed matches original";
 
@@ -1126,7 +1134,7 @@ sub run
             is $buff, $appended, "  Appended data ok";
 
             $out = '';
-            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), '  Uncompressed ok' ;
+            ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' ;
 
             is $out, $expected, "  Uncompressed matches original";
 
@@ -1151,7 +1159,7 @@ sub run
 
             my $output ;
 
-            ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp), '  Uncompressed ok' 
+            ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), '  Uncompressed ok' 
                 or diag $$Error ;
 
             my $buff ;
@@ -1182,6 +1190,10 @@ sub run
         my $comp = compressBuffer(getTopFuncName($UncompressClass), $buffer) ;
         my $keep_comp = $comp;
 
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
         my $incumbent = "incumbent data" ;
 
         my $lex = new LexFile(my $file1, my $file2) ;
@@ -1203,7 +1215,7 @@ sub run
             title "$TopType - From ArrayRef to Buffer" ;
 
             my $output  ;
-            ok &$Func(\@input, \$output, AutoClose => 0), '  UnCompressed ok' ;
+            ok &$Func(\@input, \$output, AutoClose => 0, @opts), '  UnCompressed ok' ;
 
             is $output, join('', @expected)
         }
@@ -1214,7 +1226,7 @@ sub run
             my $lex = new LexFile my $output;
             $of->open("<$file1") ;
 
-            ok &$Func(\@input, $output, AutoClose => 0), '  UnCompressed ok' ;
+            ok &$Func(\@input, $output, AutoClose => 0, @opts), '  UnCompressed ok' ;
 
             is readFile($output), join('', @expected)
         }
@@ -1226,7 +1238,7 @@ sub run
             my $fh = new IO::File ">$output" ;
             $of->open("<$file1") ;
 
-            ok &$Func(\@input, $fh, AutoClose => 0), '  UnCompressed ok' ;
+            ok &$Func(\@input, $fh, AutoClose => 0, @opts), '  UnCompressed ok' ;
             $fh->close;
 
             is readFile($output), join('', @expected)
@@ -1237,7 +1249,7 @@ sub run
 
             my @output = (\'first') ;
             $of->open("<$file1") ;
-            ok &$Func(\@input, \@output, AutoClose => 0), '  UnCompressed ok' ;
+            ok &$Func(\@input, \@output, AutoClose => 0, @opts), '  UnCompressed ok' ;
 
             is_deeply \@input, \@keep, "  Input array not changed" ;
             is_deeply [map { defined $$_ ? $$_ : "" } @output], 
@@ -1264,6 +1276,10 @@ sub run
         mkdir $tmpDir1, 0777;
         mkdir $tmpDir2, 0777;
 
+        my @opts = ();
+        @opts = (RawInflate => 1)
+            if $bit eq 'IO::Uncompress::AnyUncompress';
+
         ok   -d $tmpDir1, "  Temp Directory $tmpDir1 exists";
         #ok ! -d $tmpDir2, "  Temp Directory $tmpDir2 does not exist";
 
@@ -1276,7 +1292,7 @@ sub run
         {
             title "$TopType - From FileGlob to FileGlob" ;
 
-            ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), '  UnCompressed ok' 
+            ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), '  UnCompressed ok' 
                 or diag $$Error ;
 
             my @copy = @expected;
@@ -1292,7 +1308,7 @@ sub run
             title "$TopType - From FileGlob to Arrayref" ;
 
             my @output = (\'first');
-            ok &$Func("<$tmpDir1/a*.tmp>" => \@output), '  UnCompressed ok' 
+            ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), '  UnCompressed ok' 
                 or diag $$Error ;
 
             my @copy = ('first', @expected);
@@ -1308,7 +1324,7 @@ sub run
             title "$TopType - From FileGlob to Buffer" ;
 
             my $output ;
-            ok &$Func("<$tmpDir1/a*.tmp>" => \$output), '  UnCompressed ok' 
+            ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), '  UnCompressed ok' 
                 or diag $$Error ;
 
             is $output, join('', @expected), "  got expected uncompressed data";
@@ -1319,7 +1335,7 @@ sub run
 
             my $lex = new LexFile my $output ;
             ok ! -e $output, "  $output does not exist" ;
-            ok &$Func("<$tmpDir1/a*.tmp>" => $output), '  UnCompressed ok' 
+            ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), '  UnCompressed ok' 
                 or diag $$Error ;
 
             ok -e $output, "  $output does exist" ;
@@ -1332,7 +1348,7 @@ sub run
             my $output = 'abc' ;
             my $lex = new LexFile $output ;
             my $fh = new IO::File ">$output" ;
-            ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1), '  UnCompressed ok' 
+            ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), '  UnCompressed ok' 
                 or diag $$Error ;
 
             ok -e $output, "  $output does exist" ;