Ignore:
Timestamp:
2021-02-26T19:39:51+13:00 (3 years ago)
Author:
anupama
Message:

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/cpan/Image/ExifTool/WriteXMP.pl

    r24107 r34921  
    99
    1010use strict;
    11 use vars qw(%specialStruct %dateTimeInfo $xlatNamespace);
     11use vars qw(%specialStruct %dateTimeInfo %stdXlatNS);
    1212
    1313use Image::ExifTool qw(:DataAccess :Utils);
    1414
    15 sub CheckXMP($$$);
     15sub CheckXMP($$$;$);
    1616sub CaptureXMP($$$;$);
    1717sub SetPropertyPath($$;$$$$);
    … …  
    4646my $pktCloseW =  "<?xpacket end='w'?>"; # writable by default
    4747my $pktCloseR =  "<?xpacket end='r'?>";
     48my ($sp, $nl);
    4849
    4950#------------------------------------------------------------------------------
    … …  
    5354sub XMPOpen($)
    5455{
    55     my $exifTool = shift;
    56     my $nv = $exifTool->{NEW_VALUE}->{$Image::ExifTool::XMP::x{xmptk}};
     56    my $et = shift;
     57    my $nv = $$et{NEW_VALUE}{$Image::ExifTool::XMP::x{xmptk}};
    5758    my $tk;
    5859    if (defined $nv) {
    59         $tk = Image::ExifTool::GetNewValues($nv);
    60         $exifTool->VerboseValue(($tk ? '+' : '-') . ' XMP-x:XMPToolkit', $tk);
    61         ++$exifTool->{CHANGED};
     60        $tk = $et->GetNewValue($nv);
     61        $et->VerboseValue(($tk ? '+' : '-') . ' XMP-x:XMPToolkit', $tk);
     62        ++$$et{CHANGED};
    6263    } else {
    6364        $tk = "Image::ExifTool $Image::ExifTool::VERSION";
    … …  
    7475{
    7576    my ($xmpPt, $mode) = @_;
     77    $$xmpPt =~ s/^\s*<!--.*?-->\s*//s; # remove leading comment if it exists
    7678    unless ($$xmpPt =~ /^\0*<\0*\?\0*x\0*p\0*a\0*c\0*k\0*e\0*t/) {
    7779        return '' unless $$xmpPt =~ /^<x(mp)?:x[ma]pmeta/;
    … …  
    8890
    8991#------------------------------------------------------------------------------
     92# Validate XMP property
     93# Inputs: 0) ExifTool ref, 1) validate hash ref, 2) attribute hash ref
     94# - issues warnings if problems detected
     95sub ValidateProperty($$;$)
     96{
     97    my ($et, $propList, $attr) = @_;
     98
     99    if ($$et{XmpValidate} and @$propList > 2) {
     100        if ($$propList[0] =~ /^x:x[ma]pmeta$/ and
     101            $$propList[1] eq 'rdf:RDF' and
     102            $$propList[2] =~ /rdf:Description( |$)/)
     103        {
     104            if (@$propList > 3) {
     105                if ($$propList[-1] =~ /^rdf:(Bag|Seq|Alt)$/) {
     106                    $et->Warn("Ignored empty $$propList[-1] list for $$propList[-2]", 1);
     107                } else {
     108                    if ($$propList[-2] eq 'rdf:Alt' and $attr) {
     109                        my $lang = $$attr{'xml:lang'};
     110                        if ($lang and @$propList >= 5) {
     111                            my $langPath = join('/', @$propList[3..($#$propList-2)]);
     112                            my $valLang = $$et{XmpValidateLangAlt} || ($$et{XmpValidateLangAlt} = { });
     113                            $$valLang{$langPath} or $$valLang{$langPath} = { };
     114                            if ($$valLang{$langPath}{$lang}) {
     115                                $et->WarnOnce("Duplicate language ($lang) in lang-alt list: $langPath");
     116                            } else {
     117                                $$valLang{$langPath}{$lang} = 1;
     118                            }
     119                        }
     120                    }
     121                    my $xmpValidate = $$et{XmpValidate};
     122                    my $path = join('/', @$propList[3..$#$propList]);
     123                    if (defined $$xmpValidate{$path}) {
     124                        $et->Warn("Duplicate XMP property: $path");
     125                    } else {
     126                        $$xmpValidate{$path} = 1;
     127                    }
     128                }
     129            }
     130        } elsif ($$propList[0] ne 'rdf:RDF' or
     131                 $$propList[1] !~ /rdf:Description( |$)/)
     132        {
     133            $et->Warn('Improperly enclosed XMP property: ' . join('/',@$propList));
     134        }
     135    }
     136}
     137
     138#------------------------------------------------------------------------------
    90139# Check XMP date values for validity and format accordingly
    91 # Inputs: 1) date string
     140# Inputs: 1) EXIF-format date string
    92141# Returns: XMP date/time string (or undef on error)
    93142sub FormatXMPDate($)
    … …  
    117166#------------------------------------------------------------------------------
    118167# Check XMP values for validity and format accordingly
    119 # Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref
     168# Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref, 3) conversion type
    120169# Returns: error string or undef (and may change value) on success
    121170# Note: copies structured information to avoid conflicts with calling code
    122 sub CheckXMP($$$)
    123 {
    124     my ($exifTool, $tagInfo, $valPtr) = @_;
     171sub CheckXMP($$$;$)
     172{
     173    my ($et, $tagInfo, $valPtr, $convType) = @_;
    125174
    126175    if ($$tagInfo{Struct}) {
    … …  
    130179            ($$valPtr, $warn) = InflateStruct($valPtr);
    131180            # expect a structure HASH ref or ARRAY of structures
    132             ref $$valPtr or return 'Improperly formed structure';
     181            unless (ref $$valPtr) {
     182                $$valPtr eq '' and $$valPtr = { }, return undef; # allow empty structures
     183                return 'Improperly formed structure';
     184            }
    133185        }
    134186        if (ref $$valPtr eq 'ARRAY') {
    … …  
    144196                    last;
    145197                }
    146                 ($item, $err) = CheckStruct($exifTool, $item, $$tagInfo{Struct});
     198                ($item, $err) = CheckStruct($et, $item, $$tagInfo{Struct});
    147199                last if $err;
    148200            }
    149201        } else {
    150             ($$valPtr, $err) = CheckStruct($exifTool, $$valPtr, $$tagInfo{Struct});
    151         }
    152         $warn and $$exifTool{CHECK_WARN} = $warn;
     202            ($$valPtr, $err) = CheckStruct($et, $$valPtr, $$tagInfo{Struct});
     203        }
     204        $warn and $$et{CHECK_WARN} = $warn;
    153205        return $err;
    154206    }
    155     my $format = $tagInfo->{Writable};
     207    my $format = $$tagInfo{Writable};
    156208    # (if no format specified, value is a simple string)
    157209    if (not $format or $format eq 'string' or $format eq 'lang-alt') {
    158210        # convert value to UTF8 if necessary
    159         if ($exifTool->{OPTIONS}->{Charset} ne 'UTF8') {
     211        if ($$et{OPTIONS}{Charset} ne 'UTF8') {
    160212            if ($$valPtr =~ /[\x80-\xff]/) {
    161213                # convert from Charset to UTF-8
    162                 $$valPtr = $exifTool->Encode($$valPtr,'UTF8');
     214                $$valPtr = $et->Encode($$valPtr,'UTF8');
    163215            }
    164216        } else {
    … …  
    166218            $$valPtr =~ tr/\0-\x08\x0b\x0c\x0e-\x1f/./;
    167219            # fix any malformed UTF-8 characters
    168             if (FixUTF8($valPtr) and not $$exifTool{WarnBadUTF8}) {
    169                 $exifTool->Warn('Malformed UTF-8 character(s)');
    170                 $$exifTool{WarnBadUTF8} = 1;
     220            if (FixUTF8($valPtr) and not $$et{WarnBadUTF8}) {
     221                $et->Warn('Malformed UTF-8 character(s)');
     222                $$et{WarnBadUTF8} = 1;
    171223            }
    172224        }
    … …  
    180232             $$valPtr eq 'undef' or Image::ExifTool::IsRational($$valPtr))))
    181233        {
    182             return 'Not a floating point number' 
     234            return 'Not a floating point number';
    183235        }
    184236        if ($format eq 'rational') {
    … …  
    199251        $$valPtr = $newDate;
    200252    } elsif ($format eq 'boolean') {
     253        # (allow lower-case 'true' and 'false' if not setting PrintConv value)
    201254        if (not $$valPtr or $$valPtr =~ /false/i or $$valPtr =~ /^no$/i) {
    202             $$valPtr = 'False';
    203         } else {
     255            if (not $$valPtr or $$valPtr ne 'false' or not $convType or $convType eq 'PrintConv') {
     256                $$valPtr = 'False';
     257            }
     258        } elsif ($$valPtr ne 'true' or not $convType or $convType eq 'PrintConv') {
    204259            $$valPtr = 'True';
    205260        }
    … …  
    235290    my $table = $structPtr || $tagTablePtr;
    236291    my $tagInfo = $$table{$tagID};
    237 
    238     return if ref($tagInfo) ne 'HASH' or $$tagInfo{PropertyPath};
    239 
    240     # don't override existing main table entry if already set by a Struct
     292    my $flatInfo;
     293
     294    return if ref($tagInfo) ne 'HASH'; # (shouldn't happen)
     295
    241296    if ($structPtr) {
     297        my $flatID = $parentID . ucfirst($tagID);
     298        $flatInfo = $$tagTablePtr{$flatID};
     299        if ($flatInfo) {
     300            return if $$flatInfo{PropertyPath};
     301        } else {
     302            # flattened tag doesn't exist, so create it now
     303            # (could happen if we were just writing a structure)
     304            $flatInfo = { Name => ucfirst($flatID), Flat => 1 };
     305            AddTagToTable($tagTablePtr, $flatID, $flatInfo);
     306        }
    242307        $isType = 1 if $$structPtr{TYPE};
    243308    } else {
     309        # don't override existing main table entry if already set by a Struct
     310        return if $$tagInfo{PropertyPath};
    244311        # use property path from original tagInfo if this is an alternate-language tag
    245312        my $srcInfo = $$tagInfo{SrcTagInfo};
    … …  
    251318            return if $$tagInfo{PropertyPath};
    252319            warn "Internal Error: Didn't set path from root for $tagID\n";
     320            warn "(Is the Struct NAMESPACE defined?)\n";
    253321        }
    254322    }
    … …  
    263331        # remove language code from property path if it exists
    264332        $propList[-1] =~ s/-$$tagInfo{LangCode}$// if $$tagInfo{LangCode};
    265         # handle lists of lang-alt lists (ie. XMP-plus:Custom tags)
     333        # handle lists of lang-alt lists (eg. XMP-plus:Custom tags)
    266334        if ($$tagInfo{List} and $$tagInfo{List} ne '1') {
    267335            push @propList, "rdf:$$tagInfo{List}", 'rdf:li 10';
    … …  
    273341    push @propList, "rdf:$listType", 'rdf:li 10' if $listType and $listType ne '1';
    274342    # set PropertyPath for all flattened tags of this structure if necessary
    275     # (note: don't do this for variable-namespace structures (undef NAMESPACE))
    276343    my $strTable = $$tagInfo{Struct};
    277     if ($strTable and $$strTable{NAMESPACE}) {
     344    if ($strTable and not ($parentID and
     345        # must test NoSubStruct flag to avoid infinite recursion
     346        (($$tagTablePtr{$parentID} and $$tagTablePtr{$parentID}{NoSubStruct}) or
     347        length $parentID > 500))) # avoid deep recursion
     348    {
    278349        # make sure the structure namespace has been registered
    279350        # (user-defined namespaces may not have been)
    … …  
    290361    # we set PropertyPath in the corresponding flattened tag
    291362    if ($structPtr) {
    292         my $flatID = $parentID . ucfirst($tagID);
    293         $tagInfo = $$tagTablePtr{$flatID};
    294         # create flattened tag now if necessary
    295         # (could happen if we were just writing a structure)
    296         unless ($tagInfo) {
    297             $tagInfo = { Name => ucfirst($flatID), Flat => 1 };
    298             Image::ExifTool::AddTagToTable($tagTablePtr, $flatID, $tagInfo);
    299         }
     363        $tagInfo = $flatInfo;
    300364        # set StructType flag if any containing structure has a TYPE
    301365        $$tagInfo{StructType} = 1 if $isType;
    … …  
    312376sub CaptureXMP($$$;$)
    313377{
    314     my ($exifTool, $propList, $val, $attrs) = @_;
     378    my ($et, $propList, $val, $attrs) = @_;
    315379    return unless defined $val and @$propList > 2;
    316380    if ($$propList[0] =~ /^x:x[ma]pmeta$/ and
    … …  
    322386        # ignore empty list properties
    323387        if ($$propList[-1] =~ /^rdf:(Bag|Seq|Alt)$/) {
    324             $exifTool->Warn("Ignored empty $$propList[-1] list for $$propList[-2]", 1);
     388            $et->Warn("Ignored empty $$propList[-1] list for $$propList[-2]", 1);
    325389            return;
    326390        }
    327391        # save information about this property
    328         my $capture = $exifTool->{XMP_CAPTURE};
     392        my $capture = $$et{XMP_CAPTURE};
    329393        my $path = join('/', @$propList[3..$#$propList]);
    330394        if (defined $$capture{$path}) {
    331             $exifTool->{XMP_ERROR} = "Duplicate XMP property: $path";
     395            $$et{XMP_ERROR} = "Duplicate XMP property: $path";
    332396        } else {
    333397            $$capture{$path} = [$val, $attrs || { }];
    … …  
    337401    {
    338402        # set flag so we don't write x:xmpmeta element
    339         $exifTool->{XMP_NO_XMPMETA} = 1;
     403        $$et{XMP_NO_XMPMETA} = 1;
    340404        # add missing x:xmpmeta element and try again
    341405        unshift @$propList, 'x:xmpmeta';
    342         CaptureXMP($exifTool, $propList, $val, $attrs);
     406        CaptureXMP($et, $propList, $val, $attrs);
    343407    } else {
    344         $exifTool->{XMP_ERROR} = 'Improperly enclosed XMP property: ' . join('/',@$propList);
     408        $$et{XMP_ERROR} = 'Improperly enclosed XMP property: ' . join('/',@$propList);
    345409    }
    346410}
    … …  
    374438            }
    375439        }
    376         $blankInfo->{Prop}->{$id}->{Pre}->{$pre} = 1;
     440        $$blankInfo{Prop}{$id}{Pre}{$pre} = 1;
    377441        if ((defined $post and length $post) or (defined $val and length $val)) {
    378442            # save the property value and attributes for each unique path suffix
    379             $blankInfo->{Prop}->{$id}->{Post}->{$post} = [ $val, $attrs, $propPath ];
     443            $$blankInfo{Prop}{$id}{Post}{$post} = [ $val, $attrs, $propPath ];
    380444        }
    381445    }
    … …  
    388452sub ProcessBlankInfo($$$;$)
    389453{
    390     my ($exifTool, $tagTablePtr, $blankInfo, $isWriting) = @_;
    391     $exifTool->VPrint(1, "  [Elements with nodeID set:]\n") unless $isWriting;
     454    my ($et, $tagTablePtr, $blankInfo, $isWriting) = @_;
     455    $et->VPrint(1, "  [Elements with nodeID set:]\n") unless $isWriting;
    392456    my ($id, $pre, $post);
    393457    # handle each nodeID separately
    394458    foreach $id (sort keys %{$$blankInfo{Prop}}) {
    395         my $path = $blankInfo->{Prop}->{$id};
     459        my $path = $$blankInfo{Prop}{$id};
    396460        # flag all resource names so we can warn later if some are unused
    397461        my %unused;
    398         foreach $post (keys %{$path->{Post}}) {
     462        foreach $post (keys %{$$path{Post}}) {
    399463            $unused{$post} = 1;
    400464        }
    401465        # combine property paths for all possible paths through this node
    402         foreach $pre (sort keys %{$path->{Pre}}) {
     466        foreach $pre (sort keys %{$$path{Pre}}) {
    403467            # there will be no description for the object of a blank node
    404468            next unless $pre =~ m{/$rdfDesc/};
    405             foreach $post (sort keys %{$path->{Post}}) {
     469            foreach $post (sort keys %{$$path{Post}}) {
    406470                my @propList = split m{/}, "$pre$post";
    407                 my ($val, $attrs) = @{$path->{Post}->{$post}};
     471                my ($val, $attrs) = @{$$path{Post}{$post}};
    408472                if ($isWriting) {
    409                     CaptureXMP($exifTool, \@propList, $val, $attrs);
     473                    CaptureXMP($et, \@propList, $val, $attrs);
    410474                } else {
    411                     FoundXMP($exifTool, $tagTablePtr, \@propList, $val);
     475                    FoundXMP($et, $tagTablePtr, \@propList, $val);
    412476                }
    413477                delete $unused{$post};
    … …  
    416480        # save information from unused properties (if RDF is malformed like f-spot output)
    417481        if (%unused) {
    418             $exifTool->Options('Verbose') and $exifTool->Warn('An XMP resource is about nothing');
     482            $et->Options('Verbose') and $et->Warn('An XMP resource is about nothing');
    419483            foreach $post (sort keys %unused) {
    420                 my ($val, $attrs, $propPath) = @{$path->{Post}->{$post}};
     484                my ($val, $attrs, $propPath) = @{$$path{Post}{$post}};
    421485                my @propList = split m{/}, $propPath;
    422486                if ($isWriting) {
    423                     CaptureXMP($exifTool, \@propList, $val, $attrs);
     487                    CaptureXMP($et, \@propList, $val, $attrs);
    424488                } else {
    425                     FoundXMP($exifTool, $tagTablePtr, \@propList, $val);
     489                    FoundXMP($et, $tagTablePtr, \@propList, $val);
    426490                }
    427491            }
    … …  
    437501sub ConformPathToNamespace($$)
    438502{
    439     my ($exifTool, $path) = @_;
     503    my ($et, $path) = @_;
    440504    my @propList = split('/',$path);
    441     my $nsUsed = $exifTool->{XMP_NS};
     505    my $nsUsed = $$et{XMP_NS};
    442506    my $prop;
    443507    foreach $prop (@propList) {
    … …  
    446510        my $uri = $nsURI{$ns};
    447511        unless ($uri) {
    448             warn "No URI for namepace prefix $ns!\n";
     512            warn "No URI for namespace prefix $ns!\n";
    449513            next;
    450514        }
    … …  
    467531sub AddStructType($$$$;$)
    468532{
    469     my ($exifTool, $tagTablePtr, $capture, $path, $basePath) = @_;
     533    my ($et, $tagTablePtr, $capture, $path, $basePath) = @_;
    470534    my @props = split '/', $path;
    471535    my %doneID;
    … …  
    483547                my $pat = $$tagInfo{PropertyPath};
    484548                $pat or warn("Missing PropertyPath in AddStructType\n"), last;
    485                 $pat = ConformPathToNamespace($exifTool, $pat);
     549                $pat = ConformPathToNamespace($et, $pat);
    486550                $pat =~  s/ \d+/ \\d\+/g;
    487551                $path =~ /^($pat)/ or warn("Wrong path in AddStructType\n"), last;
    … …  
    496560
    497561#------------------------------------------------------------------------------
     562# Hack to use XMP writer for SphericalVideoXML
     563# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
     564# Returns: SphericalVideoXML data
     565sub WriteGSpherical($$$)
     566{
     567    my ($et, $dirInfo, $tagTablePtr) = @_;
     568    $$dirInfo{Compact} = 1,
     569    my $dataPt = $$dirInfo{DataPt};
     570    if ($dataPt and $$dataPt) {
     571        # make it look like XMP for writing
     572        my $buff = $$dataPt;
     573        $buff =~ s/<rdf:SphericalVideo/<?xpacket begin='.*?' id='W5M0MpCehiHzreSzNTczkc9d'?>\n<x:xmpmeta xmlns:x='adobe:ns:meta\/'><rdf:RDF/;
     574        $buff =~ s/\s*xmlns:GSpherical/>\n<rdf:Description xmlns:GSpherical/s;
     575        $buff =~ s/<\/rdf:SphericalVideo>/<\/rdf:Description>/;
     576        $buff .= "</rdf:RDF></x:xmpmeta><?xpacket end='w'?>";
     577        $$dirInfo{DataPt} = \$buff;
     578        $$dirInfo{DirLen} = length($buff) - ($$dirInfo{DirStart} || 0);
     579    }
     580    my $xmp = Image::ExifTool::XMP::WriteXMP($et, $dirInfo, $tagTablePtr);
     581    if ($xmp) {
     582        # change back to rdf:SphericalVideo structure
     583        $xmp =~ s/^<\?xpacket begin.*?<rdf:RDF/<rdf:SphericalVideo\n/s;
     584        $xmp =~ s/>\s*<rdf:Description rdf:about=''\s*/\n /;
     585        $xmp =~ s/\s*<\/rdf:Description>\s*(<\/rdf:RDF>)/\n<\/rdf:SphericalVideo>$1/s;
     586        $xmp =~ s/\s*<\/rdf:RDF>\s*<\/x:xmpmeta>.*//s;
     587    }
     588    return $xmp;
     589}
     590
     591#------------------------------------------------------------------------------
    498592# Utility routine to encode data in base64
    499 # Inputs: 0) binary data string
     593# Inputs: 0) binary data string, 1) flag to avoid inserting newlines
    500594# Returns:   base64-encoded string
    501 sub EncodeBase64($)
     595sub EncodeBase64($;$)
    502596{
    503597    # encode the data in 45-byte chunks
    … …  
    517611    my $pad = 3 - ($len % 3);
    518612    substr($str, -$pad-1, $pad) = ('=' x $pad) if $pad < 3;
     613    $str =~ tr/\n//d if $_[1];  # remove newlines if specified
    519614    return $str;
    520615}
    … …  
    547642sub LimitXMPSize($$$$$$)
    548643{
    549     my ($exifTool, $dataPt, $maxLen, $about, $startPt, $extStart) = @_;
     644    my ($et, $dataPt, $maxLen, $about, $startPt, $extStart) = @_;
    550645
    551646    # return straight away if it isn't too big
    … …  
    556651    my $guid = '0' x 32;
    557652    # write the required xmpNote:HasExtendedXMP property
    558     $newData .= "\n <$rdfDesc rdf:about='$about'\n  xmlns:xmpNote='$nsURI{xmpNote}'>\n" .
    559                   "  <xmpNote:HasExtendedXMP>$guid</xmpNote:HasExtendedXMP>\n" .
    560                   " </$rdfDesc>\n";
     653    $newData .= "$nl$sp<$rdfDesc rdf:about='${about}'\n$sp${sp}xmlns:xmpNote='$nsURI{xmpNote}'";
     654    if ($$et{OPTIONS}{Compact}{Shorthand}) {
     655        $newData .= "\n$sp${sp}xmpNote:HasExtendedXMP='${guid}'/>\n";
     656    } else {
     657        $newData .= ">$nl$sp$sp<xmpNote:HasExtendedXMP>$guid</xmpNote:HasExtendedXMP>$nl$sp</$rdfDesc>\n";
     658    }
    561659
    562660    my ($i, %descSize, $start);
    … …  
    568666    # write the descriptions from smallest to largest, as many in main XMP as possible
    569667    my @descStart = sort { $descSize{$a} <=> $descSize{$b} } @$startPt;
    570     my $extData = XMPOpen($exifTool) . $rdfOpen;
     668    my $extData = XMPOpen($et) . $rdfOpen;
    571669    for ($i=0; $i<2; ++$i) {
    572670      foreach $start (@descStart) {
    … …  
    579677    $extData .= $rdfClose . $xmpClose;  # close rdf:RDF and x:xmpmeta
    580678    # calculate GUID from MD5 of extended XMP data
    581     if (eval 'require Digest::MD5') {
     679    if (eval { require Digest::MD5 }) {
    582680        $guid = uc unpack('H*', Digest::MD5::md5($extData));
    583681        $newData =~ s/0{32}/$guid/;     # update GUID in main XMP segment
    584682    }
    585     $exifTool->VerboseValue('+ XMP-xmpNote:HasExtendedXMP', $guid);
     683    $et->VerboseValue('+ XMP-xmpNote:HasExtendedXMP', $guid);
    586684    $$dataPt = $newData;        # return main XMP block
    587685    return (\$extData, $guid);  # return extended XMP and its GUID
    … …  
    589687
    590688#------------------------------------------------------------------------------
     689# Close out bottom-level property
     690# Inputs: 0) current property path list ref, 1) longhand properties at each resource
     691#         level, 2) shorthand properties at each resource level, 3) resource flag for
     692#         each property path level (set only if Shorthand is enabled)
     693sub CloseProperty($$$$)
     694{
     695    my ($curPropList, $long, $short, $resFlag) = @_;
     696
     697    my $prop = pop @$curPropList;
     698    $prop =~ s/ .*//;       # remove list index if it exists
     699    my $pad = $sp x (scalar(@$curPropList) + 1);
     700    if ($$resFlag[@$curPropList]) {
     701        # close this XMP structure with possible shorthand properties
     702        if (length $$short[-1]) {
     703            if (length $$long[-1]) {
     704                # require a new Description if both longhand and shorthand properties
     705                $$long[-2] .= ">$nl$pad<$rdfDesc";
     706                $$short[-1] .= ">$nl";
     707                $$long[-1] .= "$pad</$rdfDesc>$nl";
     708            } else {
     709                # simply close empty property if all shorthand
     710                $$short[-1] .= "/>$nl";
     711            }
     712        } else {
     713            # use "parseType" instead of opening a new Description
     714            $$long[-2] .= ' rdf:parseType="Resource"';
     715            $$short[-1] = length $$long[-1] ? ">$nl" : "/>$nl";
     716        }
     717        $$long[-1] .= "$pad</$prop>$nl" if length $$long[-1];
     718        $$long[-2] .= $$short[-1] . $$long[-1];
     719        pop @$short;
     720        pop @$long;
     721    } elsif (defined $$resFlag[@$curPropList]) {
     722        # close this top level Description with possible shorthand values
     723        if (length $$long[-1]) {
     724            $$long[-2] .= $$short[-1] . ">$nl" . $$long[-1] . "$pad</$prop>$nl";
     725        } else {
     726            $$long[-2] .= $$short[-1] . "/>$nl"; # empty element (ie. all shorthand)
     727        }
     728        $$short[-1] = $$long[-1] = '';
     729    } else {
     730        # close this property (no chance of shorthand)
     731        $$long[-1] .= "$pad</$prop>$nl";
     732        unless (@$curPropList) {
     733            # add properties now that this top-level Description is complete
     734            $$long[-2] .= ">$nl" . $$long[-1];
     735            $$long[-1] = '';
     736        }
     737    }
     738    $#$resFlag = $#$curPropList;    # remove expired resource flags
     739}
     740
     741#------------------------------------------------------------------------------
    591742# Write XMP information
    592 # Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
    593 #         2) [optional] tag table reference
     743# Inputs: 0) ExifTool ref, 1) source dirInfo ref (with optional WriteGroup),
     744#         2) [optional] tag table ref
    594745# Returns: with tag table: new XMP data (may be empty if no XMP data) or undef on error
    595746#          without tag table: 1 on success, 0 if not valid XMP file, -1 on write error
    596 # Notes: May set dirInfo InPlace flag to rewrite with specified DirLen
     747# Notes: May set dirInfo InPlace flag to rewrite with specified DirLen (=2 to allow larger)
    597748#        May set dirInfo ReadOnly flag to write as read-only XMP ('r' mode and no padding)
    598749#        May set dirInfo Compact flag to force compact (drops 2kB of padding)
    … …  
    601752sub WriteXMP($$;$)
    602753{
    603     my ($exifTool, $dirInfo, $tagTablePtr) = @_;
    604     $exifTool or return 1;    # allow dummy access to autoload this package
     754    my ($et, $dirInfo, $tagTablePtr) = @_;
     755    $et or return 1;    # allow dummy access to autoload this package
    605756    my $dataPt = $$dirInfo{DataPt};
    606     my (%capture, %nsUsed, $xmpErr, $tagInfo, $about);
     757    my (%capture, %nsUsed, $xmpErr, $about);
    607758    my $changed = 0;
    608759    my $xmpFile = (not $tagTablePtr);   # this is an XMP data file if no $tagTablePtr
    609760    # prefer XMP over other metadata formats in some types of files
    610     my $preferred = $xmpFile || ($$exifTool{PreferredGroup} and $$exifTool{PreferredGroup} eq 'XMP');
    611     my $verbose = $exifTool->Options('Verbose');
     761    my $preferred = $xmpFile || ($$et{PreferredGroup} and $$et{PreferredGroup} eq 'XMP');
     762    my $verbose = $$et{OPTIONS}{Verbose};
     763    my %compact = ( %{$$et{OPTIONS}{Compact}} ); # (make a copy so we can change settings)
    612764    my $dirLen = $$dirInfo{DirLen};
    613765    $dirLen = length($$dataPt) if not defined $dirLen and $dataPt;
    … …  
    621773    # rdf:RDF/rdf:Description/.  The values are array references with the
    622774    # following entries: 0) value, 1) attribute hash reference.
    623     $exifTool->{XMP_CAPTURE} = \%capture;
    624     $exifTool->{XMP_NS} = \%nsUsed;
    625     delete $exifTool->{XMP_NO_XMPMETA};
    626     delete $exifTool->{XMP_NO_XPACKET};
    627     delete $exifTool->{XMP_IS_XML};
    628     delete $exifTool->{XMP_IS_SVG};
     775    $$et{XMP_CAPTURE} = \%capture;
     776    $$et{XMP_NS} = \%nsUsed;
     777    delete $$et{XMP_NO_XMPMETA};
     778    delete $$et{XMP_NO_XPACKET};
     779    delete $$et{XMP_IS_XML};
     780    delete $$et{XMP_IS_SVG};
     781
     782    # set current padding characters
     783    ($sp, $nl) = ($compact{NoIndent} ? '' : ' ', $compact{NoNewline} ? '' : "\n");
     784
     785    # get value for new rdf:about
     786    my $tagInfo = $Image::ExifTool::XMP::rdf{about};
     787    if (defined $$et{NEW_VALUE}{$tagInfo}) {
     788        $about = $et->GetNewValue($$et{NEW_VALUE}{$tagInfo}) || '';
     789    }
    629790
    630791    if ($xmpFile or $dirLen) {
    631         delete $exifTool->{XMP_ERROR};
    632         delete $exifTool->{XMP_ABOUT};
     792        delete $$et{XMP_ERROR};
    633793        # extract all existing XMP information (to the XMP_CAPTURE hash)
    634         my $success = ProcessXMP($exifTool, $dirInfo, $tagTablePtr);
     794        my $success = ProcessXMP($et, $dirInfo, $tagTablePtr);
    635795        # don't continue if there is nothing to parse or if we had a parsing error
    636         unless ($success and not $exifTool->{XMP_ERROR}) {
    637             my $err = $exifTool->{XMP_ERROR} || 'Error parsing XMP';
     796        unless ($success and not $$et{XMP_ERROR}) {
     797            my $err = $$et{XMP_ERROR} || 'Error parsing XMP';
    638798            # may ignore this error only if we were successful
    639799            if ($xmpFile) {
    … …  
    642802                if ($success or not $raf->Seek(0,2) or $raf->Tell()) {
    643803                    # no error message if not an XMP file
    644                     return 0 unless $exifTool->{XMP_ERROR};
    645                     if ($exifTool->Error($err, $success)) {
    646                         delete $exifTool->{XMP_CAPTURE};
     804                    return 0 unless $$et{XMP_ERROR};
     805                    if ($et->Error($err, $success)) {
     806                        delete $$et{XMP_CAPTURE};
    647807                        return 0;
    648808                    }
    649809                }
    650810            } else {
    651                 if ($exifTool->Warn($err, $success)) {
    652                     delete $exifTool->{XMP_CAPTURE};
     811                $success = 2 if $success and $success eq '1';
     812                if ($et->Warn($err, $success)) {
     813                    delete $$et{XMP_CAPTURE};
    653814                    return undef;
    654815                }
    655816            }
    656817        }
    657         $tagInfo = $Image::ExifTool::XMP::rdf{about};
    658         if (defined $exifTool->{NEW_VALUE}->{$tagInfo}) {
    659             $about = Image::ExifTool::GetNewValues($exifTool->{NEW_VALUE}->{$tagInfo}) || '';
     818        if (defined $about) {
    660819            if ($verbose > 1) {
    661                 my $wasAbout = $exifTool->{XMP_ABOUT};
    662                 $exifTool->VerboseValue('- XMP-rdf:About', UnescapeXML($wasAbout)) if defined $wasAbout;
    663                 $exifTool->VerboseValue('+ XMP-rdf:About', $about);
     820                my $wasAbout = $$et{XmpAbout};
     821                $et->VerboseValue('- XMP-rdf:About', UnescapeXML($wasAbout)) if defined $wasAbout;
     822                $et->VerboseValue('+ XMP-rdf:About', $about);
    664823            }
    665824            $about = EscapeXML($about); # must escape for XML
    666825            ++$changed;
    667826        } else {
    668             $about = $exifTool->{XMP_ABOUT} || '';
    669         }
    670         delete $exifTool->{XMP_ERROR};
    671         delete $exifTool->{XMP_ABOUT};
     827            $about = $$et{XmpAbout} || '';
     828        }
     829        delete $$et{XMP_ERROR};
     830
     831        # call InitWriteDirs to initialize FORCE_WRITE flags if necessary
     832        $et->InitWriteDirs({}, 'XMP') if $xmpFile and $et->GetNewValue('ForceWrite');
     833        # set changed if we are ForceWrite tag was set to "XMP"
     834        ++$changed if $$et{FORCE_WRITE}{XMP};
     835
     836    } elsif (defined $about) {
     837        $et->VerboseValue('+ XMP-rdf:About', $about);
     838        $about = EscapeXML($about); # must escape for XML
     839        # (don't increment $changed here because we need another tag to be written)
    672840    } else {
    673841        $about = '';
    … …  
    678846    if ($xmpFile) {
    679847        $tagInfo = $Image::ExifTool::Extra{XMP};
    680         if ($tagInfo and $exifTool->{NEW_VALUE}->{$tagInfo}) {
     848        if ($tagInfo and $$et{NEW_VALUE}{$tagInfo}) {
    681849            my $rtnVal = 1;
    682             my $newVal = Image::ExifTool::GetNewValues($exifTool->{NEW_VALUE}->{$tagInfo});
     850            my $newVal = $et->GetNewValue($$et{NEW_VALUE}{$tagInfo});
    683851            if (defined $newVal and length $newVal) {
    684                 $exifTool->VPrint(0, "  Writing XMP as a block\n");
    685                 ++$exifTool->{CHANGED};
     852                $et->VPrint(0, "  Writing XMP as a block\n");
     853                ++$$et{CHANGED};
    686854                Write($$dirInfo{OutFile}, $newVal) or $rtnVal = -1;
    687855            }
    688             delete $exifTool->{XMP_CAPTURE};
     856            delete $$et{XMP_CAPTURE};
    689857            return $rtnVal;
    690858        }
    … …  
    693861# delete groups in family 1 if requested
    694862#
    695     if (%{$exifTool->{DEL_GROUP}} and (grep /^XMP-.+$/, keys %{$exifTool->{DEL_GROUP}} or
     863    if (%{$$et{DEL_GROUP}} and (grep /^XMP-.+$/, keys %{$$et{DEL_GROUP}} or
    696864        # (logic is a bit more complex for group names in exiftool XML files)
    697         grep m{^http://ns.exiftool.ca/}, values %nsUsed))
     865        grep m{^http://ns.exiftool.(?:ca|org)/}, values %nsUsed))
    698866    {
    699         my $del = $exifTool->{DEL_GROUP};
     867        my $del = $$et{DEL_GROUP};
    700868        my $path;
    701869        foreach $path (keys %capture) {
    … …  
    703871            my ($tag, $ns) = GetXMPTagID(\@propList);
    704872            # translate namespace if necessary
    705             $ns = $$xlatNamespace{$ns} if $$xlatNamespace{$ns};
     873            $ns = $stdXlatNS{$ns} if $stdXlatNS{$ns};
    706874            my ($grp, @g);
    707875            # no "XMP-" added to most groups in exiftool RDF/XML output file
    708             if ($nsUsed{$ns} and (@g = ($nsUsed{$ns} =~ m{^http://ns.exiftool.ca/(.*?)/(.*?)/}))) {
     876            if ($nsUsed{$ns} and (@g = ($nsUsed{$ns} =~ m{^http://ns.exiftool.(?:ca|org)/(.*?)/(.*?)/}))) {
    709877                if ($g[1] =~ /^\d/) {
    710878                    $grp = "XML-$g[0]";
    … …  
    721889                next unless $$del{$ucg} or ($$del{'XMP-*'} and not $$del{"-$ucg"});
    722890            }
    723             $exifTool->VerboseValue("- $grp:$tag", $capture{$path}->[0]);
     891            $et->VerboseValue("- $grp:$tag", $capture{$path}->[0]);
    724892            delete $capture{$path};
    725893            ++$changed;
    … …  
    729897    my $hasExtTag = 'xmpNote:HasExtendedXMP';
    730898    if ($capture{$hasExtTag}) {
    731         $exifTool->VerboseValue("- XMP-$hasExtTag", $capture{$hasExtTag}->[0]);
     899        $et->VerboseValue("- XMP-$hasExtTag", $capture{$hasExtTag}->[0]);
    732900        delete $capture{$hasExtTag};
    733901    }
    734902    # set $xmpOpen now to to handle xmptk tag first
    735     my $xmpOpen = $exifTool->{XMP_NO_XMPMETA} ? '' : XMPOpen($exifTool);
     903    my $xmpOpen = $$et{XMP_NO_XMPMETA} ? '' : XMPOpen($et);
    736904#
    737905# add, delete or change information as specified
    738906#
    739907    # get hash of all information we want to change
    740     # (sorted by tag name so alternate languages come last)
    741     my @tagInfoList = sort ByTagName $exifTool->GetNewTagInfoList();
     908    # (sorted by tag name so alternate languages come last, but with structures
     909    # first so flattened tags may be used to override individual structure elements)
     910    my (@tagInfoList, $delLangPath, %delLangPaths, %delAllLang, $firstNewPath);
     911    my $writeGroup = $$dirInfo{WriteGroup};
     912    foreach $tagInfo (sort ByTagName $et->GetNewTagInfoList()) {
     913        next unless $et->GetGroup($tagInfo, 0) eq 'XMP';
     914        next if $$tagInfo{Name} eq 'XMP'; # (ignore full XMP block if we didn't write it already)
     915        next if $writeGroup and $writeGroup ne $$et{NEW_VALUE}{$tagInfo}{WriteGroup};
     916        if ($$tagInfo{Struct}) {
     917            unshift @tagInfoList, $tagInfo;
     918        } else {
     919            push @tagInfoList, $tagInfo;
     920        }
     921    }
    742922    foreach $tagInfo (@tagInfoList) {
    743         next unless $exifTool->GetGroup($tagInfo, 0) eq 'XMP';
     923        my @delPaths;   # list of deleted paths
    744924        my $tag = $$tagInfo{TagID};
    745925        my $path = GetPropertyPath($tagInfo);
    746926        unless ($path) {
    747             $exifTool->Warn("Can't write XMP:$tag (namespace unknown)");
     927            $et->Warn("Can't write XMP:$tag (namespace unknown)");
    748928            next;
    749929        }
    … …  
    756936        # change our property path namespace prefixes to conform
    757937        # to the ones used in this file
    758         $path = ConformPathToNamespace($exifTool, $path);
     938        $path = ConformPathToNamespace($et, $path);
    759939        # find existing property
    760         my $cap = $capture{$path}; 
     940        my $cap = $capture{$path};
    761941        # MicrosoftPhoto screws up the case of some tags, and some other software,
    762942        # including Adobe software, has been known to write the wrong list type or
    763943        # not properly enclose properties in a list, so we check for this
    764         # (NOTE: we don't currently do these tests when writing structures!
    765         #  --> add this to DeleteStruct() below if it turns out to be a problem)
    766         unless ($cap or $isStruct) {
    767             my $regex = quotemeta $path;
    768             # also allow for missing structure fields in lists of structures
    769             $regex =~  s/ \d+/ \\d\+/g;
    770             my $ok = $regex; # regular expression to match standard property names
    771             # also check for incorrect list types which can cause problems
    772             if ($regex =~ s{\\/rdf\\:(Bag|Seq|Alt)\\/}{/rdf:(Bag|Seq|Alt)/}g) {
    773                 # also look for missing bottom-level list
    774                 $regex =~ s{/rdf:\(Bag\|Seq\|Alt\)\/rdf\\:li\\ \\d\+$}{(/.*)?};
    775             }
    776             my @matches = sort grep m{^$regex$}i, keys %capture;
    777             if (@matches) {
    778                 if ($matches[0] =~ /^$ok$/) {
    779                     $path = $matches[0];    # use existing property path
    780                     $cap = $capture{$path};
     944        until ($cap) {
     945            # find and fix all incorrect property names if this is a structure or a flattened tag
     946            my @fixInfo;
     947            if ($isStruct or defined $$tagInfo{Flat}) {
     948                # get tagInfo for all containing (possibly nested) structures
     949                my @props = split '/', $path;
     950                my $tbl = $$tagInfo{Table};
     951                while (@props) {
     952                    my $info = $$tbl{GetXMPTagID(\@props)};
     953                    unshift @fixInfo, $info if ref $info eq 'HASH' and $$info{Struct} and
     954                        (not @fixInfo or $fixInfo[0] ne $info);
     955                    pop @props;
     956                }
     957                $et->WarnOnce("Error finding parent structure for $$tagInfo{Name}") unless @fixInfo;
     958            }
     959            # fix property path for this tag (last in the @fixInfo list)
     960            push @fixInfo, $tagInfo unless @fixInfo and $isStruct;
     961            # start from outermost containing structure, fixing incorrect list types, etc,
     962            # finally fixing the actual tag properties after all containing structures
     963            my $err;
     964            while (@fixInfo) {
     965                my $fixInfo = shift @fixInfo;
     966                my $fixPath = ConformPathToNamespace($et, GetPropertyPath($fixInfo));
     967                my $regex = quotemeta($fixPath);
     968                $regex =~ s/ \d+/ \\d\+/g;  # match any list index
     969                my $ok = $regex;
     970                my ($ok2, $match, $i, @fixed, %fixed, $fixed);
     971                # check for incorrect list types
     972                if ($regex =~ s{\\/rdf\\:(Bag|Seq|Alt)\\/}{/rdf:(Bag|Seq|Alt)/}g) {
     973                    # also look for missing bottom-level list
     974                    if ($regex =~ s{/rdf:\(Bag\|Seq\|Alt\)\/rdf\\:li\\ \\d\+$}{}) {
     975                        $regex .= '(/.*)?' unless @fixInfo;
     976                    }
     977                } elsif (not @fixInfo) {
     978                    $ok2 = $regex;
     979                    # check for properties in lists that shouldn't be (ref forum4325)
     980                    $regex .= '(/rdf:(Bag|Seq|Alt)/rdf:li \d+)?';
     981                }
     982                if (@fixInfo) {
     983                    $regex .= '(/.*)?';
     984                    $ok .= '(/.*)?';
     985                }
     986                my @matches = sort grep m{^$regex$}i, keys %capture;
     987                last unless @matches;
     988                if ($matches[0] =~ m{^$ok$}) {
     989                    unless (@fixInfo) {
     990                        $path = $matches[0];
     991                        $cap = $capture{$path};
     992                    }
     993                    next;
     994                }
     995                # needs fixing...
     996                my @fixProps = split '/', $fixPath;
     997                foreach $match (@matches) {
     998                    my @matchProps = split '/', $match;
     999                    # remove superfluous list properties if necessary
     1000                    $#matchProps = $#fixProps if $ok2 and $#matchProps > $#fixProps;
     1001                    for ($i=0; $i<@fixProps; ++$i) {
     1002                        defined $matchProps[$i] or $matchProps[$i] = $fixProps[$i], next;
     1003                        next if $matchProps[$i] =~ / \d+$/ or $matchProps[$i] eq $fixProps[$i];
     1004                        $matchProps[$i] = $fixProps[$i];
     1005                    }
     1006                    $fixed = join '/', @matchProps;
     1007                    $err = 1 if $fixed{$fixed} or ($capture{$fixed} and $match ne $fixed);
     1008                    push @fixed, $fixed;
     1009                    $fixed{$fixed} = 1;
     1010                }
     1011                my $tg = $et->GetGroup($fixInfo, 1) . ':' . $$fixInfo{Name};
     1012                my $wrn = lc($fixed[0]) eq lc($matches[0]) ? 'tag ID case' : 'list type';
     1013                if ($err) {
     1014                    $et->Warn("Incorrect $wrn for existing $tg (not changed)");
    7811015                } else {
    782                     # property list was wrong, so issue a warning and fix it
    783                     my ($match, @fixed, %fixed, $err);
    784                     foreach $match (@matches) {
    785                         my $fixed = $path;
    786                         # set list indices
    787                         while ($match =~ / (\d+)/g) {
    788                             my $idx = $1;
    789                             # insert leading "X" so we don't replace this one again
    790                             $fixed =~ s/ \d+/ X$idx/;
    791                         }
    792                         $fixed =~ s/ X/ /g if $fixed ne $path;  # remove "X"s
    793                         $err = 1 if $capture{$fixed} or $fixed{$fixed};
    794                         push @fixed, $fixed;
    795                         $fixed{$fixed} = 1;
    796                     }
    797                     my $tg = $exifTool->GetGroup($tagInfo, 1) . ':' . $$tagInfo{Name};
    798                     my $wrn = lc($path) eq lc($matches[0]) ? 'tag ID case' : 'list type';
    799                     if ($err) {
    800                         $exifTool->Warn("Incorrect $wrn for $tg conflicts with existing tag");
    801                     } else {
    802                         # fix the incorrect property paths for all values of this tag
    803                         foreach $match (@matches) {
    804                             my $fixed = shift @fixed;
    805                             $capture{$fixed} = $capture{$match};
    806                             delete $capture{$match};
    807                         }
    808                         $cap = $capture{$path} || $capture{$fixed[0]};
    809                         $exifTool->Warn("Fixed incorrect $wrn for $tg", 1);
    810                     }
    811                 }
    812             }
    813         }
    814         my $nvHash = $exifTool->GetNewValueHash($tagInfo);
    815         my $overwrite = Image::ExifTool::IsOverwriting($nvHash);
     1016                    # fix the incorrect property paths for all values of this tag
     1017                    my $didFix;
     1018                    foreach $fixed (@fixed) {
     1019                        my $match = shift @matches;
     1020                        next if $fixed eq $match;
     1021                        $capture{$fixed} = $capture{$match};
     1022                        delete $capture{$match};
     1023                        # remove xml:lang attribute from incorrect lang-alt list if necessary
     1024                        delete $capture{$fixed}[1]{'xml:lang'} if $ok2 and $match !~ /^$ok2$/;
     1025                        $didFix = 1;
     1026                    }
     1027                    $cap = $capture{$path} || $capture{$fixed[0]} unless @fixInfo;
     1028                    if ($didFix) {
     1029                        $et->Warn("Fixed incorrect $wrn for $tg", 1);
     1030                        ++$changed;
     1031                    }
     1032                }
     1033            }
     1034            last;
     1035        }
     1036        my $nvHash = $et->GetNewValueHash($tagInfo);
     1037        my $overwrite = $et->IsOverwriting($nvHash);
    8161038        my $writable = $$tagInfo{Writable} || '';
    817         my (%attrs, $deleted, $added);
     1039        my (%attrs, $deleted, $added, $existed, $newLang);
     1040        # set up variables to save/restore paths of deleted lang-alt tags
     1041        if ($writable eq 'lang-alt') {
     1042            $newLang = lc($$tagInfo{LangCode} || 'x-default');
     1043            if ($delLangPath and $delLangPath eq $path) {
     1044                # restore paths of deleted entries for this language
     1045                @delPaths = @{$delLangPaths{$newLang}} if $delLangPaths{$newLang};
     1046            } else {
     1047                undef %delLangPaths;
     1048                $delLangPath = $path;   # base path for deleted lang-alt tags
     1049                undef %delAllLang;
     1050                undef $firstNewPath;    # reset first path for new lang-alt tag
     1051            }
     1052            if (%delAllLang) {
     1053                # add missing paths to delete list for entries where all languages were deleted
     1054                my ($prefix, $reSort);
     1055                foreach $prefix (keys %delAllLang) {
     1056                    next if grep /^$prefix/, @delPaths;
     1057                    push @delPaths, "${prefix}10";
     1058                    $reSort = 1;
     1059                }
     1060                @delPaths = sort @delPaths if $reSort;
     1061            }
     1062        }
    8181063        # delete existing entry if necessary
    8191064        if ($isStruct) {
     1065            # delete all structure (or pseudo-structure) elements
    8201066            require 'Image/ExifTool/XMPStruct.pl';
    821             ($deleted, $added) = DeleteStruct($exifTool, \%capture, \$path, $nvHash, \$changed);
     1067            ($deleted, $added, $existed) = DeleteStruct($et, \%capture, \$path, $nvHash, \$changed);
     1068            next unless $deleted or $added or $et->IsOverwriting($nvHash);
     1069            next if $existed and $$nvHash{CreateOnly};
    8221070        } elsif ($cap) {
     1071            next if $$nvHash{CreateOnly};   # (necessary for List-type tags)
    8231072            # take attributes from old values if they exist
    8241073            %attrs = %{$$cap[1]};
    8251074            if ($overwrite) {
    826                 my ($delPath, $oldLang, $delLang, $addLang, @matchingPaths);
     1075                my ($oldLang, $delLang, $addLang, @matchingPaths, $langPathPat, %langsHere);
    8271076                # check to see if this is an indexed list item
    8281077                if ($path =~ / /) {
    … …  
    8331082                    push @matchingPaths, $path;
    8341083                }
     1084                my $oldOverwrite = $overwrite;
    8351085                foreach $path (@matchingPaths) {
    8361086                    my ($val, $attrs) = @{$capture{$path}};
    8371087                    if ($writable eq 'lang-alt') {
     1088                        # get original language code (lc for comparisons)
     1089                        $oldLang = lc($$attrs{'xml:lang'} || 'x-default');
     1090                        # revert to original overwrite flag if this is in a different structure
     1091                        if (not $langPathPat or $path !~ /^$langPathPat$/) {
     1092                            $overwrite = $oldOverwrite;
     1093                            ($langPathPat = $path) =~ s/\d+$/\\d+/;
     1094                        }
     1095                        # remember languages in this lang-alt list
     1096                        $langsHere{$langPathPat}{$oldLang} = 1;
    8381097                        unless (defined $addLang) {
    8391098                            # add to lang-alt list by default if creating this tag from scratch
    840                             $addLang = Image::ExifTool::IsCreating($nvHash) ? 1 : 0;
     1099                            $addLang = $$nvHash{IsCreating} ? 1 : 0;
    8411100                        }
    842                         # get original language code (lc for comparisons)
    843                         $oldLang = lc($$attrs{'xml:lang'} || 'x-default');
    8441101                        if ($overwrite < 0) {
    845                             my $newLang = lc($$tagInfo{LangCode} || 'x-default');
    8461102                            next unless $oldLang eq $newLang;
    8471103                            # only add new tag if we are overwriting this one
    8481104                            # (note: this won't match if original XML contains CDATA!)
    849                             $addLang = Image::ExifTool::IsOverwriting($nvHash, UnescapeXML($val));
     1105                            $addLang = $et->IsOverwriting($nvHash, UnescapeXML($val));
    8501106                            next unless $addLang;
    8511107                        }
    … …  
    8611117                    } elsif ($overwrite < 0) {
    8621118                        # only overwrite specific values
     1119                        if ($$nvHash{Shift}) {
     1120                            # values to be shifted are checked (hence re-formatted) late,
     1121                            # so we must un-format the to-be-shifted value for IsOverwriting()
     1122                            my $fmt = $$tagInfo{Writable} || '';
     1123                            if ($fmt eq 'rational') {
     1124                                ConvertRational($val);
     1125                            } elsif ($fmt eq 'date') {
     1126                                $val = ConvertXMPDate($val);
     1127                            }
     1128                        }
    8631129                        # (note: this won't match if original XML contains CDATA!)
    864                         next unless Image::ExifTool::IsOverwriting($nvHash, UnescapeXML($val));
     1130                        next unless $et->IsOverwriting($nvHash, UnescapeXML($val));
    8651131                    }
    8661132                    if ($verbose > 1) {
    867                         my $grp = $exifTool->GetGroup($tagInfo, 1);
     1133                        my $grp = $et->GetGroup($tagInfo, 1);
    8681134                        my $tagName = $$tagInfo{Name};
    8691135                        $tagName =~ s/-$$tagInfo{LangCode}$// if $$tagInfo{LangCode};
    8701136                        $tagName .= '-' . $$attrs{'xml:lang'} if $$attrs{'xml:lang'};
    871                         $exifTool->VerboseValue("- $grp:$tagName", $val);
     1137                        $et->VerboseValue("- $grp:$tagName", $val);
    8721138                    }
    8731139                    # save attributes and path from first deleted property
    8741140                    # so we can replace it exactly
    875                     unless ($delPath) {
    876                         %attrs = %$attrs;
    877                         $delPath = $path;
     1141                    %attrs = %$attrs unless @delPaths;
     1142                    if ($writable eq 'lang-alt') {
     1143                        $langsHere{$langPathPat}{$oldLang} = 0; # (lang was deleted)
     1144                    }
     1145                    # save deleted paths so we can replace the same elements
     1146                    # (separately for each language of a lang-alt list)
     1147                    if ($writable ne 'lang-alt' or $oldLang eq $newLang) {
     1148                        push @delPaths, $path;
     1149                    } else {
     1150                        $delLangPaths{$oldLang} or $delLangPaths{$oldLang} = [ ];
     1151                        push @{$delLangPaths{$oldLang}}, $path;
     1152                    }
     1153                    # keep track of paths where we deleted all languages of a lang-alt tag
     1154                    if ($delLang) {
     1155                        my $p;
     1156                        ($p = $path) =~ s/\d+$//;
     1157                        $delAllLang{$p} = 1;
    8781158                    }
    8791159                    # delete this tag
    … …  
    8871167                    }
    8881168                }
    889                 next unless $delPath or $$tagInfo{List} or $addLang;
    890                 if ($delPath) {
    891                     $path = $delPath;
     1169                next unless @delPaths or $$tagInfo{List} or $addLang;
     1170                if (@delPaths) {
     1171                    $path = shift @delPaths;
     1172                    # make sure new path is unique
     1173                    while ($capture{$path}) {
     1174                        last unless $path =~ s/ \d(\d+)$/' '.length($1+1).($1+1)/e;
     1175                    }
    8921176                    $deleted = 1;
    8931177                } else {
    … …  
    8951179                    # unless this is a list or an lang-alt tag
    8961180                    next unless $$tagInfo{List} or $oldLang;
     1181                    # avoid adding duplicate entry to lang-alt in a list
     1182                    if ($writable eq 'lang-alt' and %langsHere) {
     1183                        foreach (sort keys %langsHere) {
     1184                            next unless $path =~ /^$_$/;
     1185                            last unless $langsHere{$_}{$newLang};
     1186                            $path =~ /(.* )\d(\d+)(.*? \d+)$/ or $et->Error('Internal error writing lang-alt list'), last;
     1187                            my $nxt = $2 + 1;
     1188                            $path = $1 . length($nxt) . ($nxt) . $3; # step to next index
     1189                        }
     1190                    }
    8971191                    # (match last index to put in same lang-alt list for Bag of lang-alt items)
    8981192                    $path =~ m/.* (\d+)/g or warn "Internal error: no list index!\n", next;
    … …  
    9001194                }
    9011195            } else {
    902                 # are never overwriting, so we must be adding to a list
     1196                # we are never overwriting, so we must be adding to a list
    9031197                # match the last index unless this is a list of lang-alt lists
    904                 my $pat = $writable eq 'lang-alt' ? '.* (\d+)(.*? \d+)' : '.* (\d+)';
     1198                my $pat = '.* (\d+)';
     1199                if ($writable eq 'lang-alt') {
     1200                    if ($firstNewPath) {
     1201                        $path = $firstNewPath;
     1202                        $overwrite = 1; # necessary to put x-default entry first below
     1203                    } else {
     1204                        $pat = '.* (\d+)(.*? \d+)';
     1205                    }
     1206                }
    9051207                if ($path =~ m/$pat/g) {
    9061208                    $added = $1;
    … …  
    9191221                {
    9201222                    my $saveCap = $capture{$path};
    921                     for (;;) {
     1223                    while ($saveCap) {
    9221224                        my $p = $path;
    9231225                        substr($p, $pos, $len) = length($nxt) . $nxt;
    … …  
    9311233                } else {
    9321234                    # add to end of list
    933                     for (;;) {
     1235                    while ($capture{$path}) {
    9341236                        my $try = length($nxt) . $nxt;
    9351237                        substr($path, $pos, $len) = $try;
    936                         last unless $capture{$path};
    9371238                        $len = length $try;
    9381239                        ++$nxt;
    … …  
    9431244        # check to see if we want to create this tag
    9441245        # (create non-avoided tags in XMP data files by default)
    945         my $isCreating = (Image::ExifTool::IsCreating($nvHash) or $isStruct or
     1246        my $isCreating = ($$nvHash{IsCreating} or (($isStruct or
    9461247                          ($preferred and not $$tagInfo{Avoid} and
    947                             not defined $$nvHash{Shift}));
     1248                            not defined $$nvHash{Shift})) and not $$nvHash{EditOnly}));
    9481249
    9491250        # don't add new values unless...
    … …  
    9541255
    9551256        # get list of new values (all done if no new values specified)
    956         my @newValues = Image::ExifTool::GetNewValues($nvHash) or next;
     1257        my @newValues = $et->GetNewValue($nvHash) or next;
    9571258
    9581259        # set language attribute for lang-alt lists
    959         $attrs{'xml:lang'} = $$tagInfo{LangCode} || 'x-default' if $writable eq 'lang-alt';
    960 
     1260        if ($writable eq 'lang-alt') {
     1261            $attrs{'xml:lang'} = $$tagInfo{LangCode} || 'x-default';
     1262            $firstNewPath = $path if defined $added;  # save path of first lang-alt tag added
     1263        }
    9611264        # add new value(s) to %capture hash
    9621265        my $subIdx;
    … …  
    9641267            my $newValue = shift @newValues;
    9651268            if ($isStruct) {
    966                 ++$changed if AddNewStruct($exifTool, $tagInfo, \%capture,
     1269                ++$changed if AddNewStruct($et, $tagInfo, \%capture,
    9671270                                           $path, $newValue, $$tagInfo{Struct});
    9681271            } else {
    9691272                $newValue = EscapeXML($newValue);
    970                 if ($$tagInfo{Resource}) {
    971                     $capture{$path} = [ '', { %attrs, 'rdf:resource' => $newValue } ];
    972                 } else {
     1273                for (;;) { # (a cheap 'goto')
     1274                    if ($$tagInfo{Resource}) {
     1275                        # only store as a resource if it doesn't contain any illegal characters
     1276                        if ($newValue !~ /[^a-z0-9\:\/\?\#\[\]\@\!\$\&\'\(\)\*\+\,\;\=\.\-\_\~]/i) {
     1277                            $capture{$path} = [ '', { %attrs, 'rdf:resource' => $newValue } ];
     1278                            last;
     1279                        }
     1280                        my $grp = $et->GetGroup($tagInfo, 1);
     1281                        $et->Warn("$grp:$$tagInfo{Name} written as a literal because value is not a valid URI", 1);
     1282                        # fall through to write as a string literal
     1283                    }
     1284                    # remove existing value and/or resource attribute if they exist
     1285                    delete $attrs{'rdf:value'};
     1286                    delete $attrs{'rdf:resource'};
    9731287                    $capture{$path} = [ $newValue, \%attrs ];
     1288                    last;
    9741289                }
    9751290                if ($verbose > 1) {
    976                     my $grp = $exifTool->GetGroup($tagInfo, 1);
    977                     $exifTool->VerboseValue("+ $grp:$$tagInfo{Name}", $newValue);
     1291                    my $grp = $et->GetGroup($tagInfo, 1);
     1292                    $et->VerboseValue("+ $grp:$$tagInfo{Name}", $newValue);
    9781293                }
    9791294                ++$changed;
    9801295                # add rdf:type if necessary
    9811296                if ($$tagInfo{StructType}) {
    982                     AddStructType($exifTool, $$tagInfo{Table}, \%capture, $path);
     1297                    AddStructType($et, $$tagInfo{Table}, \%capture, $path);
    9831298                }
    9841299            }
    … …  
    9871302            # item in a different lang-alt list (so match the 2nd-last for these)
    9881303            my $pat = $writable eq 'lang-alt' ? '.* (\d+)(.*? \d+)' : '.* (\d+)';
    989             $path =~ m/$pat/g or warn("Internal error: no list index for $tag!\n"), next;
     1304            pos($path) = 0;
     1305            $path =~ m/$pat/g or warn("Internal error: no list index for $tag ($path) ($pat)!\n"), next;
    9901306            my $idx = $1;
    9911307            my $len = length $1;
    9921308            my $pos = pos($path) - $len - ($2 ? length $2 : 0);
    993             # generate unique list sub-indices to store additional values in sequence
     1309            # use sub-indices if necessary to store additional values in sequence
    9941310            if ($subIdx) {
    9951311                $idx = substr($idx, 0, -length($subIdx));   # remove old sub-index
    9961312                $subIdx = substr($subIdx, 1) + 1;
    9971313                $subIdx = length($subIdx) . $subIdx;
     1314            } elsif (@delPaths) {
     1315                $path = shift @delPaths;
     1316                # make sure new path is unique
     1317                while ($capture{$path}) {
     1318                    last unless $path =~ s/ \d(\d+)$/' '.length($1+1).($1+1)/e;
     1319                }
     1320                next;
    9981321            } else {
    9991322                $subIdx = '10';
    … …  
    10011324            substr($path, $pos, $len) = $idx . $subIdx;
    10021325        }
     1326        # make sure any empty structures are deleted
     1327        # (ExifTool shouldn't write these, but other software may)
     1328        if (defined $$tagInfo{Flat}) {
     1329            my $p = $path;
     1330            while ($p =~ s/\/[^\/]+$//) {
     1331                next unless $capture{$p};
     1332                # it is an error if this property has a value
     1333                $et->Error("Improperly structured XMP ($p)",1) if $capture{$p}[0] =~ /\S/;
     1334                delete $capture{$p};    # delete the (hopefully) empty structure
     1335            }
     1336        }
    10031337    }
    10041338    # remove the ExifTool members we created
    1005     delete $exifTool->{XMP_CAPTURE};
    1006     delete $exifTool->{XMP_NS};
     1339    delete $$et{XMP_CAPTURE};
     1340    delete $$et{XMP_NS};
    10071341
    10081342    my $maxDataLen = $$dirInfo{MaxDataLen};
    10091343    # get DataPt again because it may have been set by ProcessXMP
    10101344    $dataPt = $$dirInfo{DataPt};
     1345
    10111346    # return now if we didn't change anything
    10121347    unless ($changed or ($maxDataLen and $dataPt and defined $$dataPt and
    … …  
    10211356#
    10221357    # start writing the XMP data
    1023     my $newData = '';
    1024     if ($$exifTool{XMP_NO_XPACKET}) {
     1358    my (@long, @short, @resFlag);
     1359    $long[0] = $long[1] = $short[0] = '';
     1360    if ($$et{XMP_NO_XPACKET}) {
    10251361        # write BOM if flag is set
    1026         $newData .= "\xef\xbb\xbf" if $$exifTool{XMP_NO_XPACKET} == 2;
     1362        $long[-2] .= "\xef\xbb\xbf" if $$et{XMP_NO_XPACKET} == 2;
    10271363    } else {
    1028         $newData .= $pktOpen;
    1029     }
    1030     $newData .= $xmlOpen if $$exifTool{XMP_IS_XML};
    1031     $newData .= $xmpOpen . $rdfOpen;
     1364        $long[-2] .= $pktOpen;
     1365    }
     1366    $long[-2] .= $xmlOpen if $$et{XMP_IS_XML};
     1367    $long[-2] .= $xmpOpen . $rdfOpen;
    10321368
    10331369    # initialize current property path list
    … …  
    10691405            @pathList = @writeLast;
    10701406            undef @writeLast;
    1071             $extStart = length $newData;
    1072             $newDesc = 1;   # start with a new description
     1407            $newDesc = 2;   # start with a new description for the extended data
    10731408        }
    10741409        $path = shift @pathList;
    … …  
    10981433            foreach $path2 (@pathList) {
    10991434                my @ns2s = ($path2 =~ m{(?:^|/)([^/]+?):}g);
    1100                 my $opening = 0;
     1435                my $opening = $compact{OneDesc} ? 1 : 0;
    11011436                foreach $ns2 (@ns2s) {
    11021437                    next if $ns2 eq 'rdf';
    … …  
    11171452        }
    11181453        # close out properties down to the common base path
    1119         while (@curPropList > $closeTo) {
    1120             ($prop = pop @curPropList) =~ s/ .*//;
    1121             $newData .= (' ' x scalar(@curPropList)) . " </$prop>\n";
    1122         }
     1454        CloseProperty(\@curPropList, \@long, \@short, \@resFlag) while @curPropList > $closeTo;
     1455
     1456        # open new description if necessary
    11231457        if ($newDesc) {
     1458            $extStart = length($long[-2]) if $newDesc == 2; # extended data starts after this
    11241459            # save rdf:Description start positions so we can reorder them if necessary
    1125             push @descStart, length($newData) if $maxDataLen;
     1460            push @descStart, length($long[-2]) if $maxDataLen;
    11261461            # open the new description
    11271462            $prop = $rdfDesc;
    11281463            %nsCur = %nsNew;            # save current namespaces
    1129             $newData .= "\n <$prop rdf:about='$about'";
    11301464            my @ns = sort keys %nsCur;
     1465            $long[-2] .= "$nl$sp<$prop rdf:about='${about}'";
    11311466            # generate et:toolkit attribute if this is an exiftool RDF/XML output file
    1132             if (@ns and $nsCur{$ns[0]} =~ m{^http://ns.exiftool.ca/}) {
    1133                 $newData .= "\n  xmlns:et='http://ns.exiftool.ca/1.0/'" .
     1467            if (@ns and $nsCur{$ns[0]} =~ m{^http://ns.exiftool.(?:ca|org)/}) {
     1468                $long[-2] .= "\n$sp${sp}xmlns:et='http://ns.exiftool.ca/1.0/'" .
    11341469                            " et:toolkit='Image::ExifTool $Image::ExifTool::VERSION'";
    11351470            }
    1136             foreach (@ns) {
    1137                 $newData .= "\n  xmlns:$_='$nsCur{$_}'";
    1138             }
    1139             $newData .= ">\n";
     1471            $long[-2] .= "\n$sp${sp}xmlns:$_='$nsCur{$_}'" foreach @ns;
    11401472            push @curPropList, $prop;
    1141         }
    1142         # loop over all values for this new property
     1473            # set resFlag to 0 to indicate base description when Shorthand enabled
     1474            $resFlag[0] = 0 if $compact{Shorthand};
     1475        }
    11431476        my ($val, $attrs) = @{$capture{$path}};
    11441477        $debug and print "$path = $val\n";
    1145         # open new properties
    1146         my $attr;
     1478        # open new properties if necessary
     1479        my ($attr, $dummy);
    11471480        for ($n=@curPropList; $n<$#propList; ++$n) {
    11481481            $prop = $propList[$n];
    11491482            push @curPropList, $prop;
    1150             # remove list index if it exists
    1151             $prop =~ s/ .*//;
    1152             $attr = '';
     1483            $prop =~ s/ .*//;       # remove list index if it exists
     1484            # (we may add parseType and shorthand properties later,
     1485            #  so leave off the trailing ">" for now)
     1486            $long[-1] .= ($compact{NoIndent} ? '' : ' ' x scalar(@curPropList)) . "<$prop";
    11531487            if ($prop ne $rdfDesc and ($propList[$n+1] !~ /^rdf:/ or
    11541488                ($propList[$n+1] eq 'rdf:type' and $n+1 == $#propList)))
    11551489            {
    1156                 # need parseType='Resource' to avoid new 'rdf:Description'
    1157                 $attr = " rdf:parseType='Resource'";
    1158             }
    1159             $newData .= (' ' x scalar(@curPropList)) . "<$prop$attr>\n";
     1490                # check for empty structure
     1491                if ($propList[$n+1] =~ /:~dummy~$/) {
     1492                    $long[-1] .= " rdf:parseType='Resource'/>$nl";
     1493                    pop @curPropList;
     1494                    $dummy = 1;
     1495                    last;
     1496                }
     1497                if ($compact{Shorthand}) {
     1498                    $resFlag[$#curPropList] = 1;
     1499                    push @long, '';
     1500                    push @short, '';
     1501                } else {
     1502                    # use rdf:parseType='Resource' to avoid new 'rdf:Description'
     1503                    $long[-1] .= " rdf:parseType='Resource'>$nl";
     1504                }
     1505            } else {
     1506                $long[-1] .= ">$nl"; # (will be no shorthand properties)
     1507            }
    11601508        }
    11611509        my $prop2 = pop @propList;  # get new property name
    1162         $prop2 =~ s/ .*//;          # remove list index if it exists
    1163         $newData .= (' ' x scalar(@curPropList)) . " <$prop2";
    1164         # write out attributes
    1165         foreach $attr (sort keys %$attrs) {
    1166             my $attrVal = $$attrs{$attr};
    1167             my $quot = ($attrVal =~ /'/) ? '"' : "'";
    1168             $newData .= " $attr=$quot$attrVal$quot";
    1169         }
    1170         $newData .= length $val ? ">$val</$prop2>\n" : "/>\n";
    1171     }
    1172     # close off any open elements
    1173     while ($prop = pop @curPropList) {
    1174         $prop =~ s/ .*//;   # remove list index if it exists
    1175         $newData .= (' ' x scalar(@curPropList)) . " </$prop>\n";
    1176     }
     1510        # add element unless it was a dummy structure field
     1511        unless ($dummy or ($val eq '' and $prop2 =~ /:~dummy~$/)) {
     1512            $prop2 =~ s/ .*//;      # remove list index if it exists
     1513            my $pad = $compact{NoIndent} ? '' : ' ' x (scalar(@curPropList) + 1);
     1514            # (can't write as shortcut if it has attributes or CDATA)
     1515            if (defined $resFlag[$#curPropList] and not %$attrs and $val !~ /<!\[CDATA\[/) {
     1516                $short[-1] .= "\n$pad$prop2='${val}'";
     1517            } else {
     1518                $long[-1] .= "$pad<$prop2";
     1519                # write out attributes
     1520                foreach $attr (sort keys %$attrs) {
     1521                    my $attrVal = $$attrs{$attr};
     1522                    my $quot = ($attrVal =~ /'/) ? '"' : "'";
     1523                    $long[-1] .= " $attr=$quot$attrVal$quot";
     1524                }
     1525                $long[-1] .= length $val ? ">$val</$prop2>$nl" : "/>$nl";
     1526            }
     1527        }
     1528    }
     1529    # close out all open properties
     1530    CloseProperty(\@curPropList, \@long, \@short, \@resFlag) while @curPropList;
     1531
    11771532    # limit XMP length and re-arrange if necessary to fit inside specified size
    1178     my $compact = $$dirInfo{Compact} || $exifTool->Options('Compact');
    11791533    if ($maxDataLen) {
    11801534        # adjust maxDataLen to allow room for closing elements
    11811535        $maxDataLen -= length($rdfClose) + length($xmpClose) + length($pktCloseW);
    1182         $extStart or $extStart = length $newData;
    1183         my @rtn = LimitXMPSize($exifTool, \$newData, $maxDataLen, $about, \@descStart, $extStart);
     1536        $extStart or $extStart = length $long[-2];
     1537        my @rtn = LimitXMPSize($et, \$long[-2], $maxDataLen, $about, \@descStart, $extStart);
    11841538        # return extended XMP information in $dirInfo
    11851539        $$dirInfo{ExtendedXMP} = $rtn[0];
    11861540        $$dirInfo{ExtendedGUID} = $rtn[1];
    11871541        # compact if necessary to fit
    1188         $compact = 1 if length($newData) + 101 * $numPadLines > $maxDataLen;
    1189     }
     1542        $compact{NoPadding} = 1 if length($long[-2]) + 101 * $numPadLines > $maxDataLen;
     1543    }
     1544    $compact{NoPadding} = 1 if $$dirInfo{Compact};
    11901545#
    11911546# close out the XMP, clean up, and return our data
    11921547#
    1193     $newData .= $rdfClose;
    1194     $newData .= $xmpClose unless $exifTool->{XMP_NO_XMPMETA};
     1548    $long[-2] .= $rdfClose;
     1549    $long[-2] .= $xmpClose unless $$et{XMP_NO_XMPMETA};
    11951550
    11961551    # remove the ExifTool members we created
    1197     delete $exifTool->{XMP_CAPTURE};
    1198     delete $exifTool->{XMP_NS};
    1199     delete $exifTool->{XMP_NO_XMPMETA};
     1552    delete $$et{XMP_CAPTURE};
     1553    delete $$et{XMP_NS};
     1554    delete $$et{XMP_NO_XMPMETA};
    12001555
    12011556    # (the XMP standard recommends writing 2k-4k of white space before the
    12021557    # packet trailer, with a newline every 100 characters)
    1203     unless ($$exifTool{XMP_NO_XPACKET}) {
     1558    unless ($$et{XMP_NO_XPACKET}) {
    12041559        my $pad = (' ' x 100) . "\n";
    1205         if ($$dirInfo{InPlace}) {
     1560        # get current XMP length without padding
     1561        my $len = length($long[-2]) + length($pktCloseW);
     1562        if ($$dirInfo{InPlace} and not ($$dirInfo{InPlace} == 2 and $len > $dirLen)) {
    12061563            # pad to specified DirLen
    1207             my $len = length($newData) + length($pktCloseW);
    12081564            if ($len > $dirLen) {
    1209                 $exifTool->Warn('Not enough room to edit XMP in place');
     1565                my $str = 'Not enough room to edit XMP in place';
     1566                $str .= '. Try Shorthand feature' unless $compact{Shorthand};
     1567                $et->Warn($str);
    12101568                return undef;
    12111569            }
    12121570            my $num = int(($dirLen - $len) / length($pad));
    12131571            if ($num) {
    1214                 $newData .= $pad x $num;
     1572                $long[-2] .= $pad x $num;
    12151573                $len += length($pad) * $num;
    12161574            }
    1217             $len < $dirLen and $newData .= (' ' x ($dirLen - $len - 1)) . "\n";
    1218         } elsif (not $compact and not $xmpFile and not $$dirInfo{ReadOnly}) {
    1219             $newData .= $pad x $numPadLines;
    1220         }
    1221         $newData .= ($$dirInfo{ReadOnly} ? $pktCloseR : $pktCloseW);
     1575            $len < $dirLen and $long[-2] .= (' ' x ($dirLen - $len - 1)) . "\n";
     1576        } elsif (not $compact{NoPadding} and not $xmpFile and not $$dirInfo{ReadOnly}) {
     1577            $long[-2] .= $pad x $numPadLines;
     1578        }
     1579        $long[-2] .= ($$dirInfo{ReadOnly} ? $pktCloseR : $pktCloseW);
    12221580    }
    12231581    # return empty data if no properties exist and this is allowed
    12241582    unless (%capture or $xmpFile or $$dirInfo{InPlace} or $$dirInfo{NoDelete}) {
    1225         $newData = '';
     1583        $long[-2] = '';
    12261584    }
    12271585    if ($xmpErr) {
    12281586        if ($xmpFile) {
    1229             $exifTool->Error($xmpErr);
     1587            $et->Error($xmpErr);
    12301588            return -1;
    12311589        }
    1232         $exifTool->Warn($xmpErr);
     1590        $et->Warn($xmpErr);
    12331591        return undef;
    12341592    }
    1235     $exifTool->{CHANGED} += $changed;
    1236     $debug > 1 and $newData and print $newData,"\n";
    1237     return $newData unless $xmpFile;
    1238     Write($$dirInfo{OutFile}, $newData) or return -1;
     1593    $$et{CHANGED} += $changed;
     1594    $debug > 1 and $long[-2] and print $long[-2],"\n";
     1595    return $long[-2] unless $xmpFile;
     1596    Write($$dirInfo{OutFile}, $long[-2]) or return -1;
    12391597    return 1;
    12401598}
    … …  
    12591617=head1 AUTHOR
    12601618
    1261 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     1619Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    12621620
    12631621This library is free software; you can redistribute it and/or modify it
Note: See TracChangeset for help on using the changeset viewer.