source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/BigTIFF.pm@ 24626

Last change on this file since 24626 was 24626, checked in by jmt12, 13 years ago

An (almost) complete copy of the perllib directory from a (circa SEP2011) head checkout from Greenstone 2 trunk - in order to try and make merging in this extension a little easier later on (as there have been some major changes to buildcol.pl commited in the main trunk but not in the x64 branch)
File size: 11.0 KB
Line 
1#------------------------------------------------------------------------------
2# File: BigTIFF.pm
3#
4# Description: Read Big TIFF meta information
5#
6# Revisions: 07/03/2007 - P. Harvey Created
7#
8# References: 1) http://www.awaresystems.be/imaging/tiff/bigtiff.html
9#------------------------------------------------------------------------------
10
11package Image::ExifTool::BigTIFF;
12
13use strict;
14use vars qw($VERSION);
15use Image::ExifTool qw(:DataAccess :Utils);
16use Image::ExifTool::Exif;
17
18$VERSION = '1.05';
19
20my $maxOffset = 0x7fffffff; # currently supported maximum data offset/size
21
22#------------------------------------------------------------------------------
23# Process Big IFD directory
24# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
25# Returns: 1 on success, otherwise returns 0 and sets a Warning
26sub ProcessBigIFD($$$)
27{
28 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
29 my $raf = $$dirInfo{RAF};
30 my $verbose = $exifTool->{OPTIONS}->{Verbose};
31 my $htmlDump = $exifTool->{HTML_DUMP};
32 my $dirName = $$dirInfo{DirName};
33 my $dirStart = $$dirInfo{DirStart};
34
35 $verbose = -1 if $htmlDump; # mix htmlDump into verbose so we can test for both at once
36
37 # loop through IFD chain
38 for (;;) {
39 if ($dirStart > $maxOffset and not $exifTool->Options('LargeFileSupport')) {
40 $exifTool->Warn('Huge offsets not supported (LargeFileSupport not set)');
41 last;
42 }
43 unless ($raf->Seek($dirStart, 0)) {
44 $exifTool->Warn("Bad $dirName offset");
45 return 0;
46 }
47 my ($dirBuff, $index);
48 unless ($raf->Read($dirBuff, 8) == 8) {
49 $exifTool->Warn("Truncated $dirName count");
50 return 0;
51 }
52 my $numEntries = Image::ExifTool::Get64u(\$dirBuff, 0);
53 $verbose > 0 and $exifTool->VerboseDir($dirName, $numEntries);
54 my $bsize = $numEntries * 20;
55 if ($bsize > $maxOffset) {
56 $exifTool->Warn('Huge directory counts not yet supported');
57 last;
58 }
59 my $bufPos = $raf->Tell();
60 unless ($raf->Read($dirBuff, $bsize) == $bsize) {
61 $exifTool->Warn("Truncated $dirName directory");
62 return 0;
63 }
64 my $nextIFD;
65 $raf->Read($nextIFD, 8) == 8 or undef $nextIFD; # try to read next IFD pointer
66 if ($htmlDump) {
67 $exifTool->HDump($bufPos-8, 8, "$dirName entries", "Entry count: $numEntries");
68 if (defined $nextIFD) {
69 my $tip = sprintf("Offset: 0x%.8x", Image::ExifTool::Get64u(\$nextIFD, 0));
70 $exifTool->HDump($bufPos + 20 * $numEntries, 8, "Next IFD", $tip, 0);
71 }
72 }
73 # loop through all entries in this BigTIFF IFD
74 for ($index=0; $index<$numEntries; ++$index) {
75 my $entry = 20 * $index;
76 my $tagID = Get16u(\$dirBuff, $entry);
77 my $format = Get16u(\$dirBuff, $entry+2);
78 my $count = Image::ExifTool::Get64u(\$dirBuff, $entry+4);
79 my $formatSize = $Image::ExifTool::Exif::formatSize[$format];
80 unless (defined $formatSize) {
81 $exifTool->HDump($bufPos+$entry,20,"[invalid IFD entry]",
82 "Bad format value: $format", 1);
83 # warn unless the IFD was just padded with zeros
84 $exifTool->Warn(sprintf("Unknown format ($format) for $dirName tag 0x%x",$tagID));
85 return 0; # assume corrupted IFD
86 }
87 my $formatStr = $Image::ExifTool::Exif::formatName[$format];
88 my $size = $count * $formatSize;
89 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tagID);
90 next unless defined $tagInfo or $verbose;
91 my $valuePtr = $entry + 12;
92 my ($valBuff, $valBase);
93 if ($size > 8) {
94 if ($size > $maxOffset) {
95 $exifTool->Warn("Can't handle $dirName entry $index (huge size)");
96 next;
97 }
98 $valuePtr = Image::ExifTool::Get64u(\$dirBuff, $valuePtr);
99 if ($valuePtr > $maxOffset and not $exifTool->Options('LargeFileSupport')) {
100 $exifTool->Warn("Can't handle $dirName entry $index (LargeFileSupport not set)");
101 next;
102 }
103 unless ($raf->Seek($valuePtr, 0) and $raf->Read($valBuff, $size) == $size) {
104 $exifTool->Warn("Error reading $dirName entry $index");
105 next;
106 }
107 $valBase = 0;
108 } else {
109 $valBuff = substr($dirBuff, $valuePtr, $size);
110 $valBase = $bufPos;
111 }
112 if (defined $tagInfo and not $tagInfo) {
113 # GetTagInfo() required the value for a Condition
114 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tagID, \$valBuff);
115 }
116 my $val = ReadValue(\$valBuff, 0, $formatStr, $count, $size);
117 if ($htmlDump) {
118 my $tval = $val;
119 if ($formatStr =~ /^rational64([su])$/) {
120 # show numerator/denominator separately
121 my $f = ReadValue(\$valBuff, 0, "int32$1", $count*2, $size);
122 $f =~ s/(-?\d+) (-?\d+)/$1\/$2/g;
123 $tval .= " ($f)";
124 }
125 my ($tagName, $colName);
126 if ($tagID == 0x927c and $dirName eq 'ExifIFD') {
127 $tagName = 'MakerNotes';
128 } elsif ($tagInfo) {
129 $tagName = $$tagInfo{Name};
130 } else {
131 $tagName = sprintf("Tag 0x%.4x",$tagID);
132 }
133 my $dname = sprintf("$dirName-%.2d", $index);
134 # build our tool tip
135 my $tip = sprintf("Tag ID: 0x%.4x\n", $tagID) .
136 "Format: $formatStr\[$count]\nSize: $size bytes\n";
137 if ($size > 8) {
138 $tip .= sprintf("Value offset: 0x%.8x\n", $valuePtr);
139 $colName = "<span class=H>$tagName</span>";
140 } else {
141 $colName = $tagName;
142 }
143 $tval = substr($tval,0,28) . '[...]' if length($tval) > 32;
144 if ($formatStr =~ /^(string|undef|binary)/) {
145 # translate non-printable characters
146 $tval =~ tr/\x00-\x1f\x7f-\xff/./;
147 } elsif ($tagInfo and Image::ExifTool::IsInt($tval)) {
148 if ($$tagInfo{IsOffset}) {
149 $tval = sprintf('0x%.4x', $tval);
150 } elsif ($$tagInfo{PrintHex}) {
151 $tval = sprintf('0x%x', $tval);
152 }
153 }
154 $tip .= "Value: $tval";
155 $exifTool->HDump($entry+$bufPos, 20, "$dname $colName", $tip, 1);
156 if ($size > 8) {
157 # add value data block
158 my $flg = ($tagInfo and $$tagInfo{SubDirectory} and $$tagInfo{MakerNotes}) ? 4 : 0;
159 $exifTool->HDump($valuePtr,$size,"$tagName value",'SAME', $flg);
160 }
161 }
162 if ($tagInfo and $$tagInfo{SubIFD}) {
163 # process all SubIFD's as BigTIFF
164 $verbose > 0 and $exifTool->VerboseInfo($tagID, $tagInfo,
165 Table => $tagTablePtr,
166 Index => $index,
167 Value => $val,
168 DataPt => \$valBuff,
169 DataPos => $valBase + $valuePtr,
170 Start => 0,
171 Size => $size,
172 Format => $formatStr,
173 Count => $count,
174 );
175 my @offsets = split ' ', $val;
176 my $i;
177 for ($i=0; $i<scalar(@offsets); ++$i) {
178 my $subdirName = $$tagInfo{Name};
179 $subdirName .= $i if $i;
180 my %subdirInfo = (
181 RAF => $raf,
182 DataPos => 0,
183 DirStart => $offsets[$i],
184 DirName => $subdirName,
185 Parent => $dirInfo,
186 );
187 $exifTool->ProcessDirectory(\%subdirInfo, $tagTablePtr, \&ProcessBigIFD);
188 }
189 } else {
190 my $tagKey = $exifTool->HandleTag($tagTablePtr, $tagID, $val,
191 Index => $index,
192 DataPt => \$valBuff,
193 DataPos => $valBase + $valuePtr,
194 Start => 0,
195 Size => $size,
196 Format => $formatStr,
197 TagInfo => $tagInfo,
198 RAF => $raf,
199 );
200 $tagKey and $exifTool->SetGroup($tagKey, $dirName);
201 }
202 }
203 last unless $dirName =~ /^(IFD|SubIFD)(\d*)$/;
204 $dirName = $1 . (($2 || 0) + 1);
205 defined $nextIFD or $exifTool->Warn("Bad $dirName pointer"), return 0;
206 $dirStart = Image::ExifTool::Get64u(\$nextIFD, 0);
207 $dirStart or last;
208 }
209 return 1;
210}
211
212#------------------------------------------------------------------------------
213# Extract meta information from a BigTIFF image
214# Inputs: 0) ExifTool object reference, 1) dirInfo reference
215# Returns: 1 on success, 0 if this wasn't a valid BigTIFF image
216sub ProcessBTF($$)
217{
218 my ($exifTool, $dirInfo) = @_;
219 my $raf = $$dirInfo{RAF};
220 my $buff;
221
222 return 0 unless $raf->Read($buff, 16) == 16;
223 return 0 unless $buff =~ /^(MM\0\x2b\0\x08\0\0|II\x2b\0\x08\0\0\0)/;
224 if ($$dirInfo{OutFile}) {
225 $exifTool->Error('ExifTool does not support writing of BigTIFF images');
226 return 1;
227 }
228 $exifTool->SetFileType('BTF'); # set the FileType tag
229 SetByteOrder(substr($buff, 0, 2));
230 my $offset = Image::ExifTool::Get64u(\$buff, 8);
231 if ($exifTool->{HTML_DUMP}) {
232 my $o = (GetByteOrder() eq 'II') ? 'Little' : 'Big';
233 $exifTool->HDump(0, 8, "BigTIFF header", "Byte order: $o endian", 0);
234 $exifTool->HDump(8, 8, "IFD0 pointer", sprintf("Offset: 0x%.8x",$offset), 0);
235 }
236 my %dirInfo = (
237 RAF => $raf,
238 DataPos => 0,
239 DirStart => $offset,
240 DirName => 'IFD0',
241 Parent => 'BigTIFF',
242 );
243 my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
244 $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr, \&ProcessBigIFD);
245 return 1;
246}
247
2481; # end
249
250__END__
251
252=head1 NAME
253
254Image::ExifTool::BigTIFF - Read Big TIFF meta information
255
256=head1 SYNOPSIS
257
258This module is used by Image::ExifTool
259
260=head1 DESCRIPTION
261
262This module contains routines required by Image::ExifTool to read meta
263information in BigTIFF images.
264
265=head1 AUTHOR
266
267Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
268
269This library is free software; you can redistribute it and/or modify it
270under the same terms as Perl itself.
271
272=head1 REFERENCES
273
274=over 4
275
276=item L<http://www.awaresystems.be/imaging/tiff/bigtiff.html>
277
278=back
279
280=head1 SEE ALSO
281
282L<Image::ExifTool::TagNames/EXIF Tags>,
283L<Image::ExifTool(3pm)|Image::ExifTool>
284
285=cut
286
Note: See TracBrowser for help on using the repository browser.