exiftool_vendored 10.04.0 → 10.23.0

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

@@ -0,0 +1,2466 @@
+#------------------------------------------------------------------------------
+# File:         WriteExif.pl
+#
+# Description:  Write EXIF meta information
+#
+# Revisions:    12/13/2004 - P. Harvey Created
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::Exif;
+
+use strict;
+use vars qw($VERSION $AUTOLOAD @formatSize @formatName %formatNumber
+            %compression %photometricInterpretation %orientation);
+
+use Image::ExifTool::Fixup;
+
+# some information may be stored in different IFD's with the same meaning.
+# Use this lookup to decide when we should delete information that is stored
+# in another IFD when we write it to the preferred IFD.
+my %crossDelete = (
+    ExifIFD => 'IFD0',
+    IFD0    => 'ExifIFD',
+);
+
+# mandatory tag default values
+my %mandatory = (
+    IFD0 => {
+        0x011a => 72,       # XResolution
+        0x011b => 72,       # YResolution
+        0x0128 => 2,        # ResolutionUnit (inches)
+        0x0213 => 1,        # YCbCrPositioning (centered)
+      # 0x8769 => ????,     # ExifOffset
+    },
+    IFD1 => {
+        0x0103 => 6,        # Compression (JPEG)
+        0x011a => 72,       # XResolution
+        0x011b => 72,       # YResolution
+        0x0128 => 2,        # ResolutionUnit (inches)
+    },
+    ExifIFD => {
+        0x9000 => '0230',   # ExifVersion
+        0x9101 => "1 2 3 0",# ComponentsConfiguration
+        0xa000 => '0100',   # FlashpixVersion
+        0xa001 => 0xffff,   # ColorSpace (uncalibrated)
+      # 0xa002 => ????,     # ExifImageWidth
+      # 0xa003 => ????,     # ExifImageHeight
+    },
+    GPS => {
+        0x0000 => '2 3 0 0',# GPSVersionID
+    },
+    InteropIFD => {
+        0x0002 => '0100',   # InteropVersion
+    },
+);
+
+#------------------------------------------------------------------------------
+# Inverse print conversion for LensInfo
+# Inputs: 0) lens info string
+# Returns: PrintConvInv of string
+sub ConvertLensInfo($)
+{
+    my $val = shift;
+    my @a = GetLensInfo($val, 1); # (allow unknown "?" values)
+    return @a ? join(' ', @a) : $val;
+}
+
+#------------------------------------------------------------------------------
+# Get binary CFA Pattern from a text string
+# Inputs: Print-converted CFA pattern (eg. '[Blue,Green][Green,Red]')
+# Returns: CFA pattern as a string of numbers
+sub GetCFAPattern($)
+{
+    my $val = shift;
+    my @rows = split /\]\s*\[/, $val;
+    @rows or warn("Rows not properly bracketed by '[]'\n"), return undef;
+    my @cols = split /,/, $rows[0];
+    @cols or warn("Colors not separated by ','\n"), return undef;
+    my $ny = @cols;
+    my @a = (scalar(@rows), scalar(@cols));
+    my %cfaLookup = (red=>0, green=>1, blue=>2, cyan=>3, magenta=>4, yellow=>5, white=>6);
+    my $row;
+    foreach $row (@rows) {
+        @cols = split /,/, $row;
+        @cols == $ny or warn("Inconsistent number of colors in each row\n"), return undef;
+        foreach (@cols) {
+            tr/ \]\[//d;    # remove remaining brackets and any spaces
+            my $c = $cfaLookup{lc($_)};
+            defined $c or warn("Unknown color '$_'\n"), return undef;
+            push @a, $c;
+        }
+    }
+    return "@a";
+}
+
+#------------------------------------------------------------------------------
+# validate raw values for writing
+# Inputs: 0) ExifTool ref, 1) tagInfo hash ref, 2) raw value ref
+# Returns: error string or undef (and possibly changes value) on success
+sub CheckExif($$$)
+{
+    my ($et, $tagInfo, $valPtr) = @_;
+    my $format = $$tagInfo{Format} || $$tagInfo{Writable} || $$tagInfo{Table}{WRITABLE};
+    if (not $format or $format eq '1') {
+        if ($$tagInfo{Groups}{0} eq 'MakerNotes') {
+            return undef;   # OK to have no format for makernotes
+        } else {
+            return 'No writable format';
+        }
+    }
+    return Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
+}
+
+#------------------------------------------------------------------------------
+# encode exif ASCII/Unicode text from UTF8 or Latin
+# Inputs: 0) ExifTool ref, 1) text string
+# Returns: encoded string
+# Note: MUST be called Raw conversion time so the EXIF byte order is known!
+sub EncodeExifText($$)
+{
+    my ($et, $val) = @_;
+    # does the string contain special characters?
+    if ($val =~ /[\x80-\xff]/) {
+        my $order = $et->GetNewValue('ExifUnicodeByteOrder');
+        return "UNICODE\0" . $et->Encode($val,'UTF16',$order);
+    } else {
+        return "ASCII\0\0\0$val";
+    }
+}
+
+#------------------------------------------------------------------------------
+# rebuild maker notes to properly contain all value data
+# (some manufacturers put value data outside maker notes!!)
+# Inputs: 0) ExifTool object ref, 1) tag table ref, 2) dirInfo ref
+# Returns: new maker note data (and creates MAKER_NOTE_FIXUP), or undef on error
+sub RebuildMakerNotes($$$)
+{
+    my ($et, $tagTablePtr, $dirInfo) = @_;
+    my $dirStart = $$dirInfo{DirStart};
+    my $dirLen = $$dirInfo{DirLen};
+    my $dataPt = $$dirInfo{DataPt};
+    my $dataPos = $$dirInfo{DataPos} || 0;
+    my $rtnValue;
+    my %subdirInfo = %$dirInfo;
+
+    delete $$et{MAKER_NOTE_FIXUP};
+
+    # don't need to rebuild text, BinaryData or PreviewImage maker notes
+    my $tagInfo = $$dirInfo{TagInfo};
+    my $subdir = $$tagInfo{SubDirectory};
+    my $proc = $$subdir{ProcessProc} || $$tagTablePtr{PROCESS_PROC} || \&ProcessExif;
+    if (($proc ne \&ProcessExif and $$tagInfo{Name} =~ /Text/) or
+         $proc eq \&Image::ExifTool::ProcessBinaryData or
+        ($$tagInfo{PossiblePreview} and $dirLen > 6 and
+         substr($$dataPt, $dirStart, 3) eq "\xff\xd8\xff"))
+    {
+        return substr($$dataPt, $dirStart, $dirLen);
+    }
+    my $saveOrder = GetByteOrder();
+    my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
+    if (defined $loc) {
+        my $makerFixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
+        # create new exiftool object to rewrite the directory without changing it
+        my $newTool = new Image::ExifTool;
+        $newTool->Options(
+            IgnoreMinorErrors => $$et{OPTIONS}{IgnoreMinorErrors},
+            FixBase           => $$et{OPTIONS}{FixBase},
+        );
+        $newTool->Init();   # must do this before calling WriteDirectory()!
+        # don't copy over preview image
+        $newTool->SetNewValue(PreviewImage => '');
+        # copy all transient members over in case they are used for writing
+        # (Make, Model, etc)
+        foreach (grep /[a-z]/, keys %$et) {
+            $$newTool{$_} = $$et{$_};
+        }
+        # fix base offsets if specified
+        $newTool->Options(FixBase => $et->Options('FixBase'));
+        # set GENERATE_PREVIEW_INFO flag so PREVIEW_INFO will be generated
+        $$newTool{GENERATE_PREVIEW_INFO} = 1;
+        # drop any large tags
+        $$newTool{DROP_TAGS} = 1;
+        # initialize other necessary data members
+        $$newTool{FILE_TYPE} = $$et{FILE_TYPE};
+        $$newTool{TIFF_TYPE} = $$et{TIFF_TYPE};
+        # rewrite maker notes
+        $rtnValue = $newTool->WriteDirectory(\%subdirInfo, $tagTablePtr);
+        if (defined $rtnValue and length $rtnValue) {
+            # add the dummy/empty preview image if necessary
+            if ($$newTool{PREVIEW_INFO}) {
+                $makerFixup->SetMarkerPointers(\$rtnValue, 'PreviewImage', length($rtnValue));
+                $rtnValue .= $$newTool{PREVIEW_INFO}{Data};
+                delete $$newTool{PREVIEW_INFO};
+            }
+            # add makernote header
+            if ($loc) {
+                my $hdr = substr($$dataPt, $dirStart, $loc);
+                # special case: convert Pentax/Samsung DNG maker notes to JPEG style
+                # (in JPEG, Pentax makernotes are absolute and start with "AOC\0" for some
+                # models, but in DNG images they are stored in tag 0xc634 of IFD0 and
+                # start with either "PENTAX \0" or "SAMSUNG\0")
+                if ($$dirInfo{Parent} eq 'IFD0' and $hdr =~ /^(PENTAX |SAMSUNG)\0/) {
+                    # convert to JPEG-style AOC maker notes if used by this model
+                    # (Note: this expression also appears in Exif.pm)
+                    if ($$et{Model} =~ /\b(K(-[57mrx]|(10|20|100|110|200)D|2000)|GX(10|20))\b/) {
+                        $hdr =~ s/^(PENTAX |SAMSUNG)\0/AOC\0/;
+                        # save fixup because AOC maker notes have absolute offsets
+                        $$et{MAKER_NOTE_FIXUP} = $makerFixup;
+                    }
+                }
+                $rtnValue = $hdr . $rtnValue;
+                # adjust fixup for shift in start position
+                $$makerFixup{Start} += length $hdr;
+            }
+            # shift offsets according to original position of maker notes,
+            # and relative to the makernotes Base
+            $$makerFixup{Shift} += $dataPos + $dirStart +
+                                   $$dirInfo{Base} - $subdirInfo{Base};
+            # repair incorrect offsets if offsets were fixed
+            $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0;
+            # fix up pointers to the specified offset
+            $makerFixup->ApplyFixup(\$rtnValue);
+            # save fixup information unless offsets were relative
+            unless ($subdirInfo{Relative}) {
+                # set shift so offsets are all relative to start of maker notes
+                $$makerFixup{Shift} -= $dataPos + $dirStart;
+                $$et{MAKER_NOTE_FIXUP} = $makerFixup;    # save fixup for later
+            }
+        }
+    }
+    SetByteOrder($saveOrder);
+
+    return $rtnValue;
+}
+
+#------------------------------------------------------------------------------
+# Sort IFD directory entries
+# Inputs: 0) data reference, 1) directory start, 2) number of entries,
+#         3) flag to treat 0 as a valid tag ID (as opposed to an empty IFD entry)
+sub SortIFD($$$;$)
+{
+    my ($dataPt, $dirStart, $numEntries, $allowZero) = @_;
+    my ($index, %entries);
+    # split the directory into separate entries
+    for ($index=0; $index<$numEntries; ++$index) {
+        my $entry = $dirStart + 2 + 12 * $index;
+        my $tagID = Get16u($dataPt, $entry);
+        my $entryData = substr($$dataPt, $entry, 12);
+        # silly software can pad directories with zero entries -- put these at the end
+        $tagID = 0x10000 unless $tagID or $index == 0 or $allowZero;
+        # add new entry (allow for duplicate tag ID's, which shouldn't normally happen)
+        if ($entries{$tagID}) {
+            $entries{$tagID} .= $entryData;
+        } else {
+            $entries{$tagID} = $entryData;
+        }
+    }
+    # sort the directory entries
+    my @sortedTags = sort { $a <=> $b } keys %entries;
+    # generate the sorted IFD
+    my $newDir = '';
+    foreach (@sortedTags) {
+        $newDir .= $entries{$_};
+    }
+    # replace original directory with new, sorted one
+    substr($$dataPt, $dirStart + 2, 12 * $numEntries) = $newDir;
+}
+
+#------------------------------------------------------------------------------
+# Validate IFD entries (strict validation to test possible chained IFD's)
+# Inputs: 0) dirInfo ref (must have RAF set), 1) optional DirStart
+# Returns: true if IFD looks OK
+sub ValidateIFD($;$)
+{
+    my ($dirInfo, $dirStart) = @_;
+    my $raf = $$dirInfo{RAF} or return 0;
+    my $base = $$dirInfo{Base};
+    $dirStart = $$dirInfo{DirStart} || 0 unless defined $dirStart;
+    my $offset = $dirStart + ($$dirInfo{DataPos} || 0);
+    my ($buff, $index);
+    $raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2 or return 0;
+    my $numEntries = Get16u(\$buff,0);
+    $numEntries > 1 and $numEntries < 64 or return 0;
+    my $len = 12 * $numEntries;
+    $raf->Read($buff, $len) == $len or return 0;
+    my $lastID = -1;
+    for ($index=0; $index<$numEntries; ++$index) {
+        my $entry = 12 * $index;
+        my $tagID = Get16u(\$buff, $entry);
+        $tagID > $lastID or $$dirInfo{AllowOutOfOrderTags} or return 0;
+        my $format = Get16u(\$buff, $entry+2);
+        $format > 0 and $format <= 13 or return 0;
+        my $count = Get32u(\$buff, $entry+4);
+        $count > 0 or return 0;
+        $lastID = $tagID;
+    }
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+# Get sorted list of offsets used in IFD
+# Inputs: 0) data ref, 1) directory start, 2) dataPos, 3) IFD entries, 4) tag table ref
+# Returns: 0) sorted list of offsets (only offsets after the end of the IFD)
+#          1) hash of list indices keyed by offset value
+# Notes: This is used in a patch to fix the count for tags in Kodak SubIFD3
+sub GetOffList($$$$$)
+{
+    my ($dataPt, $dirStart, $dataPos, $numEntries, $tagTablePtr) = @_;
+    my $ifdEnd = $dirStart + 2 + 12 * $numEntries + $dataPos;
+    my ($index, $offset, %offHash);
+    for ($index=0; $index<$numEntries; ++$index) {
+        my $entry = $dirStart + 2 + 12 * $index;
+        my $format = Get16u($dataPt, $entry + 2);
+        next if $format < 1 or $format > 13;
+        my $count = Get16u($dataPt, $entry + 4);
+        my $size = $formatSize[$format] * $count;
+        if ($size <= 4) {
+            my $tagID = Get16u($dataPt, $entry);
+            next unless ref $$tagTablePtr{$tagID} eq 'HASH' and $$tagTablePtr{$tagID}{FixCount};
+        }
+        my $offset = Get16u($dataPt, $entry + 8);
+        $offHash{$offset} = 1 if $offset >= $ifdEnd;
+    }
+    # set offset hash values to indices in list
+    my @offList = sort keys %offHash;
+    $index = 0;
+    foreach $offset (@offList) {
+        $offHash{$offset} = $index++;
+    }
+    return(\@offList, \%offHash);
+}
+
+#------------------------------------------------------------------------------
+# Update TIFF_END member if defined
+# Inputs: 0) ExifTool ref, 1) end of valid TIFF data
+sub UpdateTiffEnd($$)
+{
+    my ($et, $end) = @_;
+    if (defined $$et{TIFF_END} and
+        $$et{TIFF_END} < $end)
+    {
+        $$et{TIFF_END} = $end;
+    }
+}
+
+#------------------------------------------------------------------------------
+# Handle error while writing EXIF
+# Inputs: 0) ExifTool ref, 1) error string, 2) tag table ref
+# Returns: undef on fatal error, or '' if minor error is ignored
+sub ExifErr($$$)
+{
+    my ($et, $errStr, $tagTablePtr) = @_;
+    # MakerNote errors are minor by default
+    my $minor = ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes');
+    if ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{MINOR_ERRORS}) {
+        $et->Warn("$errStr. IFD dropped.") and return '' if $minor;
+        $minor = 1;
+    }
+    return undef if $et->Error($errStr, $minor);
+    return '';
+}
+
+#------------------------------------------------------------------------------
+# Read/Write IFD with TIFF-like header (used by DNG 1.2)
+# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
+# Returns: Reading: 1 on success, otherwise returns 0 and sets a Warning
+#          Writing: new data block or undef on error
+sub ProcessTiffIFD($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    $et or return 1;    # allow dummy access
+    my $raf = $$dirInfo{RAF};
+    my $base = $$dirInfo{Base} || 0;
+    my $dirName = $$dirInfo{DirName};
+    my $magic = $$dirInfo{Subdir}{Magic} || 0x002a;
+    my $buff;
+
+    # structured with a TIFF-like header and relative offsets
+    $raf->Seek($base, 0) and $raf->Read($buff, 8) == 8 or return 0;
+    unless (SetByteOrder(substr($buff,0,2)) and Get16u(\$buff, 2) == $magic) {
+        my $msg = "Invalid $dirName header";
+        if ($$dirInfo{IsWriting}) {
+            $et->Error($msg);
+            return undef;
+        } else {
+            $et->Warn($msg);
+            return 0;
+        }
+    }
+    my $offset = Get32u(\$buff, 4);
+    my %dirInfo = (
+        DirName  => $$dirInfo{DirName},
+        Parent   => $$dirInfo{Parent},
+        Base     => $base,
+        DataPt   => \$buff,
+        DataLen  => length $buff,
+        DataPos  => 0,
+        DirStart => $offset,
+        DirLen   => length($buff) - $offset,
+        RAF      => $raf,
+        NewDataPos => 8,
+    );
+    if ($$dirInfo{IsWriting}) {
+        # rewrite the Camera Profile IFD
+        my $newDir = WriteExif($et, \%dirInfo, $tagTablePtr);
+        # don't add header if error writing directory ($newDir is undef)
+        # or if directory is being deleted ($newDir is empty)
+        return $newDir unless $newDir;
+        # return directory with TIFF-like header
+        return GetByteOrder() . Set16u($magic) . Set32u(8) . $newDir;
+    }
+    if ($$et{HTML_DUMP}) {
+        my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n%s offset: 0x%.4x",
+                          (GetByteOrder() eq 'II') ? 'Little' : 'Big', $magic, $dirName, $offset);
+        $et->HDump($base, 8, "$dirName header", $tip, 0);
+    }
+    return ProcessExif($et, \%dirInfo, $tagTablePtr);
+}
+
+#------------------------------------------------------------------------------
+# Write EXIF directory
+# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
+# Returns: Exif data block (may be empty if no Exif data) or undef on error
+# Notes: Increments ExifTool CHANGED flag for each tag changed.  Also updates
+#        TIFF_END if defined with location of end of original TIFF image.
+# Returns IFD data in the following order:
+#   1. IFD0 directory followed by its data
+#   2. SubIFD directory followed by its data, thumbnail and image
+#   3. GlobalParameters, EXIF, GPS, Interop IFD's each with their data
+#   4. IFD1,IFD2,... directories each followed by their data
+#   5. Thumbnail and/or image data for each IFD, with IFD0 image last
+sub WriteExif($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    $et or return 1;      # allow dummy access to autoload this package
+    my $origDirInfo = $dirInfo; # save original dirInfo
+    my $dataPt = $$dirInfo{DataPt};
+    unless ($dataPt) {
+        my $emptyData = '';
+        $dataPt = \$emptyData;
+    }
+    my $dataPos = $$dirInfo{DataPos} || 0;
+    my $dirStart = $$dirInfo{DirStart} || 0;
+    my $dataLen = $$dirInfo{DataLen} || length($$dataPt);
+    my $dirLen = $$dirInfo{DirLen} || ($dataLen - $dirStart);
+    my $base = $$dirInfo{Base} || 0;
+    my $firstBase = $base;
+    my $raf = $$dirInfo{RAF};
+    my $dirName = $$dirInfo{DirName} || 'unknown';
+    my $fixup = $$dirInfo{Fixup} || new Image::ExifTool::Fixup;
+    my $imageDataFlag = $$dirInfo{ImageData} || '';
+    my $verbose = $et->Options('Verbose');
+    my $out = $et->Options('TextOut');
+    my ($nextIfdPos, %offsetData, $inMakerNotes);
+    my (@offsetInfo, %xDelete, $strEnc);
+    my $deleteAll = 0;
+    my $newData = '';   # initialize buffer to receive new directory data
+    my @imageData;      # image data blocks to copy later if requested
+    my $name = $$dirInfo{Name};
+    $name = $dirName unless $name and $dirName eq 'MakerNotes' and $name !~ /^MakerNote/;
+
+    # set encoding for strings
+    $strEnc = $et->Options('CharsetEXIF') if $$tagTablePtr{GROUPS}{0} eq 'EXIF';
+
+    # allow multiple IFD's in IFD0-IFD1-IFD2... chain
+    $$dirInfo{Multi} = 1 if $dirName =~ /^(IFD0|SubIFD)$/ and not defined $$dirInfo{Multi};
+    $inMakerNotes = 1 if $$tagTablePtr{GROUPS}{0} eq 'MakerNotes';
+    my $ifd;
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# loop through each IFD
+#
+    for ($ifd=0; ; ++$ifd) {  # loop through multiple IFD's
+
+        # save pointer to start of this IFD within the newData
+        my $newStart = length($newData);
+        my @subdirs;    # list of subdirectory data and tag table pointers
+        # determine if directory is contained within our data
+        my $mustRead;
+        if ($dirStart < 0 or $dirStart > $dataLen-2) {
+            $mustRead = 1;
+        } elsif ($dirLen > 2) {
+            my $len = 2 + 12 * Get16u($dataPt, $dirStart);
+            $mustRead = 1 if $dirStart + $len > $dataLen;
+        }
+        # read IFD from file if necessary
+        if ($mustRead) {
+            if ($raf) {
+                # read the count of entries in this IFD
+                my $offset = $dirStart + $dataPos;
+                my ($buff, $buf2);
+                unless ($raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2) {
+                    return ExifErr($et, "Bad IFD or truncated file in $name", $tagTablePtr);
+                }
+                my $len = 12 * Get16u(\$buff,0);
+                # (also read next IFD pointer if available)
+                unless ($raf->Read($buf2, $len+4) >= $len) {
+                    return ExifErr($et, "Error reading $name", $tagTablePtr);
+                }
+                $buff .= $buf2;
+                # make copy of dirInfo since we're going to modify it
+                my %newDirInfo = %$dirInfo;
+                $dirInfo = \%newDirInfo;
+                # update directory parameters for the newly loaded IFD
+                $dataPt = $$dirInfo{DataPt} = \$buff;
+                $dirStart = $$dirInfo{DirStart} = 0;
+                $dataPos = $$dirInfo{DataPos} = $offset;
+                $dataLen = $$dirInfo{DataLen} = length $buff;
+                $dirLen = $$dirInfo{DirLen} = $dataLen;
+                # only account for nextIFD pointer if we are going to use it
+                $len += 4 if $dataLen==$len+6 and ($$dirInfo{Multi} or $buff =~ /\0{4}$/);
+                UpdateTiffEnd($et, $offset+$base+2+$len);
+            } elsif ($dirLen) {
+                # error if we can't load IFD (unless we are creating
+                # from scratch, in which case dirLen will be zero)
+                my $str = $et->Options('IgnoreMinorErrors') ? 'Deleted bad' : 'Bad';
+                $et->Error("$str $name directory", 1);
+            }
+        }
+        my ($index, $dirEnd, $numEntries);
+        if ($dirStart + 4 < $dataLen) {
+            $numEntries = Get16u($dataPt, $dirStart);
+            $dirEnd = $dirStart + 2 + 12 * $numEntries;
+            if ($dirEnd > $dataLen) {
+                return ExifErr($et, "Truncated $name directory", $tagTablePtr);
+            }
+            # sort entries if necessary (but not in maker notes IFDs)
+            unless ($inMakerNotes) {
+                my $lastID = -1;
+                for ($index=0; $index<$numEntries; ++$index) {
+                    my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index);
+                    # check for proper sequence (but ignore null entries at end)
+                    if ($tagID < $lastID and ($tagID or $$tagTablePtr{0})) {
+                        SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0});
+                        $et->Warn("Entries in $name were out of sequence. Fixed.",1);
+                        last;
+                    }
+                    $lastID = $tagID;
+                }
+            }
+        } else {
+            $numEntries = 0;
+            $dirEnd = $dirStart;
+        }
+
+        # loop through new values and accumulate all information for this IFD
+        my (%set, %mayDelete, $tagInfo);
+        my $wrongDir = $crossDelete{$dirName};
+        foreach $tagInfo ($et->GetNewTagInfoList($tagTablePtr)) {
+            my $tagID = $$tagInfo{TagID};
+            # evaluate conditional lists now if necessary
+            if (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) {
+                my $curInfo = $et->GetTagInfo($tagTablePtr, $tagID);
+                if (defined $curInfo and not $curInfo) {
+                    # need value to evaluate the condition
+                    my $val = $et->GetNewValue($tagInfo);
+                    # must convert to binary for evaluating in Condition
+                    if ($$tagInfo{Format} and defined $val) {
+                        $val = WriteValue($val, $$tagInfo{Format}, $$tagInfo{Count});
+                    }
+                    if (defined $val) {
+                        my $fmt = $$tagInfo{Writable} || $$tagInfo{Format} || 'undef';
+                        my $cnt = $$tagInfo{Count} || 1;
+                        # always use old format/count for Condition in maker notes
+                        if ($inMakerNotes) {
+                            for ($index=0; $index<$numEntries; ++$index) {
+                                my $entry = $dirStart + 2 + 12 * $index;
+                                my $id = Get16u($dataPt, $entry);
+                                if ($id eq $tagID) {
+                                    my $f = Get16u($dataPt, $entry + 2);
+                                    if ($formatName[$f]) {
+                                        $fmt = $formatName[$f];
+                                        $cnt = Get32u($dataPt, $entry + 4);
+                                    }
+                                    last;
+                                }
+                            }
+                        }
+                        $curInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$val, $fmt, $cnt);
+                    } else {
+                        # may want to delete this, but we need to see the value first
+                        $mayDelete{$tagID} = 1;
+                    }
+                }
+                # don't set this tag unless valid for the current condition
+                next unless defined $curInfo and $curInfo eq $tagInfo;
+            }
+            if ($$tagInfo{WriteCondition}) {
+                my $self = $et;   # set $self to be used in eval
+                #### eval WriteCondition ($self)
+                unless (eval $$tagInfo{WriteCondition}) {
+                    $@ and warn $@;
+                    next;
+                }
+            }
+            my $nvHash = $et->GetNewValueHash($tagInfo, $dirName);
+            unless ($nvHash) {
+                next unless $wrongDir;
+                # delete stuff from the wrong directory if setting somewhere else
+                $nvHash = $et->GetNewValueHash($tagInfo, $wrongDir);
+                # don't cross delete if not overwriting
+                next unless $et->IsOverwriting($nvHash);
+                # don't cross delete if specifically deleting from the other directory
+                # (Note: don't call GetValue() here because it shouldn't be called
+                #  if IsOverwriting returns < 0 -- eg. when shifting)
+                next if not defined $$nvHash{Value} and $$nvHash{WantGroup} and
+                        lc($$nvHash{WantGroup}) eq lc($wrongDir);
+                # remove this tag if found in this IFD
+                $xDelete{$tagID} = 1;
+            }
+            if ($set{$tagID}) {
+                # this tag is being set twice, which can happen if two Condition's
+                # were true for this tag.  Hopefully the only case where this can
+                # happen is the MakerNotes tag since it may store two very different
+                # types of information (MakerNotes and PreviewImage), but we want
+                # to store the MakerNotes if both are available
+                if ($tagID == 0x927c and $dirName =~ /^(ExifIFD|IFD0)$/) {
+                    next if $$tagInfo{Name} eq 'PreviewImage';
+                } else {
+                    $et->Warn(sprintf("Multiple new values for $name tag 0x%.4x",$tagID));
+                }
+            }
+            $set{$tagID} = $tagInfo;
+        }
+
+        # fix base offsets (some cameras incorrectly write maker notes in IFD0)
+        if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/ and
+            $$et{TIFF_TYPE} !~ /^(ARW|SR2)$/ and not $$et{LeicaTrailerPos} and
+            Image::ExifTool::MakerNotes::FixBase($et, $dirInfo))
+        {
+            # update local variables from fixed values
+            $base = $$dirInfo{Base};
+            $dataPos = $$dirInfo{DataPos};
+        }
+
+        # initialize variables to handle mandatory tags
+        my $mandatory = $mandatory{$dirName};
+        my ($allMandatory, $addMandatory);
+        if ($mandatory) {
+            # use X/Y resolution values from JFIF if available
+            if ($dirName eq 'IFD0' and defined $$et{JFIFYResolution}) {
+                my %ifd0Vals = %$mandatory;
+                $ifd0Vals{0x011a} = $$et{JFIFXResolution};
+                $ifd0Vals{0x011b} = $$et{JFIFYResolution};
+                $ifd0Vals{0x0128} = $$et{JFIFResolutionUnit} + 1;
+                $mandatory = \%ifd0Vals;
+            }
+            $allMandatory = $addMandatory = 0; # initialize to zero
+            # add mandatory tags if creating a new directory
+            unless ($numEntries) {
+                foreach (keys %$mandatory) {
+                    $set{$_} or $set{$_} = $$tagTablePtr{$_};
+                }
+            }
+        } else {
+            undef $deleteAll;   # don't remove directory (no mandatory entries)
+        }
+        my ($addDirs, @newTags);
+        if ($inMakerNotes) {
+            $addDirs = { };     # can't currently add new directories in MakerNotes
+            # allow non-permanent makernotes tags to be added
+            # (note: we may get into trouble if there are too many of these
+            #  because we allow out-of-order tags in MakerNote IFD's but our
+            #  logic to add new tags relies on ordered entries)
+            foreach (keys %set) {
+                my $perm = $set{$_}{Permanent};
+                push @newTags, $_ if defined $perm and not $perm;
+            }
+            @newTags = sort { $a <=> $b } @newTags if @newTags > 1;
+        } else {
+            # get a hash of directories we will be writing in this one
+            $addDirs = $et->GetAddDirHash($tagTablePtr, $dirName);
+            # make a union of tags & dirs (can set whole dirs, like MakerNotes)
+            my %allTags = ( %set, %$addDirs );
+            # make sorted list of new tags to be added
+            @newTags = sort { $a <=> $b } keys(%allTags);
+        }
+        my $dirBuff = '';   # buffer for directory data
+        my $valBuff = '';   # buffer for value data
+        my @valFixups;      # list of fixups for offsets in valBuff
+        # fixup for offsets in dirBuff
+        my $dirFixup = new Image::ExifTool::Fixup;
+        my $entryBasedFixup;
+        my $lastTagID = -1;
+        my ($oldInfo, $oldFormat, $oldFormName, $oldCount, $oldSize, $oldValue, $oldImageData);
+        my ($readFormat, $readFormName, $readCount); # format for reading old value(s)
+        my ($entry, $valueDataPt, $valueDataPos, $valueDataLen, $valuePtr, $valEnd);
+        my ($offList, $offHash, $ignoreCount, $fixCount);
+        my $oldID = -1;
+        my $newID = -1;
+
+        # patch for Canon EOS 40D firmware 1.0.4 bug (incorrect directory counts)
+        if ($inMakerNotes and $$et{Model} eq 'Canon EOS 40D') {
+            my $fmt = Get16u($dataPt, $dirStart + 2 + 12 * ($numEntries - 1) + 2);
+            if ($fmt < 1 or $fmt > 13) {
+                # adjust the number of directory entries
+                --$numEntries;
+                $dirEnd -= 12;
+                $ignoreCount = 1;
+            }
+        }
+#..............................................................................
+# loop through entries in new directory
+#
+        $index = 0;
+Entry:  for (;;) {
+
+            if (defined $oldID and $oldID == $newID) {
+#
+# read next entry from existing directory
+#
+                if ($index < $numEntries) {
+                    $entry = $dirStart + 2 + 12 * $index;
+                    $oldID = Get16u($dataPt, $entry);
+                    $readFormat = $oldFormat = Get16u($dataPt, $entry+2);
+                    $readCount = $oldCount = Get32u($dataPt, $entry+4);
+                    undef $oldImageData;
+                    if ($oldFormat < 1 or $oldFormat > 13) {
+                        my $msg = "Bad format ($oldFormat) for $name entry $index";
+                        # patch to preserve invalid directory entries in SubIFD3 of
+                        # various Kodak Z-series cameras (Z812, Z1085IS, Z1275)
+                        # and some Sony cameras such as the DSC-P10
+                        if ($dirName eq 'MakerNotes' and (($$et{Make}=~/KODAK/i and
+                            $$dirInfo{Name} and $$dirInfo{Name} eq 'SubIFD3') or
+                            ($numEntries == 12 and $$et{Make} eq 'SONY' and $index >= 8)))
+                        {
+                            $dirBuff .= substr($$dataPt, $entry, 12);
+                            ++$index;
+                            $newID = $oldID;    # we wrote this
+                            $et->Warn($msg, 1);
+                            next;
+                        }
+                        # don't write out null directory entry
+                        if ($oldFormat==0 and $index and $oldCount==0) {
+                            $ignoreCount = ($ignoreCount || 0) + 1;
+                            # must keep same directory size to avoid messing up our fixed offsets
+                            $dirBuff .= ("\0" x 12) if $$dirInfo{FixBase};
+                            ++$index;
+                            $newID = $oldID;    # pretend we wrote this
+                            next;
+                        }
+                        return ExifErr($et, $msg, $tagTablePtr);
+                    }
+                    $readFormName = $oldFormName = $formatName[$oldFormat];
+                    $valueDataPt = $dataPt;
+                    $valueDataPos = $dataPos;
+                    $valueDataLen = $dataLen;
+                    $valuePtr = $entry + 8;
+                    # try direct method first for speed
+                    $oldInfo = $$tagTablePtr{$oldID};
+                    if (ref $oldInfo ne 'HASH' or $$oldInfo{Condition}) {
+                        # must get unknown tags too
+                        # (necessary so we don't miss a tag we want to Drop)
+                        my $unk = $et->Options(Unknown => 1);
+                        $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID);
+                        $et->Options(Unknown => $unk);
+                    }
+                    # patch incorrect count in Kodak SubIFD3 tags
+                    if ($oldCount < 2 and $oldInfo and $$oldInfo{FixCount}) {
+                        $offList or ($offList, $offHash) = GetOffList($dataPt, $dirStart, $dataPos,
+                                                                      $numEntries, $tagTablePtr);
+                        my $i = $$offHash{Get32u($dataPt, $valuePtr)};
+                        if (defined $i and $i < $#$offList) {
+                            $oldCount = int(($$offList[$i+1] - $$offList[$i]) / $formatSize[$oldFormat]);
+                            $fixCount = ($fixCount || 0) + 1 if $oldCount != $readCount;
+                        }
+                    }
+                    $oldSize = $oldCount * $formatSize[$oldFormat];
+                    my $readFromFile;
+                    if ($oldSize > 4) {
+                        $valuePtr = Get32u($dataPt, $valuePtr);
+                        # fix valuePtr if necessary
+                        if ($$dirInfo{FixOffsets}) {
+                            $valEnd or $valEnd = $dataPos + $dirStart + 2 + 12 * $numEntries + 4;
+                            my ($tagID, $size, $wFlag) = ($oldID, $oldSize, 1);
+                            #### eval FixOffsets ($valuePtr, $valEnd, $size, $tagID, $wFlag)
+                            eval $$dirInfo{FixOffsets};
+                            unless (defined $valuePtr) {
+                                unless ($$et{DROP_TAGS}) {
+                                    my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf("tag 0x%.4x",$oldID);
+                                    return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
+                                }
+                                ++$index;  $oldID = $newID;  next;  # drop this tag
+                            }
+                        }
+                        # offset shouldn't point into TIFF or IFD header
+                        my $suspect = ($valuePtr < 8);
+                        # convert offset to pointer in $$dataPt
+                        if ($$dirInfo{EntryBased} or (ref $$tagTablePtr{$oldID} eq 'HASH' and
+                            $$tagTablePtr{$oldID}{EntryBased}))
+                        {
+                            $valuePtr += $entry;
+                        } else {
+                            $valuePtr -= $dataPos;
+                        }
+                        # value shouldn't overlap our directory
+                        $suspect = 1 if $valuePtr < $dirEnd and $valuePtr+$oldSize > $dirStart;
+                        # get value by seeking in file if we are allowed
+                        if ($valuePtr < 0 or $valuePtr+$oldSize > $dataLen) {
+                            my ($pos, $tagStr, $invalidPreview, $tmpInfo, $leicaTrailer);
+                            if ($oldInfo) {
+                                $tagStr = $$oldInfo{Name};
+                                $leicaTrailer = $$oldInfo{LeicaTrailer};
+                            } elsif (defined $oldInfo) {
+                                $tmpInfo = $et->GetTagInfo($tagTablePtr, $oldID, \ '', $oldFormName, $oldCount);
+                                if ($tmpInfo) {
+                                    $tagStr = $$tmpInfo{Name};
+                                    $leicaTrailer = $$tmpInfo{LeicaTrailer};
+                                }
+                            }
+                            $tagStr or $tagStr = sprintf("tag 0x%.4x",$oldID);
+                            # allow PreviewImage to run outside EXIF segment in JPEG images
+                            if (not $raf) {
+                                if ($tagStr eq 'PreviewImage') {
+                                    $raf = $$et{RAF};
+                                    if ($raf) {
+                                        $pos = $raf->Tell();
+                                        if ($oldInfo and $$oldInfo{ChangeBase}) {
+                                            # adjust base offset for this tag only
+                                            #### eval ChangeBase ($dirStart,$dataPos)
+                                            my $newBase = eval $$oldInfo{ChangeBase};
+                                            $valuePtr += $newBase;
+                                        }
+                                    } else {
+                                        $invalidPreview = 1;
+                                    }
+                                } elsif ($leicaTrailer) {
+                                    # save information about Leica makernote trailer
+                                    $$et{LeicaTrailer} = {
+                                        TagInfo => $oldInfo || $tmpInfo,
+                                        Offset  => $base + $valuePtr + $dataPos,
+                                        Size    => $oldSize,
+                                        Fixup   => new Image::ExifTool::Fixup,
+                                    },
+                                    $invalidPreview = 2;
+                                    # remove SubDirectory to prevent processing (for now)
+                                    my %copy = %{$oldInfo || $tmpInfo};
+                                    delete $copy{SubDirectory};
+                                    delete $copy{MakerNotes};
+                                    $oldInfo = \%copy;
+                                }
+                            }
+                            if ($oldSize > BINARY_DATA_LIMIT and $$origDirInfo{ImageData} and
+                                (not defined $oldInfo or ($oldInfo and not $$oldInfo{SubDirectory})))
+                            {
+                                # copy huge data blocks later instead of loading into memory
+                                $oldValue = ''; # dummy empty value
+                                # copy this value later unless writing a new value
+                                unless ($set{$oldID}) {
+                                    my $pad = $oldSize & 0x01 ? 1 : 0;
+                                    # save block information to copy later (set directory offset later)
+                                    $oldImageData = [$base+$valuePtr+$dataPos, $oldSize, $pad];
+                                }
+                            } elsif ($raf) {
+                                my $success = ($raf->Seek($base+$valuePtr+$dataPos, 0) and
+                                               $raf->Read($oldValue, $oldSize) == $oldSize);
+                                if (defined $pos) {
+                                    $raf->Seek($pos, 0);
+                                    undef $raf;
+                                    # (sony A700 has 32-byte header on PreviewImage)
+                                    unless ($success and $oldValue =~ /^(\xff\xd8\xff|(.|.{33})\xd8\xff\xdb)/s) {
+                                        $invalidPreview = 1;
+                                        $success = 1;   # continue writing directory anyway
+                                    }
+                                }
+                                unless ($success) {
+                                    return undef if $et->Error("Error reading value for $name entry $index", $inMakerNotes);
+                                    ++$index;  $oldID = $newID;  next;  # drop this tag
+                                }
+                            } elsif (not $invalidPreview) {
+                                return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
+                                ++$index;  $oldID = $newID;  next;  # drop this tag
+                            }
+                            if ($invalidPreview) {
+                                # set value for invalid preview
+                                if ($$et{FILE_TYPE} eq 'JPEG') {
+                                    # define dummy value for preview (or Leica MakerNote) to write later
+                                    # (value must be larger than 4 bytes to generate PREVIEW_INFO,
+                                    # and an even number of bytes so it won't be padded)
+                                    $oldValue = 'LOAD_PREVIEW';
+                                } else {
+                                    $oldValue = 'none';
+                                    $oldSize = length $oldValue;
+                                }
+                                $valuePtr = 0;
+                            } else {
+                                UpdateTiffEnd($et, $base+$valuePtr+$dataPos+$oldSize);
+                            }
+                            # update pointers for value just read from file
+                            $valueDataPt = \$oldValue;
+                            $valueDataPos = $valuePtr + $dataPos;
+                            $valueDataLen = $oldSize;
+                            $valuePtr = 0;
+                            $readFromFile = 1;
+                        }
+                        if ($suspect) {
+                            my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf('tag 0x%.4x', $oldID);
+                            my $str = "Suspicious $name offset for $tagStr";
+                            if ($inMakerNotes) {
+                                $et->Warn($str, 1);
+                            } else {
+                                return undef if $et->Error($str, 1);
+                            }
+                        }
+                    }
+                    # read value if we haven't already
+                    $oldValue = substr($$valueDataPt, $valuePtr, $oldSize) unless $readFromFile;
+                    # get tagInfo using value if necessary
+                    if (defined $oldInfo and not $oldInfo) {
+                        my $unk = $et->Options(Unknown => 1);
+                        $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID, \$oldValue, $oldFormName, $oldCount);
+                        $et->Options(Unknown => $unk);
+                        # now that we have the value, we can resolve the Condition to finally
+                        # determine whether we want to delete this tag or not
+                        if ($mayDelete{$oldID} and $oldInfo and (not @newTags or $newTags[0] != $oldID)) {
+                            my $nvHash = $et->GetNewValueHash($oldInfo, $dirName);
+                            if (not $nvHash and $wrongDir) {
+                                # delete from wrong directory if necessary
+                                $nvHash = $et->GetNewValueHash($oldInfo, $wrongDir);
+                                $nvHash and $xDelete{$oldID} = 1;
+                            }
+                            if ($nvHash) {
+                                # we want to delete this tag after all, so insert it into our list
+                                $set{$oldID} = $oldInfo;
+                                unshift @newTags, $oldID;
+                            }
+                        }
+                    }
+                    # make sure we are handling the 'ifd' format properly
+                    if (($oldFormat == 13 or $oldFormat == 18) and
+                        (not $oldInfo or not $$oldInfo{SubIFD}))
+                    {
+                        my $str = sprintf('%s tag 0x%.4x IFD format not handled', $name, $oldID);
+                        $et->Error($str, $inMakerNotes);
+                    }
+                    # override format we use to read the value if specified
+                    if ($oldInfo) {
+                        # check for tags which must be integers
+                        if (($$oldInfo{IsOffset} or $$oldInfo{SubIFD}) and
+                            not $intFormat{$oldFormName})
+                        {
+                            $et->Error("Invalid format ($oldFormName) for $name $$oldInfo{Name}", $inMakerNotes);
+                            ++$index;  $oldID = $newID;  next;  # drop this tag
+                        }
+                        if ($$oldInfo{Drop} and $$et{DROP_TAGS} and
+                            ($$oldInfo{Drop} == 1 or $$oldInfo{Drop} < $oldSize))
+                        {
+                            ++$index;  $oldID = $newID;  next;  # drop this tag
+                        }
+                        if ($$oldInfo{Format}) {
+                            $readFormName = $$oldInfo{Format};
+                            $readFormat = $formatNumber{$readFormName};
+                            unless ($readFormat) {
+                                # we aren't reading in a standard EXIF format, so rewrite in old format
+                                $readFormName = $oldFormName;
+                                $readFormat = $oldFormat;
+                            }
+                            # adjust number of items to read if format size changed
+                            $readCount = $oldSize / $formatSize[$readFormat];
+                        }
+                    }
+                    if ($oldID <= $lastTagID and not $inMakerNotes) {
+                        my $str = $oldInfo ? "$$oldInfo{Name} tag" : sprintf('tag 0x%x',$oldID);
+                        if ($oldID == $lastTagID) {
+                            $et->Warn("Duplicate $str in $name");;
+                        } else {
+                            $et->Warn("\u$str out of sequence in $name");
+                        }
+                    }
+                    $lastTagID = $oldID;
+                    ++$index;               # increment index for next time
+                } else {
+                    undef $oldID;           # no more existing entries
+                }
+            }
+#
+# write out all new tags, up to and including this one
+#
+            $newID = $newTags[0];
+            my $isNew;  # -1=tag is old, 0=tag same as existing, 1=tag is new
+            if (not defined $oldID) {
+                last unless defined $newID;
+                $isNew = 1;
+            } elsif (not defined $newID) {
+                # maker notes will have no new tags defined
+                if ($set{$oldID}) {
+                    $newID = $oldID;
+                    $isNew = 0;
+                } else {
+                    $isNew = -1;
+                }
+            } else {
+                $isNew = $oldID <=> $newID;
+            }
+            my $newInfo = $oldInfo;
+            my $newFormat = $oldFormat;
+            my $newFormName = $oldFormName;
+            my $newCount = $oldCount;
+            my $ifdFormName;
+            my $newValue;
+            my $newValuePt = $isNew >= 0 ? \$newValue : \$oldValue;
+            my $isOverwriting;
+
+            if ($isNew >= 0) {
+                # add, edit or delete this tag
+                shift @newTags; # remove from list
+                if ($set{$newID}) {
+#
+# set the new tag value (or 'next' if deleting tag)
+#
+                    $newInfo = $set{$newID};
+                    $newCount = $$newInfo{Count};
+                    my ($val, $newVal, $n);
+                    my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
+                    if ($isNew > 0) {
+                        # don't create new entry unless requested
+                        if ($nvHash) {
+                            next unless $$nvHash{IsCreating};
+                            if ($$newInfo{IsOverwriting}) {
+                                my $proc = $$newInfo{IsOverwriting};
+                                $isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
+                            } else {
+                                $isOverwriting = $et->IsOverwriting($nvHash);
+                            }
+                        } else {
+                            next if $xDelete{$newID};       # don't create if cross deleting
+                            $newVal = $$mandatory{$newID};  # get value for mandatory tag
+                            $isOverwriting = 1;
+                        }
+                        # convert using new format
+                        if ($$newInfo{Format}) {
+                            $newFormName = $$newInfo{Format};
+                            # use Writable flag to specify IFD format code
+                            $ifdFormName = $$newInfo{Writable};
+                        } else {
+                            $newFormName = $$newInfo{Writable};
+                            unless ($newFormName) {
+                                warn("No format for $name $$newInfo{Name}\n");
+                                next;
+                            }
+                        }
+                        $newFormat = $formatNumber{$newFormName};
+                    } elsif ($nvHash or $xDelete{$newID}) {
+                        unless ($nvHash) {
+                            $nvHash = $et->GetNewValueHash($newInfo, $wrongDir);
+                        }
+                        # read value
+                        if (length $oldValue >= $oldSize) {
+                            $val = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
+                        } else {
+                            $val = '';
+                        }
+                        # determine write format (by default, use 'Writable' format)
+                        my $writable = $$newInfo{Writable};
+                        # (or use existing format if 'Writable' not specified)
+                        $writable = $oldFormName unless $writable and $writable ne '1';
+                        # (and override write format with 'Format' if specified)
+                        my $writeForm = $$newInfo{Format} || $writable;
+                        if ($writeForm ne $newFormName) {
+                            # write in specified format
+                            $newFormName = $writeForm;
+                            $newFormat = $formatNumber{$newFormName};
+                            # use different IFD format code if necessary
+                            if ($inMakerNotes) {
+                                # always preserve IFD format in maker notes
+                                $ifdFormName = $oldFormName;
+                            } elsif ($writable ne $newFormName) {
+                                # use specified IFD format
+                                $ifdFormName = $writable;
+                            }
+                        }
+                        if ($inMakerNotes and $readFormName ne 'string' and $readFormName ne 'undef') {
+                            # keep same size in maker notes unless string or binary
+                            $newCount = $oldCount * $formatSize[$oldFormat] / $formatSize[$newFormat];
+                        }
+                        if ($$newInfo{IsOverwriting}) {
+                            my $proc = $$newInfo{IsOverwriting};
+                            $isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
+                        } else {
+                            $isOverwriting = $et->IsOverwriting($nvHash, $val);
+                        }
+                    }
+                    if ($isOverwriting) {
+                        $newVal = $et->GetNewValue($nvHash) unless defined $newVal;
+                        # value undefined if deleting this tag
+                        # (also delete tag if cross-deleting and this isn't a date/time shift)
+                        if (not defined $newVal or ($xDelete{$newID} and not defined $$nvHash{Shift})) {
+                            if ($$newInfo{RawConvInv} and defined $$nvHash{Value}) {
+                                # error in RawConvInv, so rewrite existing tag
+                                goto NoOverwrite; # GOTO!
+                            }
+                            unless ($isNew) {
+                                ++$$et{CHANGED};
+                                $et->VerboseValue("- $dirName:$$newInfo{Name}", $val);
+                            }
+                            next;
+                        }
+                        if ($newCount and $newCount < 0) {
+                            # set count to number of values if variable
+                            my @vals = split ' ',$newVal;
+                            $newCount = @vals;
+                        }
+                        # convert to binary format
+                        $newValue = WriteValue($newVal, $newFormName, $newCount);
+                        unless (defined $newValue) {
+                            $et->Warn("Invalid value for $dirName:$$newInfo{Name}");
+                            goto NoOverwrite; # GOTO!
+                        }
+                        if (length $newValue) {
+                            # limit maximum value length in JPEG images
+                            # (max segment size is 65533 bytes and the min EXIF size is 96 incl an additional IFD entry)
+                            if ($$et{FILE_TYPE} eq 'JPEG' and length($newValue) > 65436 and
+                                $$newInfo{Name} ne 'PreviewImage')
+                            {
+                                my $name = $$newInfo{MakerNotes} ? 'MakerNotes' : $$newInfo{Name};
+                                $et->Warn("$name too large to write in JPEG segment");
+                                goto NoOverwrite; # GOTO!
+                            }
+                            # re-code if necessary
+                            if ($strEnc and $newFormName eq 'string') {
+                                $newValue = $et->Encode($newValue, $strEnc);
+                            }
+                        } else {
+                            $et->Warn("Can't write zero length $$newInfo{Name} in $$tagTablePtr{GROUPS}{1}");
+                            goto NoOverwrite; # GOTO!
+                        }
+                        if ($isNew >= 0) {
+                            $newCount = length($newValue) / $formatSize[$newFormat];
+                            ++$$et{CHANGED};
+                            if (defined $allMandatory) {
+                                # not all mandatory if we are writing any tag specifically
+                                if ($nvHash) {
+                                    undef $allMandatory;
+                                    undef $deleteAll;
+                                } else {
+                                    ++$addMandatory;    # count mandatory tags that we added
+                                }
+                            }
+                            if ($verbose > 1) {
+                                $et->VerboseValue("- $dirName:$$newInfo{Name}", $val) unless $isNew;
+                                my $str = $nvHash ? '' : ' (mandatory)';
+                                $et->VerboseValue("+ $dirName:$$newInfo{Name}", $newVal, $str);
+                            }
+                        }
+                    } else {
+NoOverwrite:            next if $isNew > 0;
+                        $isNew = -1;        # rewrite existing tag
+                    }
+                    # set format for EXIF IFD if different than conversion format
+                    if ($ifdFormName) {
+                        $newFormName = $ifdFormName;
+                        $newFormat = $formatNumber{$newFormName};
+                    }
+
+                } elsif ($isNew > 0) {
+#
+# create new subdirectory
+#
+                    # newInfo may not be defined if we try to add a mandatory tag
+                    # to a directory that doesn't support it (eg. IFD1 in RW2 images)
+                    $newInfo = $$addDirs{$newID} or next;
+                    # make sure we don't try to generate a new MakerNotes directory
+                    # or a SubIFD
+                    next if $$newInfo{MakerNotes} or $$newInfo{Name} eq 'SubIFD';
+                    my $subTable;
+                    if ($$newInfo{SubDirectory}{TagTable}) {
+                        $subTable = Image::ExifTool::GetTagTable($$newInfo{SubDirectory}{TagTable});
+                    } else {
+                        $subTable = $tagTablePtr;
+                    }
+                    # create empty source directory
+                    my %sourceDir = (
+                        Parent => $dirName,
+                        Fixup => new Image::ExifTool::Fixup,
+                    );
+                    $sourceDir{DirName} = $$newInfo{Groups}{1} if $$newInfo{SubIFD};
+                    $newValue = $et->WriteDirectory(\%sourceDir, $subTable);
+                    # only add new directory if it isn't empty
+                    next unless defined $newValue and length($newValue);
+                    # set the fixup start location
+                    if ($$newInfo{SubIFD}) {
+                        # subdirectory is referenced by an offset in value buffer
+                        my $subdir = $newValue;
+                        $newValue = Set32u(0xfeedf00d);
+                        push @subdirs, {
+                            DataPt => \$subdir,
+                            Table => $subTable,
+                            Fixup => $sourceDir{Fixup},
+                            Offset => length($dirBuff) + 8,
+                            Where => 'dirBuff',
+                        };
+                        $newFormName = 'int32u';
+                        $newFormat = $formatNumber{$newFormName};
+                    } else {
+                        # subdirectory goes directly into value buffer
+                        $sourceDir{Fixup}{Start} += length($valBuff);
+                        # use Writable to set format, otherwise 'undef'
+                        $newFormName = $$newInfo{Writable};
+                        unless ($newFormName and $formatNumber{$newFormName}) {
+                            $newFormName = 'undef';
+                        }
+                        $newFormat = $formatNumber{$newFormName};
+                        push @valFixups, $sourceDir{Fixup};
+                    }
+                } elsif ($$newInfo{Format} and $$newInfo{Writable} and $$newInfo{Writable} ne '1') {
+                    # use specified write format
+                    $newFormName = $$newInfo{Writable};
+                    $newFormat = $formatNumber{$newFormName};
+                } elsif ($$addDirs{$newID} and $newInfo ne $$addDirs{$newID}) {
+                    # this can happen if we are trying to add a directory that doesn't exist
+                    # in this type of file (eg. try adding a SubIFD tag to an A100 image)
+                    $isNew = -1;
+                }
+            }
+            if ($isNew < 0) {
+                # just rewrite existing tag
+                $newID = $oldID;
+                $newValue = $oldValue;
+                $newFormat = $oldFormat; # (just in case it changed)
+                $newFormName = $oldFormName;
+                # set offset of this entry in the directory so we can update the pointer
+                # and save block information to copy this large block later
+                if ($oldImageData) {
+                    $$oldImageData[3] = $newStart + length($dirBuff) + 2;
+                    push @imageData, $oldImageData;
+                    $$origDirInfo{ImageData} = \@imageData;
+                }
+            }
+            if ($newInfo) {
+#
+# load necessary data for this tag (thumbnail image, etc)
+#
+                if ($$newInfo{DataTag} and $isNew >= 0) {
+                    my $dataTag = $$newInfo{DataTag};
+                    # load data for this tag
+                    unless (defined $offsetData{$dataTag} or $dataTag eq 'LeicaTrailer') {
+                        # prefer tag from Composite table if it exists (otherwise
+                        # PreviewImage data would be taken from Extra tag)
+                        my $compInfo = $Image::ExifTool::Composite{$dataTag};
+                        $offsetData{$dataTag} = $et->GetNewValue($compInfo || $dataTag);
+                        my $err;
+                        if (defined $offsetData{$dataTag}) {
+                            my $len = length $offsetData{$dataTag};
+                            if ($dataTag eq 'PreviewImage') {
+                                # must set DEL_PREVIEW flag now if preview fit into IFD
+                                $$et{DEL_PREVIEW} = 1 if $len <= 4;
+                            } elsif ($$et{FILE_TYPE} eq 'JPEG' and $len > 60000) {
+                                delete $offsetData{$dataTag};
+                                $err = "$dataTag not written (too large for JPEG segment)";
+                            }
+                        } else {
+                            $err = "$dataTag not found";
+                        }
+                        if ($err) {
+                            $et->Warn($err) if $$newInfo{IsOffset};
+                            delete $set{$newID};    # remove from list of tags we are setting
+                            next;
+                        }
+                    }
+                }
+#
+# write maker notes
+#
+                if ($$newInfo{MakerNotes}) {
+                    # don't write new makernotes if we are deleting this group
+                    if ($$et{DEL_GROUP}{MakerNotes} and
+                       ($$et{DEL_GROUP}{MakerNotes} != 2 or $isNew <= 0))
+                    {
+                        if ($isNew <= 0) {
+                            ++$$et{CHANGED};
+                            $verbose and print $out "  Deleting MakerNotes\n";
+                        }
+                        next;
+                    }
+                    my $saveOrder = GetByteOrder();
+                    if ($isNew >= 0 and $set{$newID}) {
+                        # we are writing a whole new maker note block
+                        # --> add fixup information if necessary
+                        my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
+                        if ($nvHash and $$nvHash{MAKER_NOTE_FIXUP}) {
+                            # must clone fixup because we will be shifting it
+                            my $makerFixup = $$nvHash{MAKER_NOTE_FIXUP}->Clone();
+                            my $valLen = length($valBuff);
+                            $$makerFixup{Start} += $valLen;
+                            push @valFixups, $makerFixup;
+                        }
+                    } else {
+                        # update maker notes if possible
+                        my %subdirInfo = (
+                            Base     => $base,
+                            DataPt   => $valueDataPt,
+                            DataPos  => $valueDataPos,
+                            DataLen  => $valueDataLen,
+                            DirStart => $valuePtr,
+                            DirLen   => $oldSize,
+                            DirName  => 'MakerNotes',
+                            Name     => $$newInfo{Name},
+                            Parent   => $dirName,
+                            TagInfo  => $newInfo,
+                            RAF      => $raf,
+                        );
+                        my ($subTable, $subdir, $loc, $writeProc, $notIFD);
+                        if ($$newInfo{SubDirectory}) {
+                            my $sub = $$newInfo{SubDirectory};
+                            $subdirInfo{FixBase} = 1 if $$sub{FixBase};
+                            $subdirInfo{FixOffsets} = $$sub{FixOffsets};
+                            $subdirInfo{EntryBased} = $$sub{EntryBased};
+                            $subdirInfo{NoFixBase} = 1 if defined $$sub{Base};
+                            $subdirInfo{AutoFix} = $$sub{AutoFix};
+                        }
+                        # get the proper tag table for these maker notes
+                        if ($oldInfo and $$oldInfo{SubDirectory}) {
+                            $subTable = $$oldInfo{SubDirectory}{TagTable};
+                            $subTable and $subTable = Image::ExifTool::GetTagTable($subTable);
+                            $writeProc = $$oldInfo{SubDirectory}{WriteProc};
+                            $notIFD = $$oldInfo{NotIFD};
+                        } else {
+                            $et->Warn('Internal problem getting maker notes tag table');
+                        }
+                        $writeProc or $writeProc = $$subTable{WRITE_PROC} if $subTable;
+                        $subTable or $subTable = $tagTablePtr;
+                        if ($writeProc and
+                            $writeProc eq \&Image::ExifTool::MakerNotes::WriteUnknownOrPreview and
+                            $oldValue =~ /^\xff\xd8\xff/)
+                        {
+                            $loc = 0;
+                        } elsif (not $notIFD) {
+                            # look for IFD-style maker notes
+                            $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
+                        }
+                        if (defined $loc) {
+                            # we need fixup data for this subdirectory
+                            $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
+                            # rewrite maker notes
+                            my $changed = $$et{CHANGED};
+                            $subdir = $et->WriteDirectory(\%subdirInfo, $subTable, $writeProc);
+                            if ($changed == $$et{CHANGED} and $subdirInfo{Fixup}->IsEmpty()) {
+                                # return original data if nothing changed and no fixups
+                                undef $subdir;
+                            }
+                        } elsif ($$subTable{PROCESS_PROC} and
+                                 $$subTable{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData)
+                        {
+                            my $sub = $$oldInfo{SubDirectory};
+                            if (defined $$sub{Start}) {
+                                #### eval Start ($valuePtr)
+                                my $start = eval $$sub{Start};
+                                $loc = $start - $valuePtr;
+                                $subdirInfo{DirStart} = $start;
+                                $subdirInfo{DirLen} -= $loc;
+                            } else {
+                                $loc = 0;
+                            }
+                            # rewrite maker notes
+                            $subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
+                        } elsif ($notIFD) {
+                            if ($writeProc) {
+                                $loc = 0;
+                                $subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
+                            }
+                        } else {
+                            my $msg = 'Maker notes could not be parsed';
+                            if ($$et{FILE_TYPE} eq 'JPEG') {
+                                $et->Warn($msg, 1);
+                            } else {
+                                $et->Error($msg, 1);
+                            }
+                        }
+                        if (defined $subdir) {
+                            next unless length $subdir;
+                            my $valLen = length($valBuff);
+                            # restore existing header and substitute the new
+                            # maker notes for the old value
+                            $newValue = substr($oldValue, 0, $loc) . $subdir;
+                            my $makerFixup = $subdirInfo{Fixup};
+                            my $previewInfo = $$et{PREVIEW_INFO};
+                            if ($subdirInfo{Relative}) {
+                                # apply a one-time fixup to $loc since offsets are relative
+                                $$makerFixup{Start} += $loc;
+                                # shift all offsets to be relative to new base
+                                my $baseShift = $valueDataPos + $valuePtr + $base - $subdirInfo{Base};
+                                $$makerFixup{Shift} += $baseShift;
+                                $makerFixup->ApplyFixup(\$newValue);
+                                if ($previewInfo) {
+                                    # remove all but PreviewImage fixup (since others shouldn't change)
+                                    foreach (keys %{$$makerFixup{Pointers}}) {
+                                        /_PreviewImage$/ or delete $$makerFixup{Pointers}{$_};
+                                    }
+                                    # zero pointer so we can see how it gets shifted later
+                                    $makerFixup->SetMarkerPointers(\$newValue, 'PreviewImage', 0);
+                                    # set the pointer to the start of the EXIF information
+                                    # add preview image fixup to list of value fixups
+                                    $$makerFixup{Start} += $valLen;
+                                    push @valFixups, $makerFixup;
+                                    $$previewInfo{BaseShift} = $baseShift;
+                                    $$previewInfo{Relative} = 1;
+                                }
+                            # don't shift anything if relative flag set to zero (Pentax patch)
+                            } elsif (not defined $subdirInfo{Relative}) {
+                                # shift offset base if shifted in the original image or if FixBase
+                                # was used, but be careful of automatic FixBase with negative shifts
+                                # since they may lead to negative (invalid) offsets (casio_edit_problem.jpg)
+                                my $baseShift = $base - $subdirInfo{Base};
+                                if ($subdirInfo{AutoFix}) {
+                                    $baseShift = 0;
+                                } elsif ($subdirInfo{FixBase} and $baseShift < 0 and
+                                    # allow negative base shift if offsets are bigger (PentaxOptioWP.jpg)
+                                    (not $subdirInfo{MinOffset} or $subdirInfo{MinOffset} + $baseShift < 0))
+                                {
+                                    my $fixBase = $et->Options('FixBase');
+                                    if (not defined $fixBase) {
+                                        my $str = $et->Options('IgnoreMinorErrors') ? 'ignored' : 'fix or ignore?';
+                                        $et->Error("MakerNotes offsets may be incorrect ($str)", 1);
+                                    } elsif ($fixBase eq '') {
+                                        $et->Warn('Fixed incorrect MakerNotes offsets');
+                                        $baseShift = 0;
+                                    }
+                                }
+                                $$makerFixup{Start} += $valLen + $loc;
+                                $$makerFixup{Shift} += $baseShift;
+                                # permanently fix makernote offset errors
+                                $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0;
+                                push @valFixups, $makerFixup;
+                                if ($previewInfo and not $$previewInfo{NoBaseShift}) {
+                                    $$previewInfo{BaseShift} = $baseShift;
+                                }
+                            }
+                            $newValuePt = \$newValue;   # write new value
+                        }
+                    }
+                    SetByteOrder($saveOrder);
+
+                # process existing subdirectory unless we are overwriting it entirely
+                } elsif ($$newInfo{SubDirectory} and $isNew <= 0 and not $isOverwriting
+                    # don't edit directory if Writable is set to 0
+                    and (not defined $$newInfo{Writable} or $$newInfo{Writable}))
+                {
+
+                    my $subdir = $$newInfo{SubDirectory};
+                    if ($$newInfo{SubIFD}) {
+#
+# rewrite existing sub IFD's
+#
+                        my $subTable = $tagTablePtr;
+                        if ($$subdir{TagTable}) {
+                            $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
+                        }
+                        # determine directory name for this IFD
+                        my $subdirName = $$newInfo{Groups}{1} || $$newInfo{Name};
+                        # all makernotes directory names must be 'MakerNotes'
+                        $subdirName = 'MakerNotes' if $$subTable{GROUPS}{0} eq 'MakerNotes';
+                        # must handle sub-IFD's specially since the values
+                        # are actually offsets to subdirectories
+                        unless ($readCount) {   # can't have zero count
+                            return undef if $et->Error("$name entry $index has zero count", 2);
+                            next;
+                        }
+                        my $writeCount = 0;
+                        my $i;
+                        $newValue = '';    # reset value because we regenerate it below
+                        for ($i=0; $i<$readCount; ++$i) {
+                            my $off = $i * $formatSize[$readFormat];
+                            my $val = ReadValue($valueDataPt, $valuePtr + $off,
+                                                $readFormName, 1, $oldSize - $off);
+                            my $subdirStart = $val - $dataPos;
+                            my $subdirBase = $base;
+                            my $hdrLen;
+                            if (defined $$subdir{Start}) {
+                                #### eval Start ($val)
+                                my $newStart = eval $$subdir{Start};
+                                unless (Image::ExifTool::IsInt($newStart)) {
+                                    $et->Error("Bad subdirectory start for $$newInfo{Name}");
+                                    next;
+                                }
+                                $newStart -= $dataPos;
+                                $hdrLen = $newStart - $subdirStart;
+                                $subdirStart = $newStart;
+                            }
+                            if ($$subdir{Base}) {
+                                my $start = $subdirStart + $dataPos;
+                                #### eval Base ($start,$base)
+                                $subdirBase += eval $$subdir{Base};
+                            }
+                            # add IFD number if more than one
+                            $subdirName =~ s/\d*$/$i/ if $i;
+                            my %subdirInfo = (
+                                Base     => $subdirBase,
+                                DataPt   => $dataPt,
+                                DataPos  => $dataPos - $subdirBase + $base,
+                                DataLen  => $dataLen,
+                                DirStart => $subdirStart,
+                                DirName  => $subdirName,
+                                Name     => $$newInfo{Name},
+                                TagInfo  => $newInfo,
+                                Parent   => $dirName,
+                                Fixup    => new Image::ExifTool::Fixup,
+                                RAF      => $raf,
+                                Subdir   => $subdir,
+                                # set ImageData only for 1st level SubIFD's
+                                ImageData=> $imageDataFlag eq 'Main' ? 'SubIFD' : undef,
+                            );
+                            # pass on header pointer only for certain sub IFD's
+                            $subdirInfo{HeaderPtr} = $$dirInfo{HeaderPtr} if $$newInfo{SubIFD} == 2;
+                            if ($$subdir{RelativeBase}) {
+                                # apply one-time fixup if offsets are relative (Sony IDC hack)
+                                delete $subdirInfo{Fixup};
+                                delete $subdirInfo{ImageData};
+                            }
+                            # is the subdirectory outside our current data?
+                            if ($subdirStart < 0 or $subdirStart + 2 > $dataLen) {
+                                if ($raf) {
+                                    # reset SubDirectory buffer (we will load it later)
+                                    my $buff = '';
+                                    $subdirInfo{DataPt} = \$buff;
+                                    $subdirInfo{DataLen} = 0;
+                                } else {
+                                    my @err = ("Can't read $subdirName data", $inMakerNotes);
+                                    if ($$subTable{VARS} and $$subTable{VARS}{MINOR_ERRORS}) {
+                                        $et->Warn($err[0] . '. Ignored.');
+                                    } elsif ($et->Error(@err)) {
+                                        return undef;
+                                    }
+                                    next Entry; # don't write this directory
+                                }
+                            }
+                            my $subdirData = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
+                            unless (defined $subdirData) {
+                                # WriteDirectory should have issued an error, but check just in case
+                                $et->Error("Error writing $subdirName") unless $$et{VALUE}{Error};
+                                return undef;
+                            }
+                            # add back original header if necessary (eg. Ricoh GR)
+                            if ($hdrLen and $hdrLen > 0 and $subdirStart <= $dataLen) {
+                                $subdirData = substr($$dataPt, $subdirStart - $hdrLen, $hdrLen) . $subdirData;
+                                $subdirInfo{Fixup}{Start} += $hdrLen;
+                            }
+                            unless (length $subdirData) {
+                                next unless $inMakerNotes;
+                                # don't delete MakerNote Sub-IFD's, write empty IFD instead
+                                $subdirData = "\0" x 6;
+                                # reset SubIFD ImageData and Fixup just to be safe
+                                delete $subdirInfo{ImageData};
+                                delete $subdirInfo{Fixup};
+                            }
+                            # handle data blocks that we will transfer later
+                            if (ref $subdirInfo{ImageData}) {
+                                push @imageData, @{$subdirInfo{ImageData}};
+                                $$origDirInfo{ImageData} = \@imageData;
+                            }
+                            # temporarily set value to subdirectory index
+                            # (will set to actual offset later when we know what it is)
+                            $newValue .= Set32u(0xfeedf00d);
+                            my ($offset, $where);
+                            if ($readCount > 1) {
+                                $offset = length($valBuff) + $i * 4;
+                                $where = 'valBuff';
+                            } else {
+                                $offset = length($dirBuff) + 8;
+                                $where = 'dirBuff';
+                            }
+                            # add to list of subdirectories we will append later
+                            push @subdirs, {
+                                DataPt    => \$subdirData,
+                                Table     => $subTable,
+                                Fixup     => $subdirInfo{Fixup},
+                                Offset    => $offset,
+                                Where     => $where,
+                                ImageData => $subdirInfo{ImageData},
+                            };
+                            ++$writeCount;  # count number of subdirs written
+                        }
+                        next unless length $newValue;
+                        # must change location of subdir offset if we deleted
+                        # a directory and only one remains
+                        if ($writeCount < $readCount and $writeCount == 1) {
+                            $subdirs[-1]{Where} = 'dirBuff';
+                            $subdirs[-1]{Offset} = length($dirBuff) + 8;
+                        }
+                        # set new format to int32u for IFD
+                        $newFormName = $$newInfo{FixFormat} || 'int32u';
+                        $newFormat = $formatNumber{$newFormName};
+                        $newValuePt = \$newValue;
+
+                    } elsif ((not defined $$subdir{Start} or
+                             $$subdir{Start} =~ /\$valuePtr/) and
+                             $$subdir{TagTable})
+                    {
+#
+# rewrite other existing subdirectories ('$valuePtr' type only)
+#
+                        # set subdirectory Start and Base
+                        my $subdirStart = $valuePtr;
+                        if ($$subdir{Start}) {
+                            #### eval Start ($valuePtr)
+                            $subdirStart = eval $$subdir{Start};
+                            # must adjust directory size if start changed
+                            $oldSize -= $subdirStart - $valuePtr;
+                        }
+                        my $subdirBase = $base;
+                        if ($$subdir{Base}) {
+                            my $start = $subdirStart + $valueDataPos;
+                            #### eval Base ($start,$base)
+                            $subdirBase += eval $$subdir{Base};
+                        }
+                        my $subFixup = new Image::ExifTool::Fixup;
+                        my %subdirInfo = (
+                            Base     => $subdirBase,
+                            DataPt   => $valueDataPt,
+                            DataPos  => $valueDataPos - $subdirBase + $base,
+                            DataLen  => $valueDataLen,
+                            DirStart => $subdirStart,
+                            DirName  => $$subdir{DirName},
+                            DirLen   => $oldSize,
+                            Parent   => $dirName,
+                            Fixup    => $subFixup,
+                            RAF      => $raf,
+                            TagInfo  => $newInfo,
+                        );
+                        unless ($oldSize) {
+                            # replace with dummy data if empty to prevent WriteDirectory
+                            # routines from accessing data they shouldn't
+                            my $tmp = '';
+                            $subdirInfo{DataPt} = \$tmp;
+                            $subdirInfo{DataLen} = 0;
+                            $subdirInfo{DirStart} = 0;
+                            $subdirInfo{DataPos} += $subdirStart;
+                        }
+                        my $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
+                        my $oldOrder = GetByteOrder();
+                        SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
+                        $newValue = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
+                        SetByteOrder($oldOrder);
+                        if (defined $newValue) {
+                            my $hdrLen = $subdirStart - $valuePtr;
+                            if ($hdrLen) {
+                                $newValue = substr($$valueDataPt, $valuePtr, $hdrLen) . $newValue;
+                                $$subFixup{Start} += $hdrLen;
+                            }
+                            $newValuePt = \$newValue;
+                        } else {
+                            $newValuePt = \$oldValue;
+                        }
+                        unless (length $$newValuePt) {
+                            # don't delete a previously empty makernote directory
+                            next if $oldSize or not $inMakerNotes;
+                        }
+                        if ($$subFixup{Pointers} and $subdirInfo{Base} == $base) {
+                            $$subFixup{Start} += length $valBuff;
+                            push @valFixups, $subFixup;
+                        } else {
+                            # apply fixup in case we added a header ($hdrLen above)
+                            $subFixup->ApplyFixup(\$newValue);
+                        }
+                    }
+
+                } elsif ($$newInfo{OffsetPair}) {
+#
+# keep track of offsets
+#
+                    my $dataTag = $$newInfo{DataTag} || '';
+                    if ($dataTag eq 'CanonVRD') {
+                        # must decide now if we will write CanonVRD information
+                        my $hasVRD;
+                        if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonVRD}}) {
+                            # adding or deleting as a block
+                            $hasVRD = $et->GetNewValue('CanonVRD') ? 1 : 0;
+                        } elsif ($$et{DEL_GROUP}{CanonVRD} or
+                                 $$et{DEL_GROUP}{Trailer})
+                        {
+                            $hasVRD = 0;    # deleting as a group
+                        } else {
+                            $hasVRD = ($$newValuePt ne "\0\0\0\0");
+                        }
+                        if ($hasVRD) {
+                            # add a fixup, and set this offset later
+                            $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
+                        } else {
+                            # there is (or will soon be) no VRD information, so set pointer to zero
+                            $newValue = "\0" x length($$newValuePt);
+                            $newValuePt = \$newValue;
+                        }
+                    } elsif ($dataTag eq 'OriginalDecisionData') {
+                        # handle Canon OriginalDecisionData (no associated length tag)
+                        # - I'm going out of my way here to preserve data which is
+                        #   invalidated anyway by our edits
+                        my $odd;
+                        my $oddInfo = $Image::ExifTool::Composite{OriginalDecisionData};
+                        if ($oddInfo and $$et{NEW_VALUE}{$oddInfo}) {
+                            $odd = $et->GetNewValue($dataTag);
+                            if ($verbose > 1) {
+                                print $out "    - $dirName:$dataTag\n" if $$newValuePt ne "\0\0\0\0";
+                                print $out "    + $dirName:$dataTag\n" if $odd;
+                            }
+                            ++$$et{CHANGED};
+                        } elsif ($$newValuePt ne "\0\0\0\0") {
+                            if (length($$newValuePt) == 4) {
+                                require Image::ExifTool::Canon;
+                                my $offset = Get32u($newValuePt,0);
+                                # absolute offset in JPEG images only
+                                $offset += $base unless $$et{FILE_TYPE} eq 'JPEG';
+                                $odd = Image::ExifTool::Canon::ReadODD($et, $offset);
+                                $odd = $$odd if ref $odd;
+                            } else {
+                                $et->Error("Invalid $$newInfo{Name}",1);
+                            }
+                        }
+                        if ($odd) {
+                            my $newOffset = length($valBuff);
+                            # (ODD offset is absolute in JPEG, so add base offset!)
+                            $newOffset += $base if $$et{FILE_TYPE} eq 'JPEG';
+                            $newValue = Set32u($newOffset);
+                            $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
+                            $valBuff .= $odd;   # add original decision data
+                        } else {
+                            $newValue = "\0\0\0\0";
+                        }
+                        $newValuePt = \$newValue;
+                    } else {
+                        my $offsetInfo = $offsetInfo[$ifd];
+                        # save original values (for updating TIFF_END later)
+                        my @vals;
+                        if ($isNew <= 0) {
+                            my $oldOrder = GetByteOrder();
+                            # Minolta A200 stores these in the wrong byte order!
+                            SetByteOrder($$newInfo{ByteOrder}) if $$newInfo{ByteOrder};
+                            @vals = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
+                            SetByteOrder($oldOrder);
+                        }
+                        # only support int32 pointers (for now)
+                        if ($formatSize[$newFormat] != 4 and $$newInfo{IsOffset}) {
+                            $isNew > 0 and warn("Internal error (Offset not int32)"), return undef;
+                            $newCount != $readCount and warn("Wrong count!"), return undef;
+                            # change to int32
+                            $newFormName = 'int32u';
+                            $newFormat = $formatNumber{$newFormName};
+                            $newValue = WriteValue(join(' ',@vals), $newFormName, $newCount);
+                            unless (defined $newValue) {
+                                warn "Internal error writing offsets for $$newInfo{Name}\n";
+                                return undef;
+                            }
+                        }
+                        $offsetInfo or $offsetInfo = $offsetInfo[$ifd] = { };
+                        # save location of valuePtr in new directory
+                        # (notice we add 10 instead of 8 for valuePtr because
+                        # we will put a 2-byte count at start of directory later)
+                        my $ptr = $newStart + length($dirBuff) + 10;
+                        $newCount or $newCount = 1; # make sure count is set for offsetInfo
+                        # save value pointer and value count for each tag
+                        $$offsetInfo{$newID} = [$newInfo, $ptr, $newCount, \@vals, $newFormat];
+                    }
+
+                } elsif ($$newInfo{DataMember}) {
+
+                    # save any necessary data members (Make, Model, etc)
+                    my $formatStr = $newFormName;
+                    my $count = $newCount;
+                    # change to specified format if necessary
+                    if ($$newInfo{Format} and $$newInfo{Format} ne $formatStr) {
+                        $formatStr = $$newInfo{Format};
+                        my $format = $formatNumber{$formatStr};
+                        # adjust number of items for new format size
+                        $count = int(length($$newValuePt) / $formatSize[$format]) if $format;
+                    }
+                    my $val = ReadValue($newValuePt,0,$formatStr,$count,length($$newValuePt));
+                    my $conv = $$newInfo{RawConv};
+                    if ($conv) {
+                        # let the RawConv store the (possibly converted) data member
+                        if (ref $conv eq 'CODE') {
+                            &$conv($val, $et);
+                        } else {
+                            my ($self, $tag, $taginfo) = ($et, $$newInfo{Name}, $newInfo);
+                            #### eval RawConv ($self, $val, $tag, $tagInfo)
+                            eval $conv;
+                        }
+                    } else {
+                        $$et{$$newInfo{DataMember}} = $val;
+                    }
+                }
+            }
+#
+# write out the directory entry
+#
+            my $newSize = length($$newValuePt);
+            my $fsize = $formatSize[$newFormat];
+            my $offsetVal;
+            $newCount = int(($newSize + $fsize - 1) / $fsize);  # set proper count
+            if ($newSize > 4) {
+                # zero-pad to an even number of bytes (required by EXIF standard)
+                # and make sure we are a multiple of the format size
+                while ($newSize & 0x01 or $newSize < $newCount * $fsize) {
+                    $$newValuePt .= "\0";
+                    ++$newSize;
+                }
+                my $entryBased;
+                if ($$dirInfo{EntryBased} or ($newInfo and $$newInfo{EntryBased})) {
+                    $entryBased = 1;
+                    $offsetVal = Set32u(length($valBuff) - length($dirBuff));
+                } else {
+                    $offsetVal = Set32u(length $valBuff);
+                }
+                my ($dataTag, $putFirst);
+                ($dataTag, $putFirst) = @$newInfo{'DataTag','PutFirst'} if $newInfo;
+                if ($dataTag) {
+                    if ($dataTag eq 'PreviewImage' and ($$et{FILE_TYPE} eq 'JPEG' or
+                        $$et{GENERATE_PREVIEW_INFO}))
+                    {
+                        # hold onto the PreviewImage until we can determine if it fits
+                        $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
+                            Data => $$newValuePt,
+                            Fixup => new Image::ExifTool::Fixup,
+                        };
+                        $$et{PREVIEW_INFO}{ChangeBase} = 1 if $$newInfo{ChangeBase};
+                        if ($$newInfo{IsOffset} and $$newInfo{IsOffset} eq '2') {
+                            $$et{PREVIEW_INFO}{NoBaseShift} = 1;
+                        }
+                        # use original preview size if we will attempt to load it later
+                        $newCount = $oldCount if $$newValuePt eq 'LOAD_PREVIEW';
+                        $$newValuePt = '';
+                    } elsif ($dataTag eq 'LeicaTrailer' and $$et{LeicaTrailer}) {
+                        $$newValuePt = '';
+                    }
+                }
+                if ($putFirst and $$dirInfo{HeaderPtr}) {
+                    my $hdrPtr = $$dirInfo{HeaderPtr};
+                    # place this value immediately after the TIFF header (eg. IIQ maker notes)
+                    $offsetVal = Set32u(length $$hdrPtr);
+                    $$hdrPtr .= $$newValuePt;
+                } else {
+                    $valBuff .= $$newValuePt;       # add value data to buffer
+                    # must save a fixup pointer for every pointer in the directory
+                    if ($entryBased) {
+                        $entryBasedFixup or $entryBasedFixup = new Image::ExifTool::Fixup;
+                        $entryBasedFixup->AddFixup(length($dirBuff) + 8, $dataTag);
+                    } else {
+                        $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
+                    }
+                }
+            } else {
+                $offsetVal = $$newValuePt;      # save value in offset if 4 bytes or less
+                # must pad value with zeros if less than 4 bytes
+                $newSize < 4 and $offsetVal .= "\0" x (4 - $newSize);
+            }
+            # write the directory entry
+            $dirBuff .= Set16u($newID) . Set16u($newFormat) .
+                        Set32u($newCount) . $offsetVal;
+            # update flag to keep track of mandatory tags
+            while (defined $allMandatory) {
+                if (defined $$mandatory{$newID}) {
+                    # values must correspond to mandatory values
+                    my $form = $$newInfo{Format} || $newFormName;
+                    my $mandVal = WriteValue($$mandatory{$newID}, $form, $newCount);
+                    if (defined $mandVal and $mandVal eq $$newValuePt) {
+                        ++$allMandatory;        # count mandatory tags
+                        last;
+                    }
+                }
+                undef $deleteAll;
+                undef $allMandatory;
+            }
+        }
+        if ($ignoreCount) {
+            my $y = $ignoreCount > 1 ? 'ies' : 'y';
+            my $verb = $$dirInfo{FixBase} ? 'Ignored' : 'Removed';
+            $et->Warn("$verb $ignoreCount invalid entr$y from $name", 1);
+        }
+        if ($fixCount) {
+            my $s = $fixCount > 1 ? 's' : '';
+            $et->Warn("Fixed invalid count$s for $fixCount $name tag$s", 1);
+        }
+#..............................................................................
+# write directory counts and nextIFD pointer and add value data to end of IFD
+#
+        # determine now if there is or will be another IFD after this one
+        my $nextIfdOffset;
+        if ($dirEnd + 4 <= $dataLen) {
+            $nextIfdOffset = Get32u($dataPt, $dirEnd);
+        } else {
+            $nextIfdOffset = 0;
+        }
+        my $isNextIFD = ($$dirInfo{Multi} and ($nextIfdOffset or
+                        # account for the case where we will create the next IFD
+                        # (IFD1 only, but not in TIFF-format images)
+                        ($dirName eq 'IFD0' and $$et{ADD_DIRS}{'IFD1'} and
+                         $$et{FILE_TYPE} ne 'TIFF')));
+        # calculate number of entries in new directory
+        my $newEntries = length($dirBuff) / 12;
+        # delete entire directory if we deleted a tag and only mandatory tags remain or we
+        # attempted to create a directory with only mandatory tags and there is no nextIFD
+        if ($allMandatory and not $isNextIFD and ($newEntries < $numEntries or $numEntries == 0)) {
+            $newEntries = 0;
+            $dirBuff = '';
+            $valBuff = '';
+            undef $dirFixup;    # no fixups in this directory
+            ++$deleteAll if defined $deleteAll;
+            $verbose > 1 and print $out "    - $allMandatory mandatory tag(s)\n";
+            $$et{CHANGED} -= $addMandatory;    # didn't change these after all
+        }
+        if ($ifd and not $newEntries) {
+            $verbose and print $out "  Deleting IFD1\n";
+            last;   # don't write IFD1 if empty
+        }
+        # apply one-time fixup for entry-based offsets
+        if ($entryBasedFixup) {
+            $$entryBasedFixup{Shift} = length($dirBuff) + 4;
+            $entryBasedFixup->ApplyFixup(\$dirBuff);
+            undef $entryBasedFixup;
+        }
+        # initialize next IFD pointer to zero
+        my $nextIFD = Set32u(0);
+        # some cameras use a different amount of padding after the makernote IFD
+        if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/) {
+            my ($rel, $pad) = Image::ExifTool::MakerNotes::GetMakerNoteOffset($et);
+            $nextIFD = "\0" x $pad if defined $pad and ($pad==0 or ($pad>4 and $pad<=32));
+        }
+        # add directory entry count to start of IFD and next IFD pointer to end
+        $newData .= Set16u($newEntries) . $dirBuff . $nextIFD;
+        # get position of value data in newData
+        my $valPos = length($newData);
+        # go back now and set next IFD pointer if this isn't the first IFD
+        if ($nextIfdPos) {
+            # set offset to next IFD
+            Set32u($newStart, \$newData, $nextIfdPos);
+            $fixup->AddFixup($nextIfdPos,'NextIFD');    # add fixup for this offset in newData
+        }
+        # remember position of 'next IFD' pointer so we can set it next time around
+        $nextIfdPos = length($nextIFD) ? $valPos - length($nextIFD) : undef;
+        # add value data after IFD
+        $newData .= $valBuff;
+#
+# add any subdirectories, adding fixup information
+#
+        if (@subdirs) {
+            my $subdir;
+            foreach $subdir (@subdirs) {
+                my $len = length($newData);         # position of subdirectory in data
+                my $subdirFixup = $$subdir{Fixup};
+                if ($subdirFixup) {
+                    $$subdirFixup{Start} += $len;
+                    $fixup->AddFixup($subdirFixup);
+                }
+                my $imageData = $$subdir{ImageData};
+                my $blockSize = 0;
+                # must also update start position for ImageData fixups
+                if (ref $imageData) {
+                    my $blockInfo;
+                    foreach $blockInfo (@$imageData) {
+                        my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
+                        if ($subFix) {
+                            $$subFix{Start} += $len;
+                            # save expected image data offset for calculating shift later
+                            $$subFix{BlockLen} = length(${$$subdir{DataPt}}) + $blockSize;
+                        }
+                        $blockSize += $size + $pad;
+                    }
+                }
+                $newData .= ${$$subdir{DataPt}};    # add subdirectory to our data
+                undef ${$$subdir{DataPt}};          # free memory now
+                # set the pointer
+                my $offset = $$subdir{Offset};
+                # if offset is in valBuff, it was added to the end of dirBuff
+                # (plus 4 bytes for nextIFD pointer)
+                $offset += length($dirBuff) + 4 if $$subdir{Where} eq 'valBuff';
+                $offset += $newStart + 2;           # get offset in newData
+                # check to be sure we got the right offset
+                unless (Get32u(\$newData, $offset) == 0xfeedf00d) {
+                    $et->Error("Internal error while rewriting $name");
+                    return undef;
+                }
+                # set the offset to the subdirectory data
+                Set32u($len, \$newData, $offset);
+                $fixup->AddFixup($offset);  # add fixup for this offset in newData
+            }
+        }
+        # add fixup for all offsets in directory according to value data position
+        # (which is at the end of this directory)
+        if ($dirFixup) {
+            $$dirFixup{Start} = $newStart + 2;
+            $$dirFixup{Shift} = $valPos - $$dirFixup{Start};
+            $fixup->AddFixup($dirFixup);
+        }
+        # add valueData fixups, adjusting for position of value data
+        my $valFixup;
+        foreach $valFixup (@valFixups) {
+            $$valFixup{Start} += $valPos;
+            $fixup->AddFixup($valFixup);
+        }
+        # stop if no next IFD pointer
+        last unless $isNextIFD;   # stop unless scanning for multiple IFD's
+        if ($nextIfdOffset) {
+            # continue with next IFD
+            $dirStart = $nextIfdOffset - $dataPos;
+        } else {
+            # create IFD1 if necessary
+            $verbose and print $out "  Creating IFD1\n";
+            my $ifd1 = "\0" x 2;  # empty IFD1 data (zero entry count)
+            $dataPt = \$ifd1;
+            $dirStart = 0;
+            $dirLen = $dataLen = 2;
+        }
+        # increment IFD name
+        my $ifdNum = $dirName =~ s/(\d+)$// ? $1 : 0;
+        $dirName .= $ifdNum + 1;
+        $name =~ s/\d+$//;
+        $name .= $ifdNum + 1;
+        $$et{DIR_NAME} = $$et{PATH}[-1] = $dirName;
+        next unless $nextIfdOffset;
+
+        # guard against writing the same directory twice
+        my $addr = $nextIfdOffset + $base;
+        if ($$et{PROCESSED}{$addr}) {
+            $et->Error("$name pointer references previous $$et{PROCESSED}{$addr} directory", 1);
+            last;
+        }
+        $$et{PROCESSED}{$addr} = $name;
+
+        if ($dirName eq 'SubIFD1' and not ValidateIFD($dirInfo, $dirStart)) {
+            if ($$et{TIFF_TYPE} eq 'TIFF') {
+                $et->Error('Ignored bad IFD linked from SubIFD', 1);
+            } elsif ($verbose) {
+                $et->Warn('Ignored bad IFD linked from SubIFD');
+            }
+            last;   # don't write bad IFD
+        }
+        if ($$et{DEL_GROUP}{$dirName}) {
+            $verbose and print $out "  Deleting $dirName\n";
+            $raf and $et->Error("Deleting $dirName also deletes subsequent" .
+                                      " IFD's and possibly image data", 1);
+            ++$$et{CHANGED};
+            if ($$et{DEL_GROUP}{$dirName} == 2 and
+                $$et{ADD_DIRS}{$dirName})
+            {
+                my $emptyIFD = "\0" x 2;    # start with empty IFD
+                $dataPt = \$emptyIFD;
+                $dirStart = 0;
+                $dirLen = $dataLen = 2;
+            } else {
+                last;   # don't write this IFD (or any subsequent IFD)
+            }
+        } else {
+            $verbose and print $out "  Rewriting $name\n";
+        }
+    }
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+    # do our fixups now so we can more easily calculate offsets below
+    $fixup->ApplyFixup(\$newData);
+#
+# determine total block size for deferred data
+#
+    my $numBlocks = scalar @imageData;  # save this so we scan only existing blocks later
+    my $blockSize = 0;  # total size of blocks to copy later
+    my $blockInfo;
+    foreach $blockInfo (@imageData) {
+        my ($pos, $size, $pad) = @$blockInfo;
+        $blockSize += $size + $pad;
+    }
+#
+# copy over image data for IFD's, starting with the last IFD first
+#
+    if (@offsetInfo) {
+        my $ttwLen;     # length of MRW TTW segment
+        my @writeLater; # write image data last
+        for ($ifd=$#offsetInfo; $ifd>=-1; --$ifd) {
+            # build list of offsets to process
+            my @offsetList;
+            if ($ifd >= 0) {
+                my $offsetInfo = $offsetInfo[$ifd] or next;
+                # patch Panasonic RAW/RW2 StripOffsets/StripByteCounts if necessary
+                my $stripOffsets = $$offsetInfo{0x111};
+                if ($stripOffsets and $$stripOffsets[0]{PanasonicHack}) {
+                    require Image::ExifTool::PanasonicRaw;
+                    my $err = Image::ExifTool::PanasonicRaw::PatchRawDataOffset($offsetInfo, $raf, $ifd);
+                    $err and $et->Error($err);
+                }
+                my $tagID;
+                # loop through all tags in reverse order so we save thumbnail
+                # data before main image data if both exist in the same IFD
+                foreach $tagID (reverse sort keys %$offsetInfo) {
+                    my $tagInfo = $$offsetInfo{$tagID}[0];
+                    next unless $$tagInfo{IsOffset}; # handle byte counts with offsets
+                    my $sizeInfo = $$offsetInfo{$$tagInfo{OffsetPair}};
+                    $sizeInfo or $et->Error("No size tag for $dirName:$$tagInfo{Name}"), next;
+                    my $dataTag = $$tagInfo{DataTag};
+                    # write TIFF image data (strips or tiles) later if requested
+                    if ($raf and defined $$origDirInfo{ImageData} and
+                        ($tagID == 0x111 or $tagID == 0x144 or
+                          # also defer writing of other big data such as JpgFromRaw in NEF
+                          ($$sizeInfo[3][0] and
+                           # (calculate approximate combined size of all blocks)
+                           $$sizeInfo[3][0] * scalar(@{$$sizeInfo[3]}) > 1000000)) and
+                        # but don't defer writing if replacing with new value
+                        (not defined $dataTag or not defined $offsetData{$dataTag}))
+                    {
+                        push @writeLater, [ $$offsetInfo{$tagID}, $sizeInfo ];
+                    } else {
+                        push @offsetList, [ $$offsetInfo{$tagID}, $sizeInfo ];
+                    }
+                }
+            } else {
+                last unless @writeLater;
+                @offsetList = @writeLater;
+            }
+            my $offsetPair;
+            foreach $offsetPair (@offsetList) {
+                my ($tagInfo, $offsets, $count, $oldOffset) = @{$$offsetPair[0]};
+                my ($cntInfo, $byteCounts, $count2, $oldSize, $format) = @{$$offsetPair[1]};
+                # must be the same number of offset and byte count values
+                unless ($count == $count2) {
+                    $et->Error("Offsets/ByteCounts disagree on count for $$tagInfo{Name}");
+                    return undef;
+                }
+                my $formatStr = $formatName[$format];
+                # follow pointer to value data if necessary
+                $count > 1 and $offsets = Get32u(\$newData, $offsets);
+                my $n = $count * $formatSize[$format];
+                $n > 4 and $byteCounts = Get32u(\$newData, $byteCounts);
+                if ($byteCounts < 0 or $byteCounts + $n > length($newData)) {
+                    $et->Error("Error reading $$tagInfo{Name} byte counts");
+                    return undef;
+                }
+                # get offset base and data pos (abnormal for some preview images)
+                my ($dbase, $dpos, $wrongBase, $subIfdDataFixup);
+                if ($$tagInfo{IsOffset} eq '2') {
+                    $dbase = $firstBase;
+                    $dpos = $dataPos + $base - $firstBase;
+                } else {
+                    $dbase = $base;
+                    $dpos = $dataPos;
+                }
+                # use different base if necessary for some offsets (Minolta A200)
+                if ($$tagInfo{WrongBase}) {
+                    my $self = $et;
+                    #### eval WrongBase ($self)
+                    $wrongBase = eval $$tagInfo{WrongBase} || 0;
+                    $dbase += $wrongBase;
+                    $dpos -= $wrongBase;
+                } else {
+                    $wrongBase = 0;
+                }
+                my $oldOrder = GetByteOrder();
+                my $dataTag = $$tagInfo{DataTag};
+                # use different byte order for values of this offset pair if required (Minolta A200)
+                SetByteOrder($$tagInfo{ByteOrder}) if $$tagInfo{ByteOrder};
+                # transfer the data referenced by all offsets of this tag
+                for ($n=0; $n<$count; ++$n) {
+                    my ($oldEnd, $size);
+                    if (@$oldOffset and @$oldSize) {
+                        # calculate end offset of this block
+                        $oldEnd = $$oldOffset[$n] + $$oldSize[$n];
+                        # update TIFF_END as if we read this data from file
+                        UpdateTiffEnd($et, $oldEnd + $dbase);
+                    }
+                    my $offsetPos = $offsets + $n * 4;
+                    my $byteCountPos = $byteCounts + $n * $formatSize[$format];
+                    if ($$tagInfo{PanasonicHack}) {
+                        # use actual raw data length (may be different than StripByteCounts!)
+                        $size = $$oldSize[$n];
+                    } else {
+                        # use size of new data
+                        $size = ReadValue(\$newData, $byteCountPos, $formatStr, 1, 4);
+                    }
+                    my $offset = $$oldOffset[$n];
+                    if (defined $offset) {
+                        $offset -= $dpos;
+                    } elsif ($size != 0xfeedfeed) {
+                        $et->Error('Internal error (no offset)');
+                        return undef;
+                    }
+                    my $newOffset = length($newData) - $wrongBase;
+                    my $buff;
+                    # look for 'feed' code to use our new data
+                    if ($size == 0xfeedfeed) {
+                        unless (defined $dataTag) {
+                            $et->Error("No DataTag defined for $$tagInfo{Name}");
+                            return undef;
+                        }
+                        unless (defined $offsetData{$dataTag}) {
+                            $et->Error("Internal error (no $dataTag)");
+                            return undef;
+                        }
+                        if ($count > 1) {
+                            $et->Error("Can't modify $$tagInfo{Name} with count $count");
+                            return undef;
+                        }
+                        $buff = $offsetData{$dataTag};
+                        if ($formatSize[$format] != 4) {
+                            $et->Error("$$cntInfo{Name} is not int32");
+                            return undef;
+                        }
+                        # set the data size
+                        $size = length($buff);
+                        Set32u($size, \$newData, $byteCountPos);
+                    } elsif ($ifd < 0) {
+                        # pad if necessary (but don't pad contiguous image blocks)
+                        my $pad = 0;
+                        ++$pad if $size & 0x01 and ($n+1 >= $count or not $oldEnd or
+                                  $oldEnd != $$oldOffset[$n+1]);
+                        # preserve original image padding if specified
+                        if ($$origDirInfo{PreserveImagePadding} and $n+1 < $count and
+                            $oldEnd and $$oldOffset[$n+1] > $oldEnd)
+                        {
+                            $pad = $$oldOffset[$n+1] - $oldEnd;
+                        }
+                        # copy data later
+                        push @imageData, [$offset+$dbase+$dpos, $size, $pad];
+                        $newOffset += $blockSize;   # data comes after other deferred data
+                        # create fixup for SubIFD ImageData
+                        if ($imageDataFlag eq 'SubIFD' and not $subIfdDataFixup) {
+                            $subIfdDataFixup = new Image::ExifTool::Fixup;
+                            $imageData[-1][4] = $subIfdDataFixup;
+                        }
+                        $size += $pad; # account for pad byte if necessary
+                        # return ImageData list
+                        $$origDirInfo{ImageData} = \@imageData;
+                    } elsif ($offset >= 0 and $offset+$size <= $dataLen) {
+                        # take data from old dir data buffer
+                        $buff = substr($$dataPt, $offset, $size);
+                    } elsif ($$et{TIFF_TYPE} eq 'MRW') {
+                        # TTW segment must be an even 4 bytes long, so pad now if necessary
+                        my $n = length $newData;
+                        $buff = ($n & 0x03) ? "\0" x (4 - ($n & 0x03)) : '';
+                        $size = length($buff);
+                        # data exists after MRW TTW segment
+                        $ttwLen = length($newData) + $size unless defined $ttwLen;
+                        $newOffset = $offset + $dpos + $ttwLen - $dataLen;
+                    } elsif ($raf and $raf->Seek($offset+$dbase+$dpos,0) and
+                             $raf->Read($buff,$size) == $size)
+                    {
+                        # (data was read OK)
+                        # patch incorrect ThumbnailOffset in Sony A100 1.00 ARW images
+                        if ($$et{TIFF_TYPE} eq 'ARW' and $$tagInfo{Name} eq 'ThumbnailOffset' and
+                            $$et{Model} eq 'DSLR-A100' and $buff !~ /^\xff\xd8\xff/)
+                        {
+                            my $pos = $offset + $dbase + $dpos;
+                            my $try;
+                            if ($pos < 0x10000 and $raf->Seek($pos+0x10000,0) and
+                                $raf->Read($try,$size) == $size and $try =~ /^\xff\xd8\xff/)
+                            {
+                                $buff = $try;
+                                $et->Warn('Adjusted incorrect A100 ThumbnailOffset', 1);
+                            } else {
+                                $et->Error('Invalid ThumbnailImage');
+                            }
+                        }
+                    } elsif ($$tagInfo{Name} eq 'ThumbnailOffset' and $offset>=0 and $offset<$dataLen) {
+                        # Grrr.  The Canon 350D writes the thumbnail with an incorrect byte count
+                        my $diff = $offset + $size - $dataLen;
+                        $et->Warn("ThumbnailImage runs outside EXIF data by $diff bytes (truncated)",1);
+                        # set the size to the available data
+                        $size -= $diff;
+                        unless (WriteValue($size, $formatStr, 1, \$newData, $byteCountPos)) {
+                            warn 'Internal error writing thumbnail size';
+                        }
+                        # get the truncated image
+                        $buff = substr($$dataPt, $offset, $size);
+                    } elsif ($$tagInfo{Name} eq 'PreviewImageStart' and $$et{FILE_TYPE} eq 'JPEG') {
+                        # try to load the preview image using the specified offset
+                        undef $buff;
+                        my $r = $$et{RAF};
+                        if ($r and not $raf) {
+                            my $tell = $r->Tell();
+                            # read and validate
+                            undef $buff unless $r->Seek($offset+$base+$dataPos,0) and
+                                               $r->Read($buff,$size) == $size and
+                                               $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/s;
+                            $r->Seek($tell, 0) or $et->Error('Seek error'), return undef;
+                        }
+                        # set flag if we must load PreviewImage
+                        $buff = 'LOAD_PREVIEW' unless defined $buff;
+                    } else {
+                        my $dataName = $dataTag || $$tagInfo{Name};
+                        return undef if $et->Error("Error reading $dataName data in $name", $inMakerNotes);
+                        $buff = '';
+                    }
+                    if ($$tagInfo{Name} eq 'PreviewImageStart') {
+                        if ($$et{FILE_TYPE} eq 'JPEG' and not $$tagInfo{MakerPreview}) {
+                            # hold onto the PreviewImage until we can determine if it fits
+                            $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
+                                Data => $buff,
+                                Fixup => new Image::ExifTool::Fixup,
+                            };
+                            if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '2') {
+                                $$et{PREVIEW_INFO}{NoBaseShift} = 1;
+                            }
+                            if ($offset >= 0 and $offset+$size <= $dataLen) {
+                                # set flag indicating this preview wasn't in a trailer
+                                $$et{PREVIEW_INFO}{WasContained} = 1;
+                            }
+                            $buff = '';
+                        } elsif ($$et{TIFF_TYPE} eq 'ARW' and $$et{Model}  eq 'DSLR-A100') {
+                            # the A100 double-references the same preview, so ignore the
+                            # second one (the offset and size will be patched later)
+                            next if $$et{A100PreviewLength};
+                            $$et{A100PreviewLength} = length $buff if defined $buff;
+                        }
+                    }
+                    # update offset accordingly and add to end of new data
+                    Set32u($newOffset, \$newData, $offsetPos);
+                    # add a pointer to fix up this offset value (marked with DataTag name)
+                    $fixup->AddFixup($offsetPos, $dataTag);
+                    # also add to subIfdDataFixup if necessary
+                    $subIfdDataFixup->AddFixup($offsetPos, $dataTag) if $subIfdDataFixup;
+                    # must also (sometimes) update StripOffsets in Panasonic RW2 images
+                    my $otherPos = $$offsetPair[0][5];
+                    if ($otherPos and $$tagInfo{PanasonicHack}) {
+                        Set32u($newOffset, \$newData, $otherPos);
+                        $fixup->AddFixup($otherPos, $dataTag);
+                    }
+                    if ($ifd >= 0) {
+                        # buff length must be even (Note: may have changed since $size was set)
+                        $buff .= "\0" if length($buff) & 0x01;
+                        $newData .= $buff;      # add this strip to the data
+                    } else {
+                        $blockSize += $size;    # keep track of total size
+                    }
+                }
+                SetByteOrder($oldOrder);
+            }
+        }
+        # verify that nothing else got written after determining TTW length
+        if (defined $ttwLen and $ttwLen != length($newData)) {
+            $et->Error('Internal error writing MRW TTW');
+        }
+    }
+#
+# set offsets and generate fixups for tag values which were too large for memory
+#
+    $blockSize = 0;
+    foreach $blockInfo (@imageData) {
+        my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
+        if (defined $entry) {
+            my $format = Get16u(\$newData, $entry + 2);
+            if ($format < 1 or $format > 13) {
+                $et->Error('Internal error copying huge value');
+                last;
+            } else {
+                # set count and offset in directory entry
+                Set32u($size / $formatSize[$format], \$newData, $entry + 4);
+                Set32u(length($newData)+$blockSize, \$newData, $entry + 8);
+                $fixup->AddFixup($entry + 8);
+                # create special fixup for SubIFD data
+                if ($imageDataFlag eq 'SubIFD') {
+                    my $subIfdDataFixup = new Image::ExifTool::Fixup;
+                    $subIfdDataFixup->AddFixup($entry + 8);
+                    # save fixup in imageData list
+                    $$blockInfo[4] = $subIfdDataFixup;
+                }
+                # must reset entry pointer so we don't use it again in a parent IFD!
+                $$blockInfo[3] = undef;
+            }
+        }
+        # apply additional shift required for contained SubIFD image data offsets
+        if ($subFix and defined $$subFix{BlockLen} and $numBlocks > 0) {
+            # our offset expects the data at the end of the SubIFD block (BlockLen + Start),
+            # but it will actually be at length($newData) + $blockSize.  So adjust
+            # accordingly (and subtract an extra Start because this shift is applied later)
+            $$subFix{Shift} += length($newData) - $$subFix{BlockLen} - 2 * $$subFix{Start} + $blockSize;
+            $subFix->ApplyFixup(\$newData);
+        }
+        $blockSize += $size + $pad;
+        --$numBlocks;
+    }
+#
+# apply final shift to new data position if this is the top level IFD
+#
+    unless ($$dirInfo{Fixup}) {
+        my $hdrPtr = $$dirInfo{HeaderPtr};
+        my $newDataPos = $hdrPtr ? length $$hdrPtr : $$dirInfo{NewDataPos} || 0;
+        # adjust CanonVRD offset to point to end of regular TIFF if necessary
+        # (NOTE: This will be incorrect if multiple trailers exist,
+        #  but it is unlikely that it could ever be correct in this case anyway.
+        #  Also, this doesn't work for JPEG images (but CanonDPP doesn't set
+        #  this when editing JPEG images anyway))
+        $fixup->SetMarkerPointers(\$newData, 'CanonVRD', length($newData) + $blockSize);
+        if ($newDataPos) {
+            $$fixup{Shift} += $newDataPos;
+            $fixup->ApplyFixup(\$newData);
+        }
+        # save fixup for adjusting Leica trailer offset if necessary
+        $$et{LeicaTrailer}{Fixup}->AddFixup($fixup) if $$et{LeicaTrailer};
+        # save fixup for PreviewImage in JPEG file if necessary
+        my $previewInfo = $$et{PREVIEW_INFO};
+        if ($previewInfo) {
+            my $pt = \$$previewInfo{Data}; # image data or 'LOAD_PREVIEW' flag
+            # now that we know the size of the EXIF data, first test to see if our new image fits
+            # inside the EXIF segment (remember about the TIFF and EXIF headers: 8+6 bytes)
+            if (($$pt ne 'LOAD_PREVIEW' and length($$pt) + length($newData) + 14 <= 0xfffd and
+                not $$previewInfo{IsTrailer}) or
+                $$previewInfo{IsShort}) # must fit in this segment if using short pointers
+            {
+                # It fits! (or must exist in EXIF segment), so fixup the
+                # PreviewImage pointers and stuff the preview image in here
+                my $newPos = length($newData) + $newDataPos;
+                $newPos += ($$previewInfo{BaseShift} || 0);
+                if ($$previewInfo{Relative}) {
+                    # calculate our base by looking at how far the pointer got shifted
+                    $newPos -= ($fixup->GetMarkerPointers(\$newData, 'PreviewImage') || 0);
+                }
+                $fixup->SetMarkerPointers(\$newData, 'PreviewImage', $newPos);
+                $newData .= $$pt;
+                # set flag to delete old preview unless it was contained in the EXIF
+                $$et{DEL_PREVIEW} = 1 unless $$et{PREVIEW_INFO}{WasContained};
+                delete $$et{PREVIEW_INFO};   # done with our preview data
+            } else {
+                # Doesn't fit, or we still don't know, so save fixup information
+                # and put the preview at the end of the file
+                $$previewInfo{Fixup} or $$previewInfo{Fixup} = new Image::ExifTool::Fixup;
+                $$previewInfo{Fixup}->AddFixup($fixup);
+            }
+        } elsif (defined $newData and $deleteAll) {
+            $newData = '';  # delete both IFD0 and IFD1 since only mandatory tags remain
+        } elsif ($$et{A100PreviewLength}) {
+            # save preview image start for patching A100 quirks later
+            $$et{A100PreviewStart} = $fixup->GetMarkerPointers(\$newData, 'PreviewImage');
+        }
+        # save location of last IFD for use in Canon RAW header
+        if ($newDataPos == 16) {
+            my @ifdPos = $fixup->GetMarkerPointers(\$newData,'NextIFD');
+            $$origDirInfo{LastIFD} = pop @ifdPos;
+        }
+        # recrypt SR2 SubIFD data if necessary
+        my $key = $$et{SR2SubIFDKey};
+        if ($key) {
+            my $start = $fixup->GetMarkerPointers(\$newData, 'SR2SubIFDOffset');
+            my $len = $$et{SR2SubIFDLength};
+            # (must subtract 8 for size of TIFF header)
+            if ($start and $start - 8 + $len <= length $newData) {
+                require Image::ExifTool::Sony;
+                Image::ExifTool::Sony::Decrypt(\$newData, $start - 8, $len, $key);
+            }
+        }
+    }
+    # return empty string if no entries in directory
+    # (could be up to 10 bytes and still be empty)
+    $newData = '' if defined $newData and length($newData) < 12;
+
+    return $newData;    # return our directory data
+}
+
+1; # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WriteExif.pl - Write EXIF meta information
+
+=head1 SYNOPSIS
+
+This file is autoloaded by Image::ExifTool::Exif.
+
+=head1 DESCRIPTION
+
+This file contains routines to write EXIF metadata.
+
+=head1 AUTHOR
+
+Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::Exif(3pm)|Image::ExifTool::Exif>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut