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__ |