source: gsdl/trunk/perllib/cpan/Image/ExifTool/IPTC.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 32.3 KB
Line 
1#------------------------------------------------------------------------------
2# File: IPTC.pm
3#
4# Description: Read IPTC meta information
5#
6# Revisions: Jan. 08/03 - P. Harvey Created
7# Feb. 05/04 - 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);
16
17$VERSION = '1.23';
18
19%iptcCharset = (
20 "\x1b%G" => 'UTF8',
21 # don't translate these (at least until we handle ISO 2022 shift codes)
22 # because the sets are only designated and not invoked
23 # "\x1b,A" => 'Latin', # G0 = ISO 8859-1 (similar to Latin1, but codes 0x80-0x9f are missing)
24 # "\x1b-A" => 'Latin', # G1 "
25 # "\x1b.A" => 'Latin', # G2
26 # "\x1b/A" => 'Latin', # G3
27);
28
29sub ProcessIPTC($$$);
30sub WriteIPTC($$$);
31sub CheckIPTC($$$);
32sub PrintCodedCharset($);
33sub PrintInvCodedCharset($);
34
35my %fileFormat = (
36 0 => 'No ObjectData',
37 1 => 'IPTC-NAA Digital Newsphoto Parameter Record',
38 2 => 'IPTC7901 Recommended Message Format',
39 3 => 'Tagged Image File Format (Adobe/Aldus Image data)',
40 4 => 'Illustrator (Adobe Graphics data)',
41 5 => 'AppleSingle (Apple Computer Inc)',
42 6 => 'NAA 89-3 (ANPA 1312)',
43 7 => 'MacBinary II',
44 8 => 'IPTC Unstructured Character Oriented File Format (UCOFF)',
45 9 => 'United Press International ANPA 1312 variant',
46 10 => 'United Press International Down-Load Message',
47 11 => 'JPEG File Interchange (JFIF)',
48 12 => 'Photo-CD Image-Pac (Eastman Kodak)',
49 13 => 'Bit Mapped Graphics File [.BMP] (Microsoft)',
50 14 => 'Digital Audio File [.WAV] (Microsoft & Creative Labs)',
51 15 => 'Audio plus Moving Video [.AVI] (Microsoft)',
52 16 => 'PC DOS/Windows Executable Files [.COM][.EXE]',
53 17 => 'Compressed Binary File [.ZIP] (PKWare Inc)',
54 18 => 'Audio Interchange File Format AIFF (Apple Computer Inc)',
55 19 => 'RIFF Wave (Microsoft Corporation)',
56 20 => 'Freehand (Macromedia/Aldus)',
57 21 => 'Hypertext Markup Language [.HTML] (The Internet Society)',
58 22 => 'MPEG 2 Audio Layer 2 (Musicom), ISO/IEC',
59 23 => 'MPEG 2 Audio Layer 3, ISO/IEC',
60 24 => 'Portable Document File [.PDF] Adobe',
61 25 => 'News Industry Text Format (NITF)',
62 26 => 'Tape Archive [.TAR]',
63 27 => 'Tidningarnas Telegrambyra NITF version (TTNITF DTD)',
64 28 => 'Ritzaus Bureau NITF version (RBNITF DTD)',
65 29 => 'Corel Draw [.CDR]',
66);
67
68# main IPTC tag table
69# Note: ALL entries in main IPTC table (except PROCESS_PROC) must be SubDirectory
70# entries, each specifying a TagTable.
71%Image::ExifTool::IPTC::Main = (
72 GROUPS => { 2 => 'Image' },
73 PROCESS_PROC => \&ProcessIPTC,
74 WRITE_PROC => \&WriteIPTC,
75 1 => {
76 Name => 'IPTCEnvelope',
77 SubDirectory => {
78 TagTable => 'Image::ExifTool::IPTC::EnvelopeRecord',
79 },
80 },
81 2 => {
82 Name => 'IPTCApplication',
83 SubDirectory => {
84 TagTable => 'Image::ExifTool::IPTC::ApplicationRecord',
85 },
86 },
87 3 => {
88 Name => 'IPTCNewsPhoto',
89 SubDirectory => {
90 TagTable => 'Image::ExifTool::IPTC::NewsPhoto',
91 },
92 },
93 7 => {
94 Name => 'IPTCPreObjectData',
95 SubDirectory => {
96 TagTable => 'Image::ExifTool::IPTC::PreObjectData',
97 },
98 },
99 8 => {
100 Name => 'IPTCObjectData',
101 SubDirectory => {
102 TagTable => 'Image::ExifTool::IPTC::ObjectData',
103 },
104 },
105 9 => {
106 Name => 'IPTCPostObjectData',
107 SubDirectory => {
108 TagTable => 'Image::ExifTool::IPTC::PostObjectData',
109 },
110 },
111);
112
113# Record 1 -- EnvelopeRecord
114%Image::ExifTool::IPTC::EnvelopeRecord = (
115 GROUPS => { 2 => 'Other' },
116 WRITE_PROC => \&WriteIPTC,
117 CHECK_PROC => \&CheckIPTC,
118 WRITABLE => 1,
119 0 => {
120 Name => 'EnvelopeRecordVersion',
121 Format => 'int16u',
122 },
123 5 => {
124 Name => 'Destination',
125 Flags => 'List',
126 Groups => { 2 => 'Location' },
127 Format => 'string[0,1024]',
128 },
129 20 => {
130 Name => 'FileFormat',
131 Groups => { 2 => 'Image' },
132 Format => 'int16u',
133 PrintConv => \%fileFormat,
134 },
135 22 => {
136 Name => 'FileVersion',
137 Groups => { 2 => 'Image' },
138 Format => 'int16u',
139 },
140 30 => {
141 Name => 'ServiceIdentifier',
142 Format => 'string[0,10]',
143 },
144 40 => {
145 Name => 'EnvelopeNumber',
146 Format => 'digits[8]',
147 },
148 50 => {
149 Name => 'ProductID',
150 Flags => 'List',
151 Format => 'string[0,32]',
152 },
153 60 => {
154 Name => 'EnvelopePriority',
155 Format => 'digits[1]',
156 },
157 70 => {
158 Name => 'DateSent',
159 Groups => { 2 => 'Time' },
160 Format => 'digits[8]',
161 Shift => 'Time',
162 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
163 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
164 },
165 80 => {
166 Name => 'TimeSent',
167 Groups => { 2 => 'Time' },
168 Format => 'string[11]',
169 Shift => 'Time',
170 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
171 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
172 },
173 90 => {
174 Name => 'CodedCharacterSet',
175 Notes => q{
176 values are entered in the form "ESC X Y[, ...]". The escape sequence for
177 UTF-8 character coding is "ESC % G", but this is displayed as "UTF8" for
178 convenience. Either string may be used when writing. The value of this tag
179 affects the decoding of string values in the Application and NewsPhoto
180 records
181 },
182 Format => 'string[0,32]',
183 # convert ISO 2022 escape sequences to a more readable format
184 PrintConv => \&PrintCodedCharset,
185 PrintConvInv => \&PrintInvCodedCharset,
186 },
187 100 => {
188 Name => 'UniqueObjectName',
189 Format => 'string[14,80]',
190 },
191 120 => {
192 Name => 'ARMIdentifier',
193 Format => 'int16u',
194 },
195 122 => {
196 Name => 'ARMVersion',
197 Format => 'int16u',
198 },
199);
200
201# Record 2 -- ApplicationRecord
202%Image::ExifTool::IPTC::ApplicationRecord = (
203 GROUPS => { 2 => 'Other' },
204 WRITE_PROC => \&WriteIPTC,
205 CHECK_PROC => \&CheckIPTC,
206 WRITABLE => 1,
207 0 => {
208 Name => 'ApplicationRecordVersion',
209 Format => 'int16u',
210 },
211 3 => {
212 Name => 'ObjectTypeReference',
213 Format => 'string[3,67]',
214 },
215 4 => {
216 Name => 'ObjectAttributeReference',
217 Flags => 'List',
218 Format => 'string[4,68]',
219 },
220 5 => {
221 Name => 'ObjectName',
222 Format => 'string[0,64]',
223 },
224 7 => {
225 Name => 'EditStatus',
226 Format => 'string[0,64]',
227 },
228 8 => {
229 Name => 'EditorialUpdate',
230 Format => 'digits[2]',
231 },
232 10 => {
233 Name => 'Urgency',
234 Format => 'digits[1]',
235 },
236 12 => {
237 Name => 'SubjectReference',
238 Flags => 'List',
239 Format => 'string[13,236]',
240 },
241 15 => {
242 Name => 'Category',
243 Format => 'string[0,3]',
244 },
245 20 => {
246 Name => 'SupplementalCategories',
247 Flags => 'List',
248 Format => 'string[0,32]',
249 },
250 22 => {
251 Name => 'FixtureIdentifier',
252 Format => 'string[0,32]',
253 },
254 25 => {
255 Name => 'Keywords',
256 Flags => 'List',
257 Format => 'string[0,64]',
258 },
259 26 => {
260 Name => 'ContentLocationCode',
261 Flags => 'List',
262 Groups => { 2 => 'Location' },
263 Format => 'string[3]',
264 },
265 27 => {
266 Name => 'ContentLocationName',
267 Flags => 'List',
268 Groups => { 2 => 'Location' },
269 Format => 'string[0,64]',
270 },
271 30 => {
272 Name => 'ReleaseDate',
273 Groups => { 2 => 'Time' },
274 Format => 'digits[8]',
275 Shift => 'Time',
276 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
277 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
278 },
279 35 => {
280 Name => 'ReleaseTime',
281 Groups => { 2 => 'Time' },
282 Format => 'string[11]',
283 Shift => 'Time',
284 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
285 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
286 },
287 37 => {
288 Name => 'ExpirationDate',
289 Groups => { 2 => 'Time' },
290 Format => 'digits[8]',
291 Shift => 'Time',
292 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
293 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
294 },
295 38 => {
296 Name => 'ExpirationTime',
297 Groups => { 2 => 'Time' },
298 Format => 'string[11]',
299 Shift => 'Time',
300 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
301 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
302 },
303 40 => {
304 Name => 'SpecialInstructions',
305 Format => 'string[0,256]',
306 },
307 42 => {
308 Name => 'ActionAdvised',
309 Format => 'digits[2]',
310 PrintConv => {
311 '' => '',
312 '01' => 'Object Kill',
313 '02' => 'Object Replace',
314 '03' => 'Ojbect Append',
315 '04' => 'Object Reference',
316 },
317 },
318 45 => {
319 Name => 'ReferenceService',
320 Flags => 'List',
321 Format => 'string[0,10]',
322 },
323 47 => {
324 Name => 'ReferenceDate',
325 Groups => { 2 => 'Time' },
326 Flags => 'List',
327 Format => 'digits[8]',
328 Shift => 'Time',
329 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
330 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
331 },
332 50 => {
333 Name => 'ReferenceNumber',
334 Flags => 'List',
335 Format => 'digits[8]',
336 },
337 55 => {
338 Name => 'DateCreated',
339 Groups => { 2 => 'Time' },
340 Format => 'digits[8]',
341 Shift => 'Time',
342 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
343 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
344 },
345 60 => {
346 Name => 'TimeCreated',
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 },
353 62 => {
354 Name => 'DigitalCreationDate',
355 Groups => { 2 => 'Time' },
356 Format => 'digits[8]',
357 Shift => 'Time',
358 ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
359 ValueConvInv => 'Image::ExifTool::IPTC::IptcDate($val)',
360 },
361 63 => {
362 Name => 'DigitalCreationTime',
363 Groups => { 2 => 'Time' },
364 Format => 'string[11]',
365 Shift => 'Time',
366 ValueConv => 'Image::ExifTool::Exif::ExifTime($val)',
367 ValueConvInv => 'Image::ExifTool::IPTC::IptcTime($val)',
368 },
369 65 => {
370 Name => 'OriginatingProgram',
371 Format => 'string[0,32]',
372 },
373 70 => {
374 Name => 'ProgramVersion',
375 Format => 'string[0,10]',
376 },
377 75 => {
378 Name => 'ObjectCycle',
379 Format => 'string[1]',
380 PrintConv => {
381 'a' => 'Morning',
382 'p' => 'Evening',
383 'b' => 'Both Morning and Evening',
384 },
385 },
386 80 => {
387 Name => 'By-line',
388 Flags => 'List',
389 Format => 'string[0,32]',
390 Groups => { 2 => 'Author' },
391 },
392 85 => {
393 Name => 'By-lineTitle',
394 Flags => 'List',
395 Format => 'string[0,32]',
396 Groups => { 2 => 'Author' },
397 },
398 90 => {
399 Name => 'City',
400 Format => 'string[0,32]',
401 Groups => { 2 => 'Location' },
402 },
403 92 => {
404 Name => 'Sub-location',
405 Format => 'string[0,32]',
406 Groups => { 2 => 'Location' },
407 },
408 95 => {
409 Name => 'Province-State',
410 Format => 'string[0,32]',
411 Groups => { 2 => 'Location' },
412 },
413 100 => {
414 Name => 'Country-PrimaryLocationCode',
415 Format => 'string[3]',
416 Groups => { 2 => 'Location' },
417 },
418 101 => {
419 Name => 'Country-PrimaryLocationName',
420 Format => 'string[0,64]',
421 Groups => { 2 => 'Location' },
422 },
423 103 => {
424 Name => 'OriginalTransmissionReference',
425 Format => 'string[0,32]',
426 },
427 105 => {
428 Name => 'Headline',
429 Format => 'string[0,256]',
430 },
431 110 => {
432 Name => 'Credit',
433 Groups => { 2 => 'Author' },
434 Format => 'string[0,32]',
435 },
436 115 => {
437 Name => 'Source',
438 Groups => { 2 => 'Author' },
439 Format => 'string[0,32]',
440 },
441 116 => {
442 Name => 'CopyrightNotice',
443 Groups => { 2 => 'Author' },
444 Format => 'string[0,128]',
445 },
446 118 => {
447 Name => 'Contact',
448 Flags => 'List',
449 Groups => { 2 => 'Author' },
450 Format => 'string[0,128]',
451 },
452 120 => {
453 Name => 'Caption-Abstract',
454 Format => 'string[0,2000]',
455 },
456 121 => { # (format not certain)
457 Name => 'LocalCaption',
458 Format => 'string[0,256]',
459 Notes => q{
460 I haven't found a reference for the format of tags 121, 184-188 and
461 225-232, so I have just make them writable as strings with
462 reasonable length. Beware that if this is wrong, other utilities
463 won't be able to read these tags as written by ExifTool.
464 },
465 },
466 122 => {
467 Name => 'Writer-Editor',
468 Flags => 'List',
469 Groups => { 2 => 'Author' },
470 Format => 'string[0,32]',
471 },
472 125 => {
473 Name => 'RasterizedCaption',
474 Format => 'string[7360]',
475 Binary => 1,
476 },
477 130 => {
478 Name => 'ImageType',
479 Groups => { 2 => 'Image' },
480 Format => 'string[2]',
481 },
482 131 => {
483 Name => 'ImageOrientation',
484 Groups => { 2 => 'Image' },
485 Format => 'string[1]',
486 PrintConv => {
487 P => 'Portrait',
488 L => 'Landscape',
489 S => 'Square',
490 },
491 },
492 135 => {
493 Name => 'LanguageIdentifier',
494 Format => 'string[2,3]',
495 },
496 150 => {
497 Name => 'AudioType',
498 Format => 'string[2]',
499 PrintConv => {
500 '1A' => 'Mono Actuality',
501 '2A' => 'Stereo Actuality',
502 '1C' => 'Mono Question and Answer Session',
503 '2C' => 'Stereo Question and Answer Session',
504 '1M' => 'Mono Music',
505 '2M' => 'Stereo Music',
506 '1Q' => 'Mono Response to a Question',
507 '2Q' => 'Stereo Response to a Question',
508 '1R' => 'Mono Raw Sound',
509 '2R' => 'Stereo Raw Sound',
510 '1S' => 'Mono Scener',
511 '2S' => 'Stereo Scener',
512 '0T' => 'Text Only',
513 '1V' => 'Mono Voicer',
514 '2V' => 'Stereo Voicer',
515 '1W' => 'Mono Wrap',
516 '2W' => 'Stereo Wrap',
517 },
518 },
519 151 => {
520 Name => 'AudioSamplingRate',
521 Format => 'digits[6]',
522 },
523 152 => {
524 Name => 'AudioSamplingResolution',
525 Format => 'digits[2]',
526 },
527 153 => {
528 Name => 'AudioDuration',
529 Format => 'digits[6]',
530 },
531 154 => {
532 Name => 'AudioOutcue',
533 Format => 'string[0,64]',
534 },
535 184 => { # (format not certain)
536 Name => 'JobID',
537 Format => 'string[0,64]',
538 },
539 185 => { # (format not certain)
540 Name => 'MasterDocumentID',
541 Format => 'string[0,256]',
542 },
543 186 => { # (format not certain)
544 Name => 'ShortDocumentID',
545 Format => 'string[0,64]',
546 },
547 187 => { # (format not certain)
548 Name => 'UniqueDocumentID',
549 Format => 'string[0,128]',
550 },
551 188 => { # (format not certain)
552 Name => 'OwnerID',
553 Format => 'string[0,128]',
554 },
555 200 => {
556 Name => 'ObjectPreviewFileFormat',
557 Groups => { 2 => 'Image' },
558 Format => 'int16u',
559 PrintConv => \%fileFormat,
560 },
561 201 => {
562 Name => 'ObjectPreviewFileVersion',
563 Groups => { 2 => 'Image' },
564 Format => 'int16u',
565 },
566 202 => {
567 Name => 'ObjectPreviewData',
568 Groups => { 2 => 'Image' },
569 Format => 'string[0,256000]',
570 Binary => 1,
571 },
572 221 => {
573 Name => 'Prefs',
574 Groups => { 2 => 'Image' },
575 Format => 'string[0,64]',
576 Notes => 'PhotoMechanic preferences',
577 PrintConv => q{
578 $val =~ s[\s*(\d+):\s*(\d+):\s*(\d+):\s*(\S*)]
579 [Tagged:$1, ColorClass:$2, Rating:$3, FrameNum:$4];
580 return $val;
581 },
582 PrintConvInv => q{
583 $val =~ s[Tagged:\s*(\d+).*ColorClass:\s*(\d+).*Rating:\s*(\d+).*FrameNum:\s*(\S*)]
584 [$1:$2:$3:$4]is;
585 return $val;
586 },
587 },
588 225 => { # (format not certain)
589 Name => 'ClassifyState',
590 Format => 'string[0,64]',
591 },
592 228 => { # (format not certain)
593 Name => 'SimilarityIndex',
594 Format => 'string[0,32]',
595 },
596 230 => { # (format not certain)
597 Name => 'DocumentNotes',
598 Format => 'string[0,1024]',
599 },
600 231 => { # (format not certain)
601 Name => 'DocumentHistory',
602 Format => 'string[0,256]',
603 },
604 232 => { # (format not certain)
605 Name => 'ExifCameraInfo',
606 Format => 'string[0,4096]',
607 },
608);
609
610# Record 3 -- News photo
611%Image::ExifTool::IPTC::NewsPhoto = (
612 GROUPS => { 2 => 'Image' },
613 WRITE_PROC => \&WriteIPTC,
614 CHECK_PROC => \&CheckIPTC,
615 WRITABLE => 1,
616 0 => {
617 Name => 'NewsPhotoVersion',
618 Format => 'int16u',
619 },
620 10 => {
621 Name => 'IPTCPictureNumber',
622 Format => 'string[16]',
623 Notes => '4 numbers: 1-Manufacturer ID, 2-Equipment ID, 3-Date, 4-Sequence',
624 PrintConv => 'Image::ExifTool::IPTC::ConvertPictureNumber($val)',
625 PrintConvInv => 'Image::ExifTool::IPTC::InvConvertPictureNumber($val)',
626 },
627 20 => {
628 Name => 'IPTCImageWidth',
629 Format => 'int16u',
630 },
631 30 => {
632 Name => 'IPTCImageHeight',
633 Format => 'int16u',
634 },
635 40 => {
636 Name => 'IPTCPixelWidth',
637 Format => 'int16u',
638 },
639 50 => {
640 Name => 'IPTCPixelHeight',
641 Format => 'int16u',
642 },
643 55 => {
644 Name => 'SupplementalType',
645 Format => 'int8u',
646 PrintConv => {
647 0 => 'Main Image',
648 1 => 'Reduced Resolution Image',
649 2 => 'Logo',
650 3 => 'Rasterized Caption',
651 },
652 },
653 60 => {
654 Name => 'ColorRepresentation',
655 Format => 'int16u',
656 PrintHex => 1,
657 PrintConv => {
658 0x000 => 'No Image, Single Frame',
659 0x100 => 'Monochrome, Single Frame',
660 0x300 => '3 Components, Single Frame',
661 0x301 => '3 Components, Frame Sequential in Multiple Objects',
662 0x302 => '3 Components, Frame Sequential in One Object',
663 0x303 => '3 Components, Line Sequential',
664 0x304 => '3 Components, Pixel Sequential',
665 0x305 => '3 Components, Special Interleaving',
666 0x400 => '4 Components, Single Frame',
667 0x401 => '4 Components, Frame Sequential in Multiple Objects',
668 0x402 => '4 Components, Frame Sequential in One Object',
669 0x403 => '4 Components, Line Sequential',
670 0x404 => '4 Components, Pixel Sequential',
671 0x405 => '4 Components, Special Interleaving',
672 },
673 },
674 64 => {
675 Name => 'InterchangeColorSpace',
676 Format => 'int8u',
677 PrintConv => {
678 1 => 'X,Y,Z CIE',
679 2 => 'RGB SMPTE',
680 3 => 'Y,U,V (K) (D65)',
681 4 => 'RGB Device Dependent',
682 5 => 'CMY (K) Device Dependent',
683 6 => 'Lab (K) CIE',
684 7 => 'YCbCr',
685 8 => 'sRGB',
686 },
687 },
688 65 => {
689 Name => 'ColorSequence',
690 Format => 'int8u',
691 },
692 66 => {
693 Name => 'ICC_Profile',
694 # ...could add SubDirectory support to read into this (if anybody cares)
695 Writable => 0,
696 Binary => 1,
697 },
698 70 => {
699 Name => 'ColorCalibrationMatrix',
700 Writable => 0,
701 Binary => 1,
702 },
703 80 => {
704 Name => 'LookupTable',
705 Writable => 0,
706 Binary => 1,
707 },
708 84 => {
709 Name => 'NumIndexEntries',
710 Format => 'int16u',
711 },
712 85 => {
713 Name => 'ColorPalette',
714 Writable => 0,
715 Binary => 1,
716 },
717 86 => {
718 Name => 'IPTCBitsPerSample',
719 Format => 'int8u',
720 },
721 90 => {
722 Name => 'SampleStructure',
723 Format => 'int8u',
724 PrintConv => {
725 0 => 'OrthogonalConstangSampling',
726 1 => 'Orthogonal4-2-2Sampling',
727 2 => 'CompressionDependent',
728 },
729 },
730 100 => {
731 Name => 'ScanningDirection',
732 Format => 'int8u',
733 PrintConv => {
734 0 => 'L-R, Top-Bottom',
735 1 => 'R-L, Top-Bottom',
736 2 => 'L-R, Bottom-Top',
737 3 => 'R-L, Bottom-Top',
738 4 => 'Top-Bottom, L-R',
739 5 => 'Bottom-Top, L-R',
740 6 => 'Top-Bottom, R-L',
741 7 => 'Bottom-Top, R-L',
742 },
743 },
744 102 => {
745 Name => 'IPTCImageRotation',
746 Format => 'int8u',
747 PrintConv => {
748 0 => 0,
749 1 => 90,
750 2 => 180,
751 3 => 270,
752 },
753 },
754 110 => {
755 Name => 'DataCompressionMethod',
756 Format => 'int32u',
757 },
758 120 => {
759 Name => 'QuantizationMethod',
760 Format => 'int8u',
761 PrintConv => {
762 0 => 'Linear Reflectance/Transmittance',
763 1 => 'Linear Density',
764 2 => 'IPTC Ref B',
765 3 => 'Linear Dot Percent',
766 4 => 'AP Domestic Analogue',
767 5 => 'Compression Method Specific',
768 6 => 'Color Space Specific',
769 7 => 'Gamma Compensated',
770 },
771 },
772 125 => {
773 Name => 'EndPoints',
774 Writable => 0,
775 Binary => 1,
776 },
777 130 => {
778 Name => 'ExcursionTolerance',
779 Format => 'int8u',
780 PrintConv => {
781 0 => 'Not Allowed',
782 1 => 'Allowed',
783 },
784 },
785 135 => {
786 Name => 'BitsPerComponent',
787 Format => 'int8u',
788 },
789 140 => {
790 Name => 'MaximumDensityRange',
791 Format => 'int16u',
792 },
793 145 => {
794 Name => 'GammaCompensatedValue',
795 Format => 'int16u',
796 },
797);
798
799# Record 7 -- Pre-object Data
800%Image::ExifTool::IPTC::PreObjectData = (
801 # (not actually writable, but used in BuildTagLookup to recognize IPTC tables)
802 WRITE_PROC => \&WriteIPTC,
803 10 => {
804 Name => 'SizeMode',
805 Format => 'int8u',
806 PrintConv => {
807 0 => 'Size Not Known',
808 1 => 'Size Known',
809 },
810 },
811 20 => {
812 Name => 'MaxSubfileSize',
813 Format => 'int32u',
814 },
815 90 => {
816 Name => 'ObjectSizeAnnounced',
817 Format => 'int32u',
818 },
819 95 => {
820 Name => 'MaximumObjectSize',
821 Format => 'int32u',
822 },
823);
824
825# Record 8 -- ObjectData
826%Image::ExifTool::IPTC::ObjectData = (
827 WRITE_PROC => \&WriteIPTC,
828 10 => {
829 Name => 'SubFile',
830 Flags => 'List',
831 Binary => 1,
832 },
833);
834
835# Record 9 -- PostObjectData
836%Image::ExifTool::IPTC::PostObjectData = (
837 WRITE_PROC => \&WriteIPTC,
838 10 => {
839 Name => 'ConfirmedObjectSize',
840 Format => 'int32u',
841 },
842);
843
844
845#------------------------------------------------------------------------------
846# AutoLoad our writer routines when necessary
847#
848sub AUTOLOAD
849{
850 return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
851}
852
853#------------------------------------------------------------------------------
854# Print conversion for CodedCharacterSet
855# Inputs: 0) value
856sub PrintCodedCharset($)
857{
858 my $val = shift;
859 return $iptcCharset{$val} if $iptcCharset{$val};
860 $val =~ s/(.)/ $1/g;
861 $val =~ s/ \x1b/, ESC/g;
862 $val =~ s/^,? //;
863 return $val;
864}
865
866#------------------------------------------------------------------------------
867# Handle CodedCharacterSet
868# Inputs: 0) ExifTool ref, 1) CodedCharacterSet value
869# Returns: external character set if translation required (or 'bad' if unknown)
870sub HandleCodedCharset($$)
871{
872 my ($exifTool, $val) = @_;
873 my $xlat = $exifTool->Options('Charset');
874 if ($iptcCharset{$val}) {
875 # no need to translate if destination is the same
876 undef $xlat if $xlat eq $iptcCharset{$val};
877 } elsif ($val =~ /^\x1b\x25/) {
878 # some unknown character set involked
879 $xlat = 'bad'; # flag unsupported coding
880 } else {
881 # translate all other codes as Latin
882 undef $xlat if $xlat eq 'Latin';
883 }
884 return $xlat;
885}
886
887#------------------------------------------------------------------------------
888# Encode or decode coded string
889# Inputs: 0) ExifTool ref, 1) value ptr, 2) destination charset ('Latin','UTF8' or 'bad')
890# 3) flag set to decode (read) value from IPTC
891# Updates value on return
892sub TranslateCodedString($$$$)
893{
894 my ($exifTool, $valPtr, $xlatPtr, $read) = @_;
895 my $escaped;
896 if ($$xlatPtr eq 'bad') {
897 $exifTool->Warn('Some IPTC characters not converted (unsupported CodedCharacterSet)');
898 undef $$xlatPtr;
899 } elsif ($$xlatPtr eq 'Latin' xor $read) {
900 # don't yet support reading ISO 2022 shifted character sets
901 if (not $read or $$valPtr !~ /[\x14\x15\x1b]/) {
902 # convert from Latin to UTF-8
903 my $val = Image::ExifTool::Latin2Unicode($$valPtr,'n');
904 $$valPtr = Image::ExifTool::Unicode2UTF8($val,'n');
905 } elsif (not $$exifTool{WarnShift2022}) {
906 $exifTool->Warn('Some IPTC characters not converted (ISO 2022 shifting not supported)');
907 $$exifTool{WarnShift2022} = 1;
908 }
909 } else {
910 # convert from UTF-8 to Latin
911 my $val = Image::ExifTool::UTF82Unicode($$valPtr,'n',$exifTool);
912 $$valPtr = Image::ExifTool::Unicode2Latin($val,'n',$exifTool);
913 }
914}
915
916#------------------------------------------------------------------------------
917# get IPTC info
918# Inputs: 0) ExifTool object reference, 1) dirInfo reference
919# 2) reference to tag table
920# Returns: 1 on success, 0 otherwise
921sub ProcessIPTC($$$)
922{
923 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
924 my $dataPt = $$dirInfo{DataPt};
925 my $pos = $$dirInfo{DirStart} || 0;
926 my $dirLen = $$dirInfo{DirLen} || 0;
927 my $dirEnd = $pos + $dirLen;
928 my $verbose = $exifTool->Options('Verbose');
929 my $success = 0;
930 my (%listTags, $lastRec, $recordPtr, $recordName);
931
932 # begin by assuming IPTC is Latin (so no translation if Charset is Latin)
933 my $xlat = $exifTool->Options('Charset');
934 undef $xlat if $xlat eq 'Latin';
935
936 $verbose and $dirInfo and $exifTool->VerboseDir('IPTC', 0, $$dirInfo{DirLen});
937 if ($tagTablePtr eq \%Image::ExifTool::IPTC::Main) {
938 my $dirCount = ($exifTool->{DIR_COUNT}->{IPTC} || 0) + 1;
939 $exifTool->{DIR_COUNT}->{IPTC} = $dirCount;
940 $exifTool->{SET_GROUP1} = '+' . $dirCount if $dirCount > 1;
941 }
942 # quick check for improperly byte-swapped IPTC
943 if ($dirLen >= 4 and substr($$dataPt, $pos, 1) ne "\x1c" and
944 substr($$dataPt, $pos + 3, 1) eq "\x1c")
945 {
946 $exifTool->Warn('IPTC data was improperly byte-swapped');
947 my $newData = pack('N*', unpack('V*', substr($$dataPt, $pos, $dirLen) . "\0\0\0"));
948 $dataPt = \$newData;
949 $pos = 0;
950 $dirEnd = $pos + $dirLen;
951 # NOTE: MUST NOT access $dirInfo DataPt, DirStart or DataLen after this!
952 }
953 while ($pos + 5 <= $dirEnd) {
954 my $buff = substr($$dataPt, $pos, 5);
955 my ($id, $rec, $tag, $len) = unpack("CCCn", $buff);
956 unless ($id == 0x1c) {
957 unless ($id) {
958 # scan the rest of the data an give warning unless all zeros
959 # (iMatch pads the IPTC block with nulls for some reason)
960 my $remaining = substr($$dataPt, $pos, $dirEnd - $pos);
961 last unless $remaining =~ /[^\0]/;
962 }
963 $exifTool->Warn(sprintf('Bad IPTC data tag (marker 0x%x)',$id));
964 last;
965 }
966 if (not defined $lastRec or $lastRec != $rec) {
967 my $tableInfo = $tagTablePtr->{$rec};
968 unless ($tableInfo) {
969 $exifTool->Warn("Unrecognized IPTC record: $rec");
970 last; # stop now because we're probably reading garbage
971 }
972 my $tableName = $tableInfo->{SubDirectory}->{TagTable};
973 unless ($tableName) {
974 $exifTool->Warn("No table for IPTC record $rec!");
975 last; # this shouldn't happen
976 }
977 $recordName = $$tableInfo{Name};
978 $recordPtr = Image::ExifTool::GetTagTable($tableName);
979 $exifTool->VPrint(0,$$exifTool{INDENT},"-- $recordName record --\n");
980 $lastRec = $rec;
981 }
982 $pos += 5; # step to after field header
983 # handle extended IPTC entry if necessary
984 if ($len & 0x8000) {
985 my $n = $len & 0x7fff; # get num bytes in length field
986 if ($pos + $n > $dirEnd or $n > 8) {
987 $exifTool->VPrint(0, "Invalid extended IPTC entry (tag $tag)\n");
988 $success = 0;
989 last;
990 }
991 # determine length (a big-endian, variable sized int)
992 for ($len = 0; $n; ++$pos, --$n) {
993 $len = $len * 256 + ord(substr($$dataPt, $pos, 1));
994 }
995 }
996 if ($pos + $len > $dirEnd) {
997 $exifTool->VPrint(0, "Invalid IPTC entry (tag $tag, len $len)\n");
998 $success = 0;
999 last;
1000 }
1001 my $val = substr($$dataPt, $pos, $len);
1002
1003 # add tagInfo for all unknown tags:
1004 unless ($$recordPtr{$tag}) {
1005 # - no Format so format is auto-detected
1006 # - no Name so name is generated automatically with decimal tag number
1007 Image::ExifTool::AddTagToTable($recordPtr, $tag, { Unknown => 1 });
1008 }
1009
1010 my $tagInfo = $exifTool->GetTagInfo($recordPtr, $tag);
1011 my $format;
1012 $format = $$tagInfo{Format} if $tagInfo;
1013 # use logic to determine format if not specified
1014 unless ($format) {
1015 $format = 'int' if $len <= 4 and $len != 3 and $val =~ /[\0-\x08]/;
1016 }
1017 if ($format) {
1018 if ($format =~ /^int/) {
1019 if ($len <= 8) { # limit integer conversion to 8 bytes long
1020 $val = 0;
1021 my $i;
1022 for ($i=0; $i<$len; ++$i) {
1023 $val = $val * 256 + ord(substr($$dataPt, $pos+$i, 1));
1024 }
1025 }
1026 } elsif ($format =~ /^string/) {
1027 if ($rec == 1) {
1028 # handle CodedCharacterSet tag
1029 $xlat = HandleCodedCharset($exifTool, $val) if $tag == 90;
1030 # translate characters if necessary and special characters exist
1031 } elsif ($xlat and $rec < 7 and $val =~ /[\x80-\xff]/) {
1032 # translate to specified character set
1033 TranslateCodedString($exifTool, \$val, \$xlat, 1);
1034 }
1035 } elsif ($format !~ /^digits/) {
1036 warn("Invalid IPTC format: $format");
1037 }
1038 }
1039 $verbose and $exifTool->VerboseInfo($tag, $tagInfo,
1040 Table => $tagTablePtr,
1041 Value => $val,
1042 DataPt => $dataPt,
1043 DataPos => $$dirInfo{DataPos},
1044 Size => $len,
1045 Start => $pos,
1046 Extra => ", $recordName record",
1047 );
1048 # prevent adding tags to list from another IPTC directory
1049 if ($tagInfo) {
1050 if ($$tagInfo{List}) {
1051 $exifTool->{NO_LIST} = 1 unless $listTags{$tagInfo};
1052 $listTags{$tagInfo} = 1; # list the next one we see
1053 }
1054 $exifTool->FoundTag($tagInfo, $val);
1055 }
1056 delete $exifTool->{NO_LIST};
1057 $success = 1;
1058
1059 $pos += $len; # increment to next field
1060 }
1061 delete $exifTool->{SET_GROUP1};
1062 return $success;
1063}
1064
10651; # end
1066
1067
1068__END__
1069
1070=head1 NAME
1071
1072Image::ExifTool::IPTC - Read IPTC meta information
1073
1074=head1 SYNOPSIS
1075
1076This module is loaded automatically by Image::ExifTool when required.
1077
1078=head1 DESCRIPTION
1079
1080This module contains definitions required by Image::ExifTool to interpret
1081IPTC (International Press Telecommunications Council) meta information in
1082image files.
1083
1084=head1 AUTHOR
1085
1086Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
1087
1088This library is free software; you can redistribute it and/or modify it
1089under the same terms as Perl itself.
1090
1091=head1 REFERENCES
1092
1093=over 4
1094
1095=item L<http://www.iptc.org/IIM/>
1096
1097=back
1098
1099=head1 SEE ALSO
1100
1101L<Image::ExifTool::TagNames/IPTC Tags>,
1102L<Image::ExifTool(3pm)|Image::ExifTool>
1103
1104=cut
Note: See TracBrowser for help on using the repository browser.