File Coverage

blib/lib/Image/ExifTool/CanonVRD.pm
Criterion Covered Total %
statement 373 464 80.3
branch 211 324 65.1
condition 65 127 51.1
subroutine 13 16 81.2
pod 0 12 0.0
total 662 943 70.2


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: CanonVRD.pm
3             #
4             # Description: Read/write Canon VRD and DR4 information
5             #
6             # Revisions: 2006/10/30 - P. Harvey Created
7             # 2007/10/23 - PH Added new VRD 3.0 tags
8             # 2008/08/29 - PH Added new VRD 3.4 tags
9             # 2008/12/02 - PH Added new VRD 3.5 tags
10             # 2010/06/18 - PH Support variable-length CustomPictureStyle data
11             # 2010/09/14 - PH Added r/w support for XMP in VRD
12             # 2015/05/16 - PH Added DR4 support (DPP 4.1.50.0)
13             # 2018/03/13 - PH Update to DPP 4.8.20
14             #
15             # References: 1) Bogdan private communication (Canon DPP v3.4.1.1)
16             # 2) Gert Kello private communication (DPP 3.8)
17             #------------------------------------------------------------------------------
18              
19             package Image::ExifTool::CanonVRD;
20              
21 14     14   7141 use strict;
  14         30  
  14         689  
22 14     14   117 use vars qw($VERSION);
  14         29  
  14         836  
23 14     14   82 use Image::ExifTool qw(:DataAccess :Utils);
  14         301  
  14         4016  
24 14     14   7245 use Image::ExifTool::Canon;
  14         45  
  14         122072  
25              
26             $VERSION = '1.41';
27              
28             sub ProcessCanonVRD($$;$);
29             sub WriteCanonVRD($$;$);
30             sub ProcessEditData($$$);
31             sub ProcessIHL($$$);
32             sub ProcessIHLExif($$$);
33             sub ProcessDR4($$;$);
34             sub SortDR4($$);
35              
36             # map for adding directories to VRD
37             my %vrdMap = (
38             XMP => 'CanonVRD',
39             CanonVRD => 'VRD',
40             );
41              
42             my %noYes = (
43             PrintConvColumns => 2,
44             PrintConv => { 0 => 'No', 1 => 'Yes' },
45             );
46              
47             # DR4 format codes
48             my %vrdFormat = (
49             1 => 'int32u',
50             2 => 'string',
51             8 => 'int32u',
52             9 => 'int32s',
53             13 => 'double',
54             24 => 'int32s', # (rectangle coordinates)
55             33 => 'int32u', # (array)
56             38 => 'double', # (array)
57             # 254 => 'undef', ?
58             255 => 'undef',
59             );
60              
61             # empty VRD header/footer for creating VRD from scratch
62             my $blankHeader = "CANON OPTIONAL DATA\0\0\x01\0\0\0\0\0\0";
63             my $blankFooter = "CANON OPTIONAL DATA\0" . ("\0" x 42) . "\xff\xd9";
64              
65             # main tag table blocks in CanonVRD trailer (ref PH)
66             %Image::ExifTool::CanonVRD::Main = (
67             WRITE_PROC => \&WriteCanonVRD,
68             PROCESS_PROC => \&ProcessCanonVRD,
69             NOTES => q{
70             Canon Digital Photo Professional writes VRD (Recipe Data) information as a
71             trailer record to JPEG, TIFF, CRW and CR2 images, or as stand-alone VRD or
72             DR4 files. The tags listed below represent information found in these
73             records. The complete VRD/DR4 data record may be accessed as a block using
74             the Extra 'CanonVRD' or 'CanonDR4' tag, but this tag is not extracted or
75             copied unless specified explicitly.
76             },
77             0xffff00f4 => {
78             Name => 'EditData',
79             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Edit' },
80             },
81             0xffff00f5 => {
82             Name => 'IHLData',
83             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::IHL' },
84             },
85             0xffff00f6 => {
86             Name => 'XMP',
87             Flags => [ 'Binary', 'Protected' ],
88             Writable => 'undef', # allow writing/deleting as a block
89             SubDirectory => {
90             DirName => 'XMP',
91             TagTable => 'Image::ExifTool::XMP::Main',
92             },
93             },
94             0xffff00f7 => {
95             Name => 'Edit4Data',
96             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Edit4' },
97             },
98             );
99              
100             # the VRD edit information is divided into sections
101             %Image::ExifTool::CanonVRD::Edit = (
102             WRITE_PROC => \&ProcessEditData,
103             PROCESS_PROC => \&ProcessEditData,
104             VARS => { ID_LABEL => 'Index' }, # change TagID label in documentation
105             NOTES => 'Canon VRD edit information.',
106             0 => {
107             Name => 'VRD1',
108             Size => 0x272, # size of version 1.0 edit information in bytes
109             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Ver1' },
110             },
111             1 => {
112             Name => 'VRDStampTool',
113             Size => 0, # size is variable, and obtained from int32u at directory start
114             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::StampTool' },
115             },
116             2 => {
117             Name => 'VRD2',
118             Size => undef, # size is the remaining edit data
119             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Ver2' },
120             },
121             );
122              
123             # Canon DPP version 4 edit information
124             %Image::ExifTool::CanonVRD::Edit4 = (
125             WRITE_PROC => \&ProcessEditData,
126             PROCESS_PROC => \&ProcessEditData,
127             VARS => { ID_LABEL => 'Index' }, # change TagID label in documentation
128             NOTES => 'Canon DPP version 4 edit information.',
129             0 => {
130             Name => 'DR4',
131             Size => undef, # size is the remaining edit data
132             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::DR4' },
133             },
134             );
135              
136             # "IHL Created Optional Item Data" tags (not yet writable)
137             %Image::ExifTool::CanonVRD::IHL = (
138             PROCESS_PROC => \&ProcessIHL,
139             TAG_PREFIX => 'VRD_IHL',
140             GROUPS => { 2 => 'Image' },
141             1 => [
142             # this contains edited TIFF-format data, with an original IFD at 0x0008
143             # and an edited IFD with offset given in the TIFF header.
144             {
145             Name => 'IHL_EXIF',
146             Condition => '$self->Options("ExtractEmbedded")',
147             SubDirectory => {
148             TagTable => 'Image::ExifTool::Exif::Main',
149             ProcessProc => \&ProcessIHLExif,
150             },
151             },{
152             Name => 'IHL_EXIF',
153             Notes => q{
154             extracted as a block if the L option is used, or processed as the
155             first sub-document with the L option
156             },
157             Binary => 1,
158             Unknown => 1,
159             },
160             ],
161             # 2 - written by DPP 3.0.2.6, and it looks something like edit data,
162             # but I haven't decoded it yet - PH
163             3 => {
164             # (same size as the PreviewImage with DPP 3.0.2.6)
165             Name => 'ThumbnailImage',
166             Groups => { 2 => 'Preview' },
167             Binary => 1,
168             },
169             4 => {
170             Name => 'PreviewImage',
171             Groups => { 2 => 'Preview' },
172             Binary => 1,
173             },
174             5 => {
175             Name => 'RawCodecVersion',
176             ValueConv => '$val =~ s/\0.*//s; $val', # truncate string at null
177             },
178             6 => {
179             Name => 'CRCDevelParams',
180             Binary => 1,
181             Unknown => 1,
182             },
183             );
184              
185             # VRD version 1 tags (ref PH)
186             %Image::ExifTool::CanonVRD::Ver1 = (
187             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
188             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
189             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
190             WRITABLE => 1,
191             PERMANENT => 1, # (can't add/delete these individually)
192             FIRST_ENTRY => 0,
193             GROUPS => { 2 => 'Image' },
194             DATAMEMBER => [ 0x002 ], # necessary for writing
195             #
196             # RAW image adjustment
197             #
198             0x002 => {
199             Name => 'VRDVersion',
200             Format => 'int16u',
201             Writable => 0,
202             DataMember => 'VRDVersion',
203             RawConv => '$$self{VRDVersion} = $val',
204             PrintConv => '$val =~ s/^(\d)(\d*)(\d)$/$1.$2.$3/; $val',
205             },
206             0x006 => {
207             Name => 'WBAdjRGGBLevels',
208             Format => 'int16u[4]',
209             },
210             0x018 => {
211             Name => 'WhiteBalanceAdj',
212             Format => 'int16u',
213             PrintConvColumns => 2,
214             PrintConv => {
215             0 => 'Auto',
216             1 => 'Daylight',
217             2 => 'Cloudy',
218             3 => 'Tungsten',
219             4 => 'Fluorescent',
220             5 => 'Flash',
221             8 => 'Shade',
222             9 => 'Kelvin',
223             30 => 'Manual (Click)',
224             31 => 'Shot Settings',
225             },
226             },
227             0x01a => {
228             Name => 'WBAdjColorTemp',
229             Format => 'int16u',
230             },
231             # 0x01c similar to 0x006
232             0x024 => {
233             Name => 'WBFineTuneActive',
234             Format => 'int16u',
235             %noYes,
236             },
237             0x028 => {
238             Name => 'WBFineTuneSaturation',
239             Format => 'int16u',
240             },
241             0x02c => {
242             Name => 'WBFineTuneTone',
243             Format => 'int16u',
244             },
245             0x02e => {
246             Name => 'RawColorAdj',
247             Format => 'int16u',
248             PrintConv => {
249             0 => 'Shot Settings',
250             1 => 'Faithful',
251             2 => 'Custom',
252             },
253             },
254             0x030 => {
255             Name => 'RawCustomSaturation',
256             Format => 'int32s',
257             },
258             0x034 => {
259             Name => 'RawCustomTone',
260             Format => 'int32s',
261             },
262             0x038 => {
263             Name => 'RawBrightnessAdj',
264             Format => 'int32s',
265             ValueConv => '$val / 6000',
266             ValueConvInv => 'int($val * 6000 + ($val < 0 ? -0.5 : 0.5))',
267             PrintConv => 'sprintf("%.2f",$val)',
268             PrintConvInv => '$val',
269             },
270             0x03c => {
271             Name => 'ToneCurveProperty',
272             Format => 'int16u',
273             PrintConvColumns => 2,
274             PrintConv => {
275             0 => 'Shot Settings',
276             1 => 'Linear',
277             2 => 'Custom 1',
278             3 => 'Custom 2',
279             4 => 'Custom 3',
280             5 => 'Custom 4',
281             6 => 'Custom 5',
282             },
283             },
284             # 0x040 usually "10 9 2"
285             0x07a => {
286             Name => 'DynamicRangeMin',
287             Format => 'int16u',
288             },
289             0x07c => {
290             Name => 'DynamicRangeMax',
291             Format => 'int16u',
292             },
293             # 0x0c6 usually "10 9 2"
294             #
295             # RGB image adjustment
296             #
297             0x110 => {
298             Name => 'ToneCurveActive',
299             Format => 'int16u',
300             %noYes,
301             },
302             0x113 => {
303             Name => 'ToneCurveMode',
304             PrintConv => { 0 => 'RGB', 1 => 'Luminance' },
305             },
306             0x114 => {
307             Name => 'BrightnessAdj',
308             Format => 'int8s',
309             },
310             0x115 => {
311             Name => 'ContrastAdj',
312             Format => 'int8s',
313             },
314             0x116 => {
315             Name => 'SaturationAdj',
316             Format => 'int16s',
317             },
318             0x11e => {
319             Name => 'ColorToneAdj',
320             Notes => 'in degrees, so -1 is the same as 359',
321             Format => 'int32s',
322             },
323             0x126 => {
324             Name => 'LuminanceCurvePoints',
325             Format => 'int16u[21]',
326             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
327             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
328             },
329             0x150 => {
330             Name => 'LuminanceCurveLimits',
331             Notes => '4 numbers: input and output highlight and shadow points',
332             Format => 'int16u[4]',
333             },
334             0x159 => {
335             Name => 'ToneCurveInterpolation',
336             PrintConv => { 0 => 'Curve', 1 => 'Straight' },
337             },
338             0x160 => {
339             Name => 'RedCurvePoints',
340             Format => 'int16u[21]',
341             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
342             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
343             },
344             # 0x193 same as 0x159
345             0x19a => {
346             Name => 'GreenCurvePoints',
347             Format => 'int16u[21]',
348             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
349             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
350             },
351             # 0x1cd same as 0x159
352             0x1d4 => {
353             Name => 'BlueCurvePoints',
354             Format => 'int16u[21]',
355             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
356             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
357             },
358             0x18a => {
359             Name => 'RedCurveLimits',
360             Format => 'int16u[4]',
361             },
362             0x1c4 => {
363             Name => 'GreenCurveLimits',
364             Format => 'int16u[4]',
365             },
366             0x1fe => {
367             Name => 'BlueCurveLimits',
368             Format => 'int16u[4]',
369             },
370             # 0x207 same as 0x159
371             0x20e => {
372             Name => 'RGBCurvePoints',
373             Format => 'int16u[21]',
374             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
375             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
376             },
377             0x238 => {
378             Name => 'RGBCurveLimits',
379             Format => 'int16u[4]',
380             },
381             # 0x241 same as 0x159
382             0x244 => {
383             Name => 'CropActive',
384             Format => 'int16u',
385             %noYes,
386             },
387             0x246 => {
388             Name => 'CropLeft',
389             Notes => 'crop coordinates in original unrotated image',
390             Format => 'int16u',
391             },
392             0x248 => {
393             Name => 'CropTop',
394             Format => 'int16u',
395             },
396             0x24a => {
397             Name => 'CropWidth',
398             Format => 'int16u',
399             },
400             0x24c => {
401             Name => 'CropHeight',
402             Format => 'int16u',
403             },
404             0x25a => {
405             Name => 'SharpnessAdj',
406             Format => 'int16u',
407             },
408             0x260 => {
409             Name => 'CropAspectRatio',
410             Format => 'int16u',
411             PrintConv => {
412             0 => 'Free',
413             1 => '3:2',
414             2 => '2:3',
415             3 => '4:3',
416             4 => '3:4',
417             5 => 'A-size Landscape',
418             6 => 'A-size Portrait',
419             7 => 'Letter-size Landscape',
420             8 => 'Letter-size Portrait',
421             9 => '4:5',
422             10 => '5:4',
423             11 => '1:1',
424             12 => 'Circle',
425             65535 => 'Custom',
426             },
427             },
428             0x262 => {
429             Name => 'ConstrainedCropWidth',
430             Format => 'float',
431             PrintConv => 'sprintf("%.7g",$val)',
432             PrintConvInv => '$val',
433             },
434             0x266 => {
435             Name => 'ConstrainedCropHeight',
436             Format => 'float',
437             PrintConv => 'sprintf("%.7g",$val)',
438             PrintConvInv => '$val',
439             },
440             0x26a => {
441             Name => 'CheckMark',
442             Format => 'int16u',
443             PrintConv => {
444             0 => 'Clear',
445             1 => 1,
446             2 => 2,
447             3 => 3,
448             },
449             },
450             0x26e => {
451             Name => 'Rotation',
452             Format => 'int16u',
453             PrintConv => {
454             0 => 0,
455             1 => 90,
456             2 => 180,
457             3 => 270,
458             },
459             },
460             0x270 => {
461             Name => 'WorkColorSpace',
462             Format => 'int16u',
463             PrintConv => {
464             0 => 'sRGB',
465             1 => 'Adobe RGB',
466             2 => 'Wide Gamut RGB',
467             3 => 'Apple RGB',
468             4 => 'ColorMatch RGB',
469             },
470             },
471             # (VRD 1.0.0 edit data ends here -- 0x272 bytes)
472             );
473              
474             # VRD Stamp Tool tags (ref PH)
475             %Image::ExifTool::CanonVRD::StampTool = (
476             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
477             GROUPS => { 2 => 'Image' },
478             0x00 => {
479             Name => 'StampToolCount',
480             Format => 'int32u',
481             },
482             );
483              
484             # VRD version 2 and 3 tags (ref PH)
485             %Image::ExifTool::CanonVRD::Ver2 = (
486             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
487             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
488             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
489             WRITABLE => 1,
490             PERMANENT => 1, # (can't add/delete these individually)
491             FIRST_ENTRY => 0,
492             FORMAT => 'int16s',
493             DATAMEMBER => [ 0x58, 0xdc, 0xdf, 0xe0 ], # (required for DataMember and var-format tags)
494             IS_SUBDIR => [ 0xe0 ],
495             GROUPS => { 2 => 'Image' },
496             NOTES => 'Tags added in DPP version 2.0 and later.',
497             0x02 => {
498             Name => 'PictureStyle',
499             PrintConvColumns => 2,
500             PrintConv => {
501             0 => 'Standard',
502             1 => 'Portrait',
503             2 => 'Landscape',
504             3 => 'Neutral',
505             4 => 'Faithful',
506             5 => 'Monochrome',
507             6 => 'Unknown?', # PH (maybe in-camera custom picture style?)
508             7 => 'Custom',
509             },
510             },
511             0x03 => { Name => 'IsCustomPictureStyle', %noYes },
512             # 0x08: 3
513             # 0x09: 4095
514             # 0x0a: 0
515             # 0x0b: 4095
516             # 0x0c: 0
517             0x0d => 'StandardRawColorTone',
518             0x0e => 'StandardRawSaturation',
519             0x0f => 'StandardRawContrast',
520             0x10 => { Name => 'StandardRawLinear', %noYes },
521             0x11 => 'StandardRawSharpness',
522             0x12 => 'StandardRawHighlightPoint',
523             0x13 => 'StandardRawShadowPoint',
524             0x14 => 'StandardOutputHighlightPoint', #2
525             0x15 => 'StandardOutputShadowPoint', #2
526             0x16 => 'PortraitRawColorTone',
527             0x17 => 'PortraitRawSaturation',
528             0x18 => 'PortraitRawContrast',
529             0x19 => { Name => 'PortraitRawLinear', %noYes },
530             0x1a => 'PortraitRawSharpness',
531             0x1b => 'PortraitRawHighlightPoint',
532             0x1c => 'PortraitRawShadowPoint',
533             0x1d => 'PortraitOutputHighlightPoint',
534             0x1e => 'PortraitOutputShadowPoint',
535             0x1f => 'LandscapeRawColorTone',
536             0x20 => 'LandscapeRawSaturation',
537             0x21 => 'LandscapeRawContrast',
538             0x22 => { Name => 'LandscapeRawLinear', %noYes },
539             0x23 => 'LandscapeRawSharpness',
540             0x24 => 'LandscapeRawHighlightPoint',
541             0x25 => 'LandscapeRawShadowPoint',
542             0x26 => 'LandscapeOutputHighlightPoint',
543             0x27 => 'LandscapeOutputShadowPoint',
544             0x28 => 'NeutralRawColorTone',
545             0x29 => 'NeutralRawSaturation',
546             0x2a => 'NeutralRawContrast',
547             0x2b => { Name => 'NeutralRawLinear', %noYes },
548             0x2c => 'NeutralRawSharpness',
549             0x2d => 'NeutralRawHighlightPoint',
550             0x2e => 'NeutralRawShadowPoint',
551             0x2f => 'NeutralOutputHighlightPoint',
552             0x30 => 'NeutralOutputShadowPoint',
553             0x31 => 'FaithfulRawColorTone',
554             0x32 => 'FaithfulRawSaturation',
555             0x33 => 'FaithfulRawContrast',
556             0x34 => { Name => 'FaithfulRawLinear', %noYes },
557             0x35 => 'FaithfulRawSharpness',
558             0x36 => 'FaithfulRawHighlightPoint',
559             0x37 => 'FaithfulRawShadowPoint',
560             0x38 => 'FaithfulOutputHighlightPoint',
561             0x39 => 'FaithfulOutputShadowPoint',
562             0x3a => {
563             Name => 'MonochromeFilterEffect',
564             PrintConv => {
565             -2 => 'None',
566             -1 => 'Yellow',
567             0 => 'Orange',
568             1 => 'Red',
569             2 => 'Green',
570             },
571             },
572             0x3b => {
573             Name => 'MonochromeToningEffect',
574             PrintConv => {
575             -2 => 'None',
576             -1 => 'Sepia',
577             0 => 'Blue',
578             1 => 'Purple',
579             2 => 'Green',
580             },
581             },
582             0x3c => 'MonochromeContrast',
583             0x3d => { Name => 'MonochromeLinear', %noYes },
584             0x3e => 'MonochromeSharpness',
585             0x3f => 'MonochromeRawHighlightPoint',
586             0x40 => 'MonochromeRawShadowPoint',
587             0x41 => 'MonochromeOutputHighlightPoint',
588             0x42 => 'MonochromeOutputShadowPoint',
589             0x45 => { Name => 'UnknownContrast', Unknown => 1 },
590             0x46 => { Name => 'UnknownLinear', %noYes, Unknown => 1 },
591             0x47 => { Name => 'UnknownSharpness', Unknown => 1 },
592             0x48 => { Name => 'UnknownRawHighlightPoint', Unknown => 1 },
593             0x49 => { Name => 'UnknownRawShadowPoint', Unknown => 1 },
594             0x4a => { Name => 'UnknownOutputHighlightPoint',Unknown => 1 },
595             0x4b => { Name => 'UnknownOutputShadowPoint', Unknown => 1 },
596             0x4c => 'CustomColorTone',
597             0x4d => 'CustomSaturation',
598             0x4e => 'CustomContrast',
599             0x4f => { Name => 'CustomLinear', %noYes },
600             0x50 => 'CustomSharpness',
601             0x51 => 'CustomRawHighlightPoint',
602             0x52 => 'CustomRawShadowPoint',
603             0x53 => 'CustomOutputHighlightPoint',
604             0x54 => 'CustomOutputShadowPoint',
605             0x58 => {
606             Name => 'CustomPictureStyleData',
607             Format => 'var_int16u',
608             Binary => 1,
609             Notes => 'variable-length data structure',
610             Writable => 0,
611             RawConv => 'length($val) == 2 ? undef : $val', # ignore if no data
612             },
613             # (VRD 2.0.0 edit data ends here: 178 bytes, index 0x59)
614             0x5e => [{
615             Name => 'ChrominanceNoiseReduction',
616             Condition => '$$self{VRDVersion} < 330',
617             Notes => 'VRDVersion prior to 3.3.0',
618             PrintConv => {
619             0 => 'Off',
620             58 => 'Low',
621             100 => 'High',
622             },
623             },{ #1
624             Name => 'ChrominanceNoiseReduction',
625             Notes => 'VRDVersion 3.3.0 or later',
626             PrintHex => 1,
627             PrintConvColumns => 4,
628             PrintConv => {
629             0x00 => 0,
630             0x10 => 1,
631             0x21 => 2,
632             0x32 => 3,
633             0x42 => 4,
634             0x53 => 5,
635             0x64 => 6,
636             0x74 => 7,
637             0x85 => 8,
638             0x96 => 9,
639             0xa6 => 10,
640             0xa7 => 11,
641             0xa8 => 12,
642             0xa9 => 13,
643             0xaa => 14,
644             0xab => 15,
645             0xac => 16,
646             0xad => 17,
647             0xae => 18,
648             0xaf => 19,
649             0xb0 => 20,
650             },
651             }],
652             0x5f => [{
653             Name => 'LuminanceNoiseReduction',
654             Condition => '$$self{VRDVersion} < 330',
655             Notes => 'VRDVersion prior to 3.3.0',
656             PrintConv => {
657             0 => 'Off',
658             65 => 'Low',
659             100 => 'High',
660             },
661             },{ #1
662             Name => 'LuminanceNoiseReduction',
663             Notes => 'VRDVersion 3.3.0 or later',
664             PrintHex => 1,
665             PrintConvColumns => 4,
666             PrintConv => {
667             0x00 => 0,
668             0x41 => 1,
669             0x64 => 2,
670             0x6e => 3,
671             0x78 => 4,
672             0x82 => 5,
673             0x8c => 6,
674             0x96 => 7,
675             0xa0 => 8,
676             0xaa => 9,
677             0xb4 => 10,
678             0xb5 => 11,
679             0xb6 => 12,
680             0xb7 => 13,
681             0xb8 => 14,
682             0xb9 => 15,
683             0xba => 16,
684             0xbb => 17,
685             0xbc => 18,
686             0xbd => 19,
687             0xbe => 20,
688             },
689             }],
690             0x60 => [{
691             Name => 'ChrominanceNR_TIFF_JPEG',
692             Condition => '$$self{VRDVersion} < 330',
693             Notes => 'VRDVersion prior to 3.3.0',
694             PrintConv => {
695             0 => 'Off',
696             33 => 'Low',
697             100 => 'High',
698             },
699             },{ #1
700             Name => 'ChrominanceNR_TIFF_JPEG',
701             Notes => 'VRDVersion 3.3.0 or later',
702             PrintHex => 1,
703             PrintConvColumns => 4,
704             PrintConv => {
705             0x00 => 0,
706             0x10 => 1,
707             0x21 => 2,
708             0x32 => 3,
709             0x42 => 4,
710             0x53 => 5,
711             0x64 => 6,
712             0x74 => 7,
713             0x85 => 8,
714             0x96 => 9,
715             0xa6 => 10,
716             0xa7 => 11,
717             0xa8 => 12,
718             0xa9 => 13,
719             0xaa => 14,
720             0xab => 15,
721             0xac => 16,
722             0xad => 17,
723             0xae => 18,
724             0xaf => 19,
725             0xb0 => 20,
726             },
727             }],
728             # 0x61: 1
729             # (VRD 3.0.0 edit data ends here: 196 bytes, index 0x62)
730             0x62 => { Name => 'ChromaticAberrationOn', %noYes },
731             0x63 => { Name => 'DistortionCorrectionOn', %noYes },
732             0x64 => { Name => 'PeripheralIlluminationOn', %noYes },
733             0x65 => { Name => 'ColorBlur', %noYes },
734             0x66 => {
735             Name => 'ChromaticAberration',
736             ValueConv => '$val / 0x400',
737             ValueConvInv => 'int($val * 0x400 + 0.5)',
738             PrintConv => 'sprintf("%.0f%%", $val * 100)',
739             PrintConvInv => 'ToFloat($val) / 100',
740             },
741             0x67 => {
742             Name => 'DistortionCorrection',
743             ValueConv => '$val / 0x400',
744             ValueConvInv => 'int($val * 0x400 + 0.5)',
745             PrintConv => 'sprintf("%.0f%%", $val * 100)',
746             PrintConvInv => 'ToFloat($val) / 100',
747             },
748             0x68 => {
749             Name => 'PeripheralIllumination',
750             ValueConv => '$val / 0x400',
751             ValueConvInv => 'int($val * 0x400 + 0.5)',
752             PrintConv => 'sprintf("%.0f%%", $val * 100)',
753             PrintConvInv => 'ToFloat($val) / 100',
754             },
755             0x69 => {
756             Name => 'AberrationCorrectionDistance',
757             Notes => '100% = infinity',
758             RawConv => '$val == 0x7fff ? undef : $val',
759             ValueConv => '1 - $val / 0x400',
760             ValueConvInv => 'int((1 - $val) * 0x400 + 0.5)',
761             PrintConv => 'sprintf("%.0f%%", $val * 100)',
762             PrintConvInv => 'ToFloat($val) / 100',
763             },
764             0x6a => 'ChromaticAberrationRed',
765             0x6b => 'ChromaticAberrationBlue',
766             0x6d => { #1
767             Name => 'LuminanceNR_TIFF_JPEG',
768             Notes => 'val = raw / 10',
769             ValueConv => '$val / 10',
770             ValueConvInv => 'int($val * 10 + 0.5)',
771             },
772             # (VRD 3.4.0 edit data ends here: 220 bytes, index 0x6e)
773             0x6e => { Name => 'AutoLightingOptimizerOn', %noYes },
774             0x6f => {
775             Name => 'AutoLightingOptimizer',
776             PrintConv => {
777             100 => 'Low',
778             200 => 'Standard',
779             300 => 'Strong',
780             0x7fff => 'n/a', #1
781             },
782             },
783             # 0x71: 200
784             # 0x73: 100
785             # (VRD 3.5.0 edit data ends here: 232 bytes, index 0x74)
786             0x75 => {
787             Name => 'StandardRawHighlight',
788             ValueConv => '$val / 10',
789             ValueConvInv => '$val * 10',
790             },
791             0x76 => {
792             Name => 'PortraitRawHighlight',
793             ValueConv => '$val / 10',
794             ValueConvInv => '$val * 10',
795             },
796             0x77 => {
797             Name => 'LandscapeRawHighlight',
798             ValueConv => '$val / 10',
799             ValueConvInv => '$val * 10',
800             },
801             0x78 => {
802             Name => 'NeutralRawHighlight',
803             ValueConv => '$val / 10',
804             ValueConvInv => '$val * 10',
805             },
806             0x79 => {
807             Name => 'FaithfulRawHighlight',
808             ValueConv => '$val / 10',
809             ValueConvInv => '$val * 10',
810             },
811             0x7a => {
812             Name => 'MonochromeRawHighlight',
813             ValueConv => '$val / 10',
814             ValueConvInv => '$val * 10',
815             },
816             0x7b => {
817             Name => 'UnknownRawHighlight',
818             Unknown => 1,
819             ValueConv => '$val / 10',
820             ValueConvInv => '$val * 10',
821             },
822             0x7c => {
823             Name => 'CustomRawHighlight',
824             ValueConv => '$val / 10',
825             ValueConvInv => '$val * 10',
826             },
827             0x7e => {
828             Name => 'StandardRawShadow',
829             ValueConv => '$val / 10',
830             ValueConvInv => '$val * 10',
831             },
832             0x7f => {
833             Name => 'PortraitRawShadow',
834             ValueConv => '$val / 10',
835             ValueConvInv => '$val * 10',
836             },
837             0x80 => {
838             Name => 'LandscapeRawShadow',
839             ValueConv => '$val / 10',
840             ValueConvInv => '$val * 10',
841             },
842             0x81 => {
843             Name => 'NeutralRawShadow',
844             ValueConv => '$val / 10',
845             ValueConvInv => '$val * 10',
846             },
847             0x82 => {
848             Name => 'FaithfulRawShadow',
849             ValueConv => '$val / 10',
850             ValueConvInv => '$val * 10',
851             },
852             0x83 => {
853             Name => 'MonochromeRawShadow',
854             ValueConv => '$val / 10',
855             ValueConvInv => '$val * 10',
856             },
857             0x84 => {
858             Name => 'UnknownRawShadow',
859             Unknown => 1,
860             ValueConv => '$val / 10',
861             ValueConvInv => '$val * 10',
862             },
863             0x85 => {
864             Name => 'CustomRawShadow',
865             ValueConv => '$val / 10',
866             ValueConvInv => '$val * 10',
867             },
868             0x8b => { #2
869             Name => 'AngleAdj',
870             Format => 'int32s',
871             ValueConv => '$val / 100',
872             ValueConvInv => '$val * 100',
873             },
874             0x8e => {
875             Name => 'CheckMark2',
876             Format => 'int16u',
877             PrintConvColumns => 2,
878             PrintConv => {
879             0 => 'Clear',
880             1 => 1,
881             2 => 2,
882             3 => 3,
883             4 => 4,
884             5 => 5,
885             },
886             },
887             # (VRD 3.8.0 edit data ends here: 286 bytes, index 0x8f)
888             0x90 => {
889             Name => 'UnsharpMask',
890             PrintConv => { 0 => 'Off', 1 => 'On' },
891             },
892             0x92 => 'StandardUnsharpMaskStrength',
893             0x94 => 'StandardUnsharpMaskFineness',
894             0x96 => 'StandardUnsharpMaskThreshold',
895             0x98 => 'PortraitUnsharpMaskStrength',
896             0x9a => 'PortraitUnsharpMaskFineness',
897             0x9c => 'PortraitUnsharpMaskThreshold',
898             0x9e => 'LandscapeUnsharpMaskStrength',
899             0xa0 => 'LandscapeUnsharpMaskFineness',
900             0xa2 => 'LandscapeUnsharpMaskThreshold',
901             0xa4 => 'NeutraUnsharpMaskStrength',
902             0xa6 => 'NeutralUnsharpMaskFineness',
903             0xa8 => 'NeutralUnsharpMaskThreshold',
904             0xaa => 'FaithfulUnsharpMaskStrength',
905             0xac => 'FaithfulUnsharpMaskFineness',
906             0xae => 'FaithfulUnsharpMaskThreshold',
907             0xb0 => 'MonochromeUnsharpMaskStrength',
908             0xb2 => 'MonochromeUnsharpMaskFineness',
909             0xb4 => 'MonochromeUnsharpMaskThreshold',
910             0xb6 => 'CustomUnsharpMaskStrength',
911             0xb8 => 'CustomUnsharpMaskFineness',
912             0xba => 'CustomUnsharpMaskThreshold',
913             0xbc => 'CustomDefaultUnsharpStrength',
914             0xbe => 'CustomDefaultUnsharpFineness',
915             0xc0 => 'CustomDefaultUnsharpThreshold',
916             # (VRD 3.9.1 edit data ends here: 392 bytes, index 0xc4)
917             # 0xc9: 3 - some RawSharpness
918             # 0xca: 4095 - some RawHighlightPoint
919             # 0xcb: 0 - some RawShadowPoint
920             # 0xcc: 4095 - some OutputHighlightPoint
921             # 0xcd: 0 - some OutputShadowPoint
922             # 0xd1: 3 - some UnsharpMaskStrength
923             # 0xd3: 7 - some UnsharpMaskFineness
924             # 0xd5: 3,4 - some UnsharpMaskThreshold
925             0xd6 => { Name => 'CropCircleActive', %noYes },
926             0xd7 => 'CropCircleX',
927             0xd8 => 'CropCircleY',
928             0xd9 => 'CropCircleRadius',
929             # 0xda: 0, 1
930             # 0xdb: 100
931             0xdc => {
932             Name => 'DLOOn',
933             DataMember => 'DLOOn',
934             RawConv => '$$self{DLOOn} = $val',
935             %noYes,
936             },
937             0xdd => 'DLOSetting',
938             # (VRD 3.11.0 edit data ends here: 444 bytes, index 0xde)
939             0xde => {
940             Name => 'DLOShootingDistance',
941             Notes => '100% = infinity',
942             RawConv => '$val == 0x7fff ? undef : $val',
943             ValueConv => '1 - $val / 0x400',
944             ValueConvInv => 'int((1 - $val) * 0x400 + 0.5)',
945             PrintConv => 'sprintf("%.0f%%", $val * 100)',
946             PrintConvInv => 'ToFloat($val) / 100',
947             },
948             0xdf => {
949             Name => 'DLODataLength',
950             DataMember => 'DLODataLength',
951             Format => 'int32u',
952             Writable => 0,
953             RawConv => '$$self{DLODataLength} = $val',
954             },
955             0xe0 => { # (yes, this overlaps DLODataLength)
956             Name => 'DLOInfo',
957             # - have seen DLODataLengths of 65536,64869 when DLO is Off, so must test DLOOn flag
958             Condition => '$$self{DLOOn}',
959             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::DLOInfo' },
960             Hook => '$varSize += $$self{DLODataLength} + 0x16',
961             },
962             0xe1 => 'CameraRawColorTone',
963             # (VRD 3.11.2 edit data ends here: 452 bytes, index 0xe2, unless DLO is on)
964             0xe2 => 'CameraRawSaturation',
965             0xe3 => 'CameraRawContrast',
966             0xe4 => { Name => 'CameraRawLinear', %noYes },
967             0xe5 => 'CameraRawSharpness',
968             0xe6 => 'CameraRawHighlightPoint',
969             0xe7 => 'CameraRawShadowPoint',
970             0xe8 => 'CameraRawOutputHighlightPoint',
971             0xe9 => 'CameraRawOutputShadowPoint',
972             );
973              
974             # DLO tags (ref PH)
975             %Image::ExifTool::CanonVRD::DLOInfo = (
976             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
977             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
978             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
979             WRITABLE => 1,
980             FIRST_ENTRY => 1,
981             FORMAT => 'int16s',
982             GROUPS => { 2 => 'Image' },
983             NOTES => 'Tags added when DLO (Digital Lens Optimizer) is on.',
984             # 0x01 - seen 3112,3140
985             0x04 => 'DLOSettingApplied',
986             0x05 => {
987             Name => 'DLOVersion', #(NC)
988             Format => 'string[10]',
989             },
990             0x0a => {
991             Name => 'DLOData',
992             LargeTag => 1, # large tag, so avoid storing unnecessarily
993             Notes => 'variable-length Digital Lens Optimizer data, stored in JPEG-like format',
994             Format => 'undef[$$self{DLODataLength}]',
995             Writable => 0,
996             Binary => 1,
997             },
998             );
999              
1000             # VRD version 4 tags (ref PH)
1001             %Image::ExifTool::CanonVRD::DR4 = (
1002             PROCESS_PROC => \&ProcessDR4,
1003             WRITE_PROC => \&ProcessDR4,
1004             WRITABLE => 1,
1005             PERMANENT => 1, # (can't add/delete these individually)
1006             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1007             VARS => { ID_FMT => 'hex', SORT_PROC => \&SortDR4 },
1008             NOTES => q{
1009             Tags written by Canon DPP version 4 in CanonVRD trailers and DR4 files. Each
1010             tag has three associated flag words which are stored with the directory
1011             entry, some of which are extracted as a separate tag, indicated in the table
1012             below by a decimal appended to the tag ID (.0, .1 or .2).
1013             },
1014             header => {
1015             Name => 'DR4Header',
1016             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::DR4Header' },
1017             },
1018             0x10002 => 'Rotation', # left/right rotation 90,180,270
1019             0x10003 => 'AngleAdj', # crop angle
1020             # 0x10018 - fmt=8: 0
1021             # 0x10020 - fmt=2: ''
1022             0x10021 => 'CustomPictureStyle', # (string)
1023             0x10100 => { #forum15965
1024             Name => 'Rating',
1025             PrintConv => {
1026             0 => 'Unrated',
1027             1 => 1,
1028             2 => 2,
1029             3 => 3,
1030             4 => 4,
1031             5 => 5,
1032             4294967295 => 'Rejected',
1033             },
1034             },
1035             0x10101 => {
1036             Name => 'CheckMark',
1037             PrintConv => {
1038             0 => 'Clear',
1039             1 => 1,
1040             2 => 2,
1041             3 => 3,
1042             4 => 4,
1043             5 => 5,
1044             },
1045             },
1046             0x10200 => {
1047             Name => 'WorkColorSpace',
1048             PrintConv => {
1049             1 => 'sRGB',
1050             2 => 'Adobe RGB',
1051             3 => 'Wide Gamut RGB',
1052             4 => 'Apple RGB',
1053             5 => 'ColorMatch RGB',
1054             },
1055             },
1056             # 0x10201 - fmt=9: 0
1057             # 0x10f20 - fmt=9: 350
1058             0x20001 => 'RawBrightnessAdj',
1059             0x20101 => {
1060             Name => 'WhiteBalanceAdj',
1061             PrintConvColumns => 2,
1062             PrintConv => {
1063             -1 => 'Manual (Click)',
1064             0 => 'Auto',
1065             1 => 'Daylight',
1066             2 => 'Cloudy',
1067             3 => 'Tungsten',
1068             4 => 'Fluorescent',
1069             5 => 'Flash',
1070             8 => 'Shade',
1071             9 => 'Kelvin',
1072             255 => 'Shot Settings',
1073             },
1074             },
1075             0x20102 => 'WBAdjColorTemp',
1076             0x20105 => 'WBAdjMagentaGreen',
1077             0x20106 => 'WBAdjBlueAmber',
1078             0x20125 => {
1079             Name => 'WBAdjRGGBLevels',
1080             PrintConv => '$val =~ s/^\d+ //; $val', # remove first integer (14: what is this for?)
1081             PrintConvInv => '"14 $val"',
1082             },
1083             0x20200 => { Name => 'GammaLinear', %noYes },
1084             0x20301 => {
1085             Name => 'PictureStyle',
1086             PrintHex => 1,
1087             PrintConv => {
1088             0x81 => 'Standard',
1089             0x82 => 'Portrait',
1090             0x83 => 'Landscape',
1091             0x84 => 'Neutral',
1092             0x85 => 'Faithful',
1093             0x86 => 'Monochrome',
1094             0x87 => 'Auto',
1095             0x88 => 'Fine Detail',
1096             0xf0 => 'Shot Settings',
1097             0xff => 'Custom',
1098             },
1099             },
1100             # 0x20302 - Gamma curve data
1101             0x20303 => 'ContrastAdj',
1102             0x20304 => 'ColorToneAdj',
1103             0x20305 => 'ColorSaturationAdj',
1104             0x20306 => {
1105             Name => 'MonochromeToningEffect',
1106             PrintConv => {
1107             0 => 'None',
1108             1 => 'Sepia',
1109             2 => 'Blue',
1110             3 => 'Purple',
1111             4 => 'Green',
1112             },
1113             },
1114             0x20307 => {
1115             Name => 'MonochromeFilterEffect',
1116             PrintConv => {
1117             0 => 'None',
1118             1 => 'Yellow',
1119             2 => 'Orange',
1120             3 => 'Red',
1121             4 => 'Green',
1122             },
1123             },
1124             0x20308 => 'UnsharpMaskStrength',
1125             0x20309 => 'UnsharpMaskFineness',
1126             0x2030a => 'UnsharpMaskThreshold',
1127             0x2030b => 'ShadowAdj',
1128             0x2030c => 'HighlightAdj',
1129             0x20310 => {
1130             Name => 'SharpnessAdj',
1131             PrintConv => {
1132             0 => 'Sharpness',
1133             1 => 'Unsharp Mask',
1134             },
1135             },
1136             '0x20310.0' => { Name => 'SharpnessAdjOn', %noYes },
1137             0x20311 => 'SharpnessStrength',
1138             0x20400 => {
1139             Name => 'ToneCurve',
1140             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::ToneCurve' },
1141             },
1142             '0x20400.1' => { Name => 'ToneCurveOriginal', %noYes },
1143             # 0x20401 - fmt=33 (312 bytes)
1144             0x20410 => 'ToneCurveBrightness',
1145             0x20411 => 'ToneCurveContrast',
1146             0x20500 => {
1147             Name => 'AutoLightingOptimizer',
1148             PrintConv => {
1149             0 => 'Low',
1150             1 => 'Standard',
1151             2 => 'Strong',
1152             },
1153             },
1154             '0x20500.0' => {
1155             Name => 'AutoLightingOptimizerOn',
1156             Notes => 'ignored if gamma is linear',
1157             %noYes,
1158             },
1159             # 0x20501 - fmt=13: 0
1160             # 0x20502 - fmt=13: 0
1161             0x20600 => 'LuminanceNoiseReduction',
1162             0x20601 => 'ChrominanceNoiseReduction',
1163             # 0x20650 - fmt=9: 0 (JPG images)
1164             0x20670 => 'ColorMoireReduction',
1165             '0x20670.0' => { Name => 'ColorMoireReductionOn', %noYes },
1166             0x20701 => {
1167             Name => 'ShootingDistance',
1168             Notes => '100% = infinity',
1169             ValueConv => '$val / 10',
1170             ValueConvInv => '$val * 10',
1171             PrintConv => 'sprintf("%.0f%%", $val * 100)',
1172             PrintConvInv => 'ToFloat($val) / 100',
1173             },
1174             0x20702 => {
1175             Name => 'PeripheralIllumination',
1176             PrintConv => 'sprintf "%g", $val',
1177             PrintConvInv => '$val',
1178             },
1179             '0x20702.0' => { Name => 'PeripheralIlluminationOn', %noYes },
1180             0x20703 => {
1181             Name => 'ChromaticAberration',
1182             PrintConv => 'sprintf "%g", $val',
1183             PrintConvInv => '$val',
1184             },
1185             '0x20703.0' => { Name => 'ChromaticAberrationOn', %noYes },
1186             0x20704 => { Name => 'ColorBlurOn', %noYes },
1187             0x20705 => {
1188             Name => 'DistortionCorrection',
1189             PrintConv => 'sprintf "%g", $val',
1190             PrintConvInv => '$val',
1191             },
1192             '0x20705.0' => { Name => 'DistortionCorrectionOn', %noYes },
1193             0x20706 => 'DLOSetting',
1194             '0x20706.0' => { Name => 'DLOOn', %noYes },
1195             0x20707 => {
1196             Name => 'ChromaticAberrationRed',
1197             PrintConv => 'sprintf "%g", $val',
1198             PrintConvInv => '$val',
1199             },
1200             0x20708 => {
1201             Name => 'ChromaticAberrationBlue',
1202             PrintConv => 'sprintf "%g", $val',
1203             PrintConvInv => '$val',
1204             },
1205             0x20709 => {
1206             Name => 'DistortionEffect',
1207             PrintConv => {
1208             0 => 'Shot Settings',
1209             1 => 'Emphasize Linearity',
1210             2 => 'Emphasize Distance',
1211             3 => 'Emphasize Periphery',
1212             4 => 'Emphasize Center',
1213             },
1214             },
1215             0x2070b => { Name => 'DiffractionCorrectionOn', %noYes },
1216             # 0x20800 - fmt=1: 0
1217             # 0x20801 - fmt=1: 0
1218             0x20900 => 'ColorHue',
1219             0x20901 => 'SaturationAdj',
1220             0x20910 => 'RedHSL',
1221             0x20911 => 'OrangeHSL',
1222             0x20912 => 'YellowHSL',
1223             0x20913 => 'GreenHSL',
1224             0x20914 => 'AquaHSL',
1225             0x20915 => 'BlueHSL',
1226             0x20916 => 'PurpleHSL',
1227             0x20917 => 'MagentaHSL',
1228             0x20a00 => {
1229             Name => 'GammaInfo',
1230             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::GammaInfo' },
1231             },
1232             # 0x20a01 - Auto picture style settings
1233             # 0x20a02 - Standard picture style settings
1234             # 0x20a03 - Portrait picture style settings
1235             # 0x20a04 - Landscape picture style settings
1236             # 0x20a05 - Neutral picture style settings
1237             # 0x20a06 - Faithful picture style settings
1238             # 0x20a07 - Monochrome picture style settings
1239             # 0x20a08 - (unknown picture style settings)
1240             # 0x20a09 - Custom picture style settings
1241             # 0x20a20 - Fine Detail picture style settings
1242             0x20b10 => 'DPRAWMicroadjustBackFront', #forum15660
1243             0x20b12 => 'DPRAWMicroadjustStrength', #forum15660
1244             0x20b20 => 'DPRAWBokehShift', #forum15660
1245             0x20b21 => 'DPRAWBokehShiftArea', #PH
1246             0x20b30 => 'DPRAWGhostingReductionArea', #forum15660
1247             0x30101 => {
1248             Name => 'CropAspectRatio',
1249             PrintConv => {
1250             0 => 'Free',
1251             1 => 'Custom',
1252             2 => '1:1',
1253             3 => '3:2',
1254             4 => '2:3',
1255             5 => '4:3',
1256             6 => '3:4',
1257             7 => '5:4',
1258             8 => '4:5',
1259             9 => '16:9',
1260             10 => '9:16',
1261             },
1262             },
1263             0x30102 => 'CropAspectRatioCustom',
1264             # 0x30103 - fmt=33: "0 0 8"
1265             0xf0100 => {
1266             Name => 'CropInfo',
1267             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::CropInfo' },
1268             },
1269             0xf0500 => {
1270             Name => 'CustomPictureStyleData',
1271             Binary => 1,
1272             },
1273             0xf0510 => {
1274             Name => 'StampInfo',
1275             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::StampInfo' },
1276             },
1277             0xf0511 => {
1278             Name => 'DustInfo',
1279             SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::DustInfo' },
1280             },
1281             0xf0512 => 'LensFocalLength',
1282             # 0xf0521 - DLO data
1283             # 0xf0520 - DLO data
1284             # 0xf0530 - created when dust delete data applied (4 bytes, all zero)
1285             # 0xf0561 - 1932 bytes, related to Partial Adjustment Tool Palette (ref forum15660)
1286             # 0xf0562 - 1596 bytes, related to Partial Adjustment Tool Palette (ref forum15660)
1287             # 0xf0566 - 1520 bytes, related to Partial Adjustment Tool Palette (ref forum15660)
1288             # 0xf0600 - fmt=253 (2308 bytes, JPG images)
1289             # 0xf0601 - fmt=253 (2308 bytes, JPG images)
1290             # 0x1ff52c - values: 129,130,132 (related to custom picture style somehow)
1291             # to do:
1292             # - find 8-15mm CR2 sample and decode linear distortion effect fine-tune
1293             );
1294              
1295             # Version 4 header information (ref PH)
1296             %Image::ExifTool::CanonVRD::DR4Header = (
1297             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1298             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
1299             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
1300             WRITABLE => 1,
1301             FIRST_ENTRY => 0,
1302             FORMAT => 'int32u',
1303             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1304             # 0 - value: 'IIII' (presumably byte order)
1305             # 1 - value: 0x00040004 (currently use this for magic number)
1306             # 2 - value: 6
1307             3 => {
1308             Name => 'DR4CameraModel',
1309             Format => 'int32u',
1310             PrintHex => 1,
1311             SeparateTable => 'Canon CanonModelID',
1312             PrintConv => \%Image::ExifTool::Canon::canonModelID,
1313             },
1314             # 4 - value: 3
1315             # 5 - value: 4
1316             # 6 - value: 5
1317             # 7 - DR4 directory entry count
1318             );
1319              
1320             # Version 4 RGB tone curve information (ref PH)
1321             %Image::ExifTool::CanonVRD::ToneCurve = (
1322             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1323             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
1324             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
1325             WRITABLE => 1,
1326             FIRST_ENTRY => 0,
1327             FORMAT => 'int32u',
1328             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1329             0x00 => {
1330             Name => 'ToneCurveColorSpace',
1331             PrintConv => {
1332             0 => 'RGB',
1333             1 => 'Luminance',
1334             },
1335             },
1336             0x01 => {
1337             Name => 'ToneCurveShape',
1338             PrintConv => {
1339             0 => 'Curve',
1340             1 => 'Straight',
1341             },
1342             },
1343             0x03 => { Name => 'ToneCurveInputRange', Format => 'int32u[2]', Notes => '255 max' },
1344             0x05 => { Name => 'ToneCurveOutputRange', Format => 'int32u[2]', Notes => '255 max' },
1345             0x07 => {
1346             Name => 'RGBCurvePoints',
1347             Format => 'int32u[21]',
1348             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
1349             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
1350             },
1351             0x0a => 'ToneCurveX',
1352             0x0b => 'ToneCurveY',
1353             0x2d => {
1354             Name => 'RedCurvePoints',
1355             Format => 'int32u[21]',
1356             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
1357             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
1358             },
1359             0x53 => {
1360             Name => 'GreenCurvePoints',
1361             Format => 'int32u[21]',
1362             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
1363             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
1364             },
1365             0x79 => {
1366             Name => 'BlueCurvePoints',
1367             Format => 'int32u[21]',
1368             PrintConv => 'Image::ExifTool::CanonVRD::ToneCurvePrint($val)',
1369             PrintConvInv => 'Image::ExifTool::CanonVRD::ToneCurvePrintInv($val)',
1370             },
1371             );
1372              
1373             # Version 4 gamma curve information (ref PH)
1374             %Image::ExifTool::CanonVRD::GammaInfo = (
1375             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1376             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
1377             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
1378             WRITABLE => 1,
1379             FIRST_ENTRY => 0,
1380             FORMAT => 'double',
1381             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1382             0x02 => 'GammaContrast',
1383             0x03 => 'GammaColorTone',
1384             0x04 => 'GammaSaturation',
1385             0x05 => 'GammaUnsharpMaskStrength',
1386             0x06 => 'GammaUnsharpMaskFineness',
1387             0x07 => 'GammaUnsharpMaskThreshold',
1388             0x08 => 'GammaSharpnessStrength',
1389             0x09 => 'GammaShadow',
1390             0x0a => 'GammaHighlight',
1391             # 0x0b-0x10 are the same as first 6 doubles of tag DR4_0x20302
1392             # 0x0b - value: 14
1393             0x0c => {
1394             Name => 'GammaBlackPoint',
1395             ValueConv => q{
1396             return 0 if $val <= 0;
1397             $val = log($val / 4.6875) / log(2) + 1;
1398             return abs($val) > 1e-10 ? $val : 0;
1399             },
1400             ValueConvInv => '$val ? exp(($val - 1) * log(2)) * 4.6876 : 0',
1401             PrintConv => 'sprintf("%+.3f", $val)',
1402             PrintConvInv => '$val',
1403             },
1404             0x0d => {
1405             Name => 'GammaWhitePoint',
1406             ValueConv => q{
1407             return $val if $val <= 0;
1408             $val = log($val / 4.6875) / log(2) - 11.77109325169954;
1409             return abs($val) > 1e-10 ? $val : 0;
1410             },
1411             ValueConvInv => '$val ? exp(($val + 11.77109325169954) * log(2)) * 4.6875 : 0',
1412             PrintConv => 'sprintf("%+.3f", $val)',
1413             PrintConvInv => '$val',
1414             },
1415             0x0e => {
1416             Name => 'GammaMidPoint',
1417             ValueConv => q{
1418             return $val if $val <= 0;
1419             $val = log($val / 4.6875) / log(2) - 8;
1420             return abs($val) > 1e-10 ? $val : 0;
1421             },
1422             ValueConvInv => '$val ? exp(($val + 8) * log(2)) * 4.6876 : 0',
1423             PrintConv => 'sprintf("%+.3f", $val)',
1424             PrintConvInv => '$val',
1425             },
1426             0x0f => { Name => 'GammaCurveOutputRange', Format => 'double[2]', Notes => '16383 max' },
1427             );
1428              
1429             # Version 4 crop information (ref PH)
1430             %Image::ExifTool::CanonVRD::CropInfo = (
1431             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1432             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
1433             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
1434             WRITABLE => 1,
1435             FIRST_ENTRY => 0,
1436             FORMAT => 'int32s',
1437             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1438             0 => { Name => 'CropActive', %noYes },
1439             1 => 'CropRotatedOriginalWidth',
1440             2 => 'CropRotatedOriginalHeight',
1441             3 => 'CropX',
1442             4 => 'CropY',
1443             5 => 'CropWidth',
1444             6 => 'CropHeight',
1445             7 => 'CropRotation',
1446             8 => {
1447             Name => 'CropAngle',
1448             Format => 'double',
1449             PrintConv => 'sprintf("%.7g",$val)',
1450             PrintConvInv => '$val',
1451             },
1452             10 => 'CropOriginalWidth',
1453             11 => 'CropOriginalHeight',
1454             # 12 double - value: 100
1455             );
1456              
1457             # DR4 Stamp Tool tags (ref PH)
1458             %Image::ExifTool::CanonVRD::StampInfo = (
1459             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1460             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1461             FORMAT => 'int32u',
1462             FIRST_ENTRY => 0,
1463             0x02 => 'StampToolCount',
1464             );
1465              
1466             # DR4 dust delete information (ref PH)
1467             %Image::ExifTool::CanonVRD::DustInfo = (
1468             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1469             GROUPS => { 1 => 'CanonDR4', 2 => 'Image' },
1470             FORMAT => 'int32u',
1471             FIRST_ENTRY => 0,
1472             0x02 => { Name => 'DustDeleteApplied', %noYes },
1473             );
1474              
1475             #------------------------------------------------------------------------------
1476             # sort DR4 tag ID's for the documentation
1477             sub SortDR4($$)
1478             {
1479 0     0 0 0 my ($a, $b) = @_;
1480 0         0 my ($aHex, $aDec, $bHex, $bDec);
1481 0 0       0 ($aHex, $aDec) = ($1, $2) if $a =~ /^(0x[0-9a-f]+)?\.?(\d*?)$/;
1482 0 0       0 ($bHex, $bDec) = ($1, $2) if $b =~ /^(0x[0-9a-f]+)?\.?(\d*?)$/;
1483 0 0       0 if ($aHex) {
    0          
1484 0 0       0 return 1 unless defined $bDec; # $b is 'header';
1485 0 0 0     0 return hex($aHex) <=> hex($bHex) || $aDec <=> $bDec if $bHex;
1486 0   0     0 return hex($aHex) <=> $bDec || 1;
1487             } elsif ($bHex) {
1488 0 0       0 return -1 unless defined $aDec;
1489 0   0     0 return $aDec <=> hex($bHex) || -1;
1490             } else {
1491 0 0       0 return 1 unless defined $bDec;
1492 0 0       0 return -1 unless defined $aDec;
1493 0         0 return $aDec <=> $bDec;
1494             }
1495             }
1496              
1497             #------------------------------------------------------------------------------
1498             # Tone curve print conversion
1499             sub ToneCurvePrint($)
1500             {
1501 73     73 0 220 my $val = shift;
1502 73         688 my @vals = split ' ', $val;
1503 73 50       279 return $val unless @vals == 21;
1504 73         169 my $n = shift @vals;
1505 73 50 33     489 return $val unless $n >= 2 and $n <= 10;
1506 73         157 $val = '';
1507 73         236 while ($n--) {
1508 217 100       458 $val and $val .= ' ';
1509 217         642 $val .= '(' . shift(@vals) . ',' . shift(@vals) . ')';
1510             }
1511 73         884 return $val;
1512             }
1513              
1514             #------------------------------------------------------------------------------
1515             # Inverse print conversion for tone curve
1516             sub ToneCurvePrintInv($)
1517             {
1518 23     23 0 74 my $val = shift;
1519 23         189 my @vals = ($val =~ /\((\d+),(\d+)\)/g);
1520 23 50 66     246 return undef unless @vals >= 4 and @vals <= 20 and not @vals & 0x01;
      66        
1521 18         76 unshift @vals, scalar(@vals) / 2;
1522 18         55 while (@vals < 21) { push @vals, 0 }
  288         648  
1523 18         508 return join(' ',@vals);
1524             }
1525              
1526             #------------------------------------------------------------------------------
1527             # Read/Write VRD edit data
1528             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1529             # Returns: Reading: 1 on success; Writing: modified edit data, or undef if nothing changed
1530             sub ProcessEditData($$$)
1531             {
1532 38     38 0 109 my ($et, $dirInfo, $tagTablePtr) = @_;
1533 38 50       131 $et or return 1; # allow dummy access
1534 38         140 my $dataPt = $$dirInfo{DataPt};
1535 38         139 my $pos = $$dirInfo{DirStart};
1536 38         87 my $dataPos = $$dirInfo{DataPos};
1537 38         107 my $outfile = $$dirInfo{OutFile};
1538 38         96 my $dirLen = $$dirInfo{DirLen};
1539 38         175 my $verbose = $et->Options('Verbose');
1540 38         127 my $out = $et->Options('TextOut');
1541 38         106 my $oldChanged = $$et{CHANGED};
1542              
1543 38 100       255 $et->VerboseDir('VRD Edit Data', 0, $dirLen) unless $outfile;
1544              
1545 38 100       113 if ($outfile) {
1546             # make a copy for editing in place
1547 3         18 my $buff = substr($$dataPt, $pos, $dirLen);
1548 3         14 $dataPt = $$dirInfo{DataPt} = \$buff;
1549 3         6 $dataPos += $pos;
1550 3         10 $pos = $$dirInfo{DirStart} = 0;
1551             }
1552 38         125 my $dirEnd = $pos + $dirLen;
1553              
1554             # loop through all records in the edit data
1555 38         88 my ($recNum, $recLen, $err);
1556 38         128 for ($recNum=0;; ++$recNum, $pos+=$recLen) {
1557 153 100       404 if ($pos + 4 > $dirEnd) {
1558 19 50       88 last if $pos == $dirEnd; # all done if we arrived at end
1559 0         0 $recLen = 0; # just reset record size (will exit loop on test below)
1560             } else {
1561 134         410 $recLen = Get32u($dataPt, $pos);
1562             # (DR4 has a null terminator)
1563 134 100 100     568 last if $recLen == 0 and $pos + 4 == $dirEnd;
1564             }
1565 115         196 $pos += 4; # move to start of record
1566 115 50       281 if ($pos + $recLen > $dirEnd) {
1567 0         0 $et->Warn('Possibly corrupt CanonVRD Edit record');
1568 0         0 $err = 1;
1569 0         0 last;
1570             }
1571 115         242 my $saveRecLen = $recLen;
1572 115 50 33     343 if ($verbose > 1 and not $outfile) {
1573 0         0 printf $out "$$et{INDENT}CanonVRD Edit record ($recLen bytes at offset 0x%x)\n",
1574             $pos + $dataPos;
1575 0 0       0 $et->VerboseDump($dataPt, Len => $recLen, Start => $pos, Addr => $pos + $dataPos) if $recNum;
1576             }
1577              
1578             # our edit information is the 0th record, so don't process the others
1579 115 100       319 next if $recNum;
1580              
1581             # process VRD edit information
1582 38         80 my $subTablePtr = $tagTablePtr;
1583 38         65 my $index;
1584 38         292 my %subdirInfo = (
1585             DataPt => $dataPt,
1586             DataPos => $dataPos,
1587             DirStart => $pos,
1588             DirLen => $recLen,
1589             OutFile => $outfile,
1590             );
1591 38         107 my $subStart = 0;
1592             # loop through various sections of the VRD edit data
1593 38         93 for ($index=0; ; ++$index) {
1594 96 100       468 my $tagInfo = $$subTablePtr{$index} or last;
1595 77         137 my $subLen;
1596 77         174 my $maxLen = $recLen - $subStart;
1597 77 100       332 if ($$tagInfo{Size}) {
    100          
1598 29         71 $subLen = $$tagInfo{Size};
1599             } elsif (defined $$tagInfo{Size}) {
1600             # get size from int32u at $subStart
1601 29 100       213 last unless $subStart + 4 <= $recLen;
1602 10         51 $subLen = Get32u($dataPt, $subStart + $pos);
1603 10         30 $subStart += 4; # skip the length word
1604             } else {
1605 19         41 $subLen = $maxLen;
1606             }
1607 58 50       168 $subLen > $maxLen and $subLen = $maxLen;
1608 58 100       151 if ($subLen) {
1609 48         225 my $subTable = GetTagTable($$tagInfo{SubDirectory}{TagTable});
1610 48         143 my $subName = $$tagInfo{Name};
1611 48         134 $subdirInfo{DirStart} = $subStart + $pos;
1612 48         108 $subdirInfo{DirLen} = $subLen;
1613 48         159 $subdirInfo{DirName} = $subName;
1614 48 100       141 if ($outfile) {
1615             # rewrite this section of the VRD edit information
1616 5 50       22 $verbose and print $out " Rewriting Canon $subName\n";
1617 5         43 my $newVal = $et->WriteDirectory(\%subdirInfo, $subTable);
1618 5 50       37 if ($newVal) {
1619 5         12 my $sizeDiff = length($newVal) - $subLen;
1620 5         21 substr($$dataPt, $pos+$subStart, $subLen) = $newVal;
1621 5 50       17 if ($sizeDiff) {
1622 0         0 $subLen = length $newVal;
1623 0         0 $recLen += $sizeDiff;
1624 0         0 $dirEnd += $sizeDiff;
1625 0         0 $dirLen += $sizeDiff;
1626             }
1627             }
1628             } else {
1629 43         347 $et->VPrint(0, "$$et{INDENT}$subName (SubDirectory) -->\n");
1630 43         367 $et->VerboseDump($dataPt,
1631             Start => $pos + $subStart,
1632             Addr => $dataPos + $pos + $subStart,
1633             Len => $subLen,
1634             );
1635             # extract tags from this section of the VRD edit information
1636 43         209 $et->ProcessDirectory(\%subdirInfo, $subTable);
1637             }
1638             }
1639             # next section starts at the end of this one
1640 58         204 $subStart += $subLen;
1641             }
1642 38 50 66     444 if ($outfile and $saveRecLen ne $recLen) {
1643             # update record length if necessary
1644 0         0 Set32u($recLen, $dataPt, $pos - 4)
1645             }
1646             }
1647 38 100       122 if ($outfile) {
1648 3 100       22 return undef if $oldChanged == $$et{CHANGED};
1649 2         103 return substr($$dataPt, $$dirInfo{DirStart}, $dirLen);
1650             }
1651 35 50       201 return $err ? 0 : 1;
1652             }
1653              
1654             #------------------------------------------------------------------------------
1655             # Process VRD IHL data
1656             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1657             # Returns: 1 on success
1658             sub ProcessIHL($$$)
1659             {
1660 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1661 0         0 my $dataPt = $$dirInfo{DataPt};
1662 0         0 my $dataPos = $$dirInfo{DataPos};
1663 0         0 my $pos = $$dirInfo{DirStart};
1664 0         0 my $dirLen = $$dirInfo{DirLen};
1665 0         0 my $dirEnd = $pos + $dirLen;
1666              
1667 0         0 $et->VerboseDir('VRD IHL', 0, $dirLen);
1668              
1669 0         0 SetByteOrder('II'); # (make up your mind, Canon!)
1670 0         0 while ($pos + 48 <= $dirEnd) {
1671 0         0 my $hdr = substr($$dataPt, $pos, 48);
1672 0 0       0 unless ($hdr =~ /^IHL Created Optional Item Data\0\0/) {
1673 0         0 $et->Warn('Possibly corrupted VRD IHL data');
1674 0         0 last;
1675             }
1676 0         0 my $tag = Get32u($dataPt, $pos + 36);
1677 0         0 my $size = Get32u($dataPt, $pos + 40); # size of data in IHL record
1678 0         0 my $next = Get32u($dataPt, $pos + 44); # size of complete IHL record
1679 0 0 0     0 if ($size > $next or $pos + 48 + $next > $dirEnd) {
1680 0         0 $et->Warn(sprintf('Bad size for VRD IHL tag 0x%.4x', $tag));
1681 0         0 last;
1682             }
1683 0         0 $pos += 48;
1684 0         0 $et->HandleTag($tagTablePtr, $tag, substr($$dataPt, $pos, $size),
1685             DataPt => $dataPt,
1686             DataPos => $dataPos,
1687             Start => $pos,
1688             Size => $size
1689             );
1690 0         0 $pos += $next;
1691             }
1692 0         0 return 1;
1693             }
1694              
1695             #------------------------------------------------------------------------------
1696             # Process VRD IHL EXIF data
1697             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1698             # Returns: 1 on success
1699             sub ProcessIHLExif($$$)
1700             {
1701 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1702 0         0 $$et{DOC_NUM} = 1;
1703             # the IHL-edited maker notes may look messed up, but the offsets should be OK
1704 0         0 my $oldFix = $et->Options(FixBase => 0);
1705 0         0 my $rtnVal = $et->ProcessTIFF($dirInfo, $tagTablePtr);
1706 0         0 $et->Options(FixBase => $oldFix);
1707 0         0 delete $$et{DOC_NUM};
1708 0         0 return $rtnVal;
1709             }
1710              
1711             #------------------------------------------------------------------------------
1712             # Wrap DR4 data with the VRD header/footer and edit record
1713             # Inputs: 0) DR4 record
1714             # Returns: VRD[Edit[DR4]] data
1715             sub WrapDR4($)
1716             {
1717 7     7 0 25 my $val = shift;
1718 7         20 my $n = length $val;
1719 7         35 my $oldOrder = GetByteOrder();
1720 7         31 SetByteOrder('MM');
1721 7         36 $val = $blankHeader . "\xff\xff\0\xf7" . Set32u($n+8) . Set32u($n) .
1722             $val . "\0\0\0\0" . $blankFooter;
1723             # update the new VRD length in the header/footer
1724 7         38 Set32u($n + 16, \$val, 0x18); # (extra 16 bytes for the edit record wrapper)
1725 7         56 Set32u($n + 16, \$val, length($val) - 0x2c);
1726 7         30 SetByteOrder($oldOrder);
1727 7         57 return $val;
1728             }
1729              
1730             #------------------------------------------------------------------------------
1731             # Read/Write DPP version 4 edit data or DR4 file
1732             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1733             # Returns:
1734             # Reading from memory (not RAF and not IsWriting): 1 on success
1735             # Editing from memory (not RAF and IsWriting): modified edit data, or undef if nothing changed
1736             # Reading file (RAF and not OutFile): 1 if a valid DR4 file, 0 if not
1737             # Writing file (RAF and OutFile): 1 if valid DR4 file, 0 if not, -1 on write error
1738             # (serves me right for not having a consistent interface for the various modes of operation)
1739             sub ProcessDR4($$;$)
1740             {
1741 129     129 0 416 my ($et, $dirInfo, $tagTablePtr) = @_;
1742 129 100       763 $et or return 1; # allow dummy access
1743 17         64 my $dataPt = $$dirInfo{DataPt};
1744 17         48 my $raf = $$dirInfo{RAF};
1745 17         52 my $outfile = $$dirInfo{OutFile};
1746 17   66     148 my $isWriting = $outfile || $$dirInfo{IsWriting};
1747 17   100     90 my $dataPos = $$dirInfo{DataPos} || 0;
1748 17         118 my $verbose = $et->Options('Verbose');
1749 17         64 my $unknown = $et->Options('Unknown');
1750 17         56 my ($pos, $dirLen, $numEntries, $err, $newTags);
1751              
1752             # write CanonDR4 as a block if specified
1753 17 100       74 if ($isWriting) {
1754 4         11 my $nvHash;
1755 4         28 my $newVal = $et->GetNewValue('CanonDR4', \$nvHash);
1756 4 100 33     38 if ($newVal) {
    50 66        
1757 2         16 $et->VPrint(0, " Writing CanonDR4 as a block\n");
1758 2         11 $$et{DidCanonVRD} = 1; # set flag so we don't add this twice
1759 2         8 ++$$et{CHANGED};
1760 2 50       8 if ($outfile) {
1761 2 50       18 Write($$dirInfo{OutFile}, $newVal) or return -1;
1762 2         15 return 1;
1763             } else {
1764 0         0 return $newVal;
1765             }
1766             } elsif (not $dataPt and ($nvHash or $$et{DEL_GROUP}{CanonVRD})) {
1767 0         0 $et->Error("Can't delete all CanonDR4 information from a DR4 file");
1768 0         0 return 1;
1769             }
1770             }
1771 15 100       59 if ($dataPt) {
1772 9   50     53 $pos = $$dirInfo{DirStart} || 0;
1773 9   33     45 $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
1774             } else {
1775             # load DR4 file into memory
1776 6         13 my $buff;
1777 6 50 33     35 $raf->Read($buff, 8) == 8 and $buff =~ /^IIII[\x04|\x05]\0\x04\0/ or return 0;
1778 6         48 $et->SetFileType();
1779 6 50       36 $raf->Seek(0, 2) or return $err = 1;
1780 6         25 $dirLen = $raf->Tell();
1781 6 50       25 $raf->Seek(0, 0) or return $err = 1;
1782 6 50       25 $raf->Read($buff, $dirLen) == $dirLen or $err = 1;
1783 6 50       23 $err and $et->Warn('Error reading DR4 file'), return 1;
1784 6         33 $tagTablePtr = GetTagTable('Image::ExifTool::CanonVRD::DR4');
1785 6         14 $dataPt = \$buff;
1786 6         17 $pos = 0;
1787             }
1788 15         42 my $dirEnd = $pos + $dirLen;
1789              
1790 15 100 66     163 if (($$et{TAGS_FROM_FILE} and
      66        
1791             not $$et{EXCL_TAG_LOOKUP}{canondr4}) or $$et{REQ_TAG_LOOKUP}{canondr4})
1792             {
1793             # extract CanonDR4 block if copying tags, or if requested
1794 2         17 $et->FoundTag('CanonDR4', substr($$dataPt, $pos, $dirLen));
1795             }
1796              
1797             # version 4 header is 32 bytes (int32u[8])
1798 15 50       53 if ($dirLen < 32) {
1799 0         0 $err = 1;
1800             } else {
1801 15 50       107 SetByteOrder(substr($$dataPt, $pos, 2)) or $err = 1;
1802             # process the DR4 header
1803 15         140 my %hdrInfo = (
1804             DataPt => $dataPt,
1805             DirStart => $pos,
1806             DirLen => 32,
1807             DirName => 'DR4Header',
1808             );
1809 15         62 my $hdrTable = GetTagTable('Image::ExifTool::CanonVRD::DR4Header');
1810 15 100       136 if ($outfile) {
1811 2         20 my $hdr = $et->WriteDirectory(\%hdrInfo, $hdrTable);
1812 2 50 33     41 substr($$dataPt, $pos, 32) = $hdr if $hdr and length $hdr == 32;
1813             } else {
1814 13         82 $et->VerboseDir('DR4Header', undef, 32);
1815 13         77 $et->ProcessDirectory(\%hdrInfo, $hdrTable);
1816             }
1817             # number of entries in the DR4 directory
1818 15         87 $numEntries = Get32u($dataPt, $pos + 28);
1819 15 50       130 $err = 1 if $dirLen < 36 + 28 * $numEntries;
1820             }
1821 15 0       87 $err and $et->Warn('Invalid DR4 directory'), return $outfile ? undef : 0;
    50          
1822              
1823 15 100       51 if ($outfile) {
1824 2         14 $newTags = $et->GetNewTagInfoHash($tagTablePtr);
1825             } else {
1826 13         66 $et->VerboseDir('DR4', $numEntries, $dirLen);
1827             }
1828              
1829 15         50 my $index;
1830 15         70 for ($index=0; $index<$numEntries; ++$index) {
1831 1155         2288 my ($val, @flg, $i);
1832 1155         3206 my $entry = $pos + 36 + 28 * $index;
1833 1155 50       3272 last if $entry + 28 > $dirEnd;
1834 1155         4373 my $tag = Get32u($dataPt, $entry);
1835 1155         3524 my $fmt = Get32u($dataPt, $entry + 4);
1836 1155         3541 $flg[0] = Get32u($dataPt, $entry + 8);
1837 1155         3152 $flg[1] = Get32u($dataPt, $entry + 12);
1838 1155         3205 $flg[2] = Get32u($dataPt, $entry + 16);
1839 1155         2992 my $off = Get32u($dataPt, $entry + 20) + $pos;
1840 1155         3037 my $len = Get32u($dataPt, $entry + 24);
1841 1155 100       3551 next if $off + $len >= $dirEnd;
1842 1140         3479 my $format = $vrdFormat{$fmt};
1843 1140 100 100     6144 if (not $format) {
    100          
1844 15         108 $val = unpack 'H*', substr($$dataPt, $off, $len);
1845 15         46 $format = 'undef';
1846             } elsif ($format eq 'double' and $len == 8) {
1847             # avoid teeny weeny values
1848 450         1687 $val = ReadValue($dataPt, $off, $format, undef, $len);
1849 450 100       1551 $val = 0 if abs($val) < 1e-100;
1850             }
1851 1140 100       2889 if ($outfile) {
1852             # write (binary data) subdirectory if it exists
1853 152         611 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1854 152 100 100     945 if ($tagInfo and $$tagInfo{SubDirectory}) {
1855             my %subdirInfo = (
1856             DataPt => $dataPt,
1857             DirStart => $off,
1858             DirLen => $len,
1859             DirName => $$tagInfo{Name},
1860 8         72 );
1861 8         45 my $subTablePtr = GetTagTable($$tagInfo{SubDirectory}{TagTable});
1862 8         20 my $saveChanged = $$et{CHANGED};
1863 8         53 my $dat = $et->WriteDirectory(\%subdirInfo, $subTablePtr);
1864 8 100 66     57 if (defined $dat and length($dat) == $len) {
1865 6         41 substr($$dataPt, $off, $len) = $dat;
1866             } else {
1867 2         14 $$et{CHANGED} = $saveChanged; # didn't change anything after all
1868             }
1869             } else {
1870             # loop through main tag and flags (don't yet consider flag 2)
1871 144         476 for ($i=-1; $i<2; ++$i) {
1872 432 100       1497 $tagInfo = $$newTags{$i>=0 ? sprintf('0x%x.%d',$tag,$i) : $tag};
1873 432 100       1572 next unless $tagInfo;
1874 2 100       9 if ($i >= 0) {
1875 1         3 $off = $entry + 8 + 4 * $i;
1876 1         3 $format = 'int32u';
1877 1         4 $len = 4;
1878 1         4 undef $val;
1879             }
1880 2 50       15 $val = ReadValue($dataPt, $off, $format, undef, $len) unless defined $val;
1881 2         7 my $nvHash;
1882 2         14 my $newVal = $et->GetNewValue($tagInfo, \$nvHash);
1883 2 50 33     32 if ($et->IsOverwriting($nvHash, $val) and defined $newVal) {
1884 2         12 my $count = int($len / Image::ExifTool::FormatSize($format));
1885 2         12 my $rtnVal = WriteValue($newVal, $format, $count, $dataPt, $off);
1886 2 50       10 if (defined $rtnVal) {
1887 2         19 $et->VerboseValue("- CanonVRD:$$tagInfo{Name}", $val);
1888 2         10 $et->VerboseValue("+ CanonVRD:$$tagInfo{Name}", $newVal);
1889 2         11 ++$$et{CHANGED};
1890             }
1891             }
1892             }
1893             }
1894 152         745 next;
1895             }
1896 988         8316 $et->HandleTag($tagTablePtr, $tag, $val,
1897             DataPt => $dataPt,
1898             DataPos => $dataPos,
1899             Start => $off,
1900             Size => $len,
1901             Index => $index,
1902             Format => $format,
1903             # $flg[0] is on/off flag
1904             # $flg[1] "is default" flag?
1905             # $flg[2] changed to 0 when some unsharp mask settings were changed
1906             Extra => ", fmt=$fmt flags=" . join(',', @flg),
1907             );
1908 988         3447 foreach $i (0..2) {
1909 2964         8171 my $flagID = sprintf('0x%x.%d', $tag, $i);
1910 2964 100       12497 $et->HandleTag($tagTablePtr, $flagID, $flg[$i]) if $$tagTablePtr{$flagID};
1911             }
1912             }
1913 15 100       170 return 1 unless $isWriting;
1914 2 100       22 return substr($$dataPt, $pos, $dirLen) unless $raf;
1915 1 50       10 return 1 if Write($outfile, substr($$dataPt, $pos, $dirLen));
1916 0         0 return -1;
1917             }
1918              
1919             #------------------------------------------------------------------------------
1920             # Read/write Canon VRD file
1921             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1922             # Returns: 1 if this was a Canon VRD file, 0 otherwise, -1 on write error
1923             sub ProcessVRD($$)
1924             {
1925 14     14 0 39 my ($et, $dirInfo) = @_;
1926 14         35 my $raf = $$dirInfo{RAF};
1927 14         22 my $buff;
1928 14         53 my $num = $raf->Read($buff, 0x1c);
1929              
1930             # initialize write directories if necessary
1931 14 100       77 $et->InitWriteDirs(\%vrdMap, 'XMP') if $$dirInfo{OutFile};
1932              
1933 14 100 66     60 if (not $num and $$dirInfo{OutFile}) {
1934             # create new VRD file from scratch
1935 2         11 my $newVal = $et->GetNewValue('CanonVRD');
1936 2 100       8 if ($newVal) {
1937 1         40 $et->VPrint(0, " Writing CanonVRD as a block\n");
1938 1 50       9 Write($$dirInfo{OutFile}, $newVal) or return -1;
1939 1         4 $$et{DidCanonVRD} = 1;
1940 1         3 ++$$et{CHANGED};
1941             } else {
1942             # allow VRD to be created from individual tags
1943 1 50       8 if ($$et{ADD_DIRS}{CanonVRD}) {
1944 1         3 my $newVal = '';
1945 1 50       9 if (ProcessCanonVRD($et, { OutFile => \$newVal }) > 0) {
1946 1 50       8 Write($$dirInfo{OutFile}, $newVal) or return -1;
1947 1         4 ++$$et{CHANGED};
1948 1         6 return 1;
1949             }
1950             }
1951 0         0 $et->Error('No CanonVRD information to write');
1952             }
1953             } else {
1954 12 50       63 $num == 0x1c or return 0;
1955 12 50       51 $buff =~ /^CANON OPTIONAL DATA\0/ or return 0;
1956 12         63 $et->SetFileType();
1957 12         40 $$dirInfo{DirName} = 'CanonVRD'; # set directory name for verbose output
1958 12         46 my $result = ProcessCanonVRD($et, $dirInfo);
1959 12 50       45 return $result if $result < 0;
1960 12 50       39 $result or $et->Warn('Format error in VRD file');
1961             }
1962 13         63 return 1;
1963             }
1964              
1965             #------------------------------------------------------------------------------
1966             # Write VRD data record as a block
1967             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1968             # Returns: VRD data block (may be empty if no VRD data)
1969             # Notes: Increments ExifTool CHANGED flag if changed
1970             sub WriteCanonVRD($$;$)
1971             {
1972 7     7 0 27 my ($et, $dirInfo, $tagTablePtr) = @_;
1973 7 100       46 $et or return 1; # allow dummy access
1974 1         7 my $nvHash = $et->GetNewValueHash($Image::ExifTool::Extra{CanonVRD});
1975 1         23 my $val = $et->GetNewValue($nvHash);
1976 1 50       8 $val = '' unless defined $val;
1977 1 50       10 return undef unless $et->IsOverwriting($nvHash, $val);
1978 0         0 ++$$et{CHANGED};
1979 0         0 return $val;
1980             }
1981              
1982             #------------------------------------------------------------------------------
1983             # Write DR4-type CanonVRD edit record
1984             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1985             # Returns: VRD data block (may be empty if deleted, of undef on error)
1986             sub WriteCanonDR4($$;$)
1987             {
1988 2     2 0 11 my ($et, $dirInfo, $tagTablePtr) = @_;
1989 2 50       8 $et or return 1; # allow dummy access
1990 2         16 my $nvHash = $et->GetNewValueHash($Image::ExifTool::Extra{CanonDR4});
1991 2         18 my $val = $et->GetNewValue($nvHash);
1992 2 100       7 if (defined $val) {
1993 1 50       9 return undef unless $et->IsOverwriting($nvHash, $val);
1994 1         8 $et->VPrint(0, " Writing CanonDR4 as a block\n");
1995 1         4 ++$$et{CHANGED};
1996 1         7 return WrapDR4($val);
1997             }
1998 1         5 my $buff = '';
1999 1         5 $$dirInfo{OutFile} = \$buff;
2000 1 50       7 return $buff if ProcessCanonVRD($et, $dirInfo, $tagTablePtr) > 0;
2001 0         0 return undef;
2002             }
2003              
2004             #------------------------------------------------------------------------------
2005             # Read/write CanonVRD information (from VRD file or VRD trailer)
2006             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
2007             # Returns: 1 on success, 0 not valid VRD, or -1 error writing
2008             # - updates DataPos to point to start of CanonVRD information
2009             # - updates DirLen to existing trailer length
2010             sub ProcessCanonVRD($$;$)
2011             {
2012 59     59 0 190 my ($et, $dirInfo, $tagTablePtr) = @_;
2013 59         523 my $raf = $$dirInfo{RAF};
2014 59   100     355 my $offset = $$dirInfo{Offset} || 0;
2015 59         187 my $outfile = $$dirInfo{OutFile};
2016 59         149 my $dataPt = $$dirInfo{DataPt};
2017 59         309 my $verbose = $et->Options('Verbose');
2018 59         223 my $out = $et->Options('TextOut');
2019 59         166 my ($buff, $created, $err, $blockLen, $blockType, %didDir, $fromFile);
2020             #
2021             # The CanonVRD trailer has a 0x1c-byte header and a 0x40-byte footer,
2022             # each beginning with "CANON OPTIONAL DATA\0" and containing an int32u
2023             # giving the size of the contained data (at byte 0x18 and 0x14 respectively)
2024             #
2025 59 100       221 if ($raf) {
2026 53         114 $fromFile = 1;
2027             } else {
2028 6 100       33 unless ($dataPt) {
2029 2 50       12 return 1 unless $outfile;
2030             # create blank VRD data from scratch
2031 2         12 my $blank = $blankHeader . $blankFooter;
2032 2         7 $dataPt = \$blank;
2033 2 50       9 $verbose and print $out " Creating CanonVRD trailer\n";
2034 2         6 $created = 1;
2035             }
2036 6         41 $raf = File::RandomAccess->new($dataPt);
2037             }
2038             # read and validate the footer
2039 59 50       302 $raf->Seek(-0x40-$offset, 2) or return 0;
2040 59 50       228 $raf->Read($buff, 0x40) == 0x40 or return 0;
2041 59 50       483 $buff =~ /^CANON OPTIONAL DATA\0(.{4})/s or return 0;
2042 59         334 my $dirLen = unpack('N', $1) + 0x5c; # size including header+footer
2043              
2044             # read and validate the header
2045 59 50 33     415 unless ($dirLen < 0x80000000 and
      33        
      33        
      33        
2046             $raf->Seek(-$dirLen, 1) and
2047             $raf->Read($buff, 0x1c) == 0x1c and
2048             $buff =~ /^CANON OPTIONAL DATA\0/ and
2049             $raf->Seek(-0x1c, 1))
2050             {
2051 0         0 $et->Warn('Bad CanonVRD trailer');
2052 0         0 return 0;
2053             }
2054             # set variables returned in dirInfo hash
2055 59         233 $$dirInfo{DataPos} = $raf->Tell();
2056 59         223 $$dirInfo{DirLen} = $dirLen;
2057              
2058 59 100 100     430 if ($outfile and ref $outfile eq 'SCALAR' and not length $$outfile) {
      66        
2059             # write directly to outfile to avoid duplicating data in memory
2060 14 100       65 $$outfile = $$dataPt unless $fromFile;
2061             # TRICKY! -- copy to outfile memory buffer and edit in place
2062             # (so we must disable all Write() calls for this case)
2063 14         38 $dataPt = $outfile;
2064             }
2065 59 100 66     263 if ($fromFile or $$dirInfo{DirStart}) {
2066 53 100       236 $dataPt = \$buff unless $dataPt;
2067             # read VRD data into memory if necessary
2068 53 50       240 unless ($raf->Read($$dataPt, $dirLen) == $dirLen) {
2069 0 0 0     0 $$dataPt = '' if $outfile and $outfile eq $dataPt;
2070 0         0 $et->Warn('Error reading CanonVRD data');
2071 0         0 return 0;
2072             }
2073             }
2074 59         184 my $vrdType = 'VRD';
2075              
2076 59 100 66     432 if ($outfile) {
    100          
2077 18 50 33     112 $verbose and not $created and print $out " Rewriting CanonVRD trailer\n";
2078             # exit quickly if writing and no CanonVRD tags are being edited
2079 18 100       105 unless (exists $$et{EDIT_DIRS}{CanonVRD}) {
2080 4 50       11 print $out "$$et{INDENT} [nothing changed in CanonVRD]\n" if $verbose;
2081 4 50       31 return 1 if $outfile eq $dataPt;
2082 0 0       0 return Write($outfile, $$dataPt) ? 1 : -1;
2083             }
2084             # delete CanonVRD information if specified
2085 14         63 my $doDel = $$et{DEL_GROUP}{CanonVRD};
2086 14 100       56 unless ($doDel) {
2087 13 50 33     85 $doDel = 1 if $$et{DEL_GROUP}{Trailer} and $$et{FILE_TYPE} ne 'VRD';
2088 13 50       84 unless ($doDel) {
2089             # also delete if writing as a block (will get added back again later)
2090 13 100       130 if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonVRD}}) {
2091             # delete if this isn't version 4
2092 3 50       22 $doDel = 1 unless $$dataPt =~ /^.{28}\xff\xff\0\xf7/s;
2093             }
2094 13 100 66     130 if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonDR4}} and not $doDel) {
2095             # delete if this is version 4
2096 5 100       40 $doDel = 1 if $$dataPt =~ /^.{28}\xff\xff\0\xf7/s;
2097             }
2098             }
2099             }
2100 14 100       75 if ($doDel) {
2101 5 100       28 if ($$et{FILE_TYPE} eq 'VRD') {
2102 1         4 my $newVal = $et->GetNewValue('CanonVRD');
2103 1 50       4 if ($newVal) {
2104 1 50       6 $verbose and print $out " Writing CanonVRD as a block\n";
2105 1 50       4 if ($outfile eq $dataPt) {
2106 0         0 $$outfile = $newVal;
2107             } else {
2108 1 50       6 Write($outfile, $newVal) or return -1;
2109             }
2110 1         5 $$et{DidCanonVRD} = 1;
2111 1         2 ++$$et{CHANGED};
2112             } else {
2113 0         0 $et->Error("Can't delete all CanonVRD information from a VRD file");
2114             }
2115             } else {
2116 4 50       35 $verbose and print $out " Deleting CanonVRD trailer\n";
2117 4 50       28 $$outfile = '' if $outfile eq $dataPt;
2118 4         15 ++$$et{CHANGED};
2119             }
2120 5         37 return 1;
2121             }
2122             # write now and return if CanonVRD was set as a block
2123 9         60 my $val = $et->GetNewValue('CanonVRD');
2124 9 50       55 unless ($val) {
2125 9         394 $val = $et->GetNewValue('CanonDR4');
2126 9 100       54 $vrdType = 'DR4' if $val;
2127             }
2128 9 100       45 if ($val) {
2129 4 50       17 $verbose and print $out " Writing Canon$vrdType as a block\n";
2130             # must wrap DR4 data with the VRD header/footer and edit record
2131 4 50       30 $val = WrapDR4($val) if $vrdType eq 'DR4';
2132 4 100       23 if ($outfile eq $dataPt) {
2133 3         10 $$outfile = $val;
2134             } else {
2135 1 50       7 Write($outfile, $val) or return -1;
2136             }
2137 4         24 $$et{DidCanonVRD} = 1;
2138 4         13 ++$$et{CHANGED};
2139 4         31 return 1;
2140             }
2141             } elsif ($verbose or $$et{HTML_DUMP}) {
2142 1 50       12 $et->DumpTrailer($dirInfo) if $$dirInfo{RAF};
2143             }
2144              
2145 46         214 $tagTablePtr = GetTagTable('Image::ExifTool::CanonVRD::Main');
2146              
2147             # validate VRD trailer and get position and length of edit record
2148 46         231 SetByteOrder('MM'); # VRD header/footer is big-endian
2149 46         115 my $pos = 0x1c; # start at end of header
2150              
2151             # loop through the VRD blocks
2152 46         102 for (;;) {
2153 92         265 my $end = $dirLen - 0x40; # end of last VRD block (and start of footer)
2154 92 100       344 if ($pos + 8 > $end) {
2155 46 50       183 last if $pos == $end;
2156 0         0 $blockLen = $end; # mark as invalid
2157             } else {
2158 46         201 $blockType = Get32u($dataPt, $pos);
2159 46         157 $blockLen = Get32u($dataPt, $pos + 4);
2160             }
2161 46 100       169 $vrdType = 'DR4' if $blockType == 0xffff00f7;
2162 46         112 $pos += 8; # move to start of block
2163 46 50       185 if ($pos + $blockLen > $end) {
2164 0         0 $et->Warn('Possibly corrupt CanonVRD block');
2165 0         0 last;
2166             }
2167 46 50 33     194 if ($verbose > 1 and not $outfile) {
2168             printf $out " CanonVRD block 0x%.8x ($blockLen bytes at offset 0x%x)\n",
2169 0         0 $blockType, $pos + $$dirInfo{DataPos};
2170 0         0 $et->VerboseDump($dataPt, Len => $blockLen, Start => $pos, Addr => $pos + $$dirInfo{DataPos});
2171             }
2172 46         207 my $tagInfo = $$tagTablePtr{$blockType};
2173 46 50       141 unless ($tagInfo) {
2174 0 0       0 unless ($et->Options('Unknown')) {
2175 0         0 $pos += $blockLen; # step to next block
2176 0         0 next;
2177             }
2178 0         0 my $name = sprintf('CanonVRD_0x%.8x', $blockType);
2179 0         0 my $desc = $name;
2180 0         0 $desc =~ tr/_/ /;
2181 0         0 $tagInfo = {
2182             Name => $name,
2183             Description => $desc,
2184             Binary => 1,
2185             };
2186 0         0 AddTagToTable($tagTablePtr, $blockType, $tagInfo);
2187             }
2188 46 50       267 if ($$tagInfo{SubDirectory}) {
2189 46         211 my $subTablePtr = GetTagTable($$tagInfo{SubDirectory}{TagTable});
2190             my %subdirInfo = (
2191             DataPt => $dataPt,
2192             DataLen => length $$dataPt,
2193             DataPos => $$dirInfo{DataPos},
2194             DirStart => $pos,
2195             DirLen => $blockLen,
2196             DirName => $$tagInfo{Name},
2197 46         666 Parent => 'CanonVRD',
2198             OutFile => $outfile,
2199             );
2200 46 100       186 if ($outfile) {
2201             # set flag indicating we did this directory
2202 4         18 $didDir{$$tagInfo{Name}} = 1;
2203 4         14 my ($dat, $diff);
2204 4 50       22 if ($$et{NEW_VALUE}{$tagInfo}) {
2205             # write as a block
2206 0         0 $et->VPrint(0, "Writing $$tagInfo{Name} as a block\n");
2207 0         0 $dat = $et->GetNewValue($tagInfo);
2208 0 0       0 $dat = '' unless defined $dat;
2209 0         0 ++$$et{CHANGED};
2210             } else {
2211 4         54 $dat = $et->WriteDirectory(\%subdirInfo, $subTablePtr);
2212             }
2213             # update data with new directory
2214 4 100       23 if (defined $dat) {
2215 3 50 33     15 if (length $dat or $$et{FILE_TYPE} !~ /^(CRW|VRD)$/) {
2216             # replace with new block (updating the block length word)
2217 3         18 substr($$dataPt, $pos-4, $blockLen+4) = Set32u(length $dat) . $dat;
2218             } else {
2219             # remove block totally (CRW/VRD files only)
2220 0         0 substr($$dataPt, $pos-8, $blockLen+8) = '';
2221             }
2222             # make necessary adjustments if block changes length
2223 3 100       36 if (($diff = length($$dataPt) - $dirLen) != 0) {
2224 1         2 $pos += $diff;
2225 1         2 $dirLen += $diff;
2226             # update the new VRD length in the header/footer
2227 1         4 Set32u($dirLen - 0x5c, $dataPt, 0x18);
2228 1         5 Set32u($dirLen - 0x5c, $dataPt, $dirLen - 0x2c);
2229             }
2230             }
2231             } else {
2232             # extract as a block if requested
2233 42         241 $et->ProcessDirectory(\%subdirInfo, $subTablePtr);
2234             }
2235             } else {
2236 0         0 $et->HandleTag($tagTablePtr, $blockType, substr($$dataPt, $pos, $blockLen));
2237             }
2238 46         324 $pos += $blockLen; # step to next block
2239             }
2240 46 100 66     590 if ($outfile) {
    100 66        
2241             # create XMP block if necessary (CRW/VRD files only)
2242 5 100 66     57 if ($$et{ADD_DIRS}{CanonVRD} and not $didDir{XMP}) {
2243 4         18 my $subTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
2244 4         33 my $dat = $et->WriteDirectory({ Parent => 'CanonVRD' }, $subTablePtr);
2245 4 100       21 if ($dat) {
2246 2         5 my $blockLen = length $dat;
2247 2         9 substr($$dataPt, -0x40, 0) = Set32u(0xffff00f6) . Set32u(length $dat) . $dat;
2248 2         8 $dirLen = length $$dataPt;
2249             # update the new VRD length in the header/footer
2250 2         7 Set32u($dirLen - 0x5c, $dataPt, 0x18);
2251 2         6 Set32u($dirLen - 0x5c, $dataPt, $dirLen - 0x2c);
2252             }
2253             }
2254             # write CanonVRD trailer unless it is empty
2255 5 50       15 if (length $$dataPt) {
2256 5 100 33     37 Write($outfile, $$dataPt) or $err = 1 unless $outfile eq $dataPt;
2257             } else {
2258 0 0       0 $verbose and print $out " Deleting CanonVRD trailer\n";
2259             }
2260             } elsif ($vrdType eq 'VRD' and (($$et{TAGS_FROM_FILE} and
2261             not $$et{EXCL_TAG_LOOKUP}{canonvrd}) or $$et{REQ_TAG_LOOKUP}{canonvrd}))
2262             {
2263             # extract CanonVRD block if copying tags, or if requested (and not DR4 info)
2264 7         34 $et->FoundTag('CanonVRD', $buff);
2265             }
2266 46         176 undef $buff;
2267 46 50       414 return $err ? -1 : 1;
2268             }
2269              
2270             1; # end
2271              
2272             __END__