t/lib/compress/multi.pl

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use CompTestUtils;
   9
  10 BEGIN {
  11     # use Test::NoWarnings, if available
  12     my $extra = 0 ;
  13     $extra = 1
  14         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  15
  16     plan tests => 694 + $extra ;
  17
  18     use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;
  19
  20 }
  21
  22 sub run
  23 {
  24
  25     my $CompressClass   = identify();
  26     my $UncompressClass = getInverse($CompressClass);
  27     my $Error           = getErrorRef($CompressClass);
  28     my $UnError         = getErrorRef($UncompressClass);
  29
  30
  31
  32
  33     my @buffers ;
  34     push @buffers, <<EOM ;
  35 hello world
  36 this is a test
  37 some more stuff on this line
  38 ad finally...
  39 EOM
  40
  41     push @buffers, <<EOM ;
  42 some more stuff
  43 line 2
  44 EOM
  45
  46     push @buffers, <<EOM ;
  47 even more stuff
  48 EOM
  49
  50     {
  51         my $cc ;
  52         my $gz ;
  53         my $hsize ;
  54         my %headers = () ;
  55
  56
  57         foreach my $fb ( qw( file filehandle buffer ) )
  58         {
  59
  60             foreach my $i (1 .. @buffers) {
  61
  62                 title "Testing $CompressClass with $i streams to $fb";
  63
  64                 my @buffs = @buffers[0..$i -1] ;
  65
  66                 if ($CompressClass eq 'IO::Compress::Gzip') {
  67                     %headers = (
  68                                   Strict     => 1,
  69                                   Comment    => "this is a comment",
  70                                   ExtraField => ["so" => "me extra"],
  71                                   HeaderCRC  => 1);
  72
  73                 }
  74
  75                 my $lex = new LexFile my $name ;
  76                 my $output ;
  77                 if ($fb eq 'buffer')
  78                 {
  79                     my $compressed = '';
  80                     $output = \$compressed;
  81                 }
  82                 elsif ($fb eq 'filehandle')
  83                 {
  84                     $output = new IO::File ">$name" ;
  85                 }
  86                 else
  87                 {
  88                     $output = $name ;
  89                 }
  90
  91                 my $x = new $CompressClass($output, AutoClose => 1, %headers);
  92                 isa_ok $x, $CompressClass, '  $x' ;
  93
  94                 foreach my $buffer (@buffs) {
  95                     ok $x->write($buffer), "    Write OK" ;
  96                     # this will add an extra "empty" stream
  97                     ok $x->newStream(), "    newStream OK" ;
  98                 }
  99                 ok $x->close, "  Close ok" ;
 100
 101                 #hexDump($compressed) ;
 102
 103                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 104                     title "  Testing $CompressClass with $unc and $i streams, from $fb";
 105                     $cc = $output ;
 106                     if ($fb eq 'filehandle')
 107                     {
 108                         $cc = new IO::File "<$name" ;
 109                     }
 110                     my $gz = new $unc($cc,
 111                                    Strict      => 1,
 112                                    AutoClose   => 1,
 113                                    Append      => 1,
 114                                    MultiStream => 1,
 115                                    Transparent => 0)
 116                         or diag $$UnError;
 117                     isa_ok $gz, $UncompressClass, '    $gz' ;
 118
 119                     my $un = '';
 120                     1 while $gz->read($un) > 0 ;
 121                     #print "[[$un]]\n" while $gz->read($un) > 0 ;
 122                     ok ! $gz->error(), "      ! error()"
 123                         or diag "Error is " . $gz->error() ;
 124                     ok $gz->eof(), "      eof()";
 125                     ok $gz->close(), "    close() ok"
 126                         or diag "errno $!\n" ;
 127
 128                     is $gz->streamCount(), $i +1, "    streamCount ok"
 129                         or diag "Stream count is " . $gz->streamCount();
 130                     ok $un eq join('', @buffs), "    expected output" ;
 131
 132                 }
 133
 134                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 135                     title "  Testing $CompressClass with $unc nextStream and $i streams, from $fb";
 136                     $cc = $output ;
 137                     if ($fb eq 'filehandle')
 138                     {
 139                         $cc = new IO::File "<$name" ;
 140                     }
 141                     my $gz = new $unc($cc,
 142                                    Strict      => 1,
 143                                    AutoClose   => 1,
 144                                    Append      => 1,
 145                                    MultiStream => 0,
 146                                    Transparent => 0)
 147                         or diag $$UnError;
 148                     isa_ok $gz, $UncompressClass, '    $gz' ;
 149
 150                     for my $stream (1 .. $i)
 151                     {
 152                         my $buff = $buffs[$stream-1];
 153                         my @lines = split("\n", $buff);
 154                         my $lines = @lines;
 155
 156                         my $un = '';
 157                         while (<$gz>) {
 158                             $un .= $_;
 159                         }
 160                         is $., $lines, "    \$. is $lines";
 161
 162                         ok ! $gz->error(), "      ! error()"
 163                             or diag "Error is " . $gz->error() ;
 164                         ok $gz->eof(), "      eof()";
 165                         is $gz->streamCount(), $stream, "    streamCount is $stream"
 166                             or diag "Stream count is " . $gz->streamCount();
 167                         ok $un eq $buff, "    expected output" ;
 168                         #is $gz->tell(), length $buff, "    tell is ok";
 169                         is $gz->nextStream(), 1, "    nextStream ok";
 170                         is $gz->tell(), 0, "    tell is 0";
 171                         is $., 0, '    $. is 0';
 172                     }
 173
 174                     {
 175                         my $un = '';
 176                         1 while $gz->read($un) > 0 ;
 177                         #print "[[$un]]\n" while $gz->read($un) > 0 ;
 178                         ok ! $gz->error(), "      ! error()"
 179                             or diag "Error is " . $gz->error() ;
 180                         ok $gz->eof(), "      eof()";
 181                         is $gz->streamCount(), $i+1, "    streamCount is ok"
 182                             or diag "Stream count is " . $gz->streamCount();
 183                         ok $un eq "", "    expected output" ;
 184                         is $gz->tell(), 0, "    tell is 0";
 185                         is $., 0, "    \$. is 0";
 186                     }
 187
 188                     is $gz->nextStream(), 0, "    nextStream ok";
 189                     ok $gz->eof(), "      eof()";
 190                     ok $gz->close(), "    close() ok"
 191                         or diag "errno $!\n" ;
 192
 193                     is $gz->streamCount(), $i +1, "    streamCount ok"
 194                         or diag "Stream count is " . $gz->streamCount();
 195
 196                 }
 197             }
 198         }
 199     }
 200 }
 201
 202
 203 # corrupt one of the streams - all previous should be ok
 204 # trailing stuff
 205 # check that "tell" works ok
 206
 207 1;