File Coverage

blib/lib/Filter/gunzip/Filter.pm
Criterion Covered Total %
statement 41 52 78.8
branch 12 22 54.5
condition 3 6 50.0
subroutine 8 8 100.0
pod 0 2 0.0
total 64 90 71.1


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2013, 2014, 2019 Kevin Ryde
2              
3             # This file is part of Filter-gunzip.
4             #
5             # Filter-gunzip is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Filter-gunzip is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Filter-gunzip. If not, see .
17              
18             package Filter::gunzip::Filter;
19 2     2   3020 use strict;
  2         4  
  2         48  
20 2     2   9 use Carp;
  2         3  
  2         87  
21 2     2   1072 use Filter::Util::Call qw(filter_add filter_read filter_del);
  2         1491  
  2         115  
22 2     2   1022 use Compress::Raw::Zlib qw(Z_OK Z_STREAM_END Z_BUF_ERROR);
  2         8833  
  2         141  
23              
24 2     2   12 use vars '$VERSION';
  2         3  
  2         862  
25             $VERSION = 8;
26              
27             # uncomment this to run the ### lines
28             # use Smart::Comments;
29              
30             sub import {
31 1     1   9 my ($class) = @_;
32              
33             # Filter::Util::Call 1.37 filter_add() rudely re-blesses the object into the
34             # callers package. Doesn't affect plain use here, but a subclass would want
35             # to fix it up again.
36             #
37             ### filter_add()
38 1         3 filter_add ($class->new);
39             }
40              
41             sub new {
42 2     2 0 264 my $class = shift;
43             ### gunzip new(): $class
44              
45             # LimitOutput helps avoid growing $_ to a huge size if a few input bytes
46             # expand to a lot of output. (That option new in Compress::Raw::Zlib 2.018.
47             #
48             # Crib note: Must have parens on MAX_WBITS() because it's unprototyped
49             # (generated by Compress::Raw::Zlib::AUTOLOAD()) and hence without them
50             # the "+ WANT_GZIP_OR_ZLIB" is passed as a parameter instead of adding.
51             #
52             # Docs of the wbits: /usr/include/zlib.h
53             #
54             # Think MAX_WBITS is right for gunzip. Think gzip format (RFC 1952)
55             # doesn't have a window bits in its header to tell an inflator how much
56             # needed. MAX_WBITS is 32kbytes which is not too bad.
57             #
58 2         6 my ($inf, $zerr) = Compress::Raw::Zlib::Inflate->new
59             (-ConsumeInput => 1,
60             -LimitOutput => 1,
61             -WindowBits => (Compress::Raw::Zlib::MAX_WBITS()
62             + Compress::Raw::Zlib::WANT_GZIP_OR_ZLIB()));
63 2 50       769 $inf or croak __PACKAGE__," cannot create inflator: $zerr";
64              
65 2         11 return bless { inflator => $inf,
66             input => '',
67             @_ }, $class;
68             }
69              
70             sub filter {
71 14     14 0 46 my ($self) = @_;
72             ### gunzip filter(): $self
73              
74 14 100       31 if (! $self->{'inflator'}) {
75             ### inflator got to EOF, remove self
76 1         3 filter_del();
77 1 50       3 if ($self->{'input_eof'}) {
78             ### input_eof
79 0         0 return 0;
80             } else {
81 1         2 $_ = delete $self->{'input'};
82             ### remaining input: $_
83             ### return: 1
84 1         23 return 1;
85             }
86             }
87              
88             # get more input data, if haven't seen input eof and if don't already have
89             # some data to use
90             #
91             ### input length: length($self->{'input'})
92 13 100 66     36 if (! $self->{'input_eof'} && ! length ($self->{'input'})) {
93 1         17 my $status = filter_read(4096); # input block size
94             ### filter_read() returns: $status
95 1 50       5 if ($status < 0) {
96 0         0 return $status;
97             }
98 1 50       3 if ($status == 0) {
99 0         0 $self->{'input_eof'} = 1;
100             } else {
101 1         3 $self->{'input'} = $_;
102             # open my $fh, '>', '/tmp/x.dat' or die;
103             # print $fh $_ or die;
104             # close $fh or die;
105             }
106             }
107              
108 13         15 my $input_len_before = length($self->{'input'});
109             ### $input_len_before
110 13         431 my $zerr = $self->{'inflator'}->inflate ($self->{'input'}, $_);
111             ### zinflate: $zerr+0, "$zerr"
112             ### _ output length: length($_)
113             ### leaving input len: length($self->{'input'})
114              
115 13 100       33 if ($zerr == Z_STREAM_END) {
116             # inflator at eof, return final output now, next call will consider
117             # balance of $self->{'input'}
118 1         22 delete $self->{'inflator'};
119             ### return final inflate: $_
120             ### return: 1
121 1         168 return 1;
122             }
123              
124 12         56 my $status;
125 12 50 33     18 if ($zerr == Z_OK || $zerr == Z_BUF_ERROR) {
126 12 50       106 if (length($_) == 0) {
127 0 0       0 if ($input_len_before == length($self->{'input'})) {
128             # protect against infinite loop
129 0         0 carp __PACKAGE__,
130             ' oops, inflator produced nothing and consumed nothing';
131 0         0 return -1;
132             }
133 0 0       0 if ($self->{'input_eof'}) {
134             # EOF on the input side (and $self->{'input_eof'} is only set when
135             # $self->{'input'} is empty) but the inflator is not at EOF and has
136             # no further output at this point
137 0         0 carp __PACKAGE__," incomplete input";
138 0         0 return -1;
139             }
140             }
141             # It's possible $_ output is empty at this point if the inflator took
142             # some input but had nothing to output just yet. This is unlikely, but
143             # if it happens there'll be another call to us immediately, no need to
144             # do anything special.
145             #### return continuing: $_
146 12         3980 return 1;
147             }
148              
149             # $zerr not Z_OK and not Z_STREAM_END
150 0           carp __PACKAGE__," zlib error: $zerr";
151 0           return -1;
152             }
153              
154             1;
155             __END__