source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/DNG.pm@ 24107

Last change on this file since 24107 was 24107, checked in by sjm84, 13 years ago

Updating the ExifTool perl modules
File size: 31.6 KB
Line 
1#------------------------------------------------------------------------------
2# File: DNG.pm
3#
4# Description: Read DNG-specific information
5#
6# Revisions: 01/09/2006 - P. Harvey Created
7#
8# References: 1) http://www.adobe.com/products/dng/
9#------------------------------------------------------------------------------
10
11package Image::ExifTool::DNG;
12
13use strict;
14use vars qw($VERSION);
15use Image::ExifTool qw(:DataAccess :Utils);
16use Image::ExifTool::Exif;
17use Image::ExifTool::MakerNotes;
18use Image::ExifTool::CanonRaw;
19
20$VERSION = '1.15';
21
22sub ProcessOriginalRaw($$$);
23sub ProcessAdobeData($$$);
24sub ProcessAdobeMakN($$$);
25sub ProcessAdobeCRW($$$);
26sub ProcessAdobeRAF($$$);
27sub ProcessAdobeMRW($$$);
28sub ProcessAdobeSR2($$$);
29sub ProcessAdobeIFD($$$);
30sub WriteAdobeStuff($$$);
31
32# data in OriginalRawFileData
33%Image::ExifTool::DNG::OriginalRaw = (
34 GROUPS => { 2 => 'Image' },
35 PROCESS_PROC => \&ProcessOriginalRaw,
36 NOTES => q{
37 This table defines tags extracted from the DNG OriginalRawFileData
38 information.
39 },
40 0 => { Name => 'OriginalRawImage', Binary => 1 },
41 1 => { Name => 'OriginalRawResource', Binary => 1 },
42 2 => 'OriginalRawFileType',
43 3 => 'OriginalRawCreator',
44 4 => { Name => 'OriginalTHMImage', Binary => 1 },
45 5 => { Name => 'OriginalTHMResource', Binary => 1 },
46 6 => 'OriginalTHMFileType',
47 7 => 'OriginalTHMCreator',
48);
49
50%Image::ExifTool::DNG::AdobeData = ( #PH
51 GROUPS => { 0 => 'MakerNotes', 1 => 'Adobe', 2 => 'Image' },
52 PROCESS_PROC => \&ProcessAdobeData,
53 WRITE_PROC => \&WriteAdobeStuff,
54 NOTES => q{
55 This information is found in the "Adobe" DNGPrivateData.
56
57 The maker notes ('MakN') are processed by ExifTool, but some information may
58 have been lost by the Adobe DNG Converter. This is because the Adobe DNG
59 Converter (as of version 6.3) doesn't properly handle information referenced
60 from inside the maker notes that lies outside the original maker notes
61 block. This information is lost when only the maker note block is copied to
62 the DNG image. While this doesn't effect all makes of cameras, it is a
63 problem for some major brands such as Olympus and Sony.
64
65 Other entries in this table represent proprietary information that is
66 extracted from the original RAW image and restructured to a different (but
67 still proprietary) Adobe format.
68 },
69 MakN => [ ], # (filled in later)
70 'CRW ' => {
71 Name => 'AdobeCRW',
72 SubDirectory => {
73 TagTable => 'Image::ExifTool::CanonRaw::Main',
74 ProcessProc => \&ProcessAdobeCRW,
75 WriteProc => \&WriteAdobeStuff,
76 },
77 },
78 'MRW ' => {
79 Name => 'AdobeMRW',
80 SubDirectory => {
81 TagTable => 'Image::ExifTool::MinoltaRaw::Main',
82 ProcessProc => \&ProcessAdobeMRW,
83 WriteProc => \&WriteAdobeStuff,
84 },
85 },
86 'SR2 ' => {
87 Name => 'AdobeSR2',
88 SubDirectory => {
89 TagTable => 'Image::ExifTool::Sony::SR2Private',
90 ProcessProc => \&ProcessAdobeSR2,
91 },
92 },
93 'RAF ' => {
94 Name => 'AdobeRAF',
95 SubDirectory => {
96 TagTable => 'Image::ExifTool::FujiFilm::RAF',
97 ProcessProc => \&ProcessAdobeRAF,
98 },
99 },
100 'Pano' => {
101 Name => 'AdobePano',
102 SubDirectory => {
103 TagTable => 'Image::ExifTool::PanasonicRaw::Main',
104 ProcessProc => \&ProcessAdobeIFD,
105 },
106 },
107 'Koda' => {
108 Name => 'AdobeKoda',
109 SubDirectory => {
110 TagTable => 'Image::ExifTool::Kodak::IFD',
111 ProcessProc => \&ProcessAdobeIFD,
112 },
113 },
114 'Leaf' => {
115 Name => 'AdobeLeaf',
116 SubDirectory => {
117 TagTable => 'Image::ExifTool::Leaf::SubIFD',
118 ProcessProc => \&ProcessAdobeIFD,
119 },
120 },
121);
122
123# fill in maker notes
124{
125 my $tagInfo;
126 my $list = $Image::ExifTool::DNG::AdobeData{MakN};
127 foreach $tagInfo (@Image::ExifTool::MakerNotes::Main) {
128 unless (ref $tagInfo eq 'HASH') {
129 push @$list, $tagInfo;
130 next;
131 }
132 my %copy = %$tagInfo;
133 delete $copy{Groups};
134 delete $copy{GotGroups};
135 delete $copy{Table};
136 push @$list, \%copy;
137 }
138}
139
140#------------------------------------------------------------------------------
141# Process DNG OriginalRawFileData information
142# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
143# Returns: 1 on success, otherwise returns 0 and sets a Warning
144sub ProcessOriginalRaw($$$)
145{
146 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
147 my $dataPt = $$dirInfo{DataPt};
148 my $start = $$dirInfo{DirStart};
149 my $end = $start + $$dirInfo{DirLen};
150 my $pos = $start;
151 my ($index, $err);
152
153 SetByteOrder('MM'); # pointers are always big-endian in this structure
154 for ($index=0; $index<8; ++$index) {
155 last if $pos + 4 > $end;
156 my $val = Get32u($dataPt, $pos);
157 $val or $pos += 4, next; # ignore zero values
158 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $index);
159 $tagInfo or $err = "Missing DNG tag $index", last;
160 if ($index & 0x02) {
161 # extract a simple file type (tags 2, 3, 6 and 7)
162 $val = substr($$dataPt, $pos, 4);
163 $pos += 4;
164 } else {
165 # extract a compressed data block (tags 0, 1, 4 and 5)
166 my $n = int(($val + 65535) / 65536);
167 my $hdrLen = 4 * ($n + 2);
168 $pos + $hdrLen > $end and $err = '', last;
169 my $tag = $$tagInfo{Name};
170 # only extract this information if requested (because it takes time)
171 if ($exifTool->{OPTIONS}->{Binary} or
172 $exifTool->{REQ_TAG_LOOKUP}->{lc($tag)})
173 {
174 unless (eval 'require Compress::Zlib') {
175 $err = 'Install Compress::Zlib to extract compressed images';
176 last;
177 }
178 my $i;
179 $val = '';
180 my $p2 = $pos + Get32u($dataPt, $pos + 4);
181 for ($i=0; $i<$n; ++$i) {
182 # inflate this compressed block
183 my $p1 = $p2;
184 $p2 = $pos + Get32u($dataPt, $pos + ($i + 2) * 4);
185 if ($p1 >= $p2 or $p2 > $end) {
186 $err = 'Bad compressed RAW image';
187 last;
188 }
189 my $buff = substr($$dataPt, $p1, $p2 - $p1);
190 my ($v2, $stat);
191 my $inflate = Compress::Zlib::inflateInit();
192 $inflate and ($v2, $stat) = $inflate->inflate($buff);
193 if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
194 $val .= $v2;
195 } else {
196 $err = 'Error inflating compressed RAW image';
197 last;
198 }
199 }
200 $pos = $p2;
201 } else {
202 $pos + $hdrLen > $end and $err = '', last;
203 my $len = Get32u($dataPt, $pos + $hdrLen - 4);
204 $pos + $len > $end and $err = '', last;
205 $val = substr($$dataPt, $pos + $hdrLen, $len - $hdrLen);
206 $val = "Binary data $len bytes";
207 $pos += $len; # skip over this block
208 }
209 }
210 $exifTool->FoundTag($tagInfo, $val);
211 }
212 $exifTool->Warn($err || 'Bad OriginalRawFileData') if defined $err;
213 return 1;
214}
215
216#------------------------------------------------------------------------------
217# Process Adobe DNGPrivateData directory
218# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
219# Returns: 1 on success
220sub ProcessAdobeData($$$)
221{
222 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
223 my $dataPt = $$dirInfo{DataPt};
224 my $dataPos = $$dirInfo{DataPos};
225 my $pos = $$dirInfo{DirStart};
226 my $end = $$dirInfo{DirLen} + $pos;
227 my $outfile = $$dirInfo{OutFile};
228 my $verbose = $exifTool->Options('Verbose');
229 my $htmlDump = $exifTool->Options('HtmlDump');
230
231 return 0 unless $$dataPt =~ /^Adobe\0/;
232 unless ($outfile) {
233 $exifTool->VerboseDir($dirInfo);
234 # don't parse makernotes if FastScan > 1
235 my $fast = $exifTool->Options('FastScan');
236 return 1 if $fast and $fast > 1;
237 }
238 $htmlDump and $exifTool->HDump($dataPos, 6, 'Adobe DNGPrivateData header');
239 SetByteOrder('MM'); # always big endian
240 $pos += 6;
241 while ($pos + 8 <= $end) {
242 my ($tag, $size) = unpack("x${pos}a4N", $$dataPt);
243 $pos += 8;
244 last if $pos + $size > $end;
245 my $tagInfo = $$tagTablePtr{$tag};
246 if ($htmlDump) {
247 my $name = "Adobe$tag";
248 $name =~ tr/ //d;
249 $exifTool->HDump($dataPos + $pos - 8, 8, "$name header", "Data Size: $size bytes");
250 # dump non-EXIF format data
251 unless ($tag =~ /^(MakN|SR2 )$/) {
252 $exifTool->HDump($dataPos + $pos, $size, "$name data");
253 }
254 }
255 if ($verbose and not $outfile) {
256 $tagInfo or $exifTool->VPrint(0, "$$exifTool{INDENT}Unsupported DNGAdobeData record: ($tag)\n");
257 $exifTool->VerboseInfo($tag,
258 ref $tagInfo eq 'HASH' ? $tagInfo : undef,
259 DataPt => $dataPt,
260 DataPos => $dataPos,
261 Start => $pos,
262 Size => $size,
263 );
264 }
265 my $value;
266 while ($tagInfo) {
267 my ($subTable, $subName, $processProc);
268 if (ref $tagInfo eq 'HASH') {
269 unless ($$tagInfo{SubDirectory}) {
270 if ($outfile) {
271 # copy value across to outfile
272 $value = substr($$dataPt, $pos, $size);
273 } else {
274 $exifTool->HandleTag($tagTablePtr, $tag, substr($$dataPt, $pos, $size));
275 }
276 last;
277 }
278 $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
279 $subName = $$tagInfo{Name};
280 $processProc = $tagInfo->{SubDirectory}->{ProcessProc};
281 } else {
282 $subTable = $tagTablePtr;
283 $subName = 'AdobeMakN';
284 $processProc = \&ProcessAdobeMakN;
285 }
286 my %dirInfo = (
287 Base => $$dirInfo{Base},
288 DataPt => $dataPt,
289 DataPos => $dataPos,
290 DataLen => $$dirInfo{DataLen},
291 DirStart => $pos,
292 DirLen => $size,
293 DirName => $subName,
294 );
295 if ($outfile) {
296 $dirInfo{Proc} = $processProc; # WriteAdobeStuff() calls this to do the actual writing
297 $value = $exifTool->WriteDirectory(\%dirInfo, $subTable, \&WriteAdobeStuff);
298 # use old directory if an error occurred
299 defined $value or $value = substr($$dataPt, $pos, $size);
300 } else {
301 # override process proc for MakN
302 $exifTool->ProcessDirectory(\%dirInfo, $subTable, $processProc);
303 }
304 last;
305 }
306 if (defined $value and length $value) {
307 # add "Adobe" header if necessary
308 $$outfile = "Adobe\0" unless $$outfile and length $$outfile;
309 $$outfile .= $tag . pack('N', length $value) . $value;
310 $$outfile .= "\0" if length($value) & 0x01; # pad if necessary
311 }
312 $pos += $size;
313 ++$pos if $size & 0x01; # (darn padding)
314 }
315 $pos == $end or $exifTool->Warn("$pos $end Adobe private data is corrupt");
316 return 1;
317}
318
319#------------------------------------------------------------------------------
320# Process Adobe CRW directory
321# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
322# Returns: 1 on success, otherwise returns 0 and sets a Warning
323# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
324# - this routine would be as simple as ProcessAdobeMRW() below if Adobe hadn't
325# pulled the bonehead move of reformatting the CRW information
326sub ProcessAdobeCRW($$$)
327{
328 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
329 my $dataPt = $$dirInfo{DataPt};
330 my $start = $$dirInfo{DirStart};
331 my $end = $start + $$dirInfo{DirLen};
332 my $verbose = $exifTool->Options('Verbose');
333 my $buildMakerNotes = $exifTool->Options('MakerNotes');
334 my $outfile = $$dirInfo{OutFile};
335 my ($newTags, $oldChanged);
336
337 SetByteOrder('MM'); # always big endian
338 return 0 if $$dirInfo{DirLen} < 4;
339 my $byteOrder = substr($$dataPt, $start, 2);
340 return 0 unless $byteOrder =~ /^(II|MM)$/;
341
342 # initialize maker note data if building maker notes
343 $buildMakerNotes and Image::ExifTool::CanonRaw::InitMakerNotes($exifTool);
344
345 my $entries = Get16u($dataPt, $start + 2);
346 my $pos = $start + 4;
347 $exifTool->VerboseDir($dirInfo, $entries) unless $outfile;
348 if ($outfile) {
349 # get hash of new tags
350 $newTags = $exifTool->GetNewTagInfoHash($tagTablePtr);
351 $$outfile = substr($$dataPt, $start, 4);
352 $oldChanged = $exifTool->{CHANGED};
353 }
354 # loop through entries in Adobe CRW information
355 my $index;
356 for ($index=0; $index<$entries; ++$index) {
357 last if $pos + 6 > $end;
358 my $tag = Get16u($dataPt, $pos);
359 my $size = Get32u($dataPt, $pos + 2);
360 $pos += 6;
361 last if $pos + $size > $end;
362 my $value = substr($$dataPt, $pos, $size);
363 my $tagID = $tag & 0x3fff;
364 my $tagType = ($tag >> 8) & 0x38; # get tag type
365 my $format = $Image::ExifTool::CanonRaw::crwTagFormat{$tagType};
366 my $count;
367 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tagID, \$value);
368 if ($tagInfo) {
369 $format = $$tagInfo{Format} if $$tagInfo{Format};
370 $count = $$tagInfo{Count};
371 }
372 # set count to 1 by default for values that were in the directory entry
373 if (not defined $count and $tag & 0x4000 and $format and $format ne 'string') {
374 $count = 1;
375 }
376 # set count from tagInfo count if necessary
377 if ($format and not $count) {
378 # set count according to format and size
379 my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
380 my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
381 $count = int($size / $fsiz);
382 }
383 $format or $format = 'undef';
384 SetByteOrder($byteOrder);
385 my $val = ReadValue(\$value, 0, $format, $count, $size);
386 if ($outfile) {
387 if ($tagInfo) {
388 my $subdir = $$tagInfo{SubDirectory};
389 if ($subdir and $$subdir{TagTable}) {
390 my $name = $$tagInfo{Name};
391 my $newTagTable = GetTagTable($$subdir{TagTable});
392 return 0 unless $newTagTable;
393 my $subdirStart = 0;
394 #### eval Start ()
395 $subdirStart = eval $$subdir{Start} if $$subdir{Start};
396 my $dirData = \$value;
397 my %subdirInfo = (
398 Name => $name,
399 DataPt => $dirData,
400 DataLen => $size,
401 DirStart => $subdirStart,
402 DirLen => $size - $subdirStart,
403 Parent => $$dirInfo{DirName},
404 );
405 #### eval Validate ($dirData, $subdirStart, $size)
406 if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
407 $exifTool->Warn("Invalid $name data");
408 } else {
409 $subdir = $exifTool->WriteDirectory(\%subdirInfo, $newTagTable);
410 if (defined $subdir and length $subdir) {
411 if ($subdirStart) {
412 # add header before data directory
413 $value = substr($value, 0, $subdirStart) . $subdir;
414 } else {
415 $value = $subdir;
416 }
417 }
418 }
419 } elsif ($$newTags{$tagID}) {
420 my $nvHash = $exifTool->GetNewValueHash($tagInfo);
421 if (Image::ExifTool::IsOverwriting($nvHash, $val)) {
422 my $newVal = Image::ExifTool::GetNewValues($nvHash);
423 my $verboseVal;
424 $verboseVal = $newVal if $verbose > 1;
425 # convert to specified format if necessary
426 if (defined $newVal and $format) {
427 $newVal = WriteValue($newVal, $format, $count);
428 }
429 if (defined $newVal) {
430 $exifTool->VerboseValue("- CanonRaw:$$tagInfo{Name}", $value);
431 $exifTool->VerboseValue("+ CanonRaw:$$tagInfo{Name}", $verboseVal);
432 $value = $newVal;
433 ++$exifTool->{CHANGED};
434 }
435 }
436 }
437 }
438 # write out new value (always big-endian)
439 SetByteOrder('MM');
440 # (verified that there is no padding here)
441 $$outfile .= Set16u($tag) . Set32u(length($value)) . $value;
442 } else {
443 $exifTool->HandleTag($tagTablePtr, $tagID, $val,
444 Index => $index,
445 DataPt => $dataPt,
446 DataPos => $$dirInfo{DataPos},
447 Start => $pos,
448 Size => $size,
449 TagInfo => $tagInfo,
450 );
451 if ($buildMakerNotes) {
452 # build maker notes information if requested
453 Image::ExifTool::CanonRaw::BuildMakerNotes($exifTool, $tagID, $tagInfo,
454 \$value, $format, $count);
455 }
456 }
457 # (we lost the directory structure, but the second tag 0x0805
458 # should be in the ImageDescription directory)
459 $exifTool->{DIR_NAME} = 'ImageDescription' if $tagID == 0x0805;
460 SetByteOrder('MM');
461 $pos += $size;
462 }
463 if ($outfile and (not defined $$outfile or $index != $entries or
464 $exifTool->{CHANGED} == $oldChanged))
465 {
466 $exifTool->{CHANGED} = $oldChanged; # nothing changed
467 undef $$outfile; # rewrite old directory
468 }
469 if ($index != $entries) {
470 $exifTool->Warn('Truncated CRW notes');
471 } elsif ($pos < $end) {
472 $exifTool->Warn($end-$pos . ' extra bytes at end of CRW notes');
473 }
474 # finish building maker notes if necessary
475 if ($buildMakerNotes) {
476 SetByteOrder($byteOrder);
477 Image::ExifTool::CanonRaw::SaveMakerNotes($exifTool);
478 }
479 return 1;
480}
481
482#------------------------------------------------------------------------------
483# Process Adobe MRW directory
484# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
485# Returns: 1 on success, otherwise returns 0 and sets a Warning
486# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
487sub ProcessAdobeMRW($$$)
488{
489 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
490 my $dataPt = $$dirInfo{DataPt};
491 my $dirLen = $$dirInfo{DirLen};
492 my $dirStart = $$dirInfo{DirStart};
493 my $outfile = $$dirInfo{OutFile};
494
495 # construct fake MRW file
496 my $buff = "\0MRM" . pack('N', $dirLen - 4);
497 # ignore leading byte order and directory count words
498 $buff .= substr($$dataPt, $dirStart + 4, $dirLen - 4);
499 my $raf = new File::RandomAccess(\$buff);
500 my %dirInfo = ( RAF => $raf, OutFile => $outfile );
501 my $rtnVal = Image::ExifTool::MinoltaRaw::ProcessMRW($exifTool, \%dirInfo);
502 if ($outfile and defined $$outfile and length $$outfile) {
503 # remove MRW header and add Adobe header
504 $$outfile = substr($$dataPt, $dirStart, 4) . substr($$outfile, 8);
505 }
506 return $rtnVal;
507}
508
509#------------------------------------------------------------------------------
510# Process Adobe RAF directory
511# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
512# Returns: 1 on success, otherwise returns 0 and sets a Warning
513sub ProcessAdobeRAF($$$)
514{
515 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
516 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
517 my $dataPt = $$dirInfo{DataPt};
518 my $pos = $$dirInfo{DirStart};
519 my $dirEnd = $$dirInfo{DirLen} + $pos;
520 my ($readIt, $warn);
521
522 # set byte order according to first 2 bytes of Adobe RAF data
523 if ($pos + 2 <= $dirEnd and SetByteOrder(substr($$dataPt, $pos, 2))) {
524 $pos += 2;
525 } else {
526 $exifTool->Warn('Invalid DNG RAF data');
527 return 0;
528 }
529 $exifTool->VerboseDir($dirInfo);
530 # make fake RAF object for processing (same acronym, different meaning)
531 my $raf = new File::RandomAccess($dataPt);
532 my $num = '';
533 # loop through all records in Adobe RAF data:
534 # 0 - RAF table (not processed)
535 # 1 - first RAF directory
536 # 2 - second RAF directory (if available)
537 for (;;) {
538 last if $pos + 4 > $dirEnd;
539 my $len = Get32u($dataPt, $pos);
540 $pos += 4 + $len; # step to next entry in Adobe RAF record
541 $len or last; # ends with an empty entry
542 $readIt or $readIt = 1, next; # ignore first entry (RAF table)
543 my %dirInfo = (
544 RAF => $raf,
545 DirStart => $pos - $len,
546 );
547 $$exifTool{SET_GROUP1} = "RAF$num";
548 $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr) or $warn = 1;
549 delete $$exifTool{SET_GROUP1};
550 $num = ($num || 1) + 1;
551 }
552 $warn and $exifTool->Warn('Possibly corrupt RAF information');
553 return 1;
554}
555
556#------------------------------------------------------------------------------
557# Process Adobe SR2 directory
558# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
559# Returns: 1 on success, otherwise returns 0 and sets a Warning
560# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
561sub ProcessAdobeSR2($$$)
562{
563 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
564 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
565 my $dataPt = $$dirInfo{DataPt};
566 my $start = $$dirInfo{DirStart};
567 my $len = $$dirInfo{DirLen};
568
569 return 0 if $len < 6;
570 SetByteOrder('MM');
571 my $originalPos = Get32u($dataPt, $start + 2);
572 return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
573
574 $exifTool->VerboseDir($dirInfo);
575 my $dataPos = $$dirInfo{DataPos};
576 my $dirStart = $start + 6; # pointer to maker note directory
577 my $dirLen = $len - 6;
578
579 # initialize subdirectory information
580 my $fix = $dataPos + $dirStart - $originalPos;
581 my %subdirInfo = (
582 DirName => 'AdobeSR2',
583 Base => $$dirInfo{Base} + $fix,
584 DataPt => $dataPt,
585 DataPos => $dataPos - $fix,
586 DataLen => $$dirInfo{DataLen},
587 DirStart => $dirStart,
588 DirLen => $dirLen,
589 Parent => $$dirInfo{DirName},
590 );
591 if ($exifTool->Options('HtmlDump')) {
592 $exifTool->HDump($dataPos + $start, 6, 'Adobe SR2 data');
593 }
594 # parse the SR2 directory
595 $exifTool->ProcessDirectory(\%subdirInfo, $tagTablePtr);
596 return 1;
597}
598
599#------------------------------------------------------------------------------
600# Process Adobe-mutilated IFD directory
601# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
602# Returns: 1 on success, otherwise returns 0 and sets a Warning
603# Notes: data has 2 byte header (byte order of the data)
604sub ProcessAdobeIFD($$$)
605{
606 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
607 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
608 my $dataPt = $$dirInfo{DataPt};
609 my $pos = $$dirInfo{DirStart};
610 my $dataPos = $$dirInfo{DataPos};
611
612 return 0 if $$dirInfo{DirLen} < 4;
613 my $dataOrder = substr($$dataPt, $pos, 2);
614 return 0 unless SetByteOrder($dataOrder); # validate byte order of data
615
616 # parse the mutilated IFD. This is similar to a TIFF IFD, except:
617 # - data follows directly after Count entry in IFD
618 # - byte order of IFD entires is always big-endian, but byte order of data changes
619 SetByteOrder('MM'); # IFD structure is always big-endian
620 my $entries = Get16u($dataPt, $pos + 2);
621 $exifTool->VerboseDir($dirInfo, $entries);
622 $pos += 4;
623
624 my $end = $pos + $$dirInfo{DirLen};
625 my $index;
626 for ($index=0; $index<$entries; ++$index) {
627 last if $pos + 8 > $end;
628 SetByteOrder('MM'); # directory entries always big-endian (doh!)
629 my $tagID = Get16u($dataPt, $pos);
630 my $format = Get16u($dataPt, $pos+2);
631 my $count = Get32u($dataPt, $pos+4);
632 if ($format < 1 or $format > 13) {
633 # warn unless the IFD was just padded with zeros
634 $format and $exifTool->Warn(
635 sprintf("Unknown format ($format) for $$dirInfo{DirName} tag 0x%x",$tagID));
636 return 0; # must be corrupted
637 }
638 my $size = $Image::ExifTool::Exif::formatSize[$format] * $count;
639 last if $pos + 8 + $size > $end;
640 my $formatStr = $Image::ExifTool::Exif::formatName[$format];
641 SetByteOrder($dataOrder); # data stored in native order
642 my $val = ReadValue($dataPt, $pos + 8, $formatStr, $count, $size);
643 $exifTool->HandleTag($tagTablePtr, $tagID, $val,
644 Index => $index,
645 DataPt => $dataPt,
646 DataPos => $dataPos,
647 Start => $pos + 8,
648 Size => $size
649 );
650 $pos += 8 + $size;
651 }
652 if ($index < $entries) {
653 $exifTool->Warn("Truncated $$dirInfo{DirName} directory");
654 return 0;
655 }
656 return 1;
657}
658
659#------------------------------------------------------------------------------
660# Process Adobe MakerNotes directory
661# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
662# Returns: 1 on success, otherwise returns 0 and sets a Warning
663# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
664sub ProcessAdobeMakN($$$)
665{
666 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
667 my $dataPt = $$dirInfo{DataPt};
668 my $start = $$dirInfo{DirStart};
669 my $len = $$dirInfo{DirLen};
670 my $outfile = $$dirInfo{OutFile};
671
672 return 0 if $len < 6;
673 SetByteOrder('MM');
674 my $originalPos = Get32u($dataPt, $start + 2);
675 return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
676
677 $exifTool->VerboseDir($dirInfo) unless $outfile;
678 my $dataPos = $$dirInfo{DataPos};
679 my $dirStart = $start + 6; # pointer to maker note directory
680 my $dirLen = $len - 6;
681
682 my $hdr = substr($$dataPt, $dirStart, $dirLen < 48 ? $dirLen : 48);
683 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, 'MakN', \$hdr);
684 return 0 unless $tagInfo and $$tagInfo{SubDirectory};
685 my $subdir = $$tagInfo{SubDirectory};
686 my $subTable = GetTagTable($$subdir{TagTable});
687 # initialize subdirectory information
688 my %subdirInfo = (
689 DirName => 'MakerNotes',
690 Name => $$tagInfo{Name}, # needed for maker notes verbose dump
691 Base => $$dirInfo{Base},
692 DataPt => $dataPt,
693 DataPos => $dataPos,
694 DataLen => $$dirInfo{DataLen},
695 DirStart => $dirStart,
696 DirLen => $dirLen,
697 TagInfo => $tagInfo,
698 FixBase => $$subdir{FixBase},
699 EntryBased=> $$subdir{EntryBased},
700 Parent => $$dirInfo{DirName},
701 );
702 # look for start of maker notes IFD
703 my $loc = Image::ExifTool::MakerNotes::LocateIFD($exifTool,\%subdirInfo);
704 unless (defined $loc) {
705 $exifTool->Warn('Maker notes could not be parsed');
706 return 0;
707 }
708 if ($exifTool->Options('HtmlDump')) {
709 $exifTool->HDump($dataPos + $start, 6, 'Adobe MakN data');
710 $exifTool->HDump($dataPos + $dirStart, $loc, "$$tagInfo{Name} header") if $loc;
711 }
712
713 my $fix = 0;
714 unless ($$subdir{Base}) {
715 # adjust base offset for current maker note position
716 $fix = $dataPos + $dirStart - $originalPos;
717 $subdirInfo{Base} += $fix;
718 $subdirInfo{DataPos} -= $fix;
719 }
720 if ($outfile) {
721 # rewrite the maker notes directory
722 my $fixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
723 my $oldChanged = $$exifTool{CHANGED};
724 my $buff = $exifTool->WriteDirectory(\%subdirInfo, $subTable);
725 # nothing to do if error writing directory or nothing changed
726 unless (defined $buff and $exifTool->{CHANGED} != $oldChanged) {
727 $exifTool->{CHANGED} = $oldChanged;
728 return 1;
729 }
730 # deleting maker notes if directory is empty
731 unless (length $buff) {
732 $$outfile = '';
733 return 1;
734 }
735 # apply a one-time fixup to offsets
736 if ($subdirInfo{Relative}) {
737 # shift all offsets to be relative to new base
738 my $baseShift = $dataPos + $dirStart + $$dirInfo{Base} - $subdirInfo{Base};
739 $fixup->{Shift} += $baseShift;
740 } else {
741 # shift offsets to position of original maker notes
742 $fixup->{Shift} += $originalPos;
743 }
744 # if we wrote the directory as a block the header is already included
745 $loc = 0 if $subdirInfo{BlockWrite};
746 $fixup->{Shift} += $loc; # adjust for makernotes header
747 $fixup->ApplyFixup(\$buff); # fix up pointer offsets
748 # get copy of original Adobe header (6) and makernotes header ($loc)
749 my $header = substr($$dataPt, $start, 6 + $loc);
750 # add Adobe and makernotes headers to new directory
751 $$outfile = $header . $buff;
752 } else {
753 # parse the maker notes directory
754 $exifTool->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc});
755 # extract maker notes as a block if specified
756 if ($exifTool->Options('MakerNotes') or
757 $exifTool->{REQ_TAG_LOOKUP}->{lc($$tagInfo{Name})})
758 {
759 my $val;
760 if ($$tagInfo{MakerNotes}) {
761 $subdirInfo{Base} = $$dirInfo{Base} + $fix;
762 $subdirInfo{DataPos} = $dataPos - $fix;
763 $subdirInfo{DirStart} = $dirStart;
764 $subdirInfo{DirLen} = $dirLen;
765 # rebuild the maker notes to identify all offsets that require fixing up
766 $val = Image::ExifTool::Exif::RebuildMakerNotes($exifTool, $subTable, \%subdirInfo);
767 defined $val or $exifTool->Warn('Error rebuilding maker notes (may be corrupt)');
768 } else {
769 # extract this directory as a block if specified
770 return 1 unless $$tagInfo{Writable};
771 }
772 $val = substr($$dataPt, 20) unless defined $val;
773 $exifTool->FoundTag($tagInfo, $val);
774 }
775 }
776 return 1;
777}
778
779#------------------------------------------------------------------------------
780# Write Adobe information (calls appropriate ProcessProc to do the actual work)
781# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
782# Returns: new data block (may be empty if directory is deleted) or undef on error
783sub WriteAdobeStuff($$$)
784{
785 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
786 $exifTool or return 1; # allow dummy access
787 my $proc = $$dirInfo{Proc} || \&ProcessAdobeData;
788 my $buff;
789 $$dirInfo{OutFile} = \$buff;
790 &$proc($exifTool, $dirInfo, $tagTablePtr) or undef $buff;
791 return $buff;
792}
793
7941; # end
795
796__END__
797
798=head1 NAME
799
800Image::ExifTool::DNG.pm - Read DNG-specific information
801
802=head1 SYNOPSIS
803
804This module is used by Image::ExifTool
805
806=head1 DESCRIPTION
807
808This module contains routines required by Image::ExifTool to process
809information in DNG (Digital Negative) images.
810
811=head1 AUTHOR
812
813Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
814
815This library is free software; you can redistribute it and/or modify it
816under the same terms as Perl itself.
817
818=head1 REFERENCES
819
820=over 4
821
822=item L<http://www.adobe.com/products/dng/>
823
824=back
825
826=head1 SEE ALSO
827
828L<Image::ExifTool::TagNames/DNG Tags>,
829L<Image::ExifTool::TagNames/EXIF Tags>,
830L<Image::ExifTool(3pm)|Image::ExifTool>
831
832=cut
Note: See TracBrowser for help on using the repository browser.