1use lib 't'; 2use strict; 3use warnings; 4use bytes; 5 6use Test::More ; 7use CompTestUtils; 8 9BEGIN { 10 plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" ) 11 if $] < 5.005 ; 12 13 14 # use Test::NoWarnings, if available 15 my $extra = 0 ; 16 $extra = 1 17 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 18 19 plan tests => 1007 + $extra ; 20 21 use_ok('IO::Uncompress::AnyUncompress', qw(anyuncompress $AnyUncompressError)) ; 22 23} 24 25my $OriginalContent1 = <<EOM ; 26Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 27 dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 28 est. Quintus cenum parat. 29EOM 30 31my $OriginalContent2 = <<EOM ; 32LOREM ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 33 dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 34 est. Quintus cenum PARAT. 35EOM 36 37sub run 38{ 39 40 my $CompressClass = identify(); 41 my $UncompressClass = getInverse($CompressClass); 42 my $Error = getErrorRef($CompressClass); 43 my $UnError = getErrorRef($UncompressClass); 44 my $TopFuncName = getTopFuncName($CompressClass); 45 46 47 my @MultiValues = getMultiValues($CompressClass); 48 49 foreach my $bit ($CompressClass, $UncompressClass, 50 'IO::Uncompress::AnyUncompress', 51 ) 52 { 53 my $Error = getErrorRef($bit); 54 my $Func = getTopFuncRef($bit); 55 my $TopType = getTopFuncName($bit); 56 57 #my $inverse = getInverse($bit); 58 #my $InverseFunc = getTopFuncRef($inverse); 59 60 title "Testing $TopType Error Cases"; 61 62 my $a; 63 my $x ; 64 65 eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ; 66 like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), ' Illegal Parameters'; 67 68 eval { $a = $Func->() ;} ; 69 like $@, "/^$TopType: expected at least 1 parameters/", ' No Parameters'; 70 71 eval { $a = $Func->(\$x, \1) ;} ; 72 like $$Error, "/^$TopType: output buffer is read-only/", ' Output is read-only' ; 73 74 my $in ; 75 eval { $a = $Func->($in, \$x) ;} ; 76 like $@, mkErr("^$TopType: input filename is undef or null string"), 77 ' Input filename undef' ; 78 79 $in = ''; 80 eval { $a = $Func->($in, \$x) ;} ; 81 like $@, mkErr("^$TopType: input filename is undef or null string"), 82 ' Input filename empty' ; 83 84 { 85 my $lex1 = new LexFile my $in ; 86 writeFile($in, "abc"); 87 my $out = $in ; 88 eval { $a = $Func->($in, $out) ;} ; 89 like $@, mkErr("^$TopType: input and output filename are identical"), 90 ' Input and Output filename are the same'; 91 } 92 93 { 94 my $dir ; 95 my $lex = new LexDir $dir ; 96 my $d = quotemeta $dir; 97 98 $a = $Func->("$dir", \$x) ; 99 is $a, undef, " $TopType returned undef"; 100 like $$Error, "/input file '$d' is a directory/", 101 ' Input filename is a directory'; 102 103 $a = $Func->(\$x, "$dir") ; 104 is $a, undef, " $TopType returned undef"; 105 like $$Error, "/output file '$d' is a directory/", 106 ' Output filename is a directory'; 107 } 108 109 eval { $a = $Func->(\$in, \$in) ;} ; 110 like $@, mkErr("^$TopType: input and output buffer are identical"), 111 ' Input and Output buffer are the same'; 112 113 SKIP: 114 { 115 # Threaded 5.6.x seems to have a problem comparing filehandles. 116 use Config; 117 118 skip 'Cannot compare filehandles with threaded $]', 2 119 if $] >= 5.006 && $] < 5.007 && $Config{useithreads}; 120 121 my $lex = new LexFile my $out_file ; 122 open OUT, ">$out_file" ; 123 eval { $a = $Func->(\*OUT, \*OUT) ;} ; 124 like $@, mkErr("^$TopType: input and output handle are identical"), 125 ' Input and Output handle are the same'; 126 127 close OUT; 128 is -s $out_file, 0, " File zero length" ; 129 } 130 131 { 132 my %x = () ; 133 my $object = bless \%x, "someClass" ; 134 135 # Buffer not a scalar reference 136 #eval { $a = $Func->(\$x, \%x) ;} ; 137 eval { $a = $Func->(\$x, $object) ;} ; 138 like $@, mkErr("^$TopType: illegal output parameter"), 139 ' Bad Output Param'; 140 141 # Buffer not a scalar reference 142 eval { $a = $Func->(\$x, \%x) ;} ; 143 like $@, mkErr("^$TopType: illegal output parameter"), 144 ' Bad Output Param'; 145 146 147 eval { $a = $Func->(\%x, \$x) ;} ; 148 like $@, mkErr("^$TopType: illegal input parameter"), 149 ' Bad Input Param'; 150 151 #eval { $a = $Func->(\%x, \$x) ;} ; 152 eval { $a = $Func->($object, \$x) ;} ; 153 like $@, mkErr("^$TopType: illegal input parameter"), 154 ' Bad Input Param'; 155 } 156 157 my $filename = 'abc.def'; 158 ok ! -e $filename, " input file '$filename' does not exist"; 159 $a = $Func->($filename, \$x) ; 160 is $a, undef, " $TopType returned undef"; 161 like $$Error, "/^input file '$filename' does not exist\$/", " input File '$filename' does not exist"; 162 163 $filename = '/tmp/abd/abc.def'; 164 ok ! -e $filename, " output File '$filename' does not exist"; 165 $a = $Func->(\$x, $filename) ; 166 is $a, undef, " $TopType returned undef"; 167 like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), " output File '$filename' does not exist"; 168 169 eval { $a = $Func->(\$x, '<abc>') } ; 170 like $$Error, "/Need input fileglob for outout fileglob/", 171 ' Output fileglob with no input fileglob'; 172 is $a, undef, " $TopType returned undef"; 173 174 $a = $Func->('<abc)>', '<abc>') ; 175 is $a, undef, " $TopType returned undef"; 176 like $$Error, "/Unmatched \\) in input fileglob/", 177 " Unmatched ) in input fileglob"; 178 } 179 180 foreach my $bit ($UncompressClass, 181 'IO::Uncompress::AnyUncompress', 182 ) 183 { 184 my $Error = getErrorRef($bit); 185 my $Func = getTopFuncRef($bit); 186 my $TopType = getTopFuncName($bit); 187 188 { 189 my $in ; 190 my $out ; 191 my @x ; 192 193 SKIP: 194 { 195 use Config; 196 197 skip 'readonly + threads', 1 198 if $Config{useithreads} ; 199 200 skip '\\ returns mutable value in 5.19.3', 1 201 if $] >= 5.019003; 202 203 eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ; 204 like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"), 205 ' TrailingData output not writable'; 206 } 207 208 eval { $a = $Func->(\$in, \$out, TrailingData => \@x) ;} ; 209 like $@, mkErr("^$TopType: Parameter 'TrailingData' not a scalar reference"), 210 ' TrailingData output not scalar reference'; 211 } 212 } 213 214 foreach my $bit ($UncompressClass, 215 'IO::Uncompress::AnyUncompress', 216 ) 217 { 218 my $Error = getErrorRef($bit); 219 my $Func = getTopFuncRef($bit); 220 my $TopType = getTopFuncName($bit); 221 222 my $data = "mary had a little lamb" ; 223 my $keep = $data ; 224 225 for my $trans ( 0, 1) 226 { 227 title "Non-compressed data with $TopType, Transparent => $trans "; 228 my $a; 229 my $x ; 230 my $out = '' ; 231 232 $a = $Func->(\$data, \$out, Transparent => $trans) ; 233 234 is $data, $keep, " Input buffer not changed" ; 235 236 if ($trans) 237 { 238 ok $a, " $TopType returned true" ; 239 is $out, $data, " got expected output" ; 240 ok ! $$Error, " no error [$$Error]" ; 241 } 242 else 243 { 244 ok ! $a, " $TopType returned false" ; 245 #like $$Error, '/xxx/', " error" ; 246 ok $$Error, " error is '$$Error'" ; 247 } 248 } 249 } 250 251 foreach my $bit ($CompressClass 252 ) 253 { 254 my $Error = getErrorRef($bit); 255 my $Func = getTopFuncRef($bit); 256 my $TopType = getTopFuncName($bit); 257 my $TopTypeInverse = getInverse($bit); 258 my $FuncInverse = getTopFuncRef($TopTypeInverse); 259 my $ErrorInverse = getErrorRef($TopTypeInverse); 260 261 title "$TopTypeInverse - corrupt data"; 262 263 my $data = "abcd" x 100 ; 264 my $out; 265 266 ok $Func->(\$data, \$out), " $TopType ok"; 267 268 # corrupt the compressed data 269 #substr($out, -10, 10) = "x" x 10 ; 270 substr($out, int(length($out)/3), 10) = 'abcdeabcde'; 271 272 my $result; 273 ok ! $FuncInverse->(\$out => \$result, Transparent => 0), " $TopTypeInverse ok"; 274 ok $$ErrorInverse, " Got error '$$ErrorInverse'" ; 275 276 #is $result, $data, " data ok"; 277 278 ok ! anyuncompress(\$out => \$result, Transparent => 0), "anyuncompress ok"; 279 ok $AnyUncompressError, " Got error '$AnyUncompressError'" ; 280 } 281 282 283 foreach my $bit ($CompressClass 284 ) 285 { 286 my $Error = getErrorRef($bit); 287 my $Func = getTopFuncRef($bit); 288 my $TopType = getTopFuncName($bit); 289 my $TopTypeInverse = getInverse($bit); 290 my $FuncInverse = getTopFuncRef($TopTypeInverse); 291 292 my @opts = (); 293 @opts = (RawInflate => 1, UnLzma => 1) 294 if $CompressClass eq 'IO::Compress::RawInflate'; 295 296 for my $append ( 1, 0 ) 297 { 298 my $already = ''; 299 $already = 'abcde' if $append ; 300 301 for my $buffer ( undef, '', $OriginalContent1 ) 302 { 303 my $disp_content = defined $buffer ? $buffer : '<undef>' ; 304 305 my $keep = $buffer; 306 my $out_file = "abcde.out"; 307 my $in_file = "abcde.in"; 308 309 { 310 title "$TopType - From Buff to Buff content '$disp_content' Append $append" ; 311 312 my $output = $already; 313 ok &$Func(\$buffer, \$output, Append => $append), ' Compressed ok' ; 314 315 is $keep, $buffer, " Input buffer not changed" ; 316 my $got = anyUncompress(\$output, $already); 317 $got = undef if ! defined $buffer && $got eq '' ; 318 ok ! $$Error, " no error [$$Error]" ; 319 is $got, $buffer, " Uncompressed matches original"; 320 } 321 322 { 323 title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ; 324 325 my @output = ('first') ; 326 ok &$Func(\$buffer, \@output, Append => $append), ' Compressed ok' ; 327 328 is $output[0], 'first', " Array[0] unchanged"; 329 is $keep, $buffer, " Input buffer not changed" ; 330 my $got = anyUncompress($output[1]); 331 $got = undef if ! defined $buffer && $got eq '' ; 332 is $got, $buffer, " Uncompressed matches original"; 333 } 334 335 { 336 title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ; 337 338 my $lex = new LexFile my $in_file ; 339 writeFile($in_file, $buffer); 340 my @output = ('first') ; 341 my @input = ($in_file); 342 ok &$Func(\@input, \@output, Append => $append), ' Compressed ok' ; 343 344 is $output[0], 'first', " Array[0] unchanged"; 345 my $got = anyUncompress($output[1]); 346 $got = undef if ! defined $buffer && $got eq '' ; 347 is $got, $buffer, " Uncompressed matches original"; 348 } 349 350 { 351 title "$TopType - From Buff to Filename content '$disp_content' Append $append" ; 352 353 my $lex = new LexFile my $out_file ; 354 ok ! -e $out_file, " Output file does not exist"; 355 writeFile($out_file, $already); 356 357 ok &$Func(\$buffer, $out_file, Append => $append), ' Compressed ok' ; 358 359 ok -e $out_file, " Created output file"; 360 my $got = anyUncompress($out_file, $already); 361 $got = undef if ! defined $buffer && $got eq '' ; 362 is $got, $buffer, " Uncompressed matches original"; 363 } 364 365 { 366 title "$TopType - From Buff to Handle content '$disp_content' Append $append" ; 367 368 my $lex = new LexFile my $out_file ; 369 370 ok ! -e $out_file, " Output file does not exist"; 371 writeFile($out_file, $already); 372 my $of = new IO::File ">>$out_file" ; 373 ok $of, " Created output filehandle" ; 374 375 ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), ' Compressed ok' ; 376 377 ok -e $out_file, " Created output file"; 378 my $got = anyUncompress($out_file, $already); 379 $got = undef if ! defined $buffer && $got eq '' ; 380 is $got, $buffer, " Uncompressed matches original"; 381 } 382 383 384 { 385 title "$TopType - From Filename to Filename content '$disp_content' Append $append" ; 386 387 my $lex = new LexFile(my $in_file, my $out_file) ; 388 writeFile($in_file, $buffer); 389 390 ok ! -e $out_file, " Output file does not exist"; 391 writeFile($out_file, $already); 392 393 ok &$Func($in_file => $out_file, Append => $append), ' Compressed ok' ; 394 395 ok -e $out_file, " Created output file"; 396 my $got = anyUncompress($out_file, $already); 397 $got = undef if ! defined $buffer && $got eq '' ; 398 is $got, $buffer, " Uncompressed matches original"; 399 400 } 401 402 { 403 title "$TopType - From Filename to Handle content '$disp_content' Append $append" ; 404 405 my $lex = new LexFile(my $in_file, my $out_file) ; 406 writeFile($in_file, $buffer); 407 408 ok ! -e $out_file, " Output file does not exist"; 409 writeFile($out_file, $already); 410 my $out = new IO::File ">>$out_file" ; 411 412 ok &$Func($in_file, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; 413 414 ok -e $out_file, " Created output file"; 415 my $got = anyUncompress($out_file, $already); 416 $got = undef if ! defined $buffer && $got eq '' ; 417 is $got, $buffer, " Uncompressed matches original"; 418 419 } 420 421 { 422 title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ; 423 424 my $lex = new LexFile(my $in_file, my $out_file) ; 425 writeFile($in_file, $buffer); 426 427 my $out = $already; 428 429 ok &$Func($in_file => \$out, Append => $append), ' Compressed ok' ; 430 431 my $got = anyUncompress(\$out, $already); 432 $got = undef if ! defined $buffer && $got eq '' ; 433 is $got, $buffer, " Uncompressed matches original"; 434 435 } 436 437 { 438 title "$TopType - From Handle to Filename content '$disp_content' Append $append" ; 439 440 my $lex = new LexFile(my $in_file, my $out_file) ; 441 writeFile($in_file, $buffer); 442 my $in = new IO::File "<$in_file" ; 443 444 ok ! -e $out_file, " Output file does not exist"; 445 writeFile($out_file, $already); 446 447 ok &$Func($in, $out_file, Append => $append), ' Compressed ok' 448 or diag "error is $$Error" ; 449 450 ok -e $out_file, " Created output file"; 451 my $got = anyUncompress($out_file, $already); 452 $got = undef if ! defined $buffer && $got eq '' ; 453 is $buffer, $got, " Uncompressed matches original"; 454 455 } 456 457 { 458 title "$TopType - From Handle to Handle content '$disp_content' Append $append" ; 459 460 my $lex = new LexFile(my $in_file, my $out_file) ; 461 writeFile($in_file, $buffer); 462 my $in = new IO::File "<$in_file" ; 463 464 ok ! -e $out_file, " Output file does not exist"; 465 writeFile($out_file, $already); 466 my $out = new IO::File ">>$out_file" ; 467 468 ok &$Func($in, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; 469 470 ok -e $out_file, " Created output file"; 471 my $got = anyUncompress($out_file, $already); 472 $got = undef if ! defined $buffer && $got eq '' ; 473 is $buffer, $got, " Uncompressed matches original"; 474 475 } 476 477 { 478 title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ; 479 480 my $lex = new LexFile(my $in_file, my $out_file) ; 481 writeFile($in_file, $buffer); 482 my $in = new IO::File "<$in_file" ; 483 484 my $out = $already ; 485 486 ok &$Func($in, \$out, Append => $append), ' Compressed ok' ; 487 488 my $got = anyUncompress(\$out, $already); 489 $got = undef if ! defined $buffer && $got eq '' ; 490 is $buffer, $got, " Uncompressed matches original"; 491 492 } 493 494 { 495 title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ; 496 497 my $lex = new LexFile(my $in_file, my $out_file) ; 498 writeFile($in_file, $buffer); 499 500 open(SAVEIN, "<&STDIN"); 501 my $dummy = fileno SAVEIN ; 502 ok open(STDIN, "<$in_file"), " redirect STDIN"; 503 504 my $out = $already; 505 506 ok &$Func('-', \$out, Append => $append), ' Compressed ok' 507 or diag $$Error ; 508 509 open(STDIN, "<&SAVEIN"); 510 511 my $got = anyUncompress(\$out, $already); 512 $got = undef if ! defined $buffer && $got eq '' ; 513 is $buffer, $got, " Uncompressed matches original"; 514 515 } 516 517 } 518 } 519 } 520 521 foreach my $bit ($CompressClass) 522 { 523 my $Error = getErrorRef($bit); 524 my $Func = getTopFuncRef($bit); 525 my $TopType = getTopFuncName($bit); 526 527 my $TopTypeInverse = getInverse($bit); 528 my $FuncInverse = getTopFuncRef($TopTypeInverse); 529 my $ErrorInverse = getErrorRef($TopTypeInverse); 530 531 my $lex = new LexFile(my $file1, my $file2) ; 532 533 writeFile($file1, $OriginalContent1); 534 writeFile($file2, $OriginalContent2); 535 my $of = new IO::File "<$file1" ; 536 ok $of, " Created output filehandle" ; 537 538 #my @input = ( undef, "", $file2, \undef, \'', \"abcde", $of) ; 539 #my @expected = ("", "", $file2, "", "", "abcde", $OriginalContent1); 540 #my @uexpected = ("", "", $OriginalContent2, "", "", "abcde", $OriginalContent1); 541 #my @input = ( $file2, \"abcde", $of) ; 542 #my @expected = ( $file2, "abcde", $OriginalContent1); 543 #my @uexpected = ($OriginalContent2, "abcde", $OriginalContent1); 544 545 my @input = ( $file1, $file2) ; 546 #my @expected = ( $file1, $file2); 547 my @expected = ($OriginalContent1, $OriginalContent2); 548 my @uexpected = ($OriginalContent1, $OriginalContent2); 549 550 my @keep = @input ; 551 552 { 553 title "$TopType - From Array Ref to Array Ref" ; 554 555 my @output = ('first') ; 556 ok &$Func(\@input, \@output, AutoClose => 0), ' Compressed ok' ; 557 558 is $output[0], 'first', " Array[0] unchanged"; 559 560 is_deeply \@input, \@keep, " Input array not changed" ; 561 my @got = shift @output; 562 foreach (@output) { push @got, anyUncompress($_) } 563 564 is_deeply \@got, ['first', @expected], " Got Expected uncompressed data"; 565 566 } 567 568 foreach my $ms (@MultiValues) 569 { 570 { 571 title "$TopType - From Array Ref to Buffer, MultiStream $ms" ; 572 573 # rewind the filehandle 574 $of->open("<$file1") ; 575 576 my $output ; 577 ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok' 578 or diag $$Error; 579 580 my $got = anyUncompress([ \$output, MultiStream => $ms ]); 581 582 is $got, join('', @uexpected), " Got Expected uncompressed data"; 583 my @headers = getHeaders(\$output); 584 is @headers, $ms ? @input : 1, " Header count ok"; 585 } 586 587 { 588 title "$TopType - From Array Ref to Filename, MultiStream $ms" ; 589 590 my $lex = new LexFile( my $file3) ; 591 592 # rewind the filehandle 593 $of->open("<$file1") ; 594 595 my $output ; 596 ok &$Func(\@input, $file3, MultiStream => $ms, AutoClose => 0), ' Compressed ok' ; 597 598 my $got = anyUncompress([ $file3, MultiStream => $ms ]); 599 600 is $got, join('', @uexpected), " Got Expected uncompressed data"; 601 my @headers = getHeaders($file3); 602 is @headers, $ms ? @input : 1, " Header count ok"; 603 } 604 605 { 606 title "$TopType - From Array Ref to Filehandle, MultiStream $ms" ; 607 608 my $lex = new LexFile(my $file3) ; 609 610 my $fh3 = new IO::File ">$file3"; 611 612 # rewind the filehandle 613 $of->open("<$file1") ; 614 615 my $output ; 616 ok &$Func(\@input, $fh3, MultiStream => $ms, AutoClose => 0), ' Compressed ok' ; 617 618 $fh3->close(); 619 620 my $got = anyUncompress([ $file3, MultiStream => $ms ]); 621 622 is $got, join('', @uexpected), " Got Expected uncompressed data"; 623 my @headers = getHeaders($file3); 624 is @headers, $ms ? @input : 1, " Header count ok"; 625 } 626 627 SKIP: 628 { 629 title "Truncated file"; 630 skip '', 7 631 if $CompressClass =~ /lzop|lzf|lzma|zstd|lzip/i ; 632 633 my @in ; 634 push @in, "abcde" x 10; 635 push @in, "defgh" x 1000; 636 push @in, "12345" x 50000; 637 638 my $out; 639 640 for (@in) { 641 ok &$Func(\$_ , \$out, Append => 1 ), ' Compressed ok' 642 or diag $$Error; 643 } 644 #ok &$Func(\@in, \$out, MultiStream => 1 ), ' Compressed ok' 645 substr($out, -179) = ''; 646 647 my $got; 648 my $status ; 649 ok $status = &$FuncInverse(\$out => \$got, MultiStream => 0), " Uncompressed stream 1 ok"; 650 is $got, "abcde" x 10 ; 651 ok ! &$FuncInverse(\$out => \$got, MultiStream => 1), " Didn't uncompress"; 652 is $$ErrorInverse, "unexpected end of file", " Got unexpected eof"; 653 } 654 } 655 } 656 657 foreach my $bit ($CompressClass) 658 { 659 660 my $Error = getErrorRef($bit); 661 my $Func = getTopFuncRef($bit); 662 my $TopType = getTopFuncName($bit); 663 664 my $TopTypeInverse = getInverse($bit); 665 my $FuncInverse = getTopFuncRef($TopTypeInverse); 666 my $ErrorInverse = getErrorRef($TopTypeInverse); 667 668 title 'Round trip binary data that happens to include \r\n' ; 669 670 my $lex = new LexFile(my $file1, my $file2, my $file3) ; 671 672 my $original = join '', map { chr } 0x00 .. 0xff ; 673 $original .= "data1\r\ndata2\r\ndata3\r\n" ; 674 675 writeFile($file1, $original); 676 is readFile($file1), $original; 677 678 ok &$Func($file1 => $file2), ' Compressed ok' ; 679 ok &$FuncInverse($file2 => $file3), ' Uncompressed ok' ; 680 is readFile($file3), $original, " round tripped ok"; 681 682 } 683 684 foreach my $bit ($UncompressClass, 685 #'IO::Uncompress::AnyUncompress', 686 ) 687 { 688 my $Error = getErrorRef($bit); 689 my $Func = getTopFuncRef($bit); 690 my $TopType = getTopFuncName($bit); 691 my $CompressClass = getInverse($bit); 692 my $C_Func = getTopFuncRef($CompressClass); 693 694 695 696 my $data = "mary had a little lamb" ; 697 my $keep = $data ; 698 my $extra = "after the main event"; 699 700 SKIP: 701 foreach my $fb ( qw( filehandle buffer ) ) 702 { 703 title "Trailingdata with $TopType, from $fb"; 704 705 skip "zstd doesn't support trailing data", 9 706 if $CompressClass =~ /zstd/i ; 707 708 my $lex = new LexFile my $name ; 709 my $input ; 710 711 my $compressed ; 712 ok &$C_Func(\$data, \$compressed), ' Compressed ok' ; 713 $compressed .= $extra; 714 715 if ($fb eq 'buffer') 716 { 717 $input = \$compressed; 718 } 719 else 720 { 721 writeFile($name, $compressed); 722 723 $input = new IO::File "<$name" ; 724 } 725 726 my $trailing; 727 my $out; 728 ok $Func->($input, \$out, TrailingData => $trailing), " Uncompressed OK" ; 729 is $out, $keep, " Got uncompressed data"; 730 731 my $rest = ''; 732 if ($fb eq 'filehandle') 733 { 734 read($input, $rest, 10000) ; 735 } 736 737 is $trailing . $rest, $extra, " Got trailing data"; 738 739 } 740 } 741 742 743# foreach my $bit ($CompressClass) 744# { 745# my $Error = getErrorRef($bit); 746# my $Func = getTopFuncRef($bit); 747# my $TopType = getTopFuncName($bit); 748# 749# my $TopTypeInverse = getInverse($bit); 750# my $FuncInverse = getTopFuncRef($TopTypeInverse); 751# 752# my @inFiles = map { "in$_.tmp" } 1..4; 753# my @outFiles = map { "out$_.tmp" } 1..4; 754# my $lex = new LexFile(@inFiles, @outFiles); 755# 756# writeFile($_, "data $_") foreach @inFiles ; 757# 758# { 759# title "$TopType - Hash Ref: to filename" ; 760# 761# my $output ; 762# ok &$Func( { $inFiles[0] => $outFiles[0], 763# $inFiles[1] => $outFiles[1], 764# $inFiles[2] => $outFiles[2] } ), ' Compressed ok' ; 765# 766# foreach (0 .. 2) 767# { 768# my $got = anyUncompress($outFiles[$_]); 769# is $got, "data $inFiles[$_]", " Uncompressed $_ matches original"; 770# } 771# } 772# 773# { 774# title "$TopType - Hash Ref: to buffer" ; 775# 776# my @buffer ; 777# ok &$Func( { $inFiles[0] => \$buffer[0], 778# $inFiles[1] => \$buffer[1], 779# $inFiles[2] => \$buffer[2] } ), ' Compressed ok' ; 780# 781# foreach (0 .. 2) 782# { 783# my $got = anyUncompress(\$buffer[$_]); 784# is $got, "data $inFiles[$_]", " Uncompressed $_ matches original"; 785# } 786# } 787# 788# { 789# title "$TopType - Hash Ref: to undef" ; 790# 791# my @buffer ; 792# my %hash = ( $inFiles[0] => undef, 793# $inFiles[1] => undef, 794# $inFiles[2] => undef, 795# ); 796# 797# ok &$Func( \%hash ), ' Compressed ok' ; 798# 799# foreach (keys %hash) 800# { 801# my $got = anyUncompress(\$hash{$_}); 802# is $got, "data $_", " Uncompressed $_ matches original"; 803# } 804# } 805# 806# { 807# title "$TopType - Filename to Hash Ref" ; 808# 809# my %output ; 810# ok &$Func( $inFiles[0] => \%output), ' Compressed ok' ; 811# 812# is keys %output, 1, " one pair in hash" ; 813# my ($k, $v) = each %output; 814# is $k, $inFiles[0], " key is '$inFiles[0]'"; 815# my $got = anyUncompress($v); 816# is $got, "data $inFiles[0]", " Uncompressed matches original"; 817# } 818# 819# { 820# title "$TopType - File Glob to Hash Ref" ; 821# 822# my %output ; 823# ok &$Func( '<in*.tmp>' => \%output), ' Compressed ok' ; 824# 825# is keys %output, 4, " four pairs in hash" ; 826# foreach my $fil (@inFiles) 827# { 828# ok exists $output{$fil}, " key '$fil' exists" ; 829# my $got = anyUncompress($output{$fil}); 830# is $got, "data $fil", " Uncompressed matches original"; 831# } 832# } 833# 834# 835# } 836 837# foreach my $bit ($CompressClass) 838# { 839# my $Error = getErrorRef($bit); 840# my $Func = getTopFuncRef($bit); 841# my $TopType = getTopFuncName($bit); 842# 843# my $TopTypeInverse = getInverse($bit); 844# my $FuncInverse = getTopFuncRef($TopTypeInverse); 845# 846# my @inFiles = map { "in$_.tmp" } 1..4; 847# my @outFiles = map { "out$_.tmp" } 1..4; 848# my $lex = new LexFile(@inFiles, @outFiles); 849# 850# writeFile($_, "data $_") foreach @inFiles ; 851# 852# 853# 854# # if (0) 855# # { 856# # title "$TopType - Hash Ref to Array Ref" ; 857# # 858# # my @output = ('first') ; 859# # ok &$Func( { \@input, \@output } , AutoClose => 0), ' Compressed ok' ; 860# # 861# # is $output[0], 'first', " Array[0] unchanged"; 862# # 863# # is_deeply \@input, \@keep, " Input array not changed" ; 864# # my @got = shift @output; 865# # foreach (@output) { push @got, anyUncompress($_) } 866# # 867# # is_deeply \@got, ['first', @expected], " Got Expected uncompressed data"; 868# # 869# # } 870# # 871# # if (0) 872# # { 873# # title "$TopType - From Array Ref to Buffer" ; 874# # 875# # # rewind the filehandle 876# # $of->open("<$file1") ; 877# # 878# # my $output ; 879# # ok &$Func(\@input, \$output, AutoClose => 0), ' Compressed ok' ; 880# # 881# # my $got = anyUncompress(\$output); 882# # 883# # is $got, join('', @expected), " Got Expected uncompressed data"; 884# # } 885# # 886# # if (0) 887# # { 888# # title "$TopType - From Array Ref to Filename" ; 889# # 890# # my ($file3) = ("file3"); 891# # my $lex = new LexFile($file3) ; 892# # 893# # # rewind the filehandle 894# # $of->open("<$file1") ; 895# # 896# # my $output ; 897# # ok &$Func(\@input, $file3, AutoClose => 0), ' Compressed ok' ; 898# # 899# # my $got = anyUncompress($file3); 900# # 901# # is $got, join('', @expected), " Got Expected uncompressed data"; 902# # } 903# # 904# # if (0) 905# # { 906# # title "$TopType - From Array Ref to Filehandle" ; 907# # 908# # my ($file3) = ("file3"); 909# # my $lex = new LexFile($file3) ; 910# # 911# # my $fh3 = new IO::File ">$file3"; 912# # 913# # # rewind the filehandle 914# # $of->open("<$file1") ; 915# # 916# # my $output ; 917# # ok &$Func(\@input, $fh3, AutoClose => 0), ' Compressed ok' ; 918# # 919# # $fh3->close(); 920# # 921# # my $got = anyUncompress($file3); 922# # 923# # is $got, join('', @expected), " Got Expected uncompressed data"; 924# # } 925# } 926 927 foreach my $bit ($CompressClass 928 ) 929 { 930 my $Error = getErrorRef($bit); 931 my $Func = getTopFuncRef($bit); 932 my $TopType = getTopFuncName($bit); 933 934 for my $files ( [qw(a1)], [qw(a1 a2 a3)] ) 935 { 936 937 my $tmpDir1 ; 938 my $tmpDir2 ; 939 my $lex = new LexDir($tmpDir1, $tmpDir2) ; 940 my $d1 = quotemeta $tmpDir1 ; 941 my $d2 = quotemeta $tmpDir2 ; 942 943 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists"; 944 945 my @files = map { "$tmpDir1/$_.tmp" } @$files ; 946 foreach (@files) { writeFile($_, "abc $_") } 947 948 my @expected = map { "abc $_" } @files ; 949 my @outFiles = map { s/$d1/$tmpDir2/; $_ } @files ; 950 951 { 952 title "$TopType - From FileGlob to FileGlob files [@$files]" ; 953 954 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok' 955 or diag $$Error ; 956 957 my @copy = @expected; 958 for my $file (@outFiles) 959 { 960 is anyUncompress($file), shift @copy, " got expected from $file" ; 961 } 962 963 is @copy, 0, " got all files"; 964 } 965 966 { 967 title "$TopType - From FileGlob to Array files [@$files]" ; 968 969 my @buffer = ('first') ; 970 ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok' 971 or diag $$Error ; 972 973 is shift @buffer, 'first'; 974 975 my @copy = @expected; 976 for my $buffer (@buffer) 977 { 978 is anyUncompress($buffer), shift @copy, " got expected " ; 979 } 980 981 is @copy, 0, " got all files"; 982 } 983 984 foreach my $ms (@MultiValues) 985 { 986 { 987 title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ; 988 989 my $buffer ; 990 ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, 991 MultiStream => $ms), ' Compressed ok' 992 or diag $$Error ; 993 994 #hexDump(\$buffer); 995 996 my $got = anyUncompress([ \$buffer, MultiStream => $ms ]); 997 998 is $got, join("", @expected), " got expected" ; 999 my @headers = getHeaders(\$buffer); 1000 is @headers, $ms ? @files : 1, " Header count ok"; 1001 } 1002 1003 { 1004 title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ; 1005 1006 my $lex = new LexFile(my $filename) ; 1007 1008 ok &$Func("<$tmpDir1/a*.tmp>" => $filename, 1009 MultiStream => $ms), ' Compressed ok' 1010 or diag $$Error ; 1011 1012 #hexDump(\$buffer); 1013 1014 my $got = anyUncompress([$filename, MultiStream => $ms]); 1015 1016 is $got, join("", @expected), " got expected" ; 1017 my @headers = getHeaders($filename); 1018 is @headers, $ms ? @files : 1, " Header count ok"; 1019 } 1020 1021 { 1022 title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ; 1023 1024 my $lex = new LexFile(my $filename) ; 1025 my $fh = new IO::File ">$filename"; 1026 1027 ok &$Func("<$tmpDir1/a*.tmp>" => $fh, 1028 MultiStream => $ms, AutoClose => 1), ' Compressed ok' 1029 or diag $$Error ; 1030 1031 #hexDump(\$buffer); 1032 1033 my $got = anyUncompress([$filename, MultiStream => $ms]); 1034 1035 is $got, join("", @expected), " got expected" ; 1036 my @headers = getHeaders($filename); 1037 is @headers, $ms ? @files : 1, " Header count ok"; 1038 } 1039 } 1040 } 1041 1042 } 1043 1044 foreach my $bit ($UncompressClass, 1045 'IO::Uncompress::AnyUncompress', 1046 ) 1047 { 1048 my $Error = getErrorRef($bit); 1049 my $Func = getTopFuncRef($bit); 1050 my $TopType = getTopFuncName($bit); 1051 1052 my $buffer = $OriginalContent1; 1053 my $buffer2 = $OriginalContent2; 1054 my $keep_orig = $buffer; 1055 1056 my $comp = compressBuffer($UncompressClass, $buffer) ; 1057 my $comp2 = compressBuffer($UncompressClass, $buffer2) ; 1058 my $keep_comp = $comp; 1059 1060 my $incumbent = "incumbent data" ; 1061 1062 my @opts = (Strict => 1); 1063 push @opts, (RawInflate => 1, UnLzma => 1) 1064 if $bit eq 'IO::Uncompress::AnyUncompress'; 1065 1066 for my $append (0, 1) 1067 { 1068 my $expected = $buffer ; 1069 $expected = $incumbent . $buffer if $append ; 1070 1071 { 1072 title "$TopType - From Buff to Buff, Append($append)" ; 1073 1074 my $output ; 1075 $output = $incumbent if $append ; 1076 ok &$Func(\$comp, \$output, Append => $append, @opts), ' Uncompressed ok' ; 1077 1078 is $keep_comp, $comp, " Input buffer not changed" ; 1079 is $output, $expected, " Uncompressed matches original"; 1080 } 1081 1082 { 1083 title "$TopType - From Buff to Array, Append($append)" ; 1084 1085 my @output = ('first'); 1086 #$output = $incumbent if $append ; 1087 ok &$Func(\$comp, \@output, Append => $append, @opts), ' Uncompressed ok' ; 1088 1089 is $keep_comp, $comp, " Input buffer not changed" ; 1090 is $output[0], 'first', " Uncompressed matches original"; 1091 is ${ $output[1] }, $buffer, " Uncompressed matches original" 1092 or diag $output[1] ; 1093 is @output, 2, " only 2 elements in the array" ; 1094 } 1095 1096 { 1097 title "$TopType - From Buff to Filename, Append($append)" ; 1098 1099 my $lex = new LexFile(my $out_file) ; 1100 if ($append) 1101 { writeFile($out_file, $incumbent) } 1102 else 1103 { ok ! -e $out_file, " Output file does not exist" } 1104 1105 ok &$Func(\$comp, $out_file, Append => $append, @opts), ' Uncompressed ok' ; 1106 1107 ok -e $out_file, " Created output file"; 1108 my $content = readFile($out_file) ; 1109 1110 is $keep_comp, $comp, " Input buffer not changed" ; 1111 is $content, $expected, " Uncompressed matches original"; 1112 } 1113 1114 { 1115 title "$TopType - From Buff to Handle, Append($append)" ; 1116 1117 my $lex = new LexFile(my $out_file) ; 1118 my $of ; 1119 if ($append) { 1120 writeFile($out_file, $incumbent) ; 1121 $of = new IO::File "+< $out_file" ; 1122 } 1123 else { 1124 ok ! -e $out_file, " Output file does not exist" ; 1125 $of = new IO::File "> $out_file" ; 1126 } 1127 isa_ok $of, 'IO::File', ' $of' ; 1128 1129 ok &$Func(\$comp, $of, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ; 1130 1131 ok -e $out_file, " Created output file"; 1132 my $content = readFile($out_file) ; 1133 1134 is $keep_comp, $comp, " Input buffer not changed" ; 1135 is $content, $expected, " Uncompressed matches original"; 1136 } 1137 1138 { 1139 title "$TopType - From Filename to Filename, Append($append)" ; 1140 1141 my $lex = new LexFile(my $in_file, my $out_file) ; 1142 if ($append) 1143 { writeFile($out_file, $incumbent) } 1144 else 1145 { ok ! -e $out_file, " Output file does not exist" } 1146 1147 writeFile($in_file, $comp); 1148 1149 ok &$Func($in_file, $out_file, Append => $append, @opts), ' Uncompressed ok' ; 1150 1151 ok -e $out_file, " Created output file"; 1152 my $content = readFile($out_file) ; 1153 1154 is $keep_comp, $comp, " Input buffer not changed" ; 1155 is $content, $expected, " Uncompressed matches original"; 1156 } 1157 1158 { 1159 title "$TopType - From Filename to Handle, Append($append)" ; 1160 1161 my $lex = new LexFile(my $in_file, my $out_file) ; 1162 my $out ; 1163 if ($append) { 1164 writeFile($out_file, $incumbent) ; 1165 $out = new IO::File "+< $out_file" ; 1166 } 1167 else { 1168 ok ! -e $out_file, " Output file does not exist" ; 1169 $out = new IO::File "> $out_file" ; 1170 } 1171 isa_ok $out, 'IO::File', ' $out' ; 1172 1173 writeFile($in_file, $comp); 1174 1175 ok &$Func($in_file, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ; 1176 1177 ok -e $out_file, " Created output file"; 1178 my $content = readFile($out_file) ; 1179 1180 is $keep_comp, $comp, " Input buffer not changed" ; 1181 is $content, $expected, " Uncompressed matches original"; 1182 } 1183 1184 { 1185 title "$TopType - From Filename to Buffer, Append($append)" ; 1186 1187 my $lex = new LexFile(my $in_file) ; 1188 writeFile($in_file, $comp); 1189 1190 my $output ; 1191 $output = $incumbent if $append ; 1192 1193 ok &$Func($in_file, \$output, Append => $append, @opts), ' Uncompressed ok' ; 1194 1195 is $keep_comp, $comp, " Input buffer not changed" ; 1196 is $output, $expected, " Uncompressed matches original"; 1197 } 1198 1199 { 1200 title "$TopType - From Handle to Filename, Append($append)" ; 1201 1202 my $lex = new LexFile(my $in_file, my $out_file) ; 1203 if ($append) 1204 { writeFile($out_file, $incumbent) } 1205 else 1206 { ok ! -e $out_file, " Output file does not exist" } 1207 1208 writeFile($in_file, $comp); 1209 my $in = new IO::File "<$in_file" ; 1210 1211 ok &$Func($in, $out_file, Append => $append, @opts), ' Uncompressed ok' ; 1212 1213 ok -e $out_file, " Created output file"; 1214 my $content = readFile($out_file) ; 1215 1216 is $keep_comp, $comp, " Input buffer not changed" ; 1217 is $content, $expected, " Uncompressed matches original"; 1218 } 1219 1220 { 1221 title "$TopType - From Handle to Handle, Append($append)" ; 1222 1223 my $lex = new LexFile(my $in_file, my $out_file) ; 1224 my $out ; 1225 if ($append) { 1226 writeFile($out_file, $incumbent) ; 1227 $out = new IO::File "+< $out_file" ; 1228 } 1229 else { 1230 ok ! -e $out_file, " Output file does not exist" ; 1231 $out = new IO::File "> $out_file" ; 1232 } 1233 isa_ok $out, 'IO::File', ' $out' ; 1234 1235 writeFile($in_file, $comp); 1236 my $in = new IO::File "<$in_file" ; 1237 1238 ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ; 1239 1240 ok -e $out_file, " Created output file"; 1241 my $content = readFile($out_file) ; 1242 1243 is $keep_comp, $comp, " Input buffer not changed" ; 1244 is $content, $expected, " Uncompressed matches original"; 1245 } 1246 1247 { 1248 title "$TopType - From Filename to Buffer, Append($append)" ; 1249 1250 my $lex = new LexFile(my $in_file) ; 1251 writeFile($in_file, $comp); 1252 my $in = new IO::File "<$in_file" ; 1253 1254 my $output ; 1255 $output = $incumbent if $append ; 1256 1257 ok &$Func($in, \$output, Append => $append, @opts), ' Uncompressed ok' ; 1258 1259 is $keep_comp, $comp, " Input buffer not changed" ; 1260 is $output, $expected, " Uncompressed matches original"; 1261 } 1262 1263 { 1264 title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ; 1265 1266 my $lex = new LexFile(my $in_file) ; 1267 writeFile($in_file, $comp); 1268 1269 open(SAVEIN, "<&STDIN"); 1270 my $dummy = fileno SAVEIN ; 1271 ok open(STDIN, "<$in_file"), " redirect STDIN"; 1272 1273 my $output ; 1274 $output = $incumbent if $append ; 1275 1276 ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok' 1277 or diag $$Error ; 1278 1279 open(STDIN, "<&SAVEIN"); 1280 1281 is $keep_comp, $comp, " Input buffer not changed" ; 1282 is $output, $expected, " Uncompressed matches original"; 1283 } 1284 } 1285 1286 { 1287 title "$TopType - From Handle to Buffer, InputLength" ; 1288 1289 my $lex = new LexFile(my $in_file, my $out_file) ; 1290 my $out ; 1291 1292 my $expected = $buffer ; 1293 my $appended = 'appended'; 1294 my $len_appended = length $appended; 1295 writeFile($in_file, $comp . $appended . $comp . $appended) ; 1296 my $in = new IO::File "<$in_file" ; 1297 1298 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ; 1299 1300 is $out, $expected, " Uncompressed matches original"; 1301 1302 my $buff; 1303 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok"; 1304 is $buff, $appended, " Appended data ok"; 1305 1306 $out = ''; 1307 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ; 1308 1309 is $out, $expected, " Uncompressed matches original"; 1310 1311 $buff = ''; 1312 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok"; 1313 is $buff, $appended, " Appended data ok"; 1314 } 1315 1316 for my $stdin ('-', *STDIN) # , \*STDIN) 1317 { 1318 title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ; 1319 1320 my $lex = new LexFile my $in_file ; 1321 my $expected = $buffer ; 1322 my $appended = 'appended'; 1323 my $len_appended = length $appended; 1324 writeFile($in_file, $comp . $appended ) ; 1325 1326 open(SAVEIN, "<&STDIN"); 1327 my $dummy = fileno SAVEIN ; 1328 ok open(STDIN, "<$in_file"), " redirect STDIN"; 1329 1330 my $output ; 1331 1332 ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' 1333 or diag $$Error ; 1334 1335 my $buff ; 1336 is read(STDIN, $buff, $len_appended), $len_appended, " Length of Appended data ok"; 1337 1338 is $output, $expected, " Uncompressed matches original"; 1339 is $buff, $appended, " Appended data ok"; 1340 1341 open(STDIN, "<&SAVEIN"); 1342 } 1343 } 1344 1345 foreach my $bit ($UncompressClass, 1346 'IO::Uncompress::AnyUncompress', 1347 ) 1348 { 1349 # TODO -- Add Append mode tests 1350 1351 my $Error = getErrorRef($bit); 1352 my $Func = getTopFuncRef($bit); 1353 my $TopType = getTopFuncName($bit); 1354 1355 my $buffer = "abcde" ; 1356 my $keep_orig = $buffer; 1357 1358 my $null = compressBuffer($UncompressClass, "") ; 1359 my $undef = compressBuffer($UncompressClass, undef) ; 1360 my $comp = compressBuffer($UncompressClass, $buffer) ; 1361 my $keep_comp = $comp; 1362 1363 my @opts = (); 1364 @opts = (RawInflate => 1, UnLzma => 1) 1365 if $bit eq 'IO::Uncompress::AnyUncompress'; 1366 1367 my $incumbent = "incumbent data" ; 1368 1369 my $lex = new LexFile(my $file1, my $file2) ; 1370 1371 writeFile($file1, compressBuffer($UncompressClass, $OriginalContent1)); 1372 writeFile($file2, compressBuffer($UncompressClass, $OriginalContent2)); 1373 1374 my $of = new IO::File "<$file1" ; 1375 ok $of, " Created output filehandle" ; 1376 1377 #my @input = ($file2, \$undef, \$null, \$comp, $of) ; 1378 #my @expected = ('data2', '', '', 'abcde', 'data1'); 1379 my @input = ($file1, $file2); 1380 my @expected = ($OriginalContent1, $OriginalContent2); 1381 1382 my @keep = @input ; 1383 1384 { 1385 title "$TopType - From ArrayRef to Buffer" ; 1386 1387 my $output ; 1388 ok &$Func(\@input, \$output, AutoClose => 0, @opts), ' UnCompressed ok' ; 1389 1390 is $output, join('', @expected) 1391 } 1392 1393 { 1394 title "$TopType - From ArrayRef to Filename" ; 1395 1396 my $lex = new LexFile my $output; 1397 $of->open("<$file1") ; 1398 1399 ok &$Func(\@input, $output, AutoClose => 0, @opts), ' UnCompressed ok' ; 1400 1401 is readFile($output), join('', @expected) 1402 } 1403 1404 { 1405 title "$TopType - From ArrayRef to Filehandle" ; 1406 1407 my $lex = new LexFile my $output; 1408 my $fh = new IO::File ">$output" ; 1409 $of->open("<$file1") ; 1410 1411 ok &$Func(\@input, $fh, AutoClose => 0, @opts), ' UnCompressed ok' ; 1412 $fh->close; 1413 1414 is readFile($output), join('', @expected) 1415 } 1416 1417 { 1418 title "$TopType - From Array Ref to Array Ref" ; 1419 1420 my @output = (\'first') ; 1421 $of->open("<$file1") ; 1422 ok &$Func(\@input, \@output, AutoClose => 0, @opts), ' UnCompressed ok' ; 1423 1424 is_deeply \@input, \@keep, " Input array not changed" ; 1425 is_deeply [map { defined $$_ ? $$_ : "" } @output], 1426 ['first', @expected], 1427 " Got Expected uncompressed data"; 1428 1429 } 1430 } 1431 1432 foreach my $bit ($UncompressClass, 1433 'IO::Uncompress::AnyUncompress', 1434 ) 1435 { 1436 # TODO -- Add Append mode tests 1437 1438 my $Error = getErrorRef($bit); 1439 my $Func = getTopFuncRef($bit); 1440 my $TopType = getTopFuncName($bit); 1441 1442 my $tmpDir1 ; 1443 my $tmpDir2 ; 1444 my $lex = new LexDir($tmpDir1, $tmpDir2) ; 1445 my $d1 = quotemeta $tmpDir1 ; 1446 my $d2 = quotemeta $tmpDir2 ; 1447 1448 my @opts = (); 1449 @opts = (RawInflate => 1, UnLzma => 1) 1450 if $bit eq 'IO::Uncompress::AnyUncompress'; 1451 1452 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists"; 1453 1454 my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ; 1455 foreach (@files) { writeFile($_, compressBuffer($UncompressClass, "abc $_")) } 1456 1457 my @expected = map { "abc $_" } @files ; 1458 my @outFiles = map { s/$d1/$tmpDir2/; $_ } @files ; 1459 1460 { 1461 title "$TopType - From FileGlob to FileGlob" ; 1462 1463 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok' 1464 or diag $$Error ; 1465 1466 my @copy = @expected; 1467 for my $file (@outFiles) 1468 { 1469 is readFile($file), shift @copy, " got expected from $file" ; 1470 } 1471 1472 is @copy, 0, " got all files"; 1473 } 1474 1475 { 1476 title "$TopType - From FileGlob to Arrayref" ; 1477 1478 my @output = (\'first'); 1479 ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok' 1480 or diag $$Error ; 1481 1482 my @copy = ('first', @expected); 1483 for my $data (@output) 1484 { 1485 is $$data, shift @copy, " got expected data" ; 1486 } 1487 1488 is @copy, 0, " got all files"; 1489 } 1490 1491 { 1492 title "$TopType - From FileGlob to Buffer" ; 1493 1494 my $output ; 1495 ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok' 1496 or diag $$Error ; 1497 1498 is $output, join('', @expected), " got expected uncompressed data"; 1499 } 1500 1501 { 1502 title "$TopType - From FileGlob to Filename" ; 1503 1504 my $lex = new LexFile my $output ; 1505 ok ! -e $output, " $output does not exist" ; 1506 ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok' 1507 or diag $$Error ; 1508 1509 ok -e $output, " $output does exist" ; 1510 is readFile($output), join('', @expected), " got expected uncompressed data"; 1511 } 1512 1513 { 1514 title "$TopType - From FileGlob to Filehandle" ; 1515 1516 my $lex = new LexFile my $output ; 1517 my $fh = new IO::File ">$output" ; 1518 ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' 1519 or diag $$Error ; 1520 1521 ok -e $output, " $output does exist" ; 1522 is readFile($output), join('', @expected), " got expected uncompressed data"; 1523 } 1524 1525 } 1526 1527 foreach my $TopType ($CompressClass 1528 # TODO -- add the inflate classes 1529 ) 1530 { 1531 my $Error = getErrorRef($TopType); 1532 my $Func = getTopFuncRef($TopType); 1533 my $Name = getTopFuncName($TopType); 1534 1535 title "More write tests" ; 1536 1537 my $lex = new LexFile(my $file1, my $file2, my $file3) ; 1538 1539 writeFile($file1, "F1"); 1540 writeFile($file2, "F2"); 1541 writeFile($file3, "F3"); 1542 1543# my @data = ( 1544# [ '[\"ab", \"cd"]', "abcd" ], 1545# 1546# [ '[\"a", $fh1, \"bc"]', "aF1bc"], 1547# ) ; 1548# 1549# 1550# foreach my $data (@data) 1551# { 1552# my ($send, $get) = @$data ; 1553# 1554# my $fh1 = new IO::File "< $file1" ; 1555# my $fh2 = new IO::File "< $file2" ; 1556# my $fh3 = new IO::File "< $file3" ; 1557# 1558# title "$send"; 1559# my ($copy); 1560# eval "\$copy = $send"; 1561# my $Answer ; 1562# ok &$Func($copy, \$Answer), " $Name ok"; 1563# 1564# my $got = anyUncompress(\$Answer); 1565# is $got, $get, " got expected output" ; 1566# ok ! $$Error, " no error" 1567# or diag "Error is $$Error"; 1568# 1569# } 1570 1571 title "Array Input Error tests" ; 1572 1573 my @data = ( 1574 [ '[]', "empty array reference"], 1575 [ '[[]]', "unknown input parameter"], 1576 [ '[[[]]]', "unknown input parameter"], 1577 [ '[[\"ab"], [\"cd"]]', "unknown input parameter"], 1578 [ '[\""]', "not a filename"], 1579 [ '[\undef]', "not a filename"], 1580 [ '[\"abcd"]', "not a filename"], 1581 [ '[\&xx]', "unknown input parameter"], 1582 [ '[$fh2]', "not a filename"], 1583 ) ; 1584 1585 1586 foreach my $data (@data) 1587 { 1588 my ($send, $get) = @$data ; 1589 1590 my $fh1 = new IO::File "< $file1" ; 1591 my $fh2 = new IO::File "< $file2" ; 1592 my $fh3 = new IO::File "< $file3" ; 1593 1594 title "$send"; 1595 my($copy); 1596 eval "\$copy = $send"; 1597 my $Answer ; 1598 my $a ; 1599 eval { $a = &$Func($copy, \$Answer) }; 1600 ok ! $a, " $Name fails"; 1601 1602 is $$Error, $get, " got error message"; 1603 1604 } 1605 1606 @data = ( 1607 '[""]', 1608 '[undef]', 1609 ) ; 1610 1611 1612 foreach my $send (@data) 1613 { 1614 title "$send"; 1615 my($copy); 1616 eval "\$copy = $send"; 1617 my $Answer ; 1618 eval { &$Func($copy, \$Answer) } ; 1619 like $@, mkErr("^$TopFuncName: input filename is undef or null string"), 1620 " got error message"; 1621 1622 } 1623 } 1624 1625 1626 { 1627 # check setting $\ 1628 1629 my $CompFunc = getTopFuncRef($CompressClass); 1630 my $UncompFunc = getTopFuncRef($UncompressClass); 1631 my $lex = new LexFile my $file ; 1632 1633 local $\ = "\n" ; 1634 my $input = "hello world"; 1635 my $compressed ; 1636 my $output; 1637 ok &$CompFunc(\$input => \$compressed), ' Compressed ok' ; 1638 ok &$UncompFunc(\$compressed => $file), ' UnCompressed ok' ; 1639 my $content = readFile($file) ; 1640 is $content, $input, "round trip ok" ; 1641 1642 } 1643 1644 SKIP: 1645 { 1646 #95494: IO::Uncompress::Gunzip: Can no longer gunzip to in-memory file handle 1647 1648 skip "open filehandle to buffer not supported in Perl $]", 7 1649 if $] < 5.008 ; 1650 my $CompFunc = getTopFuncRef($CompressClass); 1651 my $UncompFunc = getTopFuncRef($UncompressClass); 1652 1653 my $input = "hello world"; 1654 my $compressed ; 1655 ok open my $fh_in1, '<', \$input ; 1656 ok open my $fh_out1, '>', \$compressed ; 1657 ok &$CompFunc($fh_in1 => $fh_out1), ' Compressed ok' ; 1658 1659 my $output; 1660 ok open my $fh_in2, '<', \$compressed ; 1661 ok open my $fh_out2, '>', \$output ; 1662 1663 ok &$UncompFunc($fh_in2 => $fh_out2), ' UnCompressed ok' ; 1664 is $output, $input, "round trip ok" ; 1665 } 1666 1667 1668} 1669 1670# TODO add more error cases 1671 16721; 1673