generic.pl

source of perl for linux application,

              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 ;
            }

            is $uncomp, $hello ;
            ok $buffer eq $keep ;
        }

        if ($CompressClass ne 'RawDeflate')
        {
            # write empty file
            #========================================

            my $buffer = '';
            {
              my $x ;
              ok $x = new $CompressClass(\$buffer) ;
              ok $x->close ;
          
            }

            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" ;
            #exit;

        }

        {
            # 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; 
                is $io->input_line_number, 0; 
                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();
                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;