File Coverage

blib/lib/Image/ExifTool/DNG.pm
Criterion Covered Total %
statement 115 393 29.2
branch 38 214 17.7
condition 11 87 12.6
subroutine 9 15 60.0
pod 0 9 0.0
total 173 718 24.0


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