use strict; use warnings; use bytes; use Test::More ; use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); use CompTestUtils; our ($UncompressClass); BEGIN { # use Test::NoWarnings, if available my $extra = 0 ; my $st = eval { require Test::NoWarnings ; import Test::NoWarnings; 1; }; $extra = 1 if $st ; plan(tests => 799 + $extra) ; } sub myGZreadFile { my $filename = shift ; my $init = shift ; my $fil = new $UncompressClass $filename, -Strict => 0, -Append => 1 ; my $data = ''; $data = $init if defined $init ; 1 while $fil->read($data) > 0; $fil->close ; return $data ; } sub run { my $CompressClass = identify(); $UncompressClass = getInverse($CompressClass); my $Error = getErrorRef($CompressClass); my $UnError = getErrorRef($UncompressClass); if(1) { title "Testing $CompressClass Errors"; # Buffer not writable eval qq[\$a = new $CompressClass(\\1) ;] ; like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ; my($out, $gz); my $x ; $gz = new $CompressClass(\$x); foreach my $name (qw(read readline getc)) { eval " \$gz->$name() " ; like $@, mkEvalErr("^$name Not Available: File opened only for output"); } eval ' $gz->write({})' ; like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference"); eval ' $gz->syswrite("abc", 1, 5)' ; like $@, mkEvalErr("^${CompressClass}::write: offset outside string"); eval ' $gz->syswrite("abc", 1, -4)' ; like $@, mkEvalErr("^${CompressClass}::write: offset outside string"), "write outside string"; } { title "Testing $UncompressClass Errors"; my $out = "" ; my $lex = new LexFile my $name ; ok ! -e $name, " $name does not exist"; $a = new $UncompressClass "$name" ; is $a, undef; my $gc ; my $guz = new $CompressClass(\$gc); $guz->write("abc") ; $guz->close(); my $x ; my $gz = new $UncompressClass(\$gc); foreach my $name (qw(print printf write)) { eval " \$gz->$name() " ; like $@, mkEvalErr("^$name Not Available: File opened only for intput"); } } { title "Testing $CompressClass and $UncompressClass"; { my ($a, $x, @x) = ("","","") ; # Buffer not a scalar reference eval qq[\$a = new $CompressClass \\\@x ;] ; like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref"); # Buffer not a scalar reference eval qq[\$a = new $UncompressClass \\\@x ;] ; like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref"); } foreach my $Type ( $CompressClass, $UncompressClass) { # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate my ($a, $x, @x) = ("","","") ; # Odd number of parameters eval qq[\$a = new $Type "abc", -Output ] ; like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1"); # Unknown parameter eval qq[\$a = new $Type "anc", -Fred => 123 ;] ; like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred"); # no in or out param eval qq[\$a = new $Type ;] ; like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter"); } { # write a very simple compressed file # and read back #======================================== my $lex = new LexFile my $name ; my $hello = <autoflush(1), 0, "autoflush"; is $x->autoflush(1), 1, "autoflush"; ok $x->opened(), "opened"; ok $x->write($hello), "write" ; ok $x->flush(), "flush"; ok $x->close, "close" ; ok ! $x->opened(), "! opened"; } { my $uncomp; ok my $x = new $UncompressClass $name, -Append => 1 ; ok $x->opened(), "opened"; my $len ; 1 while ($len = $x->read($uncomp)) > 0 ; is $len, 0, "read returned 0" or diag $$UnError ; ok $x->close ; is $uncomp, $hello ; ok !$x->opened(), "! opened"; } } { # write a very simple compressed file # and read back #======================================== my $lex = new LexFile my $name ; my $hello = <write(''), 0, "Write empty string is ok"; is $x->write(undef), 0, "Write undef is ok"; ok $x->write($hello), "Write ok" ; ok $x->close, "Close ok" ; } { my $uncomp; my $x = new $UncompressClass $name ; ok $x, "creates $UncompressClass $name" ; my $data = ''; $data .= $uncomp while $x->read($uncomp) > 0 ; ok $x->close, "close ok" ; is $data, $hello, "expected output" ; } } { # write a very simple file with using an IO filehandle # and read back #======================================== my $lex = new LexFile my $name ; my $hello = <$name" ; ok $fh, "opened file $name ok"; my $x = new $CompressClass $fh ; ok $x, " created $CompressClass $fh" ; is $x->fileno(), fileno($fh), "fileno match" ; is $x->write(''), 0, "Write empty string is ok"; is $x->write(undef), 0, "Write undef is ok"; ok $x->write($hello), "write ok" ; ok $x->flush(), "flush"; ok $x->close,"close" ; $fh->close() ; } my $uncomp; { my $x ; ok my $fh1 = new IO::File "<$name" ; ok $x = new $UncompressClass $fh1, -Append => 1 ; ok $x->fileno() == fileno $fh1 ; 1 while $x->read($uncomp) > 0 ; ok $x->close ; } ok $hello eq $uncomp ; } { # write a very simple file with using a glob filehandle # and read back #======================================== my $lex = new LexFile my $name ; #my $name = "/tmp/fred"; my $hello = <$name" ; my $x = new $CompressClass *FH ; ok $x, " create $CompressClass" ; is $x->fileno(), fileno(*FH), " fileno" ; is $x->write(''), 0, " Write empty string is ok"; is $x->write(undef), 0, " Write undef is ok"; ok $x->write($hello), " Write ok" ; ok $x->flush(), " Flush"; ok $x->close, " Close" ; close FH; } my $uncomp; { title "$UncompressClass: Input from typeglob filehandle, append output"; my $x ; ok open FH, "<$name" ; ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0 or diag $$UnError ; is $x->fileno(), fileno FH, " fileno ok" ; 1 while $x->read($uncomp) > 0 ; ok $x->close, " close" ; close FH; } is $uncomp, $hello, " expected output" ; } { my $lex = new LexFile my $name ; #my $name = "/tmp/fred"; my $hello = <&STDOUT"); my $dummy = fileno SAVEOUT; open STDOUT, ">$name" ; my $x = new $CompressClass '-' ; $x->write($hello); $x->close; open(STDOUT, ">&SAVEOUT"); ok 1, " wrote to stdout" ; } is myGZreadFile($name), $hello, " wrote OK"; #hexDump($name); { title "Input from stdin via filename '-'"; my $x ; my $uncomp ; my $stdinFileno = fileno(STDIN); # open below doesn't return 1 sometimes on XP open(SAVEIN, "<&STDIN"); ok open(STDIN, "<$name"), " redirect STDIN"; my $dummy = fileno SAVEIN; $x = new $UncompressClass '-', Append => 1, Transparent => 0 or diag $$UnError ; ok $x, " created object" ; is $x->fileno(), $stdinFileno, " fileno ok" ; 1 while $x->read($uncomp) > 0 ; ok $x->close, " close" ; open(STDIN, "<&SAVEIN"); is $uncomp, $hello, " expected output" ; } } { # write a compressed file to memory # and read back #======================================== #my $name = "test.gz" ; my $lex = new LexFile my $name ; my $hello = <autoflush(1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->fileno() ; is $x->write(''), 0, "Write empty string is ok"; is $x->write(undef), 0, "Write undef is ok"; ok $x->write($hello) ; ok $x->flush(); ok $x->close ; writeFile($name, $buffer) ; #is anyUncompress(\$buffer), $hello, " any ok"; } my $keep = $buffer ; my $uncomp; { my $x ; ok $x = new $UncompressClass(\$buffer, Append => 1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->fileno() ; 1 while $x->read($uncomp) > 0 ; ok $x->close, "closed" ; } is $uncomp, $hello, "got expected uncompressed data" ; ok $buffer eq $keep, "compressed input not changed" ; } if ($CompressClass ne 'RawDeflate') { # write empty file #======================================== my $buffer = ''; { my $x ; $x = new $CompressClass(\$buffer); ok $x, "new $CompressClass" ; ok $x->close, "close ok" ; } my $keep = $buffer ; my $uncomp= ''; { my $x ; ok $x = new $UncompressClass(\$buffer, Append => 1) ; 1 while $x->read($uncomp) > 0 ; ok $x->close ; } ok $uncomp eq '' ; ok $buffer eq $keep ; } { # write a larger file #======================================== my $lex = new LexFile my $name ; my $hello = <write($hello), " write ok" ; $input .= $hello ; ok $x->write("another line"), " write ok" ; $input .= "another line" ; # all characters foreach (0 .. 255) { $contents .= chr int $_ } # generate a long random string foreach (1 .. 5000) { $contents .= chr int rand 256 } ok $x->write($contents), " write ok" ; $input .= $contents ; ok $x->close, " close ok" ; } ok myGZreadFile($name) eq $input ; my $x = readFile($name) ; #print "length " . length($x) . " \n"; } SKIP: { # embed a compressed file in another file #================================ skip "zstd doesn't support trailing data", 11 if $CompressClass =~ /zstd/i ; my $lex = new LexFile my $name ; my $hello = <$name" ; print $fh $header ; my $x ; ok $x = new $CompressClass $fh, -AutoClose => 0 ; ok $x->binmode(); ok $x->write($hello) ; ok $x->close ; print $fh $trailer ; $fh->close() ; } my ($fil, $uncomp) ; my $fh1 ; ok $fh1 = new IO::File "<$name" ; # skip leading junk my $line = <$fh1> ; ok $line eq $header ; ok my $x = new $UncompressClass $fh1, Append => 1 ; ok $x->binmode(); 1 while $x->read($uncomp) > 0 ; is $uncomp, $hello ; my $rest ; read($fh1, $rest, 5000); is $x->trailingData() . $rest, $trailer ; #print "# [".$x->trailingData() . "][$rest]\n" ; } SKIP: { # embed a compressed file in another buffer #================================ skip "zstd doesn't support trailing data", 6 if $CompressClass =~ /zstd/i ; my $hello = <write($hello) ; ok $x->close ; $compressed .= $trailer ; } my $uncomp; ok my $x = new $UncompressClass(\$compressed, Append => 1) ; 1 while $x->read($uncomp) > 0 ; ok $uncomp eq $hello ; is $x->trailingData(), $trailer ; } { # Write # these tests come almost 100% from IO::String my $lex = new LexFile my $name ; my $io = $CompressClass->new($name); is $io->tell(), 0, " tell returns 0"; ; my $heisan = "Heisan\n"; $io->print($heisan) ; ok ! $io->eof(), " ! eof"; is $io->tell(), length($heisan), " tell is " . length($heisan) ; $io->print("a", "b", "c"); { local($\) = "\n"; $io->print("d", "e"); local($,) = ","; $io->print("f", "g", "h"); } { local($\) ; $io->print("D", "E"); local($,) = "."; $io->print("F", "G", "H"); } my $foo = "1234567890"; is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" } else { is $io->syswrite($foo), length $foo, " syswrite ok" } is $io->syswrite($foo, length($foo)), length $foo, " syswrite ok"; is $io->write($foo, length($foo), 5), 5, " write 5"; is $io->write("xxx\n", 100, -1), 1, " write 1"; for (1..3) { $io->printf("i(%d)", $_); $io->printf("[%d]\n", $_); } $io->print("\n"); $io->close ; ok $io->eof(), " eof"; is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" . ("1234567890" x 3) . "67890\n" . "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n", "myGZreadFile ok"; } { # Read my $str = <input_line_number, undef; $iow->print($str) ; is $iow->input_line_number, undef; $iow->close ; my @tmp; my $buf; { my $io = new $UncompressClass $name ; is $., 0; is $io->input_line_number, 0; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell 0" ; #my @lines = <$io>; my @lines = $io->getlines(); is @lines, 6 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; is $., 6; is $io->input_line_number, 6; is $io->tell(), length($str) ; ok $io->eof; ok ! ( defined($io->getline) || (@tmp = $io->getlines) || defined($io->getline) || defined($io->getc) || $io->read($buf, 100) != 0) ; } { local $/; # slurp mode my $io = $UncompressClass->new($name); is $., 0, "line 0"; is $io->input_line_number, 0; ok ! $io->eof, "eof"; my @lines = $io->getlines; is $., 1, "line 1"; is $io->input_line_number, 1, "line number 1"; ok $io->eof, "eof" ; ok @lines == 1 && $lines[0] eq $str; $io = $UncompressClass->new($name); ok ! $io->eof; my $line = $io->getline(); ok $line eq $str; ok $io->eof; } { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); is $., 0; is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); is $., 2; is $io->input_line_number, 2; ok $io->eof; ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } { # Record mode my $reclen = 7 ; my $expected_records = int(length($str) / $reclen) + (length($str) % $reclen ? 1 : 0); local $/ = \$reclen; my $io = $UncompressClass->new($name); is $., 0; is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); is $., $expected_records; is $io->input_line_number, $expected_records; ok $io->eof; is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; ok $lines[1] eq substr($str, $reclen, $reclen); } { local $/ = "is"; my $io = $UncompressClass->new($name); my @lines = (); my $no = 0; my $err = 0; ok ! $io->eof; while (my $a = $io->getline()) { push(@lines, $a); $err++ if $. != ++$no; } ok $err == 0 ; ok $io->eof; is $., 3; is $io->input_line_number, 3; ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } # Test read { my $io = $UncompressClass->new($name); eval { $io->read(1) } ; like $@, mkErr("buffer parameter is read-only"); $buf = "abcd"; is $io->read($buf, 0), 0, "Requested 0 bytes" ; is $buf, "", "Buffer empty"; is $io->read($buf, 3), 3 ; is $buf, "Thi"; is $io->sysread($buf, 3, 2), 3 ; is $buf, "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; # read the rest of the file $buf = ''; my $remain = length($str) - 9; is $io->read($buf, $remain+1), $remain ; is $buf, substr($str, 9); ok $io->eof; $buf = "hello"; is $io->read($buf, 10), 0 ; is $buf, "", "Buffer empty"; ok $io->eof; ok $io->close(); $buf = "hello"; is $io->read($buf, 10), 0 ; is $buf, "hello", "Buffer not empty"; ok $io->eof; # $io->seek(-4, 2); # # ok ! $io->eof; # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; # # ok ! $io->eof; } } { # Read from non-compressed file my $str = < 1 ; isa_ok $io, $UncompressClass ; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell == 0" ; my @lines = $io->getlines(); is @lines, 6, "got 6 lines"; ok $lines[1] eq "of a paragraph\n" ; ok join('', @lines) eq $str ; is $., 6; is $io->input_line_number, 6; ok $io->tell() == length($str) ; ok $io->eof; ok ! ( defined($io->getline) || (@tmp = $io->getlines) || defined($io->getline) || defined($io->getc) || $io->read($buf, 100) != 0) ; } { local $/; # slurp mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; is $., 1; is $io->input_line_number, 1; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; $io = $UncompressClass->new($name); ok ! $io->eof; my $line = $io->getline; is $., 1; is $io->input_line_number, 1; is $line, $str; ok $io->eof; } { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; is $., 2; is $io->input_line_number, 2; ok $io->eof; ok @lines == 2 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# [$lines[0]]\n" ; ok $lines[1] eq "and a single line.\n\n"; } { # Record mode my $reclen = 7 ; my $expected_records = int(length($str) / $reclen) + (length($str) % $reclen ? 1 : 0); local $/ = \$reclen; my $io = $UncompressClass->new($name); is $., 0; is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); is $., $expected_records; is $io->input_line_number, $expected_records; ok $io->eof; is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; ok $lines[1] eq substr($str, $reclen, $reclen); } { local $/ = "is"; my $io = $UncompressClass->new($name); my @lines = (); my $no = 0; my $err = 0; ok ! $io->eof; while (my $a = $io->getline) { push(@lines, $a); $err++ if $. != ++$no; } is $., 3; is $io->input_line_number, 3; ok $err == 0 ; ok $io->eof; ok @lines == 3 ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } # Test Read { my $io = $UncompressClass->new($name); $buf = "abcd"; is $io->read($buf, 0), 0, "Requested 0 bytes" ; is $buf, "", "Buffer empty"; ok $io->read($buf, 3) == 3 ; ok $buf eq "Thi"; ok $io->sysread($buf, 3, 2) == 3 ; ok $buf eq "Ths i"; ok ! $io->eof; $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; # read the rest of the file $buf = ''; my $remain = length($str) - 9; is $io->read($buf, $remain), $remain ; is $buf, substr($str, 9); ok $io->eof; $buf = "hello"; is $io->read($buf, 10), 0 ; is $buf, "", "Buffer empty"; ok $io->eof; ok $io->close(); $buf = "hello"; is $io->read($buf, 10), 0 ; is $buf, "hello", "Buffer not empty"; ok $io->eof; # $io->seek(-4, 2); # # ok ! $io->eof; # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; # # ok ! $io->eof; } } { # Vary the length parameter in a read my $str = <print($str) ; $iow->close ; } my $io = $UncompressClass->new($name, -Append => $append, -Transparent => $trans); my $buf; is $io->tell(), 0; if ($append) { 1 while $io->read($buf, $bufsize) > 0; } else { my $tmp ; $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ; } is length $buf, length $str; ok $buf eq $str ; ok ! $io->error() ; ok $io->eof; } } } } foreach my $file (0, 1) { foreach my $trans (0, 1) { title "seek tests - file $file trans $trans" ; my $buffer ; my $buff ; my $lex = new LexFile my $name ; my $first = "beginning" ; my $last = "the end" ; if ($trans) { $buffer = $first . "\x00" x 10 . $last; writeFile($name, $buffer); } else { my $output ; if ($file) { $output = $name ; } else { $output = \$buffer; } my $iow = new $CompressClass $output ; $iow->print($first) ; ok $iow->seek(5, SEEK_CUR) ; ok $iow->tell() == length($first)+5; ok $iow->seek(0, SEEK_CUR) ; ok $iow->tell() == length($first)+5; ok $iow->seek(length($first)+10, SEEK_SET) ; ok $iow->tell() == length($first)+10; $iow->print($last) ; $iow->close ; } my $input ; if ($file) { $input = $name ; } else { $input = \$buffer ; } ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ; my $io = $UncompressClass->new($input, Strict => 1); ok $io->seek(length($first), SEEK_CUR) or diag $$UnError ; ok ! $io->eof; is $io->tell(), length($first); ok $io->read($buff, 5) ; is $buff, "\x00" x 5 ; is $io->tell(), length($first) + 5; ok $io->seek(0, SEEK_CUR) ; my $here = $io->tell() ; is $here, length($first)+5; ok $io->seek($here+5, SEEK_SET) ; is $io->tell(), $here+5 ; ok $io->read($buff, 100) ; ok $buff eq $last ; ok $io->eof; } } { title "seek error cases" ; my $b ; my $a = new $CompressClass(\$b) ; ok ! $a->error() or die $a->error() ; eval { $a->seek(-1, 10) ; }; like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter"); eval { $a->seek(-1, SEEK_END) ; }; like $@, mkErr("^${CompressClass}::seek: cannot seek backwards"); $a->write("fred"); $a->close ; my $u = new $UncompressClass(\$b) ; eval { $u->seek(-1, 10) ; }; like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter"); eval { $u->seek(-1, SEEK_END) ; }; like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed"); eval { $u->seek(-1, SEEK_CUR) ; }; like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards"); } foreach my $fb (qw(filename buffer filehandle)) { foreach my $append (0, 1) { { title "$CompressClass -- Append $append, Output to $fb" ; my $lex = new LexFile my $name ; my $already = 'already'; my $buffer = $already; my $output; if ($fb eq 'buffer') { $output = \$buffer } elsif ($fb eq 'filename') { $output = $name ; writeFile($name, $buffer); } elsif ($fb eq 'filehandle') { $output = new IO::File ">$name" ; print $output $buffer; } my $a = new $CompressClass($output, Append => $append) ; ok $a, " Created $CompressClass"; my $string = "appended"; $a->write($string); $a->close ; my $data ; if ($fb eq 'buffer') { $data = $buffer; } else { $output->close if $fb eq 'filehandle'; $data = readFile($name); } if ($append || $fb eq 'filehandle') { is substr($data, 0, length($already)), $already, " got prefix"; substr($data, 0, length($already)) = ''; } my $uncomp; my $x = new $UncompressClass(\$data, Append => 1) ; ok $x, " created $UncompressClass"; my $len ; 1 while ($len = $x->read($uncomp)) > 0 ; $x->close ; is $uncomp, $string, ' Got uncompressed data' ; } } } foreach my $type (qw(buffer filename filehandle)) { foreach my $good (0, 1) { title "$UncompressClass -- InputLength, read from $type, good data => $good"; my $compressed ; my $string = "some data"; my $appended = "append"; if ($good) { my $c = new $CompressClass(\$compressed); $c->write($string); $c->close(); } else { $compressed = $string ; } my $comp_len = length $compressed; $compressed .= $appended; my $lex = new LexFile my $name ; my $input ; writeFile ($name, $compressed); if ($type eq 'buffer') { $input = \$compressed; } if ($type eq 'filename') { $input = $name; } elsif ($type eq 'filehandle') { my $fh = new IO::File "<$name" ; ok $fh, "opened file $name ok"; $input = $fh ; } my $x = new $UncompressClass($input, InputLength => $comp_len, Transparent => 1) ; ok $x, " created $UncompressClass"; my $len ; my $output; $len = $x->read($output, 100); is $len, length($string); is $output, $string; if ($type eq 'filehandle') { my $rest ; $input->read($rest, 1000); is $rest, $appended; } } } foreach my $append (0, 1) { title "$UncompressClass -- Append $append" ; my $lex = new LexFile my $name ; my $string = "appended"; my $compressed ; my $c = new $CompressClass(\$compressed); $c->write($string); $c->close(); my $x = new $UncompressClass(\$compressed, Append => $append) ; ok $x, " created $UncompressClass"; my $already = 'already'; my $output = $already; my $len ; $len = $x->read($output, 100); is $len, length($string); $x->close ; if ($append) { is substr($output, 0, length($already)), $already, " got prefix"; substr($output, 0, length($already)) = ''; } is $output, $string, ' Got uncompressed data' ; } foreach my $file (0, 1) { foreach my $trans (0, 1) { title "ungetc, File $file, Transparent $trans" ; my $lex = new LexFile my $name ; my $string = 'abcdeABCDE'; my $b ; if ($trans) { $b = $string ; } else { my $a = new $CompressClass(\$b) ; $a->write($string); $a->close ; } my $from ; if ($file) { writeFile($name, $b); $from = $name ; } else { $from = \$b ; } my $u = $UncompressClass->new($from, Transparent => 1) ; my $first; my $buff ; # do an ungetc before reading $u->ungetc("X"); $first = $u->getc(); is $first, 'X'; $first = $u->getc(); is $first, substr($string, 0,1); $u->ungetc($first); $first = $u->getc(); is $first, substr($string, 0,1); $u->ungetc($first); is $u->read($buff, 5), 5 ; is $buff, substr($string, 0, 5); $u->ungetc($buff) ; is $u->read($buff, length($string)), length($string) ; is $buff, $string; is $u->read($buff, 1), 0; ok $u->eof() ; my $extra = 'extra'; $u->ungetc($extra); ok ! $u->eof(); is $u->read($buff), length($extra) ; is $buff, $extra; is $u->read($buff, 1), 0; ok $u->eof() ; # getc returns undef on eof is $u->getc(), undef; $u->close(); } } { title "write tests - invalid data" ; #my $lex = new LexFile my $name1 ; my($Answer); #ok ! -e $name1, " File $name1 does not exist"; my @data = ( [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], #[ "not readable", 'xx' ], # same filehandle twice, 'xx' ) ; foreach my $data (@data) { my ($send, $get) = @$data ; title "${CompressClass}::write( $send )"; my($copy); eval "\$copy = $send"; my $x = new $CompressClass(\$Answer); ok $x, " Created $CompressClass object"; eval { $x->write($copy) } ; #like $@, "/^$get/", " error - $get"; like $@, "/not a scalar reference /", " error - not a scalar reference"; } # @data = ( # [ '[ $name1 ]', "input file '$name1' does not exist" ], # #[ "not readable", 'xx' ], # # same filehandle twice, 'xx' # ) ; # # foreach my $data (@data) # { # my ($send, $get) = @$data ; # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; # my $x = new $CompressClass(\$Answer); # ok $x, " Created $CompressClass object"; # ok ! $x->write($copy), " write fails" ; # like $$Error, "/^$get/", " error - $get"; # } #exit; } # sub deepCopy # { # if (! ref $_[0] || ref $_[0] eq 'SCALAR') # { # return $_[0] ; # } # # if (ref $_[0] eq 'ARRAY') # { # my @a ; # for my $x ( @{ $_[0] }) # { # push @a, deepCopy($x); # } # # return \@a ; # } # # croak "bad! $_[0]"; # # } # # sub deepSubst # { # #my $data = shift ; # my $from = $_[1] ; # my $to = $_[2] ; # # if (! ref $_[0]) # { # $_[0] = $to # if $_[0] eq $from ; # return ; # # } # # if (ref $_[0] eq 'SCALAR') # { # $_[0] = \$to # if defined ${ $_[0] } && ${ $_[0] } eq $from ; # return ; # # } # # if (ref $_[0] eq 'ARRAY') # { # for my $x ( @{ $_[0] }) # { # deepSubst($x, $from, $to); # } # return ; # } # #croak "bad! $_[0]"; # } # { # title "More write tests" ; # # my $file1 = "file1" ; # my $file2 = "file2" ; # my $file3 = "file3" ; # my $lex = new LexFile $file1, $file2, $file3 ; # # writeFile($file1, "F1"); # writeFile($file2, "F2"); # writeFile($file3, "F3"); # # my @data = ( # [ '""', "" ], # [ 'undef', "" ], # [ '"abcd"', "abcd" ], # # [ '\""', "" ], # [ '\undef', "" ], # [ '\"abcd"', "abcd" ], # # [ '[]', "" ], # [ '[[]]', "" ], # [ '[[[]]]', "" ], # [ '[\""]', "" ], # [ '[\undef]', "" ], # [ '[\"abcd"]', "abcd" ], # [ '[\"ab", \"cd"]', "abcd" ], # [ '[[\"ab"], [\"cd"]]', "abcd" ], # # [ '$file1', $file1 ], # [ '$fh2', "F2" ], # [ '[$file1, \"abc"]', "F1abc"], # [ '[\"a", $file1, \"bc"]', "aF1bc"], # [ '[\"a", $fh1, \"bc"]', "aF1bc"], # [ '[\"a", $fh1, \"bc", $file2]', "aF1bcF2"], # [ '[\"a", $fh1, \"bc", $file2, $fh3]', "aF1bcF2F3"], # ) ; # # # foreach my $data (@data) # { # my ($send, $get) = @$data ; # # my $fh1 = new IO::File "< $file1" ; # my $fh2 = new IO::File "< $file2" ; # my $fh3 = new IO::File "< $file3" ; # # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; # my $Answer ; # my $x = new $CompressClass(\$Answer); # ok $x, " Created $CompressClass object"; # my $len = length $get; # is $x->write($copy), length($get), " write $len bytes"; # ok $x->close(), " close ok" ; # # is myGZreadFile(\$Answer), $get, " got expected output" ; # cmp_ok $$Error, '==', 0, " no error"; # # # } # # } } { # Check can handle empty compressed files # Test is for rt.cpan #67554 foreach my $type (qw(filename filehandle buffer )) { foreach my $append (0, 1) { title "$UncompressClass -- empty file read from $type, Append => $append"; my $appended = "append"; my $string = "some data"; my $compressed ; my $c = new $CompressClass(\$compressed); $c->close(); my $comp_len = length $compressed; $compressed .= $appended if $append && $CompressClass !~ /zstd/i; my $lex = new LexFile my $name ; my $input ; writeFile ($name, $compressed); if ($type eq 'buffer') { $input = \$compressed; } elsif ($type eq 'filename') { $input = $name; } elsif ($type eq 'filehandle') { my $fh = new IO::File "<$name" ; ok $fh, "opened file $name ok"; $input = $fh ; } { # Check that eof is true immediately after creating the # uncompression object. # Check that readline returns undef my $x = new $UncompressClass $input, Transparent => 0 or diag "$$UnError" ; isa_ok $x, $UncompressClass; # should be EOF immediately is $x->eof(), 1, "eof true"; is <$x>, undef, "getline is undef"; is $x->eof(), 1, "eof true"; } { # Check that read returns an empty string if ($type eq 'filehandle') { my $fh = new IO::File "<$name" ; ok $fh, "opened file $name ok"; $input = $fh ; } my $x = new $UncompressClass $input, Transparent => 0 or diag "$$UnError" ; isa_ok $x, $UncompressClass; my $buffer; is $x->read($buffer), 0, "read 0 bytes" or diag "read returned $$UnError"; ok defined $buffer, "buffer is defined"; is $buffer, "", "buffer is empty string"; is $x->eof(), 1, "eof true"; } { # Check that read return an empty string in Append Mode # to empty string if ($type eq 'filehandle') { my $fh = new IO::File "<$name" ; ok $fh, "opened file $name ok"; $input = $fh ; } my $x = new $UncompressClass $input, Transparent => 0, Append => 1 or diag "$$UnError" ; isa_ok $x, $UncompressClass; my $buffer; is $x->read($buffer), 0, "read 0 bytes"; ok defined $buffer, "buffer is defined"; is $buffer, "", "buffer is empty string"; is $x->eof(), 1, "eof true"; } { # Check that read return an empty string in Append Mode # to non-empty string if ($type eq 'filehandle') { my $fh = new IO::File "<$name" ; ok $fh, "opened file $name ok"; $input = $fh ; } my $x = new $UncompressClass($input, Append => 1 ); isa_ok $x, $UncompressClass; my $buffer = "123"; is $x->read($buffer), 0, "read 0 bytes"; ok defined $buffer, "buffer is defined"; is $buffer, "123", "buffer orig string"; is $x->eof(), 1, "eof true"; } } } } { # Round trip binary data that happens to contain \r\n # via the filesystem my $original = join '', map { chr } 0x00 .. 0xff ; $original .= "data1\r\ndata2\r\ndata3\r\n" ; title "$UncompressClass -- round trip test"; my $string = $original; my $lex = new LexFile( my $name, my $compressed) ; my $input ; writeFile ($name, $original); my $c = new $CompressClass($compressed); isa_ok $c, $CompressClass; $c->print($string); $c->close(); my $u = new $UncompressClass $compressed, Transparent => 0 or diag "$$UnError" ; isa_ok $u, $UncompressClass; my $buffer; is $u->read($buffer), length($original), "read bytes"; is $buffer, $original, " round tripped ok"; } } 1;