exiftool_vendored 11.44.0 → 11.47.0

data/bin/lib/Image/ExifTool/README

@@ -52,6 +52,7 @@ with tag keys.  Below is an explanation of the meaning of each special key:
     FixOffsets  - Evaluated for each value pointer to patch maker note offsets
     LastIFD     - Used by WriteExif() to return offset of last IFD written
     ImageData   - Used by WriteExif() to avoid buffering large image data blocks
+    NoRefTest   - Flag to bypass "referenced by previous directory" test
 
   WRITE_PROC : Function reference or name for writing this directory.  The
   function returns the new directory data or undefined on error.  It takes the

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

@@ -6772,6 +6772,7 @@ my %tagExists = (
 	'clonetype' => 1,
 	'closedcaptioning' => 1,
 	'cmmflags' => 1,
+	'cmp1' => 1,
 	'cmykequivalent' => 1,
 	'coarsedata' => 1,
 	'coarsemapimage' => 1,
@@ -7928,6 +7929,7 @@ my %tagExists = (
 	'hyperlinkbase' => 1,
 	'hyperlinks' => 1,
 	'hyperlinkschanged' => 1,
+	'iad1' => 1,
 	'icc_untagged' => 1,
 	'iccbased' => 1,
 	'iconenvdata' => 1,
@@ -10383,6 +10385,7 @@ my %tagExists = (
 	'usptooriginalcontenttype' => 1,
 	'utm' => 1,
 	'uuid-canon' => 1,
+	'uuid-canon2' => 1,
 	'uuid-exif' => 1,
 	'uuid-exif2' => 1,
 	'uuid-exif_bad' => 1,

data/bin/lib/Image/ExifTool/TagNames.pod

@@ -12,7 +12,7 @@ meta information extracted from or written to a file.
 =head1 TAG TABLES
 
 The tables listed below give the names of all tags recognized by ExifTool.
-They contain a total of 22584 tags, with 15004 unique tag names.
+They contain a total of 22586 tags, with 15003 unique tag names.
 
 B<Tag ID>, B<Index#> or B<Sequence> is given in the first column of each
 table.  A B<Tag ID> is the computer-readable equivalent of a tag name, and
@@ -7042,8 +7042,21 @@ information.
 
   Tag ID   Tag Name                             Writable
   ------   --------                             --------
+  'IAD1'   IAD1                                 Canon IAD1
+
+=head3 Canon IAD1 Tags
+
+  Index2   Tag Name                             Writable
+  ------   --------                             --------
   [no tags known]
 
+=head3 Canon CMP1 Tags
+
+  Index2   Tag Name                             Writable
+  ------   --------                             --------
+      8    ImageWidth                           no
+     10    ImageHeight                          no
+
 =head3 Canon CNOP Tags
 
   Tag ID   Tag Name                             Writable
@@ -7090,6 +7103,12 @@ Information found in the "skip" atom of Canon MOV videos.
   ------   --------                             --------
   'CNDB'   Unknown_CNDB?                        no
 
+=head3 Canon uuid2 Tags
+
+  Tag ID   Tag Name                             Writable
+  ------   --------                             --------
+  'CNOP'   CanonVRD                             CanonVRD
+
 =head2 CanonCustom Tags
 
 =head3 CanonCustom Functions1D Tags
@@ -23954,22 +23973,29 @@ Frame rate information stored by some Canon video cameras.
 
 The QuickTime format is used for many different types of audio, video and
 image files (most notably, MOV/MP4 videos and HEIC/CR3 images).  Exiftool
-extracts standard meta information a variety of audio, video and image
+extracts standard meta information and a variety of audio, video and image
 parameters, as well as proprietary information written by many camera
 models.  Tags with a question mark after their name are not extracted unless
 the Unknown option is set.
 
 When writing, ExifTool creates both QuickTime and XMP tags by default, but
-the group may be specified to write one or the other separately.  Newly
-created QuickTime tags are added in the ItemList location if possible,
-otherwise in UserData, but this may be changed by specifying the location.
-Alternate language tags may be accessed for ItemList tags by adding a
-language-country code to the tag name (eg. "ItemList:Artist-fra-FR"), or for
-UserData tags by adding a language code (eg. "UserData:Artist-fra").  If no
-language code is specified when writing, alternate languages are deleted.
-Use the "und" language code to write the default language without deleting
-alternate languages.  Note that "eng" is treated as a default language when
-reading, but not when writing.
+the group may be specified to write one or the other separately.  If no
+location is specified, newly created QuickTime tags are added in the
+ItemList location if possible, otherwise in UserData, and finally in Keys,
+but this order may be changed by setting the PREFERRED level of the
+appropriate table in the config file (see example.config in the full
+distribution for an example).  ExifTool currently writes only top-level
+metadata in QuickTime-based files; it extracts other track-specific and
+timed metadata, but can not yet edit tags in these locations.
+
+Alternate language tags may be accessed for ItemList and Keys tags by adding
+a 3-character ISO 639-2 language code and an optional ISO 3166-1 alpha 2
+country code to the tag name (eg. "ItemList:Artist-deu" or
+"ItemList::Artist-deu-DE").  UserData tags support only a language code
+(without a country code).  If no language code is specified when writing,
+alternate languages for the tag are deleted.  Use the "und" language code to
+write the default language without deleting alternate languages.  Note that
+"eng" is treated as a default language when reading, but not when writing.
 
 According to the specification, many QuickTime date/time tags should be
 stored as UTC.  Unfortunately, digital cameras often store local time values
@@ -24016,6 +24042,7 @@ for the official specification.
   'uuid'               XMP                      XMP
                        UUID-PROF                QuickTime Profile
                        UUID-Flip                QuickTime Flip
+                       UUID-Canon2              Canon uuid2
                        PreviewImage             no
                        UUID-Unknown?            no
   'wide'               Wide?                    no
@@ -24367,6 +24394,10 @@ MP4 data reference box.
 
 As well as these tags, the "mdta" handler uses numerical tag ID's which are
 added dynamically to this table after processing the Meta Keys information.
+Tags in this table support alternate languages which are accessed by adding
+a 3-character ISO 639-2 language code and an optional ISO 3166-1 alpha 2
+country code to the tag name (eg. "ItemList:Title-fra" or
+"ItemList::Title-fra-FR").
 
   Tag ID       Tag Name                         Writable
   ------       --------                         --------
@@ -24821,6 +24852,7 @@ Child atoms found in "sinf" and/or "pinf" atoms.
      25    CompressorName                       no
      41    BitDepth                             no
   'CDI1'   CDI1                                 Canon CDI1
+  'CMP1'   CMP1                                 Canon CMP1
   'JPEG'   JPEGInfo?                            no
   'avcC'   AVCConfiguration?                    no
   'btrt'   BitrateInfo                          QuickTime Bitrate
@@ -24966,9 +24998,9 @@ MP4 video media header.
 =head3 QuickTime UserData Tags
 
 Tag ID's beginning with the copyright symbol (hex 0xa9) are multi-language
-text.  Alternate language tags are accessed by adding a dash followed by the
-language/country code to the tag name.  ExifTool will extract any
-multi-language user data tags found, even if they don't exist in this table.
+text.  Alternate language tags are accessed by adding a dash followed by a
+3-character ISO 639-2 language code to the tag name.  ExifTool will extract
+any multi-language user data tags found, even if they aren't in this table.
 
   Tag ID       Tag Name                         Writable
   ------       --------                         --------

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

@@ -215,7 +215,7 @@ sub FormatIPTC($$$$$;$)
 sub IptcDate($)
 {
     my $val = shift;
-    unless ($val =~ s/^.*(\d{4}):?(\d{2}):?(\d{2}).*/$1$2$3/s) {
+    unless ($val =~ s{^.*(\d{4})[-:/.]?(\d{2})[-:/.]?(\d{2}).*}{$1$2$3}s) {
         warn "Invalid date format (use YYYY:mm:dd)\n";
         undef $val;
     }

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

@@ -12,21 +12,23 @@ use strict;
 # maps for adding metadata to various QuickTime-based file types
 my %movMap = (
     # MOV (no 'ftyp', or 'ftyp'='qt  ') -> XMP in 'moov'-'udta'-'XMP_'
-    QuickTime => 'ItemList',
-    ItemList  => 'Meta',
+    QuickTime => 'ItemList',    # (default location for QuickTime tags)
+    ItemList  => 'Meta',        # MOV-Movie-UserData-Meta-ItemList
+    Keys      => 'Movie',       # MOV-Movie-Meta-Keys !! (hack due to different Meta location)
     Meta      => 'UserData',
-    XMP       => 'UserData',
-    UserData  => 'Movie',
+    XMP       => 'UserData',    # MOV-Movie-UserData-XMP
+    UserData  => 'Movie',       # MOV-Movie-UserData
     Movie     => 'MOV',
 );
 my %mp4Map = (
     # MP4 ('ftyp' compatible brand 'mp41', 'mp42' or 'f4v ') -> XMP at top level
-    QuickTime => 'ItemList',
-    ItemList  => 'Meta',
+    QuickTime => 'ItemList',    # (default location for QuickTime tags)
+    ItemList  => 'Meta',        # MOV-Movie-UserData-Meta-ItemList
+    Keys      => 'Movie',       # MOV-Movie-Meta-Keys !! (hack due to different Meta location)
     Meta      => 'UserData',
-    UserData  => 'Movie',
+    UserData  => 'Movie',       # MOV-Movie-UserData
     Movie     => 'MOV',
-    XMP       => 'MOV',
+    XMP       => 'MOV',         # MOV-XMP
 );
 my %heicMap = (
     # HEIC ('ftyp' compatible brand 'heic' or 'mif1') -> XMP/EXIF in top level 'meta'
@@ -55,6 +57,8 @@ my %cr3Map = (
     IFD0      => 'UUID-Canon',
     GPS       => 'UUID-Canon',
     #MakerNoteCanon => 'UUID-Canon', # (doesn't yet work -- goes into ExifIFD instead)
+   'UUID-Canon2' => 'MOV',
+    CanonVRD  => 'UUID-Canon2',
 );
 my %dirMap = (
     MOV  => \%movMap,
@@ -72,6 +76,18 @@ my %qtFormat = (
 );
 my $undLang = 0x55c4;   # numeric code for default ('und') language
 
+# boxes that may exist in an "empty" Meta box:
+my %emptyMeta = (
+    hdlr => 'Handler', 'keys' => 'Keys', lang => 'Language', ctry => 'Country', free => 'Free',
+);
+
+# lookup for CTBO ID number based on uuid for Canon CR3 files
+my %ctboID = (
+    "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac" => 1, # XMP
+    "\xea\xf4\x2b\x5e\x1c\x98\x4b\x88\xb9\xfb\xb7\xdc\x40\x6e\x4d\x16" => 2, # PreviewImage
+    # ID 3 is used for 'mdat' atom (not a uuid)
+);
+
 # mark UserData tags that don't have ItemList counterparts as Preferred
 # (and for now, set Writable to 0 for any tag with a RawConv)
 {
@@ -139,18 +155,6 @@ sub ConvInvISO6709($)
     return undef;
 }
 
-#------------------------------------------------------------------------------
-# Check to see if path is current
-# Inputs: 0) ExifTool ref, 1) directory name
-# Returns: true if current path is the root of the specified directory
-sub IsCurPath($$)
-{
-    local $_;
-    my ($et, $dir) = @_;
-    $dir = $$et{DirMap}{$dir} and $dir eq $_ or last foreach reverse @{$$et{PATH}};
-    return($dir and $dir eq 'MOV');
-}
-
 #------------------------------------------------------------------------------
 # Handle offsets in iloc (ItemLocation) atom when writing (ref ISO 14496-12:2015 pg.79)
 # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) data ref, 3) output buffer ref
@@ -239,7 +243,6 @@ sub Handle_iloc($$$$)
         # decide whether to fix up the base offset or individual item offsets
         # (adjust the one that is larger)
         if (defined $minOffset and $minOffset > $base_offset) {
-            $off or $off = $$dirInfo{ChunkOffset} = [ ];
             $$_[3] = $base_offset foreach @offItem;
             push @$off, @offItem;
         } else {
@@ -318,6 +321,100 @@ sub SetVarInt($$)
     return '';
 }
 
+#------------------------------------------------------------------------------
+# Write Meta Keys to add/delete entries as necessary ('mdta' handler) (ref PH)
+# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
+# Returns: updated keys box data
+sub WriteKeys($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    $et or return 1;      # allow dummy access to autoload this package
+    my $dataPt = $$dirInfo{DataPt};
+    my $dirLen = length $$dataPt;
+    my $outfile = $$dirInfo{OutFile};
+    my ($tag, %done, %remap, %info, %add, $i);
+
+    $dirLen < 8 and $et->Warn('Short Keys box'), $dirLen = 8, $$dataPt = "\0" x 8;
+    if ($$et{DEL_GROUP}{Keys}) {
+        $dirLen = 8;    # delete all existing keys
+        # deleted keys are identified by a zero entry in the Remap lookup
+        my $n = Get32u($dataPt, 4);
+        for ($i=1; $i<=$n; ++$i) { $remap{$i} = 0; }
+        $et->VPrint(0, "  [deleting $n Keys entr".($n==1 ? 'y' : 'ies')."]\n");
+        ++$$et{CHANGED};
+    }
+    my $pos = 8;
+    my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
+    my $newData = substr($$dataPt, 0, $pos);
+        
+    my $newIndex = 1;
+    my $index = 1;
+    while ($pos < $dirLen - 4) {
+        my $len = unpack("x${pos}N", $$dataPt);
+        last if $len < 8 or $pos + $len > $dirLen;
+        my $ns  = substr($$dataPt, $pos + 4, 4);
+        $tag = substr($$dataPt, $pos + 8, $len - 8);
+        $tag =~ s/\0.*//s; # truncate at null
+        $tag =~ s/^com\.apple\.quicktime\.// if $ns eq 'mdta'; # remove apple quicktime domain
+        $tag = "Tag_$ns" unless $tag;
+        $done{$tag} = 1;    # set flag to avoid creating this tag
+        my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
+        if ($tagInfo) {
+            $info{$index} = $tagInfo;
+            if ($$newTags{$tag}) {
+                my $nvHash = $et->GetNewValueHash($tagInfo);
+                # drop this tag if it is being deleted
+                if ($nvHash and $et->IsOverwriting($nvHash) > 0 and not defined $et->GetNewValue($nvHash)) {
+                    # delete this key
+                    $et->VPrint(1, "$$et{INDENT}\[deleting Keys entry $index '${tag}']\n");
+                    $pos += $len;
+                    $remap{$index++} = 0;
+                    ++$$et{CHANGED};
+                    next;
+                }
+            }
+        }
+        # add to the Keys box data
+        $newData .= substr($$dataPt, $pos, $len);
+        $remap{$index++} = $newIndex++;
+        $pos += $len;
+    }
+    # add keys for any tags we need to create
+    foreach $tag (sort keys %$newTags) {
+        my $tagInfo = $$newTags{$tag};
+        my $id;
+        if ($$tagInfo{LangCode} and $$tagInfo{SrcTagInfo}) {
+            $id = $$tagInfo{SrcTagInfo}{TagID};
+        } else {
+            $id = $tag;
+        }
+        next if $done{$id};
+        my $nvHash = $et->GetNewValueHash($tagInfo);
+        next unless $$nvHash{IsCreating} and $et->IsOverwriting($nvHash) and
+            defined $et->GetNewValue($nvHash);
+        # add new entry to 'keys' data
+        my $val = "com.apple.quicktime.$id";
+        $newData .= Set32u(8 + length($val)) . 'mdta' . $val;
+        $et->VPrint(1, "$$et{INDENT}\[adding Keys entry $newIndex '${id}']\n");
+        $add{$newIndex++} = $tagInfo;
+        ++$$et{CHANGED};
+    }
+    my $num = $newIndex - 1;
+    if ($num) {
+        Set32u($num, \$newData, 4);     # update count in header
+    } else {
+        $newData = '';  # delete empty Keys box
+    }
+    # save temporary variables for use when writing ItemList:
+    #   Remap - lookup for remapping Keys ID numbers (0 if item is deleted)
+    #   Info  - Keys tag information, based on old index value
+    #   Add   - Keys items deleted, based on old index value
+    #   Num   - Number of items in edited Keys box
+    $$et{Keys} = { Remap => \%remap, Info => \%info, Add => \%add, Num => $num };
+
+    return $newData;    # return updated Keys box
+}
+
 #------------------------------------------------------------------------------
 # Write ItemInformation in HEIC files
 # Inputs: 0) ExifTool ref, 1) dirInfo ref (with BoxPos entry), 2) output buffer ref
@@ -571,13 +668,14 @@ sub WriteItemInfo($$$)
 # Returns: A) if dirInfo contains DataPt: new directory data
 #          B) otherwise: true on success, 0 if a write error occurred
 #             (true but sets an Error on a file format error)
+# Notes: Yes, this is a real mess.  Just like the QuickTime metadata situation.
 sub WriteQuickTime($$$)
 {
     local $_;
     my ($et, $dirInfo, $tagTablePtr) = @_;
     $et or return 1;    # allow dummy access to autoload this package
-    my ($mdat, @mdat, @mdatEdit, $edit, $track, $outBuff, $co, $term, $err);
-    my (%langTags, $keysTags, $canCreate, %didTag, $delGrp, %boxPos);
+    my ($mdat, @mdat, @mdatEdit, $edit, $track, $outBuff, $co, $term, $err, $delCount);
+    my (%langTags, $canCreate, $delGrp, %boxPos, $createKeys, $newTags, %didDir, $writeLast);
     my $outfile = $$dirInfo{OutFile} || return 0;
     my $raf = $$dirInfo{RAF};       # (will be null for lower-level atoms)
     my $dataPt = $$dirInfo{DataPt}; # (will be null for top-level atoms)
@@ -585,6 +683,7 @@ sub WriteQuickTime($$$)
     my $dirStart = $$dirInfo{DirStart} || 0;
     my $parent = $$dirInfo{Parent};
     my $addDirs = $$et{ADD_DIRS};
+    my $didTag = $$et{DidTag};
     my ($rtnVal, $rtnErr) = $dataPt ? (undef, undef) : (1, 0);
 
     if ($dataPt) {
@@ -592,27 +691,47 @@ sub WriteQuickTime($$$)
     } else {
         return 0 unless $raf;
     }
-    # initialize ItemList key directory count
-    $$et{KeyCount} = 0 unless defined $$et{KeyCount};
-
     # use buffered output for everything but 'mdat' atoms
     $outBuff = '';
     $outfile = \$outBuff;
 
     $raf->Seek($dirStart, 1) if $dirStart;  # skip header if it exists
 
-    # get hash of new tags to add to this directory if this is the proper place for them
     my $curPath = join '-', @{$$et{PATH}};
     my ($dir, $writePath) = ($dirName, $dirName);
     $writePath = "$dir-$writePath" while defined($dir = $$et{DirMap}{$dir});
-    my $delQt = $$et{DEL_GROUP}{QuickTime};
-    if ($curPath eq $writePath) {
+    # hack for Keys write path (its containing Meta is in a different location)
+    $createKeys = 1 if $$addDirs{Keys} and $curPath =~ /^MOV-Movie(-Meta(-ItemList)?)?$/;
+    if ($curPath eq $writePath or $createKeys) {
         $canCreate = 1;
-        $delGrp = $delQt || $$et{DEL_GROUP}{$dirName};
-        $et->VPrint(0, "  Deleting $dirName tags\n") if $delGrp;
+        $delGrp = $$et{DEL_GROUP}{$dirName};
     }
-    my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
-    # make lookup of language tags for this ID
+    # edit existing Keys tags in ItemList if we are at the correct path
+    if ($curPath eq 'MOV-Movie-Meta-ItemList') {
+        $newTags = { };
+        my $keys = $$et{Keys};
+        if ($keys) {
+            # add new tag entries for existing Keys tags, now that we know their ID's
+            my ($index, %keysInfo);
+            foreach $index (keys %{$$keys{Info}}) {
+                $keysInfo{$$keys{Info}{$index}} = $index if $$keys{Remap}{$index};
+            }
+            my $keysTable = GetTagTable('Image::ExifTool::QuickTime::Keys');
+            my $newKeysTags = $et->GetNewTagInfoHash($keysTable);
+            foreach (keys %$newKeysTags) {
+                my $tagInfo = $$newKeysTags{$_};
+                $index = $keysInfo{$tagInfo} || ($$tagInfo{SrcTagInfo} and $keysInfo{$$tagInfo{SrcTagInfo}});
+                next unless $index;
+                my $id = Set32u($index);
+                $id .= '-' . $$tagInfo{LangCode} if $$tagInfo{LangCode};
+                $$newTags{$id} = $tagInfo;
+            }
+        }
+    } else {
+        # get hash of new tags to edit/create in this directory
+        $newTags = $et->GetNewTagInfoHash($tagTablePtr);
+    }
+    # make lookup of language tags for each ID
     foreach (keys %$newTags) {
         next unless $$newTags{$_}{LangCode} and $$newTags{$_}{SrcTagInfo};
         my $id = $$newTags{$_}{SrcTagInfo}{TagID};
@@ -621,7 +740,7 @@ sub WriteQuickTime($$$)
     }
 
     for (;;) {      # loop through all atoms at this level
-        my ($hdr, $buff);
+        my ($hdr, $buff, $keysIndex);
         my $n = $raf->Read($hdr, 8);
         unless ($n == 8) {
             if ($n == 4 and $hdr eq "\0\0\0\0") {
@@ -701,7 +820,7 @@ sub WriteQuickTime($$$)
 
         # if this atom stores offsets, save its location so we can fix up offsets later
         # (are there any other atoms that may store absolute file offsets?)
-        if ($tag =~ /^(stco|co64|iloc|mfra|gps )$/) {
+        if ($tag =~ /^(stco|co64|iloc|mfra|gps |CTBO|uuid)$/) {
             # (note that we only need to do this if the movie data is stored in this file)
             my $flg = $$et{QtDataFlg};
             if ($tag eq 'mfra') {
@@ -713,7 +832,6 @@ sub WriteQuickTime($$$)
                 # (only care about the 'gps ' box in 'moov')
                 if ($$dirInfo{DirID} and $$dirInfo{DirID} eq 'moov' and length $buff > 8) {
                     my $off = $$dirInfo{ChunkOffset};
-                    $off or $off = $$dirInfo{ChunkOffset} = [ ];
                     my $num = Get32u(\$buff, 4);
                     $num = int((length($buff) - 8) / 8) if $num * 8 + 8 > length($buff);
                     my $i;
@@ -721,6 +839,8 @@ sub WriteQuickTime($$$)
                         push @$off, [ 'stco_gps ', length($$outfile) + length($hdr) + 8 + $i * 8, 4 ];
                     }
                 }
+            } elsif ($tag eq 'CTBO' or $tag eq 'uuid') { # hack for updating CR3 CTBO offsets
+                push @{$$dirInfo{ChunkOffset}}, [ $tag, length($$outfile), length($hdr) + $size ];
             } elsif (not $flg) {
                 my $grp = $$et{CUR_WRITE_GROUP} || $parent;
                 $et->Error("Can't locate data reference to update offsets for $grp");
@@ -730,9 +850,7 @@ sub WriteQuickTime($$$)
                 return $rtnVal;
             } elsif ($flg == 1) {
                 # must update offsets since the data is in this file
-                my $off = $$dirInfo{ChunkOffset};
-                $off or $off = $$dirInfo{ChunkOffset} = [ ];
-                push @$off, [ $tag, length($$outfile) + length($hdr), $size ];
+                push @{$$dirInfo{ChunkOffset}}, [ $tag, length($$outfile) + length($hdr), $size ];
             }
         }
 
@@ -743,14 +861,40 @@ sub WriteQuickTime($$$)
         &{$$tagInfo{WriteHook}}($buff,$et) if $tagInfo and $$tagInfo{WriteHook};
 
         # allow numerical tag ID's (ItemList entries defined by Keys)
-        unless ($tagInfo) {
-            my $id = $$et{KeyCount} . '.' . unpack('N', $tag);
-            $tagInfo = $et->GetTagInfo($tagTablePtr, $id);
+        if (not $tagInfo and $dirName eq 'ItemList' and $$et{Keys}) {
+            $keysIndex = unpack('N', $tag);
+            my $newIndex = $$et{Keys}{Remap}{$keysIndex};
+            if (defined $newIndex) {
+                $tagInfo = $$et{Keys}{Info}{$keysIndex};
+                unless ($newIndex) {
+                    if ($tagInfo) {
+                        $et->VPrint(1,"    - Keys:$$tagInfo{Name}");
+                    } else {
+                        $delCount = ($delCount || 0) + 1;
+                    }
+                    ++$$et{CHANGED};
+                    next;
+                }
+                # use the new Keys index of this item if it changed
+                unless ($keysIndex == $newIndex) {
+                    $tag = Set32u($newIndex);
+                    substr($hdr, 4, 4) = $tag;
+                }
+            } else {
+                undef $keysIndex;
+            }
         }
-        # delete all ItemList/UserData tags if deleting group
-        if ($delGrp and $dirName =~ /^(ItemList|UserData)$/) {
-            ++$$et{CHANGED};
-            next;
+        # delete all ItemList tags when deleting group, but take care not to delete UserData Meta
+        if ($delGrp) {
+            if ($dirName eq 'ItemList') {
+                $delCount = ($delCount || 0) + 1;
+                ++$$et{CHANGED};
+                next;
+            } elsif ($dirName eq 'UserData' and (not $tagInfo or not $$tagInfo{SubDirectory})) {
+                $delCount = ($delCount || 0) + 1;
+                ++$$et{CHANGED};
+                next;
+            }
         }
         undef $tagInfo if $tagInfo and $$tagInfo{Unknown};
 
@@ -786,6 +930,7 @@ sub WriteQuickTime($$$)
                     HasData  => $$subdir{HasData},
                     Multi    => $$subdir{Multi},    # necessary?
                     OutFile  => $outfile,
+                    NoRefTest=> 1,     # don't check directory references
                     # initialize array to hold details about chunk offset table
                     # (each entry has 3-5 items: 0=atom type, 1=table offset, 2=table size,
                     #  3=optional base offset, 4=optional item ID)
@@ -826,26 +971,15 @@ sub WriteQuickTime($$$)
                     $$_[1] += $start foreach @chunkOffset;
                 }
                 # the directory exists, so we don't need to add it
-                delete $$addDirs{$subName} if IsCurPath($et, $subName);
+                if ($curPath eq $writePath and $$addDirs{$subName} and $$addDirs{$subName} eq $dirName) {
+                    delete $$addDirs{$subName};
+                }
+                $didDir{$tag} = 1; # (note: keyed by tag ID)
 
             } else {    # modify existing QuickTime tags in various formats
 
                 my $nvHash = $et->GetNewValueHash($tagInfo);
-                # get new value from Keys source tag if necessary
-                if (not $nvHash and $$tagInfo{KeysInfo}) {
-                    $nvHash = $et->GetNewValueHash($$tagInfo{KeysInfo});
-                    # may be writing this as a language tag, so fill in $langTags for this ID
-                    unless ($keysTags) {
-                        $keysTags =  $et->GetNewTagInfoHash(GetTagTable('Image::ExifTool::QuickTime::Keys'));
-                    }
-                    foreach (keys %$keysTags) {
-                        next unless $$keysTags{$_}{SrcTagInfo};
-                        next unless $$keysTags{$_}{SrcTagInfo} eq $$tagInfo{KeysInfo};
-                        $langTags{$tag} = { } unless $langTags{$tag};
-                        $langTags{$tag}{$_} = $$keysTags{$_};
-                    }
-                }
-                if ($nvHash or $langTags{$tag} or $delQt) {
+                if ($nvHash or $langTags{$tag} or $delGrp) {
                     my $nvHashNoLang = $nvHash;
                     my ($val, $len, $lang, $type, $flags, $ctry, $charsetQuickTime);
                     my $format = $$tagInfo{Format};
@@ -854,19 +988,50 @@ sub WriteQuickTime($$$)
                     if ($hasData) {
                         my $pos = 0;
                         for (;;$pos+=$len) {
-                            last if $pos + 16 > $size;
+                            if ($pos + 16 > $size) {
+                                # add any new alternate language tags now
+                                if ($langTags{$tag}) {
+                                    my $tg;
+                                    foreach $tg ('', sort keys %{$langTags{$tag}}) {
+                                        my $ti = $tg ? $langTags{$tag}{$tg} : $nvHashNoLang;
+                                        $nvHash = $et->GetNewValueHash($ti);
+                                        next unless $nvHash and not $$didTag{$nvHash};
+                                        $$didTag{$nvHash} = 1;
+                                        next unless $$nvHash{IsCreating} and $et->IsOverwriting($nvHash);
+                                        my $newVal = $et->GetNewValue($nvHash);
+                                        next unless defined $newVal;
+                                        my $prVal = $newVal;
+                                        my $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format});
+                                        next unless defined $newVal;
+                                        my ($ctry, $lang) = (0,0);
+                                        if ($$ti{LangCode}) {
+                                            unless ($$ti{LangCode} =~ /^([A-Z]{3})?[-_]?([A-Z]{2})?$/i) {
+                                                $et->Warn("Invalid language code for $$ti{Name}");
+                                                next;
+                                            }
+                                            # pack language and country codes
+                                            if ($1 and $1 ne 'und') {
+                                                $lang = ($lang << 5) | ($_ - 0x60) foreach unpack 'C*', lc($1);
+                                            }
+                                            $ctry = unpack('n', pack('a2',uc($2))) if $2 and $2 ne 'ZZ';
+                                        }
+                                        $newData = substr($buff, 0, $pos) unless defined $newData;
+                                        $newData .= pack('Na4Nnn',16+length($newVal),'data',$flags,$ctry,$lang).$newVal;
+                                        my $grp = $et->GetGroup($ti, 1);
+                                        $et->VerboseValue("+ $grp:$$ti{Name}", $prVal);
+                                        ++$$et{CHANGED};
+                                    }
+                                }
+                                last;
+                            }
                             ($len, $type, $flags, $ctry, $lang) = unpack("x${pos}Na4Nnn", $buff);
                             $lang or $lang = $undLang;  # treat both 0 and 'und' as 'und'
                             $langInfo = $tagInfo;
-                            my $delTag = $delQt;
+                            my $delTag = $delGrp;
                             my $newVal;
                             my $langCode = GetLangCode($lang, $ctry, 1);
                             for (;;) {
-                                if ($$tagInfo{KeysInfo}) {
-                                    $langInfo = GetLangInfo($$tagInfo{KeysInfo}, $langCode);
-                                } else {
-                                    $langInfo = GetLangInfo($tagInfo, $langCode);
-                                }
+                                $langInfo = GetLangInfo($tagInfo, $langCode);
                                 $nvHash = $et->GetNewValueHash($langInfo);
                                 last if $nvHash or not $ctry or $lang ne $undLang or length($langCode)==2;
                                 # check to see if tag was written with a 2-char country code only
@@ -875,7 +1040,7 @@ sub WriteQuickTime($$$)
                             # set flag to delete language tag when writing default
                             # (except for a default-language Keys entry)
                             if (not $nvHash and $nvHashNoLang) {
-                                if ($lang eq $undLang and not $ctry and not $didTag{$nvHashNoLang}) {
+                                if ($lang eq $undLang and not $ctry and not $$didTag{$nvHashNoLang}) {
                                     $nvHash = $nvHashNoLang;    # write existing default
                                 } else {
                                     $delTag = 1;    # delete tag
@@ -903,34 +1068,28 @@ sub WriteQuickTime($$$)
                                 }
                                 if (($nvHash and $et->IsOverwriting($nvHash, $val)) or $delTag) {
                                     $newVal = $et->GetNewValue($nvHash) if defined $nvHash;
-                                    if ($delTag or (not defined $newVal or $didTag{$nvHash})) {
-                                        if ($canCreate) {
-                                            my $grp = $et->GetGroup($langInfo, 1);
-                                            $et->VerboseValue("- $grp:$$langInfo{Name}", $val);
-                                            $newData = substr($buff, 0, $pos-16) unless defined $newData;
-                                            ++$$et{CHANGED};
-                                            $pos += $len;
-                                            next;
-                                        }
-                                        $newVal = '';
-                                    }
-                                    my $prVal = $newVal;
-                                    # format new value for writing (and get new flags)
-                                    $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format});
-                                    if (defined $newVal and not ($nvHash and $didTag{$nvHash})) {
-                                        next if $newVal eq '' and $val eq '';
-                                        ++$$et{CHANGED};
+                                    if ($delTag or not defined $newVal or $$didTag{$nvHash}) {
+                                        # delete the tag
                                         my $grp = $et->GetGroup($langInfo, 1);
                                         $et->VerboseValue("- $grp:$$langInfo{Name}", $val);
-                                        $et->VerboseValue("+ $grp:$$langInfo{Name}", $prVal);
-                                        $didTag{$nvHash} = 1 if $nvHash;
-                                        $newData = substr($buff, 0, $pos-16) unless defined $newData;
-                                        $newData .= pack('Na4Nnn', length($newVal)+16, $type, $flags, $ctry, $lang);
-                                        $newData .= $newVal;
-                                    } elsif (defined $newData) {
                                         # copy data up to start of this tag to delete this value
-                                        $newData .= substr($buff, $pos-16, $len+16);
+                                        $newData = substr($buff, 0, $pos-16) unless defined $newData;
+                                        ++$$et{CHANGED};
+                                        next;
                                     }
+                                    my $prVal = $newVal;
+                                    # format new value for writing (and get new flags)
+                                    $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format});
+                                    my $grp = $et->GetGroup($langInfo, 1);
+                                    $et->VerboseValue("- $grp:$$langInfo{Name}", $val);
+                                    $et->VerboseValue("+ $grp:$$langInfo{Name}", $prVal);
+                                    $$didTag{$nvHash} = 1 if $nvHash;
+                                    $newData = substr($buff, 0, $pos-16) unless defined $newData;
+                                    $newData .= pack('Na4Nnn', length($newVal)+16, $type, $flags, $ctry, $lang);
+                                    $newData .= $newVal;
+                                    ++$$et{CHANGED};
+                                } elsif (defined $newData) {
+                                    $newData .= substr($buff, $pos-16, $len+16);
                                 }
                             } elsif (defined $newData) {
                                 $newData .= substr($buff, $pos, $len);
@@ -962,10 +1121,9 @@ sub WriteQuickTime($$$)
                         $val =~ s/\0+$//;   # remove trailing nulls if they exist
                         my $langCode = UnpackLang($lang, 1);
                         $langInfo = GetLangInfo($tagInfo, $langCode);
-                        # (no need to check $$tagInfo{KeysInfo} because Keys won't get here)
                         $nvHash = $et->GetNewValueHash($langInfo);
                         if (not $nvHash and $nvHashNoLang) {
-                            if ($lang eq $undLang and not $didTag{$nvHashNoLang}) {
+                            if ($lang eq $undLang and not $$didTag{$nvHashNoLang}) {
                                 $nvHash = $nvHashNoLang;
                             } elsif ($canCreate) {
                                 # delete other languages when writing default
@@ -982,9 +1140,9 @@ sub WriteQuickTime($$$)
                         ++$$et{CHANGED};
                         my $grp = $et->GetGroup($langInfo, 1);
                         $et->VerboseValue("- $grp:$$langInfo{Name}", $val);
-                        next unless defined $newData and not $didTag{$nvHash};
+                        next unless defined $newData and not $$didTag{$nvHash};
                         $et->VerboseValue("+ $grp:$$langInfo{Name}", $newData);
-                        $didTag{$nvHash} = 1;   # set flag so we don't add this tag again
+                        $$didTag{$nvHash} = 1;   # set flag so we don't add this tag again
                         # add back necessary header and encode as necessary
                         if (defined $lang) {
                             $newData = $et->Encode($newData, $lang < 0x400 ? $charsetQuickTime : 'UTF8');
@@ -999,18 +1157,23 @@ sub WriteQuickTime($$$)
             }
             # write the new atom if it was modified
             if (defined $newData) {
-                my $len = length $newData;
-                $len > 0x7ffffff7 and $et->Error("$$tagInfo{Name} to large to write"), last;
-                next unless $len;
+                my $len = length($newData) + 8;
+                $len > 0x7fffffff and $et->Error("$$tagInfo{Name} to large to write"), last;
+                # update size in ChunkOffset list for modified 'uuid' atom
+                $$dirInfo{ChunkOffset}[-1][2] = $len if $tag eq 'uuid';
+                next unless $len > 8;   # don't write empty atom header
                 # maintain pointer to chunk offsets if necessary
                 if (@chunkOffset) {
-                    $$dirInfo{ChunkOffset} or $$dirInfo{ChunkOffset} = [ ];
                     $$_[1] += 8 + length $$outfile foreach @chunkOffset;
                     push @{$$dirInfo{ChunkOffset}}, @chunkOffset;
                 }
-                $boxPos{$tag} = [ length($$outfile), length($newData) + 8 ];
-                # write the updated directory now (unless length is zero, or it is needed as padding)
-                Write($outfile, Set32u($len+8), $tag, $newData) or $rtnVal=$rtnErr, $err=1, last;
+                if ($$tagInfo{WriteLast}) {
+                    $writeLast = ($writeLast || '') . Set32u($len) . $tag . $newData;
+                } else {
+                    $boxPos{$tag} = [ length($$outfile), length($newData) + 8 ];
+                    # write the updated directory with its atom header
+                    Write($outfile, Set32u($len), $tag, $newData) or $rtnVal=$rtnErr, $err=1, last;
+                }
                 next;
             }
         }
@@ -1045,25 +1208,61 @@ sub WriteQuickTime($$$)
             }
             $$et{QtDataFlg} = $flg;
         }
-        # save position of this box in the output buffer
-        $boxPos{$tag} = [ length($$outfile), length($hdr) + length($buff) ];
-        # copy the existing atom
-        Write($outfile, $hdr, $buff) or $rtnVal=$rtnErr, $err=1, last;
+        if ($tagInfo and $$tagInfo{WriteLast}) {
+            $writeLast = ($writeLast || '') . $hdr . $buff;
+        } else {
+            # save position of this box in the output buffer
+            $boxPos{$tag} = [ length($$outfile), length($hdr) + length($buff) ];
+            # copy the existing atom
+            Write($outfile, $hdr, $buff) or $rtnVal=$rtnErr, $err=1, last;
+        }
     }
+    $et->VPrint(0, "  [deleting $delCount $dirName tag".($delCount==1 ? '' : 's')."]\n") if $delCount;
+
+    undef $createKeys unless $$addDirs{Keys};   # (Keys may have been written)
+
     # add new directories/tags at this level if necessary
-    if (exists $$et{EDIT_DIRS}{$dirName} and $canCreate) {
+    if ($canCreate and (exists $$et{EDIT_DIRS}{$dirName} or $createKeys)) {
         # get a hash of tagInfo references to add to this directory
         my $dirs = $et->GetAddDirHash($tagTablePtr, $dirName);
         # make sorted list of new tags to be added
         my @addTags = sort(keys(%$dirs), keys %$newTags);
-        my $tag;
+        my ($tag, $index);
+        # add Keys tags if necessary
+        if ($createKeys) {
+            if ($curPath eq 'MOV-Movie') {
+                # add Meta for Keys if necessary
+                unless ($didDir{meta}) {
+                    $$dirs{meta} = $Image::ExifTool::QuickTime::Movie{meta};
+                    push @addTags, 'meta';
+                }
+            } elsif ($curPath eq 'MOV-Movie-Meta') {
+                # special case for Keys Meta -- reset directories and start again
+                undef @addTags;
+                $dirs = { };
+                foreach ('keys','ilst') {
+                    next if $didDir{$_};  # don't add again
+                    $$dirs{$_} = $Image::ExifTool::QuickTime::Meta{$_};
+                    push @addTags, $_;
+                }
+            } elsif ($curPath eq 'MOV-Movie-Meta-ItemList' and $$et{Keys}) {
+                foreach $index (sort { $a <=> $b } keys %{$$et{Keys}{Add}}) {
+                    my $id = Set32u($index);
+                    $$newTags{$id} = $$et{Keys}{Add}{$index};
+                    push @addTags, $id;
+                }
+            } else {
+                $dirs = $et->GetAddDirHash($tagTablePtr, $dirName);
+                push @addTags, sort keys %$dirs;
+            }
+        }
+        # (note that $tag may be a binary Keys index here)
         foreach $tag (@addTags) {
             my $tagInfo = $$dirs{$tag} || $$newTags{$tag};
-            next if $$tagInfo{KeysInfo};    # don't try to add keys tags (yet)
             my $subdir = $$tagInfo{SubDirectory};
             unless ($subdir) {
                 my $nvHash = $et->GetNewValueHash($tagInfo);
-                next unless $nvHash and not $didTag{$nvHash};
+                next unless $nvHash and not $$didTag{$nvHash};
                 next unless $$nvHash{IsCreating} and $et->IsOverwriting($nvHash);
                 my $newVal = $et->GetNewValue($nvHash);
                 next unless defined $newVal;
@@ -1071,16 +1270,18 @@ sub WriteQuickTime($$$)
                 my $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format});
                 next unless defined $newVal;
                 my ($ctry, $lang) = (0,0);
-                if (length $tag > 4) { # (is there a language code appended to the tag ID?)
-                    unless ($tag =~ s/(.{4})-([A-Z]{3})?[-_]?([A-Z]{2})?/$1/si) {
+                # handle alternate languages
+                if ($$tagInfo{LangCode}) {
+                    $tag = substr($tag, 0, 4);  # strip language code from tag ID
+                    unless ($$tagInfo{LangCode} =~ /^([A-Z]{3})?[-_]?([A-Z]{2})?$/i) {
                         $et->Warn("Invalid language code for $$tagInfo{Name}");
                         next;
                     }
                     # pack language and country codes
-                    if ($2 and $2 ne 'und') {
-                        $lang = ($lang << 5) | ($_ - 0x60) foreach unpack 'C*', lc($2);
+                    if ($1 and $1 ne 'und') {
+                        $lang = ($lang << 5) | ($_ - 0x60) foreach unpack 'C*', lc($1);
                     }
-                    $ctry = unpack('n', pack('a2',uc($3))) if $3 and $3 ne 'ZZ';
+                    $ctry = unpack('n', pack('a2',uc($2))) if $2 and $2 ne 'ZZ';
                 }
                 if ($$dirInfo{HasData}) {
                     # add 'data' header
@@ -1102,16 +1303,37 @@ sub WriteQuickTime($$$)
                     $et->Warn("Can't use language code for $grp:$$tagInfo{Name}");
                     next;
                 }
-                Write($outfile, Set32u(8+length($newVal)), $tag, $newVal) or $rtnVal=$rtnErr, $err=1;
-                $et->VerboseValue("+ $dirName:$$tagInfo{Name}", $prVal);
-                $didTag{$nvHash} = 1;
+                if ($$tagInfo{WriteLast}) {
+                    $writeLast = ($writeLast || '') .  Set32u(8+length($newVal)) . $tag . $newVal;
+                } else {
+                    $boxPos{$tag} = [ length($$outfile), 8 + length($newVal) ];
+                    Write($outfile, Set32u(8+length($newVal)), $tag, $newVal) or $rtnVal=$rtnErr, $err=1;
+                }
+                my $grp = $et->GetGroup($tagInfo, 1);
+                $et->VerboseValue("+ $grp:$$tagInfo{Name}", $prVal);
+                $$didTag{$nvHash} = 1;
                 ++$$et{CHANGED};
                 next;
             }
             my $subName = $$subdir{DirName} || $$tagInfo{Name};
             # QuickTime hierarchy is complex, so check full directory path before adding
-            next unless IsCurPath($et, $subName);
-            my $buff = '';  # write from scratch
+            my $buff;
+            if ($createKeys and $curPath eq 'MOV-Movie' and $subName eq 'Meta') {
+                $et->VPrint(0, "  Creating Meta with mdta Handler and Keys\n");
+                # init Meta box for Keys tags with mdta Handler and empty Keys+ItemList
+                $buff = "\0\0\0\x20hdlr\0\0\0\0\0\0\0\0mdta\0\0\0\0\0\0\0\0\0\0\0\0" .
+                        "\0\0\0\x10keys\0\0\0\0\0\0\0\0" .
+                        "\0\0\0\x08ilst";
+            } elsif ($createKeys and $curPath eq 'MOV-Movie-Meta') {
+                $buff = ($subName eq 'Keys' ? "\0\0\0\0\0\0\0\0" : '');
+            } elsif ($subName eq 'Meta' and $$et{OPTIONS}{QuickTimeHandler}) {
+                $et->VPrint(0, "  Creating Meta with mdir Handler\n");
+                # init Meta box for ItemList tags with mdir Handler
+                $buff = "\0\0\0\x20hdlr\0\0\0\0\0\0\0\0mdir\0\0\0\0\0\0\0\0\0\0\0\0";
+            } else {
+                next unless $curPath eq $writePath and $$addDirs{$subName} and $$addDirs{$subName} eq $dirName;
+                $buff = '';  # write from scratch
+            }
             my %subdirInfo = (
                 Parent   => $dirName,
                 DirName  => $subName,
@@ -1119,6 +1341,7 @@ sub WriteQuickTime($$$)
                 DirStart => 0,
                 HasData  => $$subdir{HasData},
                 OutFile  => $outfile,
+                ChunkOffset => [ ], # (just to be safe)
             );
             my $subTable = GetTagTable($$subdir{TagTable});
             my $newData = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
@@ -1136,13 +1359,25 @@ sub WriteQuickTime($$$)
                     }
                 }
                 my $newHdr = Set32u(8+length($newData)+length($prefix)) . $tag . $prefix;
-                Write($outfile, $newHdr, $newData) or $rtnVal=$rtnErr, $err=1;
+                if ($$tagInfo{WriteLast}) {
+                    $writeLast = ($writeLast || '') . $newHdr . $newData;
+                } else {
+                    if ($tag eq 'uuid') {
+                        # add offset for new uuid (needed for CR3 CTBO offsets)
+                        my $off = $$dirInfo{ChunkOffset};
+                        push @$off, [ $tag, length($$outfile), length($newHdr) + length($newData) ];
+                    }
+                    $boxPos{$tag} = [ length($$outfile), length($newHdr) + length($newData) ];
+                    Write($outfile, $newHdr, $newData) or $rtnVal=$rtnErr, $err=1;
+                }
             }
-            delete $$addDirs{$subName}; # add only once (must delete _after_ call to WriteDirectory())
+            # add only once (must delete _after_ call to WriteDirectory())
+            # (Keys is a special case, and will be removed after Meta is processed)
+            delete $$addDirs{$subName} unless $subName eq 'Keys';
         }
     }
     # write HEIC metadata after top-level 'meta' box has been processed if editing this information
-    if ($dirName eq 'Meta' and $$et{EDIT_DIRS}{ItemInformation} and $curPath eq $writePath) {
+    if ($curPath eq 'MOV-Meta' and $$et{EDIT_DIRS}{ItemInformation}) {
         $$dirInfo{BoxPos} = \%boxPos;
         my $mdatEdit = WriteItemInfo($et, $dirInfo, $outfile);
         if ($mdatEdit) {
@@ -1151,15 +1386,35 @@ sub WriteQuickTime($$$)
         }
     }
     # write out any necessary terminator
-    Write($outfile, $term) or $rtnVal=$rtnErr, $err=1 if $term;
+    Write($outfile, $term) or $rtnVal=$rtnErr, $err=1 if $term and length $$outfile;
+
+    # delete temporary Keys variables after Meta is processed
+    if ($dirName eq 'Meta') {
+        # delete any Meta box with no useful information (ie. only 'hdlr','keys','lang','ctry')
+        my $isEmpty = 1;
+        $emptyMeta{$_} or $isEmpty = 0, last foreach keys %boxPos;
+        if ($isEmpty) {
+            $et->VPrint(0,'  Deleting ' . join('+', sort map { $emptyMeta{$_} } keys %boxPos)) if %boxPos;
+            $$outfile = '';
+            ++$$et{CHANGED};
+        }
+        if ($curPath eq 'MOV-Movie-Meta') {
+            delete $$addDirs{Keys}; # prevent creation of another Meta for Keys tags
+            delete $$et{Keys};
+        }
+    }
 
     # return now if writing subdirectory
-    return $err ? undef : $$outfile if $dataPt;
+    if ($dataPt) {
+        $et->Error("Internal error: WriteLast not on top-level atom!\n") if $writeLast;
+        return $err ? undef : $$outfile;
+    }
 
     # issue minor error if we didn't find an 'mdat' atom
-    my $off = $$dirInfo{ChunkOffset} || [ ];
+    my $off = $$dirInfo{ChunkOffset};
     if (not @mdat) {
-        if (@$off) {
+        foreach $co (@$off) {
+            next if $$co[0] eq 'uuid';
             $et->Error('Movie data referenced but not found');
             return $rtnVal;
         }
@@ -1266,11 +1521,52 @@ sub WriteQuickTime($$$)
         $pos += $$mdat[4] ? length(${$$mdat[4]}) : $$mdat[1] - $$mdat[0];
     }
 
-    # fix up offsets for new mdat position(s)
+    # fix up offsets for new mdat position(s) (and uuid positions in CR3 images)
     foreach $co (@$off) {
         my ($type, $ptr, $len, $base, $id) = @$co;
         $base = 0 unless $base;
-        $type =~ /^(stco|co64)_?(.*)$/ or $et->Error('Internal error fixing offsets'), last;
+        unless ($type =~ /^(stco|co64)_?(.*)$/) {
+            next if $type eq 'uuid';
+            $type eq 'CTBO' or $et->Error('Internal error fixing offsets'), last;
+            # update 'CTBO' item offsets/sizes in Canon CR3 images
+            $$co[2] > 12 or $et->Error('Invalid CTBO atom'), last;
+            @mdat or $et->Error('Missing CR3 image data'), last;
+            my $n = Get32u($outfile, $$co[1] + 8);
+            $$co[2] < $n * 20 + 12 and $et->Error('Truncated CTBO atom'), last;
+            my (%ctboOff, $i);
+            # determine uuid types, and build an offset lookup based on CTBO ID number
+            foreach (@$off) {
+                next unless $$_[0] eq 'uuid' and $$_[2] >= 24; # (ignore undersized and deleted uuid boxes)
+                my $pos = $$_[1];
+                next if $pos + 24 > length $$outfile;   # (will happen for WriteLast uuid tags)
+                my $siz = Get32u($outfile, $pos);       # get size of uuid atom
+                if ($siz == 1) {                        # check for extended (8-byte) size
+                    next unless $$_[2] >= 32;
+                    $pos += 8;
+                }
+                # get CTBO entry ID based on 16-byte UUID identifier
+                my $id = $ctboID{substr($$outfile, $pos+8, 16)};
+                $ctboOff{$id} = $_ if defined $id;
+            }
+            # calculate new offset for the first mdat (size of -1 indicates it didn't change)
+            $ctboOff{3} = [ 'mdat', $mdat[0][3] - length $mdat[0][2], -1 ];
+            for ($i=0; $i<$n; ++$i) {
+                my $pos = $$co[1] + 12 + $i * 20;
+                my $id = Get32u($outfile, $pos);
+                # ignore if size is zero unless we can add this entry
+                # (note: can't yet add/delete PreviewImage, but leave this possibility open)
+                next unless Get64u($outfile, $pos + 12) or $id == 1 or $id == 2;
+                if (not defined $ctboOff{$id}) {
+                    $id==1 or $id==2 or $et->Error("Can't handle CR3 CTBO ID number $id"), last;
+                    # XMP or PreviewImage was deleted -- set offset and size to zero
+                    $ctboOff{$id} = [ 'uuid', 0, 0 ];
+                }
+                # update the new offset and size of this entry
+                Set64u($ctboOff{$id}[1], $outfile, $pos + 4);
+                Set64u($ctboOff{$id}[2], $outfile, $pos + 12) unless $ctboOff{$id}[2] < 0;
+            }
+            next;
+        }
         my $siz = $1 eq 'co64' ? 8 : 4;
         my ($n, $tag);
         if ($2) {   # is this an offset in an iloc or 'gps ' atom?
@@ -1354,6 +1650,9 @@ sub WriteQuickTime($$$)
         }
     }
 
+    # write the stuff that must come last
+    Write($outfile, $writeLast) or $rtnVal = 0 if $writeLast;
+    
     return $rtnVal;
 }
 
@@ -1397,12 +1696,15 @@ sub WriteMOV($$)
     $et->SetFileType($ftype); # need to set "FileType" tag for a Condition
     $et->InitWriteDirs($dirMap{$ftype}, 'XMP');
     $$et{DirMap} = $dirMap{$ftype};     # need access to directory map when writing
+    # track tags globally to avoid creating multiple tags in the case of duplicate directories
+    $$et{DidTag} = { };
     SetByteOrder('MM');
     $raf->Seek(0,0);
 
     # write the file
     $$dirInfo{Parent} = '';
     $$dirInfo{DirName} = 'MOV';
+    $$dirInfo{ChunkOffset} = [ ]; # (just to be safe)
     return WriteQuickTime($et, $dirInfo, $tagTablePtr) ? 1 : -1;
 }