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