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 => 794 + $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 = <<EOM ;
hello world
this is a test
EOM
{
my $x ;
ok $x = new $CompressClass $name ;
is $x->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 = <<EOM ;
hello world
this is a test
EOM
{
my $x ;
ok $x = new $CompressClass $name ;
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->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 = <<EOM ;
hello world
this is a test
EOM
{
my $fh = new IO::File ">$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 = <<EOM ;
hello world
this is a test
EOM
{
title "$CompressClass: Input from typeglob filehandle";
ok open FH, ">$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 = <<EOM ;
hello world
this is a test
EOM
{
title "Outout to stdout via '-'" ;
open(SAVEOUT, ">&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 = <<EOM ;
hello world
this is a test
EOM
my $buffer ;
{
my $x ;
ok $x = new $CompressClass(\$buffer) ;
ok ! defined $x->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 = <<EOM ;
hello world
this is a test
EOM
my $input = '' ;
my $contents = '' ;
{
my $x = new $CompressClass $name ;
ok $x, " created $CompressClass object";
ok $x->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";
}
{
# embed a compressed file in another file
#================================
my $lex = new LexFile my $name ;
my $hello = <<EOM ;
hello world
this is a test
EOM
my $header = "header info\n" ;
my $trailer = "trailer data\n" ;
{
my $fh ;
ok $fh = new IO::File ">$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 ;
ok $uncomp eq $hello ;
my $rest ;
read($fh1, $rest, 5000);
is $x->trailingData() . $rest, $trailer ;
#print "# [".$x->trailingData() . "][$rest]\n" ;
}
{
# embed a compressed file in another buffer
#================================
my $hello = <<EOM ;
hello world
this is a test
EOM
my $trailer = "trailer data" ;
my $compressed ;
{
ok my $x = new $CompressClass(\$compressed);
ok $x->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 = <<EOT;
This is an example
of a paragraph
and a single line.
EOT
my $lex = new LexFile my $name ;
my %opts = () ;
my $iow = new $CompressClass $name, %opts;
is $iow->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 = <<EOT;
This is an example
of a paragraph
and a single line.
EOT
my $lex = new LexFile my $name ;
writeFile($name, $str);
my @tmp;
my $buf;
{
my $io = new $UncompressClass $name, -Transparent => 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 = <<EOT;
x
x
This is an example
of a paragraph
and a single line.
EOT
$str = $str x 100 ;
foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
{
foreach my $trans (0, 1)
{
foreach my $append (0, 1)
{
title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
my $lex = new LexFile my $name ;
if ($trans) {
writeFile($name, $str) ;
}
else {
my $iow = new $CompressClass $name;
$iow->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() ;
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 ;
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 return 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";
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";
}
}
}
}
}
1;