File Coverage

blib/lib/Image/ExifTool/CanonVRD.pm
Criterion Covered Total %
statement 373 464 80.3
branch 211 324 65.1
condition 66 129 51.1
subroutine 13 16 81.2
pod 0 12 0.0
total 663 945 70.1


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