exiftool-vendored.pl 12.31.0 → 12.39.0

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

@@ -223,7 +223,7 @@ characteristics of TXT and CSV files.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Theora.pm

@@ -122,7 +122,7 @@ information from Theora video streams.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Torrent.pm

@@ -310,7 +310,7 @@ bencoded information from BitTorrent files.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Unknown.pm

@@ -53,7 +53,7 @@ unknown manufacturers.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/VCard.pm

@@ -416,7 +416,7 @@ information from vCard VCF and iCalendar ICS files.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Validate.pm

@@ -659,7 +659,7 @@ ExifTool Validate option is enabled.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Vorbis.pm

@@ -228,7 +228,7 @@ information from Ogg Vorbis audio headers.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WTV.pm

@@ -297,7 +297,7 @@ This module contains definitions required by Image::ExifTool to read WTV
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WriteCanonRaw.pl

@@ -623,7 +623,7 @@ JPEG files, and would lead to far fewer problems with corrupted metadata.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WriteExif.pl

@@ -2563,7 +2563,7 @@ This file contains routines to write EXIF metadata.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WriteIPTC.pl

@@ -715,7 +715,7 @@ seldom-used routines.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WritePDF.pl

@@ -750,7 +750,7 @@ C<PDF-update> pseudo group).
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WritePNG.pl

@@ -61,7 +61,7 @@ sub HexEncode($)
 
 #------------------------------------------------------------------------------
 # Write profile chunk (possibly compressed if Zlib is available)
-# Inputs: 0) outfile, 1) Raw profile type, 2) data ref
+# Inputs: 0) outfile, 1) Raw profile type (SCALAR ref for iCCP name), 2) data ref
 #         3) profile header type (undef if not a text profile)
 # Returns: 1 on success
 sub WriteProfile($$$;$)
@@ -73,10 +73,10 @@ sub WriteProfile($$$;$)
     }
     if (not defined $profile) {
         # write ICC profile as compressed iCCP chunk if possible
-        if ($rawType eq 'icm') {
+        if (ref $rawType) {
             return 0 unless $deflate;
             $chunk = 'iCCP';
-            $prefix = "$rawType\0\0";
+            $prefix = "$$rawType\0\0";
         } else {
             $chunk = $rawType;
             if ($rawType eq $stdCase{zxif}) {
@@ -116,7 +116,7 @@ sub WriteProfile($$$;$)
 }
 
 #------------------------------------------------------------------------------
-# Add iCCP chunk to the PNG image if necessary (must come before PLTE and IDAT)
+# Add iCCP-related chunks to the PNG image if necessary (must come before PLTE and IDAT)
 # Inputs: 0) ExifTool object ref, 1) output file or scalar ref
 # Returns: true on success
 sub Add_iCCP($$)
@@ -127,9 +127,28 @@ sub Add_iCCP($$)
         my $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::ICC_Profile::Main');
         my %dirInfo = ( Parent => 'PNG', DirName => 'ICC_Profile' );
         my $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
-        if (defined $buff and length $buff and WriteProfile($outfile, 'icm', \$buff)) {
-            $et->VPrint(0, "Created ICC profile\n");
-            delete $$et{ADD_DIRS}{ICC_Profile}; # don't add it again
+        if (defined $buff and length $buff) {
+            my $profileName = $et->GetNewValue($Image::ExifTool::PNG::Main{'iCCP-name'});
+            $profileName = 'icm' unless defined $profileName;
+            if (WriteProfile($outfile, \$profileName, \$buff)) {
+                $et->VPrint(0, "Created ICC profile with name '${profileName}'\n");
+                delete $$et{ADD_DIRS}{ICC_Profile}; # don't add it again
+            }
+        }
+    }
+    # must also add sRGB and gAMA before PLTE and IDAT
+    if ($$et{ADD_PNG}) {
+        my ($tag, %addBeforePLTE);
+        foreach $tag (qw(sRGB gAMA)) {
+            next unless $$et{ADD_PNG}{$tag};
+            $addBeforePLTE{$tag} = $$et{ADD_PNG}{$tag};
+            delete $$et{ADD_PNG}{$tag};
+        }
+        if (%addBeforePLTE) {
+            my $save = $$et{ADD_PNG};
+            $$et{ADD_PNG} = \%addBeforePLTE;
+            AddChunks($et, $outfile);
+            $$et{ADD_PNG} = $save;
         }
     }
     return 1;
@@ -244,9 +263,10 @@ sub AddChunks($$;@)
     # write any outstanding PNG tags
     foreach $tag (sort keys %$addTags) {
         my $tagInfo = $$addTags{$tag};
+        next if $$tagInfo{FakeTag}; # (iCCP-name)
         my $nvHash = $et->GetNewValueHash($tagInfo);
-        # (native PNG information is always preferred, so don't check IsCreating)
-        next unless $et->IsOverwriting($nvHash);
+        # (native PNG information is always preferred, so don't rely on just IsCreating)
+        next unless $$nvHash{IsCreating} or $et->IsOverwriting($nvHash) > 0;
         my $val = $et->GetNewValue($nvHash);
         if (defined $val) {
             next if $$nvHash{EditOnly};
@@ -381,7 +401,7 @@ strings).
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WritePhotoshop.pl

@@ -257,7 +257,7 @@ default resource name, and applied if no appended name is provided.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WritePostScript.pl

@@ -687,7 +687,7 @@ Thanks to Tim Kordick for his help testing the EPS writer.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WriteQuickTime.pl

@@ -1067,6 +1067,9 @@ sub WriteQuickTime($$$)
                     #  3=optional base offset, 4=optional item ID)
                     ChunkOffset => \@chunkOffset,
                 );
+                # set InPlace flag so XMP will be padded properly when
+                # QuickTimePad is used if this is an XMP directory
+                $subdirInfo{InPlace} = 2 if $et->Options('QuickTimePad');
                 # pass the header pointer if necessary (for EXIF IFD's
                 # where the Base offset is at the end of the header)
                 if ($hdrLen and $hdrLen < $size) {
@@ -1331,6 +1334,14 @@ sub WriteQuickTime($$$)
             }
             # write the new atom if it was modified
             if (defined $newData) {
+                my $sizeDiff = length($buff) - length($newData);
+                # pad to original size if specified, otherwise give verbose message about the changed size
+                if ($sizeDiff > 0 and $$tagInfo{PreservePadding} and $et->Options('QuickTimePad')) {
+                    $newData .= "\0" x $sizeDiff;
+                    $et->VPrint(1, "    ($$tagInfo{Name} padded to original size)");
+                } elsif ($sizeDiff) {
+                    $et->VPrint(1, "    ($$tagInfo{Name} changed size)");
+                }
                 my $len = length($newData) + 8;
                 $len > 0x7fffffff and $et->Error("$$tagInfo{Name} to large to write"), last;
                 # update size in ChunkOffset list for modified 'uuid' atom
@@ -1912,7 +1923,7 @@ QuickTime-based file formats like MOV and MP4.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/WriteXMP.pl

@@ -1418,9 +1418,15 @@ sub WriteXMP($$;$)
             unless ($uri) {
                 $uri = $nsURI{$1};      # we must have added a namespace
                 unless ($uri) {
-                    # (namespace may be empty if trying to write empty XMP structure, forum12384)
-                    $xmpErr = "Undefined XMP namespace: $1" if length $uri;
-                    next;
+                    # (namespace prefix may be empty if trying to write empty XMP structure, forum12384)
+                     if (length $1) {
+                        my $err = "Undefined XMP namespace: $1";
+                        if (not $xmpErr or $err ne $xmpErr) {
+                            $xmpFile ? $et->Error($err) : $et->Warn($err);
+                            $xmpErr = $err;
+                        }
+                     }
+                     next;
                 }
             }
             $nsNew{$1} = $uri;
@@ -1586,14 +1592,7 @@ sub WriteXMP($$;$)
     unless (%capture or $xmpFile or $$dirInfo{InPlace} or $$dirInfo{NoDelete}) {
         $long[-2] = '';
     }
-    if ($xmpErr) {
-        if ($xmpFile) {
-            $et->Error($xmpErr);
-            return -1;
-        }
-        $et->Warn($xmpErr);
-        return undef;
-    }
+    return($xmpFile ? -1 : undef) if $xmpErr;
     $$et{CHANGED} += $changed;
     $debug > 1 and $long[-2] and print $long[-2],"\n";
     return $long[-2] unless $xmpFile;
@@ -1620,7 +1619,7 @@ This file contains routines to write XMP metadata.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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/Writer.pl

@@ -136,9 +136,9 @@ my %rawType = (
 my @delGroups = qw(
     Adobe AFCP APP0 APP1 APP2 APP3 APP4 APP5 APP6 APP7 APP8 APP9 APP10 APP11
     APP12 APP13 APP14 APP15 CanonVRD CIFF Ducky EXIF ExifIFD File FlashPix
-    FotoStation GlobParamIFD GPS ICC_Profile IFD0 IFD1 Insta360 InteropIFD
-    IPTC ItemList JFIF Jpeg2000 Keys MakerNotes Meta MetaIFD Microsoft MIE
-    MPF NikonCapture PDF PDF-update PhotoMechanic Photoshop PNG PNG-pHYs
+    FotoStation GlobParamIFD GPS ICC_Profile IFD0 IFD1 Insta360 InteropIFD IPTC
+    ItemList JFIF Jpeg2000 Keys MakerNotes Meta MetaIFD Microsoft MIE MPF
+    NikonApp NikonCapture PDF PDF-update PhotoMechanic Photoshop PNG PNG-pHYs
     PrintIM QuickTime RMETA RSRC SubIFD Trailer UserData XML XML-* XMP XMP-*
 );
 # family 2 group names that we can delete
@@ -154,7 +154,7 @@ my %delMore = (
 );
 
 # family 0 groups where directories should never be deleted
-my %permanentDir = ( QuickTime => 1 );
+my %permanentDir = ( QuickTime => 1, Jpeg2000 => 1 );
 
 # lookup for all valid family 2 groups (lower case)
 my %family2groups = map { lc $_ => 1 } @delGroup2, 'Unknown';
@@ -1400,7 +1400,10 @@ sub SetNewValuesFromFile($$;@)
                 }
             }
             # validate tag name(s)
-            $$opts{EXPR} or ValidTagName($tag) or $self->Warn("Invalid tag name '${tag}'"), next;
+            unless ($$opts{EXPR} or ValidTagName($tag)) {
+                $self->Warn("Invalid tag name '${tag}'. Use '=' not '<' to assign a tag value");
+                next;
+            }
             ValidTagName($dstTag) or $self->Warn("Invalid tag name '${dstTag}'"), next;
             # translate '+' and '-' to appropriate SetNewValue option
             if ($opt) {
@@ -2074,6 +2077,46 @@ sub SetSystemTags($$)
             last;
         }
     }
+    # delete Windows Zone.Identifier if specified
+    my $zhash = $self->GetNewValueHash($Image::ExifTool::Extra{ZoneIdentifier});
+    if ($zhash) {
+        my $res = -1;
+        if ($^O ne 'MSWin32') {
+            $self->Warn('ZoneIdentifer is a Windows-only tag');
+        } elsif (ref $file) {
+            $self->Warn('Writing ZoneIdentifer requires a file name');
+        } elsif (defined $self->GetNewValue('ZoneIdentifier', \$zhash)) {
+            $self->Warn('ZoneIndentifier may only be delted');
+        } elsif (not eval { require Win32API::File }) {
+            $self->Warn('Install Win32API::File to write ZoneIdentifier');
+        } else {
+            my ($wattr, $wide);
+            my $zfile = "${file}:Zone.Identifier";
+            if ($self->EncodeFileName($zfile)) {
+                $wide = 1;
+                $wattr = eval { Win32API::File::GetFileAttributesW($zfile) };
+            } else {
+                $wattr = eval { Win32API::File::GetFileAttributes($zfile) };
+            }
+            if ($wattr == Win32API::File::INVALID_FILE_ATTRIBUTES()) {
+                $res = 0; # file doesn't exist, nothing to do
+            } elsif ($wattr & Win32API::File::FILE_ATTRIBUTE_READONLY()) {
+                $self->Warn('Zone.Identifier stream is read-only');
+            } else {
+                if ($wide) {
+                    $res = 1 if eval { Win32API::File::DeleteFileW($zfile) };
+                } else {
+                    $res = 1 if eval { Win32API::File::DeleteFile($zfile) };
+                }
+                if ($res > 0) {
+                    $self->VPrint(0, "  Deleting Zone.Identifier stream\n");
+                } else {
+                    $self->Warn('Error deleting Zone.Identifier stream');
+                }
+            }
+        }
+        $result = $res if $res == 1 or not $result;
+    }
     return $result;
 }
 
@@ -3489,7 +3532,8 @@ PAT:    foreach $pattern (@patterns) {
 #         2) optional tag value (before RawConv) if deleting specific values
 # Returns: >0 - tag should be overwritten
 #          =0 - the tag should be preserved
-#          <0 - not sure, we need the value to know
+#          <0 - not sure, we need the old value to tell (if there is no old value
+#               then the tag should be written if $$nvHash{IsCreating} is true)
 # Notes: $$nvHash{Value} is updated with the new value when shifting a value
 sub IsOverwriting($$;$)
 {
@@ -4735,7 +4779,7 @@ sub InverseDateTime($$;$$)
     my ($rtnVal, $tz);
     my $fmt = $$self{OPTIONS}{DateFormat};
     # strip off timezone first if it exists
-    if (not $fmt and $val =~ s/([+-])(\d{1,2}):?(\d{2})\s*(DST)?$//i) {
+    if (not $fmt and $val =~ s/([-+])(\d{1,2}):?(\d{2})\s*(DST)?$//i) {
         $tz = sprintf("$1%.2d:$3", $2);
     } elsif (not $fmt and $val =~ s/Z$//i) {
         $tz = 'Z';
@@ -4758,6 +4802,8 @@ sub InverseDateTime($$;$$)
                 $strptimeLib = '';
             }
         }
+        # handle factional seconds (%f), but only at the end of the string
+        my $fs = ($fmt =~ s/%f$// and $val =~ s/(\.\d+)\s*$//) ? $1 : '';
         my ($lib, $wrn, @a);
 TryLib: for ($lib=$strptimeLib; ; $lib='') {
             if (not $lib) {
@@ -4794,10 +4840,10 @@ TryLib: for ($lib=$strptimeLib; ; $lib='') {
                         next TryLib;
                     }
                 } elsif (length($a[$i]) < 2) {
-                    $$a[$i] = "0$a[$i]";# pad to 2 digits if necessary
+                    $a[$i] = "0$a[$i]"; # pad to 2 digits if necessary
                 }
             }
-            $val = join(':', @a[5,4,3]) . ' ' . join(':', @a[2,1,0]);
+            $val = join(':', @a[5,4,3]) . ' ' . join(':', @a[2,1,0]) . $fs;
             last;
         }
     }
@@ -6991,7 +7037,7 @@ used routines.
 
 =head1 AUTHOR
 
-Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
+Copyright 2003-2022, 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.