line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Resource::XObject::Image::GIF; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1158
|
use base 'PDF::Builder::Resource::XObject::Image'; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
644
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
16
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
44
|
|
6
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
101
|
|
7
|
|
|
|
|
|
|
#no warnings qw[ deprecated recursion uninitialized ]; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '3.023'; # VERSION |
10
|
|
|
|
|
|
|
our $LAST_UPDATE = '3.021'; # manually update whenever code is changed |
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
12
|
use IO::File; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
354
|
|
13
|
2
|
|
|
2
|
|
23
|
use PDF::Builder::Util; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
307
|
|
14
|
2
|
|
|
2
|
|
16
|
use PDF::Builder::Basic::PDF::Utils; |
|
2
|
|
|
|
|
13
|
|
|
2
|
|
|
|
|
188
|
|
15
|
2
|
|
|
2
|
|
16
|
use Scalar::Util qw(weaken); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
3429
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
PDF::Builder::Resource::XObject::Image::GIF - support routines for GIF image library. Inherits from L |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 Supported Formats |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
GIF87a and GIF89a headers are supported. The Image block (x2C) is supported. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
The Graphic Control Extension block (x21 + xF9) is supported for transparency |
26
|
|
|
|
|
|
|
control. Animation is not supported. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
The Comment Extension block (x21 + xFE), Plain Text Extension block (x21 + x01), |
29
|
|
|
|
|
|
|
and Application Extension block (x21 + xFF) are read, but ignored. Any other |
30
|
|
|
|
|
|
|
block or Extension block will be flagged as an error. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
If given, Local Color Tables are read and used, supposedly permitting more |
33
|
|
|
|
|
|
|
than 256 colors to be used overall in the image (despite the 8 bit color table |
34
|
|
|
|
|
|
|
depth). |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
A fairly thorough description of the GIF format may be found in |
37
|
|
|
|
|
|
|
L. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head2 Options |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=over |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=item -notrans |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
When defined and not 0, C<-notrans> suppresses the use of transparency if such |
46
|
|
|
|
|
|
|
is defined in the GIF file. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item -multi |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
When defined and not 0, C<-multi> continues processing past the end of the |
51
|
|
|
|
|
|
|
first Image Block. The old behavior, which is now the default, is to stop |
52
|
|
|
|
|
|
|
processing at the end of the first Image Block. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=back |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# added from PDF::Create: |
59
|
|
|
|
|
|
|
# PDF::Image::GIFImage - GIF image support |
60
|
|
|
|
|
|
|
# Author: Michael Gross |
61
|
|
|
|
|
|
|
# modified for internal use. (c) 2004 fredo. |
62
|
|
|
|
|
|
|
sub unInterlace { |
63
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
0
|
my $data = $self->{' stream'}; |
66
|
0
|
|
|
|
|
0
|
my $row; |
67
|
|
|
|
|
|
|
my @result; |
68
|
0
|
|
|
|
|
0
|
my $width = $self->width(); |
69
|
0
|
|
|
|
|
0
|
my $height = $self->height(); |
70
|
0
|
|
|
|
|
0
|
my $idx = 0; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#Pass 1 - every 8th row, starting with row 0 |
73
|
0
|
|
|
|
|
0
|
$row = 0; |
74
|
0
|
|
|
|
|
0
|
while ($row < $height) { |
75
|
0
|
|
|
|
|
0
|
$result[$row] = substr($data, $idx*$width, $width); |
76
|
0
|
|
|
|
|
0
|
$row += 8; |
77
|
0
|
|
|
|
|
0
|
$idx++; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
#Pass 2 - every 8th row, starting with row 4 |
81
|
0
|
|
|
|
|
0
|
$row = 4; |
82
|
0
|
|
|
|
|
0
|
while ($row < $height) { |
83
|
0
|
|
|
|
|
0
|
$result[$row] = substr($data, $idx*$width, $width); |
84
|
0
|
|
|
|
|
0
|
$row += 8; |
85
|
0
|
|
|
|
|
0
|
$idx++; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#Pass 3 - every 4th row, starting with row 2 |
89
|
0
|
|
|
|
|
0
|
$row = 2; |
90
|
0
|
|
|
|
|
0
|
while ($row < $height) { |
91
|
0
|
|
|
|
|
0
|
$result[$row] = substr($data, $idx*$width, $width); |
92
|
0
|
|
|
|
|
0
|
$row += 4; |
93
|
0
|
|
|
|
|
0
|
$idx++; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#Pass 4 - every 2nd row, starting with row 1 |
97
|
0
|
|
|
|
|
0
|
$row = 1; |
98
|
0
|
|
|
|
|
0
|
while ($row < $height) { |
99
|
0
|
|
|
|
|
0
|
$result[$row] = substr($data, $idx*$width, $width); |
100
|
0
|
|
|
|
|
0
|
$row += 2; |
101
|
0
|
|
|
|
|
0
|
$idx++; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
0
|
return $self->{' stream'} = join('', @result); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub deGIF { |
108
|
2
|
|
|
2
|
0
|
5
|
my ($ibits, $stream) = @_; |
109
|
|
|
|
|
|
|
|
110
|
2
|
|
|
|
|
3
|
my $bits = $ibits; |
111
|
2
|
|
|
|
|
5
|
my $resetcode = 1 << ($ibits-1); |
112
|
2
|
|
|
|
|
4
|
my $endcode = $resetcode+1; |
113
|
2
|
|
|
|
|
4
|
my $nextcode = $endcode+1; |
114
|
2
|
|
|
|
|
2
|
my $ptr = 0; |
115
|
2
|
|
|
|
|
4
|
my $maxptr = 8*length($stream); |
116
|
2
|
|
|
|
|
5
|
my $tag; |
117
|
2
|
|
|
|
|
3
|
my $out = ''; |
118
|
2
|
|
|
|
|
3
|
my $outptr = 0; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# print STDERR "reset=$resetcode\nend=$endcode\nmax=$maxptr\n"; |
121
|
|
|
|
|
|
|
|
122
|
2
|
|
|
|
|
6
|
my @d = map { chr($_) } (0 .. $resetcode-1); |
|
8
|
|
|
|
|
33
|
|
123
|
|
|
|
|
|
|
|
124
|
2
|
|
|
|
|
9
|
while ($ptr+$bits <= $maxptr) { |
125
|
6
|
|
|
|
|
8
|
$tag = 0; |
126
|
6
|
|
|
|
|
13
|
foreach my $off (reverse 0 .. $bits-1) { |
127
|
18
|
|
|
|
|
33
|
$tag <<= 1; |
128
|
18
|
|
|
|
|
31
|
$tag |= vec($stream, $ptr+$off, 1); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
# foreach my $off (0 .. $bits-1) { |
131
|
|
|
|
|
|
|
# $tag <<= 1; |
132
|
|
|
|
|
|
|
# $tag |= vec($stream, $ptr+$off, 1); |
133
|
|
|
|
|
|
|
# } |
134
|
|
|
|
|
|
|
# print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n"; |
135
|
|
|
|
|
|
|
# print STDERR "tag to large\n" if($tag>$nextcode); |
136
|
6
|
|
|
|
|
10
|
$ptr += $bits; |
137
|
6
|
50
|
33
|
|
|
17
|
$bits++ if $nextcode == 1 << $bits and $bits < 12; |
138
|
6
|
100
|
|
|
|
20
|
if ($tag == $resetcode) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
139
|
2
|
|
|
|
|
4
|
$bits = $ibits; |
140
|
2
|
|
|
|
|
4
|
$nextcode = $endcode+1; |
141
|
2
|
|
|
|
|
6
|
next; |
142
|
|
|
|
|
|
|
} elsif ($tag == $endcode) { |
143
|
2
|
|
|
|
|
6
|
last; |
144
|
|
|
|
|
|
|
} elsif ($tag < $resetcode) { |
145
|
2
|
|
|
|
|
5
|
$d[$nextcode] = $d[$tag]; |
146
|
2
|
|
|
|
|
7
|
$out .= $d[$nextcode]; |
147
|
2
|
|
|
|
|
5
|
$nextcode++; |
148
|
|
|
|
|
|
|
} elsif ($tag > $endcode) { |
149
|
0
|
|
|
|
|
0
|
$d[$nextcode] = $d[$tag]; |
150
|
0
|
|
|
|
|
0
|
$d[$nextcode] .= substr($d[$tag+1], 0, 1); |
151
|
0
|
|
|
|
|
0
|
$out .= $d[$nextcode]; |
152
|
0
|
|
|
|
|
0
|
$nextcode++; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
2
|
|
|
|
|
8
|
return $out; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub new { |
159
|
3
|
|
|
3
|
1
|
9
|
my ($class, $pdf, $file, $name, %opts) = @_; |
160
|
|
|
|
|
|
|
|
161
|
3
|
|
|
|
|
6
|
my $self; |
162
|
|
|
|
|
|
|
|
163
|
3
|
|
|
|
|
5
|
my $inter = 0; |
164
|
|
|
|
|
|
|
|
165
|
3
|
50
|
|
|
|
10
|
$class = ref $class if ref $class; |
166
|
|
|
|
|
|
|
|
167
|
3
|
|
33
|
|
|
18
|
$self = $class->SUPER::new($pdf, $name || 'Gx'.pdfkey()); |
168
|
3
|
50
|
|
|
|
9
|
$pdf->new_obj($self) unless $self->is_obj($pdf); |
169
|
|
|
|
|
|
|
|
170
|
3
|
|
|
|
|
6
|
$self->{' apipdf'} = $pdf; |
171
|
3
|
|
|
|
|
9
|
weaken $self->{' apipdf'}; |
172
|
|
|
|
|
|
|
|
173
|
3
|
|
|
|
|
16
|
my $fh = IO::File->new(); |
174
|
3
|
100
|
|
|
|
112
|
if (ref($file)) { |
175
|
1
|
|
|
|
|
3
|
$fh = $file; |
176
|
|
|
|
|
|
|
} else { |
177
|
2
|
100
|
|
|
|
128
|
open $fh, "<", $file or die "$!: $file"; |
178
|
|
|
|
|
|
|
} |
179
|
2
|
|
|
|
|
26
|
binmode $fh, ':raw'; |
180
|
2
|
|
|
|
|
7
|
my $buf; |
181
|
2
|
|
|
|
|
20
|
$fh->seek(0, 0); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# start reading in the GIF file |
184
|
|
|
|
|
|
|
# GIF Header |
185
|
|
|
|
|
|
|
# 6 bytes "GIF87a" or "GIF89a" |
186
|
2
|
|
|
|
|
45
|
$fh->read($buf, 6); # signature |
187
|
2
|
50
|
|
|
|
67
|
die "unknown image signature '$buf' -- not a GIF." unless $buf =~ /^GIF[0-9][0-9][a-b]/; # TBD b? is anything other than 87a and 89a valid? |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# 4 bytes logical screen width and height (2 x 16 bit LSB first) |
190
|
|
|
|
|
|
|
# 1 byte flags, 1 byte background color index, 1 byte pixel aspect ratio |
191
|
2
|
|
|
|
|
10
|
$fh->read($buf, 7); # logical descr. |
192
|
2
|
|
|
|
|
19
|
my($wg, $hg, $flags, $bgColorIndex, $aspect) = unpack('vvCCC', $buf); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# flags numbered left to right 0-7: |
195
|
|
|
|
|
|
|
# bit 0 = 1 (x80) Global Color Table Flag (GCTF) |
196
|
|
|
|
|
|
|
# bits 1-3 = color resolution |
197
|
|
|
|
|
|
|
# bit 4 = 1 (x08) sort flag for Global Color Table |
198
|
|
|
|
|
|
|
# bits 5-7 = size of Global Color Table 2**(n+1), $colSize |
199
|
2
|
50
|
|
|
|
7
|
if ($flags & 0x80) { # GCTF is set? |
200
|
2
|
|
|
|
|
6
|
my $colSize = 2**(($flags & 0x7)+1); # 2 - 256 entries |
201
|
2
|
|
|
|
|
7
|
my $dict = PDFDict(); |
202
|
2
|
|
|
|
|
8
|
$pdf->new_obj($dict); |
203
|
2
|
|
|
|
|
7
|
$self->colorspace(PDFArray(PDFName('Indexed'), PDFName('DeviceRGB'), PDFNum($colSize-1), $dict)); |
204
|
2
|
|
|
|
|
11
|
$fh->read($dict->{' stream'}, 3*$colSize); # Global Color Table |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# further content in file is blocks and trailer |
208
|
2
|
|
|
|
|
27
|
while (!$fh->eof()) { |
209
|
2
|
|
|
|
|
20
|
$fh->read($buf, 1); # 1 byte block tag (type) |
210
|
2
|
|
|
|
|
12
|
my $sep = unpack('C', $buf); |
211
|
|
|
|
|
|
|
|
212
|
2
|
50
|
|
|
|
8
|
if ($sep == 0x2C) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# x2C = image block (separator, equals ASCII comma ',') |
214
|
2
|
|
|
|
|
5
|
$fh->read($buf, 9); # image-descr. |
215
|
|
|
|
|
|
|
# image left (16 bits), image top (16 bits LSB first) |
216
|
|
|
|
|
|
|
# image width (16 bits), image height (16 bits LSB first) |
217
|
|
|
|
|
|
|
# flags (1 byte): |
218
|
|
|
|
|
|
|
# bit 0 = 1 (x80) Local Color Table Flag (LCTF) |
219
|
|
|
|
|
|
|
# bit 1 = 1 (x40) interlaced |
220
|
|
|
|
|
|
|
# bit 2 = 1 (x20) sort flag |
221
|
|
|
|
|
|
|
# bits 3-4 = reserved |
222
|
|
|
|
|
|
|
# bits 5-7 = size of Local Color Table 2**(n+1) if LCTF=1 |
223
|
2
|
|
|
|
|
12
|
my ($left, $top, $w,$h, $flags) = unpack('vvvvC', $buf); |
224
|
|
|
|
|
|
|
|
225
|
2
|
|
33
|
|
|
26
|
$self->width($w||$wg); |
226
|
2
|
|
33
|
|
|
10
|
$self->height($h||$hg); |
227
|
2
|
|
|
|
|
7
|
$self->bits_per_component(8); |
228
|
|
|
|
|
|
|
|
229
|
2
|
50
|
|
|
|
7
|
if ($flags & 0x80) { # Local Color Table (LCTF = 1) |
230
|
0
|
|
|
|
|
0
|
my $colSize = 2**(($flags & 0x7)+1); |
231
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
232
|
0
|
|
|
|
|
0
|
$pdf->new_obj($dict); |
233
|
0
|
|
|
|
|
0
|
$self->colorspace(PDFArray(PDFName('Indexed'), PDFName('DeviceRGB'), PDFNum($colSize-1), $dict)); |
234
|
0
|
|
|
|
|
0
|
$fh->read($dict->{' stream'}, 3*$colSize); # Local Color Table |
235
|
|
|
|
|
|
|
} |
236
|
2
|
50
|
|
|
|
5
|
if ($flags & 0x40) { # need de-interlace |
237
|
0
|
|
|
|
|
0
|
$inter = 1; # default to 0 earlier |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# LZW Minimum Code Size |
241
|
2
|
|
|
|
|
7
|
$fh->read($buf, 1); # image-lzw-start (should be 9). |
242
|
2
|
|
|
|
|
13
|
my ($sep) = unpack('C', $buf); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# read one or more blocks. first byte is length. |
245
|
|
|
|
|
|
|
# if 0, done (Block Terminator) |
246
|
2
|
|
|
|
|
7
|
$fh->read($buf, 1); # first chunk. |
247
|
2
|
|
|
|
|
12
|
my ($len) = unpack('C', $buf); |
248
|
2
|
|
|
|
|
4
|
my $stream = ''; |
249
|
2
|
|
|
|
|
6
|
while ($len > 0) { # loop through blocks as long as non-0 length |
250
|
2
|
|
|
|
|
9
|
$fh->read($buf, $len); |
251
|
2
|
|
|
|
|
10
|
$stream .= $buf; |
252
|
2
|
|
|
|
|
6
|
$fh->read($buf, 1); |
253
|
2
|
|
|
|
|
12
|
$len = unpack('C', $buf); |
254
|
|
|
|
|
|
|
} |
255
|
2
|
|
|
|
|
8
|
$self->{' stream'} = deGIF($sep+1, $stream); |
256
|
2
|
50
|
|
|
|
5
|
$self->unInterlace() if $inter; |
257
|
|
|
|
|
|
|
# old (and current default) behavior is to quit processing at the |
258
|
|
|
|
|
|
|
# end of the first Image Block. This means that any other blocks, |
259
|
|
|
|
|
|
|
# including the Trailer, will not be processed. |
260
|
2
|
50
|
|
|
|
7
|
if (!$opts{'-multi'}) { last; } |
|
2
|
|
|
|
|
4
|
|
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
} elsif ($sep == 0x3b) { |
263
|
|
|
|
|
|
|
# trailer (EOF) equals ASCII semicolon (;) |
264
|
0
|
|
|
|
|
0
|
last; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
} elsif ($sep == 0x21) { |
267
|
|
|
|
|
|
|
# Extension block (x21 + subtag) = ASCII '!' |
268
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # tag. |
269
|
0
|
|
|
|
|
0
|
my $tag = unpack('C', $buf); |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
0
|
if ($tag == 0xF9) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# xF9 graphic control extension block |
273
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # len. should be 04 |
274
|
0
|
|
|
|
|
0
|
my $len = unpack('C', $buf); |
275
|
0
|
|
|
|
|
0
|
my $stream = ''; |
276
|
0
|
|
|
|
|
0
|
while ($len > 0) { |
277
|
0
|
|
|
|
|
0
|
$fh->read($buf, $len); |
278
|
0
|
|
|
|
|
0
|
$stream .= $buf; |
279
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
280
|
0
|
|
|
|
|
0
|
$len = unpack('C', $buf); |
281
|
|
|
|
|
|
|
} |
282
|
0
|
|
|
|
|
0
|
my ($cFlags, $delay, $transIndex) = unpack('CvC', $stream); |
283
|
0
|
0
|
0
|
|
|
0
|
if (($cFlags & 0x01) && !$opts{'-notrans'}) { |
284
|
0
|
|
|
|
|
0
|
$self->{'Mask'} = PDFArray(PDFNum($transIndex), PDFNum($transIndex)); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
} elsif ($tag == 0xFE) { |
288
|
|
|
|
|
|
|
# xFE comment extension block |
289
|
|
|
|
|
|
|
# read comment data block(s) until 0 length |
290
|
|
|
|
|
|
|
# currently just discard comment ($stream) |
291
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # len. |
292
|
0
|
|
|
|
|
0
|
my $len = unpack('C', $buf); |
293
|
0
|
|
|
|
|
0
|
my $stream = ''; |
294
|
0
|
|
|
|
|
0
|
while ($len > 0) { |
295
|
0
|
|
|
|
|
0
|
$fh->read($buf, $len); |
296
|
0
|
|
|
|
|
0
|
$stream .= $buf; |
297
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
298
|
0
|
|
|
|
|
0
|
$len = unpack('C', $buf); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
} elsif ($tag == 0x01) { |
302
|
|
|
|
|
|
|
# x01 plain text extension block |
303
|
0
|
|
|
|
|
0
|
$fh->read($buf, 13); # len. |
304
|
0
|
|
|
|
|
0
|
my ($blkSize,$tgL,$tgT,$tgW,$tgH,$ccW,$ccH,$tFci,$tBci) = |
305
|
|
|
|
|
|
|
unpack('CvvvvCCCC', $buf); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# read plain text data block(s) until 0 length |
308
|
|
|
|
|
|
|
# currently just discard comment ($stream) |
309
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # len. |
310
|
0
|
|
|
|
|
0
|
my $len = unpack('C', $buf); |
311
|
0
|
|
|
|
|
0
|
my $stream = ''; |
312
|
0
|
|
|
|
|
0
|
while ($len > 0) { |
313
|
0
|
|
|
|
|
0
|
$fh->read($buf, $len); |
314
|
0
|
|
|
|
|
0
|
$stream .= $buf; |
315
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
316
|
0
|
|
|
|
|
0
|
$len = unpack('C', $buf); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
} elsif ($tag == 0xFF) { |
320
|
|
|
|
|
|
|
# xFF application extension block |
321
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
322
|
0
|
|
|
|
|
0
|
my $blkSize = unpack('C', $buf); |
323
|
0
|
|
|
|
|
0
|
$fh->read($buf, 8); |
324
|
0
|
|
|
|
|
0
|
my $appID = unpack('C8', $buf); |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # len. |
327
|
0
|
|
|
|
|
0
|
my $len = unpack('C', $buf); |
328
|
0
|
|
|
|
|
0
|
my $stream = ''; |
329
|
0
|
|
|
|
|
0
|
while ($len > 0) { |
330
|
0
|
|
|
|
|
0
|
$fh->read($buf, $len); |
331
|
0
|
|
|
|
|
0
|
$stream .= $buf; |
332
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
333
|
0
|
|
|
|
|
0
|
$len = unpack('C', $buf); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
} else { |
337
|
0
|
|
|
|
|
0
|
print "unsupported extension block (". |
338
|
|
|
|
|
|
|
sprintf("0x%02X",$tag).") ignored!\n"; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
} else { |
342
|
|
|
|
|
|
|
# other extensions and blocks (ignored) |
343
|
0
|
|
|
|
|
0
|
print "unsupported extension or block (". |
344
|
|
|
|
|
|
|
sprintf("0x%02X",$sep).") ignored.\n"; |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # tag. |
347
|
0
|
|
|
|
|
0
|
my $tag = unpack('C', $buf); |
348
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); # tag. |
349
|
0
|
|
|
|
|
0
|
my $len = unpack('C', $buf); |
350
|
0
|
|
|
|
|
0
|
while ($len > 0) { |
351
|
0
|
|
|
|
|
0
|
$fh->read($buf, $len); |
352
|
0
|
|
|
|
|
0
|
$fh->read($buf, 1); |
353
|
0
|
|
|
|
|
0
|
$len = unpack('C', $buf); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
} |
357
|
2
|
|
|
|
|
12
|
$fh->close(); |
358
|
|
|
|
|
|
|
|
359
|
2
|
|
|
|
|
64
|
$self->filters('FlateDecode'); |
360
|
|
|
|
|
|
|
|
361
|
2
|
|
|
|
|
10
|
return $self; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
1; |