exiftool_vendored 12.18.0 → 12.33.0

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

@@ -13,10 +13,11 @@ package Image::ExifTool::Torrent;
 use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
+use Image::ExifTool::XMP;
 
-$VERSION = '1.04';
+$VERSION = '1.05';
 
-sub ReadBencode($$);
+sub ReadBencode($$$);
 sub ExtractTags($$$;$$@);
 
 # tags extracted from BitTorrent files
@@ -99,12 +100,12 @@ sub ReadMore($$)
 
 #------------------------------------------------------------------------------
 # Read bencoded value
-# Inputs: 0) input file, 1) buffer (pos must be set to current position)
+# Inputs: 0) ExifTool ref, 1) input file, 2) buffer (pos must be set to current position)
 # Returns: HASH ref, ARRAY ref, SCALAR ref, SCALAR, or undef on error or end of data
 # Notes: Sets BencodeError element of RAF on any error
-sub ReadBencode($$)
+sub ReadBencode($$$)
 {
-    my ($raf, $dataPt) = @_;
+    my ($et, $raf, $dataPt) = @_;
 
     # read more if necessary (keep a minimum of 64 bytes in the buffer)
     my $pos = pos($$dataPt);
@@ -123,21 +124,21 @@ sub ReadBencode($$)
     } elsif ($tok eq 'd') { # dictionary
         $val = { };
         for (;;) {
-            my $k = ReadBencode($raf, $dataPt);
+            my $k = ReadBencode($et, $raf, $dataPt);
             last unless defined $k;
             # the key must be a byte string
             if (ref $k) {
                 ref $k ne 'SCALAR' and $$raf{BencodeError} = 'Bad dictionary key', last;
                 $k = $$k;
             }
-            my $v = ReadBencode($raf, $dataPt);
+            my $v = ReadBencode($et, $raf, $dataPt);
             last unless defined $v;
             $$val{$k} = $v;
         }
     } elsif ($tok eq 'l') { # list
         $val = [ ];
         for (;;) {
-            my $v = ReadBencode($raf, $dataPt);
+            my $v = ReadBencode($et, $raf, $dataPt);
             last unless defined $v;
             push @$val, $v;
         }
@@ -165,8 +166,14 @@ sub ReadBencode($$)
         }
         if (defined $value) {
             # return as binary data unless it is a reasonable-length ASCII string
-            if (length($value) > 256 or $value =~ /[^\t\x20-\x7e]/) {
+            if (length($value) > 256) {
                 $val = \$value;
+            } elsif ($value =~ /[^\t\x20-\x7e]/) {
+                if (Image::ExifTool::XMP::IsUTF8(\$value) >= 0) {
+                    $val = $et->Decode($value, 'UTF8');
+                } else {
+                    $val = \$value;
+                }
             } else {
                 $val = $value;
             }
@@ -206,7 +213,7 @@ sub ExtractTags($$$;$$@)
             my $tagInfo = $et->GetTagInfo($tagTablePtr, $id) or next;
             if (ref $val eq 'ARRAY') {
                 if ($$tagInfo{JoinPath}) {
-                    $val = join '/', @$val;
+                    $val = join '/', map { ref $_ ? '(Binary data)' : $_ } @$val;
                 } else {
                     push @more, @$val;
                     next if ref $more[0] eq 'ARRAY'; # continue expanding nested lists
@@ -273,7 +280,7 @@ sub ProcessTorrent($$)
     my $raf = $$dirInfo{RAF};
     my $buff = '';
     pos($buff) = 0;
-    my $dict = ReadBencode($raf, \$buff);
+    my $dict = ReadBencode($et, $raf, \$buff);
     my $err = $$raf{BencodeError};
     $et->Warn("Bencode error: $err") if $err;
     if (ref $dict eq 'HASH' and ($$dict{announce} or $$dict{'created by'})) {

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

@@ -548,7 +548,7 @@ sub WriteExif($$$)
         my $mustRead;
         if ($dirStart < 0 or $dirStart > $dataLen-2) {
             $mustRead = 1;
-        } elsif ($dirLen > 2) {
+        } elsif ($dirLen >= 2) {
             my $len = 2 + 12 * Get16u($dataPt, $dirStart);
             $mustRead = 1 if $dirStart + $len > $dataLen;
         }

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

@@ -170,7 +170,7 @@ sub FormatIPTC($$$$$;$)
         } else {
             my $len = int(($1 || 0) / 8);
             if ($len == 1) {        # 1 byte
-                $$valPtr = chr($$valPtr);
+                $$valPtr = chr($$valPtr & 0xff);
             } elsif ($len == 2) {   # 2-byte integer
                 $$valPtr = pack('n', $$valPtr);
             } else {                # 4-byte integer

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

@@ -293,6 +293,7 @@ sub WritePDF($$)
     my $newTool = new Image::ExifTool;
     $newTool->Options(List => 1);
     $newTool->Options(Password => $et->Options('Password'));
+    $newTool->Options(NoPDFList => $et->Options('NoPDFList'));
     $$newTool{PDF_CAPTURE} = \%capture;
     my $info = $newTool->ImageInfo($raf, 'XMP', 'PDF:*', 'Error', 'Warning');
     # not a valid PDF file unless we got a version number

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

@@ -179,6 +179,8 @@ sub BuildTextChunk($$$$$)
             $tag =~ s/-$lang$//;    # remove language code from tagID
         } elsif ($$et{OPTIONS}{Charset} ne 'Latin' and $val =~  /[\x80-\xff]/) {
             $iTXt = 1;      # write as iTXt if it contains non-Latin special characters
+        } elsif ($$tagInfo{iTXt}) {
+            $iTXt = 1;      # write as iTXt if specified in user-defined tag
         }
     }
     if ($comp) {

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

@@ -59,6 +59,7 @@ my %psMap = (
     Photoshop    => 'PostScript',
     IPTC         => 'Photoshop',
     EXIFInfo     => 'Photoshop',
+    EXIF         => 'EXIFInfo',
     IFD0         => 'EXIFInfo',
     IFD1         => 'IFD0',
     ICC_Profile  => 'PostScript',

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

@@ -17,6 +17,7 @@ my %movMap = (
     Keys      => 'Movie',       # MOV-Movie-Meta-Keys !! (hack due to different Meta location)
     Meta      => 'UserData',
     XMP       => 'UserData',    # MOV-Movie-UserData-XMP
+    Microsoft => 'UserData',    # MOV-Movie-UserData-Microsoft
     UserData  => 'Movie',       # MOV-Movie-UserData
     Movie     => 'MOV',
     GSpherical => 'SphericalVideoXML', # MOV-Movie-Track-SphericalVideoXML
@@ -30,6 +31,7 @@ my %mp4Map = (
     Keys      => 'Movie',       # MOV-Movie-Meta-Keys !! (hack due to different Meta location)
     Meta      => 'UserData',
     UserData  => 'Movie',       # MOV-Movie-UserData
+    Microsoft => 'UserData',    # MOV-Movie-UserData-Microsoft
     Movie     => 'MOV',
     XMP       => 'MOV',         # MOV-XMP
     GSpherical => 'SphericalVideoXML', # MOV-Movie-Track-SphericalVideoXML
@@ -76,8 +78,8 @@ my %dirMap = (
 # convert ExifTool Format to QuickTime type
 my %qtFormat = (
    'undef' => 0x00,  string => 0x01,
-    int8s  => 0x15,  int16s => 0x15,  int32s => 0x15,
-    int8u  => 0x16,  int16u => 0x16,  int32u => 0x16,
+    int8s  => 0x15,  int16s => 0x15,  int32s => 0x15,  int64s => 0x15,
+    int8u  => 0x16,  int16u => 0x16,  int32u => 0x16,  int64u => 0x16,
     float  => 0x17,  double => 0x18,
 );
 my $undLang = 0x55c4;   # numeric code for default ('und') language
@@ -161,6 +163,9 @@ sub ConvInvISO6709($)
         # latitude must have 2 digits before the decimal, and longitude 3,
         # and all values must start with a "+" or "-", and Google Photos
         # requires at least 3 digits after the decimal point
+        # (and as of Apr 2021, Google Photos doesn't accept coordinats
+        #  with more than 5 digits after the decimal place:
+        #  https://exiftool.org/forum/index.php?topic=11055.msg67171#msg67171 )
         my @fmt = ('%s%02d.%s%s','%s%03d.%s%s','%s%d.%s%s');
         foreach (@a) {
             return undef unless Image::ExifTool::IsFloat($_);
@@ -294,7 +299,7 @@ sub GetLangInfo($$)
 sub CheckQTValue($$$)
 {
     my ($et, $tagInfo, $valPtr) = @_;
-    my $format = $$tagInfo{Format} || $$tagInfo{Table}{FORMAT};
+    my $format = $$tagInfo{Format} || $$tagInfo{Writable} || $$tagInfo{Table}{FORMAT};
     return undef unless $format;
     return Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
 }
@@ -307,12 +312,12 @@ sub FormatQTValue($$;$$)
 {
     my ($et, $valPt, $format, $writable) = @_;
     my $flags;
-    if ($format and $format ne 'string') {
-        $$valPt = WriteValue($$valPt, $format);
+    if ($format and $format ne 'string' or not $format and $writable and $writable ne 'string') {
+        $$valPt = WriteValue($$valPt, $format || $writable);
         if ($writable and $qtFormat{$writable}) {
             $flags = $qtFormat{$writable};
         } else {
-            $flags = $qtFormat{$format} || 0;
+            $flags = $qtFormat{$format || 0} || 0;
         }
     } elsif ($$valPt =~ /^\xff\xd8\xff/) {
         $flags = 0x0d;  # JPG
@@ -844,7 +849,7 @@ sub WriteQuickTime($$$)
                 # --> hold this terminator to the end
                 $term = $hdr;
             } elsif ($n != 0) {
-                $et->Error('File format error');
+                $et->Error("Unknown $n bytes at end of file", 1);
             }
             last;
         }
@@ -1084,7 +1089,9 @@ sub WriteQuickTime($$$)
                     $$et{CHANGED} = $oldChanged if $$et{DemoteErrors} > 1;
                     delete $$et{DemoteErrors};
                 }
-                if (defined $newData and not length $newData and $$tagTablePtr{PERMANENT}) {
+                if (defined $newData and not length $newData and ($$tagInfo{Permanent} or
+                    ($$tagTablePtr{PERMANENT} and not defined $$tagInfo{Permanent})))
+                {
                     # do nothing if trying to delete tag from a PERMANENT table
                     $$et{CHANGED} = $oldChanged;
                     undef $newData;
@@ -1092,7 +1099,9 @@ sub WriteQuickTime($$$)
                 $$et{CUR_WRITE_GROUP} = $oldWriteGroup;
                 SetByteOrder('MM');
                 # add back header if necessary
-                if ($start and defined $newData and length $newData) {
+                if ($start and defined $newData and (length $newData or
+                    (defined $$tagInfo{Permanent} and not $$tagInfo{Permanent})))
+                {
                     $newData = substr($buff,0,$start) . $newData;
                     $$_[1] += $start foreach @chunkOffset;
                 }
@@ -1230,10 +1239,14 @@ sub WriteQuickTime($$$)
                     } elsif ($format) {
                         $val = ReadValue(\$buff, 0, $format, undef, $size);
                     } elsif (($tag =~ /^\xa9/ or $$tagInfo{IText}) and $size >= ($$tagInfo{IText} || 4)) {
-                        if ($$tagInfo{IText} and $$tagInfo{IText} == 6) {
-                            $lang = unpack('x4n', $buff);
-                            $len = $size - 6;
-                            $val = substr($buff, 6, $len);
+                        my $hdr;
+                        if ($$tagInfo{IText} and $$tagInfo{IText} >= 6) {
+                            my $iText = $$tagInfo{IText};
+                            my $pos = $iText - 2;
+                            $lang = unpack("x${pos}n", $buff);
+                            $hdr = substr($buff,4,$iText-6);
+                            $len = $size - $iText;
+                            $val = substr($buff, $iText, $len);
                         } else {
                             ($len, $lang) = unpack('nn', $buff);
                             $len -= 4 if 4 + $len > $size; # (see QuickTime.pm for explanation)
@@ -1241,14 +1254,18 @@ sub WriteQuickTime($$$)
                             $val = substr($buff, 4, $len);
                         }
                         $lang or $lang = $undLang;  # treat both 0 and 'und' as 'und'
+                        my $enc;
                         if ($lang < 0x400 and $val !~ /^\xfe\xff/) {
                             $charsetQuickTime = $et->Options('CharsetQuickTime');
-                            $val = $et->Decode($val, $charsetQuickTime);
+                            $enc = $charsetQuickTime;
                         } else {
-                            my $enc = $val=~s/^\xfe\xff// ? 'UTF16' : 'UTF8';
+                            $enc = $val=~s/^\xfe\xff// ? 'UTF16' : 'UTF8';
+                        }
+                        unless ($$tagInfo{NoDecode}) {
                             $val = $et->Decode($val, $enc);
+                            $val =~ s/\0+$//;   # remove trailing nulls if they exist
                         }
-                        $val =~ s/\0+$//;   # remove trailing nulls if they exist
+                        $val = $hdr . $val if defined $hdr;
                         my $langCode = UnpackLang($lang, 1);
                         $langInfo = GetLangInfo($tagInfo, $langCode);
                         $nvHash = $et->GetNewValueHash($langInfo);
@@ -1265,6 +1282,9 @@ sub WriteQuickTime($$$)
                         }
                     } else {
                         $val = $buff;
+                        if ($tag =~ /^\xa9/ or $$tagInfo{IText}) {
+                            $et->Warn("Corrupted $$tagInfo{Name} value");
+                        }
                     }
                     if ($nvHash and defined $val) {
                         if ($et->IsOverwriting($nvHash, $val)) {
@@ -1277,12 +1297,23 @@ sub WriteQuickTime($$$)
                             $et->VerboseValue("+ $grp:$$langInfo{Name}", $newData);
                             # add back necessary header and encode as necessary
                             if (defined $lang) {
-                                $newData = $et->Encode($newData, $lang < 0x400 ? $charsetQuickTime : 'UTF8');
+                                my $iText = $$tagInfo{IText} || 0;
+                                my $hdr;
+                                if ($iText > 6) {
+                                    $newData .= ' 'x($iText-6) if length($newData) < $iText-6;
+                                    $hdr = substr($newData, 0, $iText-6);
+                                    $newData = substr($newData, $iText-6);
+                                }
+                                unless ($$tagInfo{NoDecode}) {
+                                    $newData = $et->Encode($newData, $lang < 0x400 ? $charsetQuickTime : 'UTF8');
+                                }
                                 my $wLang = $lang eq $undLang ? 0 : $lang;
-                                if ($$tagInfo{IText} and $$tagInfo{IText} == 6) {
+                                if ($iText < 6) {
+                                    $newData = pack('nn', length($newData), $wLang) . $newData;
+                                } elsif ($iText == 6) {
                                     $newData = pack('Nn', 0, $wLang) . $newData . "\0";
                                 } else {
-                                    $newData = pack('nn', length($newData), $wLang) . $newData;
+                                    $newData = "\0\0\0\0" . $hdr . pack('n', $wLang) . $newData . "\0";
                                 }
                             } elsif (not $format or $format =~ /^string/ and
                                      not $$tagInfo{Binary} and not $$tagInfo{ValueConv})
@@ -1441,9 +1472,12 @@ sub WriteQuickTime($$$)
                         my $grp = $et->GetGroup($tagInfo,1);
                         $et->Warn("Can't use country code for $grp:$$tagInfo{Name}");
                         next;
-                    } elsif ($$tagInfo{IText} and $$tagInfo{IText} == 6) {
+                    } elsif ($$tagInfo{IText} and $$tagInfo{IText} >= 6) {
                         # add 6-byte langText header and trailing null
-                        $newVal = pack('Nn',0,$lang) . $newVal . "\0";
+                        # (with extra junk before language code if IText > 6)
+                        my $n = $$tagInfo{IText} - 6;
+                        $newVal .= ' ' x $n if length($newVal) < $n;
+                        $newVal = "\0\0\0\0" . substr($newVal,0,$n) . pack('n',0,$lang) . substr($newVal,$n) . "\0";
                     } else {
                         # add IText header
                         $newVal = pack('nn',length($newVal),$lang) . $newVal;

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

@@ -506,7 +506,7 @@ sub ConformPathToNamespace($$)
     my $prop;
     foreach $prop (@propList) {
         my ($ns, $tag) = $prop =~ /(.+?):(.*)/;
-        next if $$nsUsed{$ns};
+        next if not defined $ns or $$nsUsed{$ns};
         my $uri = $nsURI{$ns};
         unless ($uri) {
             warn "No URI for namespace prefix $ns!\n";
@@ -1417,7 +1417,11 @@ sub WriteXMP($$;$)
             my $uri = $nsUsed{$1};
             unless ($uri) {
                 $uri = $nsURI{$1};      # we must have added a namespace
-                $uri or $xmpErr = "Undefined XMP namespace: $1", next;
+                unless ($uri) {
+                    # (namespace may be empty if trying to write empty XMP structure, forum12384)
+                    $xmpErr = "Undefined XMP namespace: $1" if length $uri;
+                    next;
+                }
             }
             $nsNew{$1} = $uri;
             # need a new description if any new namespaces
@@ -1465,7 +1469,7 @@ sub WriteXMP($$;$)
             $long[-2] .= "$nl$sp<$prop rdf:about='${about}'";
             # generate et:toolkit attribute if this is an exiftool RDF/XML output file
             if (@ns and $nsCur{$ns[0]} =~ m{^http://ns.exiftool.(?:ca|org)/}) {
-                $long[-2] .= "\n$sp${sp}xmlns:et='http://ns.exiftool.ca/1.0/'" .
+                $long[-2] .= "\n$sp${sp}xmlns:et='http://ns.exiftool.org/1.0/'" .
                             " et:toolkit='Image::ExifTool $Image::ExifTool::VERSION'";
             }
             $long[-2] .= "\n$sp${sp}xmlns:$_='$nsCur{$_}'" foreach @ns;

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

@@ -105,6 +105,7 @@ my %writableType = (
     ICC => [ 'ICC_Profile', 'WriteICC' ],
     IND =>   'InDesign',
     JP2 =>   'Jpeg2000',
+    JXL =>   'Jpeg2000',
     MIE =>   undef,
     MOV => [ 'QuickTime',   'WriteMOV' ],
     MRW =>   'MinoltaRaw',
@@ -135,10 +136,10 @@ 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 MIE MPF NikonCapture PDF
-    PDF-update PhotoMechanic Photoshop PNG PNG-pHYs PrintIM QuickTime RMETA RSRC
-    SubIFD Trailer UserData XML XML-* XMP XMP-*
+    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
+    PrintIM QuickTime RMETA RSRC SubIFD Trailer UserData XML XML-* XMP XMP-*
 );
 # family 2 group names that we can delete
 my @delGroup2 = qw(
@@ -573,6 +574,9 @@ sub SetNewValue($;$$%)
                     my $pre = $wantGroup ? $wantGroup . ':' : '';
                     $err = "Tag '$pre${origTag}' is not defined";
                     $err .= ' or has a bad language code' if $origTag =~ /-/;
+                    if (not $pre and uc($origTag) eq 'TAG') {
+                        $err .= " (specify a writable tag name, not '${origTag}' literally)"
+                    }
                 } else {
                     $err = "Invalid tag name '${tag}'";
                     $err .= " (remove the leading '\$')" if $tag =~ /^\$/;
@@ -2639,12 +2643,14 @@ GWTInfo:    foreach $tagInfo (@infoArray) {
 
 #------------------------------------------------------------------------------
 # Get list of all group names
-# Inputs: 0) Group family number
+# Inputs: 0) [optional] ExifTool ref, 1) Group family number
 # Returns: List of group names (sorted alphabetically)
-sub GetAllGroups($)
+sub GetAllGroups($;$)
 {
     local $_;
     my $family = shift || 0;
+    my $self;
+    ref $family and $self = $family, $family = shift || 0;
 
     $family == 3 and return('Doc#', 'Main');
     $family == 4 and return('Copy#');
@@ -2663,9 +2669,23 @@ sub GetAllGroups($)
         $allGroups{$grp} = 1 if ($grps = $$table{GROUPS}) and ($grp = $$grps{$family});
         foreach $tag (TagTableKeys($table)) {
             my @infoArray = GetTagInfoList($table, $tag);
-            foreach $tagInfo (@infoArray) {
-                next unless ($grps = $$tagInfo{Groups}) and ($grp = $$grps{$family});
-                $allGroups{$grp} = 1;
+            if ($family == 7) {
+                foreach $tagInfo (@infoArray) {
+                    my $id = $$tagInfo{TagID};
+                    if (not defined $id) {
+                        $id = '';   # (just to be safe)
+                    } elsif ($id =~ /^\d+$/) {
+                        $id = sprintf('0x%x', $id) if $self and $$self{OPTIONS}{HexTagIDs};
+                    } else {
+                        $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge;
+                    }
+                    $allGroups{'ID-' . $id} = 1;
+                }
+            } else {
+                foreach $tagInfo (@infoArray) {
+                    next unless ($grps = $$tagInfo{Groups}) and ($grp = $$grps{$family});
+                    $allGroups{$grp} = 1;
+                }
             }
         }
     }
@@ -4935,6 +4955,12 @@ sub Set64u(@)
     $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
     return $val;
 }
+sub Set64s(@)
+{
+    my $val = shift;
+    $val < 0 and $val += 4294967296 * 4294967296; # (temporary hack won't really work due to round-off errors)
+    return Set64u($val, @_);
+}
 sub SetRational64u(@) {
     my ($numer,$denom) = Rationalize($_[0],0xffffffff);
     my $val = Set32u($numer) . Set32u($denom);
@@ -4996,6 +5022,7 @@ my %writeValueProc = (
     int16uRev => \&Set16uRev,
     int32s => \&Set32s,
     int32u => \&Set32u,
+    int64s => \&Set64s,
     int64u => \&Set64u,
     rational32s => \&SetRational32s,
     rational32u => \&SetRational32u,
@@ -6632,7 +6659,17 @@ sub SetFileTime($$;$$$$)
     # open file by name if necessary
     unless (ref $file) {
         # (file will be automatically closed when *FH goes out of scope)
-        $self->Open(\*FH, $file, '+<') or $self->Warn('Error opening file for update'), return 0;
+        unless ($self->Open(\*FH, $file, '+<')) {
+            my $success;
+            if (defined $atime or defined $mtime) {
+                my ($a, $m, $c) = $self->GetFileTime($file);
+                $atime = $a unless defined $atime;
+                $mtime = $m unless defined $mtime;
+                $success = eval { utime($atime, $mtime, $file) } if defined $atime and defined $mtime;
+            }
+            $self->Warn('Error opening file for update') unless $success;
+            return $success;
+        }
         $saveFile = $file;
         $file = \*FH;
     }

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

@@ -50,7 +50,7 @@ use Image::ExifTool::Exif;
 use Image::ExifTool::GPS;
 require Exporter;
 
-$VERSION = '3.38';
+$VERSION = '3.46';
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(EscapeXML UnescapeXML);
 
@@ -71,6 +71,13 @@ sub ConvertRational($);
 sub ConvertRationalList($);
 sub WriteGSpherical($$$);
 
+# standard path locations for XMP in major file types
+my %stdPath = (
+    JPEG => 'JPEG-APP1-XMP',
+    TIFF => 'TIFF-IFD0-XMP',
+    PSD => 'PSD-XMP',
+);
+
 # lookup for translating to ExifTool namespaces (and family 1 group names)
 %stdXlatNS = (
     # shorten ugly namespace prefixes
@@ -148,7 +155,7 @@ my %xmpNS = (
     DICOM     => 'http://ns.adobe.com/DICOM/',
    'drone-dji'=> 'http://www.dji.com/drone-dji/1.0/',
     svg       => 'http://www.w3.org/2000/svg',
-    et        => 'http://ns.exiftool.ca/1.0/',
+    et        => 'http://ns.exiftool.org/1.0/',
 #
 # namespaces defined in XMP2.pl:
 #
@@ -188,7 +195,7 @@ my %xmpNS = (
 );
 
 # build reverse namespace lookup
-my %uri2ns = ( 'http://ns.exiftool.org/1.0/' => 'et' ); # (allow exiftool.org as well as exiftool.ca)
+my %uri2ns = ( 'http://ns.exiftool.ca/1.0/' => 'et' ); # (allow exiftool.ca as well as exiftool.org)
 {
     my $ns;
     foreach $ns (keys %nsURI) {
@@ -201,13 +208,13 @@ my %uri2ns = ( 'http://ns.exiftool.org/1.0/' => 'et' ); # (allow exiftool.org as
     ValueConv    => 'Image::ExifTool::GPS::ToDegrees($val, 1)',
     ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val, 2, "N")',
     PrintConv    => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
-    PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1)',
+    PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1, "lat")',
 );
 %longConv = (
     ValueConv    => 'Image::ExifTool::GPS::ToDegrees($val, 1)',
     ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val, 2, "E")',
     PrintConv    => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
-    PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1)',
+    PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1, "lon")',
 );
 %dateTimeInfo = (
     # NOTE: Do NOT put "Groups" here because Groups hash must not be common!
@@ -1526,6 +1533,9 @@ my %sPantryItem = (
                     CameraProfile   => { },
                     LookTable       => { },
                     ToneCurvePV2012 => { List => 'Seq' },
+                    ToneCurvePV2012Red   => { List => 'Seq' },
+                    ToneCurvePV2012Green => { List => 'Seq' },
+                    ToneCurvePV2012Blue  => { List => 'Seq' },
                 },
             },
         }
@@ -2010,6 +2020,11 @@ my %sPantryItem = (
         Groups => { 2 => 'Location' },
         Writable => 'integer',
         PrintConv => {
+            OTHER => sub {
+                my ($val, $inv) = @_;
+                return undef unless $inv and $val =~ /^([-+0-9])/;
+                return($1 eq '-' ? 1 : 0);
+            },
             0 => 'Above Sea Level',
             1 => 'Below Sea Level',
         },
@@ -2280,7 +2295,7 @@ my %sPantryItem = (
         Priority => 0,
         # prevent this from getting set from a LensID that has been converted
         ValueConvInv => q{
-            warn "Expected one or more integer values" if $val =~ /[^\d ]/;
+            warn "Expected one or more integer values" if $val =~ /[^-\d ]/;
             return $val;
         },
     },
@@ -2334,6 +2349,8 @@ my %sPantryItem = (
     Scene               => { Groups => { 2 => 'Other' }, List => 'Bag' },
     SubjectCode         => { Groups => { 2 => 'Other' }, List => 'Bag' },
     # Copyright - have seen this in a sample (Jan 2021), but I think it is non-standard
+    AltTextAccessibility =>{ Groups => { 2 => 'Other' }, Writable => 'lang-alt' }, # added 2021-10-13
+    ExtDescrAccessibility=>{ Groups => { 2 => 'Other' }, Writable => 'lang-alt' }, # added 2021-10-13
 );
 
 # Adobe Lightroom namespace properties (lr) (ref PH)
@@ -3251,8 +3268,14 @@ NoLoop:
             }
         }
         # generate a default tagInfo hash if necessary
-        $tagInfo or $tagInfo = { Name => $name, IsDefault => 1, Priority => 0 };
-
+        unless ($tagInfo) {
+            # shorten tag name if necessary
+            if ($$et{ShortenXmpTags}) {
+                my $shorten = $$et{ShortenXmpTags};
+                $name = &$shorten($name);
+            }
+            $tagInfo = { Name => $name, IsDefault => 1, Priority => 0 };
+        }
         # add tag Namespace entry for tags in variable-namespace tables
         $$tagInfo{Namespace} = $xns if $xns;
         if ($$et{curURI}{$ns} and $$et{curURI}{$ns} =~ m{^http://ns.exiftool.(?:ca|org)/(.*?)/(.*?)/}) {
@@ -3771,6 +3794,7 @@ sub ParseXMPElement($$$;$$$$)
                 # (unless we already extracted shorthand values from this element)
                 if (length $val or not $shorthand) {
                     my $lastProp = $$propList[-1];
+                    $lastProp = '' unless defined $lastProp;
                     if (defined $nodeID) {
                         SaveBlankInfo($blankInfo, $propList, $val);
                     } elsif ($lastProp eq 'rdf:type' and $wasEmpty) {
@@ -3844,6 +3868,7 @@ sub ProcessXMP($$;$)
     my ($buff, $fmt, $hasXMP, $isXML, $isRDF, $isSVG);
     my $rtnVal = 0;
     my $bom = 0;
+    my $path = $et->MetadataPath();
 
     # namespaces and prefixes currently in effect while parsing the file,
     # and lookup to translate brain-dead-Microsoft-Photo-software prefixes
@@ -3861,11 +3886,7 @@ sub ProcessXMP($$;$)
         (($$dirInfo{DirName} || '') eq 'XMP' or $$et{FILE_TYPE} eq 'XMP'))
     {
         $$et{XmpValidate} = { } if $$et{OPTIONS}{Validate};
-        my $path = $et->MetadataPath();
-        my $nonStd;
-        if ($$et{FILE_TYPE} =~ /^(JPEG|TIFF|PSD)$/ and $path !~ /^(JPEG-APP1-XMP|TIFF-IFD0-XMP|PSD-XMP)$/) {
-            $nonStd = 1;
-        }
+        my $nonStd = ($stdPath{$$et{FILE_TYPE}} and $path ne $stdPath{$$et{FILE_TYPE}});
         if ($nonStd and $Image::ExifTool::MWG::strict) {
             $et->Warn("Ignored non-standard XMP at $path");
             return 1;
@@ -3944,7 +3965,7 @@ sub ProcessXMP($$;$)
                         } elsif ($1 eq 'REDXIF') {
                             $type = 'RMD';
                             $mime = 'application/xml';
-                        } else {
+                        } elsif ($1 ne 'fcpxml') { # Final Cut Pro XML
                             return 0;
                         }
                     } elsif ($buf2 =~ /<svg[\s>]/) {
@@ -4063,12 +4084,14 @@ sub ProcessXMP($$;$)
 
     # extract XMP/XML as a block if specified
     my $blockName = $$dirInfo{BlockInfo} ? $$dirInfo{BlockInfo}{Name} : 'XMP';
+    my $blockExtract = $et->Options('BlockExtract');
     if (($$et{REQ_TAG_LOOKUP}{lc $blockName} or ($$et{TAGS_FROM_FILE} and
-        not $$et{EXCL_TAG_LOOKUP}{lc $blockName})) and
+        not $$et{EXCL_TAG_LOOKUP}{lc $blockName}) or $blockExtract) and
         (($$et{FileType} eq 'XMP' and $blockName eq 'XMP') or
         ($$dirInfo{DirName} and $$dirInfo{DirName} eq $blockName)))
     {
         $et->FoundTag($$dirInfo{BlockInfo} || 'XMP', substr($$dataPt, $dirStart, $dirLen));
+        return 1 if $blockExtract and $blockExtract > 1;
     }
 
     $tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
@@ -4123,6 +4146,13 @@ sub ProcessXMP($$;$)
         }
         defined $fmt or $et->Warn('XMP character encoding error');
     }
+    # warn if standard XMP is missing xpacket wrapper
+    if ($$et{XMP_NO_XPACKET} and $$et{OPTIONS}{Validate} and
+        $stdPath{$$et{FILE_TYPE}} and $path eq $stdPath{$$et{FILE_TYPE}} and
+        not $$dirInfo{IsExtended} and not $$et{DOC_NUM})
+    {
+        $et->Warn('XMP is missing xpacket wrapper', 1);
+    }
     if ($fmt) {
         # trim if necessary to avoid converting non-UTF data
         if ($dirStart or $dirEnd != length($$dataPt)) {

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

@@ -539,7 +539,8 @@ my %sImageRegion = ( # new in 1.5
     NOTES => q{
         This table contains tags defined by the IPTC Extension schema version 1.5. 
         The actual namespace prefix is "Iptc4xmpExt", but ExifTool shortens this for
-        the family 1 group name. (see L<http://www.iptc.org/IPTC4XMP/>)
+        the family 1 group name. (see
+        L<http://www.iptc.org/standards/photo-metadata/iptc-standard/>)
     },
     AboutCvTerm => {
         Struct => \%sCVTermDetails,
@@ -796,6 +797,7 @@ my %sImageRegion = ( # new in 1.5
     audioBitsPerSample  => { Groups => { 2 => 'Audio' }, Writable => 'integer' },
     # new IPTC Extension schema 1.5 property
     ImageRegion => { Groups => { 2 => 'Image' }, List => 'Bag', Struct => \%sImageRegion },
+    EventID     => { List => 'Bag' }, # added 2021-10-13
 );
 
 #------------------------------------------------------------------------------