DNG.pm 31 KB

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