exiftool-vendored.pl 12.31.0 → 12.39.0

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

@@ -11,6 +11,7 @@
 #               4) http://www.color.org/privatetag2007-01.pdf
 #               5) http://www.color.org/icc_specs2.xalter (approved revisions, 2010-07-16)
 #               6) Eef Vreeland private communication
+#               7) https://color.org/specification/ICC.2-2019.pdf
 #
 # Notes:        The ICC profile information is different: the format of each
 #               tag is embedded in the information instead of in the directory
@@ -24,7 +25,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.36';
+$VERSION = '1.38';
 
 sub ProcessICC($$);
 sub ProcessICC_Profile($$$);
@@ -52,6 +53,11 @@ my %profileClass = (
     abst => 'Abstract Profile',
     nmcl => 'NamedColor Profile',
     nkpf => 'Nikon Input Device Profile (NON-STANDARD!)', # (written by Nikon utilities)
+    # additions in v5 (ref 7)
+    cenc => 'ColorEncodingSpace Profile',
+   'mid '=> 'MultiplexIdentification Profile',
+    mlnk => 'MultiplexLink Profile',
+    mvis => 'MultiplexVisualization Profile',
 );
 my %manuSig = ( #6
     'NONE' => 'none',
@@ -539,6 +545,90 @@ my %manuSig = ( #6
         Binary => 1, # (NC)
     },
 
+    # new tags in v5 (ref 7)
+    A2B3 => 'AToB3',
+    A2M0 => 'AToM0',
+    B2A3 => 'BToA3',
+    bcp0 => 'BRDFColorimetricParam0',
+    bcp1 => 'BRDFColorimetricParam1',
+    bcp2 => 'BRDFColorimetricParam2',
+    bcp3 => 'BRDFColorimetricParam3',
+    bsp0 => 'BRDFSpectralParam0',
+    bsp1 => 'BRDFSpectralParam1',
+    bsp2 => 'BRDFSpectralParam2',
+    bsp3 => 'BRDFSpectralParam3',
+    bAB0 => 'BRDFAToB0',
+    bAB1 => 'BRDFAToB1',
+    bAB2 => 'BRDFAToB2',
+    bAB3 => 'BRDFAToB3',
+    bBA0 => 'BRDFBToA0',
+    bBA1 => 'BRDFBToA1',
+    bBA2 => 'BRDFBToA2',
+    bBA3 => 'BRDFBToA3',
+    bBD0 => 'BRDFBToD0',
+    bBD1 => 'BRDFBToD1',
+    bBD2 => 'BRDFBToD2',
+    bBD3 => 'BRDFBToD3',
+    bDB0 => 'BRDFDToB0',
+    bDB1 => 'BRDFDToB1',
+    bDB2 => 'BRDFDToB2',
+    bDB3 => 'BRDFDToB3',
+    bMB0 => 'BRDFMToB0',
+    bMB1 => 'BRDFMToB1',
+    bMB2 => 'BRDFMToB2',
+    bMB3 => 'BRDFMToB3',
+    bMS0 => 'BRDFMToS0',
+    bMS1 => 'BRDFMToS1',
+    bMS2 => 'BRDFMToS2',
+    bMS3 => 'BRDFMToS3',
+    dAB0 => 'DirectionalAToB0',
+    dAB1 => 'DirectionalAToB1',
+    dAB2 => 'DirectionalAToB2',
+    dAB3 => 'DirectionalAToB3',
+    dBA0 => 'DirectionalBToA0',
+    dBA1 => 'DirectionalBToA1',
+    dBA2 => 'DirectionalBToA2',
+    dBA3 => 'DirectionalBToA3',
+    dBD0 => 'DirectionalBToD0',
+    dBD1 => 'DirectionalBToD1',
+    dBD2 => 'DirectionalBToD2',
+    dBD3 => 'DirectionalBToD3',
+    dDB0 => 'DirectionalDToB0',
+    dDB1 => 'DirectionalDToB1',
+    dDB2 => 'DirectionalDToB2',
+    dDB3 => 'DirectionalDToB3',
+    gdb0 => 'GamutBoundaryDescription0',
+    gdb1 => 'GamutBoundaryDescription1',
+    gdb2 => 'GamutBoundaryDescription2',
+    gdb3 => 'GamutBoundaryDescription3',
+   'mdv '=> 'MultiplexDefaultValues',
+    mcta => 'MultiplexTypeArray',
+    minf => 'MeasurementInfo',
+    miin => 'MeasurementInputInfo',
+    M2A0 => 'MToA0',
+    M2B0 => 'MToB0',
+    M2B1 => 'MToB1',
+    M2B2 => 'MToB2',
+    M2B3 => 'MToB3',
+    M2S0 => 'MToS0',
+    M2S1 => 'MToS1',
+    M2S2 => 'MToS2',
+    M2S3 => 'MToS3',
+    cept => 'ColorEncodingParams',
+    csnm => 'ColorSpaceName',
+    cloo => 'ColorantOrderOut',
+    clio => 'ColorantInfoOut',
+    c2sp => 'CustomToStandardPcc',
+   'CxF '=> 'CXF',
+    nmcl => 'NamedColor',
+    psin => 'ProfileSequenceInfo',
+    rfnm => 'ReferenceName',
+    svcn => 'SpectralViewingConditions',
+    swpt => 'SpectralWhitePoint',
+    s2cp => 'StandardToCustomPcc',
+    smap => 'SurfaceMap',
+    # smwp ? (seen in some v5 samples)
+
     # the following entry represents the ICC profile header, and doesn't
     # exist as a tag in the directory.  It is only in this table to provide
     # a link so ExifTool can locate the header tags
@@ -850,7 +940,7 @@ sub FormatICCTag($$$)
     # dataType
     if ($type eq 'data' and $size >= 12) {
         my $form = Get32u($dataPt, $offset+8);
-        # format 0 is ASCII data
+        # format 0 is UTF-8 data
         $form == 0 and return substr($$dataPt, $offset+12, $size-12);
         # binary data and other data types treat as binary (ie. don't format)
     }
@@ -1022,7 +1112,7 @@ sub ValidateICC($)
     $profileClass{substr($$valPtr, 12, 4)} or $err = 'profile class';
     my $col = substr($$valPtr, 16, 4); # ColorSpaceData
     my $con = substr($$valPtr, 20, 4); # ConnectionSpace
-    my $match = '(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR)';
+    my $match = '(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR|nc..|\0{4})';
     $col =~ /$match/ or $err = 'color space';
     $con =~ /$match/ or $err = 'connection space';
     return $err ? "Invalid ICC profile (bad $err)" : undef;
@@ -1134,7 +1224,7 @@ sub ProcessICC_Profile($$$)
         my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
         # unknown tags aren't generated automatically by GetTagInfo()
         # if the tagID's aren't numeric, so we must do this manually:
-        if (not $tagInfo and $$et{OPTIONS}{Unknown}) {
+        if (not $tagInfo and ($$et{OPTIONS}{Unknown} or $verbose)) {
             $tagInfo = { Unknown => 1 };
             AddTagToTable($tagTablePtr, $tagID, $tagInfo);
         }
@@ -1264,7 +1354,7 @@ data created on one device into another device's native color space.
 
 =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.
@@ -1277,6 +1367,8 @@ under the same terms as Perl itself.
 
 =item L<http://developer.apple.com/documentation/GraphicsImaging/Reference/ColorSync_Manager/ColorSync_Manager.pdf>
 
+=item L<https://color.org/specification/ICC.2-2019.pdf>
+
 =back
 
 =head1 SEE ALSO

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

@@ -1652,7 +1652,7 @@ other types of audio 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/IPTC.pm

@@ -1280,7 +1280,7 @@ image 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/ISO.pm

@@ -184,7 +184,7 @@ information from ISO 9660 disk images.
 
 =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/ITC.pm

@@ -191,7 +191,7 @@ information (including artwork images) from iTunes Cover Flow 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/Import.pm

@@ -348,7 +348,7 @@ stored as hash lookups of tag name/value for each SourceFile.
 
 =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/InDesign.pm

@@ -258,7 +258,7 @@ them and the LargeFileSupport 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/JPEG.pm

@@ -11,7 +11,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.32';
+$VERSION = '1.33';
 
 sub ProcessOcad($$$);
 sub ProcessJPEG_HDR($$$);
@@ -284,6 +284,10 @@ sub ProcessJPEG_HDR($$$);
       }, {
         Name => 'Insta360',
         Condition => '$$valPt =~ /8db42d694ccc418790edff439fe026bf$/',
+      }, {
+        Name => 'NikonApp',
+        Condition => '$$valPt =~ m(\0{6}/NIKON APP$)',
+        Notes => 'contains editing information in XMP format',
       }, {
         Name => 'PreviewImage',
         Condition => '$$valPt =~ /^\xff\xd8\xff/',
@@ -714,7 +718,7 @@ segments are included in the Image::ExifTool module itself.
 
 =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/JPEGDigest.pm

@@ -2590,7 +2590,7 @@ estimated JPEG quality if requested.
 
 =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/JSON.pm

@@ -14,7 +14,7 @@ use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 use Image::ExifTool::Import;
 
-$VERSION = '1.03';
+$VERSION = '1.05';
 
 sub ProcessJSON($$);
 sub ProcessTag($$$$%);
@@ -83,8 +83,12 @@ sub ProcessTag($$$$%)
             FoundTag($et, $tagTablePtr, $tag, $val, %flags, Struct => 1);
             return unless $et->Options('Struct') > 1;
         }
-        foreach (sort keys %$val) {
-            ProcessTag($et, $tagTablePtr, $tag . ucfirst, $$val{$_}, %flags, Flat => 1);
+        # support hashes with ordered keys
+        my @keys = $$val{_ordered_keys_} ? @{$$val{_ordered_keys_}} : sort keys %$val;
+        foreach (@keys) {
+            my $tg = $tag . ((/^\d/ and $tag =~ /\d$/) ? '_' : '') . ucfirst;
+            $tg =~ s/([^a-zA-Z])([a-z])/$1\U$2/g;
+            ProcessTag($et, $tagTablePtr, $tg, $$val{$_}, %flags, Flat => 1);
         }
     } elsif (ref $val eq 'ARRAY') {
         foreach (@$val) {
@@ -172,7 +176,7 @@ information from JSON 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/JVC.pm

@@ -117,7 +117,7 @@ notes.
 
 =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/Jpeg2000.pm

@@ -16,7 +16,7 @@ use strict;
 use vars qw($VERSION);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.30';
+$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',
@@ -116,9 +117,6 @@ my %j2cMarker = (
     0x76 => 'NLT', # non-linearity point transformation
 );
 
-my %jumbfTypes = (
-);
-
 # JPEG 2000 "box" (ie. atom) names
 # Note: only tags with a defined "Format" are extracted
 %Image::ExifTool::Jpeg2000::Main = (
@@ -127,10 +125,13 @@ my %jumbfTypes = (
     WRITE_PROC => \&ProcessJpeg2000Box,
     PREFERRED => 1, # always add these tags when writing
     NOTES => q{
-        The tags below are extracted from JPEG 2000 images and the JUMBF metadata in
-        JPEG images.  Note that ExifTool currently writes only EXIF, IPTC and XMP
-        tags in Jpeg2000 images.
+        The tags below are found in JPEG 2000 images and the JUMBF metadata in JPEG
+        images, but not all of these are extracted.  Note that ExifTool currently
+        writes only EXIF, IPTC and XMP tags in Jpeg2000 images.
     },
+#
+# NOTE: ONLY TAGS WITH "Format" DEFINED ARE EXTRACTED!
+#
    'jP  ' => 'JP2Signature', # (ref 1)
    "jP\x1a\x1a" => 'JP2Signature', # (ref 2)
     prfl => 'Profile',
@@ -340,10 +341,20 @@ my %jumbfTypes = (
         },
         {
             Name => 'UUID-Signature',  # (seen in JUMB data of JPEG images)
+            # (may be able to remove this when JUMBF specification is finalized)
             Condition => '$$valPt=~/^casg\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/',
             Format => 'undef',
             ValueConv => 'substr($val,16)',
         },
+        {
+            Name => 'UUID-C2PAClaimSignature',  # (seen in incorrectly-formatted JUMB data of JPEG images)
+            # (may be able to remove this when JUMBF specification is finalized)
+            Condition => '$$valPt=~/^c2cs\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/',
+            SubDirectory => {
+                TagTable => 'Image::ExifTool::CBOR::Main',
+                Start => '$valuePtr + 16',
+            },
+        },
         {
             Name => 'UUID-Unknown',
         },
@@ -386,6 +397,27 @@ my %jumbfTypes = (
         },
         SubDirectory => { TagTable => 'Image::ExifTool::JSON::Main' },
     },
+    cbor => {
+        Name => 'CBORData',
+        Flags => [ 'Binary', 'Protected' ],
+        SubDirectory => { TagTable => 'Image::ExifTool::CBOR::Main' },
+    },
+    bfdb => { # used in JUMBF (see  # (used when tag is renamed according to JUMDLabel)
+        Name => 'BinaryDataType',
+        Notes => 'JUMBF, MIME type and optional file name',
+        Format => 'undef',
+        # (ignore "toggles" byte and just extract MIME type and file name)
+        ValueConv => '$_=substr($val,1); s/\0+$//; s/\0/, /; $_',
+        JUMBF_Suffix => 'Type', # (used when tag is renamed according to JUMDLabel)
+    },
+    bidb => { # used in JUMBF
+        Name => 'BinaryData',
+        Notes => 'JUMBF',
+        Groups => { 2 => 'Preview' },
+        Format => 'undef',
+        Binary => 1,
+        JUMBF_Suffix => 'Data', # (used when tag is renamed according to JUMDLabel)
+    },
 #
 # stuff seen in JPEG XL images:
 #
@@ -529,11 +561,34 @@ my %jumbfTypes = (
 
 %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',
@@ -541,9 +596,15 @@ my %jumbfTypes = (
             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',
@@ -568,6 +629,7 @@ my %jumbfTypes = (
             Name => 'ColorSpace',
             Condition => '$$self{ColorSpecMethod} == 1',
             Format => 'int32u',
+            Protected => 1,
             PrintConv => { # ref 15444-2 2002-05-15
                 0 => 'Bi-level',
                 1 => 'YCbCr(1)',
@@ -597,6 +659,8 @@ my %jumbfTypes = (
         {
             Name => 'ColorSpecData',
             Format => 'undef[$size-3]',
+            Writable => 'undef',
+            Protected => 1,
             Binary => 1,
         },
     ],
@@ -690,6 +754,7 @@ sub ProcessJUMD($$$)
         if ($len) {
             $name =~ s/[^-_a-zA-Z0-9]([a-z])/\U$1/g; # capitalize characters after illegal characters
             $name =~ tr/-_a-zA-Z0-9//dc;    # remove other illegal characters
+            $name =~ s/__/_/;               # collapse double underlines
             $name = ucfirst $name;          # capitalize first letter
             $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
             $$et{JUMBFLabel} = $name;
@@ -785,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
@@ -802,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) {
@@ -810,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
@@ -825,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;
@@ -839,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
@@ -932,6 +1054,14 @@ sub ProcessJpeg2000Box($$$)
                 }
             }
         }
+        # create new tag for JUMBF data values with name corresponding to JUMBFLabel
+        if ($tagInfo and $$et{JUMBFLabel} and (not $$tagInfo{SubDirectory} or $$tagInfo{BlockExtract})) {
+            $tagInfo = { %$tagInfo, Name => $$et{JUMBFLabel} . ($$tagInfo{JUMBF_Suffix} || '') };
+            delete $$tagInfo{Description};
+            AddTagToTable($tagTablePtr, '_JUMBF_' . $$et{JUMBFLabel}, $tagInfo);
+            delete $$tagInfo{Protected}; # (must do this so -j -b returns JUMBF binary data)
+            $$tagInfo{TagID} = $boxID;
+        }
         if ($verbose) {
             $et->VerboseInfo($boxID, $tagInfo,
                 Table  => $tagTablePtr,
@@ -942,13 +1072,6 @@ sub ProcessJpeg2000Box($$$)
             );
             next unless $tagInfo;
         }
-        # create new tag for JUMBF data values with name corresponding to JUMBFLabel
-        if ($$et{JUMBFLabel} and (not $$tagInfo{SubDirectory} or $$tagInfo{BlockExtract})) {
-            $tagInfo = { %$tagInfo, Name => $$et{JUMBFLabel} };
-            AddTagToTable($tagTablePtr, '_JUMBF_' . $$et{JUMBFLabel}, $tagInfo);
-            delete $$tagInfo{Protected}; # (must do this so -j -b returns JUMBF binary data)
-            $$tagInfo{TagID} = $boxID;
-        }
         if ($$tagInfo{SubDirectory}) {
             my $subdir = $$tagInfo{SubDirectory};
             my $subdirStart = $valuePtr;
@@ -976,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) {
@@ -989,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};
@@ -1225,7 +1355,7 @@ 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/Kodak.pm

@@ -3252,7 +3252,7 @@ interpret Kodak maker notes EXIF meta information.
 
 =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/KyoceraRaw.pm

@@ -152,7 +152,7 @@ meta information from Kyocera Contax N Digital RAW images.
 
 =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/LIF.pm

@@ -139,7 +139,7 @@ metadata from Leica Image File (LIF) images.
 
 =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.