source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/IPTC.pm@ 34921

Last change on this file since 34921 was 34921, checked in by anupama, 3 years ago

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.
File size: 39.5 KB
Line 
1#------------------------------------------------------------------------------
2# File: IPTC.pm
3#
4# Description: Read IPTC meta information
5#
6# Revisions: Jan. 08/2003 - P. Harvey Created
7# Feb. 05/2004 - P. Harvey Added support for records other than 2
8#
9# References: 1) http://www.iptc.org/IIM/
10#------------------------------------------------------------------------------
11
12package Image::ExifTool::IPTC;
13
14use strict;
15use vars qw($VERSION $AUTOLOAD %iptcCharset);
16use Image::ExifTool qw(:DataAccess :Utils);
17
18$VERSION = '1.57';
19
20%iptcCharset = (
21 "\x1b%G" => 'UTF8',
22 # don't translate these (at least until we handle ISO 2022 shift codes)
23 # because the sets are only designated and not invoked
24 # "\x1b,A" => 'Latin', # G0 = ISO 8859-1 (similar to Latin1, but codes 0x80-0x9f are missing)
25 # "\x1b-A" => 'Latin', # G1 "
26 # "\x1b.A" => 'Latin', # G2
27 # "\x1b/A" => 'Latin', # G3
28);
29
30sub ProcessIPTC($$$);
31sub WriteIPTC($$$);
32sub CheckIPTC($$$);
33sub PrintCodedCharset($);
34sub PrintInvCodedCharset($);
35
36# standard IPTC locations
37# (MWG specifies locations only for JPEG, TIFF and PSD -- the rest are ExifTool-defined)
38my %isStandardIPTC = (
39 'JPEG-APP13-Photoshop-IPTC' => 1,
40 'TIFF-IFD0-IPTC' => 1,
41 'PSD-IPTC' => 1,
42 'MIE-IPTC' => 1,
43 'EPS-Photoshop-IPTC' => 1,
44 'PS-Photoshop-IPTC' => 1,
45 'EXV-APP13-Photoshop-IPTC' => 1,
46 # set file types to 0 if they have a standard location
47 JPEG => 0,
48 TIFF => 0,
49 PSD => 0,
50 MIE => 0,
51 EPS => 0,
52 PS => 0,
53 EXV => 0,
54);
55
56my %fileFormat = (
57 0 => 'No ObjectData',
58 1 => 'IPTC-NAA Digital Newsphoto Parameter Record',
59 2 => 'IPTC7901 Recommended Message Format',
60 3 => 'Tagged Image File Format (Adobe/Aldus Image data)',
61 4 => 'Illustrator (Adobe Graphics data)',
62 5 => 'AppleSingle (Apple Computer Inc)',
63 6 => 'NAA 89-3 (ANPA 1312)',
64 7 => 'MacBinary II',
65 8 => 'IPTC Unstructured Character Oriented File Format (UCOFF)',
66 9 => 'United Press International ANPA 1312 variant',
67 10 => 'United Press International Down-Load Message',
68 11 => 'JPEG File Interchange (JFIF)',
69 12 => 'Photo-CD Image-Pac (Eastman Kodak)',
70 13 => 'Bit Mapped Graphics File [.BMP] (Microsoft)',
71 14 => 'Digital Audio File [.WAV] (Microsoft & Creative Labs)',
72 15 => 'Audio plus Moving Video [.AVI] (Microsoft)',
73 16 => 'PC DOS/Windows Executable Files [.COM][.EXE]',
74 17 => 'Compressed Binary File [.ZIP] (PKWare Inc)',
75 18 => 'Audio Interchange File Format AIFF (Apple Computer Inc)',
76 19 => 'RIFF Wave (Microsoft Corporation)',
77 20 => 'Freehand (Macromedia/Aldus)',
78 21 => 'Hypertext Markup Language [.HTML] (The Internet Society)',
79 22 => 'MPEG 2 Audio Layer 2 (Musicom), ISO/IEC',
80 23 => 'MPEG 2 Audio Layer 3, ISO/IEC',
81 24 => 'Portable Document File [.PDF] Adobe',
82 25 => 'News Industry Text Format (NITF)',
83 26 => 'Tape Archive [.TAR]',
84 27 => 'Tidningarnas Telegrambyra NITF version (TTNITF DTD)',
85 28 => 'Ritzaus Bureau NITF version (RBNITF DTD)',
86 29 => 'Corel Draw [.CDR]',
87);
88
89# main IPTC tag table
90# Note: ALL entries in main IPTC table (except PROCESS_PROC) must be SubDirectory
91# entries, each specifying a TagTable.
92%Image::ExifTool::IPTC::Main = (
93 GROUPS => { 2 => 'Image' },
94 PROCESS_PROC => \&ProcessIPTC,
95 WRITE_PROC => \&WriteIPTC,
96 1 => {
97 Name => 'IPTCEnvelope',
98 SubDirectory => {
99 TagTable => 'Image::ExifTool::IPTC::EnvelopeRecord',
100 },
101 },
102 2 => {
103 Name => 'IPTCApplication',
104 SubDirectory => {
105 TagTable => 'Image::ExifTool::IPTC::ApplicationRecord',
106 },
107 },
108 3 => {
109 Name => 'IPTCNewsPhoto',
110 SubDirectory => {
111 TagTable => 'Image::ExifTool::IPTC::NewsPhoto',
112 },
113 },
114 7 => {
115 Name => 'IPTCPreObjectData',
116 SubDirectory => {
117 TagTable => 'Image::ExifTool::IPTC::PreObjectData',
118 },
119 },
120 8 => {
121 Name => 'IPTCObjectData',
122 SubDirectory => {
123 TagTable => 'Image::ExifTool::IPTC::ObjectData',
124 },
125 },
126 9 => {
127 Name => 'IPTCPostObjectData',
128 Groups => { 1 => 'IPTC#' }, #(just so this shows up in group list)
129 SubDirectory => {
130 TagTable => 'Image::ExifTool::IPTC::PostObjectData',
131 },
132 },
133 240 => {
134 Name => 'IPTCFotoStation',
135 SubDirectory => {
136 TagTable => 'Image::ExifTool::IPTC::FotoStation',
137 },
138 },
139);
140
141# Record 1 -- EnvelopeRecord
142%Image::ExifTool::IPTC::EnvelopeRecord = (
143 GROUPS => { 2 => 'Other' },
144 WRITE_PROC => \&WriteIPTC,
145 CHECK_PROC => \&CheckIPTC,
146 WRITABLE => 1,
147 0 => {
148 Name => 'EnvelopeRecordVersion',
149 Format => 'int16u',
150 Mandatory => 1,
151 },
152 5 => {
153 Name => 'Destination',
154 Flags => 'List',
155 Groups => { 2 => 'Location' },
156 Format => 'string[0,1024]',
157 },
158 20 => {
159 Name => 'FileFormat',
160 Groups => { 2 => 'Image' },
161 Format => 'int16u',
162 PrintConv => \%fileFormat,
163 },
164 22 => {
165 Name => 'FileVersion',
166 Groups => { 2 => 'Image' },
167 Format => 'int16u',
168 },
169 30 => {
170 Name => 'ServiceIdentifier',
171 Format => 'string[0,10]',
172 },
173 40 => {
174 Name => 'EnvelopeNumber',
175 Format => 'digits[8]',
176 },
177 50 => {
178 Name => 'ProductID',
179 Flags => 'List',
180 Format => 'string[0,32]',
181 },
182 60 => {
183 Name => 'EnvelopePriority',
184 Format => 'digits[1]',
185 PrintConv => {
186 0 => '0 (reserved)',
187 1 => '1 (most urgent)',
188 2 => 2,
189 3 => 3,
190 4 => 4,
191 5 => '5 (normal urgency)',
192 6 => 6,
193 7 => 7,
194 8 => '8 (least urgent)',
195 9 => '9 (user-defined priority)',
196 },
197 },
198 70 => {
199 Name => 'DateSent',
200 Groups => { 2 => 'Time' },
201 Format => 'digits[8]',
202 Shift => 'Time',
203 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
204 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
205 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
206 },
207 80 => {
208 Name => 'TimeSent',
209 Groups => { 2 => 'Time' },
210 Format => 'string[11]',
211 Shift => 'Time',
212 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
213 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
214 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
215 },
216 90 => {
217 Name => 'CodedCharacterSet',
218 Notes => q{
219 values are entered in the form "ESC X Y[, ...]". The escape sequence for
220 UTF-8 character coding is "ESC % G", but this is displayed as "UTF8" for
221 convenience. Either string may be used when writing. The value of this tag
222 affects the decoding of string values in the Application and NewsPhoto
223 records. This tag is marked as "unsafe" to prevent it from being copied by
224 default in a group operation because existing tags in the destination image
225 may use a different encoding. When creating a new IPTC record from scratch,
226 it is suggested that this be set to "UTF8" if special characters are a
227 possibility
228 },
229 Protected => 1,
230 Format => 'string[0,32]',
231 ValueConvInv => '$val =~ /^UTF-?8$/i ? "\x1b%G" : $val',
232 # convert ISO 2022 escape sequences to a more readable format
233 PrintConv => \&PrintCodedCharset,
234 PrintConvInv => \&PrintInvCodedCharset,
235 },
236 100 => {
237 Name => 'UniqueObjectName',
238 Format => 'string[14,80]',
239 },
240 120 => {
241 Name => 'ARMIdentifier',
242 Format => 'int16u',
243 },
244 122 => {
245 Name => 'ARMVersion',
246 Format => 'int16u',
247 },
248);
249
250# Record 2 -- ApplicationRecord
251%Image::ExifTool::IPTC::ApplicationRecord = (
252 GROUPS => { 2 => 'Other' },
253 WRITE_PROC => \&WriteIPTC,
254 CHECK_PROC => \&CheckIPTC,
255 WRITABLE => 1,
256 0 => {
257 Name => 'ApplicationRecordVersion',
258 Format => 'int16u',
259 Mandatory => 1,
260 },
261 3 => {
262 Name => 'ObjectTypeReference',
263 Format => 'string[3,67]',
264 },
265 4 => {
266 Name => 'ObjectAttributeReference',
267 Flags => 'List',
268 Format => 'string[4,68]',
269 },
270 5 => {
271 Name => 'ObjectName',
272 Format => 'string[0,64]',
273 },
274 7 => {
275 Name => 'EditStatus',
276 Format => 'string[0,64]',
277 },
278 8 => {
279 Name => 'EditorialUpdate',
280 Format => 'digits[2]',
281 PrintConv => {
282 '01' => 'Additional language',
283 },
284 },
285 10 => {
286 Name => 'Urgency',
287 Format => 'digits[1]',
288 PrintConv => {
289 0 => '0 (reserved)',
290 1 => '1 (most urgent)',
291 2 => 2,
292 3 => 3,
293 4 => 4,
294 5 => '5 (normal urgency)',
295 6 => 6,
296 7 => 7,
297 8 => '8 (least urgent)',
298 9 => '9 (user-defined priority)',
299 },
300 },
301 12 => {
302 Name => 'SubjectReference',
303 Flags => 'List',
304 Format => 'string[13,236]',
305 },
306 15 => {
307 Name => 'Category',
308 Format => 'string[0,3]',
309 },
310 20 => {
311 Name => 'SupplementalCategories',
312 Flags => 'List',
313 Format => 'string[0,32]',
314 },
315 22 => {
316 Name => 'FixtureIdentifier',
317 Format => 'string[0,32]',
318 },
319 25 => {
320 Name => 'Keywords',
321 Flags => 'List',
322 Format => 'string[0,64]',
323 },
324 26 => {
325 Name => 'ContentLocationCode',
326 Flags => 'List',
327 Groups => { 2 => 'Location' },
328 Format => 'string[3]',
329 },
330 27 => {
331 Name => 'ContentLocationName',
332 Flags => 'List',
333 Groups => { 2 => 'Location' },
334 Format => 'string[0,64]',
335 },
336 30 => {
337 Name => 'ReleaseDate',
338 Groups => { 2 => 'Time' },
339 Format => 'digits[8]',
340 Shift => 'Time',
341 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
342 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
343 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
344 },
345 35 => {
346 Name => 'ReleaseTime',
347 Groups => { 2 => 'Time' },
348 Format => 'string[11]',
349 Shift => 'Time',
350 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
351 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
352 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
353 },
354 37 => {
355 Name => 'ExpirationDate',
356 Groups => { 2 => 'Time' },
357 Format => 'digits[8]',
358 Shift => 'Time',
359 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
360 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
361 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
362 },
363 38 => {
364 Name => 'ExpirationTime',
365 Groups => { 2 => 'Time' },
366 Format => 'string[11]',
367 Shift => 'Time',
368 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
369 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
370 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
371 },
372 40 => {
373 Name => 'SpecialInstructions',
374 Format => 'string[0,256]',
375 },
376 42 => {
377 Name => 'ActionAdvised',
378 Format => 'digits[2]',
379 PrintConv => {
380 '' => '',
381 '01' => 'Object Kill',
382 '02' => 'Object Replace',
383 '03' => 'Object Append',
384 '04' => 'Object Reference',
385 },
386 },
387 45 => {
388 Name => 'ReferenceService',
389 Flags => 'List',
390 Format => 'string[0,10]',
391 },
392 47 => {
393 Name => 'ReferenceDate',
394 Groups => { 2 => 'Time' },
395 Flags => 'List',
396 Format => 'digits[8]',
397 Shift => 'Time',
398 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
399 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
400 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
401 },
402 50 => {
403 Name => 'ReferenceNumber',
404 Flags => 'List',
405 Format => 'digits[8]',
406 },
407 55 => {
408 Name => 'DateCreated',
409 Groups => { 2 => 'Time' },
410 Format => 'digits[8]',
411 Shift => 'Time',
412 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
413 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
414 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
415 },
416 60 => {
417 Name => 'TimeCreated',
418 Groups => { 2 => 'Time' },
419 Format => 'string[11]',
420 Shift => 'Time',
421 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
422 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
423 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
424 },
425 62 => {
426 Name => 'DigitalCreationDate',
427 Groups => { 2 => 'Time' },
428 Format => 'digits[8]',
429 Shift => 'Time',
430 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
431 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
432 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
433 },
434 63 => {
435 Name => 'DigitalCreationTime',
436 Groups => { 2 => 'Time' },
437 Format => 'string[11]',
438 Shift => 'Time',
439 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
440 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
441 PrintConvInv => 'Image::ExifTool::IPTC::InverseDateOrTime($self,$val)',
442 },
443 65 => {
444 Name => 'OriginatingProgram',
445 Format => 'string[0,32]',
446 },
447 70 => {
448 Name => 'ProgramVersion',
449 Format => 'string[0,10]',
450 },
451 75 => {
452 Name => 'ObjectCycle',
453 Format => 'string[1]',
454 PrintConv => {
455 'a' => 'Morning',
456 'p' => 'Evening',
457 'b' => 'Both Morning and Evening',
458 },
459 },
460 80 => {
461 Name => 'By-line',
462 Flags => 'List',
463 Format => 'string[0,32]',
464 Groups => { 2 => 'Author' },
465 },
466 85 => {
467 Name => 'By-lineTitle',
468 Flags => 'List',
469 Format => 'string[0,32]',
470 Groups => { 2 => 'Author' },
471 },
472 90 => {
473 Name => 'City',
474 Format => 'string[0,32]',
475 Groups => { 2 => 'Location' },
476 },
477 92 => {
478 Name => 'Sub-location',
479 Format => 'string[0,32]',
480 Groups => { 2 => 'Location' },
481 },
482 95 => {
483 Name => 'Province-State',
484 Format => 'string[0,32]',
485 Groups => { 2 => 'Location' },
486 },
487 100 => {
488 Name => 'Country-PrimaryLocationCode',
489 Format => 'string[3]',
490 Groups => { 2 => 'Location' },
491 },
492 101 => {
493 Name => 'Country-PrimaryLocationName',
494 Format => 'string[0,64]',
495 Groups => { 2 => 'Location' },
496 },
497 103 => {
498 Name => 'OriginalTransmissionReference',
499 Format => 'string[0,32]',
500 Notes => 'now used as a job identifier',
501 },
502 105 => {
503 Name => 'Headline',
504 Format => 'string[0,256]',
505 },
506 110 => {
507 Name => 'Credit',
508 Groups => { 2 => 'Author' },
509 Format => 'string[0,32]',
510 },
511 115 => {
512 Name => 'Source',
513 Groups => { 2 => 'Author' },
514 Format => 'string[0,32]',
515 },
516 116 => {
517 Name => 'CopyrightNotice',
518 Groups => { 2 => 'Author' },
519 Format => 'string[0,128]',
520 },
521 118 => {
522 Name => 'Contact',
523 Flags => 'List',
524 Groups => { 2 => 'Author' },
525 Format => 'string[0,128]',
526 },
527 120 => {
528 Name => 'Caption-Abstract',
529 Format => 'string[0,2000]',
530 },
531 121 => {
532 Name => 'LocalCaption',
533 Format => 'string[0,256]', # (guess)
534 Notes => q{
535 I haven't found a reference for the format of tags 121, 184-188 and
536 225-232, so I have just make them writable as strings with
537 reasonable length. Beware that if this is wrong, other utilities
538 may not be able to read these tags as written by ExifTool
539 },
540 },
541 122 => {
542 Name => 'Writer-Editor',
543 Flags => 'List',
544 Groups => { 2 => 'Author' },
545 Format => 'string[0,32]',
546 },
547 125 => {
548 Name => 'RasterizedCaption',
549 Format => 'undef[7360]',
550 Binary => 1,
551 },
552 130 => {
553 Name => 'ImageType',
554 Groups => { 2 => 'Image' },
555 Format => 'string[2]',
556 },
557 131 => {
558 Name => 'ImageOrientation',
559 Groups => { 2 => 'Image' },
560 Format => 'string[1]',
561 PrintConv => {
562 P => 'Portrait',
563 L => 'Landscape',
564 S => 'Square',
565 },
566 },
567 135 => {
568 Name => 'LanguageIdentifier',
569 Format => 'string[2,3]',
570 },
571 150 => {
572 Name => 'AudioType',
573 Format => 'string[2]',
574 PrintConv => {
575 '1A' => 'Mono Actuality',
576 '2A' => 'Stereo Actuality',
577 '1C' => 'Mono Question and Answer Session',
578 '2C' => 'Stereo Question and Answer Session',
579 '1M' => 'Mono Music',
580 '2M' => 'Stereo Music',
581 '1Q' => 'Mono Response to a Question',
582 '2Q' => 'Stereo Response to a Question',
583 '1R' => 'Mono Raw Sound',
584 '2R' => 'Stereo Raw Sound',
585 '1S' => 'Mono Scener',
586 '2S' => 'Stereo Scener',
587 '0T' => 'Text Only',
588 '1V' => 'Mono Voicer',
589 '2V' => 'Stereo Voicer',
590 '1W' => 'Mono Wrap',
591 '2W' => 'Stereo Wrap',
592 },
593 },
594 151 => {
595 Name => 'AudioSamplingRate',
596 Format => 'digits[6]',
597 },
598 152 => {
599 Name => 'AudioSamplingResolution',
600 Format => 'digits[2]',
601 },
602 153 => {
603 Name => 'AudioDuration',
604 Format => 'digits[6]',
605 },
606 154 => {
607 Name => 'AudioOutcue',
608 Format => 'string[0,64]',
609 },
610 184 => {
611 Name => 'JobID',
612 Format => 'string[0,64]', # (guess)
613 },
614 185 => {
615 Name => 'MasterDocumentID',
616 Format => 'string[0,256]', # (guess)
617 },
618 186 => {
619 Name => 'ShortDocumentID',
620 Format => 'string[0,64]', # (guess)
621 },
622 187 => {
623 Name => 'UniqueDocumentID',
624 Format => 'string[0,128]', # (guess)
625 },
626 188 => {
627 Name => 'OwnerID',
628 Format => 'string[0,128]', # (guess)
629 },
630 200 => {
631 Name => 'ObjectPreviewFileFormat',
632 Groups => { 2 => 'Image' },
633 Format => 'int16u',
634 PrintConv => \%fileFormat,
635 },
636 201 => {
637 Name => 'ObjectPreviewFileVersion',
638 Groups => { 2 => 'Image' },
639 Format => 'int16u',
640 },
641 202 => {
642 Name => 'ObjectPreviewData',
643 Groups => { 2 => 'Preview' },
644 Format => 'undef[0,256000]',
645 Binary => 1,
646 },
647 221 => {
648 Name => 'Prefs',
649 Groups => { 2 => 'Image' },
650 Format => 'string[0,64]',
651 Notes => 'PhotoMechanic preferences',
652 PrintConv => q{
653 $val =~ s[\s*(\d+):\s*(\d+):\s*(\d+):\s*(\S*)]
654 [Tagged:$1, ColorClass:$2, Rating:$3, FrameNum:$4];
655 return $val;
656 },
657 PrintConvInv => q{
658 $val =~ s[Tagged:\s*(\d+).*ColorClass:\s*(\d+).*Rating:\s*(\d+).*FrameNum:\s*(\S*)]
659 [$1:$2:$3:$4]is;
660 return $val;
661 },
662 },
663 225 => {
664 Name => 'ClassifyState',
665 Format => 'string[0,64]', # (guess)
666 },
667 228 => {
668 Name => 'SimilarityIndex',
669 Format => 'string[0,32]', # (guess)
670 },
671 230 => {
672 Name => 'DocumentNotes',
673 Format => 'string[0,1024]', # (guess)
674 },
675 231 => {
676 Name => 'DocumentHistory',
677 Format => 'string[0,256]', # (guess)
678 ValueConv => '$val =~ s/\0+/\n/g; $val', # (have seen embedded nulls)
679 ValueConvInv => '$val',
680 },
681 232 => {
682 Name => 'ExifCameraInfo',
683 Format => 'string[0,4096]', # (guess)
684 },
685 255 => { #PH
686 Name => 'CatalogSets',
687 List => 1,
688 Format => 'string[0,256]', # (guess)
689 Notes => 'written by iView MediaPro',
690 },
691);
692
693# Record 3 -- News photo
694%Image::ExifTool::IPTC::NewsPhoto = (
695 GROUPS => { 2 => 'Image' },
696 WRITE_PROC => \&WriteIPTC,
697 CHECK_PROC => \&CheckIPTC,
698 WRITABLE => 1,
699 0 => {
700 Name => 'NewsPhotoVersion',
701 Format => 'int16u',
702 Mandatory => 1,
703 },
704 10 => {
705 Name => 'IPTCPictureNumber',
706 Format => 'string[16]',
707 Notes => '4 numbers: 1-Manufacturer ID, 2-Equipment ID, 3-Date, 4-Sequence',
708 PrintConv => 'Image::ExifTool::IPTC::ConvertPictureNumber($val)',
709 PrintConvInv => 'Image::ExifTool::IPTC::InvConvertPictureNumber($val)',
710 },
711 20 => {
712 Name => 'IPTCImageWidth',
713 Format => 'int16u',
714 },
715 30 => {
716 Name => 'IPTCImageHeight',
717 Format => 'int16u',
718 },
719 40 => {
720 Name => 'IPTCPixelWidth',
721 Format => 'int16u',
722 },
723 50 => {
724 Name => 'IPTCPixelHeight',
725 Format => 'int16u',
726 },
727 55 => {
728 Name => 'SupplementalType',
729 Format => 'int8u',
730 PrintConv => {
731 0 => 'Main Image',
732 1 => 'Reduced Resolution Image',
733 2 => 'Logo',
734 3 => 'Rasterized Caption',
735 },
736 },
737 60 => {
738 Name => 'ColorRepresentation',
739 Format => 'int16u',
740 PrintHex => 1,
741 PrintConv => {
742 0x000 => 'No Image, Single Frame',
743 0x100 => 'Monochrome, Single Frame',
744 0x300 => '3 Components, Single Frame',
745 0x301 => '3 Components, Frame Sequential in Multiple Objects',
746 0x302 => '3 Components, Frame Sequential in One Object',
747 0x303 => '3 Components, Line Sequential',
748 0x304 => '3 Components, Pixel Sequential',
749 0x305 => '3 Components, Special Interleaving',
750 0x400 => '4 Components, Single Frame',
751 0x401 => '4 Components, Frame Sequential in Multiple Objects',
752 0x402 => '4 Components, Frame Sequential in One Object',
753 0x403 => '4 Components, Line Sequential',
754 0x404 => '4 Components, Pixel Sequential',
755 0x405 => '4 Components, Special Interleaving',
756 },
757 },
758 64 => {
759 Name => 'InterchangeColorSpace',
760 Format => 'int8u',
761 PrintConv => {
762 1 => 'X,Y,Z CIE',
763 2 => 'RGB SMPTE',
764 3 => 'Y,U,V (K) (D65)',
765 4 => 'RGB Device Dependent',
766 5 => 'CMY (K) Device Dependent',
767 6 => 'Lab (K) CIE',
768 7 => 'YCbCr',
769 8 => 'sRGB',
770 },
771 },
772 65 => {
773 Name => 'ColorSequence',
774 Format => 'int8u',
775 },
776 66 => {
777 Name => 'ICC_Profile',
778 # ...could add SubDirectory support to read into this (if anybody cares)
779 Writable => 0,
780 Binary => 1,
781 },
782 70 => {
783 Name => 'ColorCalibrationMatrix',
784 Writable => 0,
785 Binary => 1,
786 },
787 80 => {
788 Name => 'LookupTable',
789 Writable => 0,
790 Binary => 1,
791 },
792 84 => {
793 Name => 'NumIndexEntries',
794 Format => 'int16u',
795 },
796 85 => {
797 Name => 'ColorPalette',
798 Writable => 0,
799 Binary => 1,
800 },
801 86 => {
802 Name => 'IPTCBitsPerSample',
803 Format => 'int8u',
804 },
805 90 => {
806 Name => 'SampleStructure',
807 Format => 'int8u',
808 PrintConv => {
809 0 => 'OrthogonalConstangSampling',
810 1 => 'Orthogonal4-2-2Sampling',
811 2 => 'CompressionDependent',
812 },
813 },
814 100 => {
815 Name => 'ScanningDirection',
816 Format => 'int8u',
817 PrintConv => {
818 0 => 'L-R, Top-Bottom',
819 1 => 'R-L, Top-Bottom',
820 2 => 'L-R, Bottom-Top',
821 3 => 'R-L, Bottom-Top',
822 4 => 'Top-Bottom, L-R',
823 5 => 'Bottom-Top, L-R',
824 6 => 'Top-Bottom, R-L',
825 7 => 'Bottom-Top, R-L',
826 },
827 },
828 102 => {
829 Name => 'IPTCImageRotation',
830 Format => 'int8u',
831 PrintConv => {
832 0 => 0,
833 1 => 90,
834 2 => 180,
835 3 => 270,
836 },
837 },
838 110 => {
839 Name => 'DataCompressionMethod',
840 Format => 'int32u',
841 },
842 120 => {
843 Name => 'QuantizationMethod',
844 Format => 'int8u',
845 PrintConv => {
846 0 => 'Linear Reflectance/Transmittance',
847 1 => 'Linear Density',
848 2 => 'IPTC Ref B',
849 3 => 'Linear Dot Percent',
850 4 => 'AP Domestic Analogue',
851 5 => 'Compression Method Specific',
852 6 => 'Color Space Specific',
853 7 => 'Gamma Compensated',
854 },
855 },
856 125 => {
857 Name => 'EndPoints',
858 Writable => 0,
859 Binary => 1,
860 },
861 130 => {
862 Name => 'ExcursionTolerance',
863 Format => 'int8u',
864 PrintConv => {
865 0 => 'Not Allowed',
866 1 => 'Allowed',
867 },
868 },
869 135 => {
870 Name => 'BitsPerComponent',
871 Format => 'int8u',
872 },
873 140 => {
874 Name => 'MaximumDensityRange',
875 Format => 'int16u',
876 },
877 145 => {
878 Name => 'GammaCompensatedValue',
879 Format => 'int16u',
880 },
881);
882
883# Record 7 -- Pre-object Data
884%Image::ExifTool::IPTC::PreObjectData = (
885 # (not actually writable, but used in BuildTagLookup to recognize IPTC tables)
886 WRITE_PROC => \&WriteIPTC,
887 10 => {
888 Name => 'SizeMode',
889 Format => 'int8u',
890 PrintConv => {
891 0 => 'Size Not Known',
892 1 => 'Size Known',
893 },
894 },
895 20 => {
896 Name => 'MaxSubfileSize',
897 Format => 'int32u',
898 },
899 90 => {
900 Name => 'ObjectSizeAnnounced',
901 Format => 'int32u',
902 },
903 95 => {
904 Name => 'MaximumObjectSize',
905 Format => 'int32u',
906 },
907);
908
909# Record 8 -- ObjectData
910%Image::ExifTool::IPTC::ObjectData = (
911 WRITE_PROC => \&WriteIPTC,
912 10 => {
913 Name => 'SubFile',
914 Flags => 'List',
915 Binary => 1,
916 },
917);
918
919# Record 9 -- PostObjectData
920%Image::ExifTool::IPTC::PostObjectData = (
921 WRITE_PROC => \&WriteIPTC,
922 10 => {
923 Name => 'ConfirmedObjectSize',
924 Format => 'int32u',
925 },
926);
927
928# Record 240 -- FotoStation proprietary data (ref PH)
929%Image::ExifTool::IPTC::FotoStation = (
930 GROUPS => { 2 => 'Other' },
931 WRITE_PROC => \&WriteIPTC,
932 CHECK_PROC => \&CheckIPTC,
933 WRITABLE => 1,
934);
935
936# IPTC Composite tags
937%Image::ExifTool::IPTC::Composite = (
938 GROUPS => { 2 => 'Image' },
939 DateTimeCreated => {
940 Description => 'Date/Time Created',
941 Groups => { 2 => 'Time' },
942 Require => {
943 0 => 'IPTC:DateCreated',
944 1 => 'IPTC:TimeCreated',
945 },
946 ValueConv => '"$val[0] $val[1]"',
947 PrintConv => '$self->ConvertDateTime($val)',
948 },
949 DigitalCreationDateTime => {
950 Description => 'Digital Creation Date/Time',
951 Groups => { 2 => 'Time' },
952 Require => {
953 0 => 'IPTC:DigitalCreationDate',
954 1 => 'IPTC:DigitalCreationTime',
955 },
956 ValueConv => '"$val[0] $val[1]"',
957 PrintConv => '$self->ConvertDateTime($val)',
958 },
959);
960
961# add our composite tags
962Image::ExifTool::AddCompositeTags('Image::ExifTool::IPTC');
963
964
965#------------------------------------------------------------------------------
966# AutoLoad our writer routines when necessary
967#
968sub AUTOLOAD
969{
970 return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
971}
972
973#------------------------------------------------------------------------------
974# Print conversion for CodedCharacterSet
975# Inputs: 0) value
976sub PrintCodedCharset($)
977{
978 my $val = shift;
979 return $iptcCharset{$val} if $iptcCharset{$val};
980 $val =~ s/(.)/ $1/g;
981 $val =~ s/ \x1b/, ESC/g;
982 $val =~ s/^,? //;
983 return $val;
984}
985
986#------------------------------------------------------------------------------
987# Handle CodedCharacterSet
988# Inputs: 0) ExifTool ref, 1) CodedCharacterSet value
989# Returns: IPTC character set if translation required (or 'bad' if unknown)
990sub HandleCodedCharset($$)
991{
992 my ($et, $val) = @_;
993 my $xlat = $iptcCharset{$val};
994 unless ($xlat) {
995 if ($val =~ /^\x1b\x25/) {
996 # some unknown character set invoked
997 $xlat = 'bad'; # flag unsupported coding
998 } else {
999 $xlat = $et->Options('CharsetIPTC');
1000 }
1001 }
1002 # no need to translate if Charset is the same
1003 undef $xlat if $xlat eq $et->Options('Charset');
1004 return $xlat;
1005}
1006
1007#------------------------------------------------------------------------------
1008# Encode or decode coded string
1009# Inputs: 0) ExifTool ref, 1) value ptr, 2) IPTC charset (or 'bad') ref
1010# 3) flag set to decode (read) value from IPTC
1011# Updates value on return
1012sub TranslateCodedString($$$$)
1013{
1014 my ($et, $valPtr, $xlatPtr, $read) = @_;
1015 if ($$xlatPtr eq 'bad') {
1016 $et->Warn('Some IPTC characters not converted (unsupported CodedCharacterSet)');
1017 undef $$xlatPtr;
1018 } elsif (not $read) {
1019 $$valPtr = $et->Decode($$valPtr, undef, undef, $$xlatPtr);
1020 } elsif ($$valPtr !~ /[\x14\x15\x1b]/) {
1021 $$valPtr = $et->Decode($$valPtr, $$xlatPtr);
1022 } else {
1023 # don't yet support reading ISO 2022 shifted character sets
1024 $et->WarnOnce('Some IPTC characters not converted (ISO 2022 shifting not supported)');
1025 }
1026}
1027
1028#------------------------------------------------------------------------------
1029# Is this IPTC in a standard location?
1030# Inputs: 0) Current metadata path string
1031# Returns: true if path is standard, 0 if file type doesn't have standard IPTC,
1032# or undef if IPTC is non-standard
1033sub IsStandardIPTC($)
1034{
1035 my $path = shift;
1036 return 1 if $isStandardIPTC{$path};
1037 return 0 unless $path =~ /^(\w+)/ and defined $isStandardIPTC{$1};
1038 return undef; # non-standard
1039}
1040
1041#------------------------------------------------------------------------------
1042# get IPTC info
1043# Inputs: 0) ExifTool object reference, 1) dirInfo reference
1044# 2) reference to tag table
1045# Returns: 1 on success, 0 otherwise
1046sub ProcessIPTC($$$)
1047{
1048 my ($et, $dirInfo, $tagTablePtr) = @_;
1049 my $dataPt = $$dirInfo{DataPt};
1050 my $pos = $$dirInfo{DirStart} || 0;
1051 my $dirLen = $$dirInfo{DirLen} || 0;
1052 my $dirEnd = $pos + $dirLen;
1053 my $verbose = $et->Options('Verbose');
1054 my $validate = $et->Options('Validate');
1055 my $success = 0;
1056 my ($lastRec, $recordPtr, $recordName);
1057
1058 $verbose and $dirInfo and $et->VerboseDir('IPTC', 0, $$dirInfo{DirLen});
1059
1060 if ($tagTablePtr eq \%Image::ExifTool::IPTC::Main) {
1061 my $path = $et->MetadataPath();
1062 my $isStd = IsStandardIPTC($path);
1063 if (defined $isStd and not $$et{DIR_COUNT}{STD_IPTC}) {
1064 # set flag to ensure we only have one family 1 "IPTC" group
1065 $$et{DIR_COUNT}{STD_IPTC} = 1;
1066 # calculate MD5 if Digest::MD5 is available (truly standard IPTC only)
1067 if ($isStd) {
1068 my $md5;
1069 if (eval { require Digest::MD5 }) {
1070 if ($pos or $dirLen != length($$dataPt)) {
1071 $md5 = Digest::MD5::md5(substr $$dataPt, $pos, $dirLen);
1072 } else {
1073 $md5 = Digest::MD5::md5($$dataPt);
1074 }
1075 } else {
1076 # a zero digest indicates IPTC exists but we don't have Digest::MD5
1077 $md5 = "\0" x 16;
1078 }
1079 $et->FoundTag('CurrentIPTCDigest', $md5);
1080 }
1081 } else {
1082 if (($Image::ExifTool::MWG::strict or $et->Options('Validate')) and
1083 $$et{FILE_TYPE} =~ /^(JPEG|TIFF|PSD)$/)
1084 {
1085 if ($Image::ExifTool::MWG::strict) {
1086 # ignore non-standard IPTC while in strict MWG compatibility mode
1087 $et->Warn("Ignored non-standard IPTC at $path");
1088 return 1;
1089 } else {
1090 $et->Warn("Non-standard IPTC at $path", 1);
1091 }
1092 }
1093 # extract non-standard IPTC
1094 my $count = ($$et{DIR_COUNT}{IPTC} || 0) + 1; # count non-standard IPTC
1095 $$et{DIR_COUNT}{IPTC} = $count;
1096 $$et{LOW_PRIORITY_DIR}{IPTC} = 1; # lower priority of non-standard IPTC
1097 $$et{SET_GROUP1} = '+' . ($count + 1); # add number to family 1 group name
1098 }
1099 }
1100 # begin by assuming default IPTC encoding
1101 my $xlat = $et->Options('CharsetIPTC');
1102 undef $xlat if $xlat eq $et->Options('Charset');
1103
1104 # quick check for improperly byte-swapped IPTC
1105 if ($dirLen >= 4 and substr($$dataPt, $pos, 1) ne "\x1c" and
1106 substr($$dataPt, $pos + 3, 1) eq "\x1c")
1107 {
1108 $et->Warn('IPTC data was improperly byte-swapped');
1109 my $newData = pack('N*', unpack('V*', substr($$dataPt, $pos, $dirLen) . "\0\0\0"));
1110 $dataPt = \$newData;
1111 $pos = 0;
1112 $dirEnd = $pos + $dirLen;
1113 # NOTE: MUST NOT access $dirInfo DataPt, DirStart or DataLen after this!
1114 }
1115 # extract IPTC as a block if specified
1116 if ($$et{REQ_TAG_LOOKUP}{iptc} or ($$et{TAGS_FROM_FILE} and
1117 not $$et{EXCL_TAG_LOOKUP}{iptc}))
1118 {
1119 if ($pos or $dirLen != length($$dataPt)) {
1120 $et->FoundTag('IPTC', substr($$dataPt, $pos, $dirLen));
1121 } else {
1122 $et->FoundTag('IPTC', $$dataPt);
1123 }
1124 }
1125 while ($pos + 5 <= $dirEnd) {
1126 my $buff = substr($$dataPt, $pos, 5);
1127 my ($id, $rec, $tag, $len) = unpack("CCCn", $buff);
1128 unless ($id == 0x1c) {
1129 unless ($id) {
1130 # scan the rest of the data an give warning unless all zeros
1131 # (iMatch pads the IPTC block with nulls for some reason)
1132 my $remaining = substr($$dataPt, $pos, $dirEnd - $pos);
1133 last unless $remaining =~ /[^\0]/;
1134 }
1135 $et->Warn(sprintf('Bad IPTC data tag (marker 0x%x)',$id));
1136 last;
1137 }
1138 $pos += 5; # step to after field header
1139 # handle extended IPTC entry if necessary
1140 if ($len & 0x8000) {
1141 my $n = $len & 0x7fff; # get num bytes in length field
1142 if ($pos + $n > $dirEnd or $n > 8) {
1143 $et->VPrint(0, "Invalid extended IPTC entry (dataset $rec:$tag, len $len)\n");
1144 $success = 0;
1145 last;
1146 }
1147 # determine length (a big-endian, variable sized int)
1148 for ($len = 0; $n; ++$pos, --$n) {
1149 $len = $len * 256 + ord(substr($$dataPt, $pos, 1));
1150 }
1151 }
1152 if ($pos + $len > $dirEnd) {
1153 $et->VPrint(0, "Invalid IPTC entry (dataset $rec:$tag, len $len)\n");
1154 $success = 0;
1155 last;
1156 }
1157 if (not defined $lastRec or $lastRec != $rec) {
1158 if ($validate and defined $lastRec and $rec < $lastRec) {
1159 $et->Warn("IPTC doesn't conform to spec: Records out of sequence",1)
1160 }
1161 my $tableInfo = $tagTablePtr->{$rec};
1162 unless ($tableInfo) {
1163 $et->WarnOnce("Unrecognized IPTC record $rec (ignored)");
1164 $pos += $len;
1165 next; # ignore this entry
1166 }
1167 my $tableName = $tableInfo->{SubDirectory}->{TagTable};
1168 unless ($tableName) {
1169 $et->Warn("No table for IPTC record $rec!");
1170 last; # this shouldn't happen
1171 }
1172 $recordName = $$tableInfo{Name};
1173 $recordPtr = Image::ExifTool::GetTagTable($tableName);
1174 $et->VPrint(0,$$et{INDENT},"-- $recordName record --\n");
1175 $lastRec = $rec;
1176 }
1177 my $val = substr($$dataPt, $pos, $len);
1178
1179 # add tagInfo for all unknown tags:
1180 unless ($$recordPtr{$tag}) {
1181 # - no Format so format is auto-detected
1182 # - no Name so name is generated automatically with decimal tag number
1183 AddTagToTable($recordPtr, $tag, { Unknown => 1 });
1184 }
1185
1186 my $tagInfo = $et->GetTagInfo($recordPtr, $tag);
1187 my $format;
1188 # (could use $$recordPtr{FORMAT} if no Format below, but don't do this to
1189 # be backward compatible with improperly written PhotoMechanic tags)
1190 $format = $$tagInfo{Format} if $tagInfo;
1191 if (not $format) {
1192 # guess at "int" format if not specified
1193 $format = 'int' if $len <= 4 and $len != 3 and $val =~ /[\0-\x08]/;
1194 } elsif ($validate) {
1195 my ($fmt,$min,$max);
1196 if ($format =~ /(.*)\[(\d+)(,(\d+))?\]/) {
1197 $fmt = $1;
1198 $min = $2;
1199 $max = $4 || $2;
1200 } else {
1201 $fmt = $format;
1202 $min = $max = 1;
1203 }
1204 my $siz = Image::ExifTool::FormatSize($fmt) || 1;
1205 $min *= $siz; $max *= $siz;
1206 if ($len < $min or $len > $max) {
1207 my $should = ($min == $max) ? $min : ($len < $min ? "$min min" : "$max max");
1208 my $what = ($len < $siz * $min) ? 'short' : 'long';
1209 $et->Warn("IPTC $$tagInfo{Name} too $what ($len bytes; should be $should)", 1);
1210 }
1211 }
1212 if ($format) {
1213 if ($format =~ /^int/) {
1214 if ($len <= 8) { # limit integer conversion to 8 bytes long
1215 $val = 0;
1216 my $i;
1217 for ($i=0; $i<$len; ++$i) {
1218 $val = $val * 256 + ord(substr($$dataPt, $pos+$i, 1));
1219 }
1220 }
1221 } elsif ($format =~ /^string/) {
1222 # some braindead softwares add null terminators
1223 if ($val =~ s/\0+$// and $validate) {
1224 $et->Warn("IPTC $$tagInfo{Name} improperly terminated", 1);
1225 }
1226 if ($rec == 1) {
1227 # handle CodedCharacterSet tag
1228 $xlat = HandleCodedCharset($et, $val) if $tag == 90;
1229 # translate characters if necessary and special characters exist
1230 } elsif ($xlat and $rec < 7 and $val =~ /[\x80-\xff]/) {
1231 # translate to specified character set
1232 TranslateCodedString($et, \$val, \$xlat, 1);
1233 }
1234 } elsif ($format =~ /^digits/) {
1235 if ($val =~ s/\0+$// and $validate) {
1236 $et->Warn("IPTC $$tagInfo{Name} improperly terminated", 1);
1237 }
1238 } elsif ($format !~ /^undef/) {
1239 warn("Invalid IPTC format: $format"); # (this would be a programming error)
1240 }
1241 }
1242 $verbose and $et->VerboseInfo($tag, $tagInfo,
1243 Table => $tagTablePtr,
1244 Value => $val,
1245 DataPt => $dataPt,
1246 DataPos => $$dirInfo{DataPos},
1247 Size => $len,
1248 Start => $pos,
1249 Extra => ", $recordName record",
1250 Format => $format,
1251 );
1252 $et->FoundTag($tagInfo, $val) if $tagInfo;
1253 $success = 1;
1254
1255 $pos += $len; # increment to next field
1256 }
1257 delete $$et{SET_GROUP1};
1258 delete $$et{LOW_PRIORITY_DIR}{IPTC};
1259 return $success;
1260}
1261
12621; # end
1263
1264
1265__END__
1266
1267=head1 NAME
1268
1269Image::ExifTool::IPTC - Read IPTC meta information
1270
1271=head1 SYNOPSIS
1272
1273This module is loaded automatically by Image::ExifTool when required.
1274
1275=head1 DESCRIPTION
1276
1277This module contains definitions required by Image::ExifTool to interpret
1278IPTC (International Press Telecommunications Council) meta information in
1279image files.
1280
1281=head1 AUTHOR
1282
1283Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
1284
1285This library is free software; you can redistribute it and/or modify it
1286under the same terms as Perl itself.
1287
1288=head1 REFERENCES
1289
1290=over 4
1291
1292=item L<http://www.iptc.org/IIM/>
1293
1294=back
1295
1296=head1 SEE ALSO
1297
1298L<Image::ExifTool::TagNames/IPTC Tags>,
1299L<Image::ExifTool(3pm)|Image::ExifTool>
1300
1301=cut
Note: See TracBrowser for help on using the repository browser.