WriteCanonRaw.pl 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637
  1. #------------------------------------------------------------------------------
  2. # File: WriteCanonRaw.pl
  3. #
  4. # Description: Write Canon RAW (CRW and CR2) meta information
  5. #
  6. # Revisions: 01/25/2005 - P. Harvey Created
  7. # 09/16/2010 - PH Added ability to write XMP in CRW images
  8. #------------------------------------------------------------------------------
  9. package Image::ExifTool::CanonRaw;
  10. use strict;
  11. use vars qw($VERSION $AUTOLOAD %crwTagFormat);
  12. use Image::ExifTool::Fixup;
  13. # map for adding directories to CRW
  14. my %crwMap = (
  15. XMP => 'CanonVRD',
  16. CanonVRD => 'Trailer',
  17. );
  18. # mappings to from RAW tagID to MakerNotes tagID
  19. # (Note: upper two bits of RawTagID are zero)
  20. my %mapRawTag = (
  21. # RawTagID => Canon TagID
  22. 0x080b => 0x07, # CanonFirmwareVersion
  23. 0x0810 => 0x09, # OwnerName
  24. 0x0815 => 0x06, # CanonImageType
  25. 0x1028 => 0x03, # (unknown if no tag name specified)
  26. 0x1029 => 0x02, # FocalLength
  27. 0x102a => 0x04, # CanonShotInfo
  28. 0x102d => 0x01, # CanonCameraSettings
  29. 0x1033 => 0x0f, # CanonCustomFunctions (only verified for 10D)
  30. 0x1038 => 0x12, # CanonAFInfo
  31. 0x1039 => 0x13,
  32. 0x1093 => 0x93,
  33. 0x10a8 => 0xa8,
  34. 0x10a9 => 0xa9, # WhiteBalanceTable
  35. 0x10aa => 0xaa,
  36. 0x10ae => 0xae, # ColorTemperature
  37. 0x10b4 => 0xb4, # ColorSpace
  38. 0x10b5 => 0xb5,
  39. 0x10c0 => 0xc0,
  40. 0x10c1 => 0xc1,
  41. 0x180b => 0x0c, # SerialNumber
  42. 0x1817 => 0x08, # FileNumber
  43. 0x1834 => 0x10,
  44. 0x183b => 0x15,
  45. );
  46. # translation from Rotation to Orientation values
  47. my %mapRotation = (
  48. 0 => 1,
  49. 90 => 6,
  50. 180 => 3,
  51. 270 => 8,
  52. );
  53. #------------------------------------------------------------------------------
  54. # Initialize buffers for building MakerNotes from RAW data
  55. # Inputs: 0) ExifTool object reference
  56. sub InitMakerNotes($)
  57. {
  58. my $et = shift;
  59. $$et{MAKER_NOTE_INFO} = {
  60. Entries => { }, # directory entries keyed by tagID
  61. ValBuff => "\0\0\0\0", # value data buffer (start with zero nextIFD pointer)
  62. FixupTags => { }, # flags for tags with data in value buffer
  63. };
  64. }
  65. #------------------------------------------------------------------------------
  66. # Build maker notes from CanonRaw information
  67. # Inputs: 0) ExifTool object reference, 1) raw tag ID, 2) reference to tagInfo
  68. # 3) reference to value, 4) format name, 5) count
  69. # Notes: This will build the directory in the order the tags are found in the CRW
  70. # file, which isn't sequential (but Canon's version isn't sequential either...)
  71. sub BuildMakerNotes($$$$$$)
  72. {
  73. my ($et, $rawTag, $tagInfo, $valuePt, $formName, $count) = @_;
  74. my $tagID = $mapRawTag{$rawTag} || return;
  75. $formName or warn(sprintf "No format for tag 0x%x!\n",$rawTag), return;
  76. # special case: ignore user comment because it gets saved in EXIF
  77. # (and has the same raw tagID as CanonFileDescription)
  78. return if $tagInfo and $$tagInfo{Name} eq 'UserComment';
  79. my $format = $Image::ExifTool::Exif::formatNumber{$formName};
  80. my $fsiz = $Image::ExifTool::Exif::formatSize[$format];
  81. my $size = length($$valuePt);
  82. my $value;
  83. if ($count and $size != $count * $fsiz) {
  84. if ($size < $count * $fsiz) {
  85. warn sprintf("Value too short for raw tag 0x%x\n",$rawTag);
  86. return;
  87. }
  88. # shorten value appropriately
  89. $size = $count * $fsiz;
  90. $value = substr($$valuePt, 0, $size);
  91. } else {
  92. $count = $size / $fsiz;
  93. $value = $$valuePt;
  94. }
  95. my $offsetVal;
  96. my $makerInfo = $$et{MAKER_NOTE_INFO};
  97. if ($size > 4) {
  98. my $len = length $makerInfo->{ValBuff};
  99. $offsetVal = Set32u($len);
  100. $makerInfo->{ValBuff} .= $value;
  101. # pad to an even number of bytes
  102. $size & 0x01 and $makerInfo->{ValBuff} .= "\0";
  103. # set flag indicating that this tag needs a fixup
  104. $makerInfo->{FixupTags}->{$tagID} = 1;
  105. } else {
  106. $offsetVal = $value;
  107. $size < 4 and $offsetVal .= "\0" x (4 - $size);
  108. }
  109. $makerInfo->{Entries}->{$tagID} = Set16u($tagID) . Set16u($format) .
  110. Set32u($count) . $offsetVal;
  111. }
  112. #------------------------------------------------------------------------------
  113. # Finish building and save MakerNotes
  114. # Inputs: 0) ExifTool object reference
  115. sub SaveMakerNotes($)
  116. {
  117. my $et = shift;
  118. # save maker notes
  119. my $makerInfo = $$et{MAKER_NOTE_INFO};
  120. delete $$et{MAKER_NOTE_INFO};
  121. my $dirEntries = $makerInfo->{Entries};
  122. my $numEntries = scalar(keys %$dirEntries);
  123. my $fixup = new Image::ExifTool::Fixup;
  124. return unless $numEntries;
  125. # build the MakerNotes directory
  126. my $makerNotes = Set16u($numEntries);
  127. my $tagID;
  128. # write the entries in proper tag order (even though Canon doesn't do this...)
  129. foreach $tagID (sort { $a <=> $b } keys %$dirEntries) {
  130. $makerNotes .= $$dirEntries{$tagID};
  131. next unless $makerInfo->{FixupTags}->{$tagID};
  132. # add fixup for this pointer
  133. $fixup->AddFixup(length($makerNotes) - 4);
  134. }
  135. # save position of maker notes for pointer fixups
  136. $fixup->{Shift} += length($makerNotes);
  137. $$et{MAKER_NOTE_FIXUP} = $fixup;
  138. $$et{MAKER_NOTE_BYTE_ORDER} = GetByteOrder();
  139. # add value data
  140. $makerNotes .= $makerInfo->{ValBuff};
  141. # get MakerNotes tag info
  142. my $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::Exif::Main');
  143. my $tagInfo = $et->GetTagInfo($tagTablePtr, 0x927c, \$makerNotes);
  144. # save the MakerNotes
  145. $et->FoundTag($tagInfo, $makerNotes);
  146. # save the garbage collection some work later
  147. delete $makerInfo->{Entries};
  148. delete $makerInfo->{ValBuff};
  149. delete $makerInfo->{FixupTags};
  150. # also generate Orientation tag since Rotation isn't transferred from RAW info
  151. my $rotation = $et->GetValue('Rotation', 'ValueConv');
  152. if (defined $rotation and defined $mapRotation{$rotation}) {
  153. $tagInfo = $et->GetTagInfo($tagTablePtr, 0x112);
  154. $et->FoundTag($tagInfo, $mapRotation{$rotation});
  155. }
  156. }
  157. #------------------------------------------------------------------------------
  158. # Check CanonRaw information
  159. # Inputs: 0) ExifTool object reference, 1) tagInfo hash reference,
  160. # 2) raw value reference
  161. # Returns: error string or undef (and may change value) on success
  162. sub CheckCanonRaw($$$)
  163. {
  164. my ($et, $tagInfo, $valPtr) = @_;
  165. my $tagName = $$tagInfo{Name};
  166. if ($tagName eq 'JpgFromRaw' or $tagName eq 'ThumbnailImage') {
  167. unless ($$valPtr =~ /^\xff\xd8/ or $et->Options('IgnoreMinorErrors')) {
  168. return '[minor] Not a valid image';
  169. }
  170. } else {
  171. my $format = $$tagInfo{Format};
  172. my $count = $$tagInfo{Count};
  173. unless ($format) {
  174. my $tagType = ($$tagInfo{TagID} >> 8) & 0x38;
  175. $format = $crwTagFormat{$tagType};
  176. }
  177. $format and return Image::ExifTool::CheckValue($valPtr, $format, $count);
  178. }
  179. return undef;
  180. }
  181. #------------------------------------------------------------------------------
  182. # Write CR2 file
  183. # Inputs: 0) ExifTool ref, 1) dirInfo reference (must have read first 16 bytes)
  184. # 2) tag table reference
  185. # Returns: true on success
  186. sub WriteCR2($$$)
  187. {
  188. my ($et, $dirInfo, $tagTablePtr) = @_;
  189. my $dataPt = $$dirInfo{DataPt} or return 0;
  190. my $outfile = $$dirInfo{OutFile} or return 0;
  191. $$dirInfo{RAF} or return 0;
  192. # check CR2 signature
  193. if ($$dataPt !~ /^.{8}CR\x02\0/s) {
  194. my ($msg, $minor);
  195. if ($$dataPt =~ /^.{8}CR/s) {
  196. $msg = 'Unsupported Canon RAW file. May cause problems if rewritten';
  197. $minor = 1;
  198. } elsif ($$dataPt =~ /^.{8}\xba\xb0\xac\xbb/s) {
  199. $msg = 'Can not currently write Canon 1D RAW images';
  200. } else {
  201. $msg = 'Unrecognized Canon RAW file';
  202. }
  203. return 0 if $et->Error($msg, $minor);
  204. }
  205. # CR2 has a 16-byte header
  206. $$dirInfo{NewDataPos} = 16;
  207. my $newData = $et->WriteDirectory($dirInfo, $tagTablePtr);
  208. return 0 unless defined $newData;
  209. unless ($$dirInfo{LastIFD}) {
  210. $et->Error("CR2 image IFD may not be deleted");
  211. return 0;
  212. }
  213. if (length($newData)) {
  214. # build 16 byte header for Canon RAW file
  215. my $header = substr($$dataPt, 0, 16);
  216. # set IFD0 pointer (may not be 16 if edited by PhotoMechanic)
  217. Set32u(16, \$header, 4);
  218. # last 4 bytes of header is pointer to last IFD
  219. Set32u($$dirInfo{LastIFD}, \$header, 12);
  220. Write($outfile, $header, $newData) or return 0;
  221. undef $newData; # free memory
  222. # copy over image data now if necessary
  223. if (ref $$dirInfo{ImageData}) {
  224. $et->CopyImageData($$dirInfo{ImageData}, $outfile) or return 0;
  225. delete $$dirInfo{ImageData};
  226. }
  227. }
  228. return 1;
  229. }
  230. #------------------------------------------------------------------------------
  231. # Write CanonRaw (CRW) information
  232. # Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
  233. # 2) tag table reference
  234. # Returns: true on success
  235. # Notes: Increments ExifTool CHANGED flag for each tag changed This routine is
  236. # different from all of the other write routines because Canon RAW files are
  237. # designed well! So it isn't necessary to buffer the data in memory before
  238. # writing it out. Therefore this routine doesn't return the directory data as
  239. # the rest of the Write routines do. Instead, it writes to the dirInfo
  240. # OutFile on the fly --> much faster, efficient, and less demanding on memory!
  241. sub WriteCanonRaw($$$)
  242. {
  243. my ($et, $dirInfo, $tagTablePtr) = @_;
  244. $et or return 1; # allow dummy access to autoload this package
  245. my $blockStart = $$dirInfo{DirStart};
  246. my $blockSize = $$dirInfo{DirLen};
  247. my $raf = $$dirInfo{RAF} or return 0;
  248. my $outfile = $$dirInfo{OutFile} or return 0;
  249. my $outPos = $$dirInfo{OutPos} or return 0;
  250. my $outBase = $outPos;
  251. my $verbose = $et->Options('Verbose');
  252. my $out = $et->Options('TextOut');
  253. my ($buff, $tagInfo);
  254. # 4 bytes at end of block give directory position within block
  255. $raf->Seek($blockStart+$blockSize-4, 0) or return 0;
  256. $raf->Read($buff, 4) == 4 or return 0;
  257. my $dirOffset = Get32u(\$buff,0) + $blockStart;
  258. $raf->Seek($dirOffset, 0) or return 0;
  259. $raf->Read($buff, 2) == 2 or return 0;
  260. my $entries = Get16u(\$buff,0); # get number of entries in directory
  261. # read the directory (10 bytes per entry)
  262. $raf->Read($buff, 10 * $entries) == 10 * $entries or return 0;
  263. my $newDir = '';
  264. # get hash of new information keyed by tagID
  265. my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
  266. # generate list of tags to add or delete (currently, we only allow JpgFromRaw
  267. # and ThumbnailImage, to be added or deleted from the root CanonRaw directory)
  268. my (@addTags, %delTag);
  269. if ($$dirInfo{Nesting} == 0) {
  270. my $tagID;
  271. foreach $tagID (keys %$newTags) {
  272. my $permanent = $newTags->{$tagID}->{Permanent};
  273. push(@addTags, $tagID) if defined($permanent) and not $permanent;
  274. }
  275. }
  276. my $index;
  277. for ($index=0; ; ++$index) {
  278. my ($pt, $tag, $size, $valuePtr, $ptr, $value);
  279. if ($index<$entries) {
  280. $pt = 10 * $index;
  281. $tag = Get16u(\$buff, $pt);
  282. $size = Get32u(\$buff, $pt+2);
  283. $valuePtr = Get32u(\$buff, $pt+6);
  284. $ptr = $valuePtr + $blockStart; # all pointers relative to block start
  285. }
  286. # add any required new tags
  287. # NOTE: can't currently add tags where value is stored in directory
  288. if (@addTags and (not defined($tag) or $tag >= $addTags[0])) {
  289. my $addTag = shift @addTags;
  290. $tagInfo = $$newTags{$addTag};
  291. my $newVal = $et->GetNewValue($tagInfo);
  292. if (defined $newVal) {
  293. # pad value to an even length (Canon ImageBrowser and ZoomBrowser
  294. # version 6.1.1 have problems with odd-sized embedded JPEG images
  295. # even if the value is padded to maintain alignment, so do this
  296. # before calculating the size for the directory entry)
  297. $newVal .= "\0" if length($newVal) & 0x01;
  298. # add new directory entry
  299. $newDir .= Set16u($addTag) . Set32u(length($newVal)) .
  300. Set32u($outPos - $outBase);
  301. # write new value data
  302. Write($outfile, $newVal) or return 0;
  303. $outPos += length($newVal); # update current position
  304. $verbose > 1 and print $out " + CanonRaw:$$tagInfo{Name}\n";
  305. ++$$et{CHANGED};
  306. }
  307. # set flag to delete this tag if found later
  308. $delTag{$addTag} = 1;
  309. }
  310. last unless defined $tag; # all done if no more directory entries
  311. return 0 if $tag & 0x8000; # top bit should not be set
  312. my $tagID = $tag & 0x3fff; # get tag ID
  313. my $tagType = ($tag >> 8) & 0x38; # get tag type
  314. my $valueInDir = ($tag & 0x4000); # flag for value in directory
  315. my $tagInfo = $et->GetTagInfo($tagTablePtr,$tagID);
  316. my $format = $crwTagFormat{$tagType};
  317. my ($count, $subdir);
  318. if ($tagInfo) {
  319. $subdir = $$tagInfo{SubDirectory};
  320. $format = $$tagInfo{Format} if $$tagInfo{Format};
  321. $count = $$tagInfo{Count};
  322. }
  323. if ($valueInDir) {
  324. $size = 8;
  325. $value = substr($buff, $pt+2, $size);
  326. # set count to 1 by default for normal values in directory
  327. $count = 1 if not defined $count and $format and
  328. $format ne 'string' and not $subdir;
  329. } else {
  330. if ($tagType==0x28 or $tagType==0x30) {
  331. # this type of tag specifies a raw subdirectory
  332. my $name;
  333. $tagInfo and $name = $$tagInfo{Name};
  334. $name or $name = sprintf("CanonRaw_0x%.4x", $tagID);
  335. my %subdirInfo = (
  336. DirName => $name,
  337. DataLen => 0,
  338. DirStart => $ptr,
  339. DirLen => $size,
  340. Nesting => $$dirInfo{Nesting} + 1,
  341. RAF => $raf,
  342. Parent => $$dirInfo{DirName},
  343. OutFile => $outfile,
  344. OutPos => $outPos,
  345. );
  346. my $result = $et->WriteDirectory(\%subdirInfo, $tagTablePtr);
  347. return 0 unless $result;
  348. # set size and pointer for this new directory
  349. $size = $subdirInfo{OutPos} - $outPos;
  350. $valuePtr = $outPos - $outBase;
  351. $outPos = $subdirInfo{OutPos};
  352. } else {
  353. # verify that the value data is within this block
  354. $valuePtr + $size <= $blockSize or return 0;
  355. # read value from file
  356. $raf->Seek($ptr, 0) or return 0;
  357. $raf->Read($value, $size) == $size or return 0;
  358. }
  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. # edit subdirectory if necessary
  368. if ($tagInfo) {
  369. if ($subdir and $$subdir{TagTable}) {
  370. my $name = $$tagInfo{Name};
  371. my $newTagTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
  372. return 0 unless $newTagTable;
  373. my $subdirStart = 0;
  374. #### eval Start ()
  375. $subdirStart = eval $$subdir{Start} if $$subdir{Start};
  376. my $dirData = \$value;
  377. my %subdirInfo = (
  378. Name => $name,
  379. DataPt => $dirData,
  380. DataLen => $size,
  381. DirStart => $subdirStart,
  382. DirLen => $size - $subdirStart,
  383. Nesting => $$dirInfo{Nesting} + 1,
  384. RAF => $raf,
  385. Parent => $$dirInfo{DirName},
  386. );
  387. #### eval Validate ($dirData, $subdirStart, $size)
  388. if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
  389. $et->Warn("Invalid $name data");
  390. } else {
  391. $subdir = $et->WriteDirectory(\%subdirInfo, $newTagTable);
  392. if (defined $subdir and length $subdir) {
  393. if ($subdirStart) {
  394. # add header before data directory
  395. $value = substr($value, 0, $subdirStart) . $subdir;
  396. } else {
  397. $value = $subdir;
  398. }
  399. }
  400. }
  401. } elsif ($$newTags{$tagID}) {
  402. if ($delTag{$tagID}) {
  403. $verbose > 1 and print $out " - CanonRaw:$$tagInfo{Name}\n";
  404. ++$$et{CHANGED};
  405. next; # next since we already added this tag
  406. }
  407. my $oldVal;
  408. if ($format) {
  409. $oldVal = ReadValue(\$value, 0, $format, $count, $size);
  410. } else {
  411. $oldVal = $value;
  412. }
  413. my $nvHash = $et->GetNewValueHash($tagInfo);
  414. if ($et->IsOverwriting($nvHash, $oldVal)) {
  415. my $newVal = $et->GetNewValue($nvHash);
  416. my $verboseVal;
  417. $verboseVal = $newVal if $verbose > 1;
  418. # convert to specified format if necessary
  419. if (defined $newVal and $format) {
  420. $newVal = WriteValue($newVal, $format, $count);
  421. }
  422. if (defined $newVal) {
  423. $value = $newVal;
  424. ++$$et{CHANGED};
  425. $et->VerboseValue("- CanonRaw:$$tagInfo{Name}", $oldVal);
  426. $et->VerboseValue("+ CanonRaw:$$tagInfo{Name}", $verboseVal);
  427. }
  428. }
  429. }
  430. }
  431. if ($valueInDir) {
  432. my $len = length $value;
  433. if ($len < 8) {
  434. # pad with original garbage in case it contained something useful
  435. $value .= substr($buff, $pt+2+8-$len, 8-$len);
  436. } elsif ($len > 8) { # this shouldn't happen
  437. warn "Value too long! -- trucated\n";
  438. $value = substr($value, 0, 8);
  439. }
  440. # create new directory entry
  441. $newDir .= Set16u($tag) . $value;
  442. next; # all done this entry
  443. }
  444. if (defined $value) {
  445. # don't allow value to change length unless Writable is 'resize'
  446. my $writable = $$tagInfo{Writable};
  447. my $diff = length($value) - $size;
  448. if ($diff) {
  449. if ($writable and $writable eq 'resize') {
  450. $size += $diff; # allow size to change
  451. } elsif ($diff > 0) {
  452. $value .= ("\0" x $diff);
  453. } else {
  454. $value = substr($value, 0, $size);
  455. }
  456. }
  457. # pad value if necessary to align on even-byte boundary (as per CIFF spec)
  458. $value .= "\0" if $size & 0x01;
  459. $valuePtr = $outPos - $outBase;
  460. # write out value data
  461. Write($outfile, $value) or return 0;
  462. $outPos += length($value); # update current position in outfile
  463. }
  464. # create new directory entry
  465. $newDir .= Set16u($tag) . Set32u($size) . Set32u($valuePtr);
  466. }
  467. # add the directory counts and offset to the directory start,
  468. $entries = length($newDir) / 10;
  469. $newDir = Set16u($entries) . $newDir . Set32u($outPos - $outBase);
  470. # write directory data
  471. Write($outfile, $newDir) or return 0;
  472. # update current output file position in dirInfo
  473. $$dirInfo{OutPos} = $outPos + length($newDir);
  474. # save outfile directory start (needed for rewriting VRD trailer)
  475. $$dirInfo{OutDirStart} = $outPos - $outBase;
  476. return 1;
  477. }
  478. #------------------------------------------------------------------------------
  479. # write Canon RAW (CRW) file
  480. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  481. # Returns: 1 on success, 0 if this wasn't a valid CRW file,
  482. # or -1 if a write error occurred
  483. sub WriteCRW($$)
  484. {
  485. my ($et, $dirInfo) = @_;
  486. my $outfile = $$dirInfo{OutFile};
  487. my $raf = $$dirInfo{RAF};
  488. my $rtnVal = 0;
  489. my ($buff, $err, $sig);
  490. $raf->Read($buff,2) == 2 or return 0;
  491. SetByteOrder($buff) or return 0;
  492. $raf->Read($buff,4) == 4 or return 0;
  493. $raf->Read($sig,8) == 8 or return 0; # get file signature
  494. $sig =~ /^HEAP(CCDR|JPGM)/ or return 0; # validate signature
  495. my $type = $1;
  496. my $hlen = Get32u(\$buff, 0); # get header length
  497. if ($$et{DEL_GROUP}{MakerNotes}) {
  498. if ($type eq 'CCDR') {
  499. $et->Error("Can't delete MakerNotes group in CRW file");
  500. return 0;
  501. } else {
  502. ++$$et{CHANGED};
  503. return 1;
  504. }
  505. }
  506. # make XMP the preferred group for CRW files
  507. if ($$et{FILE_TYPE} eq 'CRW') {
  508. $et->InitWriteDirs(\%crwMap, 'XMP');
  509. }
  510. # write header
  511. $raf->Seek(0, 0) or return 0;
  512. $raf->Read($buff, $hlen) == $hlen or return 0;
  513. Write($outfile, $buff) or $err = 1;
  514. $raf->Seek(0, 2) or return 0; # seek to end of file
  515. my $filesize = $raf->Tell() or return 0;
  516. # build directory information for main raw directory
  517. my %dirInfo = (
  518. DataLen => 0,
  519. DirStart => $hlen,
  520. DirLen => $filesize - $hlen,
  521. Nesting => 0,
  522. RAF => $raf,
  523. Parent => 'CRW',
  524. OutFile => $outfile,
  525. OutPos => $hlen,
  526. );
  527. # process the raw directory
  528. my $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::CanonRaw::Main');
  529. my $success = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
  530. my $trailPt;
  531. while ($success) {
  532. # check to see if trailer(s) exist(s)
  533. my $trailInfo = Image::ExifTool::IdentifyTrailer($raf) or last;
  534. # rewrite the trailer(s)
  535. $buff = '';
  536. $$trailInfo{OutFile} = \$buff;
  537. $success = $et->ProcessTrailers($trailInfo) or last;
  538. $trailPt = $$trailInfo{OutFile};
  539. # nothing to write if trailers were deleted
  540. undef $trailPt if length($$trailPt) < 4;
  541. last;
  542. }
  543. if ($success) {
  544. # add CanonVRD trailer if writing as a block
  545. $trailPt = $et->AddNewTrailers($trailPt,'CanonVRD');
  546. if (not $trailPt and $$et{ADD_DIRS}{CanonVRD}) {
  547. # create CanonVRD from scratch if necessary
  548. my $outbuff = '';
  549. my $saveOrder = GetByteOrder();
  550. require Image::ExifTool::CanonVRD;
  551. if (Image::ExifTool::CanonVRD::ProcessCanonVRD($et, { OutFile => \$outbuff }) > 0) {
  552. $trailPt = \$outbuff;
  553. }
  554. SetByteOrder($saveOrder);
  555. }
  556. # write trailer
  557. if ($trailPt) {
  558. # must append DirStart pointer to end of trailer
  559. my $newDirStart = Set32u($dirInfo{OutDirStart});
  560. my $len = length $$trailPt;
  561. my $pad = ($len & 0x01) ? ' ' : ''; # add pad byte if necessary
  562. Write($outfile, $pad, substr($$trailPt,0,$len-4), $newDirStart) or $err = 1;
  563. }
  564. $rtnVal = $err ? -1 : 1;
  565. } else {
  566. $et->Error('Error rewriting CRW file');
  567. }
  568. return $rtnVal;
  569. }
  570. 1; # end
  571. __END__
  572. =head1 NAME
  573. Image::ExifTool::WriteCanonRaw.pl - Write Canon RAW (CRW and CR2) information
  574. =head1 SYNOPSIS
  575. These routines are autoloaded by Image::ExifTool::CanonRaw.
  576. =head1 DESCRIPTION
  577. This file contains routines used by ExifTool to write Canon CRW and CR2
  578. files and metadata.
  579. =head1 NOTES
  580. The CRW format is a pleasure to work with. All pointer offsets are relative
  581. to the start of the data for each directory. If TIFF/EXIF had implemented
  582. pointers in this way, it would be MUCH easier to read and write TIFF/JPEG
  583. files, and would lead to far fewer problems with corrupted metadata.
  584. =head1 AUTHOR
  585. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  586. This library is free software; you can redistribute it and/or modify it
  587. under the same terms as Perl itself.
  588. =head1 SEE ALSO
  589. L<Image::ExifTool::CanonRaw(3pm)|Image::ExifTool::CanonRaw>,
  590. L<Image::ExifTool(3pm)|Image::ExifTool>,
  591. L<http://owl.phy.queensu.ca/~phil/exiftool/canon_raw.html>
  592. =cut