line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Basic::PDF::Filter::LZWDecode; |
2
|
|
|
|
|
|
|
|
3
|
40
|
|
|
40
|
|
660
|
use strict; |
|
40
|
|
|
|
|
106
|
|
|
40
|
|
|
|
|
1419
|
|
4
|
40
|
|
|
40
|
|
246
|
use warnings; |
|
40
|
|
|
|
|
96
|
|
|
40
|
|
|
|
|
1219
|
|
5
|
40
|
|
|
40
|
|
239
|
use Carp; |
|
40
|
|
|
|
|
92
|
|
|
40
|
|
|
|
|
2602
|
|
6
|
40
|
|
|
40
|
|
267
|
use POSIX; |
|
40
|
|
|
|
|
90
|
|
|
40
|
|
|
|
|
603
|
|
7
|
40
|
|
|
40
|
|
88080
|
use base 'PDF::Builder::Basic::PDF::Filter::FlateDecode'; |
|
40
|
|
|
|
|
106
|
|
|
40
|
|
|
|
|
86913
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '3.023'; # VERSION |
10
|
|
|
|
|
|
|
our $LAST_UPDATE = '3.023'; # manually update whenever code is changed |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
PDF::Builder::Basic::PDF::Filter::LZWDecode - compress and uncompress stream filters for Lempel-Ziv-Welch |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
10
|
|
|
10
|
1
|
36118
|
my ($class, $decode_parms) = @_; |
20
|
|
|
|
|
|
|
|
21
|
10
|
|
|
|
|
48
|
my $self = { DecodeParms => $decode_parms, }; |
22
|
|
|
|
|
|
|
|
23
|
10
|
|
|
|
|
32
|
bless $self, $class; |
24
|
10
|
|
|
|
|
60
|
$self->_reset_code(); |
25
|
10
|
|
|
|
|
1077
|
return $self; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub infilt { |
29
|
6
|
|
|
6
|
1
|
59
|
my ($self, $data, $is_last) = @_; |
30
|
|
|
|
|
|
|
|
31
|
6
|
|
|
|
|
48
|
my ($code, $result); |
32
|
6
|
|
|
|
|
21
|
my $partial_code = $self->{'partial_code'}; |
33
|
6
|
|
|
|
|
14
|
my $partial_bits = $self->{'partial_bits'}; |
34
|
|
|
|
|
|
|
|
35
|
6
|
|
|
|
|
15
|
my $early_change = 1; |
36
|
6
|
50
|
66
|
|
|
30
|
if ($self->{'DecodeParms'} and $self->{'DecodeParms'}->{'EarlyChange'}) { |
37
|
0
|
|
|
|
|
0
|
$early_change = $self->{'DecodeParms'}->{'EarlyChange'}->val(); |
38
|
|
|
|
|
|
|
} |
39
|
6
|
|
|
|
|
71
|
$self->{'table'} = [ map { chr } 0 .. $self->{'clear_table'} - 1 ]; |
|
1536
|
|
|
|
|
3226
|
|
40
|
|
|
|
|
|
|
|
41
|
6
|
|
|
|
|
162
|
while ( $data ne q{} ) { |
42
|
|
|
|
|
|
|
($code, $partial_code, $partial_bits) = |
43
|
|
|
|
|
|
|
$self->read_dat(\$data, $partial_code, $partial_bits, |
44
|
29558
|
|
|
|
|
62003
|
$self->{'code_length'}); |
45
|
29558
|
50
|
|
|
|
57032
|
last unless defined $code; |
46
|
|
|
|
|
|
|
|
47
|
29558
|
50
|
|
|
|
51700
|
unless ($early_change) { |
48
|
0
|
0
|
0
|
|
|
0
|
if ($self->{next_code} == (1 << $self->{code_length}) |
49
|
|
|
|
|
|
|
and $self->{code_length} < 12) { |
50
|
0
|
|
|
|
|
0
|
$self->{'code_length'}++; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
29558
|
100
|
|
|
|
72261
|
if ($code == $self->{'clear_table'}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
55
|
13
|
|
|
|
|
41
|
$self->{'code_length'} = $self->{'initial_code_length'}; |
56
|
13
|
|
|
|
|
49
|
$self->{'next_code'} = $self->{'eod_marker'} + 1; |
57
|
13
|
|
|
|
|
40
|
next; |
58
|
|
|
|
|
|
|
} elsif ($code == $self->{'eod_marker'}) { |
59
|
6
|
|
|
|
|
20
|
last; |
60
|
|
|
|
|
|
|
} elsif ($code > $self->{'eod_marker'}) { |
61
|
1049
|
|
|
|
|
2923
|
$self->{'table'}[$self->{'next_code'}] = $self->{'table'}[$code]; |
62
|
|
|
|
|
|
|
$self->{'table'}[$self->{'next_code'}] .= |
63
|
1049
|
|
|
|
|
2530
|
substr($self->{'table'}[$code + 1], 0, 1); |
64
|
1049
|
|
|
|
|
2004
|
$result .= $self->{'table'}[$self->{'next_code'}]; |
65
|
1049
|
|
|
|
|
1583
|
$self->{'next_code'}++; |
66
|
|
|
|
|
|
|
} else { |
67
|
28490
|
|
|
|
|
60605
|
$self->{'table'}[$self->{'next_code'}] = $self->{'table'}[$code]; |
68
|
28490
|
|
|
|
|
43519
|
$result .= $self->{'table'}[$self->{'next_code'}]; |
69
|
28490
|
|
|
|
|
40794
|
$self->{'next_code'}++; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
29539
|
50
|
|
|
|
51887
|
if ($early_change) { |
73
|
29539
|
100
|
100
|
|
|
75014
|
if ($self->{'next_code'} == (1 << $self->{'code_length'}) |
74
|
|
|
|
|
|
|
and $self->{code_length} < 12) { |
75
|
25
|
|
|
|
|
80
|
$self->{'code_length'}++; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
6
|
|
|
|
|
17
|
$self->{'partial_code'} = $partial_code; |
80
|
6
|
|
|
|
|
14
|
$self->{'partial_bits'} = $partial_bits; |
81
|
|
|
|
|
|
|
|
82
|
6
|
100
|
|
|
|
28
|
if ($self->_predictor_type() == 2) { |
83
|
2
|
|
|
|
|
13
|
return $self->_depredict($result); |
84
|
|
|
|
|
|
|
} |
85
|
4
|
|
|
|
|
129
|
return $result; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub outfilt { |
89
|
6
|
|
|
6
|
1
|
127
|
my ($self, $str, $is_end) = @_; |
90
|
6
|
|
|
|
|
16
|
my $max_code = 32767; |
91
|
6
|
|
|
|
|
13
|
my $bytes_in = 0; |
92
|
6
|
|
|
|
|
11
|
my $checkpoint = 0; |
93
|
6
|
|
|
|
|
13
|
my $last_ratio = 0; |
94
|
6
|
|
|
|
|
15
|
my $seen = q{}; |
95
|
6
|
|
|
|
|
19
|
$self->{'buf'} = q{}; |
96
|
6
|
|
|
|
|
14
|
$self->{'buf_pos'} = 0; |
97
|
6
|
|
|
|
|
34
|
$self->_write_code($self->{'clear_table'}); |
98
|
|
|
|
|
|
|
|
99
|
6
|
100
|
|
|
|
27
|
if ($self->_predictor_type() == 2) { |
100
|
2
|
|
|
|
|
11
|
$str = $self->_predict($str); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
6
|
|
|
|
|
25
|
for my $i (0 .. length($str)) { |
104
|
31085
|
|
|
|
|
51019
|
my $char = substr($str, $i, 1); |
105
|
31085
|
|
|
|
|
40681
|
$bytes_in += 1; |
106
|
|
|
|
|
|
|
|
107
|
31085
|
100
|
|
|
|
69442
|
if (exists $self->{'table'}{ $seen . $char }) { |
108
|
1552
|
|
|
|
|
2170
|
$seen .= $char; |
109
|
1552
|
|
|
|
|
2823
|
next; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
29533
|
|
|
|
|
79187
|
$self->_write_code($self->{'table'}{$seen}); |
113
|
|
|
|
|
|
|
|
114
|
29533
|
|
|
|
|
78605
|
$self->_new_code($seen . $char); |
115
|
|
|
|
|
|
|
|
116
|
29533
|
|
|
|
|
48613
|
$seen = $char; |
117
|
|
|
|
|
|
|
|
118
|
29533
|
100
|
|
|
|
58966
|
if ($self->{'at_max_code'}) { |
119
|
7
|
|
|
|
|
25
|
$self->_write_code($self->{'clear_table'}); |
120
|
7
|
|
|
|
|
34
|
$self->_reset_code(); |
121
|
|
|
|
|
|
|
|
122
|
7
|
|
|
|
|
20
|
undef $checkpoint; |
123
|
7
|
|
|
|
|
28
|
undef $last_ratio; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
6
|
|
|
|
|
29
|
$self->_write_code($self->{'table'}{$seen}); #last bit of input |
127
|
6
|
|
|
|
|
23
|
$self->_write_code($self->{'eod_marker'}); |
128
|
6
|
|
|
|
|
23
|
my $padding = length($self->{'buf'}) % 8; |
129
|
6
|
100
|
|
|
|
22
|
if ($padding > 0) { |
130
|
5
|
|
|
|
|
12
|
$padding = 8 - $padding; |
131
|
5
|
|
|
|
|
22
|
$self->{'buf'} .= '0' x $padding; |
132
|
|
|
|
|
|
|
} |
133
|
6
|
|
|
|
|
1090
|
return pack 'B*', $self->{'buf'}; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub _reset_code { |
137
|
17
|
|
|
17
|
|
58
|
my $self = shift; |
138
|
|
|
|
|
|
|
|
139
|
17
|
|
|
|
|
69
|
$self->{'initial_code_length'} = 9; |
140
|
17
|
|
|
|
|
49
|
$self->{'max_code_length'} = 12; |
141
|
17
|
|
|
|
|
55
|
$self->{'code_length'} = $self->{'initial_code_length'}; |
142
|
17
|
|
|
|
|
46
|
$self->{'clear_table'} = 256; |
143
|
17
|
|
|
|
|
57
|
$self->{'eod_marker'} = $self->{'clear_table'} + 1; |
144
|
17
|
|
|
|
|
55
|
$self->{'next_code'} = $self->{'eod_marker'} + 1; |
145
|
17
|
|
|
|
|
67
|
$self->{'next_increase'} = 2**$self->{'code_length'}; |
146
|
17
|
|
|
|
|
49
|
$self->{'at_max_code'} = 0; |
147
|
17
|
|
|
|
|
388
|
$self->{'table'} = { map { chr $_ => $_ } 0 .. $self->{'clear_table'} - 1 }; |
|
4352
|
|
|
|
|
16281
|
|
148
|
17
|
|
|
|
|
505
|
return; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub _new_code { |
152
|
29533
|
|
|
29533
|
|
52288
|
my ($self, $word) = @_; |
153
|
|
|
|
|
|
|
|
154
|
29533
|
50
|
|
|
|
55885
|
if ($self->{'at_max_code'} == 0) { |
155
|
29533
|
|
|
|
|
71474
|
$self->{'table'}{$word} = $self->{'next_code'}; |
156
|
29533
|
|
|
|
|
45217
|
$self->{'next_code'} += 1; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
29533
|
100
|
|
|
|
55122
|
if ($self->{'next_code'} >= $self->{'next_increase'}) { |
160
|
32
|
100
|
|
|
|
142
|
if ($self->{'code_length'} < $self->{'max_code_length'}) { |
161
|
25
|
|
|
|
|
53
|
$self->{'code_length'} += 1; |
162
|
25
|
|
|
|
|
58
|
$self->{'next_increase'} *= 2; |
163
|
|
|
|
|
|
|
} else { |
164
|
7
|
|
|
|
|
15
|
$self->{'at_max_code'} = 1; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
29533
|
|
|
|
|
45535
|
return; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub _write_code { |
171
|
29558
|
|
|
29558
|
|
51738
|
my ($self, $code) = @_; |
172
|
|
|
|
|
|
|
|
173
|
29558
|
50
|
|
|
|
49988
|
if (not defined $code) { return; } |
|
0
|
|
|
|
|
0
|
|
174
|
|
|
|
|
|
|
|
175
|
29558
|
50
|
|
|
|
59306
|
if ($code > (2**$self->{'code_length'})) { |
176
|
0
|
|
|
|
|
0
|
croak |
177
|
|
|
|
|
|
|
"Code $code too large for current code length $self->{'code_length'}"; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
29558
|
|
|
|
|
61925
|
for my $bit (reverse 0 .. ($self->{'code_length'} - 1)) { |
181
|
331147
|
100
|
|
|
|
524028
|
if (($code >> $bit) & 1) { |
182
|
119450
|
|
|
|
|
183775
|
$self->{'buf'} .= '1'; |
183
|
|
|
|
|
|
|
} else { |
184
|
211697
|
|
|
|
|
323371
|
$self->{'buf'} .= '0'; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
29558
|
|
|
|
|
51726
|
$self->{'buf_pos'} += $self->{'code_length'}; |
189
|
29558
|
|
|
|
|
45288
|
return; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub read_dat { |
193
|
29558
|
|
|
29558
|
0
|
49924
|
my ($self, $data_ref, $partial_code, $partial_bits, $code_length) = @_; |
194
|
|
|
|
|
|
|
|
195
|
29558
|
100
|
|
|
|
51582
|
if (not defined $partial_bits) { $partial_bits = 0; } |
|
6
|
|
|
|
|
17
|
|
196
|
29558
|
100
|
|
|
|
49461
|
if (not defined $partial_code) { $partial_code = 0; } |
|
6
|
|
|
|
|
14
|
|
197
|
|
|
|
|
|
|
|
198
|
29558
|
|
|
|
|
51916
|
while ($partial_bits < $code_length ) { |
199
|
41396
|
50
|
|
|
|
72887
|
return (undef, $partial_code, $partial_bits) unless length($$data_ref); |
200
|
41396
|
|
|
|
|
70065
|
$partial_code = ($partial_code << 8 ) + unpack('C', $$data_ref); |
201
|
41396
|
|
|
|
|
70184
|
substr($$data_ref, 0, 1, q{}); |
202
|
41396
|
|
|
|
|
77467
|
$partial_bits += 8; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
29558
|
|
|
|
|
45123
|
my $code = $partial_code >> ($partial_bits - $code_length); |
206
|
29558
|
|
|
|
|
45163
|
$partial_code &= (1 << ($partial_bits - $code_length)) - 1; |
207
|
29558
|
|
|
|
|
39687
|
$partial_bits -= $code_length; |
208
|
|
|
|
|
|
|
|
209
|
29558
|
|
|
|
|
54610
|
return ($code, $partial_code, $partial_bits); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _predictor_type { |
213
|
12
|
|
|
12
|
|
30
|
my ($self) = @_; |
214
|
12
|
50
|
66
|
|
|
60
|
if ($self->{'DecodeParms'} and $self->{'DecodeParms'}->{'Predictor'}) { |
215
|
4
|
|
|
|
|
30
|
my $predictor = $self->{'DecodeParms'}->{'Predictor'}->val(); |
216
|
4
|
50
|
33
|
|
|
28
|
if ($predictor == 1 or $predictor == 2) { |
|
|
0
|
|
|
|
|
|
217
|
4
|
|
|
|
|
17
|
return $predictor; |
218
|
|
|
|
|
|
|
} elsif ($predictor == 3) { |
219
|
0
|
|
|
|
|
0
|
croak 'Floating point TIFF predictor not yet supported'; |
220
|
|
|
|
|
|
|
} else { |
221
|
0
|
|
|
|
|
0
|
croak "Invalid predictor: $predictor"; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
8
|
|
|
|
|
27
|
return 1; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub _depredict { |
228
|
2
|
|
|
2
|
|
8
|
my ($self, $data) = @_; |
229
|
2
|
|
|
|
|
5
|
my $param = $self->{'DecodeParms'}; |
230
|
2
|
50
|
|
|
|
10
|
my $alpha = $param->{'Alpha'} ? $param->{'Alpha'}->val() : 0; |
231
|
|
|
|
|
|
|
my $bpc = |
232
|
2
|
50
|
|
|
|
7
|
$param->{'BitsPerComponent'} ? $param->{'BitsPerComponent'}->val() : 8; |
233
|
2
|
100
|
|
|
|
8
|
my $colors = $param->{'Colors'} ? $param->{'Colors'}->val() : 1; |
234
|
2
|
50
|
|
|
|
12
|
my $columns = $param->{'Columns'} ? $param->{'Columns'}->val() : 1; |
235
|
2
|
50
|
|
|
|
33
|
my $rows = $param->{'Rows'} ? $param->{'Rows'}->val() : 0; |
236
|
|
|
|
|
|
|
|
237
|
2
|
|
|
|
|
5
|
my $comp = $colors + $alpha; |
238
|
2
|
|
|
|
|
18
|
my $bpp = ceil($bpc * $comp / 8); |
239
|
2
|
|
|
|
|
4
|
my $max = 256; |
240
|
2
|
50
|
|
|
|
8
|
if ($bpc == 8) { |
241
|
2
|
|
|
|
|
13
|
my @data = unpack('C*', $data); |
242
|
2
|
|
|
|
|
10
|
for my $j (0 .. $rows - 1) { |
243
|
4
|
|
|
|
|
10
|
my $count = $bpp * ($j * $columns + 1); |
244
|
4
|
|
|
|
|
11
|
for my $i ($bpp .. $columns * $bpp - 1) { |
245
|
72
|
|
|
|
|
114
|
$data[$count] = |
246
|
|
|
|
|
|
|
($data[$count] + $data[$count - $bpp]) % $max; |
247
|
72
|
|
|
|
|
101
|
$count++; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
2
|
|
|
|
|
12
|
$data = pack('C*', @data); |
251
|
2
|
|
|
|
|
22
|
return $data; |
252
|
|
|
|
|
|
|
} |
253
|
0
|
|
|
|
|
0
|
return $data; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub _predict { |
257
|
3
|
|
|
3
|
|
17
|
my ($self, $data) = @_; |
258
|
3
|
|
|
|
|
51
|
my $param = $self->{'DecodeParms'}; |
259
|
3
|
50
|
|
|
|
30
|
my $alpha = $param->{'Alpha'} ? $param->{'Alpha'}->val() : 0; |
260
|
|
|
|
|
|
|
my $bpc = |
261
|
3
|
50
|
|
|
|
11
|
$param->{'BitsPerComponent'} ? $param->{'BitsPerComponent'}->val() : 8; |
262
|
3
|
100
|
|
|
|
12
|
my $colors = $param->{'Colors'} ? $param->{'Colors'}->val() : 1; |
263
|
3
|
50
|
|
|
|
17
|
my $columns = $param->{'Columns'} ? $param->{'Columns'}->val() : 1; |
264
|
3
|
50
|
|
|
|
15
|
my $rows = $param->{'Rows'} ? $param->{'Rows'}->val() : 0; |
265
|
|
|
|
|
|
|
|
266
|
3
|
|
|
|
|
7
|
my $comp = $colors + $alpha; |
267
|
3
|
|
|
|
|
49
|
my $bpp = ceil($bpc * $comp / 8); |
268
|
3
|
|
|
|
|
9
|
my $max = 256; |
269
|
3
|
50
|
|
|
|
13
|
if ($bpc == 8) { |
270
|
3
|
|
|
|
|
24
|
my @data = unpack('C*', $data); |
271
|
3
|
|
|
|
|
16
|
for my $j (0 .. $rows - 1) { |
272
|
6
|
|
|
|
|
15
|
my $count = $bpp * $columns * ($j + 1) - 1; |
273
|
6
|
|
|
|
|
16
|
for my $i ($bpp .. $columns * $bpp - 1) { |
274
|
78
|
|
|
|
|
109
|
$data[$count] -= $data[$count - $bpp]; |
275
|
78
|
100
|
|
|
|
133
|
if ($data[$count] < 0) { $data[$count] += $max; } |
|
7
|
|
|
|
|
11
|
|
276
|
78
|
|
|
|
|
119
|
$count--; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
3
|
|
|
|
|
18
|
$data = pack('C*', @data); |
280
|
3
|
|
|
|
|
16
|
return $data; |
281
|
|
|
|
|
|
|
} |
282
|
0
|
|
|
|
|
|
return $data; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
1; |