ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm

   1
   2 package IO::Uncompress::Gunzip ;
   3
   4 require 5.004 ;
   5
   6 # for RFC1952
   7
   8 use strict ;
   9 use warnings;
  10
  11 require Exporter ;
  12
  13 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GunzipError);
  14
  15 @ISA    = qw(Exporter IO::BaseInflate);
  16 @EXPORT_OK = qw( $GunzipError gunzip );
  17 %EXPORT_TAGS = %IO::BaseInflate::EXPORT_TAGS ;
  18 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  19 Exporter::export_ok_tags('all');
  20
  21
  22 $GunzipError = '';
  23
  24 $VERSION = '2.000_05';
  25
  26 sub new
  27 {
  28     my $pkg = shift ;
  29     return IO::BaseInflate::new($pkg, 'rfc1952', undef, \$GunzipError, 0, @_);
  30 }
  31
  32 sub gunzip
  33 {
  34     return IO::BaseInflate::_inf(__PACKAGE__, 'rfc1952', \$GunzipError, @_) ;
  35 }
  36
  37 package IO::BaseInflate ;
  38
  39 use strict ;
  40 use warnings;
  41 use bytes;
  42
  43 our ($VERSION, @EXPORT_OK, %EXPORT_TAGS);
  44
  45 $VERSION = '2.000_03';
  46
  47 use Compress::Zlib 2 ;
  48 use Compress::Zlib::Common ;
  49 use Compress::Zlib::ParseParameters ;
  50 use Compress::Gzip::Constants;
  51 use Compress::Zlib::FileConstants;
  52
  53 use IO::File ;
  54 use Symbol;
  55 use Scalar::Util qw(readonly);
  56 use List::Util qw(min);
  57 use Carp ;
  58
  59 %EXPORT_TAGS = ( );
  60 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  61 #Exporter::export_ok_tags('all') ;
  62
  63
  64 use constant G_EOF => 0 ;
  65 use constant G_ERR => -1 ;
  66
  67 sub smartRead
  68 {
  69     my $self = $_[0];
  70     my $out = $_[1];
  71     my $size = $_[2];
  72     $$out = "" ;
  73
  74     my $offset = 0 ;
  75
  76
  77     if ( length *$self->{Prime} ) {
  78         #$$out = substr(*$self->{Prime}, 0, $size, '') ;
  79         $$out = substr(*$self->{Prime}, 0, $size) ;
  80         substr(*$self->{Prime}, 0, $size) =  '' ;
  81         if (length $$out == $size) {
  82             #*$self->{InputLengthRemaining} -= length $$out;
  83             return length $$out ;
  84         }
  85         $offset = length $$out ;
  86     }
  87
  88     my $get_size = $size - $offset ;
  89
  90     if ( defined *$self->{InputLength} ) {
  91         #*$self->{InputLengthRemaining} += length *$self->{Prime} ;
  92         #*$self->{InputLengthRemaining} = *$self->{InputLength}
  93         #    if *$self->{InputLengthRemaining} > *$self->{InputLength};
  94         $get_size = min($get_size, *$self->{InputLengthRemaining});
  95     }
  96
  97     if (defined *$self->{FH})
  98       { *$self->{FH}->read($$out, $get_size, $offset) }
  99     elsif (defined *$self->{InputEvent}) {
 100         my $got = 1 ;
 101         while (length $$out < $size) {
 102             last
 103                 if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0;
 104         }
 105
 106         if (length $$out > $size ) {
 107             #*$self->{Prime} = substr($$out, $size, length($$out), '');
 108             *$self->{Prime} = substr($$out, $size, length($$out));
 109             substr($$out, $size, length($$out)) =  '';
 110         }
 111
 112        *$self->{EventEof} = 1 if $got <= 0 ;
 113     }
 114     else {
 115        no warnings 'uninitialized';
 116        my $buf = *$self->{Buffer} ;
 117        $$buf = '' unless defined $$buf ;
 118        #$$out = '' unless defined $$out ;
 119        substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
 120        *$self->{BufferOffset} += length($$out) - $offset ;
 121     }
 122
 123     *$self->{InputLengthRemaining} -= length $$out;
 124
 125     $self->saveStatus(length $$out < 0 ? Z_DATA_ERROR : 0) ;
 126
 127     return length $$out;
 128 }
 129
 130 sub smartSeek
 131 {
 132     my $self   = shift ;
 133     my $offset = shift ;
 134     my $truncate = shift;
 135     #print "smartSeek to $offset\n";
 136
 137     if (defined *$self->{FH})
 138       { *$self->{FH}->seek($offset, SEEK_SET) }
 139     else {
 140         *$self->{BufferOffset} = $offset ;
 141         substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = ''
 142             if $truncate;
 143         return 1;
 144     }
 145 }
 146
 147 sub smartWrite
 148 {
 149     my $self   = shift ;
 150     my $out_data = shift ;
 151
 152     if (defined *$self->{FH}) {
 153         # flush needed for 5.8.0
 154         defined *$self->{FH}->write($out_data, length $out_data) &&
 155         defined *$self->{FH}->flush() ;
 156     }
 157     else {
 158        my $buf = *$self->{Buffer} ;
 159        substr($$buf, *$self->{BufferOffset}, length $out_data) = $out_data ;
 160        *$self->{BufferOffset} += length($out_data) ;
 161        return 1;
 162     }
 163 }
 164
 165 sub smartReadExact
 166 {
 167     return $_[0]->smartRead($_[1], $_[2]) == $_[2];
 168 }
 169
 170 sub getTrailingBuffer
 171 {
 172     my ($self) = $_[0];
 173     return "" if defined *$self->{FH} || defined *$self->{InputEvent} ;
 174
 175     my $buf = *$self->{Buffer} ;
 176     my $offset = *$self->{BufferOffset} ;
 177     return substr($$buf, $offset, -1) ;
 178 }
 179
 180 sub smartEof
 181 {
 182     my ($self) = $_[0];
 183     if (defined *$self->{FH})
 184      { *$self->{FH}->eof() }
 185     elsif (defined *$self->{InputEvent})
 186      { *$self->{EventEof} }
 187     else
 188      { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) }
 189 }
 190
 191 sub saveStatus
 192 {
 193     my $self   = shift ;
 194     *$self->{ErrorNo}  = shift() + 0 ;
 195     ${ *$self->{Error} } = '' ;
 196
 197     return *$self->{ErrorNo} ;
 198 }
 199
 200
 201 sub saveErrorString
 202 {
 203     my $self   = shift ;
 204     my $retval = shift ;
 205     ${ *$self->{Error} } = shift ;
 206     *$self->{ErrorNo} = shift() + 0 if @_ ;
 207
 208     #print "saveErrorString: " . ${ *$self->{Error} } . "\n" ;
 209     return $retval;
 210 }
 211
 212 sub error
 213 {
 214     my $self   = shift ;
 215     return ${ *$self->{Error} } ;
 216 }
 217
 218 sub errorNo
 219 {
 220     my $self   = shift ;
 221     return *$self->{ErrorNo};
 222 }
 223
 224 sub HeaderError
 225 {
 226     my ($self) = shift;
 227     return $self->saveErrorString(undef, "Header Error: $_[0]", Z_DATA_ERROR);
 228 }
 229
 230 sub TrailerError
 231 {
 232     my ($self) = shift;
 233     return $self->saveErrorString(G_ERR, "Trailer Error: $_[0]", Z_DATA_ERROR);
 234 }
 235
 236 sub TruncatedHeader
 237 {
 238     my ($self) = shift;
 239     return $self->HeaderError("Truncated in $_[0] Section");
 240 }
 241
 242 sub isZipMagic
 243 {
 244     my $buffer = shift ;
 245     return 0 if length $buffer < 4 ;
 246     my $sig = unpack("V", $buffer) ;
 247     return $sig == 0x04034b50 ;
 248 }
 249
 250 sub isGzipMagic
 251 {
 252     my $buffer = shift ;
 253     return 0 if length $buffer < GZIP_ID_SIZE ;
 254     my ($id1, $id2) = unpack("C C", $buffer) ;
 255     return $id1 == GZIP_ID1 && $id2 == GZIP_ID2 ;
 256 }
 257
 258 sub isZlibMagic
 259 {
 260     my $buffer = shift ;
 261     return 0 if length $buffer < ZLIB_HEADER_SIZE ;
 262     my $hdr = unpack("n", $buffer) ;
 263     return $hdr % 31 == 0 ;
 264 }
 265
 266 sub _isRaw
 267 {
 268     my $self   = shift ;
 269     my $magic = shift ;
 270
 271     $magic = '' unless defined $magic ;
 272
 273     my $buffer = '';
 274
 275     $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0
 276         or return $self->saveErrorString(undef, "No data to read");
 277
 278     my $temp_buf = $magic . $buffer ;
 279     *$self->{HeaderPending} = $temp_buf ;
 280     $buffer = '';
 281     my $status = *$self->{Inflate}->inflate($temp_buf, $buffer) ;
 282     my $buf_len = *$self->{Inflate}->inflateCount();
 283
 284     # zlib before 1.2 needs an extra byte after the compressed data
 285     # for RawDeflate
 286     if ($status == Z_OK && $self->smartEof()) {
 287         my $byte = ' ';
 288         $status = *$self->{Inflate}->inflate(\$byte, $buffer) ;
 289         return $self->saveErrorString(undef, "Inflation Error: $status", $status)
 290             unless $self->saveStatus($status) == Z_OK || $status == Z_STREAM_END ;
 291         $buf_len += *$self->{Inflate}->inflateCount();
 292     }
 293
 294     return $self->saveErrorString(undef, "unexpected end of file", Z_DATA_ERROR)
 295         if $self->saveStatus($status) != Z_STREAM_END && $self->smartEof() ;
 296
 297     return $self->saveErrorString(undef, "Inflation Error: $status", $status)
 298         unless $status == Z_OK || $status == Z_STREAM_END ;
 299
 300     if ($status == Z_STREAM_END) {
 301         if (*$self->{MultiStream}
 302                     && (length $temp_buf || ! $self->smartEof())){
 303             *$self->{NewStream} = 1 ;
 304             *$self->{EndStream} = 0 ;
 305             *$self->{Prime} = $temp_buf  . *$self->{Prime} ;
 306         }
 307         else {
 308             *$self->{EndStream} = 1 ;
 309             *$self->{Trailing} = $temp_buf . $self->getTrailingBuffer();
 310         }
 311     }
 312     *$self->{HeaderPending} = $buffer ;
 313     *$self->{InflatedBytesRead} = $buf_len ;
 314     *$self->{TotalInflatedBytesRead} += $buf_len ;
 315     *$self->{Type} = 'rfc1951';
 316
 317     $self->saveStatus(Z_OK);
 318
 319     return {
 320         'Type'          => 'rfc1951',
 321         'HeaderLength'  => 0,
 322         'TrailerLength' => 0,
 323         'Header'        => ''
 324         };
 325 }
 326
 327 sub _guessCompression
 328 {
 329     my $self = shift ;
 330
 331     # Check raw first in case the first few bytes happen to match
 332     # the signatures of gzip/deflate.
 333     my $got = $self->_isRaw() ;
 334     return $got if defined $got ;
 335
 336     *$self->{Prime} = *$self->{HeaderPending} . *$self->{Prime} ;
 337     *$self->{HeaderPending} = '';
 338     *$self->{Inflate}->inflateReset();
 339
 340     my $magic = '' ;
 341     my $status ;
 342     $self->smartReadExact(\$magic, GZIP_ID_SIZE)
 343         or return $self->HeaderError("Minimum header size is " .
 344                                      GZIP_ID_SIZE . " bytes") ;
 345
 346     if (isGzipMagic($magic)) {
 347         $status = $self->_readGzipHeader($magic);
 348         delete *$self->{Transparent} if ! defined $status ;
 349         return $status ;
 350     }
 351     elsif ( $status = $self->_readDeflateHeader($magic) ) {
 352         return $status ;
 353     }
 354
 355     *$self->{Prime} = $magic . *$self->{HeaderPending} . *$self->{Prime} ;
 356     *$self->{HeaderPending} = '';
 357     $self->saveErrorString(undef, "unknown compression format", Z_DATA_ERROR);
 358 }
 359
 360 sub _readFullGzipHeader($)
 361 {
 362     my ($self) = @_ ;
 363     my $magic = '' ;
 364
 365     $self->smartReadExact(\$magic, GZIP_ID_SIZE);
 366
 367     *$self->{HeaderPending} = $magic ;
 368
 369     return $self->HeaderError("Minimum header size is " .
 370                               GZIP_MIN_HEADER_SIZE . " bytes")
 371         if length $magic != GZIP_ID_SIZE ;
 372
 373
 374     return $self->HeaderError("Bad Magic")
 375         if ! isGzipMagic($magic) ;
 376
 377     my $status = $self->_readGzipHeader($magic);
 378     delete *$self->{Transparent} if ! defined $status ;
 379     return $status ;
 380 }
 381
 382 sub _readGzipHeader($)
 383 {
 384     my ($self, $magic) = @_ ;
 385     my ($HeaderCRC) ;
 386     my ($buffer) = '' ;
 387
 388     $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE)
 389         or return $self->HeaderError("Minimum header size is " .
 390                                      GZIP_MIN_HEADER_SIZE . " bytes") ;
 391
 392     my $keep = $magic . $buffer ;
 393     *$self->{HeaderPending} = $keep ;
 394
 395     # now split out the various parts
 396     my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ;
 397
 398     $cm == GZIP_CM_DEFLATED
 399         or return $self->HeaderError("Not Deflate (CM is $cm)") ;
 400
 401     # check for use of reserved bits
 402     return $self->HeaderError("Use of Reserved Bits in FLG field.")
 403         if $flag & GZIP_FLG_RESERVED ;
 404
 405     my $EXTRA ;
 406     my @EXTRA = () ;
 407     if ($flag & GZIP_FLG_FEXTRA) {
 408         $EXTRA = "" ;
 409         $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE)
 410             or return $self->TruncatedHeader("FEXTRA Length") ;
 411
 412         my ($XLEN) = unpack("v", $buffer) ;
 413         $self->smartReadExact(\$EXTRA, $XLEN)
 414             or return $self->TruncatedHeader("FEXTRA Body");
 415         $keep .= $buffer . $EXTRA ;
 416
 417         if ($XLEN && *$self->{'ParseExtra'}) {
 418             my $offset = 0 ;
 419             while ($offset < $XLEN) {
 420
 421                 return $self->TruncatedHeader("FEXTRA Body")
 422                     if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ;
 423
 424                 my $id = substr($EXTRA, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);
 425                 $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE ;
 426
 427                 return $self->HeaderError("SubField ID 2nd byte is 0x00")
 428                     if *$self->{Strict} && substr($id, 1, 1) eq "\x00" ;
 429
 430                 my ($subLen) = unpack("v", substr($EXTRA, $offset,
 431                                         GZIP_FEXTRA_SUBFIELD_LEN_SIZE)) ;
 432                 $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
 433
 434                 return $self->TruncatedHeader("FEXTRA Body")
 435                     if $offset + $subLen > $XLEN ;
 436
 437                 push @EXTRA, [$id => substr($EXTRA, $offset, $subLen)];
 438                 $offset += $subLen ;
 439             }
 440         }
 441     }
 442
 443     my $origname ;
 444     if ($flag & GZIP_FLG_FNAME) {
 445         $origname = "" ;
 446         while (1) {
 447             $self->smartReadExact(\$buffer, 1)
 448                 or return $self->TruncatedHeader("FNAME");
 449             last if $buffer eq GZIP_NULL_BYTE ;
 450             $origname .= $buffer
 451         }
 452         $keep .= $origname . GZIP_NULL_BYTE ;
 453
 454         return $self->HeaderError("Non ISO 8859-1 Character found in Name")
 455             if *$self->{Strict} && $origname =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
 456     }
 457
 458     my $comment ;
 459     if ($flag & GZIP_FLG_FCOMMENT) {
 460         $comment = "";
 461         while (1) {
 462             $self->smartReadExact(\$buffer, 1)
 463                 or return $self->TruncatedHeader("FCOMMENT");
 464             last if $buffer eq GZIP_NULL_BYTE ;
 465             $comment .= $buffer
 466         }
 467         $keep .= $comment . GZIP_NULL_BYTE ;
 468
 469         return $self->HeaderError("Non ISO 8859-1 Character found in Comment")
 470             if *$self->{Strict} && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o ;
 471     }
 472
 473     if ($flag & GZIP_FLG_FHCRC) {
 474         $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE)
 475             or return $self->TruncatedHeader("FHCRC");
 476
 477         $HeaderCRC = unpack("v", $buffer) ;
 478         my $crc16 = crc32($keep) & 0xFF ;
 479
 480         return $self->HeaderError("CRC16 mismatch.")
 481             if *$self->{Strict} && $crc16 != $HeaderCRC;
 482
 483         $keep .= $buffer ;
 484     }
 485
 486     # Assume compression method is deflated for xfl tests
 487     #if ($xfl) {
 488     #}
 489
 490     *$self->{Type} = 'rfc1952';
 491
 492     return {
 493         'Type'          => 'rfc1952',
 494         'HeaderLength'  => length $keep,
 495         'TrailerLength' => GZIP_TRAILER_SIZE,
 496         'Header'        => $keep,
 497         'isMinimalHeader' => $keep eq GZIP_MINIMUM_HEADER ? 1 : 0,
 498
 499         'MethodID'      => $cm,
 500         'MethodName'    => $cm == GZIP_CM_DEFLATED ? "Deflated" : "Unknown" ,
 501         'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
 502         'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
 503         'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
 504         'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
 505         'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
 506         'Name'          => $origname,
 507         'Comment'       => $comment,
 508         'Time'          => $mtime,
 509         'OsID'          => $os,
 510         'OsName'        => defined $GZIP_OS_Names{$os}
 511                                  ? $GZIP_OS_Names{$os} : "Unknown",
 512         'HeaderCRC'     => $HeaderCRC,
 513         'Flags'         => $flag,
 514         'ExtraFlags'    => $xfl,
 515         'ExtraFieldRaw' => $EXTRA,
 516         'ExtraField'    => [ @EXTRA ],
 517
 518
 519         #'CompSize'=> $compsize,
 520         #'CRC32'=> $CRC32,
 521         #'OrigSize'=> $ISIZE,
 522       }
 523 }
 524
 525 sub _readFullZipHeader($)
 526 {
 527     my ($self) = @_ ;
 528     my $magic = '' ;
 529
 530     $self->smartReadExact(\$magic, 4);
 531
 532     *$self->{HeaderPending} = $magic ;
 533
 534     return $self->HeaderError("Minimum header size is " .
 535                               30 . " bytes")
 536         if length $magic != 4 ;
 537
 538
 539     return $self->HeaderError("Bad Magic")
 540         if ! isZipMagic($magic) ;
 541
 542     my $status = $self->_readZipHeader($magic);
 543     delete *$self->{Transparent} if ! defined $status ;
 544     return $status ;
 545 }
 546
 547 sub _readZipHeader($)
 548 {
 549     my ($self, $magic) = @_ ;
 550     my ($HeaderCRC) ;
 551     my ($buffer) = '' ;
 552
 553     $self->smartReadExact(\$buffer, 30 - 4)
 554         or return $self->HeaderError("Minimum header size is " .
 555                                      30 . " bytes") ;
 556
 557     my $keep = $magic . $buffer ;
 558     *$self->{HeaderPending} = $keep ;
 559
 560     my $extractVersion     = unpack ("v", substr($buffer, 4-4, 2));
 561     my $gpFlag             = unpack ("v", substr($buffer, 6-4, 2));
 562     my $compressedMethod   = unpack ("v", substr($buffer, 8-4, 2));
 563     my $lastModTime        = unpack ("v", substr($buffer, 10-4, 2));
 564     my $lastModDate        = unpack ("v", substr($buffer, 12-4, 2));
 565     my $crc32              = unpack ("v", substr($buffer, 14-4, 4));
 566     my $compressedLength   = unpack ("V", substr($buffer, 18-4, 4));
 567     my $uncompressedLength = unpack ("V", substr($buffer, 22-4, 4));
 568     my $filename_length    = unpack ("v", substr($buffer, 26-4, 2));
 569     my $extra_length       = unpack ("v", substr($buffer, 28-4, 2));
 570
 571     my $filename;
 572     my $extraField;
 573
 574     if ($filename_length)
 575     {
 576         $self->smartReadExact(\$filename, $filename_length)
 577             or return $self->HeaderError("xxx");
 578         $keep .= $filename ;
 579     }
 580
 581     if ($extra_length)
 582     {
 583         $self->smartReadExact(\$extraField, $extra_length)
 584             or return $self->HeaderError("xxx");
 585         $keep .= $extraField ;
 586     }
 587
 588     *$self->{Type} = 'zip';
 589
 590     return {
 591         'Type'          => 'zip',
 592         'HeaderLength'  => length $keep,
 593         'TrailerLength' => $gpFlag & 0x08 ? 16  : 0,
 594         'Header'        => $keep,
 595
 596 #        'MethodID'      => $cm,
 597 #        'MethodName'    => $cm == GZIP_CM_DEFLATED ? "Deflated" : "Unknown" ,
 598 #        'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
 599 #        'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
 600 #        'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
 601 #        'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
 602 #        'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
 603 #        'Name'          => $origname,
 604 #        'Comment'       => $comment,
 605 #        'Time'          => $mtime,
 606 #        'OsID'          => $os,
 607 #        'OsName'        => defined $GZIP_OS_Names{$os}
 608 #                                 ? $GZIP_OS_Names{$os} : "Unknown",
 609 #        'HeaderCRC'     => $HeaderCRC,
 610 #        'Flags'         => $flag,
 611 #        'ExtraFlags'    => $xfl,
 612 #        'ExtraFieldRaw' => $EXTRA,
 613 #        'ExtraField'    => [ @EXTRA ],
 614
 615
 616         #'CompSize'=> $compsize,
 617         #'CRC32'=> $CRC32,
 618         #'OrigSize'=> $ISIZE,
 619       }
 620 }
 621
 622 sub bits
 623 {
 624     my $data   = shift ;
 625     my $offset = shift ;
 626     my $mask  = shift ;
 627
 628     ($data >> $offset ) & $mask & 0xFF ;
 629 }
 630
 631
 632 sub _readDeflateHeader
 633 {
 634     my ($self, $buffer) = @_ ;
 635
 636     if (! $buffer) {
 637         $self->smartReadExact(\$buffer, ZLIB_HEADER_SIZE);
 638
 639         *$self->{HeaderPending} = $buffer ;
 640
 641         return $self->HeaderError("Header size is " .
 642                                             ZLIB_HEADER_SIZE . " bytes")
 643             if length $buffer != ZLIB_HEADER_SIZE;
 644
 645         return $self->HeaderError("CRC mismatch.")
 646             if ! isZlibMagic($buffer) ;
 647     }
 648
 649     my ($CMF, $FLG) = unpack "C C", $buffer;
 650     my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),
 651
 652     my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ;
 653     $cm == ZLIB_CMF_CM_DEFLATED
 654         or return $self->HeaderError("Not Deflate (CM is $cm)") ;
 655
 656     my $DICTID;
 657     if ($FDICT) {
 658         $self->smartReadExact(\$buffer, ZLIB_FDICT_SIZE)
 659             or return $self->TruncatedHeader("FDICT");
 660
 661         $DICTID = unpack("N", $buffer) ;
 662     }
 663
 664     *$self->{Type} = 'rfc1950';
 665
 666     return {
 667         'Type'          => 'rfc1950',
 668         'HeaderLength'  => ZLIB_HEADER_SIZE,
 669         'TrailerLength' => ZLIB_TRAILER_SIZE,
 670         'Header'        => $buffer,
 671
 672         CMF     =>      $CMF                                               ,
 673         CM      => bits($CMF, ZLIB_CMF_CM_OFFSET,     ZLIB_CMF_CM_BITS    ),
 674         CINFO   => bits($CMF, ZLIB_CMF_CINFO_OFFSET,  ZLIB_CMF_CINFO_BITS ),
 675         FLG     =>      $FLG                                               ,
 676         FCHECK  => bits($FLG, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS),
 677         FDICT   => bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),
 678         FLEVEL  => bits($FLG, ZLIB_FLG_LEVEL_OFFSET,  ZLIB_FLG_LEVEL_BITS ),
 679         DICTID  =>      $DICTID                                            ,
 680
 681 };
 682 }
 683
 684
 685 sub checkParams
 686 {
 687     my $class = shift ;
 688     my $type = shift ;
 689
 690
 691     my $Valid = {
 692                     #'Input'        => [Parse_store_ref, undef],
 693
 694                     'BlockSize'     => [Parse_unsigned, 16 * 1024],
 695                     'AutoClose'     => [Parse_boolean,  0],
 696                     'Strict'        => [Parse_boolean,  0],
 697                     #'Lax'           => [Parse_boolean,  1],
 698                     'Append'        => [Parse_boolean,  0],
 699                     'Prime'         => [Parse_any,      undef],
 700                     'MultiStream'   => [Parse_boolean,  0],
 701                     'Transparent'   => [Parse_any,      1],
 702                     'Scan'          => [Parse_boolean,  0],
 703                     'InputLength'   => [Parse_unsigned, undef],
 704
 705                     #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0,
 706                     # ContinueAfterEof
 707                 } ;
 708
 709     $Valid->{'ParseExtra'} = [Parse_boolean,  0]
 710         if $type eq 'rfc1952' ;
 711
 712     my $got = Compress::Zlib::ParseParameters::new();
 713
 714     $got->parse($Valid, @_ )
 715         or croak "$class: $got->{Error}" ;
 716
 717     return $got;
 718 }
 719
 720 sub new
 721 {
 722     my $class = shift ;
 723     my $type = shift ;
 724     my $got = shift;
 725     my $error_ref = shift ;
 726     my $append_mode = shift ;
 727
 728     croak("$class: Missing Input parameter")
 729         if ! @_ && ! $got ;
 730
 731     my $inValue = shift ;
 732
 733     if (! $got)
 734     {
 735         $got = checkParams($class, $type, @_)
 736             or return undef ;
 737     }
 738
 739     my $inType  = whatIsInput($inValue, 1);
 740
 741     ckInputParam($class, $inValue, $error_ref, 1)
 742         or return undef ;
 743
 744     my $obj = bless Symbol::gensym(), ref($class) || $class;
 745     tie *$obj, $obj if $] >= 5.005;
 746
 747
 748     $$error_ref = '' ;
 749     *$obj->{Error} = $error_ref ;
 750     *$obj->{InNew} = 1;
 751
 752     if ($inType eq 'buffer' || $inType eq 'code') {
 753         *$obj->{Buffer} = $inValue ;
 754         *$obj->{InputEvent} = $inValue
 755            if $inType eq 'code' ;
 756     }
 757     else {
 758         if ($inType eq 'handle') {
 759             *$obj->{FH} = $inValue ;
 760             *$obj->{Handle} = 1 ;
 761             # Need to rewind for Scan
 762             #seek(*$obj->{FH}, 0, SEEK_SET) if $got->value('Scan');
 763             *$obj->{FH}->seek(0, SEEK_SET) if $got->value('Scan');
 764         }
 765         else {
 766             my $mode = '<';
 767             $mode = '+<' if $got->value('Scan');
 768             *$obj->{StdIO} = ($inValue eq '-');
 769             *$obj->{FH} = new IO::File "$mode $inValue"
 770                 or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
 771             *$obj->{LineNo} = 0;
 772         }
 773         # Setting STDIN to binmode causes grief
 774         setBinModeInput(*$obj->{FH}) ;
 775
 776         my $buff = "" ;
 777         *$obj->{Buffer} = \$buff ;
 778     }
 779
 780
 781     *$obj->{InputLength}       = $got->parsed('InputLength')
 782                                     ? $got->value('InputLength')
 783                                     : undef ;
 784     *$obj->{InputLengthRemaining} = $got->value('InputLength');
 785     *$obj->{BufferOffset}      = 0 ;
 786     *$obj->{AutoClose}         = $got->value('AutoClose');
 787     *$obj->{Strict}            = $got->value('Strict');
 788     #*$obj->{Strict}            = ! $got->value('Lax');
 789     *$obj->{BlockSize}         = $got->value('BlockSize');
 790     *$obj->{Append}            = $got->value('Append');
 791     *$obj->{AppendOutput}      = $append_mode || $got->value('Append');
 792     *$obj->{Transparent}       = $got->value('Transparent');
 793     *$obj->{MultiStream}       = $got->value('MultiStream');
 794     *$obj->{Scan}              = $got->value('Scan');
 795     *$obj->{ParseExtra}        = $got->value('ParseExtra')
 796                                   || $got->value('Strict')  ;
 797                                   #|| ! $got->value('Lax')  ;
 798     *$obj->{Type}              = $type;
 799     *$obj->{Prime}             = $got->value('Prime') || '' ;
 800     *$obj->{Pending}           = '';
 801     *$obj->{Plain}             = 0;
 802     *$obj->{PlainBytesRead}    = 0;
 803     *$obj->{InflatedBytesRead} = 0;
 804     *$obj->{ISize}             = 0;
 805     *$obj->{TotalInflatedBytesRead} = 0;
 806     *$obj->{NewStream}         = 0 ;
 807     *$obj->{EventEof}          = 0 ;
 808     *$obj->{ClassName}         = $class ;
 809
 810     my $status;
 811
 812     if (*$obj->{Scan})
 813     {
 814         (*$obj->{Inflate}, $status) = new Compress::Zlib::InflateScan
 815                             -CRC32        => $type eq 'rfc1952' ||
 816                                              $type eq 'any',
 817                             -ADLER32      => $type eq 'rfc1950' ||
 818                                              $type eq 'any',
 819                             -WindowBits   => - MAX_WBITS ;
 820     }
 821     else
 822     {
 823         (*$obj->{Inflate}, $status) = new Compress::Zlib::Inflate
 824                             -AppendOutput => 1,
 825                             -CRC32        => $type eq 'rfc1952' ||
 826                                              $type eq 'any',
 827                             -ADLER32      => $type eq 'rfc1950' ||
 828                                              $type eq 'any',
 829                             -WindowBits   => - MAX_WBITS ;
 830     }
 831
 832     return $obj->saveErrorString(undef, "Could not create Inflation object: $status")
 833         if $obj->saveStatus($status) != Z_OK ;
 834
 835     if ($type eq 'rfc1952')
 836     {
 837         *$obj->{Info} = $obj->_readFullGzipHeader() ;
 838     }
 839     elsif ($type eq 'zip')
 840     {
 841         *$obj->{Info} = $obj->_readFullZipHeader() ;
 842     }
 843     elsif ($type eq 'rfc1950')
 844     {
 845         *$obj->{Info} = $obj->_readDeflateHeader() ;
 846     }
 847     elsif ($type eq 'rfc1951')
 848     {
 849         *$obj->{Info} = $obj->_isRaw() ;
 850     }
 851     elsif ($type eq 'any')
 852     {
 853         *$obj->{Info} = $obj->_guessCompression() ;
 854     }
 855
 856     if (! defined *$obj->{Info})
 857     {
 858         return undef unless *$obj->{Transparent};
 859
 860         *$obj->{Type} = 'plain';
 861         *$obj->{Plain} = 1;
 862         *$obj->{PlainBytesRead} = length *$obj->{HeaderPending}  ;
 863     }
 864
 865     push @{ *$obj->{InfoList} }, *$obj->{Info} ;
 866     *$obj->{Pending} = *$obj->{HeaderPending}
 867         if *$obj->{Plain} || *$obj->{Type}  eq 'rfc1951';
 868
 869     $obj->saveStatus(0) ;
 870     *$obj->{InNew} = 0;
 871
 872     return $obj;
 873 }
 874
 875 #sub _inf
 876 #{
 877 #    my $class = shift ;
 878 #    my $type = shift ;
 879 #    my $error_ref = shift ;
 880 #
 881 #    my $name = (caller(1))[3] ;
 882 #
 883 #    croak "$name: expected at least 2 parameters\n"
 884 #        unless @_ >= 2 ;
 885 #
 886 #    my $input = shift ;
 887 #    my $output = shift ;
 888 #
 889 #    ckInOutParams($name, $input, $output, $error_ref)
 890 #        or return undef ;
 891 #
 892 #    my $outType = whatIs($output);
 893 #
 894 #    my $gunzip = new($class, $type, $error_ref, 1, $input, @_)
 895 #        or return undef ;
 896 #
 897 #    my $fh ;
 898 #    if ($outType eq 'filename') {
 899 #        my $mode = '>' ;
 900 #        $mode = '>>'
 901 #            if *$gunzip->{Append} ;
 902 #        $fh = new IO::File "$mode $output"
 903 #            or return $gunzip->saveErrorString(undef, "cannot open file '$output': $!", $!) ;
 904 #    }
 905 #
 906 #    if ($outType eq 'handle') {
 907 #        $fh = $output;
 908 #        if (*$gunzip->{Append}) {
 909 #            seek($fh, 0, SEEK_END)
 910 #                or return $gunzip->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
 911 #        }
 912 #    }
 913 #
 914 #    my $buff = '' ;
 915 #    $buff = $output if $outType eq 'buffer' ;
 916 #    my $status ;
 917 #    while (($status = $gunzip->read($buff)) > 0) {
 918 #        if ($fh) {
 919 #            print $fh $buff
 920 #                or return $gunzip->saveErrorString(undef, "Error writing to output file: $!", $!);
 921 #        }
 922 #    }
 923 #
 924 #    return undef
 925 #        if $status < 0 ;
 926 #
 927 #    $gunzip->close()
 928 #        or return undef ;
 929 #
 930 #    if (  $outType eq 'filename' ||
 931 #         ($outType eq 'handle' && *$gunzip->{AutoClose})) {
 932 #        $fh->close()
 933 #            or return $gunzip->saveErrorString(undef, $!, $!);
 934 #    }
 935 #
 936 #    return 1 ;
 937 #}
 938
 939 sub _inf
 940 {
 941     my $class = shift ;
 942     my $type = shift ;
 943     my $error_ref = shift ;
 944
 945     my $name = (caller(1))[3] ;
 946
 947     croak "$name: expected at least 1 parameters\n"
 948         unless @_ >= 1 ;
 949
 950     my $input = shift ;
 951     my $haveOut = @_ ;
 952     my $output = shift ;
 953
 954     my $x = new Validator($class, $type, $error_ref, $name, $input, $output)
 955         or return undef ;
 956
 957     push @_, $output if $haveOut && $x->{Hash};
 958
 959     my $got = checkParams($name, $type, @_)
 960         or return undef ;
 961
 962     $x->{Got} = $got ;
 963
 964     if ($x->{Hash})
 965     {
 966         while (my($k, $v) = each %$input)
 967         {
 968             $v = \$input->{$k}
 969                 unless defined $v ;
 970
 971             _singleTarget($x, 1, $k, $v, @_)
 972                 or return undef ;
 973         }
 974
 975         return keys %$input ;
 976     }
 977
 978     if ($x->{GlobMap})
 979     {
 980         $x->{oneInput} = 1 ;
 981         foreach my $pair (@{ $x->{Pairs} })
 982         {
 983             my ($from, $to) = @$pair ;
 984             _singleTarget($x, 1, $from, $to, @_)
 985                 or return undef ;
 986         }
 987
 988         return scalar @{ $x->{Pairs} } ;
 989     }
 990
 991     #if ($x->{outType} eq 'array' || $x->{outType} eq 'hash')
 992     if (! $x->{oneOutput} )
 993     {
 994         my $inFile = ($x->{inType} eq 'filenames'
 995                         || $x->{inType} eq 'filename');
 996
 997         $x->{inType} = $inFile ? 'filename' : 'buffer';
 998         my $ot = $x->{outType} ;
 999         $x->{outType} = 'buffer';
1000
1001         foreach my $in ($x->{oneInput} ? $input : @$input)
1002         {
1003             my $out ;
1004             $x->{oneInput} = 1 ;
1005
1006             _singleTarget($x, $inFile, $in, \$out, @_)
1007                 or return undef ;
1008
1009             if ($ot eq 'array')
1010               { push @$output, \$out }
1011             else
1012               { $output->{$in} = \$out }
1013         }
1014
1015         return 1 ;
1016     }
1017
1018     # finally the 1 to 1 and n to 1
1019     return _singleTarget($x, 1, $input, $output, @_);
1020
1021     croak "should not be here" ;
1022 }
1023
1024 sub retErr
1025 {
1026     my $x = shift ;
1027     my $string = shift ;
1028
1029     ${ $x->{Error} } = $string ;
1030
1031     return undef ;
1032 }
1033
1034 sub _singleTarget
1035 {
1036     my $x         = shift ;
1037     my $inputIsFilename = shift;
1038     my $input     = shift;
1039     my $output    = shift;
1040
1041     $x->{buff} = '' ;
1042
1043     my $fh ;
1044     if ($x->{outType} eq 'filename') {
1045         my $mode = '>' ;
1046         $mode = '>>'
1047             if $x->{Got}->value('Append') ;
1048         $x->{fh} = new IO::File "$mode $output"
1049             or return retErr($x, "cannot open file '$output': $!") ;
1050         setBinModeOutput($x->{fh});
1051
1052     }
1053
1054     elsif ($x->{outType} eq 'handle') {
1055         $x->{fh} = $output;
1056         setBinModeOutput($x->{fh});
1057         if ($x->{Got}->value('Append')) {
1058                 seek($x->{fh}, 0, SEEK_END)
1059                     or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
1060             }
1061     }
1062
1063
1064     elsif ($x->{outType} eq 'buffer' )
1065     {
1066         $$output = ''
1067             unless $x->{Got}->value('Append');
1068         $x->{buff} = $output ;
1069     }
1070
1071     if ($x->{oneInput})
1072     {
1073         defined _rd2($x, $input, $inputIsFilename)
1074             or return undef;
1075     }
1076     else
1077     {
1078         my $inputIsFilename = ($x->{inType} ne 'array');
1079
1080         for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
1081         {
1082             defined _rd2($x, $element, $inputIsFilename)
1083                 or return undef ;
1084         }
1085     }
1086
1087
1088     if ( ($x->{outType} eq 'filename' && $output ne '-') ||
1089          ($x->{outType} eq 'handle' && $x->{Got}->value('AutoClose'))) {
1090         $x->{fh}->close()
1091             or return retErr($x, $!);
1092             #or return $gunzip->saveErrorString(undef, $!, $!);
1093         delete $x->{fh};
1094     }
1095
1096     return 1 ;
1097 }
1098
1099 sub _rd2
1100 {
1101     my $x         = shift ;
1102     my $input     = shift;
1103     my $inputIsFilename = shift;
1104
1105     my $gunzip = new($x->{Class}, $x->{Type}, $x->{Got}, $x->{Error}, 1, $input, @_)
1106         or return undef ;
1107
1108     my $status ;
1109     my $fh = $x->{fh};
1110
1111     while (($status = $gunzip->read($x->{buff})) > 0) {
1112         if ($fh) {
1113             print $fh $x->{buff}
1114                 or return $gunzip->saveErrorString(undef, "Error writing to output file: $!", $!);
1115             $x->{buff} = '' ;
1116         }
1117     }
1118
1119     return undef
1120         if $status < 0 ;
1121
1122     $gunzip->close()
1123         or return undef ;
1124
1125     return 1 ;
1126 }
1127
1128 sub TIEHANDLE
1129 {
1130     return $_[0] if ref($_[0]);
1131     die "OOPS\n" ;
1132
1133 }
1134
1135 sub UNTIE
1136 {
1137     my $self = shift ;
1138 }
1139
1140
1141 sub getHeaderInfo
1142 {
1143     my $self = shift ;
1144     return *$self->{Info};
1145 }
1146
1147 sub _raw_read
1148 {
1149     # return codes
1150     # >0 - ok, number of bytes read
1151     # =0 - ok, eof
1152     # <0 - not ok
1153
1154     my $self = shift ;
1155
1156     return G_EOF if *$self->{Closed} ;
1157     #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
1158     return G_EOF if *$self->{EndStream} ;
1159
1160     my $buffer = shift ;
1161     my $scan_mode = shift ;
1162
1163     if (*$self->{Plain}) {
1164         my $tmp_buff ;
1165         my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ;
1166
1167         return $self->saveErrorString(G_ERR, "Error reading data: $!", $!)
1168                 if $len < 0 ;
1169
1170         if ($len == 0 ) {
1171             *$self->{EndStream} = 1 ;
1172         }
1173         else {
1174             *$self->{PlainBytesRead} += $len ;
1175             $$buffer .= $tmp_buff;
1176         }
1177
1178         return $len ;
1179     }
1180
1181     if (*$self->{NewStream}) {
1182         *$self->{NewStream} = 0 ;
1183         *$self->{EndStream} = 0 ;
1184         *$self->{Inflate}->inflateReset();
1185
1186         if (*$self->{Type} eq 'rfc1952')
1187         {
1188             *$self->{Info} = $self->_readFullGzipHeader() ;
1189         }
1190         elsif (*$self->{Type} eq 'zip')
1191         {
1192             *$self->{Info} = $self->_readFullZipHeader() ;
1193         }
1194         elsif (*$self->{Type} eq 'rfc1950')
1195         {
1196             *$self->{Info} = $self->_readDeflateHeader() ;
1197         }
1198         elsif (*$self->{Type} eq 'rfc1951')
1199         {
1200             *$self->{Info} = $self->_isRaw() ;
1201             *$self->{Pending} = *$self->{HeaderPending}
1202                 if defined *$self->{Info} ;
1203         }
1204
1205         return G_ERR unless defined *$self->{Info} ;
1206
1207         push @{ *$self->{InfoList} }, *$self->{Info} ;
1208
1209         if (*$self->{Type} eq 'rfc1951') {
1210             $$buffer .=  *$self->{Pending} ;
1211             my $len = length  *$self->{Pending} ;
1212             *$self->{Pending} = '';
1213             return $len;
1214         }
1215     }
1216
1217     my $temp_buf ;
1218     my $status = $self->smartRead(\$temp_buf, *$self->{BlockSize}) ;
1219     return $self->saveErrorString(G_ERR, "Error Reading Data")
1220         if $status < 0  ;
1221
1222     if ($status == 0 ) {
1223         *$self->{Closed} = 1 ;
1224         *$self->{EndStream} = 1 ;
1225         return $self->saveErrorString(G_ERR, "unexpected end of file", Z_DATA_ERROR);
1226     }
1227
1228     my $before_len = defined $$buffer ? length $$buffer : 0 ;
1229     $status = *$self->{Inflate}->inflate(\$temp_buf, $buffer) ;
1230
1231     return $self->saveErrorString(G_ERR, "Inflation Error: $status")
1232         unless $self->saveStatus($status) == Z_OK || $status == Z_STREAM_END ;
1233
1234     my $buf_len = *$self->{Inflate}->inflateCount();
1235
1236     # zlib before 1.2 needs an extra byte after the compressed data
1237     # for RawDeflate
1238     if ($status == Z_OK && *$self->{Type} eq 'rfc1951' && $self->smartEof()) {
1239         my $byte = ' ';
1240         $status = *$self->{Inflate}->inflate(\$byte, $buffer) ;
1241
1242         $buf_len += *$self->{Inflate}->inflateCount();
1243
1244         return $self->saveErrorString(G_ERR, "Inflation Error: $status")
1245             unless $self->saveStatus($status) == Z_OK || $status == Z_STREAM_END ;
1246     }
1247
1248
1249     return $self->saveErrorString(G_ERR, "unexpected end of file", Z_DATA_ERROR)
1250         if $status != Z_STREAM_END && $self->smartEof() ;
1251
1252     *$self->{InflatedBytesRead} += $buf_len ;
1253     *$self->{TotalInflatedBytesRead} += $buf_len ;
1254     my $rest = GZIP_ISIZE_MAX - *$self->{ISize} ;
1255     if ($buf_len > $rest) {
1256         *$self->{ISize} = $buf_len - $rest - 1;
1257     }
1258     else {
1259         *$self->{ISize} += $buf_len ;
1260     }
1261
1262     if ($status == Z_STREAM_END) {
1263
1264         *$self->{EndStream} = 1 ;
1265
1266         if (*$self->{Type} eq 'rfc1951' || ! *$self->{Info}{TrailerLength})
1267         {
1268             *$self->{Trailing} = $temp_buf . $self->getTrailingBuffer();
1269         }
1270         else
1271         {
1272             # Only rfc1950 & 1952 have a trailer
1273
1274             my $trailer_size = *$self->{Info}{TrailerLength} ;
1275
1276             #if ($scan_mode) {
1277             #    my $offset = *$self->{Inflate}->getLastBufferOffset();
1278             #    substr($temp_buf, 0, $offset) = '' ;
1279             #}
1280
1281             if (length $temp_buf < $trailer_size) {
1282                 my $buff;
1283                 my $want = $trailer_size - length $temp_buf;
1284                 my $got = $self->smartRead(\$buff, $want) ;
1285                 if ($got != $want && *$self->{Strict} ) {
1286                     my $len = length($temp_buf) + length($buff);
1287                     return $self->TrailerError("trailer truncated. Expected " .
1288                       "$trailer_size bytes, got $len");
1289                 }
1290                 $temp_buf .= $buff;
1291             }
1292
1293             if (length $temp_buf >= $trailer_size) {
1294
1295                 #my $trailer = substr($temp_buf, 0, $trailer_size, '') ;
1296                 my $trailer = substr($temp_buf, 0, $trailer_size) ;
1297                 substr($temp_buf, 0, $trailer_size) = '' ;
1298
1299                 if (*$self->{Type} eq 'rfc1952') {
1300                     # Check CRC & ISIZE
1301                     my ($CRC32, $ISIZE) = unpack("V V", $trailer) ;
1302                     *$self->{Info}{CRC32} = $CRC32;
1303                     *$self->{Info}{ISIZE} = $ISIZE;
1304
1305                     if (*$self->{Strict}) {
1306                         return $self->TrailerError("CRC mismatch")
1307                             if $CRC32 != *$self->{Inflate}->crc32() ;
1308
1309                         my $exp_isize = *$self->{ISize};
1310                         return $self->TrailerError("ISIZE mismatch. Got $ISIZE"
1311                                                   . ", expected $exp_isize")
1312                             if $ISIZE != $exp_isize ;
1313                     }
1314                 }
1315                 elsif (*$self->{Type} eq 'zip') {
1316                     # Check CRC & ISIZE
1317                     my ($sig, $CRC32, $cSize, $uSize) = unpack("V V V V", $trailer) ;
1318                     return $self->TrailerError("Data Descriptor signature")
1319                         if $sig != 0x08074b50;
1320
1321                     if (*$self->{Strict}) {
1322                         return $self->TrailerError("CRC mismatch")
1323                             if $CRC32 != *$self->{Inflate}->crc32() ;
1324
1325                     }
1326                 }
1327                 elsif (*$self->{Type} eq 'rfc1950') {
1328                     my $ADLER32 = unpack("N", $trailer) ;
1329                     *$self->{Info}{ADLER32} = $ADLER32;
1330                     return $self->TrailerError("CRC mismatch")
1331                         if *$self->{Strict} && $ADLER32 != *$self->{Inflate}->adler32() ;
1332
1333                 }
1334
1335                 if (*$self->{MultiStream}
1336                         && (length $temp_buf || ! $self->smartEof())){
1337                     *$self->{NewStream} = 1 ;
1338                     *$self->{EndStream} = 0 ;
1339                     *$self->{Prime} = $temp_buf  . *$self->{Prime} ;
1340                     return $buf_len ;
1341                 }
1342             }
1343
1344             *$self->{Trailing} = $temp_buf .$self->getTrailingBuffer();
1345         }
1346     }
1347
1348
1349     # return the number of uncompressed bytes read
1350     return $buf_len ;
1351 }
1352
1353 #sub isEndStream
1354 #{
1355 #    my $self = shift ;
1356 #    return *$self->{NewStream} ||
1357 #           *$self->{EndStream} ;
1358 #}
1359
1360 sub streamCount
1361 {
1362     my $self = shift ;
1363     return 1 if ! defined *$self->{InfoList};
1364     return scalar @{ *$self->{InfoList} }  ;
1365 }
1366
1367 sub read
1368 {
1369     # return codes
1370     # >0 - ok, number of bytes read
1371     # =0 - ok, eof
1372     # <0 - not ok
1373
1374     my $self = shift ;
1375
1376     return G_EOF if *$self->{Closed} ;
1377     return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
1378
1379     my $buffer ;
1380
1381     #croak(*$self->{ClassName} . "::read: buffer parameter is read-only")
1382     #    if Compress::Zlib::_readonly_ref($_[0]);
1383
1384     if (ref $_[0] ) {
1385         croak(*$self->{ClassName} . "::read: buffer parameter is read-only")
1386             if readonly(${ $_[0] });
1387
1388         croak *$self->{ClassName} . "::read: not a scalar reference $_[0]"
1389             unless ref $_[0] eq 'SCALAR' ;
1390         $buffer = $_[0] ;
1391     }
1392     else {
1393         croak(*$self->{ClassName} . "::read: buffer parameter is read-only")
1394             if readonly($_[0]);
1395
1396         $buffer = \$_[0] ;
1397     }
1398
1399     my $length = $_[1] ;
1400     my $offset = $_[2] || 0;
1401
1402     # the core read will return 0 if asked for 0 bytes
1403     return 0 if defined $length && $length == 0 ;
1404
1405     $length = $length || 0;
1406
1407     croak(*$self->{ClassName} . "::read: length parameter is negative")
1408         if $length < 0 ;
1409
1410     $$buffer = '' unless *$self->{AppendOutput}  || $offset ;
1411
1412     # Short-circuit if this is a simple read, with no length
1413     # or offset specified.
1414     unless ( $length || $offset) {
1415         if (length *$self->{Pending}) {
1416             $$buffer .= *$self->{Pending} ;
1417             my $len = length *$self->{Pending};
1418             *$self->{Pending} = '' ;
1419             return $len ;
1420         }
1421         else {
1422             my $len = 0;
1423             $len = $self->_raw_read($buffer)
1424                 while ! *$self->{EndStream} && $len == 0 ;
1425             return $len ;
1426         }
1427     }
1428
1429     # Need to jump through more hoops - either length or offset
1430     # or both are specified.
1431     #*$self->{Pending} = '' if ! length *$self->{Pending} ;
1432     my $out_buffer = \*$self->{Pending} ;
1433
1434     while (! *$self->{EndStream} && length($$out_buffer) < $length)
1435     {
1436         my $buf_len = $self->_raw_read($out_buffer);
1437         return $buf_len
1438             if $buf_len < 0 ;
1439     }
1440
1441     $length = length $$out_buffer
1442         if length($$out_buffer) < $length ;
1443
1444     if ($offset) {
1445         $$buffer .= "\x00" x ($offset - length($$buffer))
1446             if $offset > length($$buffer) ;
1447         #substr($$buffer, $offset) = substr($$out_buffer, 0, $length, '') ;
1448         substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
1449         substr($$out_buffer, 0, $length) =  '' ;
1450     }
1451     else {
1452         #$$buffer .= substr($$out_buffer, 0, $length, '') ;
1453         $$buffer .= substr($$out_buffer, 0, $length) ;
1454         substr($$out_buffer, 0, $length) =  '' ;
1455     }
1456
1457     return $length ;
1458 }
1459
1460 sub _getline
1461 {
1462     my $self = shift ;
1463
1464     # Slurp Mode
1465     if ( ! defined $/ ) {
1466         my $data ;
1467         1 while $self->read($data) > 0 ;
1468         return \$data ;
1469     }
1470
1471     # Paragraph Mode
1472     if ( ! length $/ ) {
1473         my $paragraph ;
1474         while ($self->read($paragraph) > 0 ) {
1475             if ($paragraph =~ s/^(.*?\n\n+)//s) {
1476                 *$self->{Pending}  = $paragraph ;
1477                 my $par = $1 ;
1478               return \$par ;
1479             }
1480         }
1481         return \$paragraph;
1482     }
1483
1484     # Line Mode
1485     {
1486         my $line ;
1487         my $endl = quotemeta($/); # quote in case $/ contains RE meta chars
1488         while ($self->read($line) > 0 ) {
1489             if ($line =~ s/^(.*?$endl)//s) {
1490                 *$self->{Pending} = $line ;
1491                 $. = ++ *$self->{LineNo} ;
1492                 my $l = $1 ;
1493                 return \$l ;
1494             }
1495         }
1496         $. = ++ *$self->{LineNo} if defined($line);
1497         return \$line;
1498     }
1499 }
1500
1501 sub getline
1502 {
1503     my $self = shift;
1504     my $current_append = *$self->{AppendOutput} ;
1505     *$self->{AppendOutput} = 1;
1506     my $lineref = $self->_getline();
1507     *$self->{AppendOutput} = $current_append;
1508     return $$lineref ;
1509 }
1510
1511 sub getlines
1512 {
1513     my $self = shift;
1514     croak *$self->{ClassName} . "::getlines: called in scalar context\n" unless wantarray;
1515     my($line, @lines);
1516     push(@lines, $line) while defined($line = $self->getline);
1517     return @lines;
1518 }
1519
1520 sub READLINE
1521 {
1522     goto &getlines if wantarray;
1523     goto &getline;
1524 }
1525
1526 sub getc
1527 {
1528     my $self = shift;
1529     my $buf;
1530     return $buf if $self->read($buf, 1);
1531     return undef;
1532 }
1533
1534 sub ungetc
1535 {
1536     my $self = shift;
1537     *$self->{Pending} = ""  unless defined *$self->{Pending} ;
1538     *$self->{Pending} = $_[0] . *$self->{Pending} ;
1539 }
1540
1541
1542 sub trailingData
1543 {
1544     my $self = shift ;
1545     return \"" if ! defined *$self->{Trailing} ;
1546     return \*$self->{Trailing} ;
1547 }
1548
1549 sub inflateSync
1550 {
1551     my $self = shift ;
1552
1553     # inflateSync is a no-op in Plain mode
1554     return 1
1555         if *$self->{Plain} ;
1556
1557     return 0 if *$self->{Closed} ;
1558     #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
1559     return 0 if ! length *$self->{Pending} && *$self->{EndStream} ;
1560
1561     # Disable CRC check
1562     *$self->{Strict} = 0 ;
1563
1564     my $status ;
1565     while (1)
1566     {
1567         my $temp_buf ;
1568
1569         if (length *$self->{Pending} )
1570         {
1571             $temp_buf = *$self->{Pending} ;
1572             *$self->{Pending} = '';
1573         }
1574         else
1575         {
1576             $status = $self->smartRead(\$temp_buf, *$self->{BlockSize}) ;
1577             return $self->saveErrorString(0, "Error Reading Data")
1578                 if $status < 0  ;
1579
1580             if ($status == 0 ) {
1581                 *$self->{EndStream} = 1 ;
1582                 return $self->saveErrorString(0, "unexpected end of file", Z_DATA_ERROR);
1583             }
1584         }
1585
1586         $status = *$self->{Inflate}->inflateSync($temp_buf) ;
1587
1588         if ($status == Z_OK)
1589         {
1590             *$self->{Pending} .= $temp_buf ;
1591             return 1 ;
1592         }
1593
1594         last unless $status = Z_DATA_ERROR ;
1595     }
1596
1597     return 0;
1598 }
1599
1600 sub eof
1601 {
1602     my $self = shift ;
1603
1604     return (*$self->{Closed} ||
1605               (!length *$self->{Pending}
1606                 && ( $self->smartEof() || *$self->{EndStream}))) ;
1607 }
1608
1609 sub tell
1610 {
1611     my $self = shift ;
1612
1613     my $in ;
1614     if (*$self->{Plain}) {
1615         $in = *$self->{PlainBytesRead} ;
1616     }
1617     else {
1618         $in = *$self->{TotalInflatedBytesRead} ;
1619     }
1620
1621     my $pending = length *$self->{Pending} ;
1622
1623     return 0 if $pending > $in ;
1624     return $in - $pending ;
1625 }
1626
1627 sub close
1628 {
1629     # todo - what to do if close is called before the end of the gzip file
1630     #        do we remember any trailing data?
1631     my $self = shift ;
1632
1633     return 1 if *$self->{Closed} ;
1634
1635     untie *$self
1636         if $] >= 5.008 ;
1637
1638     my $status = 1 ;
1639
1640     if (defined *$self->{FH}) {
1641         if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
1642         #if ( *$self->{AutoClose}) {
1643             $! = 0 ;
1644             $status = *$self->{FH}->close();
1645             return $self->saveErrorString(0, $!, $!)
1646                 if !*$self->{InNew} && $self->saveStatus($!) != 0 ;
1647         }
1648         delete *$self->{FH} ;
1649         $! = 0 ;
1650     }
1651     *$self->{Closed} = 1 ;
1652
1653     return 1;
1654 }
1655
1656 sub DESTROY
1657 {
1658     my $self = shift ;
1659     $self->close() ;
1660 }
1661
1662 sub seek
1663 {
1664     my $self     = shift ;
1665     my $position = shift;
1666     my $whence   = shift ;
1667
1668     my $here = $self->tell() ;
1669     my $target = 0 ;
1670
1671
1672     if ($whence == SEEK_SET) {
1673         $target = $position ;
1674     }
1675     elsif ($whence == SEEK_CUR) {
1676         $target = $here + $position ;
1677     }
1678     elsif ($whence == SEEK_END) {
1679         $target = $position ;
1680         croak *$self->{ClassName} . "::seek: SEEK_END not allowed" ;
1681     }
1682     else {
1683         croak *$self->{ClassName} ."::seek: unknown value, $whence, for whence parameter";
1684     }
1685
1686     # short circuit if seeking to current offset
1687     return 1 if $target == $here ;
1688
1689     # Outlaw any attempt to seek backwards
1690     croak *$self->{ClassName} ."::seek: cannot seek backwards"
1691         if $target < $here ;
1692
1693     # Walk the file to the new offset
1694     my $offset = $target - $here ;
1695
1696     my $buffer ;
1697     $self->read($buffer, $offset) == $offset
1698         or return 0 ;
1699
1700     return 1 ;
1701 }
1702
1703 sub fileno
1704 {
1705     my $self = shift ;
1706     return defined *$self->{FH}
1707            ? fileno *$self->{FH}
1708            : undef ;
1709 }
1710
1711 sub binmode
1712 {
1713     1;
1714 #    my $self     = shift ;
1715 #    return defined *$self->{FH}
1716 #            ? binmode *$self->{FH}
1717 #            : 1 ;
1718 }
1719
1720 *BINMODE  = \&binmode;
1721 *SEEK     = \&seek;
1722 *READ     = \&read;
1723 *sysread  = \&read;
1724 *TELL     = \&tell;
1725 *EOF      = \&eof;
1726
1727 *FILENO   = \&fileno;
1728 *CLOSE    = \&close;
1729
1730 sub _notAvailable
1731 {
1732     my $name = shift ;
1733     #return sub { croak "$name Not Available" ; } ;
1734     return sub { croak "$name Not Available: File opened only for intput" ; } ;
1735 }
1736
1737
1738 *print    = _notAvailable('print');
1739 *PRINT    = _notAvailable('print');
1740 *printf   = _notAvailable('printf');
1741 *PRINTF   = _notAvailable('printf');
1742 *write    = _notAvailable('write');
1743 *WRITE    = _notAvailable('write');
1744
1745 #*sysread  = \&read;
1746 #*syswrite = \&_notAvailable;
1747
1748 #package IO::_infScan ;
1749 #
1750 #*_raw_read = \&IO::BaseInflate::_raw_read ;
1751 #*smartRead = \&IO::BaseInflate::smartRead ;
1752 #*smartWrite = \&IO::BaseInflate::smartWrite ;
1753 #*smartSeek = \&IO::BaseInflate::smartSeek ;
1754
1755 sub scan
1756 {
1757     my $self = shift ;
1758
1759     return 1 if *$self->{Closed} ;
1760     return 1 if !length *$self->{Pending} && *$self->{EndStream} ;
1761
1762     my $buffer = '' ;
1763     my $len = 0;
1764
1765     $len = $self->_raw_read(\$buffer, 1)
1766         while ! *$self->{EndStream} && $len >= 0 ;
1767
1768     #return $len if $len < 0 ? $len : 0 ;
1769     return $len < 0 ? 0 : 1 ;
1770 }
1771
1772 sub zap
1773 {
1774     my $self  = shift ;
1775
1776     my $headerLength = *$self->{Info}{HeaderLength};
1777     my $block_offset =  $headerLength + *$self->{Inflate}->getLastBlockOffset();
1778     $_[0] = $headerLength + *$self->{Inflate}->getEndOffset();
1779     #printf "# End $_[0], headerlen $headerLength \n";;
1780
1781     #printf "# block_offset $block_offset %x\n", $block_offset;
1782     my $byte ;
1783     ( $self->smartSeek($block_offset) &&
1784       $self->smartRead(\$byte, 1) )
1785         or return $self->saveErrorString(0, $!, $!);
1786
1787     #printf "#byte is %x\n", unpack('C*',$byte);
1788     *$self->{Inflate}->resetLastBlockByte($byte);
1789     #printf "#to byte is %x\n", unpack('C*',$byte);
1790
1791     ( $self->smartSeek($block_offset) &&
1792       $self->smartWrite($byte) )
1793         or return $self->saveErrorString(0, $!, $!);
1794
1795     #$self->smartSeek($end_offset, 1);
1796
1797     return 1 ;
1798 }
1799
1800 sub createDeflate
1801 {
1802     my $self  = shift ;
1803     my ($status, $def) = *$self->{Inflate}->createDeflateStream(
1804                                     -AppendOutput   => 1,
1805                                     -WindowBits => - MAX_WBITS,
1806                                     -CRC32      => *$self->{Type} eq 'rfc1952'
1807                                             || *$self->{Type} eq 'zip',
1808                                     -ADLER32    => *$self->{Type} eq 'rfc1950',
1809                                 );
1810
1811     return wantarray ? ($status, $def) : $def ;
1812 }
1813
1814
1815 package IO::Uncompress::Gunzip ;
1816
1817 1 ;
1818 __END__
1819
1820
1821 =head1 NAME
1822
1823 IO::Uncompress::Gunzip - Perl interface to read RFC 1952 files/buffers
1824
1825 =head1 SYNOPSIS
1826
1827     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
1828
1829     my $status = gunzip $input => $output [,OPTS]
1830         or die "gunzip failed: $GunzipError\n";
1831
1832     my $z = new IO::Uncompress::Gunzip $input [OPTS]
1833         or die "gunzip failed: $GunzipError\n";
1834
1835     $status = $z->read($buffer)
1836     $status = $z->read($buffer, $length)
1837     $status = $z->read($buffer, $length, $offset)
1838     $line = $z->getline()
1839     $char = $z->getc()
1840     $char = $z->ungetc()
1841     $status = $z->inflateSync()
1842     $z->trailingData()
1843     $data = $z->getHeaderInfo()
1844     $z->tell()
1845     $z->seek($position, $whence)
1846     $z->binmode()
1847     $z->fileno()
1848     $z->eof()
1849     $z->close()
1850
1851     $GunzipError ;
1852
1853     # IO::File mode
1854
1855     <$z>
1856     read($z, $buffer);
1857     read($z, $buffer, $length);
1858     read($z, $buffer, $length, $offset);
1859     tell($z)
1860     seek($z, $position, $whence)
1861     binmode($z)
1862     fileno($z)
1863     eof($z)
1864     close($z)
1865
1866
1867 =head1 DESCRIPTION
1868
1869
1870
1871 B<WARNING -- This is a Beta release>.
1872
1873 =over 5
1874
1875 =item * DO NOT use in production code.
1876
1877 =item * The documentation is incomplete in places.
1878
1879 =item * Parts of the interface defined here are tentative.
1880
1881 =item * Please report any problems you find.
1882
1883 =back
1884
1885
1886
1887
1888
1889 This module provides a Perl interface that allows the reading of
1890 files/buffers that conform to RFC 1952.
1891
1892 For writing RFC 1952 files/buffers, see the companion module
1893 IO::Compress::Gzip.
1894
1895
1896
1897 =head1 Functional Interface
1898
1899 A top-level function, C<gunzip>, is provided to carry out "one-shot"
1900 uncompression between buffers and/or files. For finer control over the uncompression process, see the L</"OO Interface"> section.
1901
1902     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
1903
1904     gunzip $input => $output [,OPTS]
1905         or die "gunzip failed: $GunzipError\n";
1906
1907     gunzip \%hash [,OPTS]
1908         or die "gunzip failed: $GunzipError\n";
1909
1910 The functional interface needs Perl5.005 or better.
1911
1912
1913 =head2 gunzip $input => $output [, OPTS]
1914
1915 If the first parameter is not a hash reference C<gunzip> expects
1916 at least two parameters, C<$input> and C<$output>.
1917
1918 =head3 The C<$input> parameter
1919
1920 The parameter, C<$input>, is used to define the source of
1921 the compressed data.
1922
1923 It can take one of the following forms:
1924
1925 =over 5
1926
1927 =item A filename
1928
1929 If the C<$input> parameter is a simple scalar, it is assumed to be a
1930 filename. This file will be opened for reading and the input data
1931 will be read from it.
1932
1933 =item A filehandle
1934
1935 If the C<$input> parameter is a filehandle, the input data will be
1936 read from it.
1937 The string '-' can be used as an alias for standard input.
1938
1939 =item A scalar reference
1940
1941 If C<$input> is a scalar reference, the input data will be read
1942 from C<$$input>.
1943
1944 =item An array reference
1945
1946 If C<$input> is an array reference, the input data will be read from each
1947 element of the array in turn. The action taken by C<gunzip> with
1948 each element of the array will depend on the type of data stored
1949 in it. You can mix and match any of the types defined in this list,
1950 excluding other array or hash references.
1951 The complete array will be walked to ensure that it only
1952 contains valid data types before any data is uncompressed.
1953
1954 =item An Input FileGlob string
1955
1956 If C<$input> is a string that is delimited by the characters "<" and ">"
1957 C<gunzip> will assume that it is an I<input fileglob string>. The
1958 input is the list of files that match the fileglob.
1959
1960 If the fileglob does not match any files ...
1961
1962 See L<File::GlobMapper|File::GlobMapper> for more details.
1963
1964
1965 =back
1966
1967 If the C<$input> parameter is any other type, C<undef> will be returned.
1968
1969
1970
1971 =head3 The C<$output> parameter
1972
1973 The parameter C<$output> is used to control the destination of the
1974 uncompressed data. This parameter can take one of these forms.
1975
1976 =over 5
1977
1978 =item A filename
1979
1980 If the C<$output> parameter is a simple scalar, it is assumed to be a filename.
1981 This file will be opened for writing and the uncompressed data will be
1982 written to it.
1983
1984 =item A filehandle
1985
1986 If the C<$output> parameter is a filehandle, the uncompressed data will
1987 be written to it.
1988 The string '-' can be used as an alias for standard output.
1989
1990
1991 =item A scalar reference
1992
1993 If C<$output> is a scalar reference, the uncompressed data will be stored
1994 in C<$$output>.
1995
1996
1997 =item A Hash Reference
1998
1999 If C<$output> is a hash reference, the uncompressed data will be written
2000 to C<$output{$input}> as a scalar reference.
2001
2002 When C<$output> is a hash reference, C<$input> must be either a filename or
2003 list of filenames. Anything else is an error.
2004
2005
2006 =item An Array Reference
2007
2008 If C<$output> is an array reference, the uncompressed data will be pushed
2009 onto the array.
2010
2011 =item An Output FileGlob
2012
2013 If C<$output> is a string that is delimited by the characters "<" and ">"
2014 C<gunzip> will assume that it is an I<output fileglob string>. The
2015 output is the list of files that match the fileglob.
2016
2017 When C<$output> is an fileglob string, C<$input> must also be a fileglob
2018 string. Anything else is an error.
2019
2020 =back
2021
2022 If the C<$output> parameter is any other type, C<undef> will be returned.
2023
2024 =head2 gunzip \%hash [, OPTS]
2025
2026 If the first parameter is a hash reference, C<\%hash>, this will be used to
2027 define both the source of compressed data and to control where the
2028 uncompressed data is output. Each key/value pair in the hash defines a
2029 mapping between an input filename, stored in the key, and an output
2030 file/buffer, stored in the value. Although the input can only be a filename,
2031 there is more flexibility to control the destination of the uncompressed
2032 data. This is determined by the type of the value. Valid types are
2033
2034 =over 5
2035
2036 =item undef
2037
2038 If the value is C<undef> the uncompressed data will be written to the
2039 value as a scalar reference.
2040
2041 =item A filename
2042
2043 If the value is a simple scalar, it is assumed to be a filename. This file will
2044 be opened for writing and the uncompressed data will be written to it.
2045
2046 =item A filehandle
2047
2048 If the value is a filehandle, the uncompressed data will be
2049 written to it.
2050 The string '-' can be used as an alias for standard output.
2051
2052
2053 =item A scalar reference
2054
2055 If the value is a scalar reference, the uncompressed data will be stored
2056 in the buffer that is referenced by the scalar.
2057
2058
2059 =item A Hash Reference
2060
2061 If the value is a hash reference, the uncompressed data will be written
2062 to C<$hash{$input}> as a scalar reference.
2063
2064 =item An Array Reference
2065
2066 If C<$output> is an array reference, the uncompressed data will be pushed
2067 onto the array.
2068
2069 =back
2070
2071 Any other type is a error.
2072
2073 =head2 Notes
2074
2075 When C<$input> maps to multiple files/buffers and C<$output> is a single
2076 file/buffer the uncompressed input files/buffers will all be stored in
2077 C<$output> as a single uncompressed stream.
2078
2079
2080
2081 =head2 Optional Parameters
2082
2083 Unless specified below, the optional parameters for C<gunzip>,
2084 C<OPTS>, are the same as those used with the OO interface defined in the
2085 L</"Constructor Options"> section below.
2086
2087 =over 5
2088
2089 =item AutoClose =E<gt> 0|1
2090
2091 This option applies to any input or output data streams to C<gunzip>
2092 that are filehandles.
2093
2094 If C<AutoClose> is specified, and the value is true, it will result in all
2095 input and/or output filehandles being closed once C<gunzip> has
2096 completed.
2097
2098 This parameter defaults to 0.
2099
2100
2101
2102 =item -Append =E<gt> 0|1
2103
2104 TODO
2105
2106
2107
2108 =back
2109
2110
2111
2112
2113 =head2 Examples
2114
2115 To read the contents of the file C<file1.txt.gz> and write the
2116 compressed data to the file C<file1.txt>.
2117
2118     use strict ;
2119     use warnings ;
2120     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
2121
2122     my $input = "file1.txt.gz";
2123     my $output = "file1.txt";
2124     gunzip $input => $output
2125         or die "gunzip failed: $GunzipError\n";
2126
2127
2128 To read from an existing Perl filehandle, C<$input>, and write the
2129 uncompressed data to a buffer, C<$buffer>.
2130
2131     use strict ;
2132     use warnings ;
2133     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
2134     use IO::File ;
2135
2136     my $input = new IO::File "<file1.txt.gz"
2137         or die "Cannot open 'file1.txt.gz': $!\n" ;
2138     my $buffer ;
2139     gunzip $input => \$buffer
2140         or die "gunzip failed: $GunzipError\n";
2141
2142 To uncompress all files in the directory "/my/home" that match "*.txt.gz" and store the compressed data in the same directory
2143
2144     use strict ;
2145     use warnings ;
2146     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
2147
2148     gunzip '</my/home/*.txt.gz>' => '</my/home/#1.txt>'
2149         or die "gunzip failed: $GunzipError\n";
2150
2151 and if you want to compress each file one at a time, this will do the trick
2152
2153     use strict ;
2154     use warnings ;
2155     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
2156
2157     for my $input ( glob "/my/home/*.txt.gz" )
2158     {
2159         my $output = $input;
2160         $output =~ s/.gz// ;
2161         gunzip $input => $output
2162             or die "Error compressing '$input': $GunzipError\n";
2163     }
2164
2165 =head1 OO Interface
2166
2167 =head2 Constructor
2168
2169 The format of the constructor for IO::Uncompress::Gunzip is shown below
2170
2171
2172     my $z = new IO::Uncompress::Gunzip $input [OPTS]
2173         or die "IO::Uncompress::Gunzip failed: $GunzipError\n";
2174
2175 Returns an C<IO::Uncompress::Gunzip> object on success and undef on failure.
2176 The variable C<$GunzipError> will contain an error message on failure.
2177
2178 If you are running Perl 5.005 or better the object, C<$z>, returned from
2179 IO::Uncompress::Gunzip can be used exactly like an L<IO::File|IO::File> filehandle.
2180 This means that all normal input file operations can be carried out with C<$z>.
2181 For example, to read a line from a compressed file/buffer you can use either
2182 of these forms
2183
2184     $line = $z->getline();
2185     $line = <$z>;
2186
2187 The mandatory parameter C<$input> is used to determine the source of the
2188 compressed data. This parameter can take one of three forms.
2189
2190 =over 5
2191
2192 =item A filename
2193
2194 If the C<$input> parameter is a scalar, it is assumed to be a filename. This
2195 file will be opened for reading and the compressed data will be read from it.
2196
2197 =item A filehandle
2198
2199 If the C<$input> parameter is a filehandle, the compressed data will be
2200 read from it.
2201 The string '-' can be used as an alias for standard input.
2202
2203
2204 =item A scalar reference
2205
2206 If C<$input> is a scalar reference, the compressed data will be read from
2207 C<$$output>.
2208
2209 =back
2210
2211 =head2 Constructor Options
2212
2213
2214 The option names defined below are case insensitive and can be optionally
2215 prefixed by a '-'.  So all of the following are valid
2216
2217     -AutoClose
2218     -autoclose
2219     AUTOCLOSE
2220     autoclose
2221
2222 OPTS is a combination of the following options:
2223
2224 =over 5
2225
2226 =item -AutoClose =E<gt> 0|1
2227
2228 This option is only valid when the C<$input> parameter is a filehandle. If
2229 specified, and the value is true, it will result in the file being closed once
2230 either the C<close> method is called or the IO::Uncompress::Gunzip object is
2231 destroyed.
2232
2233 This parameter defaults to 0.
2234
2235 =item -MultiStream =E<gt> 0|1
2236
2237
2238
2239 Allows multiple concatenated compressed streams to be treated as a single
2240 compressed stream. Decompression will stop once either the end of the
2241 file/buffer is reached, an error is encountered (premature eof, corrupt
2242 compressed data) or the end of a stream is not immediately followed by the
2243 start of another stream.
2244
2245 This parameter defaults to 0.
2246
2247
2248
2249 =item -Prime =E<gt> $string
2250
2251 This option will uncompress the contents of C<$string> before processing the
2252 input file/buffer.
2253
2254 This option can be useful when the compressed data is embedded in another
2255 file/data structure and it is not possible to work out where the compressed
2256 data begins without having to read the first few bytes. If this is the case,
2257 the uncompression can be I<primed> with these bytes using this option.
2258
2259 =item -Transparent =E<gt> 0|1
2260
2261 If this option is set and the input file or buffer is not compressed data,
2262 the module will allow reading of it anyway.
2263
2264 This option defaults to 1.
2265
2266 =item -BlockSize =E<gt> $num
2267
2268 When reading the compressed input data, IO::Uncompress::Gunzip will read it in blocks
2269 of C<$num> bytes.
2270
2271 This option defaults to 4096.
2272
2273 =item -InputLength =E<gt> $size
2274
2275 When present this option will limit the number of compressed bytes read from
2276 the input file/buffer to C<$size>. This option can be used in the situation
2277 where there is useful data directly after the compressed data stream and you
2278 know beforehand the exact length of the compressed data stream.
2279
2280 This option is mostly used when reading from a filehandle, in which case the
2281 file pointer will be left pointing to the first byte directly after the
2282 compressed data stream.
2283
2284
2285
2286 This option defaults to off.
2287
2288 =item -Append =E<gt> 0|1
2289
2290 This option controls what the C<read> method does with uncompressed data.
2291
2292 If set to 1, all uncompressed data will be appended to the output parameter of
2293 the C<read> method.
2294
2295 If set to 0, the contents of the output parameter of the C<read> method will be
2296 overwritten by the uncompressed data.
2297
2298 Defaults to 0.
2299
2300 =item -Strict =E<gt> 0|1
2301
2302
2303
2304 This option controls whether the extra checks defined below are used when
2305 carrying out the decompression. When Strict is on, the extra tests are carried
2306 out, when Strict is off they are not.
2307
2308 The default for this option is off.
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318 =over 5
2319
2320 =item 1
2321
2322 If the FHCRC bit is set in the gzip FLG header byte, the CRC16 bytes in the
2323 header must match the crc16 value of the gzip header actually read.
2324
2325 =item 2
2326
2327 If the gzip header contains a name field (FNAME) it consists solely of ISO
2328 8859-1 characters.
2329
2330 =item 3
2331
2332 If the gzip header contains a comment field (FCOMMENT) it consists solely of
2333 ISO 8859-1 characters plus line-feed.
2334
2335 =item 4
2336
2337 If the gzip FEXTRA header field is present it must conform to the sub-field
2338 structure as defined in RFC1952.
2339
2340 =item 5
2341
2342 The CRC32 and ISIZE trailer fields must be present.
2343
2344 =item 6
2345
2346 The value of the CRC32 field read must match the crc32 value of the
2347 uncompressed data actually contained in the gzip file.
2348
2349 =item 7
2350
2351 The value of the ISIZE fields read must match the length of the uncompressed
2352 data actually read from the file.
2353
2354 =back
2355
2356
2357
2358
2359
2360
2361 =item -ParseExtra =E<gt> 0|1
2362
2363 If the gzip FEXTRA header field is present and this option is set, it will
2364 force the module to check that it conforms to the sub-field structure as
2365 defined in RFC1952.
2366
2367 If the C<Strict> is on it will automatically enable this option.
2368
2369 Defaults to 0.
2370
2371
2372
2373 =back
2374
2375 =head2 Examples
2376
2377 TODO
2378
2379 =head1 Methods
2380
2381 =head2 read
2382
2383 Usage is
2384
2385     $status = $z->read($buffer)
2386
2387 Reads a block of compressed data (the size the the compressed block is
2388 determined by the C<Buffer> option in the constructor), uncompresses it and
2389 writes any uncompressed data into C<$buffer>. If the C<Append> parameter is set
2390 in the constructor, the uncompressed data will be appended to the C<$buffer>
2391 parameter. Otherwise C<$buffer> will be overwritten.
2392
2393 Returns the number of uncompressed bytes written to C<$buffer>, zero if eof or
2394 a negative number on error.
2395
2396 =head2 read
2397
2398 Usage is
2399
2400     $status = $z->read($buffer, $length)
2401     $status = $z->read($buffer, $length, $offset)
2402
2403     $status = read($z, $buffer, $length)
2404     $status = read($z, $buffer, $length, $offset)
2405
2406 Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.
2407
2408 The main difference between this form of the C<read> method and the previous
2409 one, is that this one will attempt to return I<exactly> C<$length> bytes. The
2410 only circumstances that this function will not is if end-of-file or an IO error
2411 is encountered.
2412
2413 Returns the number of uncompressed bytes written to C<$buffer>, zero if eof or
2414 a negative number on error.
2415
2416
2417 =head2 getline
2418
2419 Usage is
2420
2421     $line = $z->getline()
2422     $line = <$z>
2423
2424 Reads a single line.
2425
2426 This method fully supports the use of of the variable C<$/>
2427 (or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
2428 determine what constitutes an end of line. Both paragraph mode and file
2429 slurp mode are supported.
2430
2431
2432 =head2 getc
2433
2434 Usage is
2435
2436     $char = $z->getc()
2437
2438 Read a single character.
2439
2440 =head2 ungetc
2441
2442 Usage is
2443
2444     $char = $z->ungetc($string)
2445
2446
2447 =head2 inflateSync
2448
2449 Usage is
2450
2451     $status = $z->inflateSync()
2452
2453 TODO
2454
2455 =head2 getHeaderInfo
2456
2457 Usage is
2458
2459     $hdr = $z->getHeaderInfo()
2460
2461 TODO
2462
2463
2464
2465
2466
2467 This method returns a hash reference that contains the contents of each of the
2468 header fields defined in RFC1952.
2469
2470
2471
2472
2473
2474
2475 =over 5
2476
2477 =item Comment
2478
2479 The contents of the Comment header field, if present. If no comment is present,
2480 the value will be undef. Note this is different from a zero length comment,
2481 which will return an empty string.
2482
2483 =back
2484
2485
2486
2487
2488 =head2 tell
2489
2490 Usage is
2491
2492     $z->tell()
2493     tell $z
2494
2495 Returns the uncompressed file offset.
2496
2497 =head2 eof
2498
2499 Usage is
2500
2501     $z->eof();
2502     eof($z);
2503
2504
2505
2506 Returns true if the end of the compressed input stream has been reached.
2507
2508
2509
2510 =head2 seek
2511
2512     $z->seek($position, $whence);
2513     seek($z, $position, $whence);
2514
2515
2516
2517
2518 Provides a sub-set of the C<seek> functionality, with the restriction
2519 that it is only legal to seek forward in the input file/buffer.
2520 It is a fatal error to attempt to seek backward.
2521
2522
2523
2524 The C<$whence> parameter takes one the usual values, namely SEEK_SET,
2525 SEEK_CUR or SEEK_END.
2526
2527 Returns 1 on success, 0 on failure.
2528
2529 =head2 binmode
2530
2531 Usage is
2532
2533     $z->binmode
2534     binmode $z ;
2535
2536 This is a noop provided for completeness.
2537
2538 =head2 fileno
2539
2540     $z->fileno()
2541     fileno($z)
2542
2543 If the C<$z> object is associated with a file, this method will return
2544 the underlying filehandle.
2545
2546 If the C<$z> object is is associated with a buffer, this method will
2547 return undef.
2548
2549 =head2 close
2550
2551     $z->close() ;
2552     close $z ;
2553
2554
2555
2556 Closes the output file/buffer.
2557
2558
2559
2560 For most versions of Perl this method will be automatically invoked if
2561 the IO::Uncompress::Gunzip object is destroyed (either explicitly or by the
2562 variable with the reference to the object going out of scope). The
2563 exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
2564 these cases, the C<close> method will be called automatically, but
2565 not until global destruction of all live objects when the program is
2566 terminating.
2567
2568 Therefore, if you want your scripts to be able to run on all versions
2569 of Perl, you should call C<close> explicitly and not rely on automatic
2570 closing.
2571
2572 Returns true on success, otherwise 0.
2573
2574 If the C<AutoClose> option has been enabled when the IO::Uncompress::Gunzip
2575 object was created, and the object is associated with a file, the
2576 underlying file will also be closed.
2577
2578
2579
2580
2581 =head1 Importing
2582
2583 No symbolic constants are required by this IO::Uncompress::Gunzip at present.
2584
2585 =over 5
2586
2587 =item :all
2588
2589 Imports C<gunzip> and C<$GunzipError>.
2590 Same as doing this
2591
2592     use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
2593
2594 =back
2595
2596 =head1 EXAMPLES
2597
2598
2599
2600
2601 =head1 SEE ALSO
2602
2603 L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Uncompress::AnyInflate>
2604
2605 L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
2606
2607 L<File::GlobMapper|File::GlobMapper>, L<Archive::Tar|Archive::Zip>,
2608 L<IO::Zlib|IO::Zlib>
2609
2610 For RFC 1950, 1951 and 1952 see
2611 F<http://www.faqs.org/rfcs/rfc1950.html>,
2612 F<http://www.faqs.org/rfcs/rfc1951.html> and
2613 F<http://www.faqs.org/rfcs/rfc1952.html>
2614
2615 The primary site for the gzip program is F<http://www.gzip.org>.
2616
2617 =head1 AUTHOR
2618
2619 The I<IO::Uncompress::Gunzip> module was written by Paul Marquess,
2620 F<pmqs@cpan.org>. The latest copy of the module can be
2621 found on CPAN in F<modules/by-module/Compress/Compress-Zlib-x.x.tar.gz>.
2622
2623 The I<zlib> compression library was written by Jean-loup Gailly
2624 F<gzip@prep.ai.mit.edu> and Mark Adler F<madler@alumni.caltech.edu>.
2625
2626 The primary site for the I<zlib> compression library is
2627 F<http://www.zlib.org>.
2628
2629 =head1 MODIFICATION HISTORY
2630
2631 See the Changes file.
2632
2633 =head1 COPYRIGHT AND LICENSE
2634
2635
2636 Copyright (c) 2005 Paul Marquess. All rights reserved.
2637 This program is free software; you can redistribute it and/or
2638 modify it under the same terms as Perl itself.
2639
2640
2641