Commit | Line | Data |
642e522c |
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], |
7581d28c |
704 | 'BinModeOut' => [Parse_boolean, 0], |
642e522c |
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 | } |
07a53161 |
773 | |
7581d28c |
774 | setBinModeInput(*$obj->{FH}) ; |
642e522c |
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': $!") ; |
7581d28c |
1050 | binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut'); |
642e522c |
1051 | |
1052 | } |
1053 | |
1054 | elsif ($x->{outType} eq 'handle') { |
1055 | $x->{fh} = $output; |
7581d28c |
1056 | binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut'); |
642e522c |
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 | |