Commit | Line | Data |
---|---|---|
642e522c RGS |
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 RGS |
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 RGS |
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 RGS |
1051 | |
1052 | } | |
1053 | ||
1054 | elsif ($x->{outType} eq 'handle') { | |
1055 | $x->{fh} = $output; | |
7581d28c | 1056 | binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut'); |
642e522c RGS |
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 |