File Coverage

blib/lib/Image/ExifTool/DNG.pm
Criterion Covered Total %
statement 115 390 29.4
branch 38 212 17.9
condition 11 87 12.6
subroutine 9 15 60.0
pod 0 9 0.0
total 173 713 24.2


line stmt bran cond sub pod time code
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              
11             package Image::ExifTool::DNG;
12              
13 7     7   4800 use strict;
  7         19  
  7         282  
14 7     7   56 use vars qw($VERSION);
  7         20  
  7         436  
15 7     7   55 use Image::ExifTool qw(:DataAccess :Utils);
  7         22  
  7         1953  
16 7     7   1534 use Image::ExifTool::Exif;
  7         66  
  7         205  
17 7     7   66 use Image::ExifTool::MakerNotes;
  7         29  
  7         202  
18 7     7   635 use Image::ExifTool::CanonRaw;
  7         17  
  7         31620  
19              
20             $VERSION = '1.23';
21              
22             sub ProcessOriginalRaw($$$);
23             sub ProcessAdobeData($$$);
24             sub ProcessAdobeMakN($$$);
25             sub ProcessAdobeCRW($$$);
26             sub ProcessAdobeRAF($$$);
27             sub ProcessAdobeMRW($$$);
28             sub ProcessAdobeSR2($$$);
29             sub ProcessAdobeIFD($$$);
30             sub 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 => 'AdobeDNG', 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
144             sub ProcessOriginalRaw($$$)
145             {
146 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
147 0         0 my $dataPt = $$dirInfo{DataPt};
148 0         0 my $start = $$dirInfo{DirStart};
149 0         0 my $end = $start + $$dirInfo{DirLen};
150 0         0 my $pos = $start;
151 0         0 my ($index, $err);
152              
153 0         0 SetByteOrder('MM'); # pointers are always big-endian in this structure
154 0         0 for ($index=0; $index<8; ++$index) {
155 0 0       0 last if $pos + 4 > $end;
156 0         0 my $val = Get32u($dataPt, $pos);
157 0 0       0 $val or $pos += 4, next; # ignore zero values
158 0         0 my $tagInfo = $et->GetTagInfo($tagTablePtr, $index);
159 0 0       0 $tagInfo or $err = "Missing DNG tag $index", last;
160 0 0       0 if ($index & 0x02) {
161             # extract a simple file type (tags 2, 3, 6 and 7)
162 0         0 $val = substr($$dataPt, $pos, 4);
163 0         0 $pos += 4;
164             } else {
165             # extract a compressed data block (tags 0, 1, 4 and 5)
166 0         0 my $n = int(($val + 65535) / 65536);
167 0         0 my $hdrLen = 4 * ($n + 2);
168 0 0       0 $pos + $hdrLen > $end and $err = '', last;
169 0         0 my $tag = $$tagInfo{Name};
170             # only extract this information if requested (because it takes time)
171 0         0 my $lcTag = lc $tag;
172 0 0 0     0 if (($$et{OPTIONS}{Binary} and not $$et{EXCL_TAG_LOOKUP}{$lcTag}) or
      0        
173             $$et{REQ_TAG_LOOKUP}{$lcTag})
174             {
175 0 0       0 unless (eval { require Compress::Zlib }) {
  0         0  
176 0         0 $err = 'Install Compress::Zlib to extract compressed images';
177 0         0 last;
178             }
179 0         0 my $i;
180 0         0 $val = '';
181 0         0 my $p2 = $pos + Get32u($dataPt, $pos + 4);
182 0         0 for ($i=0; $i<$n; ++$i) {
183             # inflate this compressed block
184 0         0 my $p1 = $p2;
185 0         0 $p2 = $pos + Get32u($dataPt, $pos + ($i + 2) * 4);
186 0 0 0     0 if ($p1 >= $p2 or $p2 > $end) {
187 0         0 $err = 'Bad compressed RAW image';
188 0         0 last;
189             }
190 0         0 my $buff = substr($$dataPt, $p1, $p2 - $p1);
191 0         0 my ($v2, $stat);
192 0         0 my $inflate = Compress::Zlib::inflateInit();
193 0 0       0 $inflate and ($v2, $stat) = $inflate->inflate($buff);
194 0 0 0     0 if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
195 0         0 $val .= $v2;
196             } else {
197 0         0 $err = 'Error inflating compressed RAW image';
198 0         0 last;
199             }
200             }
201 0         0 $pos = $p2;
202             } else {
203 0 0       0 $pos + $hdrLen > $end and $err = '', last;
204 0         0 my $len = Get32u($dataPt, $pos + $hdrLen - 4);
205 0 0       0 $pos + $len > $end and $err = '', last;
206 0         0 $val = substr($$dataPt, $pos + $hdrLen, $len - $hdrLen);
207 0         0 $val = "Binary data $len bytes";
208 0         0 $pos += $len; # skip over this block
209             }
210             }
211 0         0 $et->FoundTag($tagInfo, $val);
212             }
213 0 0 0     0 $et->Warn($err || 'Bad OriginalRawFileData') if defined $err;
214 0         0 return 1;
215             }
216              
217             #------------------------------------------------------------------------------
218             # Process Adobe DNGPrivateData directory
219             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
220             # Returns: 1 on success
221             sub ProcessAdobeData($$$)
222             {
223 3     3 0 17 my ($et, $dirInfo, $tagTablePtr) = @_;
224 3         12 my $dataPt = $$dirInfo{DataPt};
225 3         9 my $dataPos = $$dirInfo{DataPos};
226 3         9 my $pos = $$dirInfo{DirStart};
227 3         10 my $end = $$dirInfo{DirLen} + $pos;
228 3         9 my $outfile = $$dirInfo{OutFile};
229 3         11 my $verbose = $et->Options('Verbose');
230 3         22 my $htmlDump = $et->Options('HtmlDump');
231              
232 3 50       36 return 0 unless $$dataPt =~ /^Adobe\0/;
233 3 100       12 unless ($outfile) {
234 2         15 $et->VerboseDir($dirInfo);
235             # don't parse makernotes if FastScan > 1
236 2         8 my $fast = $et->Options('FastScan');
237 2 50 33     21 return 1 if $fast and $fast > 1;
238             }
239 3 50       9 $htmlDump and $et->HDump($dataPos, 6, 'Adobe DNGPrivateData header');
240 3         16 SetByteOrder('MM'); # always big endian
241 3         8 $pos += 6;
242 3         25 while ($pos + 8 <= $end) {
243 3         29 my ($tag, $size) = unpack("x${pos}a4N", $$dataPt);
244 3         8 $pos += 8;
245 3 50       13 last if $pos + $size > $end;
246 3         11 my $tagInfo = $$tagTablePtr{$tag};
247 3 50       11 if ($htmlDump) {
248 0         0 my $name = "Adobe$tag";
249 0         0 $name =~ tr/ //d;
250 0         0 $et->HDump($dataPos + $pos - 8, 8, "$name header", "Data Size: $size bytes");
251             # dump non-EXIF format data
252 0 0       0 unless ($tag =~ /^(MakN|SR2 )$/) {
253 0         0 $et->HDump($dataPos + $pos, $size, "$name data");
254             }
255             }
256 3 50 33     16 if ($verbose and not $outfile) {
257 0 0       0 $tagInfo or $et->VPrint(0, "$$et{INDENT}Unsupported DNGAdobeData record: ($tag)\n");
258 0 0       0 $et->VerboseInfo($tag,
259             ref $tagInfo eq 'HASH' ? $tagInfo : undef,
260             DataPt => $dataPt,
261             DataPos => $dataPos,
262             Start => $pos,
263             Size => $size,
264             );
265             }
266 3         6 my $value;
267 3         11 while ($tagInfo) {
268 3         8 my ($subTable, $subName, $processProc);
269 3 50       13 if (ref $tagInfo eq 'HASH') {
270 0 0       0 unless ($$tagInfo{SubDirectory}) {
271 0 0       0 if ($outfile) {
272             # copy value across to outfile
273 0         0 $value = substr($$dataPt, $pos, $size);
274             } else {
275 0         0 $et->HandleTag($tagTablePtr, $tag, substr($$dataPt, $pos, $size));
276             }
277 0         0 last;
278             }
279 0         0 $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
280 0         0 $subName = $$tagInfo{Name};
281 0         0 $processProc = $tagInfo->{SubDirectory}->{ProcessProc};
282             } else {
283 3         9 $subTable = $tagTablePtr;
284 3         9 $subName = 'AdobeMakN';
285 3         9 $processProc = \&ProcessAdobeMakN;
286             }
287             my %dirInfo = (
288             Base => $$dirInfo{Base},
289             DataPt => $dataPt,
290             DataPos => $dataPos,
291             DataLen => $$dirInfo{DataLen},
292 3         37 DirStart => $pos,
293             DirLen => $size,
294             DirName => $subName,
295             );
296 3 100       11 if ($outfile) {
297 1         4 $dirInfo{Proc} = $processProc; # WriteAdobeStuff() calls this to do the actual writing
298 1         34 $value = $et->WriteDirectory(\%dirInfo, $subTable, \&WriteAdobeStuff);
299             # use old directory if an error occurred
300 1 50       12 defined $value or $value = substr($$dataPt, $pos, $size);
301             } else {
302             # override process proc for MakN
303 2         16 $et->ProcessDirectory(\%dirInfo, $subTable, $processProc);
304             }
305 3         15 last;
306             }
307 3 100 66     17 if (defined $value and length $value) {
308             # add "Adobe" header if necessary
309 1 50 33     6 $$outfile = "Adobe\0" unless $$outfile and length $$outfile;
310 1         33 $$outfile .= $tag . pack('N', length $value) . $value;
311 1 50       7 $$outfile .= "\0" if length($value) & 0x01; # pad if necessary
312             }
313 3         8 $pos += $size;
314 3 50       20 ++$pos if $size & 0x01; # (darn padding)
315             }
316 3 50       14 $pos == $end or $et->Warn("$pos $end Adobe private data is corrupt");
317 3         9 return 1;
318             }
319              
320             #------------------------------------------------------------------------------
321             # Process Adobe CRW directory
322             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
323             # Returns: 1 on success, otherwise returns 0 and sets a Warning
324             # Notes: data has 4 byte header (2 for byte order and 2 for entry count)
325             # - this routine would be as simple as ProcessAdobeMRW() below if Adobe hadn't
326             # pulled the bonehead move of reformatting the CRW information
327             sub ProcessAdobeCRW($$$)
328             {
329 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
330 0         0 my $dataPt = $$dirInfo{DataPt};
331 0         0 my $start = $$dirInfo{DirStart};
332 0         0 my $end = $start + $$dirInfo{DirLen};
333 0         0 my $verbose = $et->Options('Verbose');
334 0         0 my $buildMakerNotes = $et->Options('MakerNotes');
335 0         0 my $outfile = $$dirInfo{OutFile};
336 0         0 my ($newTags, $oldChanged);
337              
338 0         0 SetByteOrder('MM'); # always big endian
339 0 0       0 return 0 if $$dirInfo{DirLen} < 4;
340 0         0 my $byteOrder = substr($$dataPt, $start, 2);
341 0 0       0 return 0 unless $byteOrder =~ /^(II|MM)$/;
342              
343             # initialize maker note data if building maker notes
344 0 0       0 $buildMakerNotes and Image::ExifTool::CanonRaw::InitMakerNotes($et);
345              
346 0         0 my $entries = Get16u($dataPt, $start + 2);
347 0         0 my $pos = $start + 4;
348 0 0       0 $et->VerboseDir($dirInfo, $entries) unless $outfile;
349 0 0       0 if ($outfile) {
350             # get hash of new tags
351 0         0 $newTags = $et->GetNewTagInfoHash($tagTablePtr);
352 0         0 $$outfile = substr($$dataPt, $start, 4);
353 0         0 $oldChanged = $$et{CHANGED};
354             }
355             # loop through entries in Adobe CRW information
356 0         0 my $index;
357 0         0 for ($index=0; $index<$entries; ++$index) {
358 0 0       0 last if $pos + 6 > $end;
359 0         0 my $tag = Get16u($dataPt, $pos);
360 0         0 my $size = Get32u($dataPt, $pos + 2);
361 0         0 $pos += 6;
362 0 0       0 last if $pos + $size > $end;
363 0         0 my $value = substr($$dataPt, $pos, $size);
364 0         0 my $tagID = $tag & 0x3fff;
365 0         0 my $tagType = ($tag >> 8) & 0x38; # get tag type
366 0         0 my $format = $Image::ExifTool::CanonRaw::crwTagFormat{$tagType};
367 0         0 my $count;
368 0         0 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$value);
369 0 0       0 if ($tagInfo) {
370 0 0       0 $format = $$tagInfo{Format} if $$tagInfo{Format};
371 0         0 $count = $$tagInfo{Count};
372             }
373             # set count to 1 by default for values that were in the directory entry
374 0 0 0     0 if (not defined $count and $tag & 0x4000 and $format and $format ne 'string') {
      0        
      0        
375 0         0 $count = 1;
376             }
377             # set count from tagInfo count if necessary
378 0 0 0     0 if ($format and not $count) {
379             # set count according to format and size
380 0         0 my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
381 0         0 my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
382 0         0 $count = int($size / $fsiz);
383             }
384 0 0       0 $format or $format = 'undef';
385 0         0 SetByteOrder($byteOrder);
386 0         0 my $val = ReadValue(\$value, 0, $format, $count, $size);
387 0 0       0 if ($outfile) {
388 0 0       0 if ($tagInfo) {
389 0         0 my $subdir = $$tagInfo{SubDirectory};
390 0 0 0     0 if ($subdir and $$subdir{TagTable}) {
    0          
391 0         0 my $name = $$tagInfo{Name};
392 0         0 my $newTagTable = GetTagTable($$subdir{TagTable});
393 0 0       0 return 0 unless $newTagTable;
394 0         0 my $subdirStart = 0;
395             #### eval Start ()
396 0 0       0 $subdirStart = eval $$subdir{Start} if $$subdir{Start};
397 0         0 my $dirData = \$value;
398             my %subdirInfo = (
399             Name => $name,
400             DataPt => $dirData,
401             DataLen => $size,
402             DirStart => $subdirStart,
403             DirLen => $size - $subdirStart,
404             Parent => $$dirInfo{DirName},
405 0         0 );
406             #### eval Validate ($dirData, $subdirStart, $size)
407 0 0 0     0 if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
408 0         0 $et->Warn("Invalid $name data");
409             } else {
410 0         0 $subdir = $et->WriteDirectory(\%subdirInfo, $newTagTable);
411 0 0 0     0 if (defined $subdir and length $subdir) {
412 0 0       0 if ($subdirStart) {
413             # add header before data directory
414 0         0 $value = substr($value, 0, $subdirStart) . $subdir;
415             } else {
416 0         0 $value = $subdir;
417             }
418             }
419             }
420             } elsif ($$newTags{$tagID}) {
421 0         0 my $nvHash = $et->GetNewValueHash($tagInfo);
422 0 0       0 if ($et->IsOverwriting($nvHash, $val)) {
423 0         0 my $newVal = $et->GetNewValue($nvHash);
424 0         0 my $verboseVal;
425 0 0       0 $verboseVal = $newVal if $verbose > 1;
426             # convert to specified format if necessary
427 0 0 0     0 if (defined $newVal and $format) {
428 0         0 $newVal = WriteValue($newVal, $format, $count);
429             }
430 0 0       0 if (defined $newVal) {
431 0         0 $et->VerboseValue("- CanonRaw:$$tagInfo{Name}", $value);
432 0         0 $et->VerboseValue("+ CanonRaw:$$tagInfo{Name}", $verboseVal);
433 0         0 $value = $newVal;
434 0         0 ++$$et{CHANGED};
435             }
436             }
437             }
438             }
439             # write out new value (always big-endian)
440 0         0 SetByteOrder('MM');
441             # (verified that there is no padding here)
442 0         0 $$outfile .= Set16u($tag) . Set32u(length($value)) . $value;
443             } else {
444             $et->HandleTag($tagTablePtr, $tagID, $val,
445             Index => $index,
446             DataPt => $dataPt,
447             DataPos => $$dirInfo{DataPos},
448 0         0 Start => $pos,
449             Size => $size,
450             TagInfo => $tagInfo,
451             );
452 0 0       0 if ($buildMakerNotes) {
453             # build maker notes information if requested
454 0         0 Image::ExifTool::CanonRaw::BuildMakerNotes($et, $tagID, $tagInfo,
455             \$value, $format, $count);
456             }
457             }
458             # (we lost the directory structure, but the second tag 0x0805
459             # should be in the ImageDescription directory)
460 0 0       0 $$et{DIR_NAME} = 'ImageDescription' if $tagID == 0x0805;
461 0         0 SetByteOrder('MM');
462 0         0 $pos += $size;
463             }
464 0 0 0     0 if ($outfile and (not defined $$outfile or $index != $entries or
      0        
465             $$et{CHANGED} == $oldChanged))
466             {
467 0         0 $$et{CHANGED} = $oldChanged; # nothing changed
468 0         0 undef $$outfile; # rewrite old directory
469             }
470 0 0       0 if ($index != $entries) {
    0          
471 0         0 $et->Warn('Truncated CRW notes');
472             } elsif ($pos < $end) {
473 0         0 $et->Warn($end-$pos . ' extra bytes at end of CRW notes');
474             }
475             # finish building maker notes if necessary
476 0 0       0 if ($buildMakerNotes) {
477 0         0 SetByteOrder($byteOrder);
478 0         0 Image::ExifTool::CanonRaw::SaveMakerNotes($et);
479             }
480 0         0 return 1;
481             }
482              
483             #------------------------------------------------------------------------------
484             # Process Adobe MRW directory
485             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
486             # Returns: 1 on success, otherwise returns 0 and sets a Warning
487             # Notes: data has 4 byte header (2 for byte order and 2 for entry count)
488             sub ProcessAdobeMRW($$$)
489             {
490 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
491 0         0 my $dataPt = $$dirInfo{DataPt};
492 0         0 my $dirLen = $$dirInfo{DirLen};
493 0         0 my $dirStart = $$dirInfo{DirStart};
494 0         0 my $outfile = $$dirInfo{OutFile};
495              
496             # construct fake MRW file
497 0         0 my $buff = "\0MRM" . pack('N', $dirLen - 4);
498             # ignore leading byte order and directory count words
499 0         0 $buff .= substr($$dataPt, $dirStart + 4, $dirLen - 4);
500 0         0 my $raf = new File::RandomAccess(\$buff);
501 0         0 my %dirInfo = ( RAF => $raf, OutFile => $outfile );
502 0         0 my $rtnVal = Image::ExifTool::MinoltaRaw::ProcessMRW($et, \%dirInfo);
503 0 0 0     0 if ($outfile and defined $$outfile and length $$outfile) {
      0        
504             # remove MRW header and add Adobe header
505 0         0 $$outfile = substr($$dataPt, $dirStart, 4) . substr($$outfile, 8);
506             }
507 0         0 return $rtnVal;
508             }
509              
510             #------------------------------------------------------------------------------
511             # Process Adobe RAF directory
512             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
513             # Returns: 1 on success, otherwise returns 0 and sets a Warning
514             sub ProcessAdobeRAF($$$)
515             {
516 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
517 0 0       0 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
518 0         0 my $dataPt = $$dirInfo{DataPt};
519 0         0 my $pos = $$dirInfo{DirStart};
520 0         0 my $dirEnd = $$dirInfo{DirLen} + $pos;
521 0         0 my ($readIt, $warn);
522              
523             # set byte order according to first 2 bytes of Adobe RAF data
524 0 0 0     0 if ($pos + 2 <= $dirEnd and SetByteOrder(substr($$dataPt, $pos, 2))) {
525 0         0 $pos += 2;
526             } else {
527 0         0 $et->Warn('Invalid DNG RAF data');
528 0         0 return 0;
529             }
530 0         0 $et->VerboseDir($dirInfo);
531             # make fake RAF object for processing (same acronym, different meaning)
532 0         0 my $raf = new File::RandomAccess($dataPt);
533 0         0 my $num = '';
534             # loop through all records in Adobe RAF data:
535             # 0 - RAF table (not processed)
536             # 1 - first RAF directory
537             # 2 - second RAF directory (if available)
538 0         0 for (;;) {
539 0 0       0 last if $pos + 4 > $dirEnd;
540 0         0 my $len = Get32u($dataPt, $pos);
541 0         0 $pos += 4 + $len; # step to next entry in Adobe RAF record
542 0 0       0 $len or last; # ends with an empty entry
543 0 0       0 $readIt or $readIt = 1, next; # ignore first entry (RAF table)
544 0         0 my %dirInfo = (
545             RAF => $raf,
546             DirStart => $pos - $len,
547             );
548 0         0 $$et{SET_GROUP1} = "RAF$num";
549 0 0       0 $et->ProcessDirectory(\%dirInfo, $tagTablePtr) or $warn = 1;
550 0         0 delete $$et{SET_GROUP1};
551 0   0     0 $num = ($num || 1) + 1;
552             }
553 0 0       0 $warn and $et->Warn('Possibly corrupt RAF information');
554 0         0 return 1;
555             }
556              
557             #------------------------------------------------------------------------------
558             # Process Adobe SR2 directory
559             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
560             # Returns: 1 on success, otherwise returns 0 and sets a Warning
561             # Notes: data has 6 byte header (2 for byte order and 4 for original offset)
562             sub ProcessAdobeSR2($$$)
563             {
564 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
565 0 0       0 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
566 0         0 my $dataPt = $$dirInfo{DataPt};
567 0         0 my $start = $$dirInfo{DirStart};
568 0         0 my $len = $$dirInfo{DirLen};
569              
570 0 0       0 return 0 if $len < 6;
571 0         0 SetByteOrder('MM');
572 0         0 my $originalPos = Get32u($dataPt, $start + 2);
573 0 0       0 return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
574              
575 0         0 $et->VerboseDir($dirInfo);
576 0         0 my $dataPos = $$dirInfo{DataPos};
577 0         0 my $dirStart = $start + 6; # pointer to maker note directory
578 0         0 my $dirLen = $len - 6;
579              
580             # initialize subdirectory information
581 0         0 my $fix = $dataPos + $dirStart - $originalPos;
582             my %subdirInfo = (
583             DirName => 'AdobeSR2',
584             Base => $$dirInfo{Base} + $fix,
585             DataPt => $dataPt,
586             DataPos => $dataPos - $fix,
587             DataLen => $$dirInfo{DataLen},
588             DirStart => $dirStart,
589             DirLen => $dirLen,
590             Parent => $$dirInfo{DirName},
591 0         0 );
592 0 0       0 if ($et->Options('HtmlDump')) {
593 0         0 $et->HDump($dataPos + $start, 6, 'Adobe SR2 data');
594             }
595             # parse the SR2 directory
596 0         0 $et->ProcessDirectory(\%subdirInfo, $tagTablePtr);
597 0         0 return 1;
598             }
599              
600             #------------------------------------------------------------------------------
601             # Process Adobe-mutilated IFD directory
602             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
603             # Returns: 1 on success, otherwise returns 0 and sets a Warning
604             # Notes: data has 2 byte header (byte order of the data)
605             sub ProcessAdobeIFD($$$)
606             {
607 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
608 0 0       0 return 0 if $$dirInfo{OutFile}; # (can't write this yet)
609 0         0 my $dataPt = $$dirInfo{DataPt};
610 0         0 my $pos = $$dirInfo{DirStart};
611 0         0 my $dataPos = $$dirInfo{DataPos};
612              
613 0 0       0 return 0 if $$dirInfo{DirLen} < 4;
614 0         0 my $dataOrder = substr($$dataPt, $pos, 2);
615 0 0       0 return 0 unless SetByteOrder($dataOrder); # validate byte order of data
616              
617             # parse the mutilated IFD. This is similar to a TIFF IFD, except:
618             # - data follows directly after Count entry in IFD
619             # - byte order of IFD entries is always big-endian, but byte order of data changes
620 0         0 SetByteOrder('MM'); # IFD structure is always big-endian
621 0         0 my $entries = Get16u($dataPt, $pos + 2);
622 0         0 $et->VerboseDir($dirInfo, $entries);
623 0         0 $pos += 4;
624              
625 0         0 my $end = $pos + $$dirInfo{DirLen};
626 0         0 my $index;
627 0         0 for ($index=0; $index<$entries; ++$index) {
628 0 0       0 last if $pos + 8 > $end;
629 0         0 SetByteOrder('MM'); # directory entries always big-endian (doh!)
630 0         0 my $tagID = Get16u($dataPt, $pos);
631 0         0 my $format = Get16u($dataPt, $pos+2);
632 0         0 my $count = Get32u($dataPt, $pos+4);
633 0 0 0     0 if ($format < 1 or $format > 13) {
634             # warn unless the IFD was just padded with zeros
635 0 0       0 $format and $et->Warn(
636             sprintf("Unknown format ($format) for $$dirInfo{DirName} tag 0x%x",$tagID));
637 0         0 return 0; # must be corrupted
638             }
639 0         0 my $size = $Image::ExifTool::Exif::formatSize[$format] * $count;
640 0 0       0 last if $pos + 8 + $size > $end;
641 0         0 my $formatStr = $Image::ExifTool::Exif::formatName[$format];
642 0         0 SetByteOrder($dataOrder); # data stored in native order
643 0         0 my $val = ReadValue($dataPt, $pos + 8, $formatStr, $count, $size);
644 0         0 $et->HandleTag($tagTablePtr, $tagID, $val,
645             Index => $index,
646             DataPt => $dataPt,
647             DataPos => $dataPos,
648             Start => $pos + 8,
649             Size => $size
650             );
651 0         0 $pos += 8 + $size;
652             }
653 0 0       0 if ($index < $entries) {
654 0         0 $et->Warn("Truncated $$dirInfo{DirName} directory");
655 0         0 return 0;
656             }
657 0         0 return 1;
658             }
659              
660             #------------------------------------------------------------------------------
661             # Process Adobe MakerNotes directory
662             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
663             # Returns: 1 on success, otherwise returns 0 and sets a Warning
664             # Notes: data has 6 byte header (2 for byte order and 4 for original offset)
665             # --> or 18 bytes for DNG converted from JPG by Adobe Camera Raw!
666             sub ProcessAdobeMakN($$$)
667             {
668 3     3 0 26 my ($et, $dirInfo, $tagTablePtr) = @_;
669 3         10 my $dataPt = $$dirInfo{DataPt};
670 3         9 my $start = $$dirInfo{DirStart};
671 3         10 my $len = $$dirInfo{DirLen};
672 3         9 my $outfile = $$dirInfo{OutFile};
673              
674 3 50       11 return 0 if $len < 6;
675 3         12 SetByteOrder('MM');
676 3         23 my $originalPos = Get32u($dataPt, $start + 2);
677 3 50       18 return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
678              
679 3 100       22 $et->VerboseDir($dirInfo) unless $outfile;
680 3         10 my $dataPos = $$dirInfo{DataPos};
681 3         8 my $hdrLen = 6;
682              
683             # 2018-09-27: hack for extra 12 bytes in MakN header of JPEG converted to DNG
684             # by Adobe Camera Raw (4 bytes "00 00 00 01" followed by 8 unknown bytes)
685             # - this is because CameraRaw copies the maker notes from the wrong location
686             # in a JPG image (off by 12 bytes presumably due to the JPEG headers)
687             # - this hack won't work in most cases because the extra bytes are not consistent
688             # since they are just the data that existed in the JPG before the maker notes
689             # - also, the last 12 bytes of the maker notes will be missing
690             # - 2022-04-26: this bug still exists in Camera Raw 14.3
691 3 50 33     25 $hdrLen += 12 if $len >= 18 and substr($$dataPt, $start+6, 4) eq "\0\0\0\x01";
692              
693 3         5 my $dirStart = $start + $hdrLen; # pointer to maker note directory
694 3         8 my $dirLen = $len - $hdrLen;
695              
696 3 50       26 my $hdr = substr($$dataPt, $dirStart, $dirLen < 48 ? $dirLen : 48);
697 3         14 my $tagInfo = $et->GetTagInfo($tagTablePtr, 'MakN', \$hdr);
698 3 50 33     33 return 0 unless $tagInfo and $$tagInfo{SubDirectory};
699 3         10 my $subdir = $$tagInfo{SubDirectory};
700 3         15 my $subTable = GetTagTable($$subdir{TagTable});
701             # initialize subdirectory information
702             my %subdirInfo = (
703             DirName => 'MakerNotes',
704             Name => $$tagInfo{Name}, # needed for maker notes verbose dump
705             Base => $$dirInfo{Base},
706             DataPt => $dataPt,
707             DataPos => $dataPos,
708             DataLen => $$dirInfo{DataLen},
709             DirStart => $dirStart,
710             DirLen => $dirLen,
711             TagInfo => $tagInfo,
712             FixBase => $$subdir{FixBase},
713             EntryBased=> $$subdir{EntryBased},
714             Parent => $$dirInfo{DirName},
715 3         55 );
716             # look for start of maker notes IFD
717 3         25 my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
718 3 50       12 unless (defined $loc) {
719 0         0 $et->Warn('Maker notes could not be parsed');
720 0         0 return 0;
721             }
722 3 50       13 if ($et->Options('HtmlDump')) {
723 0         0 $et->HDump($dataPos + $start, $hdrLen, 'Adobe MakN data');
724 0 0       0 $et->HDump($dataPos + $dirStart, $loc, "$$tagInfo{Name} header") if $loc;
725             }
726              
727 3         28 my $fix = 0;
728 3 50       24 unless ($$subdir{Base}) {
729             # adjust base offset for current maker note position
730 3         8 $fix = $dataPos + $dirStart - $originalPos;
731 3         10 $subdirInfo{Base} += $fix;
732 3         9 $subdirInfo{DataPos} -= $fix;
733             }
734 3 100       9 if ($outfile) {
735             # rewrite the maker notes directory
736 1         7 my $fixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
737 1         3 my $oldChanged = $$et{CHANGED};
738 1         11 my $buff = $et->WriteDirectory(\%subdirInfo, $subTable);
739             # nothing to do if error writing directory or nothing changed
740 1 50 33     9 unless (defined $buff and $$et{CHANGED} != $oldChanged) {
741 0         0 $$et{CHANGED} = $oldChanged;
742 0         0 return 1;
743             }
744             # deleting maker notes if directory is empty
745 1 50       5 unless (length $buff) {
746 0         0 $$outfile = '';
747 0         0 return 1;
748             }
749             # apply a one-time fixup to offsets
750 1 50       4 if ($subdirInfo{Relative}) {
751             # shift all offsets to be relative to new base
752 0         0 my $baseShift = $dataPos + $dirStart + $$dirInfo{Base} - $subdirInfo{Base};
753 0         0 $fixup->{Shift} += $baseShift;
754             } else {
755             # shift offsets to position of original maker notes
756 1         3 $fixup->{Shift} += $originalPos;
757             }
758             # if we wrote the directory as a block the header is already included
759 1 50       5 $loc = 0 if $subdirInfo{BlockWrite};
760 1         3 $fixup->{Shift} += $loc; # adjust for makernotes header
761 1         7 $fixup->ApplyFixup(\$buff); # fix up pointer offsets
762             # get copy of original Adobe header (6 or 18) and makernotes header ($loc)
763 1         6 my $header = substr($$dataPt, $start, $hdrLen + $loc);
764             # add Adobe and makernotes headers to new directory
765 1         23 $$outfile = $header . $buff;
766             } else {
767             # parse the maker notes directory
768 2         18 $et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc});
769             # extract maker notes as a block if specified
770 2 50 33     11 if ($et->Options('MakerNotes') or
771             $$et{REQ_TAG_LOOKUP}{lc($$tagInfo{Name})})
772             {
773 0         0 my $val;
774 0 0       0 if ($$tagInfo{MakerNotes}) {
775 0         0 $subdirInfo{Base} = $$dirInfo{Base} + $fix;
776 0         0 $subdirInfo{DataPos} = $dataPos - $fix;
777 0         0 $subdirInfo{DirStart} = $dirStart;
778 0         0 $subdirInfo{DirLen} = $dirLen;
779             # rebuild the maker notes to identify all offsets that require fixing up
780 0         0 $val = Image::ExifTool::Exif::RebuildMakerNotes($et, \%subdirInfo, $subTable);
781 0 0 0     0 if (not defined $val and $dirLen > 4) {
782 0         0 $et->Warn('Error rebuilding maker notes (may be corrupt)');
783             }
784             } else {
785             # extract this directory as a block if specified
786 0 0       0 return 1 unless $$tagInfo{Writable};
787             }
788 0 0       0 $val = substr($$dataPt, 20) unless defined $val;
789 0         0 $et->FoundTag($tagInfo, $val);
790             }
791             }
792 3         28 return 1;
793             }
794              
795             #------------------------------------------------------------------------------
796             # Write Adobe information (calls appropriate ProcessProc to do the actual work)
797             # Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
798             # Returns: new data block (may be empty if directory is deleted) or undef on error
799             sub WriteAdobeStuff($$$)
800             {
801 11     11 0 53 my ($et, $dirInfo, $tagTablePtr) = @_;
802 11 100       85 $et or return 1; # allow dummy access
803 2   100     13 my $proc = $$dirInfo{Proc} || \&ProcessAdobeData;
804 2         6 my $buff;
805 2         10 $$dirInfo{OutFile} = \$buff;
806 2 50       19 &$proc($et, $dirInfo, $tagTablePtr) or undef $buff;
807 2         9 return $buff;
808             }
809              
810             1; # end
811              
812             __END__