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/XMPStruct.pl

    r24107 r34921  
    1010
    1111use strict;
    12 use vars qw(%specialStruct $xlatNamespace);
     12use vars qw(%specialStruct %stdXlatNS);
    1313
    1414use Image::ExifTool qw(:Utils);
    … …  
    2626# Inputs: 0) HASH ref, ARRAY ref, or SCALAR, 1) closing bracket (or undef)
    2727# Returns: serialized structure string
    28 # ie) "{field=text with {braces|}|, and a comma, field2=val2,field3={field4=[a,b]}}"
     28# eg) "{field=text with {braces|}|, and a comma, field2=val2,field3={field4=[a,b]}}"
    2929sub SerializeStruct($;$)
    3030{
    … …  
    8484                $part =~ s/[\x0d\x0a].*//s;
    8585                $part = substr($part,0,27) . '...' if length($part) > 30;
    86                 $warn = "Invalid structure field at '$part'";
     86                $warn = "Invalid structure field at '${part}'";
    8787            } else {
    8888                $warn = 'Missing closing brace for structure';
    … …  
    108108        $delim = $delim ? "\\$delim|,|\\||\$" : ',|\\||$';
    109109        for (;;) {
    110             $$obj =~ s/^(.*?)($delim)//s and $val .= $1;
     110            $$obj =~ s/^(.*?)($delim)//s or last;
     111            $val .= $1;
    111112            last unless $2;
    112113            $2 eq '|' or $$obj = $2 . $$obj, last;
    … …  
    177178sub CheckStruct($$$)
    178179{
    179     my ($exifTool, $struct, $strTable) = @_;
    180 
    181     my $strName = $$strTable{STRUCT_NAME} || RegisterNamespace($strTable);
     180    my ($et, $struct, $strTable) = @_;
     181
     182    my $strName = $$strTable{STRUCT_NAME} || ('XMP ' . RegisterNamespace($strTable));
    182183    ref $struct eq 'HASH' or return wantarray ? (undef, "Expecting $strName structure") : undef;
    183184
    … …  
    197198        }
    198199        until (ref $fieldInfo eq 'HASH') {
    199             # generate wildcard fields on the fly (ie. mwg-rs:Extensions)
     200            # generate wildcard fields on the fly (eg. mwg-rs:Extensions)
    200201            unless ($$strTable{NAMESPACE}) {
    201202                my ($grp, $tg, $langCode);
    … …  
    212213                # find best matching tag
    213214                foreach $ti (@matches) {
    214                     my @grps = $exifTool->GetGroup($ti);
     215                    my @grps = $et->GetGroup($ti);
    215216                    next unless $grps[0] eq 'XMP';
    216217                    next if $grp and $grp ne lc $grps[1];
    … …  
    224225                    $g1 = $grps[1];
    225226                }
    226                 $tagInfo or $warn =  "'$tag' is not a writable XMP tag", next Key;
     227                $tagInfo or $warn =  "'${tag}' is not a writable XMP tag", next Key;
    227228                GetPropertyPath($tagInfo);  # make sure property path is generated for this tag
    228229                $tag = $$tagInfo{Name};
    … …  
    233234                $fieldInfo or $fieldInfo = $$strTable{$tag} = {
    234235                    %$tagInfo, # (also copies the necessary TagID and PropertyPath)
    235                     Namespace => $$tagInfo{Table}{NAMESPACE},
     236                    Namespace => $$tagInfo{Namespace} || $$tagInfo{Table}{NAMESPACE},
    236237                    LangCode  => $langCode,
    237238                };
    … …  
    242243                last; # write this dynamically-generated field
    243244            }
    244             # generate lang-alt fields on the fly (ie. Iptc4xmpExt:AOTitle)
     245            # generate lang-alt fields on the fly (eg. Iptc4xmpExt:AOTitle)
    245246            my ($tg, $langCode) = GetLangCode($tag);
    246247            if (defined $langCode) {
    … …  
    265266                }
    266267            }
    267             $warn = "'$tag' is not a field of $strName";
     268            $warn = "'${tag}' is not a field of $strName";
    268269            next Key;
    269270        }
    … …  
    271272            $$fieldInfo{Struct} or $warn = "$tag is not a structure in $strName", next Key;
    272273            # recursively check this structure
    273             ($val, $err) = CheckStruct($exifTool, $$struct{$key}, $$fieldInfo{Struct});
     274            ($val, $err) = CheckStruct($et, $$struct{$key}, $$fieldInfo{Struct});
    274275            $err and $warn = $err, next Key;
    275276            $copy{$tag} = $val;
    … …  
    282283                if (not ref $item) {
    283284                    $item = '' unless defined $item; # use empty string for missing items
    284                     $$fieldInfo{Struct} and $warn = "$tag items are not valid structures", next Key;
    285                     $exifTool->Sanitize(\$item);
    286                     ($copy[$i],$err) = $exifTool->ConvInv($item,$fieldInfo,$tag,$strName,$type);
    287                     $err and $warn = $err, next Key;
    288                     $err = CheckXMP($exifTool, $fieldInfo, \$copy[$i]);
    289                     $err and $warn = "$err in $strName $tag", next Key;
     285                    if ($$fieldInfo{Struct}) {
     286                        # (allow empty structures)
     287                        $item =~ /^\s*$/ or $warn = "$tag items are not valid structures", next Key;
     288                        $copy[$i] = { }; # create hash for empty structure
     289                    } else {
     290                        $et->Sanitize(\$item);
     291                        ($copy[$i],$err) = $et->ConvInv($item,$fieldInfo,$tag,$strName,$type,'');
     292                        $copy[$i] = '' unless defined $copy[$i];    # avoid undefined item
     293                        $err and $warn = $err, next Key;
     294                        $err = CheckXMP($et, $fieldInfo, \$copy[$i]);
     295                        $err and $warn = "$err in $strName $tag", next Key;
     296                    }
    290297                } elsif (ref $item eq 'HASH') {
    291298                    $$fieldInfo{Struct} or $warn = "$tag is not a structure in $strName", next Key;
    292                     ($copy[$i], $err) = CheckStruct($exifTool, $item, $$fieldInfo{Struct});
     299                    ($copy[$i], $err) = CheckStruct($et, $item, $$fieldInfo{Struct});
    293300                    $err and $warn = $err, next Key;
    294301                } else {
    … …  
    302309            $warn = "Improperly formed structure in $strName $tag";
    303310        } else {
    304             $exifTool->Sanitize(\$$struct{$key});
    305             ($val,$err) = $exifTool->ConvInv($$struct{$key},$fieldInfo,$tag,$strName,$type);
     311            $et->Sanitize(\$$struct{$key});
     312            ($val,$err) = $et->ConvInv($$struct{$key},$fieldInfo,$tag,$strName,$type,'');
    306313            $err and $warn = $err, next Key;
    307             $err = CheckXMP($exifTool, $fieldInfo, \$val);
     314            next Key unless defined $val;   # check for undefined
     315            $err = CheckXMP($et, $fieldInfo, \$val);
    308316            $err and $warn = "$err in $strName $tag", next Key;
    309317            # turn this into a list if necessary
    … …  
    311319        }
    312320    }
    313     if (%copy) {
     321    if (%copy or not $warn) {
    314322        $rtnVal = \%copy;
    315323        undef $err;
    316         $$exifTool{CHECK_WARN} = $warn if $warn;
     324        $$et{CHECK_WARN} = $warn if $warn;
    317325    } else {
    318         $err = $warn || 'Structure has no fields';
     326        $err = $warn;
    319327    }
    320328    return wantarray ? ($rtnVal, $err) : $rtnVal;
    … …  
    326334#         3) new value hash ref, 4) reference to change counter
    327335# Returns: 0) delete flag, 1) list index of deleted structure if adding to list
     336#          2) flag set if structure existed
    328337# Notes: updates path to new base path for structure to be added
    329338sub DeleteStruct($$$$$)
    330339{
    331     my ($exifTool, $capture, $pathPt, $nvHash, $changed) = @_;
    332     my ($deleted, $added, $p, $pp, $val, $delPath);
     340    my ($et, $capture, $pathPt, $nvHash, $changed) = @_;
     341    my ($deleted, $added, $existed, $p, $pp, $val, $delPath);
    333342    my (@structPaths, @matchingPaths, @delPaths);
    334343
    335344    # find all existing elements belonging to this structure
    336345    ($pp = $$pathPt) =~ s/ \d+/ \\d\+/g;
    337     @structPaths = sort grep(/^$pp\//, keys %$capture);
    338 
     346    @structPaths = sort grep(/^$pp(\/|$)/, keys %$capture);
     347    $existed = 1 if @structPaths;
    339348    # delete only structures with matching fields if necessary
    340349    if ($$nvHash{DelValue}) {
    … …  
    362371                            next unless $$a2{'xml:lang'} and $$a2{'xml:lang'} eq $$attr{'xml:lang'};
    363372                        }
    364                         if ($$capture{$p2}[0] eq $cap{$p}[0]) {
     373                        if ($$capture{$p2} and $$capture{$p2}[0] eq $cap{$p}[0]) {
    365374                            # ($1 contains root path for this structure)
    366375                            $match{$1} = ($match{$1} || 0) + 1;
    … …  
    387396    }
    388397    if (@delPaths) {
    389         my $verbose = $exifTool->Options('Verbose');
     398        my $verbose = $et->Options('Verbose');
    390399        @delPaths = sort @delPaths if $verbose > 1;
    391400        foreach $p (@delPaths) {
    392             $exifTool->VerboseValue("- XMP-$p", $$capture{$p}[0]) if $verbose > 1;
     401            if ($verbose > 1) {
     402                my $p2 = $p;
     403                $p2 =~ s/^(\w+)/$stdXlatNS{$1} || $1/e;
     404                $et->VerboseValue("- XMP-$p2", $$capture{$p}[0]);
     405            }
    393406            delete $$capture{$p};
    394407            $deleted = 1;
    395408            ++$$changed;
    396409        }
    397         $delPath or warn("Internal error 1 in DeleteStruct\n"), return(undef,undef);
     410        $delPath or warn("Internal error 1 in DeleteStruct\n"), return(undef,undef,$existed);
    398411        $$pathPt = $delPath;    # return path of first element deleted
    399     } else {
    400         my $tagInfo = $$nvHash{TagInfo};
    401         if ($$tagInfo{List}) {
    402             # NOTE: we don't yet properly handle lang-alt elements!!!!
    403             if (@structPaths) {
    404                 $structPaths[-1] =~ /^($pp)/ or warn("Internal error 2 in DeleteStruct\n"), return(undef,undef);
    405                 my $path = $1;
    406                 # (match last index to put in same lang-alt list for Bag of lang-alt items)
    407                 $path =~ m/.* (\d+)/g or warn("Internal error 3 in DeleteStruct\n"), return(undef,undef);
    408                 $added = $1;
    409                 # add after last item in list
    410                 my $len = length $added;
    411                 my $pos = pos($path) - $len;
    412                 my $nxt = substr($added, 1) + 1;
    413                 substr($path, $pos, $len) = length($nxt) . $nxt;
    414                 $$pathPt = $path;
    415             } else {
    416                 $added = '10';
    417             }
    418         }
    419     }
    420     return($deleted, $added);
     412    } elsif ($$nvHash{TagInfo}{List}) {
     413        # NOTE: we don't yet properly handle lang-alt elements!!!!
     414        if (@structPaths) {
     415            $structPaths[-1] =~ /^($pp)/ or warn("Internal error 2 in DeleteStruct\n"), return(undef,undef,$existed);
     416            my $path = $1;
     417            # delete any improperly formatted xmp
     418            if ($$capture{$path}) {
     419                my $cap = $$capture{$path};
     420                # an error unless this was an empty structure
     421                $et->Error("Improperly structured XMP ($path)",1) if ref $cap ne 'ARRAY' or $$cap[0];
     422                delete $$capture{$path};
     423            }
     424            # (match last index to put in same lang-alt list for Bag of lang-alt items)
     425            $path =~ m/.* (\d+)/g or warn("Internal error 3 in DeleteStruct\n"), return(undef,undef,$existed);
     426            $added = $1;
     427            # add after last item in list
     428            my $len = length $added;
     429            my $pos = pos($path) - $len;
     430            my $nxt = substr($added, 1) + 1;
     431            substr($path, $pos, $len) = length($nxt) . $nxt;
     432            $$pathPt = $path;
     433        } else {
     434            $added = '10';
     435        }
     436    }
     437    return($deleted, $added, $existed);
    421438}
    422439
    … …  
    427444sub AddNewTag($$$$$$)
    428445{
    429     my ($exifTool, $tagInfo, $capture, $path, $valPtr, $langIdx) = @_;
     446    my ($et, $tagInfo, $capture, $path, $valPtr, $langIdx) = @_;
    430447    my $val = EscapeXML($$valPtr);
    431448    my %attrs;
    … …  
    449466    $$capture{$path} = [ $val, \%attrs ];
    450467    # print verbose message
    451     if ($exifTool and $exifTool->Options('Verbose') > 1) {
    452         $exifTool->VerboseValue("+ XMP-$path", $val);
     468    if ($et and $et->Options('Verbose') > 1) {
     469        my $p = $path;
     470        $p =~ s/^(\w+)/$stdXlatNS{$1} || $1/e;
     471        $et->VerboseValue("+ XMP-$p", $val);
    453472    }
    454473}
    … …  
    463482sub AddNewStruct($$$$$$)
    464483{
    465     my ($exifTool, $tagInfo, $capture, $basePath, $struct, $strTable) = @_;
    466     my $verbose = $exifTool ? $exifTool->Options('Verbose') : 0;
     484    my ($et, $tagInfo, $capture, $basePath, $struct, $strTable) = @_;
     485    my $verbose = $et ? $et->Options('Verbose') : 0;
    467486    my ($tag, %langIdx);
    468487
    … …  
    470489    my $changed = 0;
    471490
     491    # add dummy field to allow empty structures (name starts with '~' so it will come
     492    # after all valid structure fields, which is necessary when serializing the XMP later)
     493    %$struct or $$struct{'~dummy~'} = '';
     494
    472495    foreach $tag (sort keys %$struct) {
    473         my $fieldInfo = $$strTable{$tag} or next;
     496        my $fieldInfo = $$strTable{$tag};
     497        unless ($fieldInfo) {
     498            next unless $tag eq '~dummy~'; # check for dummy field
     499            $fieldInfo = { }; # create dummy field info for dummy structure
     500        }
    474501        my $val = $$struct{$tag};
    475502        my $propPath = $$fieldInfo{PropertyPath};
    … …  
    484511            $$fieldInfo{PropertyPath} = $propPath;  # save for next time
    485512        }
    486         my $path = $basePath . '/' . ConformPathToNamespace($exifTool, $propPath);
     513        my $path = $basePath . '/' . ConformPathToNamespace($et, $propPath);
    487514        my $addedTag;
    488515        if (ref $val eq 'HASH') {
    489516            my $subStruct = $$fieldInfo{Struct} or next;
    490             $changed += AddNewStruct($exifTool, $tagInfo, $capture, $path, $val, $subStruct);
     517            $changed += AddNewStruct($et, $tagInfo, $capture, $path, $val, $subStruct);
    491518        } elsif (ref $val eq 'ARRAY') {
    492519            next unless $$fieldInfo{List};
    493520            my $i = 0;
    494521            my ($item, $p);
     522            my $level = scalar(() = ($propPath =~ / \d+/g));
    495523            # loop through all list items (note: can't yet write multi-dimensional lists)
    496524            foreach $item (@{$val}) {
    497525                if ($i) {
    498526                    # update first index in field property (may be list of lang-alt lists)
    499                     $p = ConformPathToNamespace($exifTool, $propPath);
     527                    $p = ConformPathToNamespace($et, $propPath);
    500528                    my $idx = length($i) . $i;
    501529                    $p =~ s/ \d+/ $idx/;
    … …  
    506534                if (ref $item eq 'HASH') {
    507535                    my $subStruct = $$fieldInfo{Struct} or next;
    508                     AddNewStruct($exifTool, $tagInfo, $capture, $p, $item, $subStruct) or next;
    509                 } elsif (length $item) { # don't write empty items in list
    510                     AddNewTag($exifTool, $fieldInfo, $capture, $p, \$item, \%langIdx);
     536                    AddNewStruct($et, $tagInfo, $capture, $p, $item, $subStruct) or next;
     537                # don't write empty items in upper-level list
     538                } elsif (length $item or (defined $item and $level == 1)) {
     539                    AddNewTag($et, $fieldInfo, $capture, $p, \$item, \%langIdx);
    511540                    $addedTag = 1;
    512541                }
    … …  
    515544            }
    516545        } else {
    517             AddNewTag($exifTool, $fieldInfo, $capture, $path, \$val, \%langIdx);
     546            AddNewTag($et, $fieldInfo, $capture, $path, \$val, \%langIdx);
    518547            $addedTag = 1;
    519548            ++$changed;
    … …  
    523552        # flattened tag inside a variable-namespace structure
    524553        if ($addedTag and $$fieldInfo{StructType} and $$fieldInfo{Table}) {
    525             AddStructType($exifTool, $$fieldInfo{Table}, $capture, $propPath, $basePath);
     554            AddStructType($et, $$fieldInfo{Table}, $capture, $propPath, $basePath);
    526555        }
    527556    }
    528557    # add 'rdf:type' property if necessary
    529558    if ($$strTable{TYPE} and $changed) {
    530         my $path = $basePath . '/' . ConformPathToNamespace($exifTool, "rdf:type");
     559        my $path = $basePath . '/' . ConformPathToNamespace($et, "rdf:type");
    531560        unless ($$capture{$path}) {
    532561            $$capture{$path} = [ '', { 'rdf:resource' => $$strTable{TYPE} } ];
    533             $exifTool->VerboseValue("+ XMP-$path", $$strTable{TYPE}) if $verbose > 1;
     562            if ($verbose > 1) {
     563                my $p = $path;
     564                $p =~ s/^(\w+)/$stdXlatNS{$1} || $1/e;
     565                $et->VerboseValue("+ XMP-$p", $$strTable{TYPE});
     566            }
    534567        }
    535568    }
    … …  
    545578sub ConvertStruct($$$$;$)
    546579{
    547     my ($exifTool, $tagInfo, $value, $type, $parentID) = @_;
     580    my ($et, $tagInfo, $value, $type, $parentID) = @_;
    548581    if (ref $value eq 'HASH') {
    549582        my (%struct, $key);
    … …  
    563596            my $v = $$value{$key};
    564597            if (ref $v) {
    565                 $v = ConvertStruct($exifTool, $flatInfo, $v, $type, $tagID);
     598                $v = ConvertStruct($et, $flatInfo, $v, $type, $tagID);
    566599            } else {
    567                 $v = $exifTool->GetValue($flatInfo, $type, $v);
     600                $v = $et->GetValue($flatInfo, $type, $v);
    568601            }
    569602            $struct{$key} = $v if defined $v;  # save the converted value
    … …  
    571604        return \%struct;
    572605    } elsif (ref $value eq 'ARRAY') {
    573         my (@list, $val);
    574         foreach $val (@$value) {   
    575             my $v = ConvertStruct($exifTool, $tagInfo, $val, $type, $parentID);
    576             push @list, $v if defined $v;
    577         }
    578         return \@list;
     606        if (defined $$et{OPTIONS}{ListItem}) {
     607            my $li = $$et{OPTIONS}{ListItem};
     608            return undef unless defined $$value[$li];
     609            undef $$et{OPTIONS}{ListItem};      # only do top-level list
     610            my $val = ConvertStruct($et, $tagInfo, $$value[$li], $type, $parentID);
     611            $$et{OPTIONS}{ListItem} = $li;
     612            return $val;
     613        } else {
     614            my (@list, $val);
     615            foreach $val (@$value) {
     616                my $v = ConvertStruct($et, $tagInfo, $val, $type, $parentID);
     617                push @list, $v if defined $v;
     618            }
     619            return \@list;
     620        }
    579621    } else {
    580         return $exifTool->GetValue($tagInfo, $type, $value);
     622        return $et->GetValue($tagInfo, $type, $value);
    581623    }
    582624}
    … …  
    584626#------------------------------------------------------------------------------
    585627# Restore XMP structures in extracted information
    586 # Inputs: 0) ExifTool object ref
     628# Inputs: 0) ExifTool object ref, 1) flag to keep original flattened tags
    587629# Notes: also restores lists (including multi-dimensional)
    588 sub RestoreStruct($)
     630sub RestoreStruct($;$)
    589631{
    590632    local $_;
    591     my $exifTool = shift;
    592     my ($key, %structs, %var, %lists, $si, %listKeys);
    593     my $ex = $$exifTool{TAG_EXTRA};
    594     foreach $key (keys %{$$exifTool{TAG_INFO}}) {
     633    my ($et, $keepFlat) = @_;
     634    my ($key, %structs, %var, %lists, $si, %listKeys, @siList);
     635    my $ex = $$et{TAG_EXTRA};
     636    my $valueHash = $$et{VALUE};
     637    my $fileOrder = $$et{FILE_ORDER};
     638    my $tagExtra = $$et{TAG_EXTRA};
     639    foreach $key (keys %{$$et{TAG_INFO}}) {
    595640        $$ex{$key} or next;
    596         my ($err, $i);
    597641        my $structProps = $$ex{$key}{Struct} or next;
    598         my $tagInfo = $$exifTool{TAG_INFO}{$key};   # tagInfo for flattened tag
     642        delete $$ex{$key}{Struct}; # (don't re-use)
     643        my $tagInfo = $$et{TAG_INFO}{$key};   # tagInfo for flattened tag
    599644        my $table = $$tagInfo{Table};
    600645        my $prop = shift @$structProps;
    … …  
    608653                # (or for something like this -- what should we do here?:
    609654                # <meta:user-defined meta:name="License">test</meta:user-defined>)
    610                 $exifTool->Warn("$$strInfo{Name} is not a structure!");
     655                $et->Warn("$$strInfo{Name} is not a structure!") unless $$et{NO_STRUCT_WARN};
    611656                next;
    612657            }
    … …  
    615660            my $g1 = $$table{GROUPS}{0} || 'XMP';
    616661            my $name = $tag;
     662            # tag keys will have a group 1 prefix when coming from import of XML from -X option
    617663            if ($tag =~ /(.+):(.+)/) {
    618664                my $ns;
    619665                ($ns, $name) = ($1, $2);
    620                 $ns = $$xlatNamespace{$ns} if $$xlatNamespace{$ns};
     666                $ns =~ s/^XMP-//; # remove leading "XMP-" if it exists because we add it later
     667                $ns = $stdXlatNS{$ns} if $stdXlatNS{$ns};
    621668                $g1 .= "-$ns";
    622669            }
    … …  
    629676            if (@$structProps) {
    630677                # this is a structure
    631                 $$strInfo{Struct} = { STRUCT_NAME => 'Unknown' } if @$structProps;
     678                $$strInfo{Struct} = { STRUCT_NAME => 'XMP Unknown' } if @$structProps;
    632679            } elsif ($$tagInfo{LangCode}) {
    633680                # this is lang-alt list
    … …  
    635682                $$strInfo{LangCode} = $$tagInfo{LangCode};
    636683            }
    637             Image::ExifTool::AddTagToTable($table, $tag, $strInfo);
     684            AddTagToTable($table, $tag, $strInfo);
    638685        }
    639686        # use strInfo ref for base key to avoid collisions
    … …  
    645692        # walk through the stored structure property information
    646693        # to rebuild this structure
     694        my ($err, $i);
    647695        for (;;) {
    648696            my $index = $$prop[1];
    … …  
    688736                } else {
    689737                    $lists{$struct} = $struct;
    690                     $$struct[$index] = $$exifTool{VALUE}{$key};
     738                    $$struct[$index] = $$valueHash{$key};
    691739                    last;
    692740                }
    … …  
    698746                    $struct = $$struct{$tag} = { };
    699747                } else {
    700                     $$struct{$tag} = $$exifTool{VALUE}{$key};
     748                    $$struct{$tag} = $$valueHash{$key};
    701749                    last;
    702750                }
    … …  
    709757                # the corresponding group1 name to the tag ID.
    710758                my ($ns, $name) = ($1, $2);
    711                 $ns = $$xlatNamespace{$ns} if $$xlatNamespace{$ns};
     759                $ns = $stdXlatNS{$ns} if $stdXlatNS{$ns};
    712760                $tag = "XMP-$ns:" . ucfirst $name;
    713761            } else {
    … …  
    718766            # this may happen if we have a structural error in the XMP
    719767            # (like an improperly contained list for example)
    720             $exifTool->Warn("Error $err placing $$tagInfo{Name} in structure", 1);
     768            unless ($$et{NO_STRUCT_WARN}) {
     769                my $ns = $$tagInfo{Namespace} || $$tagInfo{Table}{NAMESPACE} || '';
     770                $et->Warn("Error $err placing $ns:$$tagInfo{TagID} in structure or list", 1);
     771            }
    721772            delete $structs{$strInfo} unless $oldStruct;
    722773        } elsif ($tagInfo eq $strInfo) {
    723             # just a regular list tag
     774            # just a regular list tag (or an empty structure)
    724775            if ($oldStruct) {
    725776                # keep tag with lowest numbered key (well, not exactly, since
    … …  
    727778                # everything else, and this is really what we care about)
    728779                my $k = $listKeys{$oldStruct};
    729                 $k lt $key and $exifTool->DeleteTag($key), next;
    730                 $exifTool->DeleteTag($k);   # remove tag with greater copy number
     780                if ($k) {   # ($k will be undef for an empty structure)
     781                    if ($k lt $key) {
     782                        # keep lowest file order
     783                        $$fileOrder{$k} = $$fileOrder{$key} if $$fileOrder{$k} > $$fileOrder{$key};
     784                        $et->DeleteTag($key);
     785                        next;
     786                    }
     787                    $$fileOrder{$key} = $$fileOrder{$k} if $$fileOrder{$key} > $$fileOrder{$k};
     788                    $et->DeleteTag($k);   # remove tag with greater copy number
     789                }
    731790            }
    732791            # replace existing value with new list
    733             $$exifTool{VALUE}{$key} = $structs{$strInfo};
     792            $$valueHash{$key} = $structs{$strInfo};
    734793            $listKeys{$structs{$strInfo}} = $key;   # save key for this list tag
    735794        } else {
    736795            # save strInfo ref and file order
    737             $var{$strInfo} = [ $strInfo, $$exifTool{FILE_ORDER}{$key} ];
    738             $exifTool->DeleteTag($key);
     796            if ($var{$strInfo}) {
     797                # set file order to just before the first associated flattened tag
     798                if ($var{$strInfo}[1] > $$fileOrder{$key}) {
     799                    $var{$strInfo}[1] = $$fileOrder{$key} - 0.5;
     800                }
     801            } else {
     802                $var{$strInfo} = [ $strInfo, $$fileOrder{$key} - 0.5 ];
     803            }
     804            # preserve original flattened tags if requested
     805            if ($keepFlat) {
     806                my $extra = $$tagExtra{$key} or next;
     807                # restore list behaviour of this flattened tag
     808                if ($$extra{NoList}) {
     809                    $$valueHash{$key} = $$extra{NoList};
     810                    delete $$extra{NoList};
     811                } elsif ($$extra{NoListDel}) {
     812                    # delete this tag since its value was included another list
     813                    $et->DeleteTag($key);
     814                }
     815            } else {
     816                $et->DeleteTag($key); # delete the flattened tag
     817            }
    739818        }
    740819    }
    … …  
    745824        defined $_ or $_ = '' foreach @{$lists{$si}};
    746825    }
    747     # save new structure tags
    748     foreach $si (keys %structs) {
    749         next unless $var{$si};  # already handled regular lists
    750         $key = $exifTool->FoundTag($var{$si}[0], '');
    751         $$exifTool{VALUE}{$key} = $structs{$si};
    752         $$exifTool{FILE_ORDER}{$key} = $var{$si}[1];
     826    # make a list of all new structures we generated
     827    $var{$_} and push @siList, $_ foreach keys %structs;
     828    # save new structures in the same order they were read from file
     829    foreach $si (sort { $var{$a}[1] <=> $var{$b}[1] } @siList) {
     830        $key = $et->FoundTag($var{$si}[0], '');
     831        $$valueHash{$key} = $structs{$si};
     832        $$fileOrder{$key} = $var{$si}[1];
    753833    }
    754834}
    … …  
    774854=head1 AUTHOR
    775855
    776 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     856Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    777857
    778858This library is free software; you can redistribute it and/or modify it
Note: See TracChangeset for help on using the changeset viewer.