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   6553 use strict;
  3         9  
  3         181  
14 3     3   23 use vars qw($VERSION);
  3         7  
  3         231  
15 3     3   25 use Image::ExifTool qw(:DataAccess :Utils);
  3         5  
  3         1029  
16 3     3   1258 use Image::ExifTool::Exif;
  3         14  
  3         366  
17 3     3   1322 use Image::ExifTool::XMP;
  3         10  
  3         8128  
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 => { ID_FMT => 'none' },
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             # Title - seen in sample XMP of MWG 2.0 specification, but not in spec itself
445             seeAlso => { Namespace => 'rdfs', Resource => 1 },
446             );
447             my %sKeywordStruct;
448             %sKeywordStruct = (
449             STRUCT_NAME => 'MWG KeywordStruct',
450             NAMESPACE => 'mwg-kw',
451             Keyword => { },
452             Applied => { Writable => 'boolean' },
453             Children => { Struct => \%sKeywordStruct, List => 'Bag' },
454             );
455              
456             # MWG 2.0 XMP region namespace tags
457             %Image::ExifTool::MWG::Regions = (
458             %Image::ExifTool::XMP::xmpTableDefaults,
459             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-rs', 2 => 'Image' },
460             NAMESPACE => 'mwg-rs',
461             NOTES => q{
462             Image region metadata defined by the MWG 2.0 specification. These tags
463             may be accessed without the need to load the MWG Composite tags above. See
464             L
465             for the official specification.
466             },
467             Regions => {
468             Name => 'RegionInfo',
469             FlatName => 'Region',
470             Struct => {
471             STRUCT_NAME => 'MWG RegionInfo',
472             NAMESPACE => 'mwg-rs',
473             RegionList => {
474             FlatName => 'Region',
475             Struct => \%sRegionStruct,
476             List => 'Bag',
477             },
478             AppliedToDimensions => { Struct => \%Image::ExifTool::XMP::sDimensions },
479             },
480             },
481             RegionsRegionList => { Flat => 1, Name => 'RegionList' },
482             );
483              
484             # MWG 2.0 XMP hierarchical keyword namespace tags
485             %Image::ExifTool::MWG::Keywords = (
486             %Image::ExifTool::XMP::xmpTableDefaults,
487             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-kw', 2 => 'Image' },
488             NAMESPACE => 'mwg-kw',
489             NOTES => q{
490             Hierarchical keywords metadata defined by the MWG 2.0 specification.
491             ExifTool unrolls keyword structures to an arbitrary depth of 6 to allow
492             individual levels to be accessed with different tag names, and to avoid
493             infinite recursion. See
494             L
495             for the official specification.
496             },
497             # arbitrarily define only the first 6 levels of the keyword hierarchy
498             Keywords => {
499             Name => 'KeywordInfo',
500             Struct => {
501             STRUCT_NAME => 'MWG KeywordInfo',
502             NAMESPACE => 'mwg-kw',
503             Hierarchy => { Struct => \%sKeywordStruct, List => 'Bag' },
504             },
505             },
506             KeywordsHierarchy => { Name => 'HierarchicalKeywords', Flat => 1 },
507             KeywordsHierarchyKeyword => { Name => 'HierarchicalKeywords1', Flat => 1 },
508             KeywordsHierarchyApplied => { Name => 'HierarchicalKeywords1Applied', Flat => 1 },
509             KeywordsHierarchyChildren => { Name => 'HierarchicalKeywords1Children', Flat => 1 },
510             KeywordsHierarchyChildrenKeyword => { Name => 'HierarchicalKeywords2', Flat => 1 },
511             KeywordsHierarchyChildrenApplied => { Name => 'HierarchicalKeywords2Applied', Flat => 1 },
512             KeywordsHierarchyChildrenChildren => { Name => 'HierarchicalKeywords2Children', Flat => 1 },
513             KeywordsHierarchyChildrenChildrenKeyword => { Name => 'HierarchicalKeywords3', Flat => 1 },
514             KeywordsHierarchyChildrenChildrenApplied => { Name => 'HierarchicalKeywords3Applied', Flat => 1 },
515             KeywordsHierarchyChildrenChildrenChildren => { Name => 'HierarchicalKeywords3Children', Flat => 1 },
516             KeywordsHierarchyChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords4', Flat => 1 },
517             KeywordsHierarchyChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords4Applied', Flat => 1 },
518             KeywordsHierarchyChildrenChildrenChildrenChildren => { Name => 'HierarchicalKeywords4Children', Flat => 1 },
519             KeywordsHierarchyChildrenChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords5', Flat => 1 },
520             KeywordsHierarchyChildrenChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords5Applied', Flat => 1 },
521             KeywordsHierarchyChildrenChildrenChildrenChildrenChildren => { Name => 'HierarchicalKeywords5Children', Flat => 1, NoSubStruct => 1 }, # break infinite recursion
522             KeywordsHierarchyChildrenChildrenChildrenChildrenChildrenKeyword => { Name => 'HierarchicalKeywords6', Flat => 1 },
523             KeywordsHierarchyChildrenChildrenChildrenChildrenChildrenApplied => { Name => 'HierarchicalKeywords6Applied', Flat => 1 },
524             );
525              
526             # MWG 2.0 XMP collections namespace tags
527             %Image::ExifTool::MWG::Collections = (
528             %Image::ExifTool::XMP::xmpTableDefaults,
529             GROUPS => { 0 => 'XMP', 1 => 'XMP-mwg-coll', 2 => 'Image' },
530             NAMESPACE => 'mwg-coll',
531             NOTES => q{
532             Collections metadata defined by the MWG 2.0 specification. See
533             L
534             for the official specification.
535             },
536             Collections => {
537             FlatName => '',
538             List => 'Bag',
539             Struct => {
540             STRUCT_NAME => 'MWG CollectionInfo',
541             NAMESPACE => 'mwg-coll',
542             CollectionName => { },
543             CollectionURI => { },
544             },
545             },
546             );
547              
548              
549             #------------------------------------------------------------------------------
550             # Load the MWG Composite tags
551             sub Load()
552             {
553 1 50   1 0 176016 return if $mwgLoaded;
554              
555             # add our composite tags
556 1         10 Image::ExifTool::AddCompositeTags('Image::ExifTool::MWG');
557             # must also add to lookup so we can write them
558             # (since MWG tags aren't in the tag lookup by default)
559 1         9 Image::ExifTool::AddTagsToLookup(\%Image::ExifTool::MWG::Composite,
560             'Image::ExifTool::Composite');
561              
562             # modify EXIF:Artist to behave as a list-type tag
563 1         5 my $artist = $Image::ExifTool::Exif::Main{0x13b};
564 1         5 $$artist{List} = 1;
565 1         4 $$artist{IsOverwriting} = \&OverwriteStringList;
566 1         4 $$artist{RawConv} = \&StringToList;
567              
568             # enable MWG strict mode if not set already
569             # (causes non-standard EXIF, IPTC and XMP to be ignored)
570 1 50       17 $Image::ExifTool::MWG::strict = 1 unless defined $Image::ExifTool::MWG::strict;
571              
572 1         5 $mwgLoaded = 1;
573             }
574              
575             #------------------------------------------------------------------------------
576             # Change a list of values to a string using MWG rules
577             # Inputs: 0)reference to list of values
578             # Returns: string of values (and may reformat list entries)
579             sub ListToString($)
580             {
581 2     2 0 4 my $vals = shift;
582 2         9 foreach (@$vals) {
583             # double all quotes in value and quote the value if it begins
584             # with a quote or contains a semicolon-space separator
585 4 50 33     23 if (/^"/ or /; /) {
586 0         0 s/"/""/g; # double all quotes
587 0         0 $_ = qq{"$_"}; # quote the value
588             }
589             }
590 2         10 return join('; ', @$vals);
591             }
592              
593             #------------------------------------------------------------------------------
594             # Change a string value to a list of values using MWG rules
595             # Inputs: 0) string of values, 1) ExifTool ref
596             # Returns: value or list reference if more than one value
597             # Notes: Sets Warning tag on error
598             sub StringToList($$)
599             {
600 6     6 0 18 my ($str, $et) = @_;
601 6         13 my (@vals, $inQuotes);
602 6         35 my @t = split '; ', $str, -1;
603 6         16 foreach (@t) {
604 10         14 my $wasQuotes = $inQuotes;
605 10 50 33     48 $inQuotes = 1 if not $inQuotes and s/^"//;
606 10 50       25 if ($inQuotes) {
607             # remove the last quote and reset the inQuotes flag if
608             # the value ended in an odd number of quotes
609 0 0       0 $inQuotes = 0 if s/((^|[^"])("")*)"$/$1/;
610 0         0 s/""/"/g; # un-double the contained quotes
611             }
612 10 50       21 if ($wasQuotes) {
613             # previous separator was quoted, so concatinate with previous value
614 0         0 $vals[-1] .= '; ' . $_;
615             } else {
616 10         27 push @vals, $_;
617             }
618             }
619 6 50       14 $et->Warn('Incorrectly quoted MWG string-list value') if $inQuotes;
620 6 100       28 return @vals > 1 ? \@vals : $vals[0];
621             }
622              
623             #------------------------------------------------------------------------------
624             # Handle logic for overwriting EXIF string-type list tag
625             # Inputs: 0) ExifTool ref, 1) new value hash ref,
626             # 2) old string value (or undef if it didn't exist), 3) new value ref
627             # Returns: 1 and sets the new value for the tag
628             sub OverwriteStringList($$$$)
629             {
630 2     2 0 5 local $_;
631 2         6 my ($et, $nvHash, $val, $newValuePt) = @_;
632 2         4 my (@new, $delIndex);
633 2         15 my $writeMode = $et->Options('WriteMode');
634 2 50       34 if ($writeMode ne 'wcg') {
635 0 0       0 if (defined $val) {
636 0 0       0 $writeMode =~ /w/i or return 0;
637             } else {
638 0 0       0 $writeMode =~ /c/i or return 0;
639             }
640             }
641 2 50 33     12 if ($$nvHash{DelValue} and defined $val) {
642             # preserve specified old values
643 0         0 my $old = StringToList($val, $et);
644 0 0       0 my @old = ref $old eq 'ARRAY' ? @$old : $old;
645 0 0       0 if (@{$$nvHash{DelValue}}) {
  0         0  
646 0         0 my %del;
647 0         0 $del{$_} = 1 foreach @{$$nvHash{DelValue}};
  0         0  
648 0         0 foreach (@old) {
649 0 0       0 $del{$_} or push(@new, $_), next;
650 0 0       0 $delIndex or $delIndex = scalar @new;
651             }
652             } else {
653 0         0 push @new, @old;
654             }
655             }
656             # add new values (at location of deleted values, if any)
657 2 50       11 if ($$nvHash{Value}) {
658 2 50       6 if (defined $delIndex) {
659 0         0 splice @new, $delIndex, 0, @{$$nvHash{Value}};
  0         0  
660             } else {
661 2         6 push @new, @{$$nvHash{Value}};
  2         9  
662             }
663             }
664 2 50       7 if (@new) {
665             # convert back to string format
666 2         8 $$newValuePt = ListToString(\@new);
667             } else {
668 0         0 $$newValuePt = undef; # delete the tag
669             }
670 2         7 return 1;
671             }
672              
673             #------------------------------------------------------------------------------
674             # Reconcile IPTC digest after writing an MWG tag
675             # Inputs: 0) ExifTool object ref
676             # Returns: empty string
677             sub ReconcileIPTCDigest($)
678             {
679 8     8 0 24 my $et = shift;
680              
681             # set new value for IPTCDigest if not done already
682 8 100 66     102 unless ($Image::ExifTool::Photoshop::iptcDigestInfo and
683             $$et{NEW_VALUE}{$Image::ExifTool::Photoshop::iptcDigestInfo})
684             {
685             # write new IPTCDigest only if it doesn't exist or
686             # is the same as the digest of the original IPTC
687 2         5 my @a; # (capture warning messages)
688 2         57 @a = $et->SetNewValue('Photoshop:IPTCDigest', 'old', Protected => 1, DelValue => 1);
689 2         17 @a = $et->SetNewValue('Photoshop:IPTCDigest', 'new', Protected => 1);
690             }
691 8         97 return '';
692             }
693              
694             #------------------------------------------------------------------------------
695             # Recover strings which were truncated by IPTC dataset length limit
696             # Inputs: 0) IPTC value, 1) XMP value, 2) length limit
697             # Notes: handles the case where IPTC and/or XMP values are lists
698             sub RecoverTruncatedIPTC($$$)
699             {
700 19     19 0 60 my ($iptc, $xmp, $limit) = @_;
701              
702 19 100       184 return $iptc unless defined $xmp;
703 8 50 33     37 if (ref $iptc) {
    50          
704 0 0       0 $xmp = [ $xmp ] unless ref $xmp;
705 0         0 my ($i, @vals);
706 0         0 for ($i=0; $i<@$iptc; ++$i) {
707 0         0 push @vals, RecoverTruncatedIPTC($$iptc[$i], $$xmp[$i], $limit);
708             }
709 0         0 return \@vals;
710             } elsif (defined $iptc and length $iptc == $limit) {
711 0 0       0 $xmp = $$xmp[0] if ref $xmp; # take first element of list
712 0 0 0     0 return $xmp if length $xmp > $limit and $iptc eq substr($xmp, 0, $limit);
713             }
714 8         104 return $iptc;
715             }
716              
717             1; # end
718              
719             __END__