File Coverage

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


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2013, 2014 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   4586 use strict;
  2         6  
  2         83  
20 2     2   11 use Carp;
  2         6  
  2         147  
21 2     2   2024 use Filter::Util::Call qw(filter_add filter_read filter_del);
  2         7093  
  2         378  
22 2     2   2552 use Compress::Raw::Zlib qw(Z_OK Z_STREAM_END Z_BUF_ERROR);
  2         18466  
  2         859  
23              
24 2     2   17 use vars '$VERSION';
  2         3  
  2         1218  
25             $VERSION = 6;
26              
27             # uncomment this to run the ### lines
28             # use Smart::Comments;
29              
30             sub import {
31 1     1   8 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         4 filter_add ($class->new);
39             }
40              
41             sub new {
42 2     2 0 1734 my $class = shift;
43             ### gunzip new(): $class
44              
45             # LimitOutput might help avoid growing $_ to a huge size if a few input
46             # bytes expand to a lot of output.
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 2         11 my ($inf, $zerr) = Compress::Raw::Zlib::Inflate->new
53             (-ConsumeInput => 1,
54             -LimitOutput => 1,
55             -WindowBits => (Compress::Raw::Zlib::MAX_WBITS()
56             + Compress::Raw::Zlib::WANT_GZIP_OR_ZLIB()));
57 2 50       796 $inf or croak __PACKAGE__," cannot create inflator: $zerr";
58              
59 2         14 return bless { inflator => $inf,
60             input => '',
61             @_ }, $class;
62             }
63              
64             sub filter {
65 14     14 0 46 my ($self) = @_;
66             ### gunzip filter(): $self
67              
68 14 100       39 if (! $self->{'inflator'}) {
69             ### inflator got to EOF, remove self
70 1         5 filter_del();
71 1 50       4 if ($self->{'input_eof'}) {
72             ### input_eof
73 0         0 return 0;
74             } else {
75 1         3 $_ = delete $self->{'input'};
76             ### remaining input: $_
77             ### return: 1
78 1         30 return 1;
79             }
80             }
81              
82             # get more input data, if haven't seen input eof and if don't already have
83             # some data to use
84             #
85             ### input length: length($self->{'input'})
86 13 100 33     56 if (! $self->{'input_eof'} && ! length ($self->{'input'})) {
87 1         18 my $status = filter_read(4096); # input block size
88             ### filter_read() returns: $status
89 1 50       4 if ($status < 0) {
90 0         0 return $status;
91             }
92 1 50       4 if ($status == 0) {
93 0         0 $self->{'input_eof'} = 1;
94             } else {
95 1         2 $self->{'input'} = $_;
96             # open my $fh, '>', '/tmp/x.dat' or die;
97             # print $fh $_ or die;
98             # close $fh or die;
99             }
100             }
101              
102 13         17 my $input_len_before = length($self->{'input'});
103             ### $input_len_before
104 13         610 my $zerr = $self->{'inflator'}->inflate ($self->{'input'}, $_);
105             ### zinflate: $zerr+0, "$zerr"
106             ### _ output length: length($_)
107             ### leaving input len: length($self->{'input'})
108              
109 13 100       43 if ($zerr == Z_STREAM_END) {
110             # inflator at eof, return final output now, next call will consider
111             # balance of $self->{'input'}
112 1         11 delete $self->{'inflator'};
113             ### return final inflate: $_
114             ### return: 1
115 1         278 return 1;
116             }
117              
118 12         64 my $status;
119 12 50 33     30 if ($zerr == Z_OK || $zerr == Z_BUF_ERROR) {
120 12 50       133 if (length($_) == 0) {
121 0 0       0 if ($input_len_before == length($self->{'input'})) {
122             # protect against infinite loop
123 0         0 carp __PACKAGE__,
124             ' oops, inflator produced nothing and consumed nothing';
125 0         0 return -1;
126             }
127 0 0       0 if ($self->{'input_eof'}) {
128             # EOF on the input side (and $self->{'input_eof'} is only set when
129             # $self->{'input'} is empty) but the inflator is not at EOF and has
130             # no further output at this point
131 0         0 carp __PACKAGE__," incomplete input";
132 0         0 return -1;
133             }
134             }
135             # It's possible $_ output is empty at this point if the inflator took
136             # some input but had nothing to output just yet. This is unlikely, but
137             # if it happens there'll be another call to us immediately, no need to
138             # do anything special.
139             #### return continuing: $_
140 12         7757 return 1;
141             }
142              
143             # $zerr not Z_OK and not Z_STREAM_END
144 0           carp __PACKAGE__," zlib error: $zerr";
145 0           return -1;
146             }
147              
148             1;
149             __END__