exiftool-vendored.pl 12.72.0 → 12.76.0

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

@@ -26,6 +26,7 @@ sub RemoveNewValuesForGroup($$);
 sub GetWriteGroup1($$);
 sub Sanitize($$);
 sub ConvInv($$$$$;$$);
+sub PushValue($$$;$);
 
 my $loadedAllTables;    # flag indicating we loaded all tables
 my $advFmtSelf;         # ExifTool object during evaluation of advanced formatting expr
@@ -1260,7 +1261,7 @@ sub SetNewValuesFromFile($$;@)
     }
     # expand shortcuts
     @setTags and ExpandShortcuts(\@setTags);
-    my $srcExifTool = new Image::ExifTool;
+    my $srcExifTool = Image::ExifTool->new;
     # set flag to indicate we are being called from inside SetNewValuesFromFile()
     $$srcExifTool{TAGS_FROM_FILE} = 1;
     # synchronize and increment the file sequence number
@@ -1302,6 +1303,7 @@ sub SetNewValuesFromFile($$;@)
         ImageHashType   => $$options{ImageHashType},
         Lang            => $$options{Lang},
         LargeFileSupport=> $$options{LargeFileSupport},
+        LimitLongValues => 10000000, # (10 MB)
         List            => 1,
         ListItem        => $$options{ListItem},
         ListSep         => $$options{ListSep},
@@ -1581,7 +1583,7 @@ SET:    foreach $set (@setList) {
         my $opts = $$set[3];
         # handle expressions
         if ($$opts{EXPR}) {
-            my $val = $srcExifTool->InsertTagValues(\@tags, $$set[1], 'Error');
+            my $val = $srcExifTool->InsertTagValues($$set[1], \@tags, 'Error');
             my $err = $$srcExifTool{VALUE}{Error};
             if ($err) {
                 # pass on any error as a warning unless it is suppressed
@@ -2431,7 +2433,7 @@ sub WriteInfo($$;$$)
 #
     until ($$self{VALUE}{Error}) {
         # create random access file object (disable seek test in case of straight copy)
-        $raf or $raf = new File::RandomAccess($inRef, 1);
+        $raf or $raf = File::RandomAccess->new($inRef, 1);
         $raf->BinMode();
         if ($numNew == $numPseudo) {
             $rtnVal = 1;
@@ -2702,7 +2704,7 @@ sub GetAllTags(;$)
     my (%allTags, @groups);
     @groups = split ':', $group if $group;
 
-    my $et = new Image::ExifTool;
+    my $et = Image::ExifTool->new;
     LoadAllTables();    # first load all our tables
     my @tableNames = keys %allTables;
 
@@ -2747,7 +2749,7 @@ sub GetWritableTags(;$)
     my (%writableTags, @groups);
     @groups = split ':', $group if $group;
 
-    my $et = new Image::ExifTool;
+    my $et = Image::ExifTool->new;
     LoadAllTables();
     my @tableNames = keys %allTables;
 
@@ -3123,11 +3125,37 @@ Conv: for (;;) {
     return($val, $err);
 }
 
+#------------------------------------------------------------------------------
+# Dereference value and push onto list
+# Inputs: 0) ExifTool ref, 1) value, 2) list ref, 3) flag to push MissingTagValue for undef value
+sub PushValue($$$;$)
+{
+    local $_;
+    my ($self, $val, $list, $missing) = @_;
+    if (ref $val eq 'ARRAY' and ref $$val[0] ne 'HASH') {
+        $self->PushValue($_, $list, $missing) foreach @$val;
+    } elsif (ref $val eq 'SCALAR') {
+        if ($$self{OPTIONS}{Binary} or $$val =~ /^Binary data/) {
+            push @$list, $$val;
+        } else {
+            push @$list, 'Binary data ' . length($$val) . ' bytes';
+        }
+    } elsif (ref $val eq 'HASH' or ref $val eq 'ARRAY') {
+        require 'Image/ExifTool/XMPStruct.pl';
+        push @$list, Image::ExifTool::XMP::SerializeStruct($self, $val);
+    } elsif (not defined $val) {
+        my $mval = $$self{OPTIONS}{MissingTagValue};
+        push @$list, $mval if $missing and defined $mval;
+    } else {
+        push @$list, $val;
+    }
+}
+
 #------------------------------------------------------------------------------
 # Convert tag names to values or variables in a string
 # (eg. '${EXIF:ISO}x $$' --> '100x $' without hash ref, or "$info{'EXIF:ISO'}x $" with)
-# Inputs: 0) ExifTool object ref, 1) reference to list of found tags
-#         2) string with embedded tag names, 3) Options:
+# Inputs: 0) ExifTool object ref, 1) string with embedded tag names,
+#         2) reference to list of found tags or undef to use FOUND_TAGS, 3) Options:
 #               undef    - set missing tags to ''
 #              'Error'   - issue minor error on missing tag (and return undef)
 #              'Warn'    - issue minor warning on missing tag (and return undef)
@@ -3144,20 +3172,22 @@ Conv: for (;;) {
 # - advanced feature allows Perl expressions inside braces (eg. '${model;tr/ //d}')
 # - an error/warning in an advanced expression ("${TAG;EXPR}") generates an error
 #   if option set to 'Error', or a warning otherwise
-sub InsertTagValues($$$;$$$)
+sub InsertTagValues($$;$$$$)
 {
     local $_;
-    my ($self, $foundTags, $line, $opt, $docGrp, $cache) = @_;
+    my ($self, $line, $foundTags, $opt, $docGrp, $cache) = @_;
     my $rtnStr = '';
     my ($docNum, $tag);
+
     if ($docGrp) {
         $docNum = $docGrp =~ /(\d+)$/ ? $1 : 0;
     } else {
         undef $cache;   # no cache if no document groups
     }
+    $foundTags or $foundTags = $$self{FOUND_TAGS} || [];
     while ($line =~ s/(.*?)\$(\{\s*)?([-\w]*\w|\$|\/)//s) {
         my ($pre, $bra, $var) = ($1, $2, $3);
-        my (@tags, $val, $tg, @val, $type, $expr, $didExpr, $level, $asList);
+        my (@tags, $tg, $val, @val, $type, $expr, $didExpr, $level, $asList);
         # "$$" represents a "$" symbol, and "$/" is a newline
         if ($var eq '$' or $var eq '/') {
             $line =~ s/^\s*\}// if $bra;
@@ -3260,15 +3290,24 @@ sub InsertTagValues($$$;$$$)
                 } elsif (defined $$et{OPTIONS}{UserParam}{$lcTag}) {
                     $val = $$et{OPTIONS}{UserParam}{$lcTag};
                 } elsif ($tag =~ /(.*):(.+)/) {
-                    my $group;
+                    my ($group, @matches);
                     ($group, $tag) = ($1, $2);
-                    if (lc $tag eq 'all') {
-                        # see if any tag from the specified group exists
-                        my $match = $et->GroupMatches($group, $fileTags);
-                        $val = $match ? 1 : 0;
+                    # join values of all matching tags if "All" group is used
+                    # (and remove "All" from group prefix)
+                    if ($group =~ s/(^|:)(all|\*)(:|$)/$1 and $3/ei) {
+                        if (lc $tag eq 'all') {
+                            @matches = $group ? $et->GroupMatches($group, $fileTags) : @$fileTags;
+                        } else {
+                            @matches = grep /^$tag(\s|$)/i, @$fileTags;
+                            @matches = $et->GroupMatches($group, \@matches) if $group;
+                        }
+                        $self->PushValue(scalar $et->GetValue($_, $type), \@val) foreach @matches;
+                    } elsif (lc $tag eq 'all') {
+                        # return "1" if any tag from the specified group exists
+                        $val = $et->GroupMatches($group, $fileTags) ? 1 : 0;
                     } else {
                         # find the specified tag
-                        my @matches = grep /^$tag(\s|$)/i, @$fileTags;
+                        @matches = grep /^$tag(\s|$)/i, @$fileTags;
                         @matches = $et->GroupMatches($group, \@matches);
                         foreach $tg (@matches) {
                             if (defined $val and $tg =~ / \((\d+)\)$/) {
@@ -3297,31 +3336,15 @@ sub InsertTagValues($$$;$$$)
                 }
             }
             $self->Options(ListJoin => $oldListJoin) if $asList;
-            if (ref $val eq 'ARRAY') {
-                push @val, @$val;
-                undef $val;
-                last unless @tags;
-            } elsif (ref $val eq 'SCALAR') {
-                if ($$self{OPTIONS}{Binary} or $$val =~ /^Binary data/) {
-                    $val = $$val;
-                } else {
-                    $val = 'Binary data ' . length($$val) . ' bytes';
-                }
-            } elsif (ref $val eq 'HASH') {
-                require 'Image/ExifTool/XMPStruct.pl';
-                $val = Image::ExifTool::XMP::SerializeStruct($self, $val);
-            } elsif (not defined $val) {
-                $val = $$self{OPTIONS}{MissingTagValue} if $asList;
-            }
-            last unless @tags;
-            push @val, $val if defined $val;
+            $self->PushValue($val, \@val, $asList);
             undef $val;
+            last unless @tags;
         }
         if (@val) {
-            push @val, $val if defined $val;
+            $self->PushValue($val, \@val) if defined $val;
             $val = join $$self{OPTIONS}{ListSep}, @val;
-        } else {
-            push @val, $val if defined $val; # (so the eval has access to @val if required)
+        } elsif (defined $val) {
+            $self->PushValue($val, \@val);  # (so the eval has access to @val if required)
         }
         # evaluate advanced formatting expression if given (eg. "${TAG;EXPR}")
         if (defined $expr and defined $val) {
@@ -3330,7 +3353,7 @@ sub InsertTagValues($$$;$$$)
             $advFmtSelf = $self;
             if ($asList) {
                 foreach (@val) {
-                    #### eval advanced formatting expression ($_, $self, @val, $advFmtSelf)
+                    #### eval advanced formatting expression ($_, $self, @val, $tag, $advFmtSelf)
                     eval $expr;
                     $@ and $evalWarning = $@;
                 }
@@ -3339,7 +3362,7 @@ sub InsertTagValues($$$;$$$)
                 $val = @val ? join $$self{OPTIONS}{ListSep}, @val : undef;
             } else {
                 $_ = $val;
-                #### eval advanced formatting expression ($_, $self, @val, $advFmtSelf)
+                #### eval advanced formatting expression ($_, $self, @val, $tag, $advFmtSelf)
                 eval $expr;
                 $@ and $evalWarning = $@;
                 $val = ref $_ eq 'ARRAY' ? join($$self{OPTIONS}{ListSep}, @$_): $_;
@@ -3394,6 +3417,7 @@ sub InsertTagValues($$$;$$$)
 #------------------------------------------------------------------------------
 # Reformat date/time value in $_ based on specified format string
 # Inputs: 0) date/time format string
+# Returns: Reformatted date/time string
 sub DateFmt($)
 {
     my $et = bless { OPTIONS => { DateFormat => shift, StrictDate => 1 } };
@@ -3405,6 +3429,7 @@ sub DateFmt($)
     $_ = $et->ConvertDateTime($_);
     defined $_ or warn "Error converting date/time\n";
     $$advFmtSelf{GLOBAL_TIME_OFFSET} = $$et{GLOBAL_TIME_OFFSET} if $shift;
+    return $_;
 }
 
 #------------------------------------------------------------------------------
@@ -3514,7 +3539,7 @@ sub CreateDirectory($$)
                     }
                     unless ($k32CreateDir) {
                         return -1 if defined $k32CreateDir;
-                        $k32CreateDir = new Win32::API('KERNEL32', 'CreateDirectoryW', 'PP', 'I');
+                        $k32CreateDir = Win32::API->new('KERNEL32', 'CreateDirectoryW', 'PP', 'I');
                         unless ($k32CreateDir) {
                             $self->Warn('Error calling Win32::API::CreateDirectoryW');
                             $k32CreateDir = 0;
@@ -4506,6 +4531,7 @@ sub HexDump($;$%)
 #        Count => number of values
 #        Extra => Extra Verbose=2 information to put after tag number
 #        Table => Reference to tag table
+#        Name => Name to use for unknown tag
 #        --> plus any of these HexDump() options: Start, Addr, Width
 sub VerboseInfo($$$%)
 {
@@ -4523,6 +4549,9 @@ sub VerboseInfo($$$%)
     # get tag name
     if ($tagInfo and $$tagInfo{Name}) {
         $tag = $$tagInfo{Name};
+    } elsif ($parms{Name}) { # (used for PNG Plus FPX tags)
+        $tag = $parms{Name};
+        undef $hexID;
     } else {
         my $prefix;
         $prefix = $parms{Table}{TAG_PREFIX} if $parms{Table};
@@ -6228,7 +6257,7 @@ sub WriteJPEG($$)
                     last unless $$editDirs{CIFF};
                     my $newData = '';
                     my %dirInfo = (
-                        RAF => new File::RandomAccess($segDataPt),
+                        RAF => File::RandomAccess->new($segDataPt),
                         OutFile => \$newData,
                     );
                     require Image::ExifTool::CanonRaw;
@@ -6947,7 +6976,7 @@ sub SetFileTime($$;$$$$)
             }
             unless ($k32SetFileTime) {
                 return 0 if defined $k32SetFileTime;
-                $k32SetFileTime = new Win32::API('KERNEL32', 'SetFileTime', 'NPPP', 'I');
+                $k32SetFileTime = Win32::API->new('KERNEL32', 'SetFileTime', 'NPPP', 'I');
                 unless ($k32SetFileTime) {
                     $self->Warn('Error calling Win32::API::SetFileTime');
                     $k32SetFileTime = 0;
@@ -7191,7 +7220,7 @@ sub WriteBinaryData($$$)
                 $$self{HiddenData} = {
                     Offset => $offset,
                     Size   => $size,
-                    Fixup  => new Image::ExifTool::Fixup,
+                    Fixup  => Image::ExifTool::Fixup->new,
                     Base   => $$dirInfo{Base},
                 };
                 next;
@@ -7200,7 +7229,7 @@ sub WriteBinaryData($$$)
             next unless $$tagInfo{DataTag} eq 'PreviewImage' and $$self{FILE_TYPE} eq 'JPEG';
             my $previewInfo = $$self{PREVIEW_INFO};
             $previewInfo or $previewInfo = $$self{PREVIEW_INFO} = {
-                Fixup => new Image::ExifTool::Fixup,
+                Fixup => Image::ExifTool::Fixup->new,
             };
             # set flag indicating we are using short pointers
             $$previewInfo{IsShort} = 1 unless $format eq 'int32u';
@@ -7304,7 +7333,7 @@ used routines.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/XISF.pm

@@ -163,7 +163,7 @@ information from XISF (Extensible Image Serialization Format) images.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/XMP.pm

@@ -50,7 +50,7 @@ use Image::ExifTool::Exif;
 use Image::ExifTool::GPS;
 require Exporter;
 
-$VERSION = '3.61';
+$VERSION = '3.63';
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(EscapeXML UnescapeXML);
 
@@ -201,6 +201,7 @@ my %xmpNS = (
     nine      => 'http://ns.nikon.com/nine/1.0/',
     hdr_metadata => 'http://ns.adobe.com/hdr-metadata/1.0/',
     hdrgm     => 'http://ns.adobe.com/hdr-gain-map/1.0/',
+    xmpDSA    => 'http://leica-camera.com/digital-shift-assistant/1.0/',
   # Note: Not included due to namespace prefix conflict with Device:Container
   # Container => 'http://ns.google.com/photos/1.0/container/',
 );
@@ -921,6 +922,10 @@ my %sRangeMask = (
         Name => 'hdrgm',
         SubDirectory => { TagTable => 'Image::ExifTool::XMP::hdrgm' },
     },
+    xmpDSA => {
+        Name => 'xmpDSA',
+        SubDirectory => { TagTable => 'Image::ExifTool::Panasonic::DSA' },
+    },
   # Note: Note included due to namespace prefix conflict with Device:Container
   # Container => {
   #     Name => 'Container',
@@ -3639,6 +3644,7 @@ NoLoop:
             IgnoreProp => $$subdir{IgnoreProp}, # (allow XML to ignore specified properties)
             IsExtended => 1, # (hack to avoid Duplicate warning for embedded XMP)
             NoStruct => 1,   # (don't try to build structures since this isn't true XMP)
+            NoBlockSave => 1,# (don't save as a block because we already did this)
         );
         my $oldOrder = GetByteOrder();
         SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
@@ -4158,7 +4164,18 @@ sub ProcessXMP($$;$)
         $dataLen = $$dirInfo{DataLen} || length($$dataPt);
         # check leading BOM (may indicate double-encoded UTF)
         pos($$dataPt) = $dirStart;
-        $double = $1 if $$dataPt =~ /\G((\0\0)?\xfe\xff|\xff\xfe(\0\0)?|\xef\xbb\xbf)\0*<\0*\?\0*x\0*p\0*a\0*c\0*k\0*e\0*t/g;
+        if ($$dataPt =~ /\G((\0\0)?\xfe\xff|\xff\xfe(\0\0)?|\xef\xbb\xbf)\0*<\0*\?\0*x\0*p\0*a\0*c\0*k\0*e\0*t/g) {
+            $double = $1 
+        } else {
+            # handle UTF-16/32 XML
+            pos($$dataPt) = $dirStart;
+            if ($$dataPt =~ /\G((\0\0)?\xfe\xff|\xff\xfe(\0\0)?|\xef\xbb\xbf)\0*<\0*\?\0*x\0*m\0*l\0* /g) {
+                my $tmp = $1;
+                $fmt = $tmp =~ /\xfe\xff/ ? 'n' : 'v';
+                $fmt = uc($fmt) if $tmp =~ /\0\0/;
+                $isXML = 1;
+            }
+        }
     } else {
         my ($type, $mime, $buf2, $buf3);
         # read information from XMP file
@@ -4516,7 +4533,7 @@ information.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/XMP2.pl

@@ -2191,6 +2191,15 @@ my %sSubVersion = (
     GROUPS => { 0 => 'SVG', 2 => 'Unknown' },
     LANG_INFO => \&GetLangInfo,
     NAMESPACE => undef, # variable namespace
+    'c2pa:manifest' => {
+        Name => 'JUMBF',
+        Groups => { 0 => 'JUMBF' },
+        RawConv => 'Image::ExifTool::XMP::DecodeBase64($val)',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::Jpeg2000::Main',
+            ByteOrder => 'BigEndian',
+        },
+    },
 );
 
 #------------------------------------------------------------------------------
@@ -2228,7 +2237,7 @@ This file contains definitions for less common XMP namespaces.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/XMPStruct.pl

@@ -937,7 +937,7 @@ information.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/ZIP.pm

@@ -20,7 +20,7 @@ use strict;
 use vars qw($VERSION $warnString);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.30';
+$VERSION = '1.31';
 
 sub WarnProc($) { $warnString = $_[0]; }
 
@@ -367,7 +367,7 @@ sub ProcessRAR($$)
             # read the header and create new RAF object for reading it
             my $header;
             $raf->Read($header, $headSize) == $headSize or last;
-            my $rafHdr = new File::RandomAccess(\$header);
+            my $rafHdr = File::RandomAccess->new(\$header);
             my $headType = ReadULEB($rafHdr);   # get header type
 
             if ($headType == 4) {  # encryption block
@@ -550,14 +550,14 @@ sub ProcessZIP($$)
         } elsif (eval { require IO::String }) {
             # read the whole file into memory (what else can I do?)
             $raf->Slurp();
-            $fh = new IO::String ${$raf->{BUFF_PT}};
+            $fh = IO::String->new(${$raf->{BUFF_PT}});
         } else {
             my $type = $raf->{FILE_PT} ? 'pipe or socket' : 'scalar reference';
             $et->Warn("Install IO::String to decode compressed ZIP information from a $type");
             last;
         }
         $et->VPrint(1, "  --- using Archive::Zip ---\n");
-        $zip = new Archive::Zip;
+        $zip = Archive::Zip->new;
         # catch all warnings! (Archive::Zip is bad for this)
         local $SIG{'__WARN__'} = \&WarnProc;
         my $status = $zip->readFromFileHandle($fh);
@@ -568,8 +568,8 @@ sub ProcessZIP($$)
             # a failed test with Perl 5.6.2 GNU/Linux 2.6.32-5-686 i686-linux-64int-ld
             $raf->Seek(0,0);
             $raf->Slurp();
-            $fh = new IO::String ${$raf->{BUFF_PT}};
-            $zip = new Archive::Zip;
+            $fh = IO::String->new(${$raf->{BUFF_PT}});
+            $zip = Archive::Zip->new;
             $status = $zip->readFromFileHandle($fh);
         }
         if ($status) {
@@ -836,7 +836,7 @@ Electronic Publication (EPUB), and Sketch design files (SKETCH).
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/ZISRAW.pm

@@ -220,7 +220,7 @@ metadata from Zeiss Integrated Software RAW (ZISRAW) CZI files.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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/iWork.pm

@@ -215,7 +215,7 @@ information from Apple iWork '09 XML+ZIP files.
 
 =head1 AUTHOR
 
-Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2024, 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.