Changeset 24107 for main/trunk/greenstone2/perllib/cpan/Image/ExifTool/IPTC.pm

Timestamp:

2011-06-01T12:33:42+12:00 (13 years ago)

Author:

sjm84

Message:

Updating the ExifTool perl modules

File:

• main/trunk/greenstone2/perllib/cpan/Image/ExifTool/IPTC.pm (modified) (25 diffs)

main/trunk/greenstone2/perllib/cpan/Image/ExifTool/IPTC.pm

@@ -4 +4 @@
 # Description:  Read IPTC meta information
 #
-# Revisions:    Jan. 08/03 - P. Harvey Created
-#               Feb. 05/04 - P. Harvey Added support for records other than 2
+# Revisions:    Jan. 08/2003 - P. Harvey Created
+#               Feb. 05/2004 - P. Harvey Added support for records other than 2
 #
 # References:   1) http://www.iptc.org/IIM/
@@ -15 +15 @@
 use vars qw($VERSION $AUTOLOAD %iptcCharset);
 
-$VERSION = '1.23';
+$VERSION = '1.42';
 
 %iptcCharset = (
     "\x1b%G"  => 'UTF8',
    # don't translate these (at least until we handle ISO 2022 shift codes)
-   # because the sets are only designated and not invoked 
+   # because the sets are only designated and not invoked
    # "\x1b,A"  => 'Latin',  # G0 = ISO 8859-1 (similar to Latin1, but codes 0x80-0x9f are missing)
    # "\x1b-A"  => 'Latin',  # G1     "
@@ -105 +105 @@
     9 => {
         Name => 'IPTCPostObjectData',
+        Groups => { 1 => 'IPTC#' }, #(just so this shows up in group list)
         SubDirectory => {
             TagTable => 'Image::ExifTool::IPTC::PostObjectData',
+        },
+    },
+    240 => {
+        Name => 'IPTCFotoStation',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::IPTC::FotoStation',
         },
     },
@@ -120 +127 @@
         Name => 'EnvelopeRecordVersion',
         Format => 'int16u',
+        Mandatory => 1,
     },
     5 => {
@@ -154 +162 @@
         Name => 'EnvelopePriority',
         Format => 'digits[1]',
+        PrintConv => {
+            0 => '0 (reserved)',
+            1 => '1 (most urgent)',
+            2 => 2,
+            3 => 3,
+            4 => 4,
+            5 => '5 (normal urgency)',
+            6 => 6,
+            7 => 7,
+            8 => '8 (least urgent)',
+            9 => '9 (user-defined priority)',
+        },
     },
     70 => {
@@ -178 +198 @@
             convenience.  Either string may be used when writing.  The value of this tag
             affects the decoding of string values in the Application and NewsPhoto
-            records
-        },
+            records.  This tag is marked as "unsafe" to prevent it from being copied by
+            default in a group operation because existing tags in the destination image
+            may use a different encoding.  When creating a new IPTC record from scratch,
+            it is suggested that this be set to "UTF8" if special characters are a
+            possibility
+        },
+        Protected => 1,
         Format => 'string[0,32]',
         # convert ISO 2022 escape sequences to a more readable format
@@ -208 +233 @@
         Name => 'ApplicationRecordVersion',
         Format => 'int16u',
+        Mandatory => 1,
     },
     3 => {
@@ -229 +255 @@
         Name => 'EditorialUpdate',
         Format => 'digits[2]',
+        PrintConv => {
+            '01' => 'Additional language',
+        },
     },
     10 => {
         Name => 'Urgency',
         Format => 'digits[1]',
+        PrintConv => {
+            0 => '0 (reserved)',
+            1 => '1 (most urgent)',
+            2 => 2,
+            3 => 3,
+            4 => 4,
+            5 => '5 (normal urgency)',
+            6 => 6,
+            7 => 7,
+            8 => '8 (least urgent)',
+            9 => '9 (user-defined priority)',
+        },
     },
     12 => {
@@ -454 +495 @@
         Format => 'string[0,2000]',
     },
-    121 => { # (format not certain)
+    121 => {
         Name => 'LocalCaption',
-        Format => 'string[0,256]',
+        Format => 'string[0,256]', # (guess)
         Notes => q{
             I haven't found a reference for the format of tags 121, 184-188 and
             225-232, so I have just make them writable as strings with
             reasonable length.  Beware that if this is wrong, other utilities
-            won't be able to read these tags as written by ExifTool.
+            won't be able to read these tags as written by ExifTool
         },
     },
@@ -472 +513 @@
     125 => {
         Name => 'RasterizedCaption',
-        Format => 'string[7360]',
+        Format => 'undef[7360]',
         Binary => 1,
     },
@@ -533 +574 @@
         Format => 'string[0,64]',
     },
-    184 => { # (format not certain)
+    184 => {
         Name => 'JobID',
-        Format => 'string[0,64]',
-    },
-    185 => { # (format not certain)
+        Format => 'string[0,64]', # (guess)
+    },
+    185 => {
         Name => 'MasterDocumentID',
-        Format => 'string[0,256]',
-    },
-    186 => { # (format not certain)
+        Format => 'string[0,256]', # (guess)
+    },
+    186 => {
         Name => 'ShortDocumentID',
-        Format => 'string[0,64]',
-    },
-    187 => { # (format not certain)
+        Format => 'string[0,64]', # (guess)
+    },
+    187 => {
         Name => 'UniqueDocumentID',
-        Format => 'string[0,128]',
-    },
-    188 => { # (format not certain)
+        Format => 'string[0,128]', # (guess)
+    },
+    188 => {
         Name => 'OwnerID',
-        Format => 'string[0,128]',
+        Format => 'string[0,128]', # (guess)
     },
     200 => {
@@ -567 +608 @@
         Name => 'ObjectPreviewData',
         Groups => { 2 => 'Image' },
-        Format => 'string[0,256000]',
+        Format => 'undef[0,256000]',
         Binary => 1,
     },
@@ -586 +627 @@
         },
     },
-    225 => { # (format not certain)
+    225 => {
         Name => 'ClassifyState',
-        Format => 'string[0,64]',
-    },
-    228 => { # (format not certain)
+        Format => 'string[0,64]', # (guess)
+    },
+    228 => {
         Name => 'SimilarityIndex',
-        Format => 'string[0,32]',
-    },
-    230 => { # (format not certain)
+        Format => 'string[0,32]', # (guess)
+    },
+    230 => {
         Name => 'DocumentNotes',
-        Format => 'string[0,1024]',
-    },
-    231 => { # (format not certain)
+        Format => 'string[0,1024]', # (guess)
+    },
+    231 => {
         Name => 'DocumentHistory',
-        Format => 'string[0,256]',
-    },
-    232 => { # (format not certain)
+        Format => 'string[0,256]', # (guess)
+    },
+    232 => {
         Name => 'ExifCameraInfo',
-        Format => 'string[0,4096]',
+        Format => 'string[0,4096]', # (guess)
+    },
+    255 => { #PH
+        Name => 'CatalogSets',
+        List => 1,
+        Format => 'string[0,256]', # (guess)
+        Notes => 'written by iView MediaPro',
     },
 );
@@ -617 +664 @@
         Name => 'NewsPhotoVersion',
         Format => 'int16u',
+        Mandatory => 1,
     },
     10 => {
@@ -842 +890 @@
 );
 
+# Record 240 -- FotoStation proprietary data (ref PH)
+%Image::ExifTool::IPTC::FotoStation = (
+    GROUPS => { 2 => 'Other' },
+    WRITE_PROC => \&WriteIPTC,
+    CHECK_PROC => \&CheckIPTC,
+    WRITABLE => 1,
+);
+
+# IPTC Composite tags
+%Image::ExifTool::IPTC::Composite = (
+    GROUPS => { 2 => 'Image' },
+    DateTimeCreated => {
+        Description => 'Date/Time Created',
+        Groups => { 2 => 'Time' },
+        Require => {
+            0 => 'IPTC:DateCreated',
+            1 => 'IPTC:TimeCreated',
+        },
+        ValueConv => '"$val[0] $val[1]"',
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+    DigitalCreationDateTime => {
+        Description => 'Digital Creation Date/Time',
+        Groups => { 2 => 'Time' },
+        Require => {
+            0 => 'IPTC:DigitalCreationDate',
+            1 => 'IPTC:DigitalCreationTime',
+        },
+        ValueConv => '"$val[0] $val[1]"',
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+);
+
+# add our composite tags
+Image::ExifTool::AddCompositeTags('Image::ExifTool::IPTC');
+
 
 #------------------------------------------------------------------------------
@@ -863 +947 @@
     return $val;
 }
-        
+
 #------------------------------------------------------------------------------
 # Handle CodedCharacterSet
 # Inputs: 0) ExifTool ref, 1) CodedCharacterSet value
-# Returns: external character set if translation required (or 'bad' if unknown)
+# Returns: IPTC character set if translation required (or 'bad' if unknown)
 sub HandleCodedCharset($$)
 {
     my ($exifTool, $val) = @_;
-    my $xlat = $exifTool->Options('Charset');
-    if ($iptcCharset{$val}) {
-        # no need to translate if destination is the same
-        undef $xlat if $xlat eq $iptcCharset{$val};
-    } elsif ($val =~ /^\x1b\x25/) {
-        # some unknown character set involked
-        $xlat = 'bad';  # flag unsupported coding
-    } else {
-        # translate all other codes as Latin
-        undef $xlat if $xlat eq 'Latin';
+    my $xlat = $iptcCharset{$val};
+    unless ($xlat) {
+        if ($val =~ /^\x1b\x25/) {
+            # some unknown character set invoked
+            $xlat = 'bad';  # flag unsupported coding
+        } else {
+            $xlat = $exifTool->Options('CharsetIPTC');
+        }
     }
+    # no need to translate if Charset is the same
+    undef $xlat if $xlat eq $exifTool->Options('Charset');
     return $xlat;
 }
@@ -887 +971 @@
 #------------------------------------------------------------------------------
 # Encode or decode coded string
-# Inputs: 0) ExifTool ref, 1) value ptr, 2) destination charset ('Latin','UTF8' or 'bad')
+# Inputs: 0) ExifTool ref, 1) value ptr, 2) IPTC charset (or 'bad') ref
 #         3) flag set to decode (read) value from IPTC
 # Updates value on return
@@ -893 +977 @@
 {
     my ($exifTool, $valPtr, $xlatPtr, $read) = @_;
-    my $escaped;
     if ($$xlatPtr eq 'bad') {
         $exifTool->Warn('Some IPTC characters not converted (unsupported CodedCharacterSet)');
         undef $$xlatPtr;
-    } elsif ($$xlatPtr eq 'Latin' xor $read) {
+    } elsif (not $read) {
+        $$valPtr = $exifTool->Decode($$valPtr, undef, undef, $$xlatPtr);
+    } elsif ($$valPtr !~ /[\x14\x15\x1b]/) {
+        $$valPtr = $exifTool->Decode($$valPtr, $$xlatPtr);
+    } else {
         # don't yet support reading ISO 2022 shifted character sets
-        if (not $read or $$valPtr !~ /[\x14\x15\x1b]/) {
-            # convert from Latin to UTF-8
-            my $val = Image::ExifTool::Latin2Unicode($$valPtr,'n');
-            $$valPtr = Image::ExifTool::Unicode2UTF8($val,'n');
-        } elsif (not $$exifTool{WarnShift2022}) {
-            $exifTool->Warn('Some IPTC characters not converted (ISO 2022 shifting not supported)');
-            $$exifTool{WarnShift2022} = 1;
-        }
-    } else {
-        # convert from UTF-8 to Latin
-        my $val = Image::ExifTool::UTF82Unicode($$valPtr,'n',$exifTool);
-        $$valPtr = Image::ExifTool::Unicode2Latin($val,'n',$exifTool);
+        $exifTool->WarnOnce('Some IPTC characters not converted (ISO 2022 shifting not supported)');
     }
+}
+
+#------------------------------------------------------------------------------
+# Is this IPTC in a standard location?
+# Inputs: 0) Current metadata path string
+# Returns: true if path is standard
+sub IsStandardIPTC($)
+{
+    my $path = shift;
+    return $path =~ /^(JPEG-APP13-Photoshop-IPTC|TIFF-IFD0-IPTC|PSD-IPTC|MIE-IPTC)$/
 }
 
@@ -928 +1014 @@
     my $verbose = $exifTool->Options('Verbose');
     my $success = 0;
-    my (%listTags, $lastRec, $recordPtr, $recordName);
-
-    # begin by assuming IPTC is Latin (so no translation if Charset is Latin)
-    my $xlat = $exifTool->Options('Charset');
-    undef $xlat if $xlat eq 'Latin';
-    
+    my ($lastRec, $recordPtr, $recordName);
+
     $verbose and $dirInfo and $exifTool->VerboseDir('IPTC', 0, $$dirInfo{DirLen});
+
     if ($tagTablePtr eq \%Image::ExifTool::IPTC::Main) {
+        # calculate MD5 if Digest::MD5 is available (for standard IPTC only)
+        my $path = $exifTool->MetadataPath();
+        if (IsStandardIPTC($path)) {
+            my $md5;
+            if (eval 'require Digest::MD5') {
+                if ($pos or $dirLen != length($$dataPt)) {
+                    $md5 = Digest::MD5::md5(substr $$dataPt, $pos, $dirLen);
+                } else {
+                    $md5 = Digest::MD5::md5($$dataPt);
+                }
+            } else {
+                # a zero digest indicates IPTC exists but we don't have Digest::MD5
+                $md5 = "\0" x 16;
+            }
+            $exifTool->FoundTag('CurrentIPTCDigest', $md5);
+        } elsif ($Image::ExifTool::MWG::strict and $$exifTool{FILE_TYPE} =~ /^(JPEG|TIFF|PSD)$/) {
+            # ignore non-standard IPTC while in strict MWG compatibility mode
+            $exifTool->Warn("Ignored non-standard IPTC at $path");
+            return 1;
+        }
+        # set family 1 group name if multiple IPTC directories
         my $dirCount = ($exifTool->{DIR_COUNT}->{IPTC} || 0) + 1;
         $exifTool->{DIR_COUNT}->{IPTC} = $dirCount;
         $exifTool->{SET_GROUP1} = '+' . $dirCount if $dirCount > 1;
     }
+    # begin by assuming default IPTC encoding
+    my $xlat = $exifTool->Options('CharsetIPTC');
+    undef $xlat if $xlat eq $exifTool->Options('Charset');
+
     # quick check for improperly byte-swapped IPTC
     if ($dirLen >= 4 and substr($$dataPt, $pos, 1) ne "\x1c" and
@@ -967 +1075 @@
             my $tableInfo = $tagTablePtr->{$rec};
             unless ($tableInfo) {
-                $exifTool->Warn("Unrecognized IPTC record: $rec");
+                $exifTool->Warn("Unrecognized IPTC record $rec, subsequent records ignored");
                 last;   # stop now because we're probably reading garbage
             }
@@ -1010 +1118 @@
         my $tagInfo = $exifTool->GetTagInfo($recordPtr, $tag);
         my $format;
+        # (could use $$recordPtr{FORMAT} if no Format below, but don't do this to
+        #  be backward compatible with improperly written PhotoMechanic tags)
         $format = $$tagInfo{Format} if $tagInfo;
         # use logic to determine format if not specified
@@ -1025 +1135 @@
                 }
             } elsif ($format =~ /^string/) {
+                $val =~ s/\0+$//;   # some braindead softwares add null terminators
                 if ($rec == 1) {
                     # handle CodedCharacterSet tag
@@ -1033 +1144 @@
                     TranslateCodedString($exifTool, \$val, \$xlat, 1);
                 }
-            } elsif ($format !~ /^digits/) {
+            } elsif ($format =~ /^digits/) {
+                $val =~ s/\0+$//;
+            } elsif ($format !~ /^undef/) {
                 warn("Invalid IPTC format: $format");
             }
@@ -1045 +1158 @@
             Start   => $pos,
             Extra   => ", $recordName record",
+            Format  => $format,
         );
-        # prevent adding tags to list from another IPTC directory
-        if ($tagInfo) {
-            if ($$tagInfo{List}) {
-                $exifTool->{NO_LIST} = 1 unless $listTags{$tagInfo};
-                $listTags{$tagInfo} = 1;    # list the next one we see
-            }
-            $exifTool->FoundTag($tagInfo, $val);
-        }
-        delete $exifTool->{NO_LIST};
+        $exifTool->FoundTag($tagInfo, $val) if $tagInfo;
         $success = 1;
 
@@ -1084 +1190 @@
 =head1 AUTHOR
 
-Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
+Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
 
 This library is free software; you can redistribute it and/or modify it