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/TagInfoXML.pm

    r24107 r34921  
    1212require Exporter;
    1313
    14 use vars qw($VERSION @ISA);
     14use vars qw($VERSION @ISA $makeMissing);
    1515use Image::ExifTool qw(:Utils :Vars);
    1616use Image::ExifTool::XMP;
    1717
    18 $VERSION = '1.15';
     18$VERSION = '1.31';
    1919@ISA = qw(Exporter);
    2020
    2121# set this to a language code to generate Lang module with 'MISSING' entries
    22 my $makeMissing = '';
    23 
    24 # set this to true to override existing different descriptions/values
    25 my $overrideDifferent;
    26 
    27 sub LoadLangModules($);
     22$makeMissing = '';
     23
     24sub LoadLangModules($;$);
    2825sub WriteLangModule($$;$);
    2926sub NumbersFirst;
     
    3229my %credits = (
    3330    cs   => 'Jens Duttke and Petr MichE<aacute>lek',
    34     de   => 'Jens Duttke and Herbert Kauer',
    35     es   => 'Jens Duttke and Santiago del BrE<iacute>o GonzE<aacute>lez',
    36     fr   => 'Jens Duttke, Bernard Guillotin, Jean Glasser, Jean Piquemal and Harry Nizard',
    37     it   => 'Jens Duttke, Ferdinando Agovino and Emilio Dati',
     31    de   => 'Jens Duttke, Herbert Kauer and Jobi',
     32    es   => 'Jens Duttke, Santiago del BrE<iacute>o GonzE<aacute>lez and Emilio Sancha',
     33    fi   => 'Jens Duttke and Jarkko ME<auml>kineva',
     34    fr   => 'Jens Duttke, Bernard Guillotin, Jean Glasser, Jean Piquemal, Harry Nizard and Alphonse Philippe',
     35    it   => 'Jens Duttke, Ferdinando Agovino, Emilio Dati and Michele Locati',
    3836    ja   => 'Jens Duttke and Kazunari Nishina',
    3937    ko   => 'Jens Duttke and Jeong Beom Kim',
    40     nl   => 'Jens Duttke, Peter Moonen and Herman Beld',
    41     pl   => 'Jens Duttke and Przemyslaw Sulek',
    42     ru   => 'Jens Duttke, Sergey Shemetov, Dmitry Yerokhin and Anton Sukhinov',
     38    nl   => 'Jens Duttke, Peter Moonen, Herman Beld and Peter van der Laan',
     39    pl   => 'Jens Duttke, Przemyslaw Sulek and Kacper Perschke',
     40    ru   => 'Jens Duttke, Sergey Shemetov, Dmitry Yerokhin, Anton Sukhinov and Alexander',
    4341    sv   => 'Jens Duttke and BjE<ouml>rn SE<ouml>derstrE<ouml>m',
    4442   'tr'  => 'Jens Duttke, Hasan Yildirim and Cihan Ulusoy',
     
    5856);
    5957
     58my $numbersFirst = 1;   # set to -1 to sort numbers last, or 2 to put negative numbers last
    6059my $caseInsensitive;    # used internally by sort routine
    6160
     
    6362# Utility to print tag information database as an XML list
    6463# Inputs: 0) output file name (undef to send to console),
    65 #         1) group name (may be undef), 2) options hash ('Flags','NoDesc')
     64#         1) group name (may be undef), 2) options hash ('Flags','NoDesc','Lang')
    6665# Returns: true on success
    6766sub Write(;$$%)
     
    6968    local ($_, *PTIFILE);
    7069    my ($file, $group, %opts) = @_;
    71     my @groups = split ':', $group if $group;
    72     my $exifTool = new Image::ExifTool;
    73     my ($fp, $tableName, %langInfo, @langs, $defaultLang);
     70    my $et = new Image::ExifTool;
     71    my ($fp, $tableName, %langInfo, @langs, $defaultLang, @groups);
     72    @groups = split ':', $group if $group;
    7473
    7574    Image::ExifTool::LoadAllTables();   # first load all our tables
    7675    unless ($opts{NoDesc}) {
    77         LoadLangModules(\%langInfo);    # load all existing Lang modules
    78         @langs = sort keys %langInfo;
    7976        $defaultLang = $Image::ExifTool::defaultLang;
     77        LoadLangModules(\%langInfo, $opts{Lang}); # load necessary Lang modules
     78        if ($opts{Lang}) {
     79            @langs = grep /^$opts{Lang}$/i, keys %langInfo;
     80        } else {
     81            @langs = sort keys %langInfo;
     82        }
    8083    }
    8184    if (defined $file) {
     
    8689    }
    8790    print $fp "<?xml version='1.0' encoding='UTF-8'?>\n";
     91    print $fp "<!-- Generated by Image::ExifTool $Image::ExifTool::VERSION -->\n";
    8892    print $fp "<taginfo>\n\n";
    8993
     
    9599        # sort in same order as tag name documentation
    96100        $caseInsensitive = ($tableName =~ /::XMP::/);
    97         my @keys = sort NumbersFirst TagTableKeys($table);
    98101        # get list of languages defining elements in this table
    99102        my $isBinary = ($$table{PROCESS_PROC} and
    100103                        $$table{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData);
    101         # loop throug all tag ID's in this table
     104        # generate flattened tag names for structure fields if this is an XMP table
     105        if ($$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP') {
     106            Image::ExifTool::XMP::AddFlattenedTags($table);
     107        }
     108        $numbersFirst = 2;
     109        $numbersFirst = -1 if $$table{VARS} and $$table{VARS}{ALPHA_FIRST};
     110        my @keys = sort NumbersFirst TagTableKeys($table);
     111        $numbersFirst = 1;
     112        # loop through all tag ID's in this table
    102113        foreach $tagID (@keys) {
    103114            my @infoArray = GetTagInfoList($table, $tagID);
     
    110121                next unless $$tagInfo{Writable} or not $$tagInfo{SubDirectory};
    111122                if (@groups) {
    112                     my @tg = $exifTool->GetGroup($tagInfo);
     123                    my @tg = $et->GetGroup($tagInfo);
    113124                    foreach $group (@groups) {
    114125                        next PTILoop unless grep /^$group$/i, @tg;
     
    117128                unless ($didTag) {
    118129                    my $tname = $$table{SHORT_NAME};
    119                     print $fp "<table name='$tname' g0='$$grps{0}' g1='$$grps{1}' g2='$$grps{2}'>\n";
     130                    print $fp "<table name='${tname}' g0='$$grps{0}' g1='$$grps{1}' g2='$$grps{2}'>\n";
    120131                    unless ($opts{NoDesc}) {
    121132                        # print table description
     
    130141                            $desc = $langInfo{$_}{$tableName} or next;
    131142                            $desc = Image::ExifTool::XMP::EscapeXML($desc);
    132                             print $fp " <desc lang='$_'>$desc</desc>\n";
     143                            print $fp " <desc lang='${_}'>$desc</desc>\n";
    133144                        }
    134145                    }
     
    136147                }
    137148                my $name = $$tagInfo{Name};
    138                 my $ind = @infoArray > 1 ? " index='$index'" : '';
     149                my $ind = @infoArray > 1 ? " index='${index}'" : '';
    139150                my $format = $$tagInfo{Writable} || $$table{WRITABLE};
    140151                my $writable = $format ? 'true' : 'false';
     
    151162                }
    152163                $format = $$tagInfo{Format} || $$table{FORMAT} if not defined $format or $format eq '1';
     164                $format = 'struct' if $$tagInfo{Struct};
    153165                if (defined $format) {
    154166                    $format =~ s/\[.*\$.*\]//;   # remove expressions from format
     
    160172                my $count = '';
    161173                if ($format =~ s/\[.*?(\d*)\]$//) {
    162                     $count = " count='$1'" if length $1;
    163                 }
    164                 my @groups = $exifTool->GetGroup($tagInfo);
     174                    $count = " count='${1}'" if length $1;
     175                } elsif ($$tagInfo{Count} and $$tagInfo{Count} > 1) {
     176                    $count = " count='$$tagInfo{Count}'";
     177                }
     178                my @groups = $et->GetGroup($tagInfo);
    165179                my $writeGroup = $$tagInfo{WriteGroup} || $$table{WRITE_GROUP};
    166180                if ($writeGroup and $writeGroup ne 'Comment') {
     
    179193                    }
    180194                    push @flags, $$tagInfo{List} if $$tagInfo{List} and $$tagInfo{List} =~ /^(Alt|Bag|Seq)$/;
     195                    push @flags, 'Flattened' if defined $$tagInfo{Flat};
    181196                    push @flags, 'Unsafe' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x01;
    182197                    push @flags, 'Protected' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x02;
     
    185200                    $grp = " flags='" . join(',', sort @flags) . "'$grp" if @flags;
    186201                }
    187                 print $fp " <tag id='$xmlID' name='$name'$ind type='$format'$count writable='$writable'$grp";
     202                print $fp " <tag id='${xmlID}' name='${name}'$ind type='${format}'$count writable='${writable}'$grp";
    188203                if ($opts{NoDesc}) {
    189204                    # short output format
    190205                    print $fp "/>\n";   # empty tag element
    191206                    next;               # no descriptions or values
     207                } else {
     208                    print $fp ">";
    192209                }
    193210                my $desc = $$tagInfo{Description};
     
    206223                    next if $ld eq $desc;
    207224                    $ld = Image::ExifTool::XMP::EscapeXML($ld);
    208                     $altDescr .= "\n  <desc lang='$_'>$ld</desc>";
     225                    $altDescr .= "\n  <desc lang='${_}'>$ld</desc>";
    209226                }
    210227                # print tag descriptions
    211228                $desc = Image::ExifTool::XMP::EscapeXML($desc);
    212                 print $fp ">\n  <desc lang='$defaultLang'>$desc</desc>$altDescr\n";
     229                unless ($opts{Lang} and $altDescr) {
     230                    print $fp "\n  <desc lang='${defaultLang}'>$desc</desc>";
     231                }
     232                print $fp "$altDescr\n";
    213233                for (my $i=0; ; ++$i) {
    214234                    my $conv = $$tagInfo{PrintConv};
     
    217237                        last unless $i < @$conv;
    218238                        $conv = $$conv[$i];
    219                         $idx = " index='$i'";
     239                        $idx = " index='${i}'";
    220240                    } else {
    221241                        last if $i;
     
    231251                        foreach $key (keys %{$$conv{BITMASK}}) {
    232252                            my $mask = 0x01 << $key;
    233                             next if $$conv{$mask};
     253                            next if not $mask or $$conv{$mask};
    234254                            $$conv{$mask} = $$conv{BITMASK}{$key};
    235255                        }
     
    240260                        my $xmlVal = Image::ExifTool::XMP::EscapeXML($val);
    241261                        my $xmlKey = Image::ExifTool::XMP::FullEscapeXML($key);
    242                         print $fp "   <key id='$xmlKey'>";
    243                         print $fp "\n    <val lang='$defaultLang'>$xmlVal</val>\n";
     262                        print $fp "   <key id='${xmlKey}'>\n";
    244263                        # add alternate language values
     264                        my $altConv = '';
    245265                        foreach (@langConv) {
    246266                            my $lv = $langConv{$_};
     
    251271                            next unless defined $lv and $lv ne $val;
    252272                            $lv = Image::ExifTool::XMP::EscapeXML($lv);
    253                             print $fp "    <val lang='$_'>$lv</val>\n";
     273                            $altConv .= "    <val lang='${_}'>$lv</val>\n";
    254274                        }
    255                         print $fp "   </key>\n";
     275                        unless ($opts{Lang} and $altConv) {
     276                            print $fp "    <val lang='${defaultLang}'>$xmlVal</val>\n"
     277                        }
     278                        print $fp "$altConv   </key>\n";
    256279                    }
    257280                    print $fp "  </values>\n";
     
    266289    close $fp or $success = 0 if defined $file;
    267290    return $success;
    268 }
    269 
    270 #------------------------------------------------------------------------------
    271 # Perl-ize this constant
    272 # Inputs: string
    273 # Returns: constant string for Perl
    274 sub Perlize($)
    275 {
    276     my $str = shift;
    277     unless (($str =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?$/ and # int or float
    278              not $str =~ /^[+-]?0\d+$/) or # not octal
    279             $str =~ /^0x[0-9a-f]+$/i) # hexadecimal
    280     {
    281         # translate unprintable characters
    282         $str =~ s/\\/\\\\/g; # escape backslashes
    283         if ($str =~ /([\x00-\x1f\x80-\xff])/) {
    284             $str =~ s/"/\\"/g; # escape double quotes
    285             # escape unprintable characters
    286             $str =~ s/([\x00-\x1f\x80-\xff])/sprintf("\\x%.2x",ord $1)/eg;
    287             $str = qq{"$str"};
    288         } else {
    289             $str =~ s/'/\\'/g; # escape single quotes
    290             $str = qq{'$str'};
    291         }
    292     }
    293     return $str;
    294291}
    295292
     
    308305#------------------------------------------------------------------------------
    309306# Generate Lang modules from input tag info XML database
    310 # Inputs: 0) XML filename, 1) update flag:
    311 #       undef = default (update changed modules only)
    312 #       0 = (update changed modules only, but preserve version numbers)
    313 #       1 = (update all, but preserve version numbers)
    314 #       2 = (update all from scratch, but preserve version numbers)
     307# Inputs: 0) XML filename, 1) update flags:
     308#       0x01 = preserve version numbers
     309#       0x02 = update all modules, even if they didn't change
     310#       0x04 = update from scratch, ignoring existing definitions
     311#       0x08 = override existing different descriptions and values
    315312# Returns: Count of updated Lang modules, or -1 on error
    316313# Notes: Must be run from the directory containing 'lib'
     
    318315{
    319316    local ($_, *XFILE);
    320     my ($file, $forceUpdate) = @_;
    321     my ($table, $tableName, $id, $index, $valIndex, $name, $key, $lang);
    322     my (%langInfo, %different, %changed);
     317    my ($file, $updateFlag) = @_;
     318    my ($table, $tableName, $id, $index, $valIndex, $name, $key, $lang, $defDesc);
     319    my (%langInfo, %different, %changed, $overrideDifferent);
    323320
    324321    Image::ExifTool::LoadAllTables();   # first load all our tables
     322    # generate our flattened tags
     323    foreach $tableName (sort keys %allTables) {
     324        my $table = GetTagTable($tableName);
     325        next unless $$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP';
     326        Image::ExifTool::XMP::AddFlattenedTags($table);
     327    }
    325328    LoadLangModules(\%langInfo);        # load all existing Lang modules
    326     %langInfo = () if $forceUpdate and $forceUpdate eq '2';
     329    $updateFlag = 0 unless $updateFlag;
     330    %langInfo = () if $updateFlag & 0x04;
     331    $overrideDifferent = 1 if $updateFlag & 0x08;
    327332
    328333    if (defined $file) {
     
    337342                    undef $index;
    338343                    undef $name;
     344                    undef $defDesc;
    339345                } elsif ($tok eq 'values') {
    340346                    undef $key;
     
    361367                $name = $2;
    362368                $index = $4;
    363                 $id = hex($id) if $id =~ /^0x[\da-fA-F]+$/; # convert hex ID's
     369                # convert hex ID's unless HEX_ID is 0 (for string ID's that look like hex)
     370                if ($id =~ /^0x[\da-fA-F]+$/ and (not defined $$table{VARS} or
     371                    not defined $$table{VARS}{HEX_ID} or $$table{VARS}{HEX_ID}))
     372                {
     373                    $id = hex($id);
     374                }
    364375                next;
    365376            }
     
    381392                my $tval = Image::ExifTool::XMP::UnescapeXML($3);
    382393                my $val = ucfirst $tval;
     394                $val = $tval if $tval =~ /^(cRAW|iTun)/; # special-case non-capitalized values
    383395                my $cap = ($tval ne $val);
    384396                if ($makeMissing and $lang eq 'en') {
    385397                    $lang = $makeMissing;
    386398                    $val = 'MISSING';
     399                    undef $cap;
    387400                }
    388401                my $isDefault = ($lang eq $Image::ExifTool::defaultLang);
     
    399412                    $langInfo{$lang}{$tableName} = $val;
    400413                    $changed{$lang} = 1;
    401                     warn("Capitalized '$lang' val for $name: $val\n") if $cap;
     414                    warn("Capitalized '${lang}' val for $name: $val\n") if $cap;
    402415                    next;
    403416                }
    404417                my @infoArray = GetTagInfoList($table, $id);
    405    
     418
    406419                # this will fail for UserDefined tags and tags without ID's
    407                 @infoArray or warn("Error loading tag for $tableName ID='$id'\n"), next;
     420                @infoArray or warn("Error loading tag for $tableName ID='${id}'\n"), next;
    408421                my ($tagInfo, $langInfo);
    409422                if (defined $index) {
     
    419432                        $$tagInfo{Description} = Image::ExifTool::MakeDescription($tagName);
    420433                    }
     434                    $defDesc = $$tagInfo{Description};
    421435                    $langInfo = $tagInfo;
    422436                } else {
     
    438452                        unless (defined $different{$t} and $different{$t} eq $val) {
    439453                            my $a = defined $different{$t} ? 'ANOTHER ' : '';
    440                             warn "${a}Different '$lang' desc for $tagName: $val (was $$langInfo{Description})\n";
     454                            warn "${a}Different '${lang}' desc for $tagName: $val (was $$langInfo{Description})\n";
    441455                            next if defined $different{$t}; # don't change back again
    442456                            $different{$t} = $val;
     
    445459                    }
    446460                    next if $isDefault;
    447                     $$langInfo{Description} = $val;
     461                    if (defined $defDesc and $defDesc eq $val) {
     462                        delete $$langInfo{Description}; # delete if same as default language
     463                    } else {
     464                        $$langInfo{Description} = $val;
     465                    }
    448466                } else {
    449467                    defined $key or warn("No key for $$tagInfo{Name}"), next;
     
    458476                        if ($$printConv{BITMASK} and $key =~ /^\d+$/) {
    459477                            my $i;
    460                             for ($i=0; $i<32; ++$i) {
    461                                 next unless $key == (0x01 << $i);
     478                            for ($i=0; $i<64; ++$i) {
     479                                my $mask = (0x01 << $i) or last;
     480                                next unless $key == $mask;
    462481                                $convVal = $$printConv{BITMASK}{$i};
    463482                            }
    464483                        }
    465                         warn("Missing PrintConv entry for $key") and next unless defined $convVal;
     484                        warn("Missing PrintConv entry for $tableName $$tagInfo{Name} $key\n") and next unless defined $convVal;
     485                    }
     486                    if ($cap and $convVal =~ /^[a-z]/) {
     487                        $val = lcfirst $val;    # change back to lower case
     488                        undef $cap;
    466489                    }
    467490                    my $lc = $$langInfo{PrintConv};
     
    476499                        unless (defined $different{$t} and $different{$t} eq $val) {
    477500                            my $a = defined $different{$t} ? 'ANOTHER ' : '';
    478                             warn "${a}Different '$lang' val for $tagName '$convVal': $val (was $oldVal)\n";
     501                            warn "${a}Different '${lang}' val for $tagName '${convVal}': $val (was $oldVal)\n";
    479502                            next if defined $different{$t}; # don't change back again
    480503                            $different{$t} = $val;
     
    483506                    }
    484507                    next if $isDefault;
    485                     warn("Capitalized '$lang' val for $tagName: $tval\n") if $cap;
     508                    warn("Capitalized '${lang}' val for $tagName: $tval\n") if $cap;
    486509                    $$lc{$convVal} = $val;
    487510                }
     
    493516    # rewrite all changed Lang modules
    494517    my $rtnVal = 0;
    495     foreach $lang ($forceUpdate ? @Image::ExifTool::langs : sort keys %changed) {
     518    foreach $lang ($updateFlag & 0x02 ? @Image::ExifTool::langs : sort keys %changed) {
    496519        next if $lang eq $Image::ExifTool::defaultLang;
    497520        ++$rtnVal;
    498521        # write this module (only increment version number if not forced)
    499         WriteLangModule($lang, $langInfo{$lang}, not defined $forceUpdate) or $rtnVal = -1, last;
     522        WriteLangModule($lang, $langInfo{$lang}, not $updateFlag & 0x01) or $rtnVal = -1, last;
    500523    }
    501524    return $rtnVal;
     
    541564use vars qw(\$VERSION);
    542565
    543 \$VERSION = '$ver';
     566\$VERSION = '${ver}';
    544567
    545568HEADER
     
    570593            next unless $conv;
    571594        }
    572         print XOUT "   '$tag' => ";
     595        print XOUT "   '${tag}' => ";
    573596        unless ($conv) {
    574             print XOUT "'$desc',\n";
     597            print XOUT "'${desc}',\n";
    575598            next;
    576599        }
    577600        print XOUT "{\n";
    578         print XOUT "      Description => '$desc',\n" if defined $desc;
     601        print XOUT "      Description => '${desc}',\n" if defined $desc;
    579602        if ($conv) {
    580603            print XOUT "      PrintConv => {\n";
     
    582605                my $str = EscapePerl($_);
    583606                my $val = EscapePerl($$conv{$_});
    584                 print XOUT "        '$str' => '$val',\n";
     607                print XOUT "        '${str}' => '${val}',\n";
    585608            }
    586609            print XOUT "      },\n";
     
    6026251;  # end
    603626
    604 
    605627__END__
    606628
     
    616638~head1 AUTHOR
    617639
    618 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     640Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    619641
    620642This library is free software; you can redistribute it and/or modify it
     
    641663#------------------------------------------------------------------------------
    642664# load all lang modules into hash
    643 # Inputs: 0) Hash reference
    644 sub LoadLangModules($)
     665# Inputs: 0) Hash reference, 1) specific language to load (undef for all)
     666sub LoadLangModules($;$)
    645667{
    646     my $langHash = shift;
    647     my $lang;
     668    my ($langHash, $lang) = @_;
    648669    require Image::ExifTool;
    649     foreach $lang (@Image::ExifTool::langs) {
     670    my @langs = $lang ? ($lang) : @Image::ExifTool::langs;
     671    foreach $lang (@langs) {
    650672        next if $lang eq $Image::ExifTool::defaultLang;
    651673        eval "require Image::ExifTool::Lang::$lang" or warn("Can't load Lang::$lang\n"), next;
     
    663685{
    664686    my $rtnVal;
    665     my $bNum = ($b =~ /^-?[0-9]+(\.\d*)?$/);
    666     if ($a =~ /^-?[0-9]+(\.\d*)?$/) {
    667         $rtnVal = ($bNum ? $a <=> $b : -1);
    668     } elsif ($bNum) {
    669         $rtnVal = 1;
     687    my ($bNum, $bDec);
     688    ($bNum, $bDec) = ($1, $3) if $b =~ /^(-?[0-9]+)(\.(\d*))?$/;
     689    if ($a =~ /^(-?[0-9]+)(\.(\d*))?$/) {
     690        if (defined $bNum) {
     691            $bNum += 1e9 if $numbersFirst == 2 and $bNum < 0;
     692            my $aInt = $1;
     693            $aInt += 1e9 if $numbersFirst == 2 and $aInt < 0;
     694            # compare integer part as a number
     695            $rtnVal = $aInt <=> $bNum;
     696            unless ($rtnVal) {
     697                my $aDec = $3 || 0;
     698                $bDec or $bDec = 0;
     699                # compare decimal part as an integer too
     700                # (so that "1.10" comes after "1.9")
     701                $rtnVal = $aDec <=> $bDec;
     702            }
     703        } else {
     704            $rtnVal = -$numbersFirst;
     705        }
     706    } elsif (defined $bNum) {
     707        $rtnVal = $numbersFirst;
    670708    } else {
    671709        my ($a2, $b2) = ($a, $b);
    672710        # expand numbers to 3 digits (with restrictions to avoid messing up ascii-hex tags)
    673         $a2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $a2 =~ /^(APP)?[.0-9 ]*$/ and length($a2)<16;
    674         $b2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $b2 =~ /^(APP)?[.0-9 ]*$/ and length($b2)<16;
     711        $a2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $a2 =~ /^(APP|DMC-\w+ )?[.0-9 ]*$/ and length($a2)<16;
     712        $b2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $b2 =~ /^(APP|DMC-\w+ )?[.0-9 ]*$/ and length($b2)<16;
    675713        $caseInsensitive and $rtnVal = (lc($a2) cmp lc($b2));
    676714        $rtnVal or $rtnVal = ($a2 cmp $b2);
     
    724762    Flags   - Set to output 'flags' attribute
    725763    NoDesc  - Set to suppress output of descriptions
     764    Lang    - Select a single language for output
    726765
    727766=item Return Value:
     
    7688070) XML file name
    769808
     8091) Update flags:
     810
     811    0x01 = preserve version numbers
     812    0x02 = update all modules, even if they didn't change
     813    0x04 = update from scratch, ignoring existing definitions
     814    0x08 = override existing different descriptions and values
     815
    770816=item Return Value:
    771817
     
    776822=head1 AUTHOR
    777823
    778 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     824Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    779825
    780826This library is free software; you can redistribute it and/or modify it
Note: See TracChangeset for help on using the changeset viewer.