File Coverage

blib/lib/PDF/API2/Resource/XObject/Image/GIF.pm
Criterion Covered Total %
statement 104 158 65.8
branch 18 42 42.8
condition 4 24 16.6
subroutine 10 11 90.9
pod 1 3 33.3
total 137 238 57.5


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::XObject::Image::GIF;
2              
3 2     2   1051 use base 'PDF::API2::Resource::XObject::Image';
  2         5  
  2         607  
4              
5 2     2   14 use strict;
  2         7  
  2         42  
6 2     2   10 use warnings;
  2         6  
  2         107  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 2     2   13 use Carp;
  2         6  
  2         117  
11 2     2   13 use IO::File;
  2         4  
  2         303  
12 2     2   13 use PDF::API2::Util;
  2         4  
  2         296  
13 2     2   15 use PDF::API2::Basic::PDF::Utils;
  2         13  
  2         147  
14 2     2   20 use Scalar::Util qw(weaken);
  2         5  
  2         2651  
15              
16             # GIF89a Specification:
17             # https://www.w3.org/Graphics/GIF/spec-gif89a.txt
18              
19             # Originally from PDF::Create
20             # PDF::Image::GIFImage - GIF image support
21             # Author: Michael Gross
22             sub unInterlace {
23 0     0 0 0 my $self = shift;
24 0         0 my $data = $self->{' stream'};
25 0         0 my $row;
26             my @result;
27 0         0 my $width = $self->width();
28 0         0 my $height = $self->height();
29 0         0 my $idx = 0;
30              
31             # Pass 1 - every 8th row, starting with row 0
32 0         0 $row = 0;
33 0         0 while ($row < $height) {
34 0         0 $result[$row] = substr($data, $idx * $width, $width);
35 0         0 $row += 8;
36 0         0 $idx++;
37             }
38              
39             # Pass 2 - every 8th row, starting with row 4
40 0         0 $row = 4;
41 0         0 while ($row < $height) {
42 0         0 $result[$row] = substr($data, $idx * $width, $width);
43 0         0 $row += 8;
44 0         0 $idx++;
45             }
46              
47             # Pass 3 - every 4th row, starting with row 2
48 0         0 $row = 2;
49 0         0 while ($row < $height) {
50 0         0 $result[$row] = substr($data, $idx * $width, $width);
51 0         0 $row += 4;
52 0         0 $idx++;
53             }
54              
55             # Pass 4 - every 2th row, starting with row 1
56 0         0 $row = 1;
57 0         0 while ($row < $height) {
58 0         0 $result[$row] = substr($data, $idx * $width, $width);
59 0         0 $row += 2;
60 0         0 $idx++;
61             }
62              
63 0         0 $self->{' stream'} = join('', @result);
64             }
65              
66             sub deGIF {
67 2     2 0 7 my ($ibits, $stream) = @_;
68 2         4 my $bits = $ibits;
69 2         5 my $resetcode = 1 << ($ibits - 1);
70 2         4 my $endcode = $resetcode + 1;
71 2         3 my $nextcode = $endcode + 1;
72 2         3 my $ptr = 0;
73 2         3 my $maxptr = 8 * length($stream);
74 2         3 my $tag;
75 2         11 my $out = '';
76 2         4 my $outptr = 0;
77              
78 2         7 my @d = map { chr($_) } (0 .. ($resetcode - 1));
  8         23  
79              
80 2         9 while (($ptr + $bits) <= $maxptr) {
81 6         9 $tag = 0;
82 6         22 foreach my $off (reverse 0 .. ($bits - 1)) {
83 18         24 $tag <<= 1;
84 18         31 $tag |= vec($stream, $ptr + $off, 1);
85             }
86             # foreach my $off (0..$bits-1) {
87             # $tag<<=1;
88             # $tag|=vec($stream,$ptr+$off,1);
89             # }
90             # print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
91             # print STDERR "tag to large\n" if($tag>$nextcode);
92 6         10 $ptr += $bits;
93 6 50 33     15 $bits++ if $nextcode == 1 << $bits and $bits < 12;
94 6 100       16 if ($tag==$resetcode) {
    100          
    50          
    0          
95 2         3 $bits = $ibits;
96 2         3 $nextcode = $endcode + 1;
97 2         5 next;
98             }
99             elsif ($tag == $endcode) {
100 2         10 last;
101             }
102             elsif ($tag < $resetcode) {
103 2         6 $d[$nextcode] = $d[$tag];
104 2         4 $out .= $d[$nextcode];
105 2         5 $nextcode++;
106             }
107             elsif ($tag > $endcode) {
108 0         0 $d[$nextcode] = $d[$tag];
109 0         0 $d[$nextcode] .= substr($d[$tag + 1], 0, 1);
110 0         0 $out .= $d[$nextcode];
111 0         0 $nextcode++;
112             }
113             }
114 2         9 return $out;
115             }
116              
117             sub new {
118 3     3 1 9 my ($class, $pdf, $file, $name, %opts) = @_;
119 3         5 my $self;
120 3         6 my $interlaced = 0;
121              
122 3 50       8 $class = ref($class) if ref($class);
123              
124 3   33     16 $self = $class->SUPER::new($pdf, $name || 'Gx' . pdfkey());
125 3 50       9 $pdf->new_obj($self) unless $self->is_obj($pdf);
126              
127 3         38 $self->{' apipdf'} = $pdf;
128 3         13 weaken $self->{' apipdf'};
129              
130 3         17 my $fh = IO::File->new();
131 3 100       117 if (ref($file)) {
132 1         4 $fh = $file;
133             }
134             else {
135 2 100       127 open $fh, '<', $file or die "$!: $file";
136             }
137 2         19 binmode $fh, ':raw';
138 2         6 my $buf;
139 2         17 $fh->seek(0, 0);
140 2         37 $fh->read($buf, 6); # signature
141 2 50       143 unless ($buf =~ /^GIF[0-9][0-9][a-z]/) {
142 0         0 die "Unknown image signature '$buf' -- not a GIF";
143             }
144              
145 2         12 $fh->read($buf, 7); # logical screen descriptor
146 2         25 my ($wg, $hg, $flags, $bgColorIndex, $aspect) = unpack('vvCCC', $buf);
147              
148 2 50       9 if ($flags & 0x80) {
149 2         6 my $colSize = 2 ** (($flags & 0x7) + 1);
150 2         6 my $dict = PDFDict();
151 2         12 $pdf->new_obj($dict);
152 2         9 $self->colorspace(PDFArray(PDFName('Indexed'),
153             PDFName('DeviceRGB'),
154             PDFNum($colSize-1),
155             $dict));
156 2         9 $fh->read($dict->{' stream'}, 3 * $colSize); # color table
157             }
158              
159 2         27 until ($fh->eof()) {
160 2         30 $fh->read($buf, 1); # tag.
161 2         13 my $sep = unpack('C', $buf);
162 2 50       6 if ($sep == 0x2C) {
    0          
163 2         6 $fh->read($buf, 9); # image descriptor
164 2         13 my ($left, $top, $w, $h, $flags) = unpack('vvvvC', $buf);
165              
166 2   33     13 $self->width($w || $wg);
167 2   33     11 $self->height($h || $hg);
168 2         8 $self->bpc(8);
169              
170 2 50       6 if ($flags & 0x80) { # local color table
171 0         0 my $colSize = 2 ** (($flags & 0x7) + 1);
172 0         0 my $dict = PDFDict();
173 0         0 $pdf->new_obj($dict);
174 0         0 $self->colorspace(PDFArray(PDFName('Indexed'),
175             PDFName('DeviceRGB'),
176             PDFNum($colSize-1),
177             $dict));
178 0         0 $fh->read($dict->{' stream'}, 3 * $colSize); # color table
179             }
180 2 50       5 if ($flags & 0x40) { # whether image is interlaced
181 0         0 $interlaced = 1;
182             }
183              
184 2         9 $fh->read($buf, 1); # image-lzw-start (should be 9).
185 2         11 my ($sep) = unpack('C', $buf);
186              
187 2         7 $fh->read($buf, 1); # first chunk.
188 2         10 my ($len) = unpack('C', $buf);
189 2         5 my $stream = '';
190 2         8 while ($len > 0) {
191 2         5 $fh->read($buf, $len);
192 2         11 $stream .= $buf;
193 2         5 $fh->read($buf, 1);
194 2         13 $len = unpack('C', $buf);
195             }
196 2         14 $self->{' stream'} = deGIF($sep + 1, $stream);
197 2 50       5 $self->unInterlace() if $interlaced;
198 2         4 last;
199             }
200             elsif ($sep == 0x3b) { # trailer
201 0         0 last;
202             }
203             else { # extension
204 0         0 $fh->read($buf, 1); # tag
205 0         0 my $tag = unpack('C', $buf);
206 0         0 $fh->read($buf, 1); # length
207 0         0 my $len = unpack('C', $buf);
208 0         0 my $stream = '';
209 0         0 while ($len > 0) {
210 0         0 $fh->read($buf, $len);
211 0         0 $stream .= $buf;
212 0         0 $fh->read($buf, 1);
213 0         0 $len = unpack('C', $buf);
214             }
215              
216             # Graphic Control Extension
217 0 0 0     0 if ($sep == 0x21 and $tag == 0xF9) {
    0 0        
    0 0        
    0          
218 0         0 my ($cFlags, $delay, $transIndex) = unpack('CvC', $stream);
219 0 0 0     0 if (($cFlags & 0x01) and not $opts{'-notrans'}) {
220 0         0 $self->{'Mask'} = PDFArray(PDFNum($transIndex),
221             PDFNum($transIndex));
222             }
223             }
224              
225             # Comment Extension
226             elsif ($sep == 0x21 and $tag == 0xFE) {
227             # NOOP: ignore
228             }
229              
230             # Plain Text Extension
231             elsif ($sep == 0x21 and $tag == 0x01) {
232             # NOOP: ignore
233             }
234              
235             elsif ($sep == 0x21) {
236 0         0 carp "Ignoring unsupported GIF extension $tag";
237             }
238             }
239             }
240 2         13 $fh->close();
241              
242 2         68 $self->filters('FlateDecode');
243              
244 2         9 return $self;
245             }
246              
247             1;