exiftool-vendored.pl 13.0.0 → 13.16.0

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

@@ -825,7 +825,7 @@ timed metadata from the 'mett' frame found in Parrot drone MP4 videos.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -6477,7 +6477,7 @@ tags, and everyone who helped contribute to the LensType values.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -450,7 +450,7 @@ sub WritePhaseOne($$$)
 
     return undef if $dirLen < 12;
     unless ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{ENTRY_SIZE}) {
-        $et->WarnOnce("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
+        $et->Warn("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
         return undef;
     }
     my $entrySize = $$tagTablePtr{VARS}{ENTRY_SIZE};
@@ -591,7 +591,7 @@ sub ProcessPhaseOne($$$)
 
     return 0 if $dirLen < 12;
     unless ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{ENTRY_SIZE}) {
-        $et->WarnOnce("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
+        $et->Warn("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
         return undef;
     }
     my $entrySize = $$tagTablePtr{VARS}{ENTRY_SIZE};
@@ -632,7 +632,7 @@ sub ProcessPhaseOne($$$)
             $formatSize = Get32u($dataPt, $entry+4);
             $formatStr = $formatName[$formatSize];
             unless ($formatStr) {
-                $et->WarnOnce("Unrecognized $ifdType format size $formatSize",1);
+                $et->Warn("Unrecognized $ifdType format size $formatSize",1);
                 $formatSize = 1;
                 $formatStr = 'undef';
             }
@@ -726,7 +726,7 @@ One maker notes.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -484,7 +484,7 @@ information from Kodak Photo CD Image Pac (PCD) files.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -237,7 +237,7 @@ write information written by the Camera Bits Photo Mechanic software.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -28,11 +28,12 @@ use strict;
 use vars qw($VERSION $AUTOLOAD $iptcDigestInfo %printFlags);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.70';
+$VERSION = '1.72';
 
 sub ProcessPhotoshop($$$);
 sub WritePhotoshop($$$);
 sub ProcessLayers($$$);
+sub ProcessChannelOptions($$$);
 
 # PrintFlags bit definitions (ref forum13785)
 %printFlags = (
@@ -322,7 +323,13 @@ my %unicodeString = (
     0x0432 => { Unknown => 1, Name => 'MeasurementScale' }, #7
     0x0433 => { Unknown => 1, Name => 'TimelineInfo' }, #7
     0x0434 => { Unknown => 1, Name => 'SheetDisclosure' }, #7
-    0x0435 => { Unknown => 1, Name => 'DisplayInfo' }, #7
+    0x0435 => {
+        Name => 'ChannelOptions', #7/forum16762
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::Photoshop::ChannelOptions',
+            Start => 4,
+        },
+    },
     0x0436 => { Unknown => 1, Name => 'OnionSkins' }, #7
     0x0438 => { Unknown => 1, Name => 'CountInfo' }, #7
     0x043a => { Unknown => 1, Name => 'PrintInfo2' }, #7
@@ -350,6 +357,41 @@ my %unicodeString = (
     0x2710 => { Unknown => 1, Name => 'PrintFlagsInfo' },
 );
 
+# Photoshop channel options (ref forum16762)
+%Image::ExifTool::Photoshop::ChannelOptions = (
+    PROCESS_PROC => \&ProcessChannelOptions,
+    VARS => { IS_BINARY => 1 },
+    GROUPS => { 2 => 'Image' },
+    NOTES => 'These tags relate only to the appearance of a channel.',
+    0 => {
+        Name => 'ChannelColorSpace',
+        Format => 'int16u',
+        PrintConv => {
+            0 => 'RGB',
+            1 => 'HSB',
+            2 => 'CMYK',
+            7 => 'Lab',
+            8 => 'Grayscale',
+        },
+    },
+    2 => {
+        Name => 'ChannelColorData',
+        Format => 'int16u[4]',
+    },
+    11 => {
+        Name => 'ChannelOpacity',
+        PrintConv => '"$val%"',
+    },
+    12 => {
+        Name => 'ChannelColorIndicates',
+        PrintConv => {
+            0 => 'Selected Areas',
+            1 => 'Masked Areas',
+            2 => 'Spot Color',
+        },
+    },
+);
+
 # Photoshop JPEG quality record (ref 2)
 %Image::ExifTool::Photoshop::JPEG_Quality = (
     PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
@@ -755,6 +797,25 @@ sub ProcessLayersAndMask($$$)
     return $raf->Seek($end, 0) ? 1 : 0;
 }
 
+#------------------------------------------------------------------------------
+# Process Photoshop channel options (ref forum16762)
+# Inputs: 0) ExifTool ref, 1) DirInfo ref, 2) tag table ref
+# Returns: 1 on success
+sub ProcessChannelOptions($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    my $end = $$dirInfo{DirStart}  + $$dirInfo{DirLen};
+    $$dirInfo{DirLen} = 13;
+    my $i;
+    for ($i=0; $$dirInfo{DirStart} + 13 <= $end; ++$i) {
+        $$et{SET_GROUP1} = "Channel$i";
+        $et->ProcessBinaryData($dirInfo, $tagTablePtr);
+        $$dirInfo{DirStart} += 13;
+    }
+    delete $$et{SET_GROUP1};
+    return 1;
+}
+
 #------------------------------------------------------------------------------
 # Process Photoshop layers (beginning with layer count)
 # Inputs: 0) ExifTool ref, 1) DirInfo ref, 2) tag table ref
@@ -1050,7 +1111,7 @@ sub ProcessPhotoshop($$$)
     if ($$et{VALUE}{IPTCDigest} and $$et{VALUE}{CurrentIPTCDigest} and
         $$et{VALUE}{IPTCDigest} ne $$et{VALUE}{CurrentIPTCDigest})
     {
-        $et->WarnOnce('IPTCDigest is not current. XMP may be out of sync');
+        $et->Warn('IPTCDigest is not current. XMP may be out of sync');
     }
     delete $$et{LOW_PRIORITY_DIR}{'*'};
     return $success;
@@ -1201,7 +1262,7 @@ be preserved when copying Photoshop information via user-defined tags.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -768,7 +768,7 @@ This code reads meta information from EPS (Encapsulated PostScript), PS
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -112,7 +112,7 @@ Print Image Matching meta information.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.

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

@@ -0,0 +1,270 @@
+#------------------------------------------------------------------------------
+# File:         Protobuf.pm
+#
+# Description:  Decode protocol buffer data
+#
+# Revisions:    2024-12-04 - P. Harvey Created
+#
+# Notes:        Tag definitions for Protobuf tags support additional 'signed',
+#               'unsigned' and 'int64s' formats for varInt (type 0) values,
+#               and 'rational' for byte (type 2) values
+#
+# References:   1) https://protobuf.dev/programming-guides/encoding/
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::Protobuf;
+
+use strict;
+use vars qw($VERSION);
+use Image::ExifTool qw(:DataAccess :Utils);
+
+$VERSION = '1.02';
+
+sub ProcessProtobuf($$$;$);
+
+#------------------------------------------------------------------------------
+# Read bytes from dirInfo object
+# Inputs: 0) dirInfo ref (with DataPt and Pos set), 1) number of bytes
+# Returns: binary data or undef on error
+sub GetBytes($$)
+{
+    my ($dirInfo, $n) = @_;
+    my $dataPt = $$dirInfo{DataPt};
+    my $pos = $$dirInfo{Pos};
+    return undef if $pos + $n > length $$dataPt;
+    $$dirInfo{Pos} += $n;
+    return substr($$dataPt, $pos, $n);
+}
+
+#------------------------------------------------------------------------------
+# Read variable-length integer
+# Inputs: 0) dirInfo ref
+# Returns: integer value
+sub VarInt($)
+{
+    my $dirInfo = shift;
+    my $val = 0;
+    my $shift = 0;
+    for (;;) {
+        my $buff = GetBytes($dirInfo, 1);
+        defined $buff or return undef;
+        $val += (ord($buff) & 0x7f) << $shift;
+        last unless ord($buff) & 0x80;
+        $shift += 7;
+    }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Read protobuf record
+# Inputs: 0) dirInfo ref
+# Returns: 0) record payload (plus tag id and format type in list context)
+# Notes: Updates dirInfo Pos to start of next record
+sub ReadRecord($)
+{
+    my $dirInfo = shift;
+    my $val = VarInt($dirInfo);
+    return undef unless defined $val;
+    my $id = $val >> 3;
+    my $type = $val & 0x07;
+    my $buff;
+
+    if ($type == 0) {       # varInt
+        $buff = VarInt($dirInfo);
+    } elsif ($type == 1) {  # 64-bit number
+        $buff = GetBytes($dirInfo, 8);
+    } elsif ($type == 2) {  # string, bytes or protobuf
+        my $len = VarInt($dirInfo);
+        if ($len) {
+            $buff = GetBytes($dirInfo, $len);
+        } else {
+            $buff = '';
+        }
+    } elsif ($type == 3) {  # (deprecated start group)
+        $buff = '';
+    } elsif ($type == 4) {  # (deprecated end group)
+        $buff = '';
+    } elsif ($type == 5) {  # 32-bit number
+        $buff = GetBytes($dirInfo, 4);
+    }
+    return wantarray ? ($buff, $id, $type) : $buff;
+}
+
+#------------------------------------------------------------------------------
+# Check to see if this could be a protobuf object
+# Inputs: 0) data reference
+# Retursn: true if this looks like a protobuf
+sub IsProtobuf($)
+{
+    my $pt = shift;
+    my $dirInfo = { DataPt => $pt, Pos => 0 };
+    for (;;) {
+        return 0 unless defined ReadRecord($dirInfo);
+        return 1 if $$dirInfo{Pos} == length $$pt;
+    }
+}
+
+#------------------------------------------------------------------------------
+# Process protobuf data (eg. DJI djmd timed data from Action4 videos) (ref 1)
+# Inputs: 0) ExifTool ref, 1) dirInfo ref with DataPt, DataPos, DirName and Base,
+#         2) tag table ptr, 3) prefix of parent protobuf ID's
+# Returns: true on success
+sub ProcessProtobuf($$$;$)
+{
+    my ($et, $dirInfo, $tagTbl, $prefix) = @_;
+    my $dataPt = $$dirInfo{DataPt};
+    my $dirName = $$dirInfo{DirName};
+    my $dirStart = $$dirInfo{DirStart} || 0;
+    my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
+    my $dirEnd = $dirStart + $dirLen;
+    my $dataPos = ($$dirInfo{Base} || 0) + ($$dirInfo{DataPos} || 0);
+    my $unknown = $et->Options('Unknown') || $et->Options('Verbose');
+
+    $$dirInfo{Pos} = $$dirInfo{DirStart} || 0; # initialize buffer Pos
+    $et->VerboseDir('Protobuf', undef, $dirLen);
+
+    unless ($prefix) {
+        $prefix = '';
+        $$et{ProtoPrefix}{$dirName} = '' unless defined $$et{ProtoPrefix}{$dirName};
+        SetByteOrder('II');
+    }
+    # loop through protobuf records
+    for (;;) {
+        my $pos = $$dirInfo{Pos};
+        last if $pos >= $dirEnd;
+        my ($buff, $id, $type) = ReadRecord($dirInfo);
+        defined $buff or $et->Warn('Protobuf format error'), last;
+        if ($type == 2 and $buff =~ /\.proto$/) {
+            # save protocol name separately for directory type
+            $$et{ProtoPrefix}{$dirName} = substr($buff, 0, -6) . '_';
+            $et->HandleTag($tagTbl, Protocol => $buff);
+        }
+        my $tag = "$$et{ProtoPrefix}{$dirName}$prefix$id";
+        my $tagInfo = $$tagTbl{$tag};
+        if ($tagInfo) {
+            next if $type != 2 and $$tagInfo{Unknown} and not $unknown;
+        } else {
+            next unless $type == 2 or $unknown;
+            $tagInfo = AddTagToTable($tagTbl, $tag, { Unknown => 1 });
+        }
+        # set IsProtobuf flag (only for Unknown tags) if necessary
+        if ($type == 2 and $$tagInfo{Unknown}) {
+            if ($$tagInfo{IsProtobuf}) {
+                $$tagInfo{IsProtobuf} = 0 unless IsProtobuf(\$buff);
+            } elsif (not defined $$tagInfo{IsProtobuf} and $buff =~ /[^\x20-\x7e]/ and
+                IsProtobuf(\$buff))
+            {
+                $$tagInfo{IsProtobuf} = 1;
+            }
+            next unless $$tagInfo{IsProtobuf} or $unknown;
+        }
+        # format binary payload into a useful value
+        my $val;
+        if ($$tagInfo{Format}) {
+            if ($type == 0) {
+                $val = $buff;
+                if ($$tagInfo{Format} eq 'signed') {
+                    $val = ($val & 1) ? -($val >> 1)-1 : ($val >> 1);
+                } elsif ($$tagInfo{Format} eq 'int64s' and $val > 0xffffffff) {
+                    # hack for DJI drones which store 64-bit signed integers improperly
+                    # (just toss upper 32 bits which should be all 1's anyway)
+                    $val = ($val & 0xffffffff) - 4294967296;
+                }
+            } elsif ($type == 2 and $$tagInfo{Format} eq 'rational') {
+                my $dir = { DataPt => \$buff, Pos => 0 };
+                my $num = VarInt($dir);
+                my $den = VarInt($dir);
+                $val = (defined $num and $den) ? "$num/$den" : 'err';
+            } else {
+                $val = ReadValue(\$buff, 0, $$tagInfo{Format}, undef, length($buff));
+            }
+        } elsif ($type == 0) {
+            $val = $buff;
+            my $hex = sprintf('%x', $val);
+            if (length($hex) == 16 and $hex =~ /^ffffffff/) {
+                my $s64 = hex(substr($hex, 8)) - 4294967296;
+                $val .= " (0x$hex, int64s $s64)";
+            } else {
+                my $signed = ($val & 1) ? -($val >> 1)-1 : ($val >> 1);
+                $val .= " (0x$hex, signed $signed)";
+            }
+        } elsif ($type == 1) {
+            $val = '0x' . unpack('H*', $buff) . ' (double ' . GetDouble(\$buff,0) . ')';
+        } elsif ($type == 2) {
+            if ($$tagInfo{SubDirectory}) {
+                # (fall through to process known SubDirectory)
+            } elsif ($$tagInfo{IsProtobuf}) {
+                # process Unknown protobuf directories
+                $et->VPrint(1, "$$et{INDENT}Protobuf $tag (" . length($buff) . " bytes) -->\n");
+                my $addr = $dataPos + $$dirInfo{Pos} - length($buff);
+                $et->VerboseDump(\$buff, Addr => $addr, Prefix => $$et{INDENT});
+                my %subdir = ( DataPt => \$buff, DataPos => $addr, DirName => $dirName );
+                $$et{INDENT} .= '| ';
+                ProcessProtobuf($et, \%subdir, $tagTbl, "$prefix$id-");
+                $$et{INDENT} = substr($$et{INDENT}, 0, -2);
+                next;
+            } elsif ($buff !~ /[^\x20-\x7e]/) {
+                $val = $buff;   # assume this is an ASCII string
+            } elsif (length($buff) % 4) {
+                $val = '0x' . unpack('H*', $buff);
+            } else {
+                $val = '0x' . join(' ', unpack('(H8)*', $buff)); # (group in 4-byte blocks)
+            }
+        } elsif ($type == 5) {
+            $val = '0x' . unpack('H*', $buff) . ' (int32u ' . Get32u(\$buff, 0);
+            $val .= ', int32s ' . Get32s(\$buff, 0) if ord(substr($buff,3,1)) & 0x80;
+            $val .= ', float ' . GetFloat(\$buff, 0) . ')';
+        } else {
+            $val = $buff;
+        }
+        # get length of data in the record
+        my $start = $type == 0 ? $pos + 1 : $$dirInfo{Pos} - length $buff;
+        $et->HandleTag($tagTbl, $tag, $val,
+            DataPt => $dataPt,
+            DataPos=> $dataPos,
+            Start  => $start,
+            Size   => $$dirInfo{Pos} - $start,
+            Extra  => ", type=$type",
+            Format => $$tagInfo{Format},
+        );
+    }
+    # warn if we didn't finish exactly at the end of the buffer
+    $et->Warn('Truncated protobuf data') unless $prefix or $$dirInfo{Pos} == $dirEnd;
+    return 1;
+}
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::Protobuf - Decode protocol buffer information
+
+=head1 SYNOPSIS
+
+This module is loaded automatically by Image::ExifTool when required.
+
+=head1 DESCRIPTION
+
+This module contains definitions required by Image::ExifTool to decode
+information in protocol buffer (protobuf) format.
+
+=head1 AUTHOR
+
+Copyright 2003-2025, 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://protobuf.dev/programming-guides/encoding/>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut

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

@@ -1331,7 +1331,7 @@ information from the APP7 Qualcomm segment in JPEG images.
 
 =head1 AUTHOR
 
-Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2025, 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.