exiftool-vendored.pl 12.60.0 → 12.65.0

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

@@ -17,7 +17,7 @@ package Image::ExifTool::Validate;
 use strict;
 use vars qw($VERSION %exifSpec);
 
-$VERSION = '1.20';
+$VERSION = '1.21';
 
 use Image::ExifTool qw(:Utils);
 use Image::ExifTool::Exif;
@@ -56,6 +56,15 @@ use Image::ExifTool::Exif;
     0x212 => 1,  0x9204 => 1,   0xa210 => 1,   0xa500 => 221,
     0x213 => 1,  0x9205 => 1,   0xa214 => 1,
     0x214 => 1,  0x9206 => 1,   0xa215 => 1,
+
+    # new Exif 3.0 tags
+    0xa436 => 300,
+    0xa437 => 300,
+    0xa438 => 300,
+    0xa439 => 300,
+    0xa43a => 300,
+    0xa43b => 300,
+    0xa43c => 300,
 );
 
 # GPSVersionID numbers when each tag was introduced
@@ -147,6 +156,13 @@ my %stdFormat = (
         0xc68d => 'int(16|32)u',                 0xc791 => 'int(16|32)u',
         0xc68e => 'int(16|32)u',                 0xc792 => 'int(16|32)u',
         0xc6d2 => '',                            0xc793 => '(int16u|int32u|rational64u)',
+        # Exif 3.0 spec
+        0x10e  => 'string|utf8',  0xa430 => 'string|utf8',  0xa439 => 'string|utf8',
+        0x10f  => 'string|utf8',  0xa433 => 'string|utf8',  0xa43a => 'string|utf8',
+        0x110  => 'string|utf8',  0xa434 => 'string|utf8',  0xa43b => 'string|utf8',
+        0x131  => 'string|utf8',  0xa436 => 'string|utf8',  0xa43c => 'string|utf8',
+        0x13b  => 'string|utf8',  0xa437 => 'string|utf8',  0xa43a => 'string|utf8',
+        0x8298 => 'string|utf8',  0xa438 => 'string|utf8',
     },
 );
 

package/bin/lib/Image/ExifTool/WPG.pm

@@ -0,0 +1,296 @@
+#------------------------------------------------------------------------------
+# File:         WPG.pm
+#
+# Description:  Read WordPerfect Graphics meta information
+#
+# Revisions:    2023-05-01 - P. Harvey Created
+#
+# References:   1) https://www.fileformat.info/format/wpg/egff.htm
+#               2) https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up
+#               3) http://libwpg.sourceforge.net/
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::WPG;
+
+use strict;
+use vars qw($VERSION);
+use Image::ExifTool qw(:DataAccess :Utils);
+
+$VERSION = '1.00';
+
+sub PrintRecord($$$);
+
+# WPG metadata
+%Image::ExifTool::WPG::Main = (
+    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
+    VARS => { NO_ID => 1 },
+    NOTES => 'Tags extracted from WordPerfect Graphics (WPG) images.',
+    WPGVersion => { },
+    ImageWidthInches  => { PrintConv => 'sprintf("%.2f",$val)' },
+    ImageHeightInches => { PrintConv => 'sprintf("%.2f",$val)' },
+    Records => {
+        Notes => 'records for version 1.0 files',
+        List => 1,
+        PrintHex => 2,
+        PrintConvColumns => 2,
+        PrintConv => {
+            OTHER => \&PrintRecord,
+            0x01 => 'Fill Attributes',
+            0x02 => 'Line Attributes',
+            0x03 => 'Marker Attributes',
+            0x04 => 'Polymarker',
+            0x05 => 'Line',
+            0x06 => 'Polyline',
+            0x07 => 'Rectangle',
+            0x08 => 'Polygon',
+            0x09 => 'Ellipse',
+            0x0a => 'Reserved',
+            0x0b => 'Bitmap (Type 1)',
+            0x0c => 'Graphics Text (Type 1)',
+            0x0d => 'Graphics Text Attributes',
+            0x0e => 'Color Map',
+            0x0f => 'Start WPG (Type 1)',
+            0x10 => 'End WPG',
+            0x11 => 'PostScript Data (Type 1)',
+            0x12 => 'Output Attributes',
+            0x13 => 'Curved Polyline',
+            0x14 => 'Bitmap (Type 2)',
+            0x15 => 'Start Figure',
+            0x16 => 'Start Chart',
+            0x17 => 'PlanPerfect Data',
+            0x18 => 'Graphics Text (Type 2)',
+            0x19 => 'Start WPG (Type 2)',
+            0x1a => 'Graphics Text (Type 3)',
+            0x1b => 'PostScript Data (Type 2)',
+        },
+    },
+    RecordsV2 => {
+        Notes => 'records for version 2.0 files',
+        List => 1,
+        PrintHex => 2,
+        PrintConvColumns => 2,
+        PrintConv => {
+            OTHER => \&PrintRecord,
+            0x00 => 'End Marker',
+            0x01 => 'Start WPG',
+            0x02 => 'End WPG',
+            0x03 => 'Form Settings',
+            0x04 => 'Ruler Settings',
+            0x05 => 'Grid Settings',
+            0x06 => 'Layer',
+            0x08 => 'Pen Style Definition',
+            0x09 => 'Pattern Definition',
+            0x0a => 'Comment',
+            0x0b => 'Color Transfer',
+            0x0c => 'Color Palette',
+            0x0d => 'DP Color Palette',
+            0x0e => 'Bitmap Data',
+            0x0f => 'Text Data',
+            0x10 => 'Chart Style',
+            0x11 => 'Chart Data',
+            0x12 => 'Object Image',
+            0x15 => 'Polyline',
+            0x16 => 'Polyspline',
+            0x17 => 'Polycurve',
+            0x18 => 'Rectangle',
+            0x19 => 'Arc',
+            0x1a => 'Compound Polygon',
+            0x1b => 'Bitmap',
+            0x1c => 'Text Line',
+            0x1d => 'Text Block',
+            0x1e => 'Text Path',
+            0x1f => 'Chart',
+            0x20 => 'Group',
+            0x21 => 'Object Capsule',
+            0x22 => 'Font Settings',
+            0x25 => 'Pen Fore Color',
+            0x26 => 'DP Pen Fore Color',
+            0x27 => 'Pen Back Color',
+            0x28 => 'DP Pen Back Color',
+            0x29 => 'Pen Style',
+            0x2a => 'Pen Pattern',
+            0x2b => 'Pen Size',
+            0x2c => 'DP Pen Size',
+            0x2d => 'Line Cap',
+            0x2e => 'Line Join',
+            0x2f => 'Brush Gradient',
+            0x30 => 'DP Brush Gradient',
+            0x31 => 'Brush Fore Color',
+            0x32 => 'DP Brush Fore Color',
+            0x33 => 'Brush Back Color',
+            0x34 => 'DP Brush Back Color',
+            0x35 => 'Brush Pattern',
+            0x36 => 'Horizontal Line',
+            0x37 => 'Vertical Line',
+            0x38 => 'Poster Settings',
+            0x39 => 'Image State',
+            0x3a => 'Envelope Definition',
+            0x3b => 'Envelope',
+            0x3c => 'Texture Definition',
+            0x3d => 'Brush Texture',
+            0x3e => 'Texture Alignment',
+            0x3f => 'Pen Texture ',
+        }
+    },
+);
+
+#------------------------------------------------------------------------------
+# Print record type
+# Inputs: 0) record type and count, 1) inverse flag, 2) PrintConv hash ref
+# Returns: converted record name
+sub PrintRecord($$$)
+{
+    my ($val, $inv, $printConv) = @_;
+    my ($type, $count) = split 'x', $val;
+    my $prt = $$printConv{$type} || sprintf('Unknown (0x%.2x)', $type);
+    $prt .= " x $count" if $count;
+    return $prt;
+}
+
+#------------------------------------------------------------------------------
+# Read variable-length integer
+# Inputs: 0) RAF ref
+# Returns: integer value
+sub ReadVarInt($)
+{
+    my $raf = shift;
+    my $buff;
+    $raf->Read($buff, 1) or return 0;
+    my $val = ord($buff);
+    if ($val == 0xff) {
+        $raf->Read($buff, 2) == 2 or return 0;
+        $val = unpack('v', $buff);
+        if ($val & 0x8000) {
+            $raf->Read($buff, 2) == 2 or return 0;
+            $val = (($val & 0x7fff) << 16) | unpack('v', $buff);
+        }
+    }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Read WPG version 1 or 2 image
+# Inputs: 0) ExifTool object reference, 1) dirInfo reference
+# Returns: 1 on success, 0 if this wasn't a valid WPG file
+sub ProcessWPG($$)
+{
+    my ($et, $dirInfo) = @_;
+    my $raf = $$dirInfo{RAF};
+    my ($buff, $lastType, $count);
+
+    # verify this is a valid WPG file
+    return 0 unless $raf->Read($buff, 16) == 16;
+    return 0 unless $buff =~ /^\xff\x57\x50\x43/;
+    $et->SetFileType();
+    SetByteOrder('II');
+    my $tagTablePtr = GetTagTable('Image::ExifTool::WPG::Main');
+    my $offset = Get32u(\$buff, 4);
+    my ($ver, $rev) = unpack('x10CC', $buff);
+    $et->HandleTag($tagTablePtr, WPGVersion => "$ver.$rev");
+    if ($ver < 1 or $ver > 2) {
+        # currently support only version 1 and 2 formats
+        $et->Warn('Unsupported WPG version');
+        return 1;
+    }
+    my $tag = $ver == 1 ? 'Records' : 'RecordsV2';
+    $raf->Seek($offset - 16, 1) or return 1 if $offset > 16;
+    # loop through records
+    for (;;) {
+        my ($type, $len, $getSize);
+        if ($raf->Read($buff, $ver) == $ver) {  # read 1 or 2 bytes, based on version
+            if ($ver == 1) {
+                # read version 1 record header
+                $type = ord($buff);
+                $len = ReadVarInt($raf);
+                $getSize = 1 if $type == 0x0f;  # Start WPG (Type 1)
+            } else {
+                # read version 2 record header
+                $type = unpack('xC', $buff);
+                ReadVarInt($raf);   # skip extensions
+                $len = ReadVarInt($raf);
+                $getSize = 1 if $type == 0x01;  # Start WPG
+                undef $type if $type > 0x3f;
+            }
+            if ($getSize) {
+                # read Start record to obtain image size
+                $raf->Read($buff, $len) == $len or $et->Warn('File format error'), last;
+                my ($w, $h, $xres, $yres);
+                if ($ver == 1) {
+                    ($w, $h) = unpack('x2vv', $buff);
+                } else {
+                    my ($precision, $format);
+                    ($xres, $yres, $precision) = unpack('vvC', $buff);
+                    if ($precision == 0 and $len >= 21) {
+                        $format = 'int16s';
+                    } elsif ($precision == 1 and $len >= 29) {
+                        $format = 'int32s';
+                    } else {
+                        $et->Warn('Invalid integer precision');
+                        next;
+                    }
+                    my ($x1,$y1,$x2,$y2) = ReadValue(\$buff, 13, $format, 4, $len-13);
+                    $w = abs($x2 - $x1);
+                    $h = abs($y2 - $y1);
+                }
+                $et->HandleTag($tagTablePtr, ImageWidthInches  => $w / ($xres || 1200));
+                $et->HandleTag($tagTablePtr, ImageHeightInches => $h / ($yres || 1200));
+            } else {
+                $raf->Seek($len, 1) or last; # skip to the next record
+            }
+        }
+        # go to some trouble to collapse identical sequential entries in record list
+        # (trying to keep the length of the list managable for complex images)
+        $lastType and $type and $type == $lastType and ++$count, next;
+        if ($lastType) {
+            my $val = $count > 1 ? "${lastType}x$count" : $lastType;
+            $et->HandleTag($tagTablePtr, $tag => $val);
+        }
+        last unless $type;
+        $lastType = $type;
+        $count = 1;
+    }
+    return 1;
+}
+
+1;  # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WPG - Read WPG meta information
+
+=head1 SYNOPSIS
+
+This module is used by Image::ExifTool
+
+=head1 DESCRIPTION
+
+This module contains definitions required by Image::ExifTool to read WPG
+(WordPerfect Graphics) images.
+
+=head1 AUTHOR
+
+Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 REFERENCES
+
+=over 4
+
+=item L<https://www.fileformat.info/format/wpg/egff.htm>
+
+=item L<https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up>
+
+=item L<http://libwpg.sourceforge.net/>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::TagNames/WPG Tags>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut

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

@@ -420,15 +420,15 @@ sub ValidateImageData($$$;$)
 }
 
 #------------------------------------------------------------------------------
-# Add specified image data to ImageDataMD5 hash
+# Add specified image data to ImageDataHash hash
 # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) lookup for [tagInfo,value] based on tagID
-sub AddImageDataMD5($$$)
+sub AddImageDataHash($$$)
 {
     my ($et, $dirInfo, $offsetInfo) = @_;
     my ($tagID, $offset, $buff);
 
     my $verbose = $et->Options('Verbose');
-    my $md5 = $$et{ImageDataMD5};
+    my $hash = $$et{ImageDataHash};
     my $raf = $$dirInfo{RAF};
 
     foreach $tagID (sort keys %$offsetInfo) {
@@ -451,12 +451,12 @@ sub AddImageDataMD5($$$)
             my $size = shift @sizes;
             next unless $offset =~ /^\d+$/ and $size and $size =~ /^\d+$/ and $size;
             next unless $raf->Seek($offset, 0); # (offset is absolute)
-            $total += $et->ImageDataMD5($raf, $size);
+            $total += $et->ImageDataHash($raf, $size);
         }
         if ($verbose) {
             my $name = "$$dirInfo{DirName}:$$tagInfo{Name}";
             $name =~ s/Offsets?|Start$//;
-            $et->VPrint(0, "$$et{INDENT}(ImageDataMD5: $total bytes of $name data)\n");
+            $et->VPrint(0, "$$et{INDENT}(ImageDataHash: $total bytes of $name data)\n");
         }
     }
 }
@@ -780,7 +780,7 @@ Entry:  for (;;) {
                     $readFormat = $oldFormat = Get16u($dataPt, $entry+2);
                     $readCount = $oldCount = Get32u($dataPt, $entry+4);
                     undef $oldImageData;
-                    if ($oldFormat < 1 or $oldFormat > 13 and not ($oldFormat == 16 and $$et{Make} eq 'Apple' and $inMakerNotes)) {
+                    if (($oldFormat < 1 or $oldFormat > 13) and $oldFormat != 129 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)
@@ -1277,7 +1277,9 @@ NoWrite:            next if $isNew > 0;
                                 $et->Warn("Writing large value for $name",1);
                             }
                             # re-code if necessary
-                            if ($strEnc and $newFormName eq 'string') {
+                            if ($newFormName eq 'utf8') {
+                                $newValue = $et->Encode($newValue, 'UTF8');
+                            } elsif ($strEnc and $newFormName eq 'string') {
                                 $newValue = $et->Encode($newValue, $strEnc);
                             }
                         } else {

package/bin/lib/Image/ExifTool/WritePDF.pl

@@ -23,7 +23,7 @@ my $beginComment = '%BeginExifToolUpdate';
 my $endComment   = '%EndExifToolUpdate ';
 
 my $keyExt;     # crypt key extension
-my $pdfVer;     # version of PDF file we are currently writing
+my $pdfVer;     # version of PDF file we are writing (highest Version in Root dictionaries)
 
 # internal tags used in dictionary objects
 my %myDictTags = (
@@ -297,15 +297,11 @@ sub WritePDF($$)
     $$newTool{PDF_CAPTURE} = \%capture;
     my $info = $newTool->ImageInfo($raf, 'XMP', 'PDF:*', 'Error', 'Warning');
     # not a valid PDF file unless we got a version number
-    # (note: can't just check $$info{PDFVersion} due to possibility of XMP-pdf:PDFVersion)
-    my $vers = $newTool->GetInfo('PDF:PDFVersion');
-    # take highest version number if multiple versions in an incremental save
-    ($pdfVer) = sort { $b <=> $a } values %$vers;
+    $pdfVer = $$newTool{PDFVersion};
     $pdfVer or $et->Error('Missing PDF:PDFVersion'), return 0;
     # check version number
-    if ($pdfVer > 1.7) {
-        $et->Warn("The PDF $pdfVer specification is not freely available", 1);
-        # (so writing by ExifTool is based on trial and error)
+    if ($pdfVer > 2.0) {
+        $et->Error("Writing PDF $pdfVer is untested", 1) and return 0;
     }
     # fail if we had any serious errors while extracting information
     if ($capture{Error} or $$info{Error}) {
@@ -412,6 +408,9 @@ sub WritePDF($$)
     my $tagID;
     foreach $tagID (sort keys %$newTags) {
         my $tagInfo = $$newTags{$tagID};
+        if ($pdfVer >= 2.0 and not $$tagInfo{PDF2}) {
+            next if $et->Warn("Writing PDF:$$tagInfo{Name} is deprecated for PDF 2.0 documents",2);
+        }
         my $nvHash = $et->GetNewValueHash($tagInfo);
         my (@vals, $deleted);
         my $tag = $$tagInfo{Name};

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

@@ -973,16 +973,14 @@ sub WriteQuickTime($$$)
                 }
             } elsif ($tag eq 'CTBO' or $tag eq 'uuid') { # hack for updating CR3 CTBO offsets
                 push @{$$dirInfo{ChunkOffset}}, [ $tag, length($$outfile), length($hdr) + $size ];
-            } elsif (not $flg) {
-                my $grp = $$et{CUR_WRITE_GROUP} || $parent;
-                $et->Error("Can't locate data reference to update offsets for $grp");
-                return $rtnVal;
+            } elsif (not $flg or $flg == 1) {
+                # assume "1" if stsd is yet to be read
+                $flg or $$et{AssumedDataRef} = 1;
+                # must update offsets since the data is in this file
+                push @{$$dirInfo{ChunkOffset}}, [ $tag, length($$outfile) + length($hdr), $size ];
             } elsif ($flg == 3) {
                 $et->Error("Can't write files with mixed internal/external media data");
                 return $rtnVal;
-            } elsif ($flg == 1) {
-                # must update offsets since the data is in this file
-                push @{$$dirInfo{ChunkOffset}}, [ $tag, length($$outfile) + length($hdr), $size ];
             }
         }
 
@@ -1036,8 +1034,10 @@ sub WriteQuickTime($$$)
 
             if ($subdir) {  # process atoms in this container from a buffer in memory
 
-                undef $$et{HandlerType} if $tag eq 'trak';  # init handler type for this track
-
+                if ($tag eq 'trak') {
+                    undef $$et{HandlerType};  # init handler type for this track
+                    delete $$et{AssumedDataRef};
+                }
                 my $subName = $$subdir{DirName} || $$tagInfo{Name};
                 my $start = $$subdir{Start} || 0;
                 my $base = ($$dirInfo{Base} || 0) + $raf->Tell() - $size;
@@ -1103,6 +1103,11 @@ sub WriteQuickTime($$$)
                     $$et{CHANGED} = $oldChanged;
                     undef $newData;
                 }
+                if ($tag eq 'trak' and $$et{AssumedDataRef}) {
+                    my $grp = $$et{CUR_WRITE_GROUP} || $dirName;
+                    $et->Error("Can't locate data reference to update offsets for $grp");
+                    delete $$et{AssumedDataRef};
+                }
                 $$et{CUR_WRITE_GROUP} = $oldWriteGroup;
                 SetByteOrder('MM');
                 # add back header if necessary
@@ -1405,6 +1410,13 @@ sub WriteQuickTime($$$)
                 $flg = 1; # (this seems to be the case)
             }
             $$et{QtDataFlg} = $flg;
+            if ($$et{AssumedDataRef}) {
+                if ($flg != $$et{AssumedDataRef}) {
+                    my $grp = $$et{CUR_WRITE_GROUP} || $parent;
+                    $et->Error("Assumed incorrect data reference for $grp (was $flg)");
+                }
+                delete $$et{AssumedDataRef};
+            }
         }
         if ($tagInfo and $$tagInfo{WriteLast}) {
             $writeLast = ($writeLast || '') . $hdr . $buff;

package/bin/lib/Image/ExifTool/WriteXMP.pl

@@ -176,7 +176,7 @@ sub CheckXMP($$$;$)
         require 'Image/ExifTool/XMPStruct.pl';
         my ($item, $err, $w, $warn);
         unless (ref $$valPtr) {
-            ($$valPtr, $warn) = InflateStruct($valPtr);
+            ($$valPtr, $warn) = InflateStruct($et, $valPtr);
             # expect a structure HASH ref or ARRAY of structures
             unless (ref $$valPtr) {
                 $$valPtr eq '' and $$valPtr = { }, return undef; # allow empty structures
@@ -189,7 +189,7 @@ sub CheckXMP($$$;$)
             $$valPtr = \@copy;          # return the copy
             foreach $item (@copy) {
                 unless (ref $item eq 'HASH') {
-                    ($item, $w) = InflateStruct(\$item); # deserialize structure
+                    ($item, $w) = InflateStruct($et, \$item); # deserialize structure
                     $w and $warn = $w;
                     next if ref $item eq 'HASH';
                     $err = 'Improperly formed structure';