exiftool-vendored.exe 12.34.0 → 12.38.0

package/bin/exiftool_files/lib/Image/ExifTool/DarwinCore.pm

@@ -15,7 +15,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool::XMP;
 
-$VERSION = '1.05';
+$VERSION = '1.06';
 
 my %dateTimeInfo = (
     # NOTE: Do NOT put "Groups" here because Groups hash must not be common!
@@ -38,7 +38,7 @@ my %event = (
     earliestDate        => { %dateTimeInfo, Groups => { 2 => 'Time' } },
     endDayOfYear        => { Writable => 'integer', Groups => { 2 => 'Time' } },
     eventDate           => { %dateTimeInfo, Groups => { 2 => 'Time' } },
-    eventID             => { },
+    eventID             => { Avoid => 1, Notes => 'avoided in favor of XMP-iptcExt:EventID' },
     eventRemarks        => { Writable => 'lang-alt' },
     eventTime => {
         Groups => { 2 => 'Time' },

package/bin/exiftool_files/lib/Image/ExifTool/Exif.pm

@@ -56,7 +56,7 @@ use vars qw($VERSION $AUTOLOAD @formatSize @formatName %formatNumber %intFormat
 use Image::ExifTool qw(:DataAccess :Utils);
 use Image::ExifTool::MakerNotes;
 
-$VERSION = '4.37';
+$VERSION = '4.38';
 
 sub ProcessExif($$$);
 sub WriteExif($$$);
@@ -4816,11 +4816,23 @@ my %subSecConv = (
     },
     GPSPosition => {
         Groups => { 2 => 'Location' },
+        Writable => 1,
+        WriteAlso => {
+            GPSLatitude => '$val =~ /(.*?)( ?[NS])?,/ ? $1 : undef',
+            GPSLatitudeRef => '$val =~ /(-?)(.*?) ?([NS]?),/ ? ($3 || ($1 ? "S" : "N")) : undef',
+            GPSLongitude => '$val =~ /, ?(.*?)( ?[EW]?)$/ ? $1 : undef',
+            GPSLongitudeRef => '$val =~ /, ?(-?)(.*?) ?([EW]?)$/ ? ($3 || ($1 ? "W" : "E")) : undef',
+        },
         Require => {
             0 => 'GPSLatitude',
             1 => 'GPSLongitude',
         },
         Priority => 0,
+        Notes => q{
+            when written, writes GPSLatitude, GPSLatitudeRef, GPSLongitude and
+            GPSLongitudeRef.  This tag may be written using the same coordinate
+            format as provided by Google Maps when right-clicking on a location
+        },
         ValueConv => '(length($val[0]) or length($val[1])) ? "$val[0] $val[1]" : undef',
         PrintConv => '"$prt[0], $prt[1]"',
     },

package/bin/exiftool_files/lib/Image/ExifTool/FLIR.pm

@@ -24,7 +24,7 @@ use Image::ExifTool qw(:DataAccess :Utils);
 use Image::ExifTool::Exif;
 use Image::ExifTool::GPS;
 
-$VERSION = '1.18';
+$VERSION = '1.19';
 
 sub ProcessFLIR($$;$);
 sub ProcessFLIRText($$$);
@@ -99,7 +99,7 @@ my %float8g = ( Format => 'float', PrintConv => 'sprintf("%.8g",$val)' );
     NOTES => q{
         Information extracted from FLIR FFF images and the APP1 FLIR segment of JPEG
         images.  These tags may also be extracted from the first frame of an FLIR
-        SEQ file.
+        SEQ file, or all frames if the ExtractEmbedded option is used.
     },
     "_header" => {
         Name => 'FFFHeader',
@@ -1457,6 +1457,7 @@ sub ProcessFLIR($$;$)
     my $raf = $$dirInfo{RAF} || new File::RandomAccess($$dirInfo{DataPt});
     my $verbose = $et->Options('Verbose');
     my $out = $et->Options('TextOut');
+    my $base = $raf->Tell();
     my ($i, $hdr, $buff, $rec);
 
     # read and verify FFF header
@@ -1485,15 +1486,18 @@ sub ProcessFLIR($$;$)
         my $ver = Get32u(\$hdr, 0x14);
         last if $ver >= 100 and $ver < 200; # (have seen 100 and 101 - PH)
         ToggleByteOrder();
-        $i and $et->Warn("Unsupported FLIR $type version"), return 1;
+        next unless $i;
+        return 0 if $$et{DOC_NUM};
+        $et->Warn("Unsupported FLIR $type version");
+        return 1;
     }
 
     # read the FLIR record directory
     my $pos = Get32u(\$hdr, 0x18);
     my $num = Get32u(\$hdr, 0x1c);
-    unless ($raf->Seek($pos) and $raf->Read($buff, $num * 0x20) == $num * 0x20) {
+    unless ($raf->Seek($base+$pos) and $raf->Read($buff, $num * 0x20) == $num * 0x20) {
         $et->Warn('Truncated FLIR FFF directory');
-        return 1;
+        return $$et{DOC_NUM} ? 0 : 1;
     }
 
     unless ($tagTablePtr) {
@@ -1504,6 +1508,7 @@ sub ProcessFLIR($$;$)
     # process the header data
     $et->HandleTag($tagTablePtr, '_header', $hdr);
 
+    my $success = 1;
     my $oldIndent = $$et{INDENT};
     $$et{INDENT} .= '| ';
     $et->VerboseDir($type, $num);
@@ -1533,12 +1538,22 @@ sub ProcessFLIR($$;$)
         $verbose and printf $out "%s%d) FLIR Record 0x%.2x, offset 0x%.4x, length 0x%.4x\n",
                                  $$et{INDENT}, $i, $recType, $recPos, $recLen;
 
-        unless ($raf->Seek($recPos) and $raf->Read($rec, $recLen) == $recLen) {
-            $et->Warn('Invalid FLIR record');
+        # skip RawData records for embedded documents
+        if ($recType == 1 and $$et{DOC_NUM}) {
+            $raf->Seek($base+$recPos+$recLen) or $success = 0, last;
+            next;
+        }
+        unless ($raf->Seek($base+$recPos) and $raf->Read($rec, $recLen) == $recLen) {
+            if ($$et{DOC_NUM}) {
+                $success = 0;   # abort processing more documents
+            } else {
+                $et->Warn('Invalid FLIR record');
+            }
             last;
         }
         if ($$tagTablePtr{$recType}) {
             $et->HandleTag($tagTablePtr, $recType, undef,
+                Base    => $base,
                 DataPt  => \$rec,
                 DataPos => $recPos,
                 Start   => 0,
@@ -1550,7 +1565,17 @@ sub ProcessFLIR($$;$)
     }
     delete $$et{SET_GROUP0};
     $$et{INDENT} = $oldIndent;
-    return 1;
+
+    # extract information from subsequent frames in SEQ file if ExtractEmbedded is used
+    if ($$dirInfo{RAF} and $et->Options('ExtractEmbedded') and not $$et{DOC_NUM}) {
+        for (;;) {
+            $$et{DOC_NUM} = $$et{DOC_COUNT} + 1;
+            last unless ProcessFLIR($et, $dirInfo, $tagTablePtr);
+            # (DOC_COUNT will be incremented automatically if we extracted any tags)
+        }
+        delete $$et{DOC_NUM};
+    }
+    return $success;
 }
 
 #------------------------------------------------------------------------------

package/bin/exiftool_files/lib/Image/ExifTool/GIF.pm

@@ -20,7 +20,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.18';
+$VERSION = '1.19';
 
 # road map of directory locations in GIF images
 my %gifMap = (
@@ -54,6 +54,7 @@ my %gifMap = (
     Extensions => { # (for documentation only)
         SubDirectory => { TagTable => 'Image::ExifTool::GIF::Extensions' },
     },
+    TransparentColor => { },
 );
 
 # GIF89a application extensions:
@@ -475,6 +476,9 @@ Block:
             my $delay = Get16u(\$buff, 1);
             $delayTime += $delay;
             $verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100;
+            # get transparent colour
+            my $bits = Get8u(\$buff, 0);
+            $et->HandleTag($tagTablePtr, 'TransparentColor', Get8u(\$buff,3)) if $bits & 0x01;
             $raf->Seek(-$length, 1) or last;
 
         } elsif ($a == 0x01 and $length == 12) {    # plain text extension

package/bin/exiftool_files/lib/Image/ExifTool/GPS.pm

@@ -137,22 +137,26 @@ my %coordConv = (
             my ($v, $et) = @_;
             $v = $et->TimeNow() if lc($v) eq 'now';
             my @tz;
-            if ($v =~ s/([-+])(.*)//s) {    # remove timezone
+            if ($v =~ s/([-+])(\d{1,2}):?(\d{2})\s*(DST)?$//i) {    # remove timezone
                 my $s = $1 eq '-' ? 1 : -1; # opposite sign to convert back to UTC
                 my $t = $2;
-                @tz = ($s*$1, $s*$2) if $t =~ /^(\d{2}):?(\d{2})\s*$/;
+                @tz = ($s*$2, $s*$3);
             }
-            my @a = ($v =~ /((?=\d|\.\d)\d*(?:\.\d*)?)/g);
-            push @a, '00' while @a < 3;
+            # (note: we must allow '.' as a time separator, eg. '10.30.00', with is tricky due to decimal seconds)
+            # YYYYmmddHHMMSS[.ss] format
+            my @a = ($v =~ /^[^\d]*\d{4}[^\d]*\d{1,2}[^\d]*\d{1,2}[^\d]*(\d{1,2})[^\d]*(\d{2})[^\d]*(\d{2}(?:\.\d+)?)[^\d]*$/);
+            # HHMMSS[.ss] format
+            @a or @a = ($v =~ /^[^\d]*(\d{1,2})[^\d]*(\d{2})[^\d]*(\d{2}(?:\.\d+)?)[^\d]*$/);
+            @a or warn('Invalid time (use HH:MM:SS[.ss][+/-HH:MM|Z])'), return undef;
             if (@tz) {
                 # adjust to UTC
-                $a[-2] += $tz[1];
-                $a[-3] += $tz[0];
-                while ($a[-2] >= 60) { $a[-2] -= 60; ++$a[-3] }
-                while ($a[-2] < 0)   { $a[-2] += 60; --$a[-3] }
-                $a[-3] = ($a[-3] + 24) % 24;
+                $a[1] += $tz[1];
+                $a[0] += $tz[0];
+                while ($a[1] >= 60) { $a[1] -= 60; ++$a[0] }
+                while ($a[1] < 0)   { $a[1] += 60; --$a[0] }
+                $a[0] = ($a[0] + 24) % 24;
             }
-            return "$a[-3]:$a[-2]:$a[-1]";
+            return join(':', @a);
         },
     },
     0x0008 => {

package/bin/exiftool_files/lib/Image/ExifTool/ICC_Profile.pm

@@ -25,7 +25,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.37';
+$VERSION = '1.38';
 
 sub ProcessICC($$);
 sub ProcessICC_Profile($$$);
@@ -549,7 +549,7 @@ my %manuSig = ( #6
     A2B3 => 'AToB3',
     A2M0 => 'AToM0',
     B2A3 => 'BToA3',
-    bcp0 => 'BRDFColorimetricParameter3Tag',
+    bcp0 => 'BRDFColorimetricParam0',
     bcp1 => 'BRDFColorimetricParam1',
     bcp2 => 'BRDFColorimetricParam2',
     bcp3 => 'BRDFColorimetricParam3',
@@ -602,7 +602,7 @@ my %manuSig = ( #6
     gdb2 => 'GamutBoundaryDescription2',
     gdb3 => 'GamutBoundaryDescription3',
    'mdv '=> 'MultiplexDefaultValues',
-    mcta => 'MultiplixTypeArray',
+    mcta => 'MultiplexTypeArray',
     minf => 'MeasurementInfo',
     miin => 'MeasurementInputInfo',
     M2A0 => 'MToA0',

package/bin/exiftool_files/lib/Image/ExifTool/Jpeg2000.pm

@@ -16,7 +16,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.31';
+$VERSION = '1.32';
 
 sub ProcessJpeg2000Box($$$);
 sub ProcessJUMD($$$);
@@ -42,8 +42,9 @@ my %jp2Map = (
    'UUID-IPTC'   => 'JP2',
    'UUID-EXIF'   => 'JP2',
    'UUID-XMP'    => 'JP2',
-  # jp2h         => 'JP2',  (not yet functional)
-  # ICC_Profile  => 'jp2h', (not yet functional)
+    jp2h         => 'JP2',
+    colr         => 'jp2h',
+    ICC_Profile  => 'colr',
     IFD1         => 'IFD0',
     EXIF         => 'IFD0', # to write EXIF as a block
     ExifIFD      => 'IFD0',
@@ -560,11 +561,34 @@ my %j2cMarker = (
 
 %Image::ExifTool::Jpeg2000::ColorSpec = (
     PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    WRITE_PROC => \&Image::ExifTool::WriteBinaryData, # (we don't actually call this)
     GROUPS => { 2 => 'Image' },
     FORMAT => 'int8s',
+    WRITABLE => 1,
+    # (Note: 'colr' is not a real group, but is used as a hack to write the
+    #  necessary colr box.  This hack necessitated another hack in TagInfoXML.pm
+    #  to avoid reporting this fake group in the XML output)
+    WRITE_GROUP => 'colr',
+    DATAMEMBER => [ 0 ],
+    IS_SUBDIR => [ 3 ],
+    NOTES => q{
+        The table below contains tags in the color specification (colr) box.  This
+        box may be rewritten by writing either ICC_Profile, ColorSpace or
+        ColorSpecData.  When writing, any existing colr boxes are replaced with the
+        newly created colr box.
+
+        B<NOTE>: Care must be taken when writing this color specification because
+        writing a specification that is incompatible with the image data may make
+        the image undisplayable.
+    },
     0 => {
         Name => 'ColorSpecMethod',
         RawConv => '$$self{ColorSpecMethod} = $val',
+        Protected => 1,
+        Notes => q{
+            default for writing is 2 when writing ICC_Profile, 1 when writing
+            ColorSpace, or 4 when writing ColorSpecData
+        },
         PrintConv => {
             1 => 'Enumerated',
             2 => 'Restricted ICC',
@@ -572,9 +596,15 @@ my %j2cMarker = (
             4 => 'Vendor Color',
         },
     },
-    1 => 'ColorSpecPrecedence',
+    1 => {
+        Name => 'ColorSpecPrecedence',
+        Notes => 'default for writing is 0',
+        Protected => 1,
+    },
     2 => {
         Name => 'ColorSpecApproximation',
+        Notes => 'default for writing is 0',
+        Protected => 1,
         PrintConv => {
             0 => 'Not Specified',
             1 => 'Accurate',
@@ -599,6 +629,7 @@ my %j2cMarker = (
             Name => 'ColorSpace',
             Condition => '$$self{ColorSpecMethod} == 1',
             Format => 'int32u',
+            Protected => 1,
             PrintConv => { # ref 15444-2 2002-05-15
                 0 => 'Bi-level',
                 1 => 'YCbCr(1)',
@@ -628,6 +659,8 @@ my %j2cMarker = (
         {
             Name => 'ColorSpecData',
             Format => 'undef[$size-3]',
+            Writable => 'undef',
+            Protected => 1,
             Binary => 1,
         },
     ],
@@ -817,6 +850,48 @@ sub CreateNewBoxes($$)
     return 1;
 }
 
+#------------------------------------------------------------------------------
+# Create Color Specification Box
+# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
+# Returns: 1 on success
+sub CreateColorSpec($$)
+{
+    my ($et, $outfile) = @_;
+    my $meth   = $et->GetNewValue('Jpeg2000:ColorSpecMethod');
+    my $prec   = $et->GetNewValue('Jpeg2000:ColorSpecPrecedence') || 0;
+    my $approx = $et->GetNewValue('Jpeg2000:ColorSpecApproximation') || 0;
+    my $icc    = $et->GetNewValue('ICC_Profile');
+    my $space  = $et->GetNewValue('Jpeg2000:ColorSpace');
+    my $cdata  = $et->GetNewValue('Jpeg2000:ColorSpecData');
+    unless ($meth) {
+        if ($icc) {
+            $meth = 2;
+        } elsif (defined $space) {
+            $meth = 1;
+        } elsif (defined $cdata) {
+            $meth = 4;
+        } else {
+            $et->Warn('Color space not defined'), return 0;
+        }
+    }
+    if ($meth eq '1') {
+        defined $space or $et->Warn('Must specify ColorSpace'), return 0;
+        $cdata = pack('N', $space);
+    } elsif ($meth eq '2' or $meth eq '3') {
+        defined $icc or $et->Warn('Must specify ICC_Profile'), return 0;
+        $cdata = $icc;
+    } elsif ($meth eq '4') {
+        defined $cdata or $et->Warn('Must specify ColorSpecData'), return 0;
+    } else {
+        $et->Warn('Unknown ColorSpecMethod'), return 0;
+    }
+    my $boxhdr = pack('N', length($cdata) + 11) . 'colr';
+    Write($outfile, $boxhdr, pack('CCC',$meth,$prec,$approx), $cdata) or return 0;
+    ++$$et{CHANGED};
+    $et->VPrint(1, "    + Jpeg2000:ColorSpec\n");
+    return 1;
+}
+
 #------------------------------------------------------------------------------
 # Process JPEG 2000 box
 # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
@@ -834,7 +909,7 @@ sub ProcessJpeg2000Box($$$)
     my $raf = $$dirInfo{RAF};
     my $outfile = $$dirInfo{OutFile};
     my $dirEnd = $dirStart + $dirLen;
-    my ($err, $outBuff, $verbose);
+    my ($err, $outBuff, $verbose, $doColour);
 
     if ($outfile) {
         unless ($raf) {
@@ -842,13 +917,19 @@ sub ProcessJpeg2000Box($$$)
             $outBuff = '';
             $outfile = \$outBuff;
         }
+        # determine if we will be writing colr box
+        if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'JP2Header') {
+            $doColour = 2 if defined $et->GetNewValue('ColorSpecMethod') or $et->GetNewValue('ICC_Profile') or
+                             defined $et->GetNewValue('ColorSpecPrecedence') or defined $et->GetNewValue('ColorSpace') or
+                             defined $et->GetNewValue('ColorSpecApproximation') or defined $et->GetNewValue('ColorSpecData');
+        }
     } else {
         # (must not set verbose flag when writing!)
         $verbose = $$et{OPTIONS}{Verbose};
         $et->VerboseDir($$dirInfo{DirName}) if $verbose;
     }
     # loop through all contained boxes
-    my ($pos, $boxLen);
+    my ($pos, $boxLen, $lastBox);
     for ($pos=$dirStart; ; $pos+=$boxLen) {
         my ($boxID, $buff, $valuePtr);
         my $hdrLen = 8;     # the box header length
@@ -857,9 +938,7 @@ sub ProcessJpeg2000Box($$$)
             my $n = $raf->Read($buff,$hdrLen);
             unless ($n == $hdrLen) {
                 $n and $err = '', last;
-                if ($outfile) {
-                    CreateNewBoxes($et, $outfile) or $err = 1;
-                }
+                CreateNewBoxes($et, $outfile) or $err = 1 if $outfile;
                 last;
             }
             $dataPt = \$buff;
@@ -871,6 +950,17 @@ sub ProcessJpeg2000Box($$$)
         }
         $boxLen = unpack("x$pos N",$$dataPt);   # (length includes header and data)
         $boxID = substr($$dataPt, $pos+4, 4);
+        # remove old colr boxes if necessary
+        if ($doColour and $boxID eq 'colr') {
+            if ($doColour == 1) { # did we successfully write the new colr box?
+                $et->VPrint(1,"    - Jpeg2000:ColorSpec\n");
+                ++$$et{CHANGED};
+                next;
+            }
+            $et->Warn('Out-of-order colr box encountered');
+            undef $doColour;
+        }
+        $lastBox = $boxID;
         $pos += $hdrLen;                # move to end of box header
         if ($boxLen == 1) {
             # box header contains an additional 8-byte integer for length
@@ -1009,8 +1099,10 @@ sub ProcessJpeg2000Box($$$)
                 # remove this directory from our create list
                 delete $$et{AddJp2Dirs}{$$tagInfo{Name}};
                 my $newdir;
-                # only edit writable UUID and Exif boxes
-                if ($uuid or $boxID eq 'Exif' or ($boxID eq 'xml ' and $$et{IsJXL})) {
+                # only edit writable UUID, Exif and jp2h boxes
+                if ($uuid or $boxID eq 'Exif' or ($boxID eq 'xml ' and $$et{IsJXL}) or
+                    ($boxID eq 'jp2h' and $$et{EDIT_DIRS}{jp2h}))
+                {
                     $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
                     next if defined $newdir and not length $newdir; # next if deleting the box
                 } elsif (defined $uuid) {
@@ -1022,6 +1114,11 @@ sub ProcessJpeg2000Box($$$)
                 my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
                 $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
                 Write($outfile, $boxhdr, $newdir) or $err = 1;
+                # write new colr box immediately after ihdr
+                if ($doColour and $boxID eq 'ihdr') {
+                    # (shouldn't be multiple ihdr boxes, but just in case, write only 1)
+                    $doColour = $doColour==2 ? CreateColorSpec($et, $outfile) : 0;
+                }
             } else {
                 # extract as a block if specified
                 $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};