cpan/IO-Compress/t/compress/generic.pl

   1
   2 use strict;
   3 use warnings;
   4 use bytes;
   5
   6 use Test::More ;
   7 use CompTestUtils;
   8
   9 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
  10
  11 our ($UncompressClass);
  12 BEGIN
  13 {
  14     # use Test::NoWarnings, if available
  15     my $extra = 0 ;
  16
  17     my $st = eval { require Test::NoWarnings ;  import Test::NoWarnings; 1; };
  18     $extra = 1
  19         if $st ;
  20
  21     plan(tests => 666 + $extra) ;
  22 }
  23
  24 sub myGZreadFile
  25 {
  26     my $filename = shift ;
  27     my $init = shift ;
  28
  29
  30     my $fil = new $UncompressClass $filename,
  31                                     -Strict   => 0,
  32                                     -Append   => 1
  33                                     ;
  34
  35     my $data = '';
  36     $data = $init if defined $init ;
  37     1 while $fil->read($data) > 0;
  38
  39     $fil->close ;
  40     return $data ;
  41 }
  42
  43 sub run
  44 {
  45     my $CompressClass   = identify();
  46     $UncompressClass = getInverse($CompressClass);
  47     my $Error           = getErrorRef($CompressClass);
  48     my $UnError         = getErrorRef($UncompressClass);
  49
  50     if(1)
  51     {
  52
  53         title "Testing $CompressClass Errors";
  54
  55         # Buffer not writable
  56         eval qq[\$a = new $CompressClass(\\1) ;] ;
  57         like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ;
  58
  59         my($out, $gz);
  60
  61         my $x ;
  62         $gz = new $CompressClass(\$x);
  63
  64         foreach my $name (qw(read readline getc))
  65         {
  66             eval " \$gz->$name() " ;
  67             like $@, mkEvalErr("^$name Not Available: File opened only for output");
  68         }
  69
  70         eval ' $gz->write({})' ;
  71         like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference");
  72
  73         eval ' $gz->syswrite("abc", 1, 5)' ;
  74         like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
  75
  76         eval ' $gz->syswrite("abc", 1, -4)' ;
  77         like $@, mkEvalErr("^${CompressClass}::write: offset outside string"), "write outside string";
  78     }
  79
  80
  81     {
  82         title "Testing $UncompressClass Errors";
  83
  84         my $out = "" ;
  85
  86         my $lex = new LexFile my $name ;
  87
  88         ok ! -e $name, "  $name does not exist";
  89
  90         $a = new $UncompressClass "$name" ;
  91         is $a, undef;
  92
  93         my $gc ;
  94         my $guz = new $CompressClass(\$gc);
  95         $guz->write("abc") ;
  96         $guz->close();
  97
  98         my $x ;
  99         my $gz = new $UncompressClass(\$gc);
 100
 101         foreach my $name (qw(print printf write))
 102         {
 103             eval " \$gz->$name() " ;
 104             like $@, mkEvalErr("^$name Not Available: File opened only for intput");
 105         }
 106
 107     }
 108
 109
 110     {
 111         title "Testing $CompressClass and $UncompressClass";
 112
 113         {
 114             my ($a, $x, @x) = ("","","") ;
 115
 116             # Buffer not a scalar reference
 117             eval qq[\$a = new $CompressClass \\\@x ;] ;
 118             like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref");
 119
 120             # Buffer not a scalar reference
 121             eval qq[\$a = new $UncompressClass \\\@x ;] ;
 122             like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref");
 123         }
 124
 125         foreach my $Type ( $CompressClass, $UncompressClass)
 126         {
 127             # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate
 128
 129             my ($a, $x, @x) = ("","","") ;
 130
 131             # Odd number of parameters
 132             eval qq[\$a = new $Type "abc", -Output ] ;
 133             like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1");
 134
 135             # Unknown parameter
 136             eval qq[\$a = new $Type  "anc", -Fred => 123 ;] ;
 137             like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred");
 138
 139             # no in or out param
 140             eval qq[\$a = new $Type ;] ;
 141             like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter");
 142
 143         }
 144
 145
 146         {
 147             # write a very simple compressed file
 148             # and read back
 149             #========================================
 150
 151
 152             my $lex = new LexFile my $name ;
 153
 154             my $hello = <<EOM ;
 155 hello world
 156 this is a test
 157 EOM
 158
 159             {
 160               my $x ;
 161               ok $x = new $CompressClass $name  ;
 162               is $x->autoflush(1), 0, "autoflush";
 163               is $x->autoflush(1), 1, "autoflush";
 164               ok $x->opened(), "opened";
 165
 166               ok $x->write($hello), "write" ;
 167               ok $x->flush(), "flush";
 168               ok $x->close, "close" ;
 169               ok ! $x->opened(), "! opened";
 170             }
 171
 172             {
 173               my $uncomp;
 174               ok my $x = new $UncompressClass $name, -Append => 1  ;
 175               ok $x->opened(), "opened";
 176
 177               my $len ;
 178               1 while ($len = $x->read($uncomp)) > 0 ;
 179
 180               is $len, 0, "read returned 0"
 181                 or diag $$UnError ;
 182
 183               ok $x->close ;
 184               is $uncomp, $hello ;
 185               ok !$x->opened(), "! opened";
 186             }
 187         }
 188
 189         {
 190             # write a very simple compressed file
 191             # and read back
 192             #========================================
 193
 194
 195             my $lex = new LexFile my $name ;
 196
 197             my $hello = <<EOM ;
 198 hello world
 199 this is a test
 200 EOM
 201
 202             {
 203               my $x ;
 204               ok $x = new $CompressClass $name  ;
 205
 206               is $x->write(''), 0, "Write empty string is ok";
 207               is $x->write(undef), 0, "Write undef is ok";
 208               ok $x->write($hello), "Write ok" ;
 209               ok $x->close, "Close ok" ;
 210             }
 211
 212             {
 213               my $uncomp;
 214               my $x = new $UncompressClass $name  ;
 215               ok $x, "creates $UncompressClass $name"  ;
 216
 217               my $data = '';
 218               $data .= $uncomp while $x->read($uncomp) > 0 ;
 219
 220               ok $x->close, "close ok" ;
 221               is $data, $hello, "expected output" ;
 222             }
 223         }
 224
 225
 226         {
 227             # write a very simple file with using an IO filehandle
 228             # and read back
 229             #========================================
 230
 231
 232             my $lex = new LexFile my $name ;
 233
 234             my $hello = <<EOM ;
 235 hello world
 236 this is a test
 237 EOM
 238
 239             {
 240               my $fh = new IO::File ">$name" ;
 241               ok $fh, "opened file $name ok";
 242               my $x = new $CompressClass $fh  ;
 243               ok $x, " created $CompressClass $fh"  ;
 244
 245               is $x->fileno(), fileno($fh), "fileno match" ;
 246               is $x->write(''), 0, "Write empty string is ok";
 247               is $x->write(undef), 0, "Write undef is ok";
 248               ok $x->write($hello), "write ok" ;
 249               ok $x->flush(), "flush";
 250               ok $x->close,"close" ;
 251               $fh->close() ;
 252             }
 253
 254             my $uncomp;
 255             {
 256               my $x ;
 257               ok my $fh1 = new IO::File "<$name" ;
 258               ok $x = new $UncompressClass $fh1, -Append => 1  ;
 259               ok $x->fileno() == fileno $fh1 ;
 260
 261               1 while $x->read($uncomp) > 0 ;
 262
 263               ok $x->close ;
 264             }
 265
 266             ok $hello eq $uncomp ;
 267         }
 268
 269         {
 270             # write a very simple file with using a glob filehandle
 271             # and read back
 272             #========================================
 273
 274
 275             my $lex = new LexFile my $name ;
 276             #my $name  = "/tmp/fred";
 277
 278             my $hello = <<EOM ;
 279 hello world
 280 this is a test
 281 EOM
 282
 283             {
 284               title "$CompressClass: Input from typeglob filehandle";
 285               ok open FH, ">$name" ;
 286
 287               my $x = new $CompressClass *FH  ;
 288               ok $x, "  create $CompressClass"  ;
 289
 290               is $x->fileno(), fileno(*FH), "  fileno" ;
 291               is $x->write(''), 0, "  Write empty string is ok";
 292               is $x->write(undef), 0, "  Write undef is ok";
 293               ok $x->write($hello), "  Write ok" ;
 294               ok $x->flush(), "  Flush";
 295               ok $x->close, "  Close" ;
 296               close FH;
 297             }
 298
 299
 300             my $uncomp;
 301             {
 302               title "$UncompressClass: Input from typeglob filehandle, append output";
 303               my $x ;
 304               ok open FH, "<$name" ;
 305               ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0
 306                 or diag $$UnError ;
 307               is $x->fileno(), fileno FH, "  fileno ok" ;
 308
 309               1 while $x->read($uncomp) > 0 ;
 310
 311               ok $x->close, "  close" ;
 312             }
 313
 314             is $uncomp, $hello, "  expected output" ;
 315         }
 316
 317         {
 318             my $lex = new LexFile my $name ;
 319             #my $name = "/tmp/fred";
 320
 321             my $hello = <<EOM ;
 322 hello world
 323 this is a test
 324 EOM
 325
 326             {
 327               title "Outout to stdout via '-'" ;
 328
 329               open(SAVEOUT, ">&STDOUT");
 330               my $dummy = fileno SAVEOUT;
 331               open STDOUT, ">$name" ;
 332
 333               my $x = new $CompressClass '-'  ;
 334               $x->write($hello);
 335               $x->close;
 336
 337               open(STDOUT, ">&SAVEOUT");
 338
 339               ok 1, "  wrote to stdout" ;
 340             }
 341             is myGZreadFile($name), $hello, "  wrote OK";
 342             #hexDump($name);
 343
 344             {
 345               title "Input from stdin via filename '-'";
 346
 347               my $x ;
 348               my $uncomp ;
 349               my $stdinFileno = fileno(STDIN);
 350               # open below doesn't return 1 sometines on XP
 351                  open(SAVEIN, "<&STDIN");
 352               ok open(STDIN, "<$name"), "  redirect STDIN";
 353               my $dummy = fileno SAVEIN;
 354               $x = new $UncompressClass '-', Append => 1, Transparent => 0
 355                     or diag $$UnError ;
 356               ok $x, "  created object" ;
 357               is $x->fileno(), $stdinFileno, "  fileno ok" ;
 358
 359               1 while $x->read($uncomp) > 0 ;
 360
 361               ok $x->close, "  close" ;
 362                  open(STDIN, "<&SAVEIN");
 363               is $uncomp, $hello, "  expected output" ;
 364             }
 365         }
 366
 367         {
 368             # write a compressed file to memory
 369             # and read back
 370             #========================================
 371
 372             #my $name = "test.gz" ;
 373             my $lex = new LexFile my $name ;
 374
 375             my $hello = <<EOM ;
 376 hello world
 377 this is a test
 378 EOM
 379
 380             my $buffer ;
 381             {
 382               my $x ;
 383               ok $x = new $CompressClass(\$buffer) ;
 384
 385               ok ! defined $x->autoflush(1) ;
 386               ok ! defined $x->autoflush(1) ;
 387               ok ! defined $x->fileno() ;
 388               is $x->write(''), 0, "Write empty string is ok";
 389               is $x->write(undef), 0, "Write undef is ok";
 390               ok $x->write($hello) ;
 391               ok $x->flush();
 392               ok $x->close ;
 393
 394               writeFile($name, $buffer) ;
 395               #is anyUncompress(\$buffer), $hello, "  any ok";
 396             }
 397
 398             my $keep = $buffer ;
 399             my $uncomp;
 400             {
 401               my $x ;
 402               ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
 403
 404               ok ! defined $x->autoflush(1) ;
 405               ok ! defined $x->autoflush(1) ;
 406               ok ! defined $x->fileno() ;
 407               1 while $x->read($uncomp) > 0  ;
 408
 409               ok $x->close, "closed" ;
 410             }
 411
 412             is $uncomp, $hello, "got expected uncompressed data" ;
 413             ok $buffer eq $keep, "compressed input not changed" ;
 414         }
 415
 416         if ($CompressClass ne 'RawDeflate')
 417         {
 418             # write empty file
 419             #========================================
 420
 421             my $buffer = '';
 422             {
 423               my $x ;
 424               $x = new $CompressClass(\$buffer);
 425               ok $x, "new $CompressClass" ;
 426               ok $x->close, "close ok" ;
 427
 428             }
 429
 430             my $keep = $buffer ;
 431             my $uncomp= '';
 432             {
 433               my $x ;
 434               ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
 435
 436               1 while $x->read($uncomp) > 0  ;
 437
 438               ok $x->close ;
 439             }
 440
 441             ok $uncomp eq '' ;
 442             ok $buffer eq $keep ;
 443
 444         }
 445
 446         {
 447             # write a larger file
 448             #========================================
 449
 450
 451             my $lex = new LexFile my $name ;
 452
 453             my $hello = <<EOM ;
 454 hello world
 455 this is a test
 456 EOM
 457
 458             my $input    = '' ;
 459             my $contents = '' ;
 460
 461             {
 462               my $x = new $CompressClass $name  ;
 463               ok $x, "  created $CompressClass object";
 464
 465               ok $x->write($hello), "  write ok" ;
 466               $input .= $hello ;
 467               ok $x->write("another line"), "  write ok" ;
 468               $input .= "another line" ;
 469               # all characters
 470               foreach (0 .. 255)
 471                 { $contents .= chr int $_ }
 472               # generate a long random string
 473               foreach (1 .. 5000)
 474                 { $contents .= chr int rand 256 }
 475
 476               ok $x->write($contents), "  write ok" ;
 477               $input .= $contents ;
 478               ok $x->close, "  close ok" ;
 479             }
 480
 481             ok myGZreadFile($name) eq $input ;
 482             my $x =  readFile($name) ;
 483             #print "length " . length($x) . " \n";
 484         }
 485
 486         {
 487             # embed a compressed file in another file
 488             #================================
 489
 490
 491             my $lex = new LexFile my $name ;
 492
 493             my $hello = <<EOM ;
 494 hello world
 495 this is a test
 496 EOM
 497
 498             my $header = "header info\n" ;
 499             my $trailer = "trailer data\n" ;
 500
 501             {
 502               my $fh ;
 503               ok $fh = new IO::File ">$name" ;
 504               print $fh $header ;
 505               my $x ;
 506               ok $x = new $CompressClass $fh,
 507                                          -AutoClose => 0   ;
 508
 509               ok $x->binmode();
 510               ok $x->write($hello) ;
 511               ok $x->close ;
 512               print $fh $trailer ;
 513               $fh->close() ;
 514             }
 515
 516             my ($fil, $uncomp) ;
 517             my $fh1 ;
 518             ok $fh1 = new IO::File "<$name" ;
 519             # skip leading junk
 520             my $line = <$fh1> ;
 521             ok $line eq $header ;
 522
 523             ok my $x = new $UncompressClass $fh1, Append => 1  ;
 524             ok $x->binmode();
 525             1 while $x->read($uncomp) > 0 ;
 526
 527             ok $uncomp eq $hello ;
 528             my $rest ;
 529             read($fh1, $rest, 5000);
 530             is $x->trailingData() . $rest, $trailer ;
 531             #print "# [".$x->trailingData() . "][$rest]\n" ;
 532
 533         }
 534
 535         {
 536             # embed a compressed file in another buffer
 537             #================================
 538
 539
 540             my $hello = <<EOM ;
 541 hello world
 542 this is a test
 543 EOM
 544
 545             my $trailer = "trailer data" ;
 546
 547             my $compressed ;
 548
 549             {
 550               ok my $x = new $CompressClass(\$compressed);
 551
 552               ok $x->write($hello) ;
 553               ok $x->close ;
 554               $compressed .= $trailer ;
 555             }
 556
 557             my $uncomp;
 558             ok my $x = new $UncompressClass(\$compressed, Append => 1)  ;
 559             1 while $x->read($uncomp) > 0 ;
 560
 561             ok $uncomp eq $hello ;
 562             is $x->trailingData(), $trailer ;
 563
 564         }
 565
 566         {
 567             # Write
 568             # these tests come almost 100% from IO::String
 569
 570             my $lex = new LexFile my $name ;
 571
 572             my $io = $CompressClass->new($name);
 573
 574             is $io->tell(), 0, " tell returns 0"; ;
 575
 576             my $heisan = "Heisan\n";
 577             $io->print($heisan) ;
 578
 579             ok ! $io->eof(), "  ! eof";
 580
 581             is $io->tell(), length($heisan), "  tell is " . length($heisan) ;
 582
 583             $io->print("a", "b", "c");
 584
 585             {
 586                 local($\) = "\n";
 587                 $io->print("d", "e");
 588                 local($,) = ",";
 589                 $io->print("f", "g", "h");
 590             }
 591
 592             {
 593                 local($\) ;
 594                 $io->print("D", "E");
 595                 local($,) = ".";
 596                 $io->print("F", "G", "H");
 597             }
 598
 599             my $foo = "1234567890";
 600
 601             is $io->syswrite($foo, length($foo)), length($foo), "  syswrite ok" ;
 602             if ( $] < 5.6 )
 603               { is $io->syswrite($foo, length $foo), length $foo, "  syswrite ok" }
 604             else
 605               { is $io->syswrite($foo), length $foo, "  syswrite ok" }
 606             is $io->syswrite($foo, length($foo)), length $foo, "  syswrite ok";
 607             is $io->write($foo, length($foo), 5), 5,   " write 5";
 608             is $io->write("xxx\n", 100, -1), 1, "  write 1";
 609
 610             for (1..3) {
 611                 $io->printf("i(%d)", $_);
 612                 $io->printf("[%d]\n", $_);
 613             }
 614             $io->print("\n");
 615
 616             $io->close ;
 617
 618             ok $io->eof(), "  eof";
 619
 620             is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" .
 621                                     ("1234567890" x 3) . "67890\n" .
 622                                         "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n",
 623                                         "myGZreadFile ok";
 624
 625
 626         }
 627
 628         {
 629             # Read
 630             my $str = <<EOT;
 631 This is an example
 632 of a paragraph
 633
 634
 635 and a single line.
 636
 637 EOT
 638
 639             my $lex = new LexFile my $name ;
 640
 641             my %opts = () ;
 642             my $iow = new $CompressClass $name, %opts;
 643             is $iow->input_line_number, undef;
 644             $iow->print($str) ;
 645             is $iow->input_line_number, undef;
 646             $iow->close ;
 647
 648             my @tmp;
 649             my $buf;
 650             {
 651                 my $io = new $UncompressClass $name ;
 652
 653                 is $., 0;
 654                 is $io->input_line_number, 0;
 655                 ok ! $io->eof, "eof";
 656                 is $io->tell(), 0, "tell 0" ;
 657                 #my @lines = <$io>;
 658                 my @lines = $io->getlines();
 659                 is @lines, 6
 660                     or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
 661                 is $lines[1], "of a paragraph\n" ;
 662                 is join('', @lines), $str ;
 663                 is $., 6;
 664                 is $io->input_line_number, 6;
 665                 is $io->tell(), length($str) ;
 666
 667                 ok $io->eof;
 668
 669                 ok ! ( defined($io->getline)  ||
 670                           (@tmp = $io->getlines) ||
 671                           defined($io->getline)         ||
 672                           defined($io->getc)     ||
 673                           $io->read($buf, 100)   != 0) ;
 674             }
 675
 676
 677             {
 678                 local $/;  # slurp mode
 679                 my $io = $UncompressClass->new($name);
 680                 is $., 0;
 681                 is $io->input_line_number, 0;
 682                 ok ! $io->eof;
 683                 my @lines = $io->getlines;
 684                 is $., 1;
 685                 is $io->input_line_number, 1;
 686                 ok $io->eof;
 687                 ok @lines == 1 && $lines[0] eq $str;
 688
 689                 $io = $UncompressClass->new($name);
 690                 ok ! $io->eof;
 691                 my $line = $io->getline();
 692                 ok $line eq $str;
 693                 ok $io->eof;
 694             }
 695
 696             {
 697                 local $/ = "";  # paragraph mode
 698                 my $io = $UncompressClass->new($name);
 699                 is $., 0;
 700                 is $io->input_line_number, 0;
 701                 ok ! $io->eof;
 702                 my @lines = $io->getlines();
 703                 is $., 2;
 704                 is $io->input_line_number, 2;
 705                 ok $io->eof;
 706                 ok @lines == 2
 707                     or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
 708                 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
 709                     or print "# $lines[0]\n";
 710                 ok $lines[1] eq "and a single line.\n\n";
 711             }
 712
 713             {
 714                 # Record mode
 715                 my $reclen = 7 ;
 716                 my $expected_records = int(length($str) / $reclen)
 717                                         + (length($str) % $reclen ? 1 : 0);
 718                 local $/ = \$reclen;
 719
 720                 my $io = $UncompressClass->new($name);
 721                 is $., 0;
 722                 is $io->input_line_number, 0;
 723
 724                 ok ! $io->eof;
 725                 my @lines = $io->getlines();
 726                 is $., $expected_records;
 727                 is $io->input_line_number, $expected_records;
 728                 ok $io->eof;
 729                 is @lines, $expected_records,
 730                     "Got $expected_records records\n" ;
 731                 ok $lines[0] eq substr($str, 0, $reclen)
 732                     or print "# $lines[0]\n";
 733                 ok $lines[1] eq substr($str, $reclen, $reclen);
 734             }
 735
 736             {
 737                 local $/ = "is";
 738                 my $io = $UncompressClass->new($name);
 739                 my @lines = ();
 740                 my $no = 0;
 741                 my $err = 0;
 742                 ok ! $io->eof;
 743                 while (my $a = $io->getline()) {
 744                     push(@lines, $a);
 745                     $err++ if $. != ++$no;
 746                 }
 747
 748                 ok $err == 0 ;
 749                 ok $io->eof;
 750
 751                 is $., 3;
 752                 is $io->input_line_number, 3;
 753                 ok @lines == 3
 754                     or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
 755                 ok join("-", @lines) eq
 756                                  "This- is- an example\n" .
 757                                 "of a paragraph\n\n\n" .
 758                                 "and a single line.\n\n";
 759             }
 760
 761
 762             # Test read
 763
 764             {
 765                 my $io = $UncompressClass->new($name);
 766
 767
 768                 eval { $io->read(1) } ;
 769                 like $@, mkErr("buffer parameter is read-only");
 770
 771                 $buf = "abcd";
 772                 is $io->read($buf, 0), 0, "Requested 0 bytes" ;
 773                 is $buf, "", "Buffer empty";
 774
 775                 is $io->read($buf, 3), 3 ;
 776                 is $buf, "Thi";
 777
 778                 is $io->sysread($buf, 3, 2), 3 ;
 779                 is $buf, "Ths i"
 780                     or print "# [$buf]\n" ;;
 781                 ok ! $io->eof;
 782
 783                 $buf = "ab" ;
 784                 is $io->read($buf, 3, 4), 3 ;
 785                 is $buf, "ab" . "\x00" x 2 . "s a"
 786                     or print "# [$buf]\n" ;;
 787                 ok ! $io->eof;
 788
 789                 # read the rest of the file
 790                 $buf = '';
 791                 my $remain = length($str) - 9;
 792                 is $io->read($buf, $remain+1), $remain ;
 793                 is $buf, substr($str, 9);
 794                 ok $io->eof;
 795
 796                 $buf = "hello";
 797                 is $io->read($buf, 10), 0 ;
 798                 is $buf, "", "Buffer empty";
 799                 ok $io->eof;
 800
 801                 ok $io->close();
 802                 $buf = "hello";
 803                 is $io->read($buf, 10), 0 ;
 804                 is $buf, "hello", "Buffer not empty";
 805                 ok $io->eof;
 806
 807         #        $io->seek(-4, 2);
 808         #
 809         #        ok ! $io->eof;
 810         #
 811         #        ok read($io, $buf, 20) == 4 ;
 812         #        ok $buf eq "e.\n\n";
 813         #
 814         #        ok read($io, $buf, 20) == 0 ;
 815         #        ok $buf eq "";
 816         #
 817         #        ok ! $io->eof;
 818             }
 819
 820         }
 821
 822         {
 823             # Read from non-compressed file
 824
 825             my $str = <<EOT;
 826 This is an example
 827 of a paragraph
 828
 829
 830 and a single line.
 831
 832 EOT
 833
 834             my $lex = new LexFile my $name ;
 835
 836             writeFile($name, $str);
 837             my @tmp;
 838             my $buf;
 839             {
 840                 my $io = new $UncompressClass $name, -Transparent => 1 ;
 841
 842                 ok defined $io;
 843                 ok ! $io->eof;
 844                 ok $io->tell() == 0 ;
 845                 my @lines = $io->getlines();
 846                 is @lines, 6;
 847                 ok $lines[1] eq "of a paragraph\n" ;
 848                 ok join('', @lines) eq $str ;
 849                 is $., 6;
 850                 is $io->input_line_number, 6;
 851                 ok $io->tell() == length($str) ;
 852
 853                 ok $io->eof;
 854
 855                 ok ! ( defined($io->getline)  ||
 856                           (@tmp = $io->getlines) ||
 857                           defined($io->getline)         ||
 858                           defined($io->getc)     ||
 859                           $io->read($buf, 100)   != 0) ;
 860             }
 861
 862
 863             {
 864                 local $/;  # slurp mode
 865                 my $io = $UncompressClass->new($name);
 866                 ok ! $io->eof;
 867                 my @lines = $io->getlines;
 868                 is $., 1;
 869                 is $io->input_line_number, 1;
 870                 ok $io->eof;
 871                 ok @lines == 1 && $lines[0] eq $str;
 872
 873                 $io = $UncompressClass->new($name);
 874                 ok ! $io->eof;
 875                 my $line = $io->getline;
 876                 is $., 1;
 877                 is $io->input_line_number, 1;
 878                 ok $line eq $str;
 879                 ok $io->eof;
 880             }
 881
 882             {
 883                 local $/ = "";  # paragraph mode
 884                 my $io = $UncompressClass->new($name);
 885                 ok ! $io->eof;
 886                 my @lines = $io->getlines;
 887                 is $., 2;
 888                 is $io->input_line_number, 2;
 889                 ok $io->eof;
 890                 ok @lines == 2
 891                     or print "# exected 2 lines, got " . scalar(@lines) . "\n";
 892                 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
 893                     or print "# [$lines[0]]\n" ;
 894                 ok $lines[1] eq "and a single line.\n\n";
 895             }
 896
 897             {
 898                 # Record mode
 899                 my $reclen = 7 ;
 900                 my $expected_records = int(length($str) / $reclen)
 901                                         + (length($str) % $reclen ? 1 : 0);
 902                 local $/ = \$reclen;
 903
 904                 my $io = $UncompressClass->new($name);
 905                 is $., 0;
 906                 is $io->input_line_number, 0;
 907
 908                 ok ! $io->eof;
 909                 my @lines = $io->getlines();
 910                 is $., $expected_records;
 911                 is $io->input_line_number, $expected_records;
 912                 ok $io->eof;
 913                 is @lines, $expected_records,
 914                     "Got $expected_records records\n" ;
 915                 ok $lines[0] eq substr($str, 0, $reclen)
 916                     or print "# $lines[0]\n";
 917                 ok $lines[1] eq substr($str, $reclen, $reclen);
 918             }
 919
 920             {
 921                 local $/ = "is";
 922                 my $io = $UncompressClass->new($name);
 923                 my @lines = ();
 924                 my $no = 0;
 925                 my $err = 0;
 926                 ok ! $io->eof;
 927                 while (my $a = $io->getline) {
 928                     push(@lines, $a);
 929                     $err++ if $. != ++$no;
 930                 }
 931
 932                 is $., 3;
 933                 is $io->input_line_number, 3;
 934                 ok $err == 0 ;
 935                 ok $io->eof;
 936
 937
 938                 ok @lines == 3 ;
 939                 ok join("-", @lines) eq
 940                                  "This- is- an example\n" .
 941                                 "of a paragraph\n\n\n" .
 942                                 "and a single line.\n\n";
 943             }
 944
 945
 946             # Test Read
 947
 948             {
 949                 my $io = $UncompressClass->new($name);
 950
 951                 $buf = "abcd";
 952                 is $io->read($buf, 0), 0, "Requested 0 bytes" ;
 953                 is $buf, "", "Buffer empty";
 954
 955                 ok $io->read($buf, 3) == 3 ;
 956                 ok $buf eq "Thi";
 957
 958                 ok $io->sysread($buf, 3, 2) == 3 ;
 959                 ok $buf eq "Ths i";
 960                 ok ! $io->eof;
 961
 962                 $buf = "ab" ;
 963                 is $io->read($buf, 3, 4), 3 ;
 964                 is $buf, "ab" . "\x00" x 2 . "s a"
 965                     or print "# [$buf]\n" ;;
 966                 ok ! $io->eof;
 967
 968                 # read the rest of the file
 969                 $buf = '';
 970                 my $remain = length($str) - 9;
 971                 is $io->read($buf, $remain), $remain ;
 972                 is $buf, substr($str, 9);
 973                 ok $io->eof;
 974
 975                 $buf = "hello";
 976                 is $io->read($buf, 10), 0 ;
 977                 is $buf, "", "Buffer empty";
 978                 ok $io->eof;
 979
 980                 ok $io->close();
 981                 $buf = "hello";
 982                 is $io->read($buf, 10), 0 ;
 983                 is $buf, "hello", "Buffer not empty";
 984                 ok $io->eof;
 985
 986         #        $io->seek(-4, 2);
 987         #
 988         #        ok ! $io->eof;
 989         #
 990         #        ok read($io, $buf, 20) == 4 ;
 991         #        ok $buf eq "e.\n\n";
 992         #
 993         #        ok read($io, $buf, 20) == 0 ;
 994         #        ok $buf eq "";
 995         #
 996         #        ok ! $io->eof;
 997             }
 998
 999
1000         }
1001
1002         {
1003             # Vary the length parameter in a read
1004
1005             my $str = <<EOT;
1006 x
1007 x
1008 This is an example
1009 of a paragraph
1010
1011
1012 and a single line.
1013
1014 EOT
1015             $str = $str x 100 ;
1016
1017
1018             foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
1019             {
1020                 foreach my $trans (0, 1)
1021                 {
1022                     foreach my $append (0, 1)
1023                     {
1024                         title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
1025
1026                         my $lex = new LexFile my $name ;
1027
1028                         if ($trans) {
1029                             writeFile($name, $str) ;
1030                         }
1031                         else {
1032                             my $iow = new $CompressClass $name;
1033                             $iow->print($str) ;
1034                             $iow->close ;
1035                         }
1036
1037
1038                         my $io = $UncompressClass->new($name,
1039                                                        -Append => $append,
1040                                                        -Transparent  => $trans);
1041
1042                         my $buf;
1043
1044                         is $io->tell(), 0;
1045
1046                         if ($append) {
1047                             1 while $io->read($buf, $bufsize) > 0;
1048                         }
1049                         else {
1050                             my $tmp ;
1051                             $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
1052                         }
1053                         is length $buf, length $str;
1054                         ok $buf eq $str ;
1055                         ok ! $io->error() ;
1056                         ok $io->eof;
1057                     }
1058                 }
1059             }
1060         }
1061
1062         foreach my $file (0, 1)
1063         {
1064             foreach my $trans (0, 1)
1065             {
1066                 title "seek tests - file $file trans $trans" ;
1067
1068                 my $buffer ;
1069                 my $buff ;
1070                 my $lex = new LexFile my $name ;
1071
1072                 my $first = "beginning" ;
1073                 my $last  = "the end" ;
1074
1075                 if ($trans)
1076                 {
1077                     $buffer = $first . "\x00" x 10 . $last;
1078                     writeFile($name, $buffer);
1079                 }
1080                 else
1081                 {
1082                     my $output ;
1083                     if ($file)
1084                     {
1085                         $output = $name ;
1086                     }
1087                     else
1088                     {
1089                         $output = \$buffer;
1090                     }
1091
1092                     my $iow = new $CompressClass $output ;
1093                     $iow->print($first) ;
1094                     ok $iow->seek(5, SEEK_CUR) ;
1095                     ok $iow->tell() == length($first)+5;
1096                     ok $iow->seek(0, SEEK_CUR) ;
1097                     ok $iow->tell() == length($first)+5;
1098                     ok $iow->seek(length($first)+10, SEEK_SET) ;
1099                     ok $iow->tell() == length($first)+10;
1100
1101                     $iow->print($last) ;
1102                     $iow->close ;
1103                 }
1104
1105                 my $input ;
1106                 if ($file)
1107                 {
1108                     $input = $name ;
1109                 }
1110                 else
1111                 {
1112                     $input = \$buffer ;
1113                 }
1114
1115                 ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ;
1116
1117                 my $io = $UncompressClass->new($input, Strict => 1);
1118                 ok $io->seek(length($first), SEEK_CUR)
1119                     or diag $$UnError ;
1120                 ok ! $io->eof;
1121                 is $io->tell(), length($first);
1122
1123                 ok $io->read($buff, 5) ;
1124                 is $buff, "\x00" x 5 ;
1125                 is $io->tell(), length($first) + 5;
1126
1127                 ok $io->seek(0, SEEK_CUR) ;
1128                 my $here = $io->tell() ;
1129                 is $here, length($first)+5;
1130
1131                 ok $io->seek($here+5, SEEK_SET) ;
1132                 is $io->tell(), $here+5 ;
1133                 ok $io->read($buff, 100) ;
1134                 ok $buff eq $last ;
1135                 ok $io->eof;
1136             }
1137         }
1138
1139         {
1140             title "seek error cases" ;
1141
1142             my $b ;
1143             my $a = new $CompressClass(\$b)  ;
1144
1145             ok ! $a->error() ;
1146             eval { $a->seek(-1, 10) ; };
1147             like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter");
1148
1149             eval { $a->seek(-1, SEEK_END) ; };
1150             like $@, mkErr("^${CompressClass}::seek: cannot seek backwards");
1151
1152             $a->write("fred");
1153             $a->close ;
1154
1155
1156             my $u = new $UncompressClass(\$b)  ;
1157
1158             eval { $u->seek(-1, 10) ; };
1159             like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter");
1160
1161             eval { $u->seek(-1, SEEK_END) ; };
1162             like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed");
1163
1164             eval { $u->seek(-1, SEEK_CUR) ; };
1165             like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards");
1166         }
1167
1168         foreach my $fb (qw(filename buffer filehandle))
1169         {
1170             foreach my $append (0, 1)
1171             {
1172                 {
1173                     title "$CompressClass -- Append $append, Output to $fb" ;
1174
1175                     my $lex = new LexFile my $name ;
1176
1177                     my $already = 'already';
1178                     my $buffer = $already;
1179                     my $output;
1180
1181                     if ($fb eq 'buffer')
1182                       { $output = \$buffer }
1183                     elsif ($fb eq 'filename')
1184                     {
1185                         $output = $name ;
1186                         writeFile($name, $buffer);
1187                     }
1188                     elsif ($fb eq 'filehandle')
1189                     {
1190                         $output = new IO::File ">$name" ;
1191                         print $output $buffer;
1192                     }
1193
1194                     my $a = new $CompressClass($output, Append => $append)  ;
1195                     ok $a, "  Created $CompressClass";
1196                     my $string = "appended";
1197                     $a->write($string);
1198                     $a->close ;
1199
1200                     my $data ;
1201                     if ($fb eq 'buffer')
1202                     {
1203                         $data = $buffer;
1204                     }
1205                     else
1206                     {
1207                         $output->close
1208                             if $fb eq 'filehandle';
1209                         $data = readFile($name);
1210                     }
1211
1212                     if ($append || $fb eq 'filehandle')
1213                     {
1214                         is substr($data, 0, length($already)), $already, "  got prefix";
1215                         substr($data, 0, length($already)) = '';
1216                     }
1217
1218
1219                     my $uncomp;
1220                     my $x = new $UncompressClass(\$data, Append => 1)  ;
1221                     ok $x, "  created $UncompressClass";
1222
1223                     my $len ;
1224                     1 while ($len = $x->read($uncomp)) > 0 ;
1225
1226                     $x->close ;
1227                     is $uncomp, $string, '  Got uncompressed data' ;
1228
1229                 }
1230             }
1231         }
1232
1233         foreach my $type (qw(buffer filename filehandle))
1234         {
1235             foreach my $good (0, 1)
1236             {
1237                 title "$UncompressClass -- InputLength, read from $type, good data => $good";
1238
1239                 my $compressed ;
1240                 my $string = "some data";
1241                 my $appended = "append";
1242
1243                 if ($good)
1244                 {
1245                     my $c = new $CompressClass(\$compressed);
1246                     $c->write($string);
1247                     $c->close();
1248                 }
1249                 else
1250                 {
1251                     $compressed = $string ;
1252                 }
1253
1254                 my $comp_len = length $compressed;
1255                 $compressed .= $appended;
1256
1257                 my $lex = new LexFile my $name ;
1258                 my $input ;
1259                 writeFile ($name, $compressed);
1260
1261                 if ($type eq 'buffer')
1262                 {
1263                     $input = \$compressed;
1264                 }
1265                 if ($type eq 'filename')
1266                 {
1267                     $input = $name;
1268                 }
1269                 elsif ($type eq 'filehandle')
1270                 {
1271                     my $fh = new IO::File "<$name" ;
1272                     ok $fh, "opened file $name ok";
1273                     $input = $fh ;
1274                 }
1275
1276                 my $x = new $UncompressClass($input,
1277                                              InputLength => $comp_len,
1278                                              Transparent => 1)  ;
1279                 ok $x, "  created $UncompressClass";
1280
1281                 my $len ;
1282                 my $output;
1283                 $len = $x->read($output, 100);
1284
1285                 is $len, length($string);
1286                 is $output, $string;
1287
1288                 if ($type eq 'filehandle')
1289                 {
1290                     my $rest ;
1291                     $input->read($rest, 1000);
1292                     is $rest, $appended;
1293                 }
1294             }
1295
1296
1297         }
1298
1299         foreach my $append (0, 1)
1300         {
1301             title "$UncompressClass -- Append $append" ;
1302
1303             my $lex = new LexFile my $name ;
1304
1305             my $string = "appended";
1306             my $compressed ;
1307             my $c = new $CompressClass(\$compressed);
1308             $c->write($string);
1309             $c->close();
1310
1311             my $x = new $UncompressClass(\$compressed, Append => $append)  ;
1312             ok $x, "  created $UncompressClass";
1313
1314             my $already = 'already';
1315             my $output = $already;
1316
1317             my $len ;
1318             $len = $x->read($output, 100);
1319             is $len, length($string);
1320
1321             $x->close ;
1322
1323             if ($append)
1324             {
1325                 is substr($output, 0, length($already)), $already, "  got prefix";
1326                 substr($output, 0, length($already)) = '';
1327             }
1328             is $output, $string, '  Got uncompressed data' ;
1329         }
1330
1331
1332         foreach my $file (0, 1)
1333         {
1334             foreach my $trans (0, 1)
1335             {
1336                 title "ungetc, File $file, Transparent $trans" ;
1337
1338                 my $lex = new LexFile my $name ;
1339
1340                 my $string = 'abcdeABCDE';
1341                 my $b ;
1342                 if ($trans)
1343                 {
1344                     $b = $string ;
1345                 }
1346                 else
1347                 {
1348                     my $a = new $CompressClass(\$b)  ;
1349                     $a->write($string);
1350                     $a->close ;
1351                 }
1352
1353                 my $from ;
1354                 if ($file)
1355                 {
1356                     writeFile($name, $b);
1357                     $from = $name ;
1358                 }
1359                 else
1360                 {
1361                     $from = \$b ;
1362                 }
1363
1364                 my $u = $UncompressClass->new($from, Transparent => 1)  ;
1365                 my $first;
1366                 my $buff ;
1367
1368                 # do an ungetc before reading
1369                 $u->ungetc("X");
1370                 $first = $u->getc();
1371                 is $first, 'X';
1372
1373                 $first = $u->getc();
1374                 is $first, substr($string, 0,1);
1375                 $u->ungetc($first);
1376                 $first = $u->getc();
1377                 is $first, substr($string, 0,1);
1378                 $u->ungetc($first);
1379
1380                 is $u->read($buff, 5), 5 ;
1381                 is $buff, substr($string, 0, 5);
1382
1383                 $u->ungetc($buff) ;
1384                 is $u->read($buff, length($string)), length($string) ;
1385                 is $buff, $string;
1386
1387                 is $u->read($buff, 1), 0;
1388                 ok $u->eof() ;
1389
1390                 my $extra = 'extra';
1391                 $u->ungetc($extra);
1392                 ok ! $u->eof();
1393                 is $u->read($buff), length($extra) ;
1394                 is $buff, $extra;
1395
1396                 is $u->read($buff, 1), 0;
1397                 ok $u->eof() ;
1398
1399                 # getc returns undef on eof
1400                 is $u->getc(), undef;
1401                 $u->close();
1402
1403             }
1404         }
1405
1406         {
1407             title "write tests - invalid data" ;
1408
1409             #my $lex = new LexFile my $name1 ;
1410             my($Answer);
1411
1412             #ok ! -e $name1, "  File $name1 does not exist";
1413
1414             my @data = (
1415                 [ '{ }',         "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1416                 [ '[ { } ]',     "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1417                 [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1418                 [ '[ "" ]',      "${CompressClass}::write: input filename is undef or null string" ],
1419                 [ '[ undef ]',   "${CompressClass}::write: input filename is undef or null string" ],
1420                 [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ],
1421                 #[ "not readable", 'xx' ],
1422                 # same filehandle twice, 'xx'
1423                ) ;
1424
1425             foreach my $data (@data)
1426             {
1427                 my ($send, $get) = @$data ;
1428                 title "${CompressClass}::write( $send )";
1429                 my($copy);
1430                 eval "\$copy = $send";
1431                 my $x = new $CompressClass(\$Answer);
1432                 ok $x, "  Created $CompressClass object";
1433                 eval { $x->write($copy) } ;
1434                 #like $@, "/^$get/", "  error - $get";
1435                 like $@, "/not a scalar reference /", "  error - not a scalar reference";
1436             }
1437
1438     #        @data = (
1439     #            [ '[ $name1 ]',  "input file '$name1' does not exist" ],
1440     #            #[ "not readable", 'xx' ],
1441     #            # same filehandle twice, 'xx'
1442     #           ) ;
1443     #
1444     #        foreach my $data (@data)
1445     #        {
1446     #            my ($send, $get) = @$data ;
1447     #            title "${CompressClass}::write( $send )";
1448     #            my $copy;
1449     #            eval "\$copy = $send";
1450     #            my $x = new $CompressClass(\$Answer);
1451     #            ok $x, "  Created $CompressClass object";
1452     #            ok ! $x->write($copy), "  write fails"  ;
1453     #            like $$Error, "/^$get/", "  error - $get";
1454     #        }
1455
1456             #exit;
1457
1458         }
1459
1460
1461     #    sub deepCopy
1462     #    {
1463     #        if (! ref $_[0] || ref $_[0] eq 'SCALAR')
1464     #        {
1465     #            return $_[0] ;
1466     #        }
1467     #
1468     #        if (ref $_[0] eq 'ARRAY')
1469     #        {
1470     #            my @a ;
1471     #            for my $x ( @{ $_[0] })
1472     #            {
1473     #                push @a, deepCopy($x);
1474     #            }
1475     #
1476     #            return \@a ;
1477     #        }
1478     #
1479     #        croak "bad! $_[0]";
1480     #
1481     #    }
1482     #
1483     #    sub deepSubst
1484     #    {
1485     #        #my $data = shift ;
1486     #        my $from = $_[1] ;
1487     #        my $to   = $_[2] ;
1488     #
1489     #        if (! ref $_[0])
1490     #        {
1491     #            $_[0] = $to
1492     #                if $_[0] eq $from ;
1493     #            return ;
1494     #
1495     #        }
1496     #
1497     #        if (ref $_[0] eq 'SCALAR')
1498     #        {
1499     #            $_[0] = \$to
1500     #                if defined ${ $_[0] } && ${ $_[0] } eq $from ;
1501     #            return ;
1502     #
1503     #        }
1504     #
1505     #        if (ref $_[0] eq 'ARRAY')
1506     #        {
1507     #            for my $x ( @{ $_[0] })
1508     #            {
1509     #                deepSubst($x, $from, $to);
1510     #            }
1511     #            return ;
1512     #        }
1513     #        #croak "bad! $_[0]";
1514     #    }
1515
1516     #    {
1517     #        title "More write tests" ;
1518     #
1519     #        my $file1 = "file1" ;
1520     #        my $file2 = "file2" ;
1521     #        my $file3 = "file3" ;
1522     #        my $lex = new LexFile $file1, $file2, $file3 ;
1523     #
1524     #        writeFile($file1, "F1");
1525     #        writeFile($file2, "F2");
1526     #        writeFile($file3, "F3");
1527     #
1528     #        my @data = (
1529     #              [ '""',                                   ""      ],
1530     #              [ 'undef',                                ""      ],
1531     #              [ '"abcd"',                               "abcd"  ],
1532     #
1533     #              [ '\""',                                   ""     ],
1534     #              [ '\undef',                                ""     ],
1535     #              [ '\"abcd"',                               "abcd" ],
1536     #
1537     #              [ '[]',                                    ""     ],
1538     #              [ '[[]]',                                  ""     ],
1539     #              [ '[[[]]]',                                ""     ],
1540     #              [ '[\""]',                                 ""     ],
1541     #              [ '[\undef]',                              ""     ],
1542     #              [ '[\"abcd"]',                             "abcd" ],
1543     #              [ '[\"ab", \"cd"]',                        "abcd" ],
1544     #              [ '[[\"ab"], [\"cd"]]',                    "abcd" ],
1545     #
1546     #              [ '$file1',                                $file1 ],
1547     #              [ '$fh2',                                  "F2"   ],
1548     #              [ '[$file1, \"abc"]',                      "F1abc"],
1549     #              [ '[\"a", $file1, \"bc"]',                 "aF1bc"],
1550     #              [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
1551     #              [ '[\"a", $fh1, \"bc", $file2]',           "aF1bcF2"],
1552     #              [ '[\"a", $fh1, \"bc", $file2, $fh3]',     "aF1bcF2F3"],
1553     #            ) ;
1554     #
1555     #
1556     #        foreach my $data (@data)
1557     #        {
1558     #            my ($send, $get) = @$data ;
1559     #
1560     #            my $fh1 = new IO::File "< $file1" ;
1561     #            my $fh2 = new IO::File "< $file2" ;
1562     #            my $fh3 = new IO::File "< $file3" ;
1563     #
1564     #            title "${CompressClass}::write( $send )";
1565     #            my $copy;
1566     #            eval "\$copy = $send";
1567     #            my $Answer ;
1568     #            my $x = new $CompressClass(\$Answer);
1569     #            ok $x, "  Created $CompressClass object";
1570     #            my $len = length $get;
1571     #            is $x->write($copy), length($get), "  write $len bytes";
1572     #            ok $x->close(), "  close ok" ;
1573     #
1574     #            is myGZreadFile(\$Answer), $get, "  got expected output" ;
1575     #            cmp_ok $$Error, '==', 0, "  no error";
1576     #
1577     #
1578     #        }
1579     #
1580     #    }
1581     }
1582
1583 }
1584
1585 1;
1586
1587
1588
1589
1590