File Coverage

blib/lib/PDF/API2/Resource/XObject/Image/TIFF.pm
Criterion Covered Total %
statement 101 197 51.2
branch 20 48 41.6
condition 8 21 38.1
subroutine 14 17 82.3
pod 2 8 25.0
total 145 291 49.8


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::XObject::Image::TIFF;
2              
3 2     2   994 use base 'PDF::API2::Resource::XObject::Image';
  2         5  
  2         589  
4              
5 2     2   16 use strict;
  2         4  
  2         41  
6 2     2   11 use warnings;
  2         5  
  2         55  
7              
8 2     2   10 no warnings 'uninitialized';
  2         4  
  2         97  
9              
10             our $VERSION = '2.044'; # VERSION
11              
12 2     2   14 use Compress::Zlib;
  2         3  
  2         625  
13              
14 2     2   16 use PDF::API2::Basic::PDF::Utils;
  2         4  
  2         184  
15 2     2   1091 use PDF::API2::Resource::XObject::Image::TIFF::File;
  2         6  
  2         75  
16 2     2   14 use PDF::API2::Util;
  2         5  
  2         269  
17 2     2   50 use Scalar::Util qw(weaken);
  2         6  
  2         4224  
18              
19             =head1 NAME
20              
21             PDF::API2::Resource::XObject::Image::TIFF - TIFF image support
22              
23             =head1 METHODS
24              
25             =over
26              
27             =item $res = PDF::API2::Resource::XObject::Image::TIFF->new $pdf, $file [, $name]
28              
29             Returns a tiff-image object.
30              
31             =cut
32              
33             sub new {
34 4     4 1 12 my ($class, $pdf, $file, $name) = @_;
35 4         7 my $self;
36              
37 4         21 my $tif = PDF::API2::Resource::XObject::Image::TIFF::File->new($file);
38              
39             # in case of problematic things
40             # proxy to other modules
41              
42 3 50       7 $class = ref($class) if ref($class);
43              
44 3   33     15 $self = $class->SUPER::new($pdf, $name || 'Ix' . pdfkey());
45 3 50       11 $pdf->new_obj($self) unless $self->is_obj($pdf);
46              
47 3         19 $self->{' apipdf'} = $pdf;
48 3         10 weaken $self->{' apipdf'};
49              
50 3         9 $self->read_tiff($pdf, $tif);
51              
52 3         17 $tif->close();
53              
54 3         76 return $self;
55             }
56              
57             sub deLZW {
58 1     1 0 3 my ($ibits, $stream) = @_;
59 1         3 my $bits = $ibits;
60 1         4 my $resetcode = 1 << ($ibits - 1);
61 1         2 my $endcode = $resetcode + 1;
62 1         10 my $nextcode = $endcode + 1;
63 1         3 my $ptr = 0;
64 1         6 $stream = unpack('B*', $stream);
65 1         2 my $maxptr = length($stream);
66 1         1 my $tag;
67 1         5 my $out = '';
68 1         2 my $outptr = 0;
69              
70             # print STDERR "reset=$resetcode\nend=$endcode\nmax=$maxptr\n";
71              
72 1         19 my @d = map { chr($_) } (0 .. $resetcode - 1);
  256         452  
73              
74 1         13 while (($ptr + $bits) <= $maxptr) {
75 3         6 $tag=0;
76 3         7 foreach my $off (reverse 1 .. $bits) {
77 27         34 $tag <<= 1;
78 27         77 $tag |= substr($stream, $ptr + $bits - $off, 1);
79             }
80             # print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
81             # print STDERR "tag to large\n" if($tag>$nextcode);
82 3         7 $ptr += $bits;
83 3 100       9 if ($tag == $resetcode) {
    100          
    50          
    0          
84 1         2 $bits = $ibits;
85 1         1 $nextcode = $endcode + 1;
86 1         3 next;
87             }
88             elsif ($tag == $endcode) {
89 1         2 last;
90             }
91             elsif ($tag < $resetcode) {
92 1         11 $d[$nextcode] = $d[$tag];
93 1         3 $out .= $d[$nextcode];
94 1         2 $nextcode++;
95             }
96             elsif ($tag > $endcode) {
97 0         0 $d[$nextcode] = $d[$tag];
98 0         0 $d[$nextcode] .= substr($d[$tag + 1], 0, 1);
99 0         0 $out .= $d[$nextcode];
100 0         0 $nextcode++;
101             }
102 1 50       5 $bits++ if $nextcode == (1 << $bits);
103             }
104 1         20 return $out;
105             }
106              
107             sub handle_generic {
108 2     2 0 12 my ($self, $pdf, $tif) = @_;
109              
110 2 50       5 if ($tif->{'filter'}) {
111             # should we die here?
112             # die "unknown tiff-compression";
113 0         0 $self->filters($tif->{filter});
114 0         0 $self->{' nofilt'} = 1;
115             }
116             else {
117 2         20 $self->filters('FlateDecode');
118             }
119              
120 2 50       5 if (ref($tif->{'imageOffset'})) {
121 0         0 $self->{' stream'} = '';
122 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
123 0         0 foreach (1..$d) {
124 0         0 my $buf;
125 0         0 $tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}), 0);
  0         0  
126 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
127 0         0 $self->{' stream'} .= $buf;
128             }
129             }
130             else {
131 2         10 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
132 2         47 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
133             }
134              
135 2         43 return $self;
136             }
137              
138             sub handle_flate {
139 0     0 0 0 my ($self, $pdf, $tif) = @_;
140 0         0 $self->filters('FlateDecode');
141              
142 0 0       0 if (ref($tif->{'imageOffset'})) {
143 0         0 $self->{' stream'} = '';
144 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
145 0         0 foreach (1 .. $d) {
146 0         0 my $buf;
147 0         0 $tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}),0);
  0         0  
148 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
149 0         0 $buf=uncompress($buf);
150 0         0 $self->{' stream'} .= $buf;
151             }
152             }
153             else {
154 0         0 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
155 0         0 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
156 0         0 $self->{' stream'} = uncompress($self->{' stream'});
157             }
158              
159 0         0 return $self;
160             }
161              
162             sub handle_lzw {
163 1     1 0 3 my ($self, $pdf, $tif) = @_;
164 1         5 $self->filters('FlateDecode');
165 1         2 my $imageWidth = $tif->{'imageWidth'};
166 1         3 my $mod = $imageWidth % 8;
167 1 50       4 if ($mod > 0) {
168 1         2 $imageWidth += 8 - $mod;
169             }
170 1         4 my $max_raw_strip = $imageWidth * $tif->{'bitsPerSample'} * $tif->{'RowsPerStrip'} / 8;
171              
172 1 50       3 if (ref($tif->{'imageOffset'})) {
173 0         0 $self->{' stream'}='';
174 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
175 0         0 foreach (1 .. $d) {
176 0         0 my $buf;
177 0         0 $tif->{'fh'}->seek(shift(@{$tif->{imageOffset}}), 0);
  0         0  
178 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
179 0         0 $buf = deLZW(9, $buf);
180 0 0       0 if (length($buf) > $max_raw_strip) {
181 0         0 $buf = substr($buf, 0, $max_raw_strip);
182             }
183 0         0 $self->{' stream'} .= $buf;
184             }
185             }
186             else {
187 1         5 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
188 1         24 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
189 1         21 $self->{' stream'} = deLZW(9, $self->{' stream'});
190             }
191              
192 1         2 return $self;
193             }
194              
195             sub handle_ccitt {
196 0     0 0 0 my ($self, $pdf, $tif) = @_;
197              
198 0         0 $self->{' nofilt'} = 1;
199 0         0 $self->{'Filter'} = PDFName('CCITTFaxDecode');
200 0         0 $self->{'DecodeParms'} = PDFDict();
201 0 0 0     0 $self->{'DecodeParms'}->{'K'} = (($tif->{'ccitt'} == 4 || ($tif->{'g3Options'} & 0x1)) ? PDFNum(-1) : PDFNum(0));
202 0         0 $self->{'DecodeParms'}->{'Columns'} = PDFNum($tif->{'imageWidth'});
203 0         0 $self->{'DecodeParms'}->{'Rows'} = PDFNum($tif->{'imageHeight'});
204 0 0       0 $self->{'DecodeParms'}->{'Blackls1'} = PDFBool($tif->{'whiteIsZero'} == 1 ? 1 : 0);
205 0 0 0     0 if (defined($tif->{'g3Options'}) && ($tif->{'g3Options'} & 0x4)) {
206 0         0 $self->{'DecodeParms'}->{'EndOfLine'} = PDFBool(1);
207 0         0 $self->{'DecodeParms'}->{'EncodedByteAlign'} = PDFBool(1);
208             }
209             # $self->{'DecodeParms'} = PDFArray($self->{'DecodeParms'});
210 0         0 $self->{'DecodeParms'}->{'DamagedRowsBeforeError'} = PDFNum(100);
211              
212 0 0       0 if (ref($tif->{'imageOffset'})) {
213 0         0 die "chunked ccitt g4 tif not supported.";
214             }
215             else {
216 0         0 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
217 0         0 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
218             }
219              
220 0         0 return $self;
221             }
222              
223             sub read_tiff {
224 3     3 0 7 my ($self, $pdf, $tif) = @_;
225              
226 3         17 $self->width($tif->{'imageWidth'});
227 3         11 $self->height($tif->{'imageHeight'});
228 3 50       9 if ($tif->{'colorSpace'} eq 'Indexed') {
229 0         0 my $dict = PDFDict();
230 0         0 $pdf->new_obj($dict);
231 0         0 $self->colorspace(PDFArray(PDFName($tif->{'colorSpace'}), PDFName('DeviceRGB'), PDFNum(255), $dict));
232 0         0 $dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
233 0         0 $tif->{'fh'}->seek($tif->{'colorMapOffset'}, 0);
234 0         0 my $colormap;
235             my $straight;
236 0         0 $tif->{'fh'}->read($colormap, $tif->{'colorMapLength'});
237 0         0 $dict->{' stream'} = '';
238 0         0 $straight .= pack('C', ($_ / 256)) for unpack($tif->{'short'} . '*', $colormap);
239 0         0 foreach my $c (0 .. (($tif->{'colorMapSamples'} / 3) - 1)) {
240 0         0 $dict->{' stream'} .= substr($straight, $c, 1);
241 0         0 $dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'} / 3), 1);
242 0         0 $dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'} / 3) * 2, 1);
243             }
244             }
245             else {
246 3         11 $self->colorspace($tif->{'colorSpace'});
247             }
248              
249 3         26 $self->{'Interpolate'} = PDFBool(1);
250 3         14 $self->bpc($tif->{'bitsPerSample'});
251              
252 3 100 66     16 if ($tif->{'whiteIsZero'} == 1 && $tif->{'filter'} ne 'CCITTFaxDecode') {
253 1         3 $self->{'Decode'} = PDFArray(PDFNum(1), PDFNum(0));
254             }
255              
256             # check filters and handle seperately
257 3 50 66     22 if (defined $tif->{'filter'} and $tif->{'filter'} eq 'CCITTFaxDecode') {
    100 66        
    50 33        
258 0         0 $self->handle_ccitt($pdf, $tif);
259             }
260             elsif (defined $tif->{'filter'} and $tif->{'filter'} eq 'LZWDecode') {
261 1         4 $self->handle_lzw($pdf, $tif);
262             }
263             elsif (defined $tif->{'filter'} and $tif->{filter} eq 'FlateDecode') {
264 0         0 $self->handle_flate($pdf, $tif);
265             }
266             else {
267 2         6 $self->handle_generic($pdf, $tif);
268             }
269              
270 3 50       14 if ($tif->{'fillOrder'} == 2) {
271 0         0 my @bl = ();
272 0         0 foreach my $n (0 .. 255) {
273 0         0 my $b = $n;
274 0         0 my $f = 0;
275 0         0 foreach (0 .. 7) {
276 0         0 my $bit = 0;
277 0 0       0 if ($b & 0x1) {
278 0         0 $bit = 1;
279             }
280 0         0 $b >>= 1;
281 0         0 $f <<= 1;
282 0         0 $f |= $bit;
283             }
284 0         0 $bl[$n] = $f;
285             }
286 0         0 my $l = length($self->{' stream'}) - 1;
287 0         0 foreach my $n (0 .. $l) {
288 0         0 vec($self->{' stream'}, $n, 8) = $bl[vec($self->{' stream'}, $n, 8)];
289             }
290             }
291 3         6 $self->{' tiff'} = $tif;
292              
293 3         12 return $self;
294             }
295              
296             =item $value = $tif->tiffTag $tag
297              
298             returns the value of the internal tiff-tag.
299              
300             B
301              
302             imageDescription, imageId (strings)
303             xRes, yRes (dpi; pixel/cm if resUnit==3)
304             resUnit
305              
306             =cut
307              
308             sub tiffTag {
309 0     0 1   my ($self, $tag) = @_;
310 0           return $self->{' tiff'}->{$tag};
311             }
312              
313             =back
314              
315             =cut
316              
317             1;