File Coverage

blib/lib/PDF/Builder/Resource/XObject/Image/TIFF.pm
Criterion Covered Total %
statement 79 176 44.8
branch 18 44 40.9
condition 15 39 38.4
subroutine 13 16 81.2
pod 3 8 37.5
total 128 283 45.2


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Image::TIFF;
2              
3 2     2   880 use base 'PDF::Builder::Resource::XObject::Image';
  2         4  
  2         728  
4              
5 2     2   12 use strict;
  2         4  
  2         34  
6 2     2   8 use warnings;
  2         4  
  2         78  
7              
8             our $VERSION = '3.024'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11 2     2   10 use Compress::Zlib;
  2         3  
  2         553  
12              
13 2     2   13 use PDF::Builder::Basic::PDF::Utils;
  2         10  
  2         148  
14 2     2   1157 use PDF::Builder::Resource::XObject::Image::TIFF::File;
  2         4  
  2         63  
15 2     2   13 use PDF::Builder::Util;
  2         3  
  2         228  
16 2     2   11 use Scalar::Util qw(weaken);
  2         4  
  2         3261  
17              
18             =head1 NAME
19              
20             PDF::Builder::Resource::XObject::Image::TIFF - TIFF image support
21              
22             =head1 METHODS
23              
24             =over
25              
26             =item $res = PDF::Builder::Resource::XObject::Image::TIFF->new($pdf, $file, %opts)
27              
28             Returns a TIFF-image object.
29              
30             If the Graphics::TIFF package is installed, the TIFF_GT library will be used
31             instead of the TIFF library. In such a case, use of the TIFF library may be
32             forced via the C flag (see Builder documentation for C).
33              
34             Options:
35              
36             =over
37              
38             =item 'name' => 'string'
39              
40             This is the name you can give for the TIFF image object. The default is Ixnnnn.
41              
42             =back
43              
44             =cut
45              
46             sub new {
47 4     4 1 13 my ($class, $pdf, $file, %opts) = @_;
48             # copy dashed option names to preferred undashed names
49 4 50 33     14 if (defined $opts{'-nouseGT'} && !defined $opts{'nouseGT'}) { $opts{'nouseGT'} = delete($opts{'-nouseGT'}); }
  0         0  
50 4 50 33     8 if (defined $opts{'-name'} && !defined $opts{'name'}) { $opts{'name'} = delete($opts{'-name'}); }
  0         0  
51 4 50 33     10 if (defined $opts{'-compress'} && !defined $opts{'compress'}) { $opts{'compress'} = delete($opts{'-compress'}); }
  0         0  
52              
53 4         7 my ($name, $compress);
54 4 50       9 if (exists $opts{'name'}) { $name = $opts{'name'}; }
  0         0  
55             #if (exists $opts{'compress'}) { $compress = $opts{'compress'}; }
56              
57 4         4 my $self;
58              
59 4         17 my $tif = PDF::Builder::Resource::XObject::Image::TIFF::File->new($file, %opts);
60              
61             # dump everything in tif except huge data streams
62             # foreach (sort keys %{ $tif }) {
63             # if ($_ eq ' stream') { next; }
64             # if ($_ eq ' apipdf') { next; }
65             # if ($_ eq ' realised') { next; }
66             # if ($_ eq ' uid') { next; }
67             # if (defined $tif->{$_}) {
68             # print "\$tif->{'$_'} = '".($tif->{$_})."'\n";
69             # } else {
70             # print "\$tif->{'$_'} = ?\n";
71             # }
72             # }
73              
74             # in case of problematic things
75             # proxy to other modules
76              
77 3 50       8 $class = ref($class) if ref($class);
78              
79 3   33     11 $self = $class->SUPER::new($pdf, $name || 'Ix'.pdfkey());
80 3 50       7 $pdf->new_obj($self) unless $self->is_obj($pdf);
81              
82 3         6 $self->{' apipdf'} = $pdf;
83 3         7 weaken $self->{' apipdf'};
84              
85 3         7 $self->read_tiff($pdf, $tif);
86              
87 3         10 $tif->close();
88              
89 3         62 return $self;
90             }
91              
92             =item $mode = $tif->usesLib()
93              
94             Returns 1 if Graphics::TIFF installed and used, 0 if not installed, or -1 if
95             installed but not used (nouseGT option given to C).
96              
97             B this method can only be used I the image object has been
98             created. It can't tell you whether Graphics::TIFF is available in
99             advance of actually using it, in case you want to use some functionality
100             available only in TIFF_GT. See the LA_GT() call if you
101             need to know in advance.
102              
103             =cut
104              
105             sub usesLib {
106 2     2 1 8 my ($self) = shift;
107             # should be 0 for Graphics::TIFF not installed, or -1 for is installed,
108             # but not using it
109 2         5 return $self->{'usesGT'}->val();
110             }
111              
112             sub handle_generic {
113 2     2 0 4 my ($self, $pdf, $tif) = @_;
114              
115 2 50       3 if ($tif->{'filter'}) {
116             # should we die here ?
117             # die "unknown tiff-compression ";
118 0         0 $self->filters($tif->{'filter'});
119 0         0 $self->{' nofilt'} = 1;
120             } else {
121 2         7 $self->filters('FlateDecode');
122             }
123              
124 2 50       4 if (ref($tif->{'imageOffset'})) {
125 0         0 $self->{' stream'} = '';
126 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
127 0         0 foreach (1 .. $d) {
128 0         0 my $buf;
129 0         0 $tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}), 0);
  0         0  
130 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
131 0         0 $self->{' stream'} .= $buf;
132             }
133             } else {
134 2         7 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
135 2         37 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
136             }
137              
138 2         33 return $self;
139             }
140              
141             sub handle_flate {
142 0     0 0 0 my ($self, $pdf, $tif) = @_;
143              
144 0         0 $self->filters('FlateDecode');
145              
146 0 0       0 if (ref($tif->{'imageOffset'})) {
147 0         0 $self->{' stream'} = '';
148 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
149 0         0 foreach (1 .. $d) {
150 0         0 my $buf;
151 0         0 $tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}), 0);
  0         0  
152 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
153 0         0 $buf = uncompress($buf);
154 0         0 $self->{' stream'} .= $buf;
155             }
156             } else {
157 0         0 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
158 0         0 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
159 0         0 $self->{' stream'} = uncompress($self->{' stream'});
160             }
161              
162 0         0 return $self;
163             }
164              
165             sub handle_lzw {
166 1     1 0 2 my ($self, $pdf, $tif) = @_;
167              
168 1         2 $self->{' nofilt'} = 1;
169 1         3 $self->{'Filter'} = PDFArray(PDFName('LZWDecode'));
170 1         3 my $decode = PDFDict();
171 1         13 $self->{'DecodeParms'} = PDFArray($decode);
172 1         3 $decode->{'Columns'} = PDFNum($tif->{'imageWidth'});
173 1         4 $decode->{'Rows'} = PDFNum($tif->{'imageHeight'});
174 1         3 $decode->{'DamagedRowsBeforeError'} = PDFNum(100);
175 1         2 $decode->{'EndOfLine'} = PDFBool(1);
176 1         2 $decode->{'EncodedByteAlign'} = PDFBool(1);
177 1 50 33     4 if (defined $tif->{'Predictor'} and $tif->{'Predictor'} > 1) {
178 0         0 $decode->{'Predictor'} = PDFNum($tif->{'Predictor'});
179             }
180              
181 1 50       3 if (ref($tif->{'imageOffset'})) {
182 0         0 $self->{' stream'} = '';
183 0         0 my $d = scalar @{$tif->{'imageOffset'}};
  0         0  
184 0         0 foreach (1 .. $d) {
185 0         0 $tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}), 0);
  0         0  
186 0         0 my $buf;
187 0         0 $tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
  0         0  
188 0         0 my $filter = PDF::Builder::Basic::PDF::Filter::LZWDecode->new();
189 0         0 $self->{' stream'} .= $filter->infilt($buf);
190             }
191 0         0 my $filter = PDF::Builder::Basic::PDF::Filter::LZWDecode->new();
192 0         0 $self->{' stream'} = $filter->outfilt($self->{' stream'});
193             } else {
194 1         5 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
195 1         18 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
196             }
197              
198 1         19 return $self;
199             }
200              
201             sub handle_ccitt {
202 0     0 0 0 my ($self, $pdf, $tif) = @_;
203              
204 0         0 $self->{' nofilt'} = 1;
205 0         0 $self->{'Filter'} = PDFName('CCITTFaxDecode');
206 0         0 $self->{'DecodeParms'} = PDFDict();
207             $self->{'DecodeParms'}->{'K'} = ($tif->{'ccitt'} == 4 ||
208 0 0 0     0 (($tif->{'g3Options'}||0) & 0x1))? PDFNum(-1): PDFNum(0);
209 0         0 $self->{'DecodeParms'}->{'Columns'} = PDFNum($tif->{'imageWidth'});
210 0         0 $self->{'DecodeParms'}->{'Rows'} = PDFNum($tif->{'imageHeight'});
211             $self->{'DecodeParms'}->{'BlackIs1'} =
212 0 0 0     0 PDFBool(($tif->{'whiteIsZero'}||0) == 0? 1: 0);
213 0 0 0     0 if (defined($tif->{'g3Options'}) && ($tif->{'g3Options'} & 0x4)) {
214 0         0 $self->{'DecodeParms'}->{'EndOfLine'} = PDFBool(1);
215 0         0 $self->{'DecodeParms'}->{'EncodedByteAlign'} = PDFBool(1);
216             }
217             # $self->{'DecodeParms'} = PDFArray($self->{'DecodeParms'});
218 0         0 $self->{'DecodeParms'}->{'DamagedRowsBeforeError'} = PDFNum(100);
219              
220 0 0       0 if (ref($tif->{'imageOffset'})) {
221 0         0 die "Chunked CCITT G4 TIFF not supported.";
222             } else {
223 0         0 $tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
224 0         0 $tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
225             }
226              
227 0         0 return $self;
228             }
229              
230             sub read_tiff {
231 3     3 0 6 my ($self, $pdf, $tif) = @_;
232              
233 3         10 $self->width($tif->{'imageWidth'});
234 3         10 $self->height($tif->{'imageHeight'});
235 3 50       8 if ($tif->{'colorSpace'} eq 'Indexed') {
236 0         0 my $dict = PDFDict();
237 0         0 $pdf->new_obj($dict);
238             $self->colorspace(PDFArray(PDFName($tif->{'colorSpace'}),
239 0         0 PDFName('DeviceRGB'), PDFNum(2**$tif->{'bitsPerSample'}-1), $dict));
240 0         0 $dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
241 0         0 $tif->{'fh'}->seek($tif->{'colorMapOffset'}, 0);
242 0         0 my $colormap;
243             my $straight;
244 0         0 $tif->{'fh'}->read($colormap, $tif->{'colorMapLength'});
245 0         0 $dict->{' stream'} = '';
246 0         0 $straight .= pack('C', ($_/256)) for
247             unpack($tif->{'short'} . '*', $colormap);
248 0         0 foreach my $c (0 .. (($tif->{'colorMapSamples'}/3)-1)) {
249 0         0 $dict->{' stream'} .= substr($straight, $c, 1);
250 0         0 $dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'}/3), 1);
251 0         0 $dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'}/3)*2, 1);
252             }
253             } else {
254 3         9 $self->colorspace($tif->{'colorSpace'});
255             }
256              
257 3         7 $self->{'Interpolate'} = PDFBool(1);
258 3         22 $self->bits_per_component($tif->{'bitsPerSample'});
259              
260             # swaps 0 and 1 ([0 1] -> [1 0]) in certain cases
261 3 100 100     15 if (($tif->{'whiteIsZero'}||0) == 1 &&
      50        
      66        
262             ($tif->{'filter'}||'') ne 'CCITTFaxDecode') {
263 1         4 $self->{'Decode'} = PDFArray(PDFNum(1), PDFNum(0));
264             }
265              
266             # check filters and handle separately
267 3 50 66     17 if (defined $tif->{'filter'} and $tif->{'filter'} eq 'CCITTFaxDecode') {
    100 66        
    50 33        
268 0         0 $self->handle_ccitt($pdf, $tif);
269             } elsif (defined $tif->{'filter'} and $tif->{'filter'} eq 'LZWDecode') {
270 1         3 $self->handle_lzw($pdf, $tif);
271             } elsif (defined $tif->{'filter'} and $tif->{'filter'} eq 'FlateDecode') {
272 0         0 $self->handle_flate($pdf, $tif);
273             } else {
274 2         4 $self->handle_generic($pdf, $tif);
275             }
276              
277             # # dump everything in self except huge data streams
278             # foreach (sort keys %{ $self }) {
279             # if ($_ eq ' stream') { next; }
280             # if ($_ eq ' apipdf') { next; }
281             # if ($_ eq ' realised') { next; }
282             # if ($_ eq ' uid') { next; }
283             # if (defined $self->{$_}) {
284             # print "\$self->{'$_'} = '".($self->{$_}->val())."'\n";
285             # } else {
286             # print "\$self->{'$_'} = ?\n";
287             # }
288             # }
289              
290 3 50       7 if ($tif->{'fillOrder'} == 2) {
291 0         0 my @bl = ();
292 0         0 foreach my $n (0 .. 255) {
293 0         0 my $b = $n;
294 0         0 my $f = 0;
295 0         0 foreach (0 .. 7) {
296 0         0 my $bit = 0;
297 0 0       0 if ($b & 0x1) {
298 0         0 $bit = 1;
299             }
300 0         0 $b >>= 1;
301 0         0 $f <<= 1;
302 0         0 $f |= $bit;
303             }
304 0         0 $bl[$n] = $f;
305             }
306 0         0 my $l = length($self->{' stream'}) - 1;
307 0         0 foreach my $n (0 .. $l) {
308 0         0 vec($self->{' stream'}, $n, 8) = $bl[vec($self->{' stream'}, $n, 8)];
309             }
310             }
311 3         6 $self->{' tiff'} = $tif;
312              
313 3         4 return $self;
314             }
315              
316             =item $value = $tif->tiffTag($tag)
317              
318             returns the value of the internal tiff-tag.
319              
320             B
321              
322             imageDescription, imageId (strings)
323             xRes, yRes (dpi; pixel/cm if resUnit==3)
324             resUnit
325              
326             =cut
327              
328             sub tiffTag {
329 0     0 1   my ($self, $tag) = @_;
330 0           return $self->{' tiff'}->{$tag};
331             }
332              
333             =back
334              
335             =cut
336              
337             1;