File Coverage

blib/lib/Image/ExifTool/MWG.pm
Criterion Covered Total %
statement 62 91 68.1
branch 20 56 35.7
condition 6 18 33.3
subroutine 11 11 100.0
pod 0 6 0.0
total 99 182 54.4


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: MWG.pm
3             #
4             # Description: Metadata Working Group support
5             #
6             # Revisions: 2009/10/21 - P. Harvey Created
7             #
8             # References: 1) http://www.metadataworkinggroup.org/
9             #------------------------------------------------------------------------------
10              
11             package Image::ExifTool::MWG;
12              
13 3     3   4738 use strict;
  3         11  
  3         157  
14 3     3   19 use vars qw($VERSION);
  3         6  
  3         163  
15 3     3   24 use Image::ExifTool qw(:DataAccess :Utils);
  3         9  
  3         857  
16 3     3   1327 use Image::ExifTool::Exif;
  3         16  
  3         280  
17 3     3   1458 use Image::ExifTool::XMP;
  3         73  
  3         6467  
18              
19             $VERSION = '1.24';
20              
21             sub RecoverTruncatedIPTC($$$);
22             sub ListToString($);
23             sub StringToList($$);
24             sub OverwriteStringList($$$$);
25              
26             my $mwgLoaded; # flag set if we alreaded Load()ed the MWG tags
27              
28             # MWG Composite tags
29             %Image::ExifTool::MWG::Composite = (
30             GROUPS => { 0 => 'Composite', 1 => 'MWG', 2 => 'Image' },
31             VARS => { NO_ID => 1 },
32             WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
33             NOTES => q{
34             The table below lists special Composite tags which are used to access other
35             tags based on the MWG 2.0 recommendations. These tags are only accessible
36             when explicitly loaded, but this is done automatically by the exiftool
37             application if MWG is specified as a group for any tag on the command line,
38             or manually with the C<-use MWG> option. Via the API, the MWG Composite
39             tags are loaded by calling "C".
40              
41             When reading, the value of each MWG tag is B the specified
42             tags based on the MWG guidelines. When writing, the appropriate associated
43             tags are written. The value of the IPTCDigest tag is updated automatically
44             when the IPTC is changed if either the IPTCDigest tag didn't exist
45             beforehand or its value agreed with the original IPTC digest (indicating
46             that the XMP is synchronized with the IPTC). IPTC information is written
47             only if the original file contained IPTC.
48              
49             Loading the MWG module activates "strict MWG conformance mode", which has
50             the effect of causing EXIF, IPTC and XMP in non-standard locations to be
51             ignored when reading, as per the MWG recommendations. Instead, a "Warning"
52             tag is generated when non-standard metadata is encountered. This feature
53             may be disabled by setting C<$Image::ExifTool::MWG::strict = 0> in the
54             L (or from your Perl script when using the API). Note
55             that the behaviour when writing is not changed: ExifTool always creates new
56             records only in the standard location, but writes new tags to any
57             EXIF/IPTC/XMP records that exist.
58              
59             Contrary to the EXIF specification, the MWG recommends that EXIF "ASCII"
60             string values be stored as UTF-8. To honour this, the exiftool application
61             sets the default internal EXIF string encoding to "UTF8" when the MWG module
62             is loaded, but via the API this must be done manually by setting the
63             L option.
64              
65             A complication of the MWG specification is that although the MWG:Creator
66             property may consist of multiple values, the associated EXIF tag
67             (EXIF:Artist) is only a simple string. To resolve this discrepancy the MWG
68             recommends a technique which allows a list of values to be stored in a
69             string by using a semicolon-space separator (with quotes around values if
70             necessary). When the MWG module is loaded, ExifTool automatically
71             implements this policy and changes EXIF:Artist to a list-type tag.
72             },
73             Keywords => {
74             Flags => ['Writable','List'],
75             Desire => {
76             0 => 'IPTC:Keywords', # (64-character limit)
77             1 => 'XMP-dc:Subject',
78             2 => 'CurrentIPTCDigest',
79             3 => 'IPTCDigest',
80             },
81             RawConv => q{
82             return $val[1] if not defined $val[2] or (defined $val[1] and
83             (not defined $val[3] or $val[2] eq $val[3]));
84             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[0], $val[1], 64);
85             },
86             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
87             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
88             WriteAlso => {
89             # only write Keywords if IPTC exists (eg. set EditGroup option)
90             'IPTC:Keywords' => '$opts{EditGroup} = 1; $val',
91             'XMP-dc:Subject' => '$val',
92             },
93             },
94             Description => {
95             Writable => 1,
96             Desire => {
97             0 => 'EXIF:ImageDescription',
98             1 => 'IPTC:Caption-Abstract', # (2000-character limit)
99             2 => 'XMP-dc:Description',
100             3 => 'CurrentIPTCDigest',
101             4 => 'IPTCDigest',
102             },
103             RawConv => q{
104             return $val[0] if defined $val[0] and $val[0] !~ /^ *$/;
105             return $val[2] if not defined $val[3] or (defined $val[2] and
106             (not defined $val[4] or $val[3] eq $val[4]));
107             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[1], $val[2], 2000);
108             },
109             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
110             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
111             WriteAlso => {
112             'EXIF:ImageDescription' => '$val',
113             'IPTC:Caption-Abstract' => '$opts{EditGroup} = 1; $val',
114             'XMP-dc:Description' => '$val',
115             },
116             },
117             DateTimeOriginal => {
118             Description => 'Date/Time Original',
119             Groups => { 2 => 'Time' },
120             Notes => '"specifies when a photo was taken" - MWG',
121             Writable => 1,
122             Shift => 0, # don't shift this tag
123             Desire => {
124             0 => 'Composite:SubSecDateTimeOriginal',
125             1 => 'EXIF:DateTimeOriginal',
126             2 => 'IPTC:DateCreated',
127             3 => 'IPTC:TimeCreated',
128             4 => 'XMP-photoshop:DateCreated',
129             5 => 'CurrentIPTCDigest',
130             6 => 'IPTCDigest',
131             },
132             # must check for validity in RawConv to avoid hiding a same-named tag,
133             # but IPTC dates use a ValueConv so we need to derive the value there
134             RawConv => q{
135             (defined $val[0] or defined $val[1] or $val[2] or
136             (defined $val[4] and (not defined $val[5] or not defined $val[6]
137             or $val[5] eq $val[6]))) ? $val : undef
138             },
139             ValueConv => q{
140             return $val[0] if defined $val[0] and $val[0] !~ /^[: ]*$/;
141             return $val[1] if defined $val[1] and $val[1] !~ /^[: ]*$/;
142             return $val[4] if not defined $val[5] or (defined $val[4] and
143             (not defined $val[6] or $val[5] eq $val[6]));
144             return $val[3] ? "$val[2] $val[3]" : $val[2] if $val[2];
145             return undef;
146             },
147             PrintConv => '$self->ConvertDateTime($val)',
148             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
149             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
150             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
151             WriteAlso => {
152             # set EXIF date/time values according to PrintConv option instead
153             # of defaulting to Type=ValueConv to allow reformatting to be applied
154             'Composite:SubSecDateTimeOriginal' => 'delete $opts{Type}; $val',
155             'IPTC:DateCreated' => '$opts{EditGroup} = 1; $val',
156             'IPTC:TimeCreated' => '$opts{EditGroup} = 1; $val',
157             'XMP-photoshop:DateCreated' => '$val',
158             },
159             },
160             CreateDate => {
161             Groups => { 2 => 'Time' },
162             Notes => '"specifies when an image was digitized" - MWG',
163             Writable => 1,
164             Shift => 0, # don't shift this tag
165             Desire => {
166             0 => 'Composite:SubSecCreateDate',
167             1 => 'EXIF:CreateDate',
168             2 => 'IPTC:DigitalCreationDate',
169             3 => 'IPTC:DigitalCreationTime',
170             4 => 'XMP-xmp:CreateDate',
171             5 => 'CurrentIPTCDigest',
172             6 => 'IPTCDigest',
173             },
174             RawConv => q{
175             (defined $val[0] or defined $val[1] or $val[2] or
176             (defined $val[4] and (not defined $val[5] or not defined $val[6]
177             or $val[5] eq $val[6]))) ? $val : undef
178             },
179             ValueConv => q{
180             return $val[0] if defined $val[0] and $val[0] !~ /^[: ]*$/;
181             return $val[1] if defined $val[1] and $val[1] !~ /^[: ]*$/;
182             return $val[4] if not defined $val[5] or (defined $val[4] and
183             (not defined $val[6] or $val[5] eq $val[6]));
184             return $val[3] ? "$val[2] $val[3]" : $val[2] if $val[2];
185             return undef;
186             },
187             PrintConv => '$self->ConvertDateTime($val)',
188             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
189             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
190             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
191             WriteAlso => {
192             'Composite:SubSecCreateDate' => 'delete $opts{Type}; $val',
193             'IPTC:DigitalCreationDate' => '$opts{EditGroup} = 1; $val',
194             'IPTC:DigitalCreationTime' => '$opts{EditGroup} = 1; $val',
195             'XMP-xmp:CreateDate' => '$val',
196             },
197             },
198             ModifyDate => {
199             Groups => { 2 => 'Time' },
200             Notes => '"specifies when a file was modified by the user" - MWG',
201             Writable => 1,
202             Shift => 0, # don't shift this tag
203             Desire => {
204             0 => 'Composite:SubSecModifyDate',
205             1 => 'EXIF:ModifyDate',
206             2 => 'XMP-xmp:ModifyDate',
207             3 => 'CurrentIPTCDigest',
208             4 => 'IPTCDigest',
209             },
210             RawConv => q{
211             return $val[0] if defined $val[0] and $val[0] !~ /^[: ]*$/;
212             return $val[1] if defined $val[1] and $val[1] !~ /^[: ]*$/;
213             return $val[2] if not defined $val[3] or not defined $val[4] or $val[3] eq $val[4];
214             return undef;
215             },
216             PrintConv => '$self->ConvertDateTime($val)',
217             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
218             # return empty string from check routines so this tag will never be set
219             # (only WriteAlso tags are written), the only difference is a -v2 message
220             DelCheck => '""',
221             WriteCheck => '""',
222             WriteAlso => {
223             'Composite:SubSecModifyDate' => 'delete $opts{Type}; $val',
224             'XMP-xmp:ModifyDate' => '$val',
225             },
226             },
227             Orientation => {
228             Writable => 1,
229             Require => 'EXIF:Orientation',
230             ValueConv => '$val',
231             PrintConv => \%Image::ExifTool::Exif::orientation,
232             DelCheck => '""',
233             WriteCheck => '""',
234             WriteAlso => {
235             'EXIF:Orientation' => '$val',
236             },
237             },
238             Rating => {
239             Writable => 1,
240             Require => 'XMP-xmp:Rating',
241             ValueConv => '$val',
242             DelCheck => '""',
243             WriteCheck => '""',
244             WriteAlso => {
245             'XMP-xmp:Rating' => '$val',
246             },
247             },
248             Copyright => {
249             Groups => { 2 => 'Author' },
250             Writable => 1,
251             Desire => {
252             0 => 'EXIF:Copyright',
253             1 => 'IPTC:CopyrightNotice', # (128-character limit)
254             2 => 'XMP-dc:Rights',
255             3 => 'CurrentIPTCDigest',
256             4 => 'IPTCDigest',
257             },
258             RawConv => q{
259             return $val[0] if defined $val[0] and $val[0] !~ /^ *$/;
260             return $val[2] if not defined $val[3] or (defined $val[2] and
261             (not defined $val[4] or $val[3] eq $val[4]));
262             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[1], $val[2], 128);
263             },
264             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
265             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
266             WriteAlso => {
267             'EXIF:Copyright' => q{
268             # encode if necessary (not automatic because Format is 'undef')
269             my $enc = $self->Options('CharsetEXIF');
270             if ($enc) {
271             my $v = $val;
272             $self->Encode($v,$enc);
273             return $v;
274             }
275             return $val;
276             },
277             'IPTC:CopyrightNotice' => '$opts{EditGroup} = 1; $val',
278             'XMP-dc:Rights' => '$val',
279             },
280             },
281             Creator => {
282             Groups => { 2 => 'Author' },
283             Flags => ['Writable','List'],
284             Desire => {
285             0 => 'EXIF:Artist',
286             1 => 'IPTC:By-line', # (32-character limit)
287             2 => 'XMP-dc:Creator',
288             3 => 'CurrentIPTCDigest',
289             4 => 'IPTCDigest',
290             },
291             RawConv => q{
292             return $val[0] if defined $val[0] and $val[0] !~ /^ *$/;
293             return $val[2] if not defined $val[3] or (defined $val[2] and
294             (not defined $val[4] or $val[3] eq $val[4]));
295             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[1], $val[2], 32);
296             },
297             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
298             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
299             WriteAlso => {
300             'EXIF:Artist' => '$val',
301             'IPTC:By-line' => '$opts{EditGroup} = 1; $val',
302             'XMP-dc:Creator' => '$val',
303             },
304             },
305             Country => {
306             Groups => { 2 => 'Location' },
307             Writable => 1,
308             Desire => {
309             0 => 'IPTC:Country-PrimaryLocationName', # (64-character limit)
310             1 => 'XMP-photoshop:Country',
311             2 => 'XMP-iptcExt:LocationShownCountryName',
312             3 => 'CurrentIPTCDigest',
313             4 => 'IPTCDigest',
314             },
315             RawConv => q{
316             my $xmpVal = $val[2] || $val[1];
317             return $xmpVal if not defined $val[3] or (defined $xmpVal and
318             (not defined $val[4] or $val[3] eq $val[4]));
319             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[0], $xmpVal, 64);
320             },
321             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
322             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
323             WriteAlso => {
324             'IPTC:Country-PrimaryLocationName' => '$opts{EditGroup} = 1; $val',
325             'XMP-photoshop:Country' => '$val', # (legacy)
326             'XMP-iptcExt:LocationShownCountryName' => '$val',
327             },
328             },
329             State => {
330             Groups => { 2 => 'Location' },
331             Writable => 1,
332             Desire => {
333             0 => 'IPTC:Province-State', # (32-character limit)
334             1 => 'XMP-photoshop:State',
335             2 => 'XMP-iptcExt:LocationShownProvinceState',
336             3 => 'CurrentIPTCDigest',
337             4 => 'IPTCDigest',
338             },
339             RawConv => q{
340             my $xmpVal = $val[2] || $val[1];
341             return $xmpVal if not defined $val[3] or (defined $xmpVal and
342             (not defined $val[4] or $val[3] eq $val[4]));
343             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[0], $xmpVal, 32);
344             },
345             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
346             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
347             WriteAlso => {
348             'IPTC:Province-State' => '$opts{EditGroup} = 1; $val',
349             'XMP-photoshop:State' => '$val', # (legacy)
350             'XMP-iptcExt:LocationShownProvinceState' => '$val',
351             },
352             },
353             City => {
354             Groups => { 2 => 'Location' },
355             Writable => 1,
356             Desire => {
357             0 => 'IPTC:City', # (32-character limit)
358             1 => 'XMP-photoshop:City',
359             2 => 'XMP-iptcExt:LocationShownCity',
360             3 => 'CurrentIPTCDigest',
361             4 => 'IPTCDigest',
362             },
363             RawConv => q{
364             my $xmpVal = $val[2] || $val[1];
365             return $xmpVal if not defined $val[3] or (defined $xmpVal and
366             (not defined $val[4] or $val[3] eq $val[4]));
367             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[0], $xmpVal, 32);
368             },
369             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
370             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
371             WriteAlso => {
372             'IPTC:City' => '$opts{EditGroup} = 1; $val',
373             'XMP-photoshop:City' => '$val', # (legacy)
374             'XMP-iptcExt:LocationShownCity' => '$val',
375             },
376             },
377             Location => {
378             Groups => { 2 => 'Location' },
379             Writable => 1,
380             Desire => {
381             0 => 'IPTC:Sub-location', # (32-character limit)
382             1 => 'XMP-iptcCore:Location',
383             2 => 'XMP-iptcExt:LocationShownSublocation',
384             3 => 'CurrentIPTCDigest',
385             4 => 'IPTCDigest',
386             },
387             RawConv => q{
388             my $xmpVal = $val[2] || $val[1];
389             return $xmpVal if not defined $val[3] or (defined $xmpVal and
390             (not defined $val[4] or $val[3] eq $val[4]));
391             return Image::ExifTool::MWG::RecoverTruncatedIPTC($val[0], $xmpVal, 32);
392             },
393             DelCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
394             WriteCheck => 'Image::ExifTool::MWG::ReconcileIPTCDigest($self)',
395             WriteAlso => {
396             'IPTC:Sub-location' => '$opts{EditGroup} = 1; $val',
397             'XMP-iptcCore:Location' => '$val', # (legacy)
398             'XMP-iptcExt:LocationShownSublocation' => '$val',
399             },
400             },
401             );
402              
403             # MWG XMP structures
404             my %sExtensions = (
405             STRUCT_NAME => 'MWG Extensions',
406             NAMESPACE => undef, # variable namespace
407             NOTES => q{
408             This structure may contain any top-level XMP tags, but none have been
409             pre-defined in ExifTool. Since no flattened tags have been pre-defined,
410             RegionExtensions is writable only as a structure (eg.
411             C<{xmp-dc:creator=me,rating=5}>). Fields for this structure are identified
412             using the standard ExifTool tag name (with optional leading group name,
413             and/or trailing language code, and/or trailing C<#> symbol to disable print
414             conversion).
415             },
416             );
417             my %sRegionStruct = (
418             STRUCT_NAME => 'MWG RegionStruct',
419             NAMESPACE => 'mwg-rs',
420             Area => { Struct => \%Image::ExifTool::XMP::sArea },
421             Type => {
422             PrintConv => {
423             Face => 'Face',
424             Pet => 'Pet',
425             Focus => 'Focus',
426             BarCode => 'BarCode',
427             },
428             },
429             Name => { },
430             Description => { },
431             FocusUsage => {
432             PrintConv => {
433             EvaluatedUsed => 'Evaluated, Used',
434             EvaluatedNotUsed => 'Evaluated, Not Used',
435             NotEvaluatedNotUsed => 'Not Evaluated, Not Used',
436             },
437             },
438             BarCodeValue=> { },
439             Extensions => { Struct => \%sExtensions },
440             Rotation => { # (observed in LR6 XMP)
441             Writable => 'real',
442             Notes => 'not part of MWG 2.0 spec',
443             },
444             seeAlso => { Namespace => 'rdfs', Resource => 1 },
445             );
446             my %sKeywordStruct;
447             %sKeywordStruct = (
448             STRUCT_NAME => 'MWG KeywordStruct',
449             NAMESPACE => 'mwg-kw',
450             Keyword => { },
451             Applied => { Writable => 'boolean' },
452             Children => { Struct => \%sKeywordStruct, List => 'Bag' },
453             );
454              
455             # MWG 2.0 XMP region namespace tags
456             %Image::ExifTool::MWG::Regions = (
457             %Image::ExifTool::XMP::xmpTableDefaults,
458             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-rs', 2 => 'Image' },
459             NAMESPACE => 'mwg-rs',
460             NOTES => q{
461             Image region metadata defined by the MWG 2.0 specification. These tags
462             may be accessed without the need to load the MWG Composite tags above. See
463             L
464             for the official specification.
465             },
466             Regions => {
467             Name => 'RegionInfo',
468             FlatName => 'Region',
469             Struct => {
470             STRUCT_NAME => 'MWG RegionInfo',
471             NAMESPACE => 'mwg-rs',
472             RegionList => {
473             FlatName => 'Region',
474             Struct => \%sRegionStruct,
475             List => 'Bag',
476             },
477             AppliedToDimensions => { Struct => \%Image::ExifTool::XMP::sDimensions },
478             },
479             },
480             RegionsRegionList => { Flat => 1, Name => 'RegionList' },
481             );
482              
483             # MWG 2.0 XMP hierarchical keyword namespace tags
484             %Image::ExifTool::MWG::Keywords = (
485             %Image::ExifTool::XMP::xmpTableDefaults,
486             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-kw', 2 => 'Image' },
487             NAMESPACE => 'mwg-kw',
488             NOTES => q{
489             Hierarchical keywords metadata defined by the MWG 2.0 specification.
490             ExifTool unrolls keyword structures to an arbitrary depth of 6 to allow
491             individual levels to be accessed with different tag names, and to avoid
492             infinite recursion. See
493             L
494             for the official specification.
495             },
496             # arbitrarily define only the first 6 levels of the keyword hierarchy
497             Keywords => {
498             Name => 'KeywordInfo',
499             Struct => {
500             STRUCT_NAME => 'MWG KeywordInfo',
501             NAMESPACE => 'mwg-kw',
502             Hierarchy => { Struct => \%sKeywordStruct, List => 'Bag' },
503             },
504             },
505             KeywordsHierarchy => { Name => 'HierarchicalKeywords', Flat => 1 },
506             KeywordsHierarchyKeyword => { Name => 'HierarchicalKeywords1', Flat => 1 },
507             KeywordsHierarchyApplied => { Name => 'HierarchicalKeywords1Applied', Flat => 1 },
508             KeywordsHierarchyChildren => { Name => 'HierarchicalKeywords1Children', Flat => 1 },
509             KeywordsHierarchyChildrenKeyword => { Name => 'HierarchicalKeywords2', Flat => 1 },
510             KeywordsHierarchyChildrenApplied => { Name => 'HierarchicalKeywords2Applied', Flat => 1 },
511             KeywordsHierarchyChildrenChildren => { Name => 'HierarchicalKeywords2Children', Flat => 1 },
512             KeywordsHierarchyChildrenChildrenKeyword => { Name => 'HierarchicalKeywords3', Flat => 1 },
513             KeywordsHierarchyChildrenChildrenApplied => { Name => 'HierarchicalKeywords3Applied', Flat => 1 },
514             KeywordsHierarchyChildrenChildrenChildren => { Name => 'HierarchicalKeywords3Children', Flat => 1 },
515             KeywordsHierarchyChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords4', Flat => 1 },
516             KeywordsHierarchyChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords4Applied', Flat => 1 },
517             KeywordsHierarchyChildrenChildrenChildrenChildren => { Name => 'HierarchicalKeywords4Children', Flat => 1 },
518             KeywordsHierarchyChildrenChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords5', Flat => 1 },
519             KeywordsHierarchyChildrenChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords5Applied', Flat => 1 },
520             KeywordsHierarchyChildrenChildrenChildrenChildrenChildren => { Name => 'HierarchicalKeywords5Children', Flat => 1, NoSubStruct => 1 }, # break infinite recursion
521             KeywordsHierarchyChildrenChildrenChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords6', Flat => 1 },
522             KeywordsHierarchyChildrenChildrenChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords6Applied', Flat => 1 },
523             );
524              
525             # MWG 2.0 XMP collections namespace tags
526             %Image::ExifTool::MWG::Collections = (
527             %Image::ExifTool::XMP::xmpTableDefaults,
528             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-coll', 2 => 'Image' },
529             NAMESPACE => 'mwg-coll',
530             NOTES => q{
531             Collections metadata defined by the MWG 2.0 specification. See
532             L
533             for the official specification.
534             },
535             Collections => {
536             FlatName => '',
537             List => 'Bag',
538             Struct => {
539             STRUCT_NAME => 'MWG CollectionInfo',
540             NAMESPACE => 'mwg-coll',
541             CollectionName => { },
542             CollectionURI => { },
543             },
544             },
545             );
546              
547              
548             #------------------------------------------------------------------------------
549             # Load the MWG Composite tags
550             sub Load()
551             {
552 1 50   1 0 9 return if $mwgLoaded;
553              
554             # add our composite tags
555 1         7 Image::ExifTool::AddCompositeTags('Image::ExifTool::MWG');
556             # must also add to lookup so we can write them
557             # (since MWG tags aren't in the tag lookup by default)
558 1         6 Image::ExifTool::AddTagsToLookup(\%Image::ExifTool::MWG::Composite,
559             'Image::ExifTool::Composite');
560              
561             # modify EXIF:Artist to behave as a list-type tag
562 1         3 my $artist = $Image::ExifTool::Exif::Main{0x13b};
563 1         13 $$artist{List} = 1;
564 1         4 $$artist{IsOverwriting} = \&OverwriteStringList;
565 1         4 $$artist{RawConv} = \&StringToList;
566              
567             # enable MWG strict mode if not set already
568             # (causes non-standard EXIF, IPTC and XMP to be ignored)
569 1 50       4 $Image::ExifTool::MWG::strict = 1 unless defined $Image::ExifTool::MWG::strict;
570              
571 1         3 $mwgLoaded = 1;
572             }
573              
574             #------------------------------------------------------------------------------
575             # Change a list of values to a string using MWG rules
576             # Inputs: 0)reference to list of values
577             # Returns: string of values (and may reformat list entries)
578             sub ListToString($)
579             {
580 2     2 0 7 my $vals = shift;
581 2         8 foreach (@$vals) {
582             # double all quotes in value and quote the value if it begins
583             # with a quote or contains a semicolon-space separator
584 4 50 33     23 if (/^"/ or /; /) {
585 0         0 s/"/""/g; # double all quotes
586 0         0 $_ = qq{"$_"}; # quote the value
587             }
588             }
589 2         12 return join('; ', @$vals);
590             }
591              
592             #------------------------------------------------------------------------------
593             # Change a string value to a list of values using MWG rules
594             # Inputs: 0) string of values, 1) ExifTool ref
595             # Returns: value or list reference if more than one value
596             # Notes: Sets Warning tag on error
597             sub StringToList($$)
598             {
599 6     6 0 22 my ($str, $et) = @_;
600 6         13 my (@vals, $inQuotes);
601 6         30 my @t = split '; ', $str, -1;
602 6         20 foreach (@t) {
603 10         16 my $wasQuotes = $inQuotes;
604 10 50 33     51 $inQuotes = 1 if not $inQuotes and s/^"//;
605 10 50       22 if ($inQuotes) {
606             # remove the last quote and reset the inQuotes flag if
607             # the value ended in an odd number of quotes
608 0 0       0 $inQuotes = 0 if s/((^|[^"])("")*)"$/$1/;
609 0         0 s/""/"/g; # un-double the contained quotes
610             }
611 10 50       22 if ($wasQuotes) {
612             # previous separator was quoted, so concatinate with previous value
613 0         0 $vals[-1] .= '; ' . $_;
614             } else {
615 10         28 push @vals, $_;
616             }
617             }
618 6 50       30 $et->Warn('Incorrectly quoted MWG string-list value') if $inQuotes;
619 6 100       39 return @vals > 1 ? \@vals : $vals[0];
620             }
621              
622             #------------------------------------------------------------------------------
623             # Handle logic for overwriting EXIF string-type list tag
624             # Inputs: 0) ExifTool ref, 1) new value hash ref,
625             # 2) old string value (or undef if it didn't exist), 3) new value ref
626             # Returns: 1 and sets the new value for the tag
627             sub OverwriteStringList($$$$)
628             {
629 2     2 0 4 local $_;
630 2         6 my ($et, $nvHash, $val, $newValuePt) = @_;
631 2         14 my (@new, $delIndex);
632 2         12 my $writeMode = $et->Options('WriteMode');
633 2 50       10 if ($writeMode ne 'wcg') {
634 0 0       0 if (defined $val) {
635 0 0       0 $writeMode =~ /w/i or return 0;
636             } else {
637 0 0       0 $writeMode =~ /c/i or return 0;
638             }
639             }
640 2 50 33     18 if ($$nvHash{DelValue} and defined $val) {
641             # preserve specified old values
642 0         0 my $old = StringToList($val, $et);
643 0 0       0 my @old = ref $old eq 'ARRAY' ? @$old : $old;
644 0 0       0 if (@{$$nvHash{DelValue}}) {
  0         0  
645 0         0 my %del;
646 0         0 $del{$_} = 1 foreach @{$$nvHash{DelValue}};
  0         0  
647 0         0 foreach (@old) {
648 0 0       0 $del{$_} or push(@new, $_), next;
649 0 0       0 $delIndex or $delIndex = scalar @new;
650             }
651             } else {
652 0         0 push @new, @old;
653             }
654             }
655             # add new values (at location of deleted values, if any)
656 2 50       11 if ($$nvHash{Value}) {
657 2 50       8 if (defined $delIndex) {
658 0         0 splice @new, $delIndex, 0, @{$$nvHash{Value}};
  0         0  
659             } else {
660 2         13 push @new, @{$$nvHash{Value}};
  2         11  
661             }
662             }
663 2 50       8 if (@new) {
664             # convert back to string format
665 2         8 $$newValuePt = ListToString(\@new);
666             } else {
667 0         0 $$newValuePt = undef; # delete the tag
668             }
669 2         10 return 1;
670             }
671              
672             #------------------------------------------------------------------------------
673             # Reconcile IPTC digest after writing an MWG tag
674             # Inputs: 0) ExifTool object ref
675             # Returns: empty string
676             sub ReconcileIPTCDigest($)
677             {
678 8     8 0 22 my $et = shift;
679              
680             # set new value for IPTCDigest if not done already
681 8 100 66     68 unless ($Image::ExifTool::Photoshop::iptcDigestInfo and
682             $$et{NEW_VALUE}{$Image::ExifTool::Photoshop::iptcDigestInfo})
683             {
684             # write new IPTCDigest only if it doesn't exist or
685             # is the same as the digest of the original IPTC
686 2         5 my @a; # (capture warning messages)
687 2         53 @a = $et->SetNewValue('Photoshop:IPTCDigest', 'old', Protected => 1, DelValue => 1);
688 2         13 @a = $et->SetNewValue('Photoshop:IPTCDigest', 'new', Protected => 1);
689             }
690 8         74 return '';
691             }
692              
693             #------------------------------------------------------------------------------
694             # Recover strings which were truncated by IPTC dataset length limit
695             # Inputs: 0) IPTC value, 1) XMP value, 2) length limit
696             # Notes: handles the case where IPTC and/or XMP values are lists
697             sub RecoverTruncatedIPTC($$$)
698             {
699 19     19 0 59 my ($iptc, $xmp, $limit) = @_;
700              
701 19 100       199 return $iptc unless defined $xmp;
702 8 50 33     43 if (ref $iptc) {
    50          
703 0 0       0 $xmp = [ $xmp ] unless ref $xmp;
704 0         0 my ($i, @vals);
705 0         0 for ($i=0; $i<@$iptc; ++$i) {
706 0         0 push @vals, RecoverTruncatedIPTC($$iptc[$i], $$xmp[$i], $limit);
707             }
708 0         0 return \@vals;
709             } elsif (defined $iptc and length $iptc == $limit) {
710 0 0       0 $xmp = $$xmp[0] if ref $xmp; # take first element of list
711 0 0 0     0 return $xmp if length $xmp > $limit and $iptc eq substr($xmp, 0, $limit);
712             }
713 8         91 return $iptc;
714             }
715              
716             1; # end
717              
718             __END__