exiftool_vendored 9.78.0 → 9.99.0

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

@@ -0,0 +1,358 @@
+#------------------------------------------------------------------------------
+# File:         WriteQuickTime.pl
+#
+# Description:  Write XMP to QuickTime (MOV and MP4) files
+#
+# Revisions:    2013-10-29 - P. Harvey Created
+#------------------------------------------------------------------------------
+package Image::ExifTool::QuickTime;
+
+use strict;
+
+# map for adding directories to QuickTime-format files
+my %movMap = (
+    # MOV (no 'ftyp', or 'ftyp'='qt  ') -> 'moov'-'udta'-'XMP_'
+    XMP      => 'UserData',
+    UserData => 'Movie',
+    Movie    => 'MOV',
+);
+my %mp4Map = (
+    # MP4 ('ftyp' compatible brand 'mp41', 'mp42' or 'f4v ') -> top level 'uuid'
+    XMP => 'MOV',
+);
+my %dirMap = (
+    MOV => \%movMap,
+    MP4 => \%mp4Map,
+);
+
+#------------------------------------------------------------------------------
+# Check to see if path is current
+# Inputs: 0) ExifTool object ref, 1) directory name
+# Returns: true if current path is the root of the specified directory
+sub IsCurPath($$)
+{
+    local $_;
+    my ($et, $dir) = @_;
+    $dir = $$et{DirMap}{$dir} and $dir eq $_ or last foreach reverse @{$$et{PATH}}; 
+    return($dir and $dir eq 'MOV');    
+}
+
+#------------------------------------------------------------------------------
+# Write a series of QuickTime atoms from file or in memory
+# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
+# Returns: A) if dirInfo contains DataPt: new directory data
+#          B) otherwise: true on success, 0 if a write error occurred
+#             (true but sets an Error on a file format error)
+sub WriteQuickTime($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    my ($foundMDAT, @hold, $track);
+    my $outfile = $$dirInfo{OutFile} or return 0;
+    my $raf = $$dirInfo{RAF};
+    my $dataPt = $$dirInfo{DataPt};
+    my $dirName = $$dirInfo{DirName};
+    my $parent = $$dirInfo{Parent};
+    my $addDirs = $$et{ADD_DIRS};
+    my $rtnVal = 1;
+
+    if ($dataPt) {
+        $raf = new File::RandomAccess($dataPt);
+        my $outBuff = '';
+        $outfile = \$outBuff;
+    } else {
+        return 0 unless $raf;
+    }
+    for (;;) {
+        my ($hdr, $buff);
+        my $n = $raf->Read($hdr, 8);
+        unless ($n == 8) {
+            if ($n == 4 and $hdr eq "\0\0\0\0") {
+                # "for historical reasons" the udta is optionally terminated by 4 zeros (ref 1)
+                # --> hold this terminator to the end
+                push @hold, $hdr;
+            } elsif ($n != 0) {
+                $et->Error('File format error');
+            }
+            last;
+        }
+        my ($size, $tag) = unpack('Na4', $hdr);
+        if ($size >= 8) {
+            $size -= 8;
+        } elsif ($size == 1) {
+            # read the extended size
+            $raf->Read($buff, 8) == 8 or $et->Error('Truncated extended atom'), last;
+            $hdr .= $buff;
+            my ($hi, $lo) = unpack('NN', $buff);
+            $size = $hi * 4294967296 + $lo - 16;
+            $size < 0 and $et->Error('Invalid extended atom size'), last;
+        } elsif (not $size and not $dataPt) {
+            # size of zero is only valid for top-level atom, and
+            # indicates the atom extends to the end of file
+            if (not $raf->{FILE_PT}) {
+                # get file size from image in memory
+                $size = length ${$$raf{BUFF_PT}};
+            } else {
+                $size = -s $$raf{FILE_PT};
+            }
+            if ($size and ($size -= $raf->Tell()) >= 0 and $size <= 0x7fffffff) {
+                Set32u($size + 8, \$hdr, 0);
+            } elsif (@hold) {
+                $et->Error("Sorry, can't yet add tags to this type of QuickTime file");
+                return $rtnVal;
+            } else {
+                # blindly copy the rest of the file
+                Write($outfile, $hdr) or $rtnVal = 0;
+                while ($raf->Read($buff, 65536)) {
+                    Write($outfile, $buff) or $rtnVal = 0, last;
+                }
+                return $rtnVal;
+            }
+        } else {
+            $et->Error('Invalid atom size');
+            last;
+        }
+
+        # set flag if we have passed the 'mdat' atom
+        $foundMDAT = 1 if $tag eq 'mdat';
+
+        # rewrite this atom
+        my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
+        if (defined $tagInfo and not $tagInfo) {
+            my $n = $size < 256 ? $size : 256;
+            unless ($raf->Read($buff, $n) == $n and $raf->Seek(-$n, 1)) {
+                $et->Error("Read/seek error in $tag atom");
+                last;
+            }
+            $tagInfo = $et->GetTagInfo($tagTablePtr, $tag, \$buff);
+        }
+        if ($tagInfo) {
+            if ($$tagInfo{Unknown}) {
+                undef $tagInfo;
+            } elsif ($size > 100000000) {
+                # limit maximum size of atom that we load into memory
+                my $mb = $size / 0x100000;
+                $et->Warn("Not editing metadata in $tag atom. $mb MB is too big");
+                undef $tagInfo;
+            }
+        }
+        if ($tagInfo) {
+            # read the atom data
+            $raf->Read($buff, $size) == $size or $et->Error("Error reading $tag data"), last;
+            my $subdir = $$tagInfo{SubDirectory};
+            my $newData;
+            if ($subdir) {
+                my $subName = $$subdir{DirName} || $$tagInfo{Name};
+                my $start = $$subdir{Start} || 0;
+                my $base = ($$dirInfo{Base} || 0) + $raf->Tell() - $size;
+                my $dPos = 0;
+                my $hdrLen = $start;
+                if ($$subdir{Base}) {
+                    my $localBase = eval $$subdir{Base};
+                    $dPos -= $localBase;
+                    $base -= $dPos;
+                    # get length of header before base offset
+                    $hdrLen -= $localBase if $localBase <= $hdrLen;
+                }
+                my %subdirInfo = (
+                    Parent   => $dirName,
+                    DirName  => $subName,
+                    DataPt   => \$buff,
+                    DataLen  => $size,
+                    DataPos  => $dPos,
+                    DirStart => $start,
+                    DirLen   => $size - $start,
+                    Base     => $base,
+                    HasData  => $$subdir{HasData},  # necessary?
+                    Multi    => $$subdir{Multi},    # necessary?
+                    OutFile  => $outfile,
+                );
+                # pass the header pointer if necessary (for EXIF IFD's
+                # where the Base offset is at the end of the header)
+                if ($hdrLen and $hdrLen < $size) {
+                    my $header = substr($buff,0,$hdrLen);
+                    $subdirInfo{HeaderPtr} = \$header;
+                }
+                SetByteOrder('II') if $$subdir{ByteOrder} and $$subdir{ByteOrder} =~ /^Little/;
+                my $oldWriteGroup = $$et{CUR_WRITE_GROUP};
+                if ($subName eq 'Track') {
+                    $track or $track = 0;
+                    $$et{CUR_WRITE_GROUP} = 'Track' . (++$track);
+                }
+                my $subTable = GetTagTable($$subdir{TagTable});
+                # demote non-QuickTime errors to warnings
+                $$et{DemoteErrors} = 1 unless $$subTable{GROUPS}{0} eq 'QuickTime';
+                my $oldChanged = $$et{CHANGED};
+                $newData = $et->WriteDirectory(\%subdirInfo, $subTable);
+                if ($$et{DemoteErrors}) {
+                    # just copy existing subdirectory a non-quicktime error occurred
+                    $$et{CHANGED} = $oldChanged if $$et{DemoteErrors} > 1;
+                    delete $$et{DemoteErrors};
+                }
+                undef $newData if $$et{CHANGED} == $oldChanged; # don't change unless necessary
+                $$et{CUR_WRITE_GROUP} = $oldWriteGroup;
+                SetByteOrder('MM');
+                # add back header if necessary
+                if ($start and defined $newData and length $newData) {
+                    $newData = substr($buff,0,$start) . $newData;
+                }
+                # the directory exists, so we don't need to add it
+                delete $$addDirs{$subName} if IsCurPath($et, $subName);
+            } else {
+                # --> this is where individual QuickTime tags would be edited,
+                # (this is such a can of worms, so don't implement this for now)
+            }
+            if (defined $newData) {
+                my $len = length $newData;
+                $len > 0x7ffffff7 and $et->Error("$tag to large to write"), last;
+                if ($len == $size or $dataPt or $foundMDAT) {
+                    # write the updated directory now
+                    Write($outfile, Set32u($len+8), $tag, $newData) or $rtnVal = 0, last;
+                    next;
+                } else {
+                    # bad things happen if 'mdat' atom is moved (eg. Adobe Bridge crashes --
+                    # there must be some absolute offsets somewhere that point into mdat),
+                    # so hold this atom and write it out later
+                    if ($len) {
+                        push @hold, Set32u($len+8), $tag, $newData;
+                        $et->VPrint(0,"  Moving '$tag' atom to after 'mdat'");
+                    } else {
+                        $et->VPrint(0,"  Freeing '$tag' atom (and zeroing data)");
+                    }
+                    # write a 'free' atom here to keep 'mdat' at the same offset
+                    substr($hdr, 4, 4) = 'free';
+                    $buff = "\0" x length($buff);   # zero out old data
+                }
+            }
+            # write out the existing atom (or 'free' padding)
+            Write($outfile, $hdr, $buff) or $rtnVal = 0, last;
+        } else {
+            # write the unknown/large atom header
+            Write($outfile, $hdr) or $rtnVal = 0, last;
+            next unless $size;
+            # copy the atom data
+            my $result = Image::ExifTool::CopyBlock($raf, $outfile, $size);
+            defined $result or $rtnVal = 0, last;
+            $result or $et->Error("Truncated $tag atom"), last;
+        }
+    }
+    # add new directories at this level if necessary
+    if (exists $$et{EDIT_DIRS}{$dirName}) {
+        # get a hash of tagInfo references to add to this directory
+        my $dirs = $et->GetAddDirHash($tagTablePtr, $dirName);
+        # make sorted list of new tags to be added
+        my @addTags = sort keys(%$dirs);
+        my $tag;
+        foreach $tag (@addTags) {
+            my $tagInfo = $$dirs{$tag};
+            my $subdir = $$tagInfo{SubDirectory} or next;
+            my $subName = $$subdir{DirName} || $$tagInfo{Name};
+            # QuickTime hierarchy is complex, so check full directory path before adding
+            next unless IsCurPath($et, $subName);
+            delete $$addDirs{$subName}; # add only once
+            my $buff = '';  # write from scratch
+            my %subdirInfo = (
+                Parent   => $dirName,
+                DirName  => $subName,
+                DataPt   => \$buff,
+                DirStart => 0,
+                OutFile  => $outfile,
+            );
+            my $subTable = GetTagTable($$subdir{TagTable});
+            my $newData = $et->WriteDirectory(\%subdirInfo, $subTable);
+            if ($newData and length($newData) <= 0x7ffffff7) {
+                my $uuid = '';
+                # add atom ID if necessary (obtain from Condition expression)
+                if ($$subdir{Start}) {
+                    my $cond = $$tagInfo{Condition};
+                    $uuid = eval qq("$1") if $cond and $cond =~ m{=~\s*\/\^(.*)/};
+                    length($uuid) == $$subdir{Start} or $et->Error('Internal UUID error');
+                }
+                my $newHdr = Set32u(8+length($newData)+length($uuid)) . $tag . $uuid;
+                Write($outfile, $newHdr, $newData) or $rtnVal = 0;
+            }
+        }
+    }
+    # write out any atoms that we are holding until the end
+    Write($outfile, @hold) or $rtnVal = 0 if @hold;
+
+    # issue minor error if we didn't find an 'mdat' atom
+    # (we could duplicate atoms indefinitely through repeated editing if we
+    #  held back some atoms here, so in this case it isn't a minor error)
+    $dataPt or $foundMDAT or $et->Error('No mdat atom found', @hold ? 0 : 1);
+
+    return $dataPt ? ($rtnVal ? $$outfile : undef) : $rtnVal;
+}
+
+#------------------------------------------------------------------------------
+# Write QuickTime-format MOV/MP4 file
+# Inputs: 0) ExifTool ref, 1) dirInfo ref
+# Returns: 1 on success, 0 if this wasn't a valid QuickTime file,
+#          or -1 if a write error occurred
+sub WriteMOV($$)
+{
+    my ($et, $dirInfo) = @_;
+    $et or return 1;
+    my $raf = $$dirInfo{RAF} or return 0;
+    my ($buff, $ftype);
+
+    # read the first atom header
+    return 0 unless $raf->Read($buff, 8) == 8;
+    my ($size, $tag) = unpack('Na4', $buff);
+    return 0 if $size < 8 and $size != 1;
+
+    # validate the file format
+    my $tagTablePtr = GetTagTable('Image::ExifTool::QuickTime::Main');
+    return 0 unless $$tagTablePtr{$tag};
+
+    # determine the file type
+    if ($tag eq 'ftyp' and $size >= 12 and $size < 100000 and
+        $raf->Read($buff, $size-8) == $size-8 and
+        $buff !~ /^(....)+(qt  )/s)
+    {
+        # file is MP4 format if 'ftyp' exists without 'qt  ' as a compatible brand
+        $ftype = 'MP4';
+    } else {
+        $ftype = 'MOV';
+    }
+    $et->SetFileType($ftype); # need to set "FileType" tag for a Condition
+    $et->InitWriteDirs($dirMap{$ftype}, 'XMP');
+    $$et{DirMap} = $dirMap{$ftype};     # need access to directory map when writing
+    SetByteOrder('MM');
+    $raf->Seek(0,0);
+
+    # write the file
+    $$dirInfo{Parent} = '';
+    $$dirInfo{DirName} = 'MOV';
+    return WriteQuickTime($et, $dirInfo, $tagTablePtr) ? 1 : -1;
+}
+
+1; # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WriteQuickTime.pl - Write XMP to QuickTime (MOV and MP4) files
+
+=head1 SYNOPSIS
+
+These routines are autoloaded by Image::ExifTool::QuickTime.
+
+=head1 DESCRIPTION
+
+This file contains routines used by ExifTool to write XMP metadata to
+QuickTime-based file formats like MOV and MP4.
+
+=head1 AUTHOR
+
+Copyright 2003-2015, 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::QuickTime(3pm)|Image::ExifTool::QuickTime>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut

data/bin/Image-ExifTool-9.99/lib/Image/ExifTool/WriteXMP.pl

@@ -0,0 +1,1367 @@
+#------------------------------------------------------------------------------
+# File:         WriteXMP.pl
+#
+# Description:  Write XMP meta information
+#
+# Revisions:    12/19/2004 - P. Harvey Created
+#------------------------------------------------------------------------------
+package Image::ExifTool::XMP;
+
+use strict;
+use vars qw(%specialStruct %dateTimeInfo %stdXlatNS);
+
+use Image::ExifTool qw(:DataAccess :Utils);
+
+sub CheckXMP($$$);
+sub CaptureXMP($$$;$);
+sub SetPropertyPath($$;$$$$);
+
+my $debug = 0;
+my $numPadLines = 24;       # number of blank padding lines
+
+# when writing extended XMP, resources bigger than this get placed in their own
+# rdf:Description so they can be moved to the extended segments if necessary
+my $newDescThresh = 10240;  # 10 kB
+
+# individual resources and namespaces to place last in separate rdf:Description's
+# so they can be moved to extended XMP segments if required (see Oct. 2008 XMP spec)
+my %extendedRes = (
+    'photoshop:History' => 1,
+    'xap:Thumbnails' => 1,
+    'xmp:Thumbnails' => 1,
+    'crs' => 1,
+    'crss' => 1,
+);
+
+my $rdfDesc = 'rdf:Description';
+#
+# packet/xmp/rdf headers and trailers
+#
+my $pktOpen = "<?xpacket begin='\xef\xbb\xbf' id='W5M0MpCehiHzreSzNTczkc9d'?>\n";
+my $xmlOpen = "<?xml version='1.0' encoding='UTF-8'?>\n";
+my $xmpOpenPrefix = "<x:xmpmeta xmlns:x='$nsURI{x}'";
+my $rdfOpen = "<rdf:RDF xmlns:rdf='$nsURI{rdf}'>\n";
+my $rdfClose = "</rdf:RDF>\n";
+my $xmpClose = "</x:xmpmeta>\n";
+my $pktCloseW =  "<?xpacket end='w'?>"; # writable by default
+my $pktCloseR =  "<?xpacket end='r'?>";
+
+#------------------------------------------------------------------------------
+# Get XMP opening tag (and set x:xmptk appropriately)
+# Inputs: 0) ExifTool object ref
+# Returns: x:xmpmeta opening tag
+sub XMPOpen($)
+{
+    my $et = shift;
+    my $nv = $$et{NEW_VALUE}{$Image::ExifTool::XMP::x{xmptk}};
+    my $tk;
+    if (defined $nv) {
+        $tk = $et->GetNewValues($nv);
+        $et->VerboseValue(($tk ? '+' : '-') . ' XMP-x:XMPToolkit', $tk);
+        ++$$et{CHANGED};
+    } else {
+        $tk = "Image::ExifTool $Image::ExifTool::VERSION";
+    }
+    my $str = $tk ? (" x:xmptk='" . EscapeXML($tk) . "'") : '';
+    return "$xmpOpenPrefix$str>\n";
+}
+
+#------------------------------------------------------------------------------
+# Validate XMP packet and set read or read/write mode
+# Inputs: 0) XMP data reference, 1) 'r' = read only, 'w' or undef = read/write
+# Returns: true if XMP is good (and adds packet header/trailer if necessary)
+sub ValidateXMP($;$)
+{
+    my ($xmpPt, $mode) = @_;
+    $$xmpPt =~ s/^\s*<!--.*?-->\s*//s; # remove leading comment if it exists
+    unless ($$xmpPt =~ /^\0*<\0*\?\0*x\0*p\0*a\0*c\0*k\0*e\0*t/) {
+        return '' unless $$xmpPt =~ /^<x(mp)?:x[ma]pmeta/;
+        # add required xpacket header/trailer
+        $$xmpPt = $pktOpen . $$xmpPt . $pktCloseW;
+    }
+    $mode = 'w' unless $mode;
+    my $end = substr($$xmpPt, -32, 32);
+    # check for proper xpacket trailer and set r/w mode if necessary
+    return '' unless $end =~ s/(e\0*n\0*d\0*=\0*['"]\0*)([rw])(\0*['"]\0*\?\0*>)/$1$mode$3/;
+    substr($$xmpPt, -32, 32) = $end if $2 ne $mode;
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+# Check XMP date values for validity and format accordingly
+# Inputs: 1) date string
+# Returns: XMP date/time string (or undef on error)
+sub FormatXMPDate($)
+{
+    my $val = shift;
+    my ($y, $m, $d, $t, $tz);
+    if ($val =~ /(\d{4}):(\d{2}):(\d{2}) (\d{2}:\d{2}(?::\d{2}(?:\.\d*)?)?)(.*)/) {
+        ($y, $m, $d, $t, $tz) = ($1, $2, $3, $4, $5);
+        $val = "$y-$m-${d}T$t";
+    } elsif ($val =~ /^\s*\d{4}(:\d{2}){0,2}\s*$/) {
+        # this is just a date (YYYY, YYYY-mm or YYYY-mm-dd)
+        $val =~ tr/:/-/;
+    } elsif ($val =~ /^\s*(\d{2}:\d{2}(?::\d{2}(?:\.\d*)?)?)(.*)\s*$/) {
+        # this is just a time
+        ($t, $tz) = ($1, $2);
+        $val = $t;
+    } else {
+        return undef;
+    }
+    if ($tz) {
+        $tz =~ /^(Z|[+-]\d{2}:\d{2})$/ or return undef;
+        $val .= $tz;
+    }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Check XMP values for validity and format accordingly
+# Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref
+# Returns: error string or undef (and may change value) on success
+# Note: copies structured information to avoid conflicts with calling code
+sub CheckXMP($$$)
+{
+    my ($et, $tagInfo, $valPtr) = @_;
+
+    if ($$tagInfo{Struct}) {
+        require 'Image/ExifTool/XMPStruct.pl';
+        my ($item, $err, $w, $warn);
+        unless (ref $$valPtr) {
+            ($$valPtr, $warn) = InflateStruct($valPtr);
+            # expect a structure HASH ref or ARRAY of structures
+            ref $$valPtr or return 'Improperly formed structure';
+        }
+        if (ref $$valPtr eq 'ARRAY') {
+            return 'Not a list tag' unless $$tagInfo{List};
+            my @copy = ( @{$$valPtr} ); # copy the list for ExifTool to use
+            $$valPtr = \@copy;          # return the copy
+            foreach $item (@copy) {
+                unless (ref $item eq 'HASH') {
+                    ($item, $w) = InflateStruct(\$item); # deserialize structure
+                    $w and $warn = $w;
+                    next if ref $item eq 'HASH';
+                    $err = 'Improperly formed structure';
+                    last;
+                }
+                ($item, $err) = CheckStruct($et, $item, $$tagInfo{Struct});
+                last if $err;
+            }
+        } else {
+            ($$valPtr, $err) = CheckStruct($et, $$valPtr, $$tagInfo{Struct});
+        }
+        $warn and $$et{CHECK_WARN} = $warn;
+        return $err;
+    }
+    my $format = $$tagInfo{Writable};
+    # (if no format specified, value is a simple string)
+    if (not $format or $format eq 'string' or $format eq 'lang-alt') {
+        # convert value to UTF8 if necessary
+        if ($$et{OPTIONS}{Charset} ne 'UTF8') {
+            if ($$valPtr =~ /[\x80-\xff]/) {
+                # convert from Charset to UTF-8
+                $$valPtr = $et->Encode($$valPtr,'UTF8');
+            }
+        } else {
+            # translate invalid XML characters to "."
+            $$valPtr =~ tr/\0-\x08\x0b\x0c\x0e-\x1f/./;
+            # fix any malformed UTF-8 characters
+            if (FixUTF8($valPtr) and not $$et{WarnBadUTF8}) {
+                $et->Warn('Malformed UTF-8 character(s)');
+                $$et{WarnBadUTF8} = 1;
+            }
+        }
+        return undef;   # success
+    }
+    if ($format eq 'rational' or $format eq 'real') {
+        # make sure the value is a valid floating point number
+        unless (Image::ExifTool::IsFloat($$valPtr) or
+            # allow 'inf' and 'undef' rational values
+            ($format eq 'rational' and ($$valPtr eq 'inf' or
+             $$valPtr eq 'undef' or Image::ExifTool::IsRational($$valPtr))))
+        {
+            return 'Not a floating point number' 
+        }
+        if ($format eq 'rational') {
+            $$valPtr = join('/', Image::ExifTool::Rationalize($$valPtr));
+        }
+    } elsif ($format eq 'integer') {
+        # make sure the value is integer
+        if (Image::ExifTool::IsInt($$valPtr)) {
+            # no conversion required (converting to 'int' would remove leading '+')
+        } elsif (Image::ExifTool::IsHex($$valPtr)) {
+            $$valPtr = hex($$valPtr);
+        } else {
+            return 'Not an integer';
+        }
+    } elsif ($format eq 'date') {
+        my $newDate = FormatXMPDate($$valPtr);
+        return "Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])" unless $newDate;
+        $$valPtr = $newDate;
+    } elsif ($format eq 'boolean') {
+        if (not $$valPtr or $$valPtr =~ /false/i or $$valPtr =~ /^no$/i) {
+            $$valPtr = 'False';
+        } else {
+            $$valPtr = 'True';
+        }
+    } elsif ($format eq '1') {
+        # this is the entire XMP data block
+        return 'Invalid XMP data' unless ValidateXMP($valPtr);
+    } else {
+        return "Unknown XMP format: $format";
+    }
+    return undef;   # success!
+}
+
+#------------------------------------------------------------------------------
+# Get PropertyPath for specified tagInfo
+# Inputs: 0) tagInfo reference
+# Returns: PropertyPath string
+sub GetPropertyPath($)
+{
+    my $tagInfo = shift;
+    SetPropertyPath($$tagInfo{Table}, $$tagInfo{TagID}) unless $$tagInfo{PropertyPath};
+    return $$tagInfo{PropertyPath};
+}
+
+#------------------------------------------------------------------------------
+# Set PropertyPath for specified tag (also for associated flattened tags and structure elements)
+# Inputs: 0) tagTable reference, 1) tagID, 2) tagID of parent structure,
+#         3) structure definition ref (or undef), 4) property list up to this point (or undef),
+#         5) flag set if any containing structure has a TYPE
+# Notes: also generates flattened tags if they don't already exist
+sub SetPropertyPath($$;$$$$)
+{
+    my ($tagTablePtr, $tagID, $parentID, $structPtr, $propList, $isType) = @_;
+    my $table = $structPtr || $tagTablePtr;
+    my $tagInfo = $$table{$tagID};
+    my $flatInfo;
+
+    return if ref($tagInfo) ne 'HASH'; # (shouldn't happen)
+
+    if ($structPtr) {
+        my $flatID = $parentID . ucfirst($tagID);
+        $flatInfo = $$tagTablePtr{$flatID};
+        if ($flatInfo) {
+            return if $$flatInfo{PropertyPath};
+        } else {
+            # flattened tag doesn't exist, so create it now
+            # (could happen if we were just writing a structure)
+            $flatInfo = { Name => ucfirst($flatID), Flat => 1 };
+            AddTagToTable($tagTablePtr, $flatID, $flatInfo);
+        }
+        $isType = 1 if $$structPtr{TYPE};
+    } else {
+        # don't override existing main table entry if already set by a Struct
+        return if $$tagInfo{PropertyPath};
+        # use property path from original tagInfo if this is an alternate-language tag
+        my $srcInfo = $$tagInfo{SrcTagInfo};
+        $$tagInfo{PropertyPath} = GetPropertyPath($srcInfo) if $srcInfo;
+        return if $$tagInfo{PropertyPath};
+        # set property path for all flattened tags in structure if necessary
+        if ($$tagInfo{RootTagInfo}) {
+            SetPropertyPath($tagTablePtr, $$tagInfo{RootTagInfo}{TagID});
+            return if $$tagInfo{PropertyPath};
+            warn "Internal Error: Didn't set path from root for $tagID\n";
+        }
+    }
+    my $ns = $$tagInfo{Namespace} || $$table{NAMESPACE};
+    $ns or warn("No namespace for $tagID\n"), return;
+    my (@propList, $listType);
+    $propList and @propList = @$propList;
+    push @propList, "$ns:$tagID";
+    # lang-alt lists are handled specially, signified by Writable='lang-alt'
+    if ($$tagInfo{Writable} and $$tagInfo{Writable} eq 'lang-alt') {
+        $listType = 'Alt';
+        # remove language code from property path if it exists
+        $propList[-1] =~ s/-$$tagInfo{LangCode}$// if $$tagInfo{LangCode};
+        # handle lists of lang-alt lists (eg. XMP-plus:Custom tags)
+        if ($$tagInfo{List} and $$tagInfo{List} ne '1') {
+            push @propList, "rdf:$$tagInfo{List}", 'rdf:li 10';
+        }
+    } else {
+        $listType = $$tagInfo{List};
+    }
+    # add required properties if this is a list
+    push @propList, "rdf:$listType", 'rdf:li 10' if $listType and $listType ne '1';
+    # set PropertyPath for all flattened tags of this structure if necessary
+    # (note: don't do this for variable-namespace structures (undef NAMESPACE))
+    my $strTable = $$tagInfo{Struct};
+    if ($strTable and $$strTable{NAMESPACE} and not ($parentID and
+        # must test NoSubStruct flag to avoid infinite recursion
+        (($$tagTablePtr{$parentID} and $$tagTablePtr{$parentID}{NoSubStruct}) or
+        length $parentID > 500))) # avoid deep recursion
+    {
+        # make sure the structure namespace has been registered
+        # (user-defined namespaces may not have been)
+        RegisterNamespace($strTable) if ref $$strTable{NAMESPACE};
+        my $tag;
+        foreach $tag (keys %$strTable) {
+            # ignore special fields and any lang-alt fields we may have added
+            next if $specialStruct{$tag} or $$strTable{$tag}{LangCode};
+            my $fullID = $parentID ? $parentID . ucfirst($tagID) : $tagID;
+            SetPropertyPath($tagTablePtr, $tag, $fullID, $strTable, \@propList, $isType);
+        }
+    }
+    # if this was a structure field and not a normal tag,
+    # we set PropertyPath in the corresponding flattened tag
+    if ($structPtr) {
+        $tagInfo = $flatInfo;
+        # set StructType flag if any containing structure has a TYPE
+        $$tagInfo{StructType} = 1 if $isType;
+    }
+    # set property path for tagInfo in main table
+    $$tagInfo{PropertyPath} = join '/', @propList;
+}
+
+#------------------------------------------------------------------------------
+# Save XMP property name/value for rewriting
+# Inputs: 0) ExifTool object reference
+#         1) reference to array of XMP property path (last is current property)
+#         2) property value, 3) optional reference to hash of property attributes
+sub CaptureXMP($$$;$)
+{
+    my ($et, $propList, $val, $attrs) = @_;
+    return unless defined $val and @$propList > 2;
+    if ($$propList[0] =~ /^x:x[ma]pmeta$/ and
+        $$propList[1] eq 'rdf:RDF' and
+        $$propList[2] =~ /$rdfDesc( |$)/)
+    {
+        # no properties to save yet if this is just the description
+        return unless @$propList > 3;
+        # ignore empty list properties
+        if ($$propList[-1] =~ /^rdf:(Bag|Seq|Alt)$/) {
+            $et->Warn("Ignored empty $$propList[-1] list for $$propList[-2]", 1);
+            return;
+        }
+        # save information about this property
+        my $capture = $$et{XMP_CAPTURE};
+        my $path = join('/', @$propList[3..$#$propList]);
+        if (defined $$capture{$path}) {
+            $$et{XMP_ERROR} = "Duplicate XMP property: $path";
+        } else {
+            $$capture{$path} = [$val, $attrs || { }];
+        }
+    } elsif ($$propList[0] eq 'rdf:RDF' and
+             $$propList[1] =~ /$rdfDesc( |$)/)
+    {
+        # set flag so we don't write x:xmpmeta element
+        $$et{XMP_NO_XMPMETA} = 1;
+        # add missing x:xmpmeta element and try again
+        unshift @$propList, 'x:xmpmeta';
+        CaptureXMP($et, $propList, $val, $attrs);
+    } else {
+        $$et{XMP_ERROR} = 'Improperly enclosed XMP property: ' . join('/',@$propList);
+    }
+}
+
+#------------------------------------------------------------------------------
+# Save information about resource containing blank node with nodeID
+# Inputs: 0) reference to blank node information hash
+#         1) reference to property list
+#         2) property value
+#         3) [optional] reference to attribute hash
+# Notes: This routine and ProcessBlankInfo() are also used for reading information, but
+#        are uncommon so are put in this file to reduce compile time for the common case
+sub SaveBlankInfo($$$;$)
+{
+    my ($blankInfo, $propListPt, $val, $attrs) = @_;
+
+    my $propPath = join '/', @$propListPt;
+    my @ids = ($propPath =~ m{ #([^ /]*)}g);
+    my $id;
+    # split the property path at each nodeID
+    foreach $id (@ids) {
+        my ($pre, $prop, $post) = ($propPath =~ m{^(.*?)/([^/]*) #$id((/.*)?)$});
+        defined $pre or warn("internal error parsing nodeID's"), next;
+        # the element with the nodeID should be in the path prefix for subject
+        # nodes and the path suffix for object nodes
+        unless ($prop eq $rdfDesc) {
+            if ($post) {
+                $post = "/$prop$post";
+            } else {
+                $pre = "$pre/$prop";
+            }
+        }
+        $$blankInfo{Prop}{$id}{Pre}{$pre} = 1;
+        if ((defined $post and length $post) or (defined $val and length $val)) {
+            # save the property value and attributes for each unique path suffix
+            $$blankInfo{Prop}{$id}{Post}{$post} = [ $val, $attrs, $propPath ];
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+# Process blank-node information
+# Inputs: 0) ExifTool object ref, 1) tag table ref,
+#         2) blank node information hash ref, 3) flag set for writing
+sub ProcessBlankInfo($$$;$)
+{
+    my ($et, $tagTablePtr, $blankInfo, $isWriting) = @_;
+    $et->VPrint(1, "  [Elements with nodeID set:]\n") unless $isWriting;
+    my ($id, $pre, $post);
+    # handle each nodeID separately
+    foreach $id (sort keys %{$$blankInfo{Prop}}) {
+        my $path = $$blankInfo{Prop}{$id};
+        # flag all resource names so we can warn later if some are unused
+        my %unused;
+        foreach $post (keys %{$$path{Post}}) {
+            $unused{$post} = 1;
+        }
+        # combine property paths for all possible paths through this node
+        foreach $pre (sort keys %{$$path{Pre}}) {
+            # there will be no description for the object of a blank node
+            next unless $pre =~ m{/$rdfDesc/};
+            foreach $post (sort keys %{$$path{Post}}) {
+                my @propList = split m{/}, "$pre$post";
+                my ($val, $attrs) = @{$$path{Post}{$post}};
+                if ($isWriting) {
+                    CaptureXMP($et, \@propList, $val, $attrs);
+                } else {
+                    FoundXMP($et, $tagTablePtr, \@propList, $val);
+                }
+                delete $unused{$post};
+            }
+        }
+        # save information from unused properties (if RDF is malformed like f-spot output)
+        if (%unused) {
+            $et->Options('Verbose') and $et->Warn('An XMP resource is about nothing');
+            foreach $post (sort keys %unused) {
+                my ($val, $attrs, $propPath) = @{$$path{Post}{$post}};
+                my @propList = split m{/}, $propPath;
+                if ($isWriting) {
+                    CaptureXMP($et, \@propList, $val, $attrs);
+                } else {
+                    FoundXMP($et, $tagTablePtr, \@propList, $val);
+                }
+            }
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+# Convert path to namespace used in file (this is a pain, but the XMP
+# spec only suggests 'preferred' namespace prefixes...)
+# Inputs: 0) ExifTool object reference, 1) property path
+# Returns: conforming property path
+sub ConformPathToNamespace($$)
+{
+    my ($et, $path) = @_;
+    my @propList = split('/',$path);
+    my $nsUsed = $$et{XMP_NS};
+    my $prop;
+    foreach $prop (@propList) {
+        my ($ns, $tag) = $prop =~ /(.+?):(.*)/;
+        next if $$nsUsed{$ns};
+        my $uri = $nsURI{$ns};
+        unless ($uri) {
+            warn "No URI for namepace prefix $ns!\n";
+            next;
+        }
+        my $ns2;
+        foreach $ns2 (keys %$nsUsed) {
+            next unless $$nsUsed{$ns2} eq $uri;
+            # use the existing namespace prefix instead of ours
+            $prop = "$ns2:$tag";
+            last;
+        }
+    }
+    return join('/',@propList);
+}
+
+#------------------------------------------------------------------------------
+# Add necessary rdf:type element when writing structure
+# Inputs: 0) ExifTool ref, 1) tag table ref, 2) capture hash ref, 3) path string
+#         4) optional base path (already conformed to namespace) for elements in
+#            variable-namespace structures
+sub AddStructType($$$$;$)
+{
+    my ($et, $tagTablePtr, $capture, $path, $basePath) = @_;
+    my @props = split '/', $path;
+    my %doneID;
+    for (;;) {
+        pop @props;
+        last unless @props;
+        my $tagID = GetXMPTagID(\@props);
+        next if $doneID{$tagID};
+        $doneID{$tagID} = 1;
+        my $tagInfo = $$tagTablePtr{$tagID};
+        last unless ref $tagInfo eq 'HASH';
+        if ($$tagInfo{Struct}) {
+            my $type = $$tagInfo{Struct}{TYPE};
+            if ($type) {
+                my $pat = $$tagInfo{PropertyPath};
+                $pat or warn("Missing PropertyPath in AddStructType\n"), last;
+                $pat = ConformPathToNamespace($et, $pat);
+                $pat =~  s/ \d+/ \\d\+/g;
+                $path =~ /^($pat)/ or warn("Wrong path in AddStructType\n"), last;
+                my $p = $1 . '/rdf:type';
+                $p = "$basePath/$p" if $basePath;
+                $$capture{$p} = [ '', { 'rdf:resource' => $type } ] unless $$capture{$p};
+            }
+        }
+        last unless $$tagInfo{StructType};
+    }
+}
+
+#------------------------------------------------------------------------------
+# Utility routine to encode data in base64
+# Inputs: 0) binary data string, 1) flag to avoid inserting newlines
+# Returns:   base64-encoded string
+sub EncodeBase64($;$)
+{
+    # encode the data in 45-byte chunks
+    my $chunkSize = 45;
+    my $len = length $_[0];
+    my $str = '';
+    my $i;
+    for ($i=0; $i<$len; $i+=$chunkSize) {
+        my $n = $len - $i;
+        $n = $chunkSize if $n > $chunkSize;
+        # add uuencoded data to output (minus size byte, but including trailing newline)
+        $str .= substr(pack('u', substr($_[0], $i, $n)), 1);
+    }
+    # convert to base64 (remember that "\0" may be encoded as ' ' or '`')
+    $str =~ tr/` -_/AA-Za-z0-9+\//;
+    # convert pad characters at the end (remember to account for trailing newline)
+    my $pad = 3 - ($len % 3);
+    substr($str, -$pad-1, $pad) = ('=' x $pad) if $pad < 3;
+    $str =~ tr/\n//d if $_[1];  # remove newlines if specified
+    return $str;
+}
+
+#------------------------------------------------------------------------------
+# sort tagInfo hash references by tag name
+sub ByTagName
+{
+    return $$a{Name} cmp $$b{Name};
+}
+
+#------------------------------------------------------------------------------
+# sort alphabetically, but with rdf:type first in the structure
+sub TypeFirst
+{
+    if ($a =~ /rdf:type$/) {
+        return substr($a, 0, -8) cmp $b unless $b =~ /rdf:type$/;
+    } elsif ($b =~ /rdf:type$/) {
+        return $a cmp substr($b, 0, -8);
+    }
+    return $a cmp $b;
+}
+
+#------------------------------------------------------------------------------
+# Limit size of XMP
+# Inputs: 0) ExifTool object ref, 1) XMP data ref (written up to start of $rdfClose),
+#         2) max XMP len, 3) rdf:about string, 4) list ref for description start offsets
+#         5) start offset of first description recommended for extended XMP
+# Returns: 0) extended XMP ref, 1) GUID and updates $$dataPt (or undef if no extended XMP)
+sub LimitXMPSize($$$$$$)
+{
+    my ($et, $dataPt, $maxLen, $about, $startPt, $extStart) = @_;
+
+    # return straight away if it isn't too big
+    return undef if length($$dataPt) < $maxLen;
+
+    push @$startPt, length($$dataPt);  # add end offset to list
+    my $newData = substr($$dataPt, 0, $$startPt[0]);
+    my $guid = '0' x 32;
+    # write the required xmpNote:HasExtendedXMP property
+    $newData .= "\n <$rdfDesc rdf:about='$about'\n  xmlns:xmpNote='$nsURI{xmpNote}'>\n" .
+                  "  <xmpNote:HasExtendedXMP>$guid</xmpNote:HasExtendedXMP>\n" .
+                  " </$rdfDesc>\n";
+
+    my ($i, %descSize, $start);
+    # calculate all description block sizes
+    for ($i=1; $i<@$startPt; ++$i) {
+        $descSize{$$startPt[$i-1]} = $$startPt[$i] - $$startPt[$i-1];
+    }
+    pop @$startPt;    # remove end offset
+    # write the descriptions from smallest to largest, as many in main XMP as possible
+    my @descStart = sort { $descSize{$a} <=> $descSize{$b} } @$startPt;
+    my $extData = XMPOpen($et) . $rdfOpen;
+    for ($i=0; $i<2; ++$i) {
+      foreach $start (@descStart) {
+        # write main XMP first (in order of size), then extended XMP afterwards (in order)
+        next if $i xor $start >= $extStart;
+        my $pt = (length($newData) + $descSize{$start} > $maxLen) ? \$extData : \$newData;
+        $$pt .= substr($$dataPt, $start, $descSize{$start});
+      }
+    }
+    $extData .= $rdfClose . $xmpClose;  # close rdf:RDF and x:xmpmeta
+    # calculate GUID from MD5 of extended XMP data
+    if (eval { require Digest::MD5 }) {
+        $guid = uc unpack('H*', Digest::MD5::md5($extData));
+        $newData =~ s/0{32}/$guid/;     # update GUID in main XMP segment
+    }
+    $et->VerboseValue('+ XMP-xmpNote:HasExtendedXMP', $guid);
+    $$dataPt = $newData;        # return main XMP block
+    return (\$extData, $guid);  # return extended XMP and its GUID
+}
+
+#------------------------------------------------------------------------------
+# Write XMP information
+# Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
+#         2) [optional] tag table reference
+# Returns: with tag table: new XMP data (may be empty if no XMP data) or undef on error
+#          without tag table: 1 on success, 0 if not valid XMP file, -1 on write error
+# Notes: May set dirInfo InPlace flag to rewrite with specified DirLen
+#        May set dirInfo ReadOnly flag to write as read-only XMP ('r' mode and no padding)
+#        May set dirInfo Compact flag to force compact (drops 2kB of padding)
+#        May set dirInfo MaxDataLen to limit output data length -- this causes ExtendedXMP
+#          and ExtendedGUID to be returned in dirInfo if extended XMP was required
+sub WriteXMP($$;$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    $et or return 1;    # allow dummy access to autoload this package
+    my $dataPt = $$dirInfo{DataPt};
+    my (%capture, %nsUsed, $xmpErr, $tagInfo, $about);
+    my $changed = 0;
+    my $xmpFile = (not $tagTablePtr);   # this is an XMP data file if no $tagTablePtr
+    # prefer XMP over other metadata formats in some types of files
+    my $preferred = $xmpFile || ($$et{PreferredGroup} and $$et{PreferredGroup} eq 'XMP');
+    my $verbose = $et->Options('Verbose');
+    my $dirLen = $$dirInfo{DirLen};
+    $dirLen = length($$dataPt) if not defined $dirLen and $dataPt;
+#
+# extract existing XMP information into %capture hash
+#
+    # define hash in ExifTool object to capture XMP information (also causes
+    # CaptureXMP() instead of FoundXMP() to be called from ParseXMPElement())
+    #
+    # The %capture hash is keyed on the complete property path beginning after
+    # rdf:RDF/rdf:Description/.  The values are array references with the
+    # following entries: 0) value, 1) attribute hash reference.
+    $$et{XMP_CAPTURE} = \%capture;
+    $$et{XMP_NS} = \%nsUsed;
+    delete $$et{XMP_NO_XMPMETA};
+    delete $$et{XMP_NO_XPACKET};
+    delete $$et{XMP_IS_XML};
+    delete $$et{XMP_IS_SVG};
+
+    if ($xmpFile or $dirLen) {
+        delete $$et{XMP_ERROR};
+        delete $$et{XMP_ABOUT};
+        # extract all existing XMP information (to the XMP_CAPTURE hash)
+        my $success = ProcessXMP($et, $dirInfo, $tagTablePtr);
+        # don't continue if there is nothing to parse or if we had a parsing error
+        unless ($success and not $$et{XMP_ERROR}) {
+            my $err = $$et{XMP_ERROR} || 'Error parsing XMP';
+            # may ignore this error only if we were successful
+            if ($xmpFile) {
+                my $raf = $$dirInfo{RAF};
+                # allow empty XMP data so we can create something from nothing
+                if ($success or not $raf->Seek(0,2) or $raf->Tell()) {
+                    # no error message if not an XMP file
+                    return 0 unless $$et{XMP_ERROR};
+                    if ($et->Error($err, $success)) {
+                        delete $$et{XMP_CAPTURE};
+                        return 0;
+                    }
+                }
+            } else {
+                if ($et->Warn($err, $success)) {
+                    delete $$et{XMP_CAPTURE};
+                    return undef;
+                }
+            }
+        }
+        $tagInfo = $Image::ExifTool::XMP::rdf{about};
+        if (defined $$et{NEW_VALUE}{$tagInfo}) {
+            $about = $et->GetNewValues($$et{NEW_VALUE}{$tagInfo}) || '';
+            if ($verbose > 1) {
+                my $wasAbout = $$et{XMP_ABOUT};
+                $et->VerboseValue('- XMP-rdf:About', UnescapeXML($wasAbout)) if defined $wasAbout;
+                $et->VerboseValue('+ XMP-rdf:About', $about);
+            }
+            $about = EscapeXML($about); # must escape for XML
+            ++$changed;
+        } else {
+            $about = $$et{XMP_ABOUT} || '';
+        }
+        delete $$et{XMP_ERROR};
+        delete $$et{XMP_ABOUT};
+    } else {
+        $about = '';
+    }
+#
+# handle writing XMP as a block to XMP file
+#
+    if ($xmpFile) {
+        $tagInfo = $Image::ExifTool::Extra{XMP};
+        if ($tagInfo and $$et{NEW_VALUE}{$tagInfo}) {
+            my $rtnVal = 1;
+            my $newVal = $et->GetNewValues($$et{NEW_VALUE}{$tagInfo});
+            if (defined $newVal and length $newVal) {
+                $et->VPrint(0, "  Writing XMP as a block\n");
+                ++$$et{CHANGED};
+                Write($$dirInfo{OutFile}, $newVal) or $rtnVal = -1;
+            }
+            delete $$et{XMP_CAPTURE};
+            return $rtnVal;
+        }
+    }
+#
+# delete groups in family 1 if requested
+#
+    if (%{$$et{DEL_GROUP}} and (grep /^XMP-.+$/, keys %{$$et{DEL_GROUP}} or
+        # (logic is a bit more complex for group names in exiftool XML files)
+        grep m{^http://ns.exiftool.ca/}, values %nsUsed))
+    {
+        my $del = $$et{DEL_GROUP};
+        my $path;
+        foreach $path (keys %capture) {
+            my @propList = split('/',$path); # get property list
+            my ($tag, $ns) = GetXMPTagID(\@propList);
+            # translate namespace if necessary
+            $ns = $stdXlatNS{$ns} if $stdXlatNS{$ns};
+            my ($grp, @g);
+            # no "XMP-" added to most groups in exiftool RDF/XML output file
+            if ($nsUsed{$ns} and (@g = ($nsUsed{$ns} =~ m{^http://ns.exiftool.ca/(.*?)/(.*?)/}))) {
+                if ($g[1] =~ /^\d/) {
+                    $grp = "XML-$g[0]";
+                    #(all XML-* groups stored as uppercase DEL_GROUP key)
+                    my $ucg = uc $grp;
+                    next unless $$del{$ucg} or ($$del{'XML-*'} and not $$del{"-$ucg"});
+                } else {
+                    $grp = $g[1];
+                    next unless $$del{$grp} or ($$del{$g[0]} and not $$del{"-$grp"});
+                }
+            } else {
+                $grp = "XMP-$ns";
+                my $ucg = uc $grp;
+                next unless $$del{$ucg} or ($$del{'XMP-*'} and not $$del{"-$ucg"});
+            }
+            $et->VerboseValue("- $grp:$tag", $capture{$path}->[0]);
+            delete $capture{$path};
+            ++$changed;
+        }
+    }
+    # delete HasExtendedXMP tag (we create it as needed)
+    my $hasExtTag = 'xmpNote:HasExtendedXMP';
+    if ($capture{$hasExtTag}) {
+        $et->VerboseValue("- XMP-$hasExtTag", $capture{$hasExtTag}->[0]);
+        delete $capture{$hasExtTag};
+    }
+    # set $xmpOpen now to to handle xmptk tag first
+    my $xmpOpen = $$et{XMP_NO_XMPMETA} ? '' : XMPOpen($et);
+#
+# add, delete or change information as specified
+#
+    # get hash of all information we want to change
+    # (sorted by tag name so alternate languages come last, but with structures
+    # first so flattened tags may be used to override individual structure elements)
+    my @tagInfoList;
+    foreach $tagInfo (sort ByTagName $et->GetNewTagInfoList()) {
+        next unless $et->GetGroup($tagInfo, 0) eq 'XMP';
+        next if $$tagInfo{Name} eq 'XMP'; # (ignore full XMP block if we didn't write it already)
+        if ($$tagInfo{Struct}) {
+            unshift @tagInfoList, $tagInfo;
+        } else {
+            push @tagInfoList, $tagInfo;
+        }
+    }
+    foreach $tagInfo (@tagInfoList) {
+        my $tag = $$tagInfo{TagID};
+        my $path = GetPropertyPath($tagInfo);
+        unless ($path) {
+            $et->Warn("Can't write XMP:$tag (namespace unknown)");
+            next;
+        }
+        # skip tags that were handled specially
+        if ($path eq 'rdf:about' or $path eq 'x:xmptk') {
+            ++$changed;
+            next;
+        }
+        my $isStruct = $$tagInfo{Struct};
+        # change our property path namespace prefixes to conform
+        # to the ones used in this file
+        $path = ConformPathToNamespace($et, $path);
+        # find existing property
+        my $cap = $capture{$path}; 
+        # MicrosoftPhoto screws up the case of some tags, and some other software,
+        # including Adobe software, has been known to write the wrong list type or
+        # not properly enclose properties in a list, so we check for this
+        until ($cap) {
+            # find and fix all incorrect property names if this is a structure or a flattened tag
+            my @fixInfo;
+            if ($isStruct or defined $$tagInfo{Flat}) {
+                # get tagInfo for all containing (possibly nested) structures
+                my @props = split '/', $path;
+                my $tbl = $$tagInfo{Table};
+                while (@props) {
+                    my $info = $$tbl{GetXMPTagID(\@props)};
+                    unshift @fixInfo, $info if ref $info eq 'HASH' and $$info{Struct} and
+                        (not @fixInfo or $fixInfo[0] ne $info);
+                    pop @props;
+                }
+                $et->WarnOnce("Error finding parent structure for $$tagInfo{Name}") unless @fixInfo;
+            }
+            # fix property path for this tag (last in the @fixInfo list)
+            push @fixInfo, $tagInfo unless @fixInfo and $isStruct;
+            # start from outermost containing structure, fixing incorrect list types, etc,
+            # finally fixing the actual tag properties after all containing structures
+            my $err;
+            while (@fixInfo) {
+                my $fixInfo = shift @fixInfo;
+                my $fixPath = ConformPathToNamespace($et, GetPropertyPath($fixInfo));
+                my $regex = quotemeta($fixPath);
+                $regex =~ s/ \d+/ \\d\+/g;  # match any list index
+                my $ok = $regex;
+                my ($ok2, $match, $i, @fixed, %fixed, $fixed);
+                # check for incorrect list types
+                if ($regex =~ s{\\/rdf\\:(Bag|Seq|Alt)\\/}{/rdf:(Bag|Seq|Alt)/}g) {
+                    # also look for missing bottom-level list
+                    if ($regex =~ s{/rdf:\(Bag\|Seq\|Alt\)\/rdf\\:li\\ \\d\+$}{}) {
+                        $regex .= '(/.*)?' unless @fixInfo;
+                    }
+                } elsif (not @fixInfo) {
+                    $ok2 = $regex;
+                    # check for properties in lists that shouldn't be (ref forum4325)
+                    $regex .= '(/rdf:(Bag|Seq|Alt)/rdf:li \d+)?';
+                }
+                if (@fixInfo) {
+                    $regex .= '(/.*)?';
+                    $ok .= '(/.*)?';
+                }
+                my @matches = sort grep m{^$regex$}i, keys %capture;
+                last unless @matches;
+                if ($matches[0] =~ m{^$ok$}) {
+                    unless (@fixInfo) {
+                        $path = $matches[0];
+                        $cap = $capture{$path};
+                    }
+                    next;
+                }
+                # needs fixing...
+                my @fixProps = split '/', $fixPath;
+                foreach $match (@matches) {
+                    my @matchProps = split '/', $match;
+                    # remove superfluous list properties if necessary
+                    $#matchProps = $#fixProps if $ok2 and $#matchProps > $#fixProps;
+                    for ($i=0; $i<@fixProps; ++$i) {
+                        defined $matchProps[$i] or $matchProps[$i] = $fixProps[$i], next;
+                        next if $matchProps[$i] =~ / \d+$/ or $matchProps[$i] eq $fixProps[$i];
+                        $matchProps[$i] = $fixProps[$i];
+                    }
+                    $fixed = join '/', @matchProps;
+                    $err = 1 if $fixed{$fixed} or ($capture{$fixed} and $match ne $fixed);
+                    push @fixed, $fixed;
+                    $fixed{$fixed} = 1;
+                }
+                my $tg = $et->GetGroup($fixInfo, 1) . ':' . $$fixInfo{Name};
+                my $wrn = lc($fixed[0]) eq lc($matches[0]) ? 'tag ID case' : 'list type';
+                if ($err) {
+                    $et->Warn("Incorrect $wrn for existing $tg (not changed)");
+                } else {
+                    # fix the incorrect property paths for all values of this tag
+                    my $didFix;
+                    foreach $fixed (@fixed) {
+                        my $match = shift @matches;
+                        next if $fixed eq $match;
+                        $capture{$fixed} = $capture{$match};
+                        delete $capture{$match};
+                        # remove xml:lang attribute from incorrect lang-alt list if necessary
+                        delete $capture{$fixed}[1]{'xml:lang'} if $ok2 and $match !~ /^$ok2$/;
+                        $didFix = 1;
+                    }
+                    $cap = $capture{$path} || $capture{$fixed[0]} unless @fixInfo;
+                    if ($didFix) {
+                        $et->Warn("Fixed incorrect $wrn for $tg", 1);
+                        ++$changed;
+                    }
+                }
+            }
+            last;
+        }
+        my $nvHash = $et->GetNewValueHash($tagInfo);
+        my $overwrite = $et->IsOverwriting($nvHash);
+        my $writable = $$tagInfo{Writable} || '';
+        my (%attrs, $deleted, $added, $existed);
+        # delete existing entry if necessary
+        if ($isStruct) {
+            require 'Image/ExifTool/XMPStruct.pl';
+            ($deleted, $added, $existed) = DeleteStruct($et, \%capture, \$path, $nvHash, \$changed);
+            next unless $deleted or $added or $et->IsOverwriting($nvHash);
+            next if $existed and $$nvHash{CreateOnly};
+        } elsif ($cap) {
+            next if $$nvHash{CreateOnly};   # (necessary for List-type tags)
+            # take attributes from old values if they exist
+            %attrs = %{$$cap[1]};
+            if ($overwrite) {
+                my ($delPath, $oldLang, $delLang, $addLang, @matchingPaths);
+                # check to see if this is an indexed list item
+                if ($path =~ / /) {
+                    my $pp;
+                    ($pp = $path) =~ s/ \d+/ \\d\+/g;
+                    @matchingPaths = sort grep(/^$pp$/, keys %capture);
+                } else {
+                    push @matchingPaths, $path;
+                }
+                foreach $path (@matchingPaths) {
+                    my ($val, $attrs) = @{$capture{$path}};
+                    if ($writable eq 'lang-alt') {
+                        unless (defined $addLang) {
+                            # add to lang-alt list by default if creating this tag from scratch
+                            $addLang = $$nvHash{IsCreating} ? 1 : 0;
+                        }
+                        # get original language code (lc for comparisons)
+                        $oldLang = lc($$attrs{'xml:lang'} || 'x-default');
+                        if ($overwrite < 0) {
+                            my $newLang = lc($$tagInfo{LangCode} || 'x-default');
+                            next unless $oldLang eq $newLang;
+                            # only add new tag if we are overwriting this one
+                            # (note: this won't match if original XML contains CDATA!)
+                            $addLang = $et->IsOverwriting($nvHash, UnescapeXML($val));
+                            next unless $addLang;
+                        }
+                        # delete all if deleting "x-default" and writing with no LangCode
+                        # (XMP spec requires x-default language exist and be first in list)
+                        if ($oldLang eq 'x-default' and not $$tagInfo{LangCode}) {
+                            $delLang = 1;   # delete all languages
+                            $overwrite = 1; # force overwrite
+                        } elsif ($$tagInfo{LangCode} and not $delLang) {
+                            # only overwrite specified language
+                            next unless lc($$tagInfo{LangCode}) eq $oldLang;
+                        }
+                    } elsif ($overwrite < 0) {
+                        # only overwrite specific values
+                        if ($$nvHash{Shift}) {
+                            # values to be shifted are checked (hence re-formatted) late,
+                            # so we must un-format the to-be-shifted value for IsOverwriting()
+                            my $fmt = $$tagInfo{Writable} || '';
+                            if ($fmt eq 'rational') {
+                                ConvertRational($val);
+                            } elsif ($fmt eq 'date') {
+                                $val = ConvertXMPDate($val);
+                            }
+                        }
+                        # (note: this won't match if original XML contains CDATA!)
+                        next unless $et->IsOverwriting($nvHash, UnescapeXML($val));
+                    }
+                    if ($verbose > 1) {
+                        my $grp = $et->GetGroup($tagInfo, 1);
+                        my $tagName = $$tagInfo{Name};
+                        $tagName =~ s/-$$tagInfo{LangCode}$// if $$tagInfo{LangCode};
+                        $tagName .= '-' . $$attrs{'xml:lang'} if $$attrs{'xml:lang'};
+                        $et->VerboseValue("- $grp:$tagName", $val);
+                    }
+                    # save attributes and path from first deleted property
+                    # so we can replace it exactly
+                    unless ($delPath) {
+                        %attrs = %$attrs;
+                        $delPath = $path;
+                    }
+                    # delete this tag
+                    delete $capture{$path};
+                    ++$changed;
+                    # delete rdf:type tag if it is the only thing left in this structure
+                    if ($path =~ /^(.*)\// and $capture{"$1/rdf:type"}) {
+                        my $pp = $1;
+                        my @a = grep /^\Q$pp\E\/[^\/]+/, keys %capture;
+                        delete $capture{"$pp/rdf:type"} if @a == 1;
+                    }
+                }
+                next unless $delPath or $$tagInfo{List} or $addLang;
+                if ($delPath) {
+                    $path = $delPath;
+                    $deleted = 1;
+                } else {
+                    # don't change tag if we couldn't delete old copy
+                    # unless this is a list or an lang-alt tag
+                    next unless $$tagInfo{List} or $oldLang;
+                    # (match last index to put in same lang-alt list for Bag of lang-alt items)
+                    $path =~ m/.* (\d+)/g or warn "Internal error: no list index!\n", next;
+                    $added = $1;
+                }
+            } else {
+                # we are never overwriting, so we must be adding to a list
+                # match the last index unless this is a list of lang-alt lists
+                my $pat = $writable eq 'lang-alt' ? '.* (\d+)(.*? \d+)' : '.* (\d+)';
+                if ($path =~ m/$pat/g) {
+                    $added = $1;
+                    # set position to end of matching index number
+                    pos($path) = pos($path) - length($2) if $2;
+                }
+            }
+            if (defined $added) {
+                my $len = length $added;
+                my $pos = pos($path) - $len;
+                my $nxt = substr($added, 1) + 1;
+                # always insert x-default lang-alt entry first (as per XMP spec)
+                # (need to test $overwrite because this will be a new lang-alt entry otherwise)
+                if ($overwrite and $writable eq 'lang-alt' and (not $$tagInfo{LangCode} or
+                    $$tagInfo{LangCode} eq 'x-default'))
+                {
+                    my $saveCap = $capture{$path};
+                    for (;;) {
+                        my $p = $path;
+                        substr($p, $pos, $len) = length($nxt) . $nxt;
+                        # increment index in the path of the existing item
+                        my $nextCap = $capture{$p};
+                        $capture{$p} = $saveCap;
+                        last unless $nextCap;
+                        $saveCap = $nextCap;
+                        ++$nxt;
+                    }
+                } else {
+                    # add to end of list
+                    for (;;) {
+                        my $try = length($nxt) . $nxt;
+                        substr($path, $pos, $len) = $try;
+                        last unless $capture{$path};
+                        $len = length $try;
+                        ++$nxt;
+                    }
+                }
+            }
+        }
+        # check to see if we want to create this tag
+        # (create non-avoided tags in XMP data files by default)
+        my $isCreating = ($$nvHash{IsCreating} or (($isStruct or
+                          ($preferred and not $$tagInfo{Avoid} and
+                            not defined $$nvHash{Shift})) and not $$nvHash{EditOnly}));
+
+        # don't add new values unless...
+            # ...tag existed before and was deleted, or we added it to a list
+        next unless $deleted or defined $added or
+            # ...tag didn't exist before and we are creating it
+            (not $cap and $isCreating);
+
+        # get list of new values (all done if no new values specified)
+        my @newValues = $et->GetNewValues($nvHash) or next;
+
+        # set language attribute for lang-alt lists
+        $attrs{'xml:lang'} = $$tagInfo{LangCode} || 'x-default' if $writable eq 'lang-alt';
+
+        # add new value(s) to %capture hash
+        my $subIdx;
+        for (;;) {
+            my $newValue = shift @newValues;
+            if ($isStruct) {
+                ++$changed if AddNewStruct($et, $tagInfo, \%capture,
+                                           $path, $newValue, $$tagInfo{Struct});
+            } else {
+                $newValue = EscapeXML($newValue);
+                for (;;) { # (a cheap 'goto')
+                    if ($$tagInfo{Resource}) {
+                        # only store as a resource if it doesn't contain any illegal characters
+                        if ($newValue !~ /[^a-z0-9\:\/\?\#\[\]\@\!\$\&\'\(\)\*\+\,\;\=\.\-\_\~]/i) {
+                            $capture{$path} = [ '', { %attrs, 'rdf:resource' => $newValue } ];
+                            last;
+                        }
+                        my $grp = $et->GetGroup($tagInfo, 1);
+                        $et->Warn("$grp:$$tagInfo{Name} written as a literal because value is not a valid URI", 1);
+                        # fall through to write as a string literal
+                    }
+                    delete $attrs{'rdf:resource'};  # (remove existing resource if necessary)
+                    $capture{$path} = [ $newValue, \%attrs ];
+                    last;
+                }
+                if ($verbose > 1) {
+                    my $grp = $et->GetGroup($tagInfo, 1);
+                    $et->VerboseValue("+ $grp:$$tagInfo{Name}", $newValue);
+                }
+                ++$changed;
+                # add rdf:type if necessary
+                if ($$tagInfo{StructType}) {
+                    AddStructType($et, $$tagInfo{Table}, \%capture, $path);
+                }
+            }
+            last unless @newValues;
+            # match last index except for lang-alt items where we want to put each
+            # item in a different lang-alt list (so match the 2nd-last for these)
+            my $pat = $writable eq 'lang-alt' ? '.* (\d+)(.*? \d+)' : '.* (\d+)';
+            $path =~ m/$pat/g or warn("Internal error: no list index for $tag!\n"), next;
+            my $idx = $1;
+            my $len = length $1;
+            my $pos = pos($path) - $len - ($2 ? length $2 : 0);
+            # generate unique list sub-indices to store additional values in sequence
+            if ($subIdx) {
+                $idx = substr($idx, 0, -length($subIdx));   # remove old sub-index
+                $subIdx = substr($subIdx, 1) + 1;
+                $subIdx = length($subIdx) . $subIdx;
+            } else {
+                $subIdx = '10';
+            }
+            substr($path, $pos, $len) = $idx . $subIdx;
+        }
+        # make sure any empty structures are deleted
+        # (ExifTool shouldn't write these, but other software may)
+        if (defined $$tagInfo{Flat}) {
+            my $p = $path;
+            while ($p =~ s/\/[^\/]+$//) {
+                next unless $capture{$p};
+                # it is an error if this property has a value
+                $et->Error("Improperly structured XMP ($p)",1) if $capture{$p}[0] =~ /\S/;
+                delete $capture{$p};    # delete the (hopefully) empty structure
+            }
+        }
+    }
+    # remove the ExifTool members we created
+    delete $$et{XMP_CAPTURE};
+    delete $$et{XMP_NS};
+
+    my $maxDataLen = $$dirInfo{MaxDataLen};
+    # get DataPt again because it may have been set by ProcessXMP
+    $dataPt = $$dirInfo{DataPt};
+    # return now if we didn't change anything
+    unless ($changed or ($maxDataLen and $dataPt and defined $$dataPt and
+        length($$dataPt) > $maxDataLen))
+    {
+        return undef unless $xmpFile;   # just rewrite original XMP
+        Write($$dirInfo{OutFile}, $$dataPt) or return -1 if $dataPt and defined $$dataPt;
+        return 1;
+    }
+#
+# write out the new XMP information (serialize it)
+#
+    # start writing the XMP data
+    my $newData = '';
+    if ($$et{XMP_NO_XPACKET}) {
+        # write BOM if flag is set
+        $newData .= "\xef\xbb\xbf" if $$et{XMP_NO_XPACKET} == 2;
+    } else {
+        $newData .= $pktOpen;
+    }
+    $newData .= $xmlOpen if $$et{XMP_IS_XML};
+    $newData .= $xmpOpen . $rdfOpen;
+
+    # initialize current property path list
+    my (@curPropList, @writeLast, @descStart, $extStart);
+    my (%nsCur, $prop, $n, $path);
+    my @pathList = sort TypeFirst keys %capture;
+    # order properties to write large values last if we have a MaxDataLen limit
+    if ($maxDataLen and @pathList) {
+        my @pathTmp;
+        my ($lastProp, $lastNS, $propSize) = ('', '', 0);
+        my @pathLoop = (@pathList, ''); # add empty path to end of list for loop
+        undef @pathList;
+        foreach $path (@pathLoop) {
+            $path =~ /^((\w*)[^\/]*)/;  # get path element ($1) and ns ($2)
+            if ($1 eq $lastProp) {
+                push @pathTmp, $path;   # accumulate all paths with same root
+            } else {
+                # put in list to write last if recommended or values are too large
+                if ($extendedRes{$lastProp} or $extendedRes{$lastNS} or
+                    $propSize > $newDescThresh)
+                {
+                    push @writeLast, @pathTmp;
+                } else {
+                    push @pathList, @pathTmp;
+                }
+                last unless $path;      # all done if we hit empty path
+                @pathTmp = ( $path );
+                ($lastProp, $lastNS, $propSize) = ($1, $2, 0);
+            }
+            $propSize += length $capture{$path}->[0];
+        }
+    }
+
+    # write out all properties
+    for (;;) {
+        my (%nsNew, $newDesc);
+        unless (@pathList) {
+            last unless @writeLast;
+            @pathList = @writeLast;
+            undef @writeLast;
+            $extStart = length $newData;
+            $newDesc = 1;   # start with a new description
+        }
+        $path = shift @pathList;
+        my @propList = split('/',$path); # get property list
+        # must open/close rdf:Description too
+        unshift @propList, $rdfDesc;
+        # make sure we have defined all necessary namespaces
+        foreach $prop (@propList) {
+            $prop =~ /(.*):/ or next;
+            $1 eq 'rdf' and next;       # rdf namespace already defined
+            my $uri = $nsUsed{$1};
+            unless ($uri) {
+                $uri = $nsURI{$1};      # we must have added a namespace
+                $uri or $xmpErr = "Undefined XMP namespace: $1", next;
+            }
+            $nsNew{$1} = $uri;
+            # need a new description if any new namespaces
+            $newDesc = 1 unless $nsCur{$1};
+        }
+        my $closeTo = 0;
+        if ($newDesc) {
+            # look forward to see if we will want to also open other namespaces
+            # at this level (this is necessary to keep lists and structures from
+            # being broken if a property introduces a new namespace; plus it
+            # improves formatting)
+            my ($path2, $ns2);
+            foreach $path2 (@pathList) {
+                my @ns2s = ($path2 =~ m{(?:^|/)([^/]+?):}g);
+                my $opening = 0;
+                foreach $ns2 (@ns2s) {
+                    next if $ns2 eq 'rdf';
+                    $nsNew{$ns2} and ++$opening, next;
+                    last unless $opening;
+                    # get URI for this existing or new namespace
+                    my $uri = $nsUsed{$ns2} || $nsURI{$ns2} or last;
+                    $nsNew{$ns2} = $uri; # also open this namespace
+                }
+                last unless $opening;
+            }
+        } else {
+            # find first property where the current path differs from the new path
+            for ($closeTo=0; $closeTo<@curPropList; ++$closeTo) {
+                last unless $closeTo < @propList;
+                last unless $propList[$closeTo] eq $curPropList[$closeTo];
+            }
+        }
+        # close out properties down to the common base path
+        while (@curPropList > $closeTo) {
+            ($prop = pop @curPropList) =~ s/ .*//;
+            $newData .= (' ' x scalar(@curPropList)) . " </$prop>\n";
+        }
+        if ($newDesc) {
+            # save rdf:Description start positions so we can reorder them if necessary
+            push @descStart, length($newData) if $maxDataLen;
+            # open the new description
+            $prop = $rdfDesc;
+            %nsCur = %nsNew;            # save current namespaces
+            $newData .= "\n <$prop rdf:about='$about'";
+            my @ns = sort keys %nsCur;
+            # generate et:toolkit attribute if this is an exiftool RDF/XML output file
+            if (@ns and $nsCur{$ns[0]} =~ m{^http://ns.exiftool.ca/}) {
+                $newData .= "\n  xmlns:et='http://ns.exiftool.ca/1.0/'" .
+                            " et:toolkit='Image::ExifTool $Image::ExifTool::VERSION'";
+            }
+            foreach (@ns) {
+                $newData .= "\n  xmlns:$_='$nsCur{$_}'";
+            }
+            $newData .= ">\n";
+            push @curPropList, $prop;
+        }
+        # loop over all values for this new property
+        my ($val, $attrs) = @{$capture{$path}};
+        $debug and print "$path = $val\n";
+        # open new properties
+        my $attr;
+        for ($n=@curPropList; $n<$#propList; ++$n) {
+            $prop = $propList[$n];
+            push @curPropList, $prop;
+            # remove list index if it exists
+            $prop =~ s/ .*//;
+            $attr = '';
+            if ($prop ne $rdfDesc and ($propList[$n+1] !~ /^rdf:/ or
+                ($propList[$n+1] eq 'rdf:type' and $n+1 == $#propList)))
+            {
+                # need parseType='Resource' to avoid new 'rdf:Description'
+                $attr = " rdf:parseType='Resource'";
+            }
+            $newData .= (' ' x scalar(@curPropList)) . "<$prop$attr>\n";
+        }
+        my $prop2 = pop @propList;  # get new property name
+        $prop2 =~ s/ .*//;          # remove list index if it exists
+        $newData .= (' ' x scalar(@curPropList)) . " <$prop2";
+        # write out attributes
+        foreach $attr (sort keys %$attrs) {
+            my $attrVal = $$attrs{$attr};
+            my $quot = ($attrVal =~ /'/) ? '"' : "'";
+            $newData .= " $attr=$quot$attrVal$quot";
+        }
+        $newData .= length $val ? ">$val</$prop2>\n" : "/>\n";
+    }
+    # close off any open elements
+    while ($prop = pop @curPropList) {
+        $prop =~ s/ .*//;   # remove list index if it exists
+        $newData .= (' ' x scalar(@curPropList)) . " </$prop>\n";
+    }
+    # limit XMP length and re-arrange if necessary to fit inside specified size
+    my $compact = $$dirInfo{Compact} || $et->Options('Compact');
+    if ($maxDataLen) {
+        # adjust maxDataLen to allow room for closing elements
+        $maxDataLen -= length($rdfClose) + length($xmpClose) + length($pktCloseW);
+        $extStart or $extStart = length $newData;
+        my @rtn = LimitXMPSize($et, \$newData, $maxDataLen, $about, \@descStart, $extStart);
+        # return extended XMP information in $dirInfo
+        $$dirInfo{ExtendedXMP} = $rtn[0];
+        $$dirInfo{ExtendedGUID} = $rtn[1];
+        # compact if necessary to fit
+        $compact = 1 if length($newData) + 101 * $numPadLines > $maxDataLen;
+    }
+#
+# close out the XMP, clean up, and return our data
+#
+    $newData .= $rdfClose;
+    $newData .= $xmpClose unless $$et{XMP_NO_XMPMETA};
+
+    # remove the ExifTool members we created
+    delete $$et{XMP_CAPTURE};
+    delete $$et{XMP_NS};
+    delete $$et{XMP_NO_XMPMETA};
+
+    # (the XMP standard recommends writing 2k-4k of white space before the
+    # packet trailer, with a newline every 100 characters)
+    unless ($$et{XMP_NO_XPACKET}) {
+        my $pad = (' ' x 100) . "\n";
+        if ($$dirInfo{InPlace}) {
+            # pad to specified DirLen
+            my $len = length($newData) + length($pktCloseW);
+            if ($len > $dirLen) {
+                $et->Warn('Not enough room to edit XMP in place');
+                return undef;
+            }
+            my $num = int(($dirLen - $len) / length($pad));
+            if ($num) {
+                $newData .= $pad x $num;
+                $len += length($pad) * $num;
+            }
+            $len < $dirLen and $newData .= (' ' x ($dirLen - $len - 1)) . "\n";
+        } elsif (not $compact and not $xmpFile and not $$dirInfo{ReadOnly}) {
+            $newData .= $pad x $numPadLines;
+        }
+        $newData .= ($$dirInfo{ReadOnly} ? $pktCloseR : $pktCloseW);
+    }
+    # return empty data if no properties exist and this is allowed
+    unless (%capture or $xmpFile or $$dirInfo{InPlace} or $$dirInfo{NoDelete}) {
+        $newData = '';
+    }
+    if ($xmpErr) {
+        if ($xmpFile) {
+            $et->Error($xmpErr);
+            return -1;
+        }
+        $et->Warn($xmpErr);
+        return undef;
+    }
+    $$et{CHANGED} += $changed;
+    $debug > 1 and $newData and print $newData,"\n";
+    return $newData unless $xmpFile;
+    Write($$dirInfo{OutFile}, $newData) or return -1;
+    return 1;
+}
+
+
+1; # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WriteXMP.pl - Write XMP meta information
+
+=head1 SYNOPSIS
+
+These routines are autoloaded by Image::ExifTool::XMP.
+
+=head1 DESCRIPTION
+
+This file contains routines to write XMP metadata.
+
+=head1 AUTHOR
+
+Copyright 2003-2015, 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::XMP(3pm)|Image::ExifTool::XMP>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut