File Coverage

blib/lib/PDF/Builder/Resource/XObject/Image/TIFF/File.pm
Criterion Covered Total %
statement 102 142 71.8
branch 69 104 66.3
condition 1 9 11.1
subroutine 7 7 100.0
pod 1 4 25.0
total 180 266 67.6


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Image::TIFF::File;
2              
3 2     2   12 use strict;
  2         4  
  2         82  
4 2     2   39 use warnings;
  2         5  
  2         176  
5              
6             our $VERSION = '3.028'; # VERSION
7             our $LAST_UPDATE = '3.027'; # manually update whenever code is changed
8              
9 2     2   13 use IO::File;
  2         3  
  2         3783  
10              
11             =head1 NAME
12              
13             PDF::Builder::Resource::XObject::Image::TIFF::File - Support routines for TIFF image library
14              
15             =head1 METHODS
16              
17             =head2 new
18              
19             PDF::Builder::Resource::XObject::Image::TIFF::File->new()
20              
21             =over
22              
23             Create a TIFF image object, I<not> using the Graphics::TIFF library.
24             Remember to use the Builder.pm method image_tiff.
25              
26             =back
27              
28             =cut
29              
30             sub new {
31 4     4 1 12 my ($class, $file) = @_;
32              
33 4         9 my $self = {};
34 4         11 bless ($self, $class);
35 4 100       16 if (ref($file)) {
36 1         3 $self->{'fh'} = $file;
37 1         9 seek($self->{'fh'}, 0, 0);
38             } else {
39 3         27 $self->{'fh'} = IO::File->new();
40 3 100       432 open($self->{'fh'}, '<', $file) or die "$!: $file";
41             }
42 3         18 binmode($self->{'fh'}, ':raw');
43 3         8 my $fh = $self->{'fh'};
44              
45 3         12 $self->{'offset'} = 0;
46 3         46 $fh->seek($self->{'offset'}, 0);
47              
48             # checking byte order of data
49 3         54 $fh->read($self->{'byteOrder'}, 2);
50 3         215 $self->{'byte'} = 'C';
51 3 50       24 $self->{'short'} = (($self->{'byteOrder'} eq 'MM')? 'n': 'v');
52 3 50       12 $self->{'long'} = (($self->{'byteOrder'} eq 'MM')? 'N': 'V');
53 3 50       15 $self->{'rational'} = (($self->{'byteOrder'} eq 'MM')? 'NN': 'VV');
54              
55             # get/check version id
56 3         21 $fh->read($self->{'version'}, 2);
57 3         34 $self->{'version'} = unpack($self->{'short'}, $self->{'version'});
58 3 50       11 die "Wrong TIFF Id '" . $self->{'version'} . "' (should be 42)." if $self->{'version'} != 42;
59              
60             # get the offset to the first tag directory.
61 3         13 $fh->read($self->{'ifdOffset'}, 4);
62 3         25 $self->{'ifdOffset'} = unpack($self->{'long'}, $self->{'ifdOffset'});
63              
64 3         14 $self->readTags();
65              
66 3         11 return $self;
67             }
68              
69             sub readTag {
70 61     61 0 103 my $self = shift;
71              
72 61         106 my $fh = $self->{'fh'};
73 61         96 my $buf;
74 61         178 $fh->read($buf, 12);
75 61         397 my $tag = unpack($self->{'short'}, substr($buf, 0, 2));
76 61         170 my $type = unpack($self->{'short'}, substr($buf, 2, 2));
77 61         131 my $count = unpack($self->{'long'}, substr($buf, 4, 4));
78 61         98 my $len = 0;
79              
80 61 100       184 $len = ($type == 1? $count : # byte
    100          
    100          
    100          
    100          
81             $type == 2? $count : # char2
82             $type == 3? $count*2: # int16
83             $type == 4? $count*4: # int32
84             $type == 5? $count*8: # rational: 2 * int32
85             $count);
86              
87 61         108 my $off = substr($buf, 8, 4);
88              
89 61 100       142 if ($len > 4) {
90 22         67 $off = unpack($self->{'long'}, $off);
91             } else {
92             $off = ($type == 1? unpack($self->{'byte'}, $off):
93             $type == 2? unpack($self->{'long'}, $off):
94             $type == 3? unpack($self->{'short'}, $off):
95             $type == 4? unpack($self->{'long'}, $off):
96 39 50       128 unpack($self->{'short'}, $off) );
    100          
    50          
    50          
97             }
98              
99 61         203 return ($tag, $type, $count, $len, $off);
100             }
101              
102             sub close { ## no critic
103 3     3 0 7 my $self = shift;
104              
105 3         19 return $self->{'fh'}->close();
106             }
107              
108             sub readTags {
109 3     3 0 6 my $self = shift;
110              
111 3         7 my $fh = $self->{'fh'};
112 3         9 $self->{'fillOrder'} = 1;
113 3         16 $self->{'ifd'} = $self->{'ifdOffset'};
114              
115 3         11 while ($self->{'ifd'} > 0) {
116 3         13 $fh->seek($self->{'ifd'}, 0);
117 3         51 $fh->read($self->{'ifdNum'}, 2);
118 3         81 $self->{'ifdNum'} = unpack($self->{'short'}, $self->{'ifdNum'});
119 3         7 $self->{'bitsPerSample'} = 1;
120 3         14 foreach (1 .. $self->{'ifdNum'}) {
121 61         149 my ($valTag, $valType, $valCount, $valLen, $valOffset) = $self->readTag();
122             # print "tag=$valTag type=$valType count=$valCount len=$valLen off=$valOffset\n";
123 61 50       432 if ($valTag == 0) {
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
124             # no-op
125             } elsif ($valTag == 256) {
126 3         10 $self->{'imageWidth'} = $valOffset;
127             } elsif ($valTag == 257) {
128 3         9 $self->{'imageHeight'} = $valOffset;
129             } elsif ($valTag == 258) {
130             # bits per sample
131 3 100       10 if ($valCount > 1) {
132 2         14 my $here = $fh->tell();
133 2         13 my $val;
134 2         9 $fh->seek($valOffset, 0);
135 2         30 $fh->read($val, 2);
136 2         27 $self->{'bitsPerSample'} = unpack($self->{'short'}, $val);
137 2         9 $fh->seek($here, 0);
138             } else {
139 1         4 $self->{'bitsPerSample'} = $valOffset;
140             }
141             } elsif ($valTag == 259) {
142             # compression
143 3         10 $self->{'filter'} = $valOffset;
144 3 100 33     41 if ($valOffset == 1) {
    50 0        
    50 0        
    0          
    0          
    0          
145 2         8 delete $self->{'filter'};
146             } elsif ($valOffset == 3 || $valOffset == 4) {
147 0         0 $self->{'filter'} = 'CCITTFaxDecode';
148 0         0 $self->{'ccitt'} = $valOffset;
149             } elsif ($valOffset == 5) {
150 1         3 $self->{'filter'} = 'LZWDecode';
151             } elsif ($valOffset == 6 || $valOffset == 7) {
152 0         0 $self->{'filter'} = 'DCTDecode';
153             } elsif ($valOffset == 8 || $valOffset == 0x80b2) {
154 0         0 $self->{'filter'} = 'FlateDecode';
155             } elsif ($valOffset == 32773) {
156 0         0 $self->{'filter'} = 'RunLengthDecode';
157             } else {
158 0         0 die "unknown/unsupported TIFF compression method with id '" . $self->{'filter'} . "'.";
159             }
160             } elsif ($valTag == 262) {
161             # photometric interpretation
162 3         8 $self->{'colorSpace'} = $valOffset;
163 3 100       23 if ($valOffset == 0) {
    50          
    50          
    0          
    0          
    0          
    0          
164 1         3 $self->{'colorSpace'} = 'DeviceGray';
165 1         3 $self->{'whiteIsZero'} = 1;
166             } elsif ($valOffset == 1) {
167 0         0 $self->{'colorSpace'} = 'DeviceGray';
168 0         0 $self->{'blackIsZero'} = 1;
169             } elsif ($valOffset == 2) {
170 2         8 $self->{'colorSpace'} = 'DeviceRGB';
171             } elsif ($valOffset == 3) {
172 0         0 $self->{'colorSpace'} = 'Indexed';
173             # } elsif ($valOffset == 4) {
174             # $self->{'colorSpace'} = 'TransMask';
175             } elsif ($valOffset == 5) {
176 0         0 $self->{'colorSpace'} = 'DeviceCMYK';
177             } elsif ($valOffset == 6) {
178 0         0 $self->{'colorSpace'} = 'DeviceRGB';
179             } elsif ($valOffset == 8) {
180 0         0 $self->{'colorSpace'} = 'Lab';
181             } else {
182 0         0 die "unknown/unsupported TIFF photometric interpretation with id '" . $self->{'colorSpace'} . "'.";
183             }
184             } elsif ($valTag == 266) {
185 0         0 $self->{'fillOrder'} = $valOffset;
186             } elsif ($valTag == 270) {
187             # ImageDescription
188 0         0 my $here = $fh->tell();
189 0         0 $fh->seek($valOffset, 0);
190 0         0 $fh->read($self->{'imageDescription'}, $valLen);
191 0         0 $fh->seek($here, 0);
192             } elsif ($valTag == 282) {
193             # xRes
194 3         13 my $here = $fh->tell();
195 3         50 $fh->seek($valOffset, 0);
196 3         53 $fh->read($self->{'xRes'}, $valLen);
197 3         66 $fh->seek($here, 0);
198 3         56 $self->{'xRes'} = [unpack($self->{'rational'}, $self->{'xRes'})];
199 3         17 $self->{'xRes'} = ($self->{'xRes'}->[0] / $self->{'xRes'}->[1]);
200             } elsif ($valTag == 283) {
201             # yRes
202 3         12 my $here = $fh->tell();
203 3         21 $fh->seek($valOffset, 0);
204 3         41 $fh->read($self->{'yRes'}, $valLen);
205 3         47 $fh->seek($here, 0);
206 3         36 $self->{'yRes'} = [unpack($self->{'rational'}, $self->{'yRes'})];
207 3         15 $self->{'yRes'} = ($self->{'yRes'}->[0] / $self->{'yRes'}->[1]);
208             } elsif ($valTag == 296) {
209             # resolution Unit
210 3         10 $self->{'resUnit'} = $valOffset;
211             } elsif ($valTag == 273) {
212             # image data offset/strip offsets
213 3 50       9 if ($valCount == 1) {
214 3         9 $self->{'imageOffset'} = $valOffset;
215             } else {
216 0         0 my $here = $fh->tell();
217 0         0 my $val;
218 0         0 $fh->seek($valOffset, 0);
219 0         0 $fh->read($val, $valLen);
220 0         0 $fh->seek($here, 0);
221 0         0 $self->{'imageOffset'} = [unpack($self->{'long'} . '*', $val)];
222             }
223             } elsif ($valTag == 277) {
224 3         9 $self->{'samplesPerPixel'} = $valOffset;
225             } elsif ($valTag == 278) {
226 3         9 $self->{'RowsPerStrip'} = $valOffset;
227             } elsif ($valTag == 279) {
228             # image data length/strip lengths
229 3 50       9 if ($valCount == 1) {
230 3         9 $self->{'imageLength'} = $valOffset;
231             } else {
232 0         0 my $here = $fh->tell();
233 0         0 my $val;
234 0         0 $fh->seek($valOffset, 0);
235 0         0 $fh->read($val, $valLen);
236 0         0 $fh->seek($here, 0);
237 0         0 $self->{'imageLength'} = [unpack($self->{'long'} . '*', $val)];
238             }
239             } elsif ($valTag == 292) {
240 0         0 $self->{'g3Options'} = $valOffset;
241             } elsif ($valTag == 293) {
242 0         0 $self->{'g4Options'} = $valOffset;
243             } elsif ($valTag == 320) {
244             # color map
245 0         0 $self->{'colorMapOffset'} = $valOffset;
246 0         0 $self->{'colorMapSamples'} = $valCount;
247 0         0 $self->{'colorMapLength'} = $valCount*2; # shorts!
248             } elsif ($valTag == 317) {
249 0         0 $self->{'Predictor'} = $valOffset;
250             } elsif ($valTag == 0x800d) {
251             # imageID
252 0         0 my $here = $fh->tell();
253 0         0 $fh->seek($valOffset, 0);
254 0         0 $fh->read($self->{'imageId'}, $valLen);
255 0         0 $fh->seek($here, 0);
256             # } else {
257             # print "tag=$valTag, type=$valType, len=$valLen\n";
258             }
259             } # end foreach loop
260            
261 3         12 $fh->read($self->{'ifd'}, 4);
262 3         26 $self->{'ifd'} = unpack($self->{'long'}, $self->{'ifd'});
263             } # end while loop
264              
265 3         7 return $self;
266             }
267              
268             1;