1b39c5158Smillertuse lib 't'; 2b39c5158Smillertuse strict; 3b39c5158Smillertuse warnings; 4b39c5158Smillertuse bytes; 5b39c5158Smillert 6b39c5158Smillertuse Test::More ; 7b39c5158Smillertuse CompTestUtils; 8b39c5158Smillert 9b39c5158Smillertuse Compress::Raw::Zlib 2 ; 10b39c5158Smillert 11b39c5158SmillertBEGIN 12b39c5158Smillert{ 13b39c5158Smillert plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " 14b39c5158Smillert . Compress::Raw::Zlib::zlib_version()) 15b39c5158Smillert if ZLIB_VERNUM() < 0x1210 ; 16b39c5158Smillert 17b39c5158Smillert # use Test::NoWarnings, if available 18b39c5158Smillert my $extra = 0 ; 19b39c5158Smillert $extra = 1 20b39c5158Smillert if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 21b39c5158Smillert 22b39c5158Smillert plan tests => 165 + $extra ; 23b39c5158Smillert 24b39c5158Smillert} 25b39c5158Smillert 26b39c5158Smillert 27b39c5158Smillertsub run 28b39c5158Smillert{ 29b39c5158Smillert 30b39c5158Smillert my $CompressClass = identify(); 31b39c5158Smillert my $UncompressClass = getInverse($CompressClass); 32b39c5158Smillert my $Error = getErrorRef($CompressClass); 33b39c5158Smillert my $UnError = getErrorRef($UncompressClass); 34b39c5158Smillert 35b39c5158Smillert # Tests 36b39c5158Smillert # destination is a file that doesn't exist -- should work ok unless AnyDeflate 37b39c5158Smillert # destination isn't compressed at all 38b39c5158Smillert # destination is compressed but wrong format 39b39c5158Smillert # destination is corrupt - error messages should be correct 40b39c5158Smillert # use apend mode with old zlib - check that this is trapped 41b39c5158Smillert # destination is not seekable, readable, writable - test for filename & handle 42b39c5158Smillert 43b39c5158Smillert { 44b39c5158Smillert title "Misc error cases"; 45b39c5158Smillert 46*256a93a4Safresh1 eval { Compress::Raw::Zlib::InflateScan->new( Bufsize => 0 ) } ; 47b39c5158Smillert like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; 48b39c5158Smillert 49b39c5158Smillert eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ; 50b39c5158Smillert like $@, mkErr("^Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; 51b39c5158Smillert 52b39c5158Smillert } 53b39c5158Smillert 54b39c5158Smillert # output file/handle not writable 55b39c5158Smillert { 56b39c5158Smillert 57b39c5158Smillert foreach my $to_file (0,1) 58b39c5158Smillert { 59b39c5158Smillert if ($to_file) 60b39c5158Smillert { title "$CompressClass - Merge to filename that isn't writable" } 61b39c5158Smillert else 62b39c5158Smillert { title "$CompressClass - Merge to filehandle that isn't writable" } 63b39c5158Smillert 64*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 65b39c5158Smillert 66b39c5158Smillert # create empty file 67b39c5158Smillert open F, ">$out_file" ; print F "x"; close F; 68b39c5158Smillert ok -e $out_file, " file exists" ; 69b39c5158Smillert ok !-z $out_file, " and is not empty" ; 70b39c5158Smillert 71b39c5158Smillert # make unwritable 72b39c5158Smillert is chmod(0444, $out_file), 1, " chmod worked" ; 73b39c5158Smillert ok -e $out_file, " still exists after chmod" ; 74b39c5158Smillert 75b39c5158Smillert SKIP: 76b39c5158Smillert { 77b39c5158Smillert skip "Cannot create non-writable file", 3 78b39c5158Smillert if -w $out_file ; 79b39c5158Smillert 80b39c5158Smillert ok ! -w $out_file, " chmod made file unwritable" ; 81b39c5158Smillert 82b39c5158Smillert my $dest ; 83b39c5158Smillert if ($to_file) 84b39c5158Smillert { $dest = $out_file } 85b39c5158Smillert else 86*256a93a4Safresh1 { $dest = IO::File->new( "<$out_file" ) } 87b39c5158Smillert 88b39c5158Smillert my $gz = $CompressClass->new($dest, Merge => 1) ; 89b39c5158Smillert 90b39c5158Smillert ok ! $gz, " Did not create $CompressClass object"; 91b39c5158Smillert 92b39c5158Smillert ok $$Error, " Got error message" ; 93b39c5158Smillert } 94b39c5158Smillert 95b39c5158Smillert chmod 0777, $out_file ; 96b39c5158Smillert } 97b39c5158Smillert } 98b39c5158Smillert 99b39c5158Smillert # output is not compressed at all 100b39c5158Smillert { 101b39c5158Smillert 102*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 103b39c5158Smillert 104b39c5158Smillert foreach my $to_file ( qw(buffer file handle ) ) 105b39c5158Smillert { 106b39c5158Smillert title "$CompressClass to $to_file, content is not compressed"; 107b39c5158Smillert 108b39c5158Smillert my $content = "abc" x 300 ; 109b39c5158Smillert my $buffer ; 110b39c5158Smillert my $disp_content = defined $content ? $content : '<undef>' ; 111b39c5158Smillert my $str_content = defined $content ? $content : '' ; 112b39c5158Smillert 113b39c5158Smillert if ($to_file eq 'buffer') 114b39c5158Smillert { 115b39c5158Smillert $buffer = \$content ; 116b39c5158Smillert } 117b39c5158Smillert else 118b39c5158Smillert { 119b39c5158Smillert writeFile($out_file, $content); 120b39c5158Smillert 121b39c5158Smillert if ($to_file eq 'handle') 122b39c5158Smillert { 123*256a93a4Safresh1 $buffer = IO::File->new( "+<$out_file" ) 124b39c5158Smillert or die "# Cannot open $out_file: $!"; 125b39c5158Smillert } 126b39c5158Smillert else 127b39c5158Smillert { $buffer = $out_file } 128b39c5158Smillert } 129b39c5158Smillert 130b39c5158Smillert ok ! $CompressClass->new($buffer, Merge => 1), " constructor fails"; 131b39c5158Smillert { 132898184e3Ssthen like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file|Inflation Error: data error)?/', " got Bad Magic" ; 133b39c5158Smillert } 134b39c5158Smillert 135b39c5158Smillert } 136b39c5158Smillert } 137b39c5158Smillert 138b39c5158Smillert # output is empty 139b39c5158Smillert { 140b39c5158Smillert 141*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 142b39c5158Smillert 143b39c5158Smillert foreach my $to_file ( qw(buffer file handle ) ) 144b39c5158Smillert { 145b39c5158Smillert title "$CompressClass to $to_file, content is empty"; 146b39c5158Smillert 147b39c5158Smillert my $content = ''; 148b39c5158Smillert my $buffer ; 149b39c5158Smillert my $dest ; 150b39c5158Smillert 151b39c5158Smillert if ($to_file eq 'buffer') 152b39c5158Smillert { 153b39c5158Smillert $dest = $buffer = \$content ; 154b39c5158Smillert } 155b39c5158Smillert else 156b39c5158Smillert { 157b39c5158Smillert writeFile($out_file, $content); 158b39c5158Smillert $dest = $out_file; 159b39c5158Smillert 160b39c5158Smillert if ($to_file eq 'handle') 161b39c5158Smillert { 162*256a93a4Safresh1 $buffer = IO::File->new( "+<$out_file" ) 163b39c5158Smillert or die "# Cannot open $out_file: $!"; 164b39c5158Smillert } 165b39c5158Smillert else 166b39c5158Smillert { $buffer = $out_file } 167b39c5158Smillert } 168b39c5158Smillert 169b39c5158Smillert ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), " constructor passes" 170b39c5158Smillert or diag $$Error; 171b39c5158Smillert 172b39c5158Smillert $gz->write("FGHI"); 173b39c5158Smillert $gz->close(); 174b39c5158Smillert 175b39c5158Smillert #hexDump($buffer); 176b39c5158Smillert my $out = anyUncompress($dest); 177b39c5158Smillert 178b39c5158Smillert is $out, "FGHI", ' Merge OK'; 179b39c5158Smillert } 180b39c5158Smillert } 181b39c5158Smillert 182b39c5158Smillert { 183b39c5158Smillert title "$CompressClass - Merge to file that doesn't exist"; 184b39c5158Smillert 185*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 186b39c5158Smillert 187b39c5158Smillert ok ! -e $out_file, " Destination file, '$out_file', does not exist"; 188b39c5158Smillert 189*256a93a4Safresh1 ok my $gz1 = $CompressClass->can('new')->( $CompressClass, $out_file, Merge => 1) 190*256a93a4Safresh1 or die "# $CompressClass->new(...) failed: $$Error\n"; 191b39c5158Smillert #hexDump($buffer); 192b39c5158Smillert $gz1->write("FGHI"); 193b39c5158Smillert $gz1->close(); 194b39c5158Smillert 195b39c5158Smillert #hexDump($buffer); 196b39c5158Smillert my $out = anyUncompress($out_file); 197b39c5158Smillert 198b39c5158Smillert is $out, "FGHI", ' Merged OK'; 199b39c5158Smillert } 200b39c5158Smillert 201b39c5158Smillert { 202b39c5158Smillert 203*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 204b39c5158Smillert 205b39c5158Smillert foreach my $to_file ( qw( buffer file handle ) ) 206b39c5158Smillert { 207b39c5158Smillert foreach my $content (undef, '', 'x', 'abcde') 208b39c5158Smillert { 209b39c5158Smillert #next if ! defined $content && $to_file; 210b39c5158Smillert 211b39c5158Smillert my $buffer ; 212b39c5158Smillert my $disp_content = defined $content ? $content : '<undef>' ; 213b39c5158Smillert my $str_content = defined $content ? $content : '' ; 214b39c5158Smillert 215b39c5158Smillert if ($to_file eq 'buffer') 216b39c5158Smillert { 217b39c5158Smillert my $x ; 218b39c5158Smillert $buffer = \$x ; 219b39c5158Smillert title "$CompressClass to Buffer, content is '$disp_content'"; 220b39c5158Smillert } 221b39c5158Smillert else 222b39c5158Smillert { 223b39c5158Smillert $buffer = $out_file ; 224b39c5158Smillert if ($to_file eq 'handle') 225b39c5158Smillert { 226b39c5158Smillert title "$CompressClass to Filehandle, content is '$disp_content'"; 227b39c5158Smillert } 228b39c5158Smillert else 229b39c5158Smillert { 230b39c5158Smillert title "$CompressClass to File, content is '$disp_content'"; 231b39c5158Smillert } 232b39c5158Smillert } 233b39c5158Smillert 234b39c5158Smillert my $gz = $CompressClass->new($buffer); 235b39c5158Smillert my $len = defined $content ? length($content) : 0 ; 236b39c5158Smillert is $gz->write($content), $len, " write ok"; 237b39c5158Smillert ok $gz->close(), " close ok"; 238b39c5158Smillert 239b39c5158Smillert #hexDump($buffer); 240b39c5158Smillert is anyUncompress($buffer), $str_content, ' Destination is ok'; 241b39c5158Smillert 242b39c5158Smillert #if ($corruption) 243b39c5158Smillert #{ 244b39c5158Smillert # next if $TopTypes eq 'RawDeflate' && $content eq ''; 245b39c5158Smillert # 246b39c5158Smillert #} 247b39c5158Smillert 248b39c5158Smillert my $dest = $buffer ; 249b39c5158Smillert if ($to_file eq 'handle') 250b39c5158Smillert { 251*256a93a4Safresh1 $dest = IO::File->new( "+<$buffer" ); 252b39c5158Smillert } 253b39c5158Smillert 254b39c5158Smillert my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1) 255b39c5158Smillert or die "## Error is $$Error\n"; 256b39c5158Smillert 257b39c5158Smillert #print "YYY\n"; 258b39c5158Smillert #hexDump($buffer); 259b39c5158Smillert #print "XXX\n"; 260b39c5158Smillert is $gz1->write("FGHI"), 4, " write returned 4"; 261b39c5158Smillert ok $gz1->close(), " close ok"; 262b39c5158Smillert 263b39c5158Smillert #hexDump($buffer); 264b39c5158Smillert my $out = anyUncompress($buffer); 265b39c5158Smillert 266b39c5158Smillert is $out, $str_content . "FGHI", ' Merged OK'; 267b39c5158Smillert #exit; 268b39c5158Smillert } 269b39c5158Smillert } 270b39c5158Smillert 271b39c5158Smillert } 272b39c5158Smillert 273b39c5158Smillert 274b39c5158Smillert 275b39c5158Smillert { 276b39c5158Smillert my $Func = getTopFuncRef($CompressClass); 277b39c5158Smillert my $TopType = getTopFuncName($CompressClass); 278b39c5158Smillert 279b39c5158Smillert my $buffer ; 280b39c5158Smillert 281*256a93a4Safresh1 my $lex = LexFile->new( my $out_file ); 282b39c5158Smillert 283b39c5158Smillert foreach my $to_file (0, 1) 284b39c5158Smillert { 285b39c5158Smillert foreach my $content (undef, '', 'x', 'abcde') 286b39c5158Smillert { 287b39c5158Smillert my $disp_content = defined $content ? $content : '<undef>' ; 288b39c5158Smillert my $str_content = defined $content ? $content : '' ; 289b39c5158Smillert my $buffer ; 290b39c5158Smillert if ($to_file) 291b39c5158Smillert { 292b39c5158Smillert $buffer = $out_file ; 293b39c5158Smillert title "$TopType to File, content is '$disp_content'"; 294b39c5158Smillert } 295b39c5158Smillert else 296b39c5158Smillert { 297b39c5158Smillert my $x = ''; 298b39c5158Smillert $buffer = \$x ; 299b39c5158Smillert title "$TopType to Buffer, content is '$disp_content'"; 300b39c5158Smillert } 301b39c5158Smillert 302b39c5158Smillert 303b39c5158Smillert ok $Func->(\$content, $buffer), " Compress content"; 304b39c5158Smillert #hexDump($buffer); 305b39c5158Smillert is anyUncompress($buffer), $str_content, ' Destination is ok'; 306b39c5158Smillert 307b39c5158Smillert 308b39c5158Smillert ok $Func->(\"FGHI", $buffer, Merge => 1), " Merge content"; 309b39c5158Smillert 310b39c5158Smillert #hexDump($buffer); 311b39c5158Smillert my $out = anyUncompress($buffer); 312b39c5158Smillert 313b39c5158Smillert is $out, $str_content . "FGHI", ' Merged OK'; 314b39c5158Smillert } 315b39c5158Smillert } 316b39c5158Smillert 317b39c5158Smillert } 318b39c5158Smillert 319b39c5158Smillert} 320b39c5158Smillert 321b39c5158Smillert 322b39c5158Smillert1; 323