exiftool_vendored 12.42.0 → 12.52.0

data/bin/lib/Image/ExifTool/Text.pm

@@ -14,9 +14,8 @@ package Image::ExifTool::Text;
 use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
-use Image::ExifTool::XMP;
 
-$VERSION = '1.03';
+$VERSION = '1.04';
 
 # Text tags
 %Image::ExifTool::Text::Main = (
@@ -97,7 +96,7 @@ sub ProcessTXT($$)
         $nl =~ tr/\0//d;    # remove nulls from newline sequence
         $isBOM = 1;         # (we don't recognize UTF-16/UTF-32 without one)
     } else {
-        $isUTF8 = Image::ExifTool::XMP::IsUTF8($dataPt, 1);
+        $isUTF8 = Image::ExifTool::IsUTF8($dataPt, 1);
         if ($isUTF8 == 0) {
             $enc = 'us-ascii';
         } elsif ($isUTF8 > 0) {
@@ -183,7 +182,7 @@ sub ProcessTXT($$)
         next if $raf->Tell() < 65536;
         # continue to check encoding after the first 64 kB
         if ($isUTF8 >= 0) { # (if ascii or utf8)
-            $isUTF8 = Image::ExifTool::XMP::IsUTF8(\$buff);
+            $isUTF8 = Image::ExifTool::IsUTF8(\$buff);
             if ($isUTF8 > 0) {
                 $enc = 'utf-8';
             } elsif ($isUTF8 < 0) {

data/bin/lib/Image/ExifTool/Torrent.pm

@@ -13,9 +13,8 @@ package Image::ExifTool::Torrent;
 use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
-use Image::ExifTool::XMP;
 
-$VERSION = '1.05';
+$VERSION = '1.06';
 
 sub ReadBencode($$$);
 sub ExtractTags($$$;$$@);
@@ -169,7 +168,7 @@ sub ReadBencode($$$)
             if (length($value) > 256) {
                 $val = \$value;
             } elsif ($value =~ /[^\t\x20-\x7e]/) {
-                if (Image::ExifTool::XMP::IsUTF8(\$value) >= 0) {
+                if (Image::ExifTool::IsUTF8(\$value) >= 0) {
                     $val = $et->Decode($value, 'UTF8');
                 } else {
                     $val = \$value;

data/bin/lib/Image/ExifTool/Validate.pm

@@ -17,7 +17,7 @@ package Image::ExifTool::Validate;
 use strict;
 use vars qw($VERSION %exifSpec);
 
-$VERSION = '1.18';
+$VERSION = '1.19';
 
 use Image::ExifTool qw(:Utils);
 use Image::ExifTool::Exif;
@@ -82,8 +82,8 @@ my %otherSpec = (
     CR2 => { 0xc5d8 => 1, 0xc5d9 => 1, 0xc5e0 => 1, 0xc640 => 1, 0xc6dc => 1, 0xc6dd => 1 },
     NEF => { 0x9216 => 1, 0x9217 => 1 },
     DNG => { 0x882a => 1, 0x9211 => 1, 0x9216 => 1 },
-    ARW => { 0x7000 => 1, 0x7001 => 1, 0x7010 => 1, 0x7011 => 1, 0x7020 => 1,
-             0x7031 => 1, 0x7032 => 1, 0x7034 => 1, 0x7035 => 1, 0x7036 => 1, 0x7037 => 1,
+    ARW => { 0x7000 => 1, 0x7001 => 1, 0x7010 => 1, 0x7011 => 1, 0x7020 => 1, 0x7031 => 1,
+             0x7032 => 1, 0x7034 => 1, 0x7035 => 1, 0x7036 => 1, 0x7037 => 1, 0x7038 => 1,
              0x7310 => 1, 0x7313 => 1, 0x7316 => 1, 0x74c7 => 1, 0x74c8 => 1, 0xa500 => 1 },
     RW2 => { All => 1 },    # ignore all unknown tags in RW2
     RWL => { All => 1 },

data/bin/lib/Image/ExifTool/WriteCanonRaw.pl

@@ -271,6 +271,13 @@ sub WriteCanonRaw($$$)
     $raf->Seek($blockStart+$blockSize-4, 0) or return 0;
     $raf->Read($buff, 4) == 4 or return 0;
     my $dirOffset = Get32u(\$buff,0) + $blockStart;
+    # avoid infinite recursion
+    $$et{ProcessedCanonRaw} or $$et{ProcessedCanonRaw} = { };
+    if ($$et{ProcessedCanonRaw}{$dirOffset}) {
+        $et->Error("Double-referenced $$dirInfo{DirName} directory");
+        return 0;
+    }
+    $$et{ProcessedCanonRaw}{$dirOffset} = 1;
     $raf->Seek($dirOffset, 0) or return 0;
     $raf->Read($buff, 2) == 2 or return 0;
     my $entries = Get16u(\$buff,0);             # get number of entries in directory

data/bin/lib/Image/ExifTool/WriteExif.pl

@@ -586,7 +586,7 @@ sub WriteExif($$$)
                 $et->Error("$str $name directory", 1);
             }
         }
-        my ($index, $dirEnd, $numEntries);
+        my ($index, $dirEnd, $numEntries, %hasOldID, $unsorted);
         if ($dirStart + 4 < $dataLen) {
             $numEntries = Get16u($dataPt, $dirStart);
             $dirEnd = $dirStart + 2 + 12 * $numEntries;
@@ -596,19 +596,20 @@ sub WriteExif($$$)
                 return undef unless $n and defined $rtn;
                 $numEntries = $n;   # continue processing the entries we have
             }
-            # sort entries if necessary (but not in maker notes IFDs)
-            unless ($inMakerNotes) {
-                my $lastID = -1;
-                for ($index=0; $index<$numEntries; ++$index) {
-                    my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index);
-                    # check for proper sequence (but ignore null entries at end)
-                    if ($tagID < $lastID and ($tagID or $$tagTablePtr{0})) {
-                        SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0});
-                        $et->Warn("Entries in $name were out of sequence. Fixed.",1);
-                        last;
-                    }
-                    $lastID = $tagID;
-                }
+            # create lookup for existing tag ID's and determine if directory is sorted
+            my $lastID = -1;
+            for ($index=0; $index<$numEntries; ++$index) {
+                my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index);
+                $hasOldID{$tagID} = 1;
+                # check for proper sequence (but ignore null entries at end)
+                $unsorted = 1 if $tagID < $lastID and ($tagID or $$tagTablePtr{0});
+                $lastID = $tagID;
+            }
+            # sort entries if out-of-order (but not in maker notes IFDs or RAW files)
+            if ($unsorted and not ($inMakerNotes or $et->IsRawType())) {
+                SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0});
+                $et->Warn("Entries in $name were out of sequence. Fixed.",1);
+                $unsorted = 0;
             }
         } else {
             $numEntries = 0;
@@ -616,11 +617,12 @@ sub WriteExif($$$)
         }
 
         # loop through new values and accumulate all information for this IFD
-        my (%set, %mayDelete, $tagInfo);
+        my (%set, %mayDelete, $tagInfo, %hasNewID);
         my $wrongDir = $crossDelete{$dirName};
         my @newTagInfo = $et->GetNewTagInfoList($tagTablePtr);
         foreach $tagInfo (@newTagInfo) {
             my $tagID = $$tagInfo{TagID};
+            $hasNewID{$tagID} = 1;
             # must evaluate Condition later when we have all DataMember's available
             $set{$tagID} = (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) ? '' : $tagInfo;
         }
@@ -723,7 +725,7 @@ Entry:  for (;;) {
                     $readFormat = $oldFormat = Get16u($dataPt, $entry+2);
                     $readCount = $oldCount = Get32u($dataPt, $entry+4);
                     undef $oldImageData;
-                    if ($oldFormat < 1 or $oldFormat > 13) {
+                    if ($oldFormat < 1 or $oldFormat > 13 and not ($oldFormat == 16 and $$et{Make} eq 'Apple' and $inMakerNotes)) {
                         my $msg = "Bad format ($oldFormat) for $name entry $index";
                         # patch to preserve invalid directory entries in SubIFD3 of
                         # various Kodak Z-series cameras (Z812, Z1085IS, Z1275)
@@ -972,7 +974,7 @@ Entry:  for (;;) {
                             $readCount = $oldSize / $formatSize[$readFormat];
                         }
                     }
-                    if ($oldID <= $lastTagID and not $inMakerNotes) {
+                    if ($oldID <= $lastTagID and not ($inMakerNotes or $et->IsRawType())) {
                         my $str = $oldInfo ? "$$oldInfo{Name} tag" : sprintf('tag 0x%x',$oldID);
                         if ($oldID == $lastTagID) {
                             $et->Warn("Duplicate $str in $name");
@@ -1006,6 +1008,23 @@ Entry:  for (;;) {
                 }
             } else {
                 $isNew = $oldID <=> $newID;
+                # special logic needed if directory has out-of-order entries
+                if ($unsorted and $isNew) {
+                    if ($isNew > 0 and $hasOldID{$newID}) {
+                        # we wanted to create the new tag, but an old tag
+                        # does exist with this ID, so defer writing the new tag
+                        $isNew = -1;
+                    }
+                    if ($isNew < 0 and $hasNewID{$oldID}) {
+                        # we wanted to write the old tag, but we have
+                        # a new tag with this ID, so move it up in the order
+                        my @tmpTags = ( $oldID );
+                        $_ == $oldID or push @tmpTags, $_ foreach @newTags;
+                        @newTags = @tmpTags;
+                        $newID = $oldID;
+                        $isNew = 0;
+                    }
+                }
             }
             my $newInfo = $oldInfo;
             my $newFormat = $oldFormat;
@@ -2170,17 +2189,39 @@ NoOverwrite:            next if $isNew > 0;
             my @offsetList;
             if ($ifd >= 0) {
                 my $offsetInfo = $offsetInfo[$ifd] or next;
+                if ($$offsetInfo{0x111} and $$offsetInfo{0x144}) {
+                    # SubIFD may contain double-referenced data as both strips and tiles
+                    # for Sony ARW files when SonyRawFileType is "Lossless Compressed RAW 2"
+                    if ($dirName eq 'SubIFD' and $$et{TIFF_TYPE} eq 'ARW' and
+                        $$offsetInfo{0x117} and $$offsetInfo{0x145} and
+                        $$offsetInfo{0x111}[2]==1) # (must be a single strip or the tile offsets could get out of sync)
+                    {
+                        # some Sony ARW images contain double-referenced raw data stored as both strips
+                        # and tiles.  Copy the data using only the strip tags, but store the TileOffets
+                        # information for updating later (see PanasonicRaw:PatchRawDataOffset for a
+                        # description of offsetInfo elements)
+                        $$offsetInfo{0x111}[5] = $$offsetInfo{0x144}; # hack to save TileOffsets
+                        # delete tile information from offsetInfo because we will copy as strips
+                        delete $$offsetInfo{0x144};
+                        delete $$offsetInfo{0x145};
+                    } else {
+                        $et->Error("TIFF $dirName contains both strip and tile data");
+                    }
+                }
                 # patch Panasonic RAW/RW2 StripOffsets/StripByteCounts if necessary
                 my $stripOffsets = $$offsetInfo{0x111};
-                if ($stripOffsets and $$stripOffsets[0]{PanasonicHack}) {
+                my $rawDataOffset = $$offsetInfo{0x118};
+                if ($stripOffsets and $$stripOffsets[0]{PanasonicHack} or
+                    $rawDataOffset and $$rawDataOffset[0]{PanasonicHack})
+                {
                     require Image::ExifTool::PanasonicRaw;
                     my $err = Image::ExifTool::PanasonicRaw::PatchRawDataOffset($offsetInfo, $raf, $ifd);
                     $err and $et->Error($err);
                 }
                 my $tagID;
-                # loop through all tags in reverse order so we save thumbnail
+                # loop through all tags in reverse numerical order so we save thumbnail
                 # data before main image data if both exist in the same IFD
-                foreach $tagID (reverse sort keys %$offsetInfo) {
+                foreach $tagID (reverse sort { $a <=> $b } keys %$offsetInfo) {
                     my $tagInfo = $$offsetInfo{$tagID}[0];
                     next unless $$tagInfo{IsOffset}; # handle byte counts with offsets
                     my $sizeInfo = $$offsetInfo{$$tagInfo{OffsetPair}};
@@ -2203,6 +2244,7 @@ NoOverwrite:            next if $isNew > 0;
                 }
             } else {
                 last unless @writeLater;
+                # finally, copy all deferred data
                 @offsetList = @writeLater;
             }
             my $offsetPair;
@@ -2296,6 +2338,23 @@ NoOverwrite:            next if $isNew > 0;
                         $size = length($buff);
                         Set32u($size, \$newData, $byteCountPos);
                     } elsif ($ifd < 0) {
+                        # hack for fixed-offset data (Panasonic GH6)
+                        if ($$offsetPair[0][6]) {
+                            if ($count > 1) {
+                                $et->Error("Can't handle fixed offsets with count > 1");
+                            } else {
+                                my $fixedOffset = Get32u(\$newData, $offsets);
+                                my $padToFixedOffset = $fixedOffset - ($newOffset + $dpos);
+                                if ($padToFixedOffset < 0) {
+                                    $et->Error('Metadata too large to fit before fixed-offset image data');
+                                } else {
+                                    # add necessary padding before raw data
+                                    push @imageData, [$offset+$dbase+$dpos, 0, $padToFixedOffset];
+                                    $newOffset += $padToFixedOffset;
+                                    $et->Warn("Adding $padToFixedOffset bytes of padding before fixed-offset image data", 1);
+                                }
+                            }
+                        }
                         # pad if necessary (but don't pad contiguous image blocks)
                         my $pad = 0;
                         ++$pad if ($blockSize + $size) & 0x01 and ($n+1 >= $count or
@@ -2406,10 +2465,28 @@ NoOverwrite:            next if $isNew > 0;
                     # also add to subIfdDataFixup if necessary
                     $subIfdDataFixup->AddFixup($offsetPos, $dataTag) if $subIfdDataFixup;
                     # must also (sometimes) update StripOffsets in Panasonic RW2 images
+                    # and TileOffsets in Sony ARW images
                     my $otherPos = $$offsetPair[0][5];
-                    if ($otherPos and $$tagInfo{PanasonicHack}) {
-                        Set32u($newOffset, \$newData, $otherPos);
-                        $fixup->AddFixup($otherPos, $dataTag);
+                    if ($otherPos) {
+                        if ($$tagInfo{PanasonicHack}) {
+                            Set32u($newOffset, \$newData, $otherPos);
+                            $fixup->AddFixup($otherPos, $dataTag);
+                        } elsif (ref $otherPos eq 'ARRAY') {
+                            # the image data was copied as one large strip, and is double-referenced
+                            # as tile data, so all we need to do now is properly update the tile offsets
+                            my $oldRawDataOffset = $$offsetPair[0][3][0];
+                            my $count = $$otherPos[2];
+                            my $i;
+                            # point to offsets in value data if more than one pointer
+                            $$otherPos[1] = Get32u(\$newData, $$otherPos[1]) if $count > 1;
+                            for ($i=0; $i<$count; ++$i) {
+                                my $oldTileOffset = $$otherPos[3][$i];
+                                my $ptrPos = $$otherPos[1] + 4 * $i;
+                                Set32u($newOffset + $oldTileOffset - $oldRawDataOffset, \$newData, $ptrPos);
+                                $fixup->AddFixup($ptrPos, $dataTag);
+                                $subIfdDataFixup->AddFixup($ptrPos, $dataTag) if $subIfdDataFixup;
+                            }
+                        }
                     }
                     if ($ifd >= 0) {
                         # buff length must be even (Note: may have changed since $size was set)

data/bin/lib/Image/ExifTool/WriteIPTC.pl

@@ -334,13 +334,9 @@ sub DoWriteIPTC($$$)
     # - improves speed
     # - avoids changing current MD5 digest unnecessarily
     # - avoids adding mandatory tags unless some other IPTC is changed
-    unless (exists $$et{EDIT_DIRS}{$$dirInfo{DirName}} or
+    return undef unless exists $$et{EDIT_DIRS}{$$dirInfo{DirName}} or
         # standard IPTC tags in other locations should be edited too (eg. AFCP_IPTC)
-        ($tagTablePtr eq \%Image::ExifTool::IPTC::Main and exists $$et{EDIT_DIRS}{IPTC}))
-    {
-        print $out "$$et{INDENT}  [nothing changed]\n" if $verbose;
-        return undef;
-    }
+        ($tagTablePtr eq \%Image::ExifTool::IPTC::Main and exists $$et{EDIT_DIRS}{IPTC});
     my $dataPt = $$dirInfo{DataPt};
     unless ($dataPt) {
         my $emptyData = '';

data/bin/lib/Image/ExifTool/WritePhotoshop.pl

@@ -138,13 +138,13 @@ sub WritePhotoshop($$$)
                 unless ($tagInfo) {
                     # process subdirectory anyway if writable (except EXIF to avoid recursion)
                     # --> this allows IPTC to be processed if found here in TIFF images
-                    # (note that I have seen a case of XMP in PSD-EXIFInfo-IFD0, and the EXIF
-                    #  exclusion means that this won't be written unless an EXIF tag is
-                    #  specifically edited, see forum10768 -- maybe this should be changed
-                    #  if it happens again)
+                    # (but allow EXIF to be written in PSD files if XMP or IPTC tags are
+                    #  being written because I have seen cases of XMP in PSD-EXIFInfo-IFD0
+                    #  and IPTC in PSD-EXIFInfo-IFD0-IPTC, see forum10768 and forum13198)
                     my $tmpInfo = $et->GetTagInfo($tagTablePtr, $tagID);
                     if ($tmpInfo and $$tmpInfo{SubDirectory} and
-                        $tmpInfo->{SubDirectory}->{TagTable} ne 'Image::ExifTool::Exif::Main')
+                        ($tmpInfo->{SubDirectory}->{TagTable} ne 'Image::ExifTool::Exif::Main' or
+                         ($$et{FILE_TYPE} eq 'PSD' and ($$editDirs{0x0404} or $$editDirs{0x0424}))))
                     {
                         my $table = Image::ExifTool::GetTagTable($tmpInfo->{SubDirectory}->{TagTable});
                         $tagInfo = $tmpInfo if $$table{WRITE_PROC};

data/bin/lib/Image/ExifTool/WriteQuickTime.pl

@@ -306,14 +306,17 @@ sub CheckQTValue($$$)
 
 #------------------------------------------------------------------------------
 # Format QuickTime value for writing
-# Inputs: 0) ExifTool ref, 1) value ref, 2) Format (or undef), 3) Writable (or undef)
-# Returns: Flags for QT data type, and reformats value as required
+# Inputs: 0) ExifTool ref, 1) value ref, 2) tagInfo ref, 3) Format (or undef)
+# Returns: Flags for QT data type, and reformats value as required (sets to undef on error)
 sub FormatQTValue($$;$$)
 {
-    my ($et, $valPt, $format, $writable) = @_;
+    my ($et, $valPt, $tagInfo, $format) = @_;
+    my $writable = $$tagInfo{Writable};
+    my $count = $$tagInfo{Count};
     my $flags;
+    $format or $format = $$tagInfo{Format};
     if ($format and $format ne 'string' or not $format and $writable and $writable ne 'string') {
-        $$valPt = WriteValue($$valPt, $format || $writable);
+        $$valPt = WriteValue($$valPt, $format || $writable, $count);
         if ($writable and $qtFormat{$writable}) {
             $flags = $qtFormat{$writable};
         } else {
@@ -329,6 +332,7 @@ sub FormatQTValue($$;$$)
         $flags = 0x01;  # UTF8
         $$valPt = $et->Encode($$valPt, 'UTF8');
     }
+    defined $$valPt or $et->WarnOnce("Error converting value for $$tagInfo{Name}");
     return $flags;
 }
 
@@ -1139,7 +1143,7 @@ sub WriteQuickTime($$$)
                                         my $newVal = $et->GetNewValue($nvHash);
                                         next unless defined $newVal;
                                         my $prVal = $newVal;
-                                        my $flags = FormatQTValue($et, \$newVal, $format, $$tagInfo{Writable});
+                                        my $flags = FormatQTValue($et, \$newVal, $tagInfo, $format);
                                         next unless defined $newVal;
                                         my ($ctry, $lang) = (0, 0);
                                         if ($$ti{LangCode}) {
@@ -1220,7 +1224,8 @@ sub WriteQuickTime($$$)
                                     }
                                     my $prVal = $newVal;
                                     # format new value for writing (and get new flags)
-                                    $flags = FormatQTValue($et, \$newVal, $format, $$tagInfo{Writable});
+                                    $flags = FormatQTValue($et, \$newVal, $tagInfo, $format);
+                                    next unless defined $newVal;
                                     my $grp = $et->GetGroup($langInfo, 1);
                                     $et->VerboseValue("- $grp:$$langInfo{Name}", $val);
                                     $et->VerboseValue("+ $grp:$$langInfo{Name}", $prVal);
@@ -1463,7 +1468,7 @@ sub WriteQuickTime($$$)
                 my $newVal = $et->GetNewValue($nvHash);
                 next unless defined $newVal;
                 my $prVal = $newVal;
-                my $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format}, $$tagInfo{Writable});
+                my $flags = FormatQTValue($et, \$newVal, $tagInfo);
                 next unless defined $newVal;
                 my ($ctry, $lang) = (0, 0);
                 # handle alternate languages