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 0 4 0.0
total 179 266 67.2


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