exiftool_vendored 12.42.0 → 12.50.0

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

@@ -0,0 +1,359 @@
+#------------------------------------------------------------------------------
+# File:         WriteRIFF.pl
+#
+# Description:  Write RIFF-format files
+#
+# Revisions:    2020-09-26 - P. Harvey Created
+#
+# Notes:        Currently writes only WEBP files
+#
+# References:   https://developers.google.com/speed/webp/docs/riff_container
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::RIFF;
+
+use strict;
+
+# map of where information is stored in WebP image
+my %webpMap = (
+   'XMP '        => 'RIFF', # (the RIFF chunk name is 'XMP ')
+    EXIF         => 'RIFF',
+    ICCP         => 'RIFF',
+    XMP          => 'XMP ',
+    IFD0         => 'EXIF',
+    IFD1         => 'IFD0',
+    ICC_Profile  => 'ICCP',
+    ExifIFD      => 'IFD0',
+    GPS          => 'IFD0',
+    SubIFD       => 'IFD0',
+    GlobParamIFD => 'IFD0',
+    PrintIM      => 'IFD0',
+    InteropIFD   => 'ExifIFD',
+    MakerNotes   => 'ExifIFD',
+);
+
+#------------------------------------------------------------------------------
+# Write RIFF file (currently WebP-type only)
+# Inputs: 0) ExifTool object ref, 1) dirInfo ref
+# Returns: 1 on success, 0 if this wasn't a valid RIFF file, or -1 if
+#          an output file was specified and a write error occurred
+sub WriteRIFF($$)
+{
+    my ($et, $dirInfo) = @_;
+    $et or return 1;    # allow dummy access to autoload this package
+    my $outfile = $$dirInfo{OutFile};
+    my $outsize = 0;
+    my $raf = $$dirInfo{RAF};
+    my ($buff, $err, $pass, %has, %dirDat, $imageWidth, $imageHeight);
+
+    # do this in 2 passes so we can set the size of the containing RIFF chunk
+    # without having to buffer the output (also to set the WebP_Flags)
+    for ($pass=0; ; ++$pass) {
+        my %doneDir;
+        # verify this is a valid RIFF file
+        return 0 unless $raf->Read($buff, 12) == 12;
+        return 0 unless $buff =~ /^(RIFF|RF64)....(.{4})/s;
+
+        unless ($1 eq 'RIFF' and $2 eq 'WEBP') {
+            my $type = $2;
+            $type =~ tr/-_a-zA-Z//dc;
+            $et->Error("Can't currently write $1 $type files");
+            return 1;
+        }
+        SetByteOrder('II');
+
+        # determine which directories we must write for this file type
+        $et->InitWriteDirs(\%webpMap);
+        my $addDirs = $$et{ADD_DIRS};
+        my $editDirs = $$et{EDIT_DIRS};
+        my ($createVP8X, $deleteVP8X);
+
+        # write header
+        if ($pass) {
+            my $needsVP8X = ($has{ANIM} or $has{'XMP '} or $has{EXIF} or
+                             $has{ALPH} or $has{ICCP});
+            if ($has{VP8X} and not $needsVP8X and $$et{CHANGED}) {
+                $deleteVP8X = 1;    # delete the VP8X chunk
+                $outsize -= 18;     # account for missing VP8X
+            } elsif ($needsVP8X and not $has{VP8X}) {
+                if (defined $imageWidth) {
+                    ++$$et{CHANGED};
+                    $createVP8X = 1;    # add VP8X chunk
+                    $outsize += 18;     # account for VP8X size
+                } else {
+                    $et->Warn('Error getting image size for required VP8X chunk');
+                }
+            }
+            # finally we can set the overall RIFF chunk size:
+            Set32u($outsize - 8, \$buff, 4);
+            Write($outfile, $buff) or $err = 1;
+            # create VP8X chunk if necessary
+            if ($createVP8X) {
+                $et->VPrint(0,"  Adding required VP8X chunk (Extended WEBP)\n");
+                my $flags = 0;
+                $flags |= 0x02 if $has{ANIM};
+                $flags |= 0x04 if $has{'XMP '};
+                $flags |= 0x08 if $has{EXIF};
+                $flags |= 0x10 if $has{ALPH};
+                $flags |= 0x20 if $has{ICCP};
+                Write($outfile, 'VP8X', pack('V3v', 10, $flags,
+                    ($imageWidth-1) | ((($imageHeight-1) & 0xff) << 24),
+                    ($imageHeight-1) >> 8));
+                # write ICCP after VP8X
+                Write($outfile, $dirDat{ICCP}) or $err = 1 if $dirDat{ICCP};
+            }
+        } else {
+            $outsize += length $buff;
+        }
+        my $pos = 12;
+#
+# Read chunks in RIFF image
+#
+        for (;;) {
+            my ($tag, $len);
+            my $num = $raf->Read($buff, 8);
+            if ($num < 8) {
+                $num and $et->Error('RIFF format error'), return 1;
+                # all done if we hit end of file unless we need to add EXIF or XMP
+                last unless $$addDirs{EXIF} or $$addDirs{'XMP '} or $$addDirs{ICCP};
+                # continue to add required EXIF or XMP chunks
+                $num = $len = 0;
+                $buff = $tag = '';
+            } else {
+                $pos += 8;
+                ($tag, $len) = unpack('a4V', $buff);
+                if ($len <= 0) {
+                    if ($len < 0) {
+                        $et->Error('Invalid chunk length');
+                        return 1;
+                    } elsif ($tag eq "\0\0\0\0") {
+                        # avoid reading through corrupted files filled with nulls because it takes forever
+                        $et->Error('Encountered empty null chunk. Processing aborted');
+                        return 1;
+                    } else { # (just in case a tag may have no data)
+                        if ($pass) {
+                            Write($outfile, $buff) or $err = 1;
+                        } else {
+                            $outsize += length $buff;
+                        }
+                        next;
+                    }
+                }
+            }
+            # RIFF chunks are padded to an even number of bytes
+            my $len2 = $len + ($len & 0x01);
+            # edit/add/delete necessary metadata chunks (EXIF must come before XMP)
+            if ($$editDirs{$tag} or $tag eq '' or ($tag eq 'XMP ' and $$addDirs{EXIF})) {
+                my $handledTag;
+                if ($len2) {
+                    $et->Warn("Duplicate '${tag}' chunk") if $doneDir{$tag} and not $pass;
+                    $doneDir{$tag} = 1;
+                    $raf->Read($buff, $len2) == $len2 or $et->Error("Truncated '${tag}' chunk"), last;
+                    $pos += $len2;  # update current position
+                } else {
+                    $buff = '';
+                }
+#
+# add/edit/delete EXIF/XMP/ICCP (note: EXIF must come before XMP, and ICCP is written elsewhere)
+#
+                my %dirName = ( EXIF => 'IFD0', 'XMP ' => 'XMP', ICCP => 'ICC_Profile' );
+                my %tblName = ( EXIF => 'Exif', 'XMP ' => 'XMP', ICCP => 'ICC_Profile' );
+                my $dir;
+                foreach $dir ('EXIF', 'XMP ', 'ICCP' ) {
+                    next unless $tag eq $dir or ($$addDirs{$dir} and
+                        ($tag eq '' or ($tag eq 'XMP ' and $dir eq 'EXIF')));
+                    delete $$addDirs{$dir}; # (don't try to add again)
+                    my $start;
+                    unless ($pass) {
+                        # write the EXIF and save the result for the next pass
+                        my $dataPt = \$buff;
+                        if ($tag eq 'EXIF') {
+                            # (only need to set directory $start for EXIF)
+                            if ($buff =~ /^Exif\0\0/) {
+                                $et->Warn('Improper EXIF header') unless $pass;
+                                $start = 6;
+                            } else {
+                                $start = 0;
+                            }
+                        } elsif ($dir ne $tag) {
+                            # create from scratch
+                            my $buf2 = '';
+                            $dataPt = \$buf2;
+                        }
+                        # write the new directory to memory
+                        my %dirInfo = (
+                            DataPt   => $dataPt,
+                            DataPos  => 0,      # (relative to Base)
+                            DirStart => $start,
+                            Base     => $pos - $len2,
+                            Parent   => $dir,
+                            DirName  => $dirName{$dir},
+                        );
+                        my $tagTablePtr = GetTagTable("Image::ExifTool::$tblName{$dir}::Main");
+                        # (override writeProc for EXIF because it has the TIFF header)
+                        my $writeProc = $dir eq 'EXIF' ? \&Image::ExifTool::WriteTIFF : undef;
+                        $dirDat{$dir} = $et->WriteDirectory(\%dirInfo, $tagTablePtr, $writeProc);
+                    }
+                    if (defined $dirDat{$dir}) {
+                        if ($dir eq $tag) {
+                            $handledTag = 1;    # set flag indicating we edited this tag
+                            # increment CHANGED count if we are deleting the directory
+                            ++$$et{CHANGED} unless length $dirDat{$dir};
+                        }
+                        if (length $dirDat{$dir}) {
+                            if ($pass) {
+                                # write metadata chunk now (but not ICCP because it was added earlier)
+                                Write($outfile, $dirDat{$dir}) or $err = 1 unless $dir eq 'ICCP';
+                            } else {
+                                # preserve (incorrect EXIF) header if it existed
+                                my $hdr = $start ? substr($buff,0,$start) : '';
+                                # (don't overwrite $len here because it may be XMP length)
+                                my $dirLen = length($dirDat{$dir}) + length($hdr);
+                                # add chunk header and padding
+                                my $pad = $dirLen & 0x01 ? "\0" : '';
+                                $dirDat{$dir} = $dir . Set32u($dirLen) . $hdr . $dirDat{$dir} . $pad;
+                                $outsize += length($dirDat{$dir});
+                                $has{$dir} = 1;
+                            }
+                        }
+                    }
+                }
+#
+# just copy XMP, EXIF or ICC if nothing changed
+#
+                if (not $handledTag and length $buff) {
+                    # write the chunk without changes
+                    if ($pass) {
+                        Write($outfile, $tag, Set32u($len), $buff) or $err = 1;
+                    } else {
+                        $outsize += 8 + length($buff);
+                        $has{$tag} = 1;
+                    }
+                }
+                next;
+            }
+            $pos += $len2;  # set read position at end of chunk data
+#
+# update necessary flags in VP8X chunk
+#
+            if ($tag eq 'VP8X') {
+                my $buf2;
+                if ($len2 < 10 or $raf->Read($buf2, $len2) != $len2) {
+                    $et->Error('Truncated VP8X chunk');
+                    return 1;
+                }
+                if ($pass) {
+                    if ($deleteVP8X) {
+                        $et->VPrint(0,"  Deleting unnecessary VP8X chunk (Standard WEBP)\n");
+                        next;
+                    }
+                    # ...but first set the VP8X flags
+                    my $flags = Get32u(\$buf2, 0);
+                    $flags &= ~0x2c; # (reset flags for everything we can write)
+                    $flags |= 0x04 if $has{'XMP '};
+                    $flags |= 0x08 if $has{EXIF};
+                    $flags |= 0x20 if $has{ICCP};
+                    Set32u($flags, \$buf2, 0);
+                    Write($outfile, $buff, $buf2) or $err = 1;
+                } else {
+                    # get the image size
+                    $imageWidth  = (Get32u(\$buf2, 4) & 0xffffff) + 1;
+                    $imageHeight = (Get32u(\$buf2, 6) >> 8) + 1;
+                    $outsize += 8 + $len2;
+                    $has{$tag} = 1;
+                }
+                # write ICCP after VP8X
+                Write($outfile, $dirDat{ICCP}) or $err = 1 if $dirDat{ICCP};
+                next;
+            }
+#
+# just copy all other chunks
+#
+            if ($pass) {
+                # write chunk header (still in $buff)
+                Write($outfile, $buff) or $err = 1;
+            } else {
+                $outsize += length $buff;
+                $has{$tag} = 1;
+            }
+            unless ($pass or defined $imageWidth) {
+                # get WebP image size from VP8 or VP8L header
+                if ($tag eq 'VP8 ' and $len2 >= 16) {
+                    $raf->Read($buff, 16) == 16 or $et->Error('Truncated VP8 chunk'), return 1;
+                    $outsize += 16;
+                    if ($buff =~ /^...\x9d\x01\x2a/s) {
+                        $imageWidth  = Get16u(\$buff, 6) & 0x3fff;
+                        $imageHeight = Get16u(\$buff, 8) & 0x3fff;
+                    }
+                    $len2 -= 16;
+                } elsif ($tag eq 'VP8L' and $len2 >= 6) {
+                    $raf->Read($buff, 6) == 6 or $et->Error('Truncated VP8L chunk'), return 1;
+                    $outsize += 6;
+                    if ($buff =~ /^\x2f/s) {
+                        $imageWidth  =  (Get16u(\$buff, 1) & 0x3fff) + 1;
+                        $imageHeight = ((Get32u(\$buff, 2) >> 6) & 0x3fff) + 1;
+                    }
+                    $len2 -= 6;
+                }
+            }
+            if ($pass) {
+                # copy the chunk data in 64k blocks
+                while ($len2) {
+                    my $num = $len2;
+                    $num = 65536 if $num > 65536;
+                    $raf->Read($buff, $num) == $num or $et->Error('Truncated RIFF chunk'), last;
+                    Write($outfile, $buff) or $err = 1, last;
+                    $len2 -= $num;
+                }
+            } else {
+                $raf->Seek($len2, 1) or $et->Error('Seek error'), last;
+                $outsize += $len2;
+            }
+        }
+        last if $pass;
+        $raf->Seek(0,0) or $et->Error('Seek error'), last;
+    }
+    return $err ? -1 : 1;
+}
+
+1; # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WriteRIFF.pl - Write RIFF-format files
+
+=head1 SYNOPSIS
+
+This file is autoloaded by Image::ExifTool::RIFF.
+
+=head1 DESCRIPTION
+
+This file contains routines to write metadata to RIFF-format files.
+
+=head1 NOTES
+
+Currently writes only WebP files.
+
+=head1 AUTHOR
+
+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.
+
+=head1 REFERENCES
+
+=over 4
+
+=item L<https://developers.google.com/speed/webp/docs/riff_container>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::Photoshop(3pm)|Image::ExifTool::RIFF>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut

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

@@ -115,7 +115,9 @@ my %writableType = (
     PS  => [ 'PostScript',  'WritePS'  ],
     PSD =>   'Photoshop',
     RAF => [ 'FujiFilm',    'WriteRAF' ],
+    RIFF=> [ 'RIFF',        'WriteRIFF'],
     VRD =>   'CanonVRD',
+    WEBP=> [ 'RIFF',        'WriteRIFF'],
     X3F =>   'SigmaRaw',
     XMP => [ undef,         'WriteXMP' ],
 );
@@ -240,7 +242,7 @@ my %intRange = (
     'int64s' => [-9223372036854775808, 9223372036854775807],
 );
 # lookup for file types with block-writable EXIF
-my %blockExifTypes = map { $_ => 1 } qw(JPEG PNG JP2 MIE EXIF FLIF MOV MP4);
+my %blockExifTypes = map { $_ => 1 } qw(JPEG PNG JP2 MIE EXIF FLIF MOV MP4 RIFF);
 
 my $maxSegmentLen = 0xfffd;     # maximum length of data in a JPEG segment
 my $maxXMPLen = $maxSegmentLen; # maximum length of XMP data in JPEG
@@ -975,7 +977,7 @@ TAG: foreach $tagInfo (@matchingTags) {
                 } else {
                     $wgrp = '';
                 }
-                foreach $wtag (keys %{$$tagInfo{WriteAlso}}) {
+                foreach $wtag (sort keys %{$$tagInfo{WriteAlso}}) {
                     my ($n,$e) = $self->SetNewValue($wgrp . $wtag, undef, Replace=>2);
                     $numSet += $n;
                 }
@@ -1123,7 +1125,7 @@ WriteAlso:
                 $wgrp = '';
             }
             local $SIG{'__WARN__'} = \&SetWarning;
-            foreach $wtag (keys %$writeAlso) {
+            foreach $wtag (sort keys %$writeAlso) {
                 my %opts = (
                     Type => 'ValueConv',
                     Protected   => $protected | 0x02,
@@ -1270,6 +1272,7 @@ sub SetNewValuesFromFile($$;@)
         GlobalTimeShift => $$options{GlobalTimeShift},
         HexTagIDs       => $$options{HexTagIDs},
         IgnoreMinorErrors=>$$options{IgnoreMinorErrors},
+        IgnoreTags      => $$options{IgnoreTags},
         Lang            => $$options{Lang},
         LargeFileSupport=> $$options{LargeFileSupport},
         List            => 1,
@@ -4241,7 +4244,12 @@ sub WriteDirectory($$$;$)
     $$self{DIR_NAME} = $oldDir;
     @$self{'Compression','SubfileType'} = @save;
     SetByteOrder($saveOrder);
-    print $out "  Deleting $name\n" if $out and defined $newData and not length $newData;
+    if ($out) {
+        print $out "  Deleting $name\n" if defined $newData and not length $newData;
+        if ($$self{CHANGED} == $oldChanged and $$self{OPTIONS}{Verbose} > 2) {
+            print $out "$$self{INDENT}  [nothing changed in $dirName]\n";
+        }
+    }
     return $newData;
 }
 
@@ -4530,7 +4538,7 @@ sub DumpUnknownTrailer($$)
         # add to Preview block list if valid and in the trailer
         $image{$prePos} = [$tag, $preLen] if $prePos and $preLen and $prePos+$preLen > $pos;
         last if $lastOne;   # checked all images
-        # look for MPF images (in the the proper order)
+        # look for MPF images (in the proper order)
         ++$mpImageNum;
         $prePos = $$self{VALUE}{"MPImageStart ($mpImageNum)"};
         if (defined $prePos) {

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

@@ -50,7 +50,7 @@ use Image::ExifTool::Exif;
 use Image::ExifTool::GPS;
 require Exporter;
 
-$VERSION = '3.51';
+$VERSION = '3.55';
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(EscapeXML UnescapeXML);
 
@@ -128,6 +128,8 @@ my %xmpNS = (
     stRef     => 'http://ns.adobe.com/xap/1.0/sType/ResourceRef#',
     stVer     => 'http://ns.adobe.com/xap/1.0/sType/Version#',
     stMfs     => 'http://ns.adobe.com/xap/1.0/sType/ManifestItem#',
+    stCamera  => 'http://ns.adobe.com/photoshop/1.0/camera-profile',
+    crlcp     => 'http://ns.adobe.com/camera-raw-embedded-lens-profile/1.0/',
     tiff      => 'http://ns.adobe.com/tiff/1.0/',
    'x'        => 'adobe:ns:meta/',
     xmpG      => 'http://ns.adobe.com/xap/1.0/g/',
@@ -1273,6 +1275,41 @@ my %sPantryItem = (
         },
     },
     EmbeddedXMPDigest => { },   #PH (LR5)
+    CameraProfiles => { #PH (2022-10-11)
+        List => 'Seq',
+        Struct => {
+            NAMESPACE   => 'stCamera',
+            STRUCT_NAME => 'Camera',
+            Author              => { },
+            Make                => { },
+            Model               => { },
+            UniqueCameraModel   => { },
+            CameraRawProfile    => { Writable => 'boolean' },
+            AutoScale           => { Writable => 'boolean' },
+            Lens                => { },
+            CameraPrettyName    => { },
+            LensPrettyName      => { },
+            ProfileName         => { },
+            SensorFormatFactor  => { Writable => 'real' },
+            FocalLength         => { Writable => 'real' },
+            FocusDistance       => { Writable => 'real' },
+            ApertureValue       => { Writable => 'real' },
+            PerspectiveModel    => {
+                Namespace       => 'crlcp',
+                Struct => {
+                    NAMESPACE   => 'stCamera',
+                    STRUCT_NAME => 'PerspectiveModel',
+                    Version              => { },
+                    ImageXCenter         => { Writable => 'real' },
+                    ImageYCenter         => { Writable => 'real' },
+                    ScaleFactor          => { Writable => 'real' },
+                    RadialDistortParam1  => { Writable => 'real' },
+                    RadialDistortParam2  => { Writable => 'real' },
+                    RadialDistortParam3  => { Writable => 'real' },
+                },
+            },
+        },
+    },
 );
 
 # Photoshop Camera Raw namespace properties (crs) - (ref 8,PH)
@@ -1431,7 +1468,14 @@ my %sPantryItem = (
     PostCropVignetteMidpoint    => { Writable => 'integer' },
     PostCropVignetteFeather     => { Writable => 'integer' },
     PostCropVignetteRoundness   => { Writable => 'integer' },
-    PostCropVignetteStyle       => { Writable => 'integer' },
+    PostCropVignetteStyle       => {
+        Writable => 'integer',
+        PrintConv => { #forum14011
+            1 => 'Highlight Priority',
+            2 => 'Color Priority',
+            3 => 'Paint Overlay',
+        },
+    },
     # disable List behaviour of flattened Gradient/PaintBasedCorrections
     # because these are nested in lists and the flattened tags can't
     # do justice to this complex structure
@@ -1528,7 +1572,17 @@ my %sPantryItem = (
     },
     ColorNoiseReductionSmoothness       => { Writable => 'integer' },
     PerspectiveAspect                   => { Writable => 'integer' },
-    PerspectiveUpright                  => { Writable => 'integer' },
+    PerspectiveUpright                  => {
+        Writable => 'integer',
+        PrintConv => { #forum14012
+            0 => 'Off',     # Disable Upright
+            1 => 'Auto',    # Apply balanced perspective corrections
+            2 => 'Full',    # Apply level, horizontal, and vertical perspective corrections
+            3 => 'Level',   # Apply only level correction
+            4 => 'Vertical',# Apply level and vertical perspective corrections
+            5 => 'Guided',  # Draw two or more guides to customize perspective corrections
+        },
+    },
     RetouchAreas => {
         FlatName => 'RetouchArea',
         Struct => \%sRetouchArea,
@@ -1552,12 +1606,17 @@ my %sPantryItem = (
     UprightPreview                      => { Writable => 'boolean' },
     UprightTransformCount               => { Writable => 'integer' },
     UprightDependentDigest              => { },
+    UprightGuidedDependentDigest        => { },
     UprightTransform_0                  => { },
     UprightTransform_1                  => { },
     UprightTransform_2                  => { },
     UprightTransform_3                  => { },
     UprightTransform_4                  => { },
     UprightTransform_5                  => { },
+    UprightFourSegments_0               => { },
+    UprightFourSegments_1               => { },
+    UprightFourSegments_2               => { },
+    UprightFourSegments_3               => { },
     # more stuff seen in lens profile file (unknown source)
     What => { }, # (with value "LensProfileDefaultSettings")
     LensProfileMatchKeyExifMake         => { },
@@ -2396,6 +2455,12 @@ my %sPantryItem = (
     LateralChromaticAberrationCorrectionAlreadyApplied => { Writable => 'boolean' },
     LensDistortInfo => { }, # (LR 7.5.1, 4 signed rational values)
     NeutralDensityFactor => { }, # (LR 11.0 - rational value, but denominator seems significant)
+    # the following are ref forum13747
+    EnhanceDetailsAlreadyApplied    => { Writable => 'boolean' },
+    EnhanceDetailsVersion           => { }, # integer?
+    EnhanceSuperResolutionAlreadyApplied => { Writable => 'boolean' },
+    EnhanceSuperResolutionVersion   => { }, # integer?
+    EnhanceSuperResolutionScale     => { Writable => 'rational' },
 );
 
 # IPTC Core namespace properties (Iptc4xmpCore) (ref 4)
@@ -2620,7 +2685,7 @@ sub FullEscapeXML($)
     $str =~ s/([&><'"])/&$charName{$1};/sg; # escape necessary XML characters
     $str =~ s/\\/&#92;/sg;                  # escape backslashes too
     # then use C-escape sequences for invalid characters
-    if ($str =~ /[\0-\x1f]/ or IsUTF8(\$str) < 0) {
+    if ($str =~ /[\0-\x1f]/ or Image::ExifTool::IsUTF8(\$str) < 0) {
         $str =~ s/([\0-\x1f\x80-\xff])/sprintf("\\x%.2x",ord $1)/sge;
     }
     return $str;
@@ -2665,57 +2730,6 @@ sub UnescapeChar($$;$)
     return $val;
 }
 
-#------------------------------------------------------------------------------
-# Does a string contain valid UTF-8 characters?
-# Inputs: 0) string reference, 1) true to allow last character to be truncated
-# Returns: 0=regular ASCII, -1=invalid UTF-8, 1=valid UTF-8 with maximum 16-bit
-#          wide characters, 2=valid UTF-8 requiring 32-bit wide characters
-# Notes: Changes current string position
-# (see http://www.fileformat.info/info/unicode/utf8.htm for help understanding this)
-sub IsUTF8($;$)
-{
-    my ($strPt, $trunc) = @_;
-    pos($$strPt) = 0; # start at beginning of string
-    return 0 unless $$strPt =~ /([\x80-\xff])/g;
-    my $rtnVal = 1;
-    for (;;) {
-        my $ch = ord($1);
-        # minimum lead byte for 2-byte sequence is 0xc2 (overlong sequences
-        # not allowed), 0xf8-0xfd are restricted by RFC 3629 (no 5 or 6 byte
-        # sequences), and 0xfe and 0xff are not valid in UTF-8 strings
-        return -1 if $ch < 0xc2 or $ch >= 0xf8;
-        # determine number of bytes remaining in sequence
-        my $n;
-        if ($ch < 0xe0) {
-            $n = 1;
-        } elsif ($ch < 0xf0) {
-            $n = 2;
-        } else {
-            $n = 3;
-            # character code is greater than 0xffff if more than 2 extra bytes
-            # were required in the UTF-8 character
-            $rtnVal = 2;
-        }
-        my $pos = pos $$strPt;
-        unless ($$strPt =~ /\G([\x80-\xbf]{$n})/g) {
-            return $rtnVal if $trunc and $pos + $n > length $$strPt;
-            return -1;
-        }
-        # the following is ref https://www.cl.cam.ac.uk/%7Emgk25/ucs/utf8_check.c
-        if ($n == 2) {
-            return -1 if ($ch == 0xe0 and (ord($1) & 0xe0) == 0x80) or
-                         ($ch == 0xed and (ord($1) & 0xe0) == 0xa0) or
-                         ($ch == 0xef and ord($1) == 0xbf and
-                            (ord(substr $1, 1) & 0xfe) == 0xbe);
-        } else {
-            return -1 if ($ch == 0xf0 and (ord($1) & 0xf0) == 0x80) or
-                         ($ch == 0xf4 and ord($1) > 0x8f) or $ch > 0xf4;
-        }
-        last unless $$strPt =~ /([\x80-\xff])/g;
-    }
-    return $rtnVal;
-}
-
 #------------------------------------------------------------------------------
 # Fix malformed UTF8 (by replacing bad bytes with specified character)
 # Inputs: 0) string reference, 1) string to replace each bad byte,
@@ -2730,7 +2744,7 @@ sub FixUTF8($;$)
         last unless $$strPt =~ /([\x80-\xff])/g;
         my $ch = ord($1);
         my $pos = pos($$strPt);
-        # (see comments in IsUTF8() above)
+        # (see comments in Image::ExifTool::IsUTF8())
         if ($ch >= 0xc2 and $ch < 0xf8) {
             my $n = $ch < 0xe0 ? 1 : ($ch < 0xf0 ? 2 : 3);
             if ($$strPt =~ /\G([\x80-\xbf]{$n})/g) {
@@ -2982,8 +2996,9 @@ sub AddFlattenedTags($;$$)
             } else {
                 $$flatInfo{Groups}{2} = $tagG2;
             }
-            # save reference to top-level structure
+            # save reference to top-level and parent structures
             $$flatInfo{RootTagInfo} = $$tagInfo{RootTagInfo} || $tagInfo;
+            $$flatInfo{ParentTagInfo} = $tagInfo;
             # recursively generate flattened tags for sub-structures
             next unless $$flatInfo{Struct};
             length($flatID) > 250 and warn("Possible deep recursion for tag $flatID\n"), last;
@@ -3447,8 +3462,12 @@ NoLoop:
         } else {
             $val = ConvertXMPDate($val, $new) if $new or $fmt eq 'date';
         }
-        if ($$et{XmpValidate} and $fmt and $fmt eq 'boolean') {
-            $et->WarnOnce("Boolean value for XMP-$ns:$$tagInfo{Name} should be capitalized",1);
+        if ($$et{XmpValidate} and $fmt and $fmt eq 'boolean' and $val!~/^True|False$/) {
+            if ($val =~ /^true|false$/) {
+                $et->WarnOnce("Boolean value for XMP-$ns:$$tagInfo{Name} should be capitalized",1);
+            } else {
+                $et->WarnOnce(qq(Boolean value for XMP-$ns:$$tagInfo{Name} should be "True" or "False"),1);
+            }
         }
         # protect against large binary data in unknown tags
         $$tagInfo{Binary} = 1 if $new and length($val) > 65536;