exiftool_vendored 10.31.0 → 10.40.0

data/bin/Image-ExifTool-10.40/lib/Image/ExifTool/TagInfoXML.pm

@@ -0,0 +1,827 @@
+#------------------------------------------------------------------------------
+# File:         TagInfoXML.pm
+#
+# Description:  Read/write tag information XML database
+#
+# Revisions:    2009/01/28 - P. Harvey Created
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::TagInfoXML;
+
+use strict;
+require Exporter;
+
+use vars qw($VERSION @ISA);
+use Image::ExifTool qw(:Utils :Vars);
+use Image::ExifTool::XMP;
+
+$VERSION = '1.28';
+@ISA = qw(Exporter);
+
+# set this to a language code to generate Lang module with 'MISSING' entries
+my $makeMissing = '';
+
+sub LoadLangModules($;$);
+sub WriteLangModule($$;$);
+sub NumbersFirst;
+
+# names for acknowledgements in the POD documentation
+my %credits = (
+    cs   => 'Jens Duttke and Petr MichE<aacute>lek',
+    de   => 'Jens Duttke and Herbert Kauer',
+    es   => 'Jens Duttke, Santiago del BrE<iacute>o GonzE<aacute>lez and Emilio Sancha',
+    fi   => 'Jens Duttke and Jarkko ME<auml>kineva',
+    fr   => 'Jens Duttke, Bernard Guillotin, Jean Glasser, Jean Piquemal, Harry Nizard and Alphonse Philippe',
+    it   => 'Jens Duttke, Ferdinando Agovino, Emilio Dati and Michele Locati',
+    ja   => 'Jens Duttke and Kazunari Nishina',
+    ko   => 'Jens Duttke and Jeong Beom Kim',
+    nl   => 'Jens Duttke, Peter Moonen, Herman Beld and Peter van der Laan',
+    pl   => 'Jens Duttke, Przemyslaw Sulek and Kacper Perschke',
+    ru   => 'Jens Duttke, Sergey Shemetov, Dmitry Yerokhin and Anton Sukhinov',
+    sv   => 'Jens Duttke and BjE<ouml>rn SE<ouml>derstrE<ouml>m',
+   'tr'  => 'Jens Duttke, Hasan Yildirim and Cihan Ulusoy',
+    zh_cn => 'Jens Duttke and Haibing Zhong',
+    zh_tw => 'Jens Duttke and MikeF',
+);
+
+# translate country codes to language codes
+my %translateLang = (
+    ch_s  => 'zh_cn',
+    ch_cn => 'zh_cn',
+    ch_tw => 'zh_tw',
+    cz    => 'cs',
+    jp    => 'ja',
+    kr    => 'ko',
+    se    => 'sv',
+);
+
+my $numbersFirst = 1;   # set to -1 to sort numbers last, or 2 to put negative numbers last
+my $caseInsensitive;    # used internally by sort routine
+
+#------------------------------------------------------------------------------
+# Utility to print tag information database as an XML list
+# Inputs: 0) output file name (undef to send to console),
+#         1) group name (may be undef), 2) options hash ('Flags','NoDesc','Lang')
+# Returns: true on success
+sub Write(;$$%)
+{
+    local ($_, *PTIFILE);
+    my ($file, $group, %opts) = @_;
+    my @groups = split ':', $group if $group;
+    my $et = new Image::ExifTool;
+    my ($fp, $tableName, %langInfo, @langs, $defaultLang);
+
+    Image::ExifTool::LoadAllTables();   # first load all our tables
+    unless ($opts{NoDesc}) {
+        $defaultLang = $Image::ExifTool::defaultLang;
+        LoadLangModules(\%langInfo, $opts{Lang}); # load necessary Lang modules
+        if ($opts{Lang}) {
+            @langs = grep /^$opts{Lang}$/i, keys %langInfo;
+        } else {
+            @langs = sort keys %langInfo;
+        }
+    }
+    if (defined $file) {
+        open PTIFILE, ">$file" or return 0;
+        $fp = \*PTIFILE;
+    } else {
+        $fp = \*STDOUT;
+    }
+    print $fp "<?xml version='1.0' encoding='UTF-8'?>\n";
+    print $fp "<!-- Generated by Image::ExifTool $Image::ExifTool::VERSION -->\n";
+    print $fp "<taginfo>\n\n";
+
+    # loop through all tables and save tag names to %allTags hash
+    foreach $tableName (sort keys %allTables) {
+        my $table = GetTagTable($tableName);
+        my $grps = $$table{GROUPS};
+        my ($tagID, $didTag);
+        # sort in same order as tag name documentation
+        $caseInsensitive = ($tableName =~ /::XMP::/);
+        # get list of languages defining elements in this table
+        my $isBinary = ($$table{PROCESS_PROC} and
+                        $$table{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData);
+        # generate flattened tag names for structure fields if this is an XMP table
+        if ($$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP') {
+            Image::ExifTool::XMP::AddFlattenedTags($table);
+        }
+        $numbersFirst = 2;
+        $numbersFirst = -1 if $$table{VARS} and $$table{VARS}{ALPHA_FIRST};
+        my @keys = sort NumbersFirst TagTableKeys($table);
+        $numbersFirst = 1;
+        # loop through all tag ID's in this table
+        foreach $tagID (@keys) {
+            my @infoArray = GetTagInfoList($table, $tagID);
+            my $xmlID = Image::ExifTool::XMP::FullEscapeXML($tagID);
+            # get a list of languages defining elements for this ID
+            my ($index, $fam);
+PTILoop:    for ($index=0; $index<@infoArray; ++$index) {
+                my $tagInfo = $infoArray[$index];
+                # don't list subdirectories unless they are writable
+                next unless $$tagInfo{Writable} or not $$tagInfo{SubDirectory};
+                if (@groups) {
+                    my @tg = $et->GetGroup($tagInfo);
+                    foreach $group (@groups) {
+                        next PTILoop unless grep /^$group$/i, @tg;
+                    }
+                }
+                unless ($didTag) {
+                    my $tname = $$table{SHORT_NAME};
+                    print $fp "<table name='$tname' g0='$$grps{0}' g1='$$grps{1}' g2='$$grps{2}'>\n";
+                    unless ($opts{NoDesc}) {
+                        # print table description
+                        my $desc = $$table{TABLE_DESC};
+                        unless ($desc) {
+                            ($desc = $tname) =~ s/::Main$//;
+                            $desc =~ s/::/ /g;
+                        }
+                        # print alternate language descriptions
+                        print $fp " <desc lang='en'>$desc</desc>\n";
+                        foreach (@langs) {
+                            $desc = $langInfo{$_}{$tableName} or next;
+                            $desc = Image::ExifTool::XMP::EscapeXML($desc);
+                            print $fp " <desc lang='$_'>$desc</desc>\n";
+                        }
+                    }
+                    $didTag = 1;
+                }
+                my $name = $$tagInfo{Name};
+                my $ind = @infoArray > 1 ? " index='$index'" : '';
+                my $format = $$tagInfo{Writable} || $$table{WRITABLE};
+                my $writable = $format ? 'true' : 'false';
+                # check our conversions to make sure we can really write this tag
+                if ($writable eq 'true') {
+                    foreach ('PrintConv','ValueConv') {
+                        next unless $$tagInfo{$_};
+                        next if $$tagInfo{$_ . 'Inv'};
+                        next if ref($$tagInfo{$_}) =~ /^(HASH|ARRAY)$/;
+                        next if $$tagInfo{WriteAlso};
+                        $writable = 'false';
+                        last;
+                    }
+                }
+                $format = $$tagInfo{Format} || $$table{FORMAT} if not defined $format or $format eq '1';
+                $format = 'struct' if $$tagInfo{Struct};
+                if (defined $format) {
+                    $format =~ s/\[.*\$.*\]//;   # remove expressions from format
+                } elsif ($isBinary) {
+                    $format = 'int8u';
+                } else {
+                    $format = '?';
+                }
+                my $count = '';
+                if ($format =~ s/\[.*?(\d*)\]$//) {
+                    $count = " count='$1'" if length $1;
+                } elsif ($$tagInfo{Count} and $$tagInfo{Count} > 1) {
+                    $count = " count='$$tagInfo{Count}'";
+                }
+                my @groups = $et->GetGroup($tagInfo);
+                my $writeGroup = $$tagInfo{WriteGroup} || $$table{WRITE_GROUP};
+                if ($writeGroup and $writeGroup ne 'Comment') {
+                    $groups[1] = $writeGroup;   # use common write group for group 1
+                }
+                # add group names if different from table defaults
+                my $grp = '';
+                for ($fam=0; $fam<3; ++$fam) {
+                    $grp .= " g$fam='$groups[$fam]'" if $groups[$fam] ne $$grps{$fam};
+                }
+                # add flags if necessary
+                if ($opts{Flags}) {
+                    my @flags;
+                    foreach (qw(Avoid Binary List Mandatory Unknown)) {
+                        push @flags, $_ if $$tagInfo{$_};
+                    }
+                    push @flags, $$tagInfo{List} if $$tagInfo{List} and $$tagInfo{List} =~ /^(Alt|Bag|Seq)$/;
+                    push @flags, 'Flattened' if defined $$tagInfo{Flat};
+                    push @flags, 'Unsafe' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x01;
+                    push @flags, 'Protected' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x02;
+                    push @flags, 'Permanent' if $$tagInfo{Permanent} or
+                        ($groups[0] eq 'MakerNotes' and not defined $$tagInfo{Permanent});
+                    $grp = " flags='" . join(',', sort @flags) . "'$grp" if @flags;
+                }
+                print $fp " <tag id='$xmlID' name='$name'$ind type='$format'$count writable='$writable'$grp";
+                if ($opts{NoDesc}) {
+                    # short output format
+                    print $fp "/>\n";   # empty tag element
+                    next;               # no descriptions or values
+                }
+                my $desc = $$tagInfo{Description};
+                $desc = Image::ExifTool::MakeDescription($name) unless defined $desc;
+                # add alternate language descriptions and get references
+                # to alternate language PrintConv hashes
+                my $altDescr = '';
+                my %langConv;
+                foreach (@langs) {
+                    my $ld = $langInfo{$_}{$name} or next;
+                    if (ref $ld) {
+                        $langConv{$_} = $$ld{PrintConv};
+                        $ld = $$ld{Description} or next;
+                    }
+                    # ignore descriptions that are the same as the default language
+                    next if $ld eq $desc;
+                    $ld = Image::ExifTool::XMP::EscapeXML($ld);
+                    $altDescr .= "\n  <desc lang='$_'>$ld</desc>";
+                }
+                # print tag descriptions
+                $desc = Image::ExifTool::XMP::EscapeXML($desc);
+                unless ($opts{Lang} and $altDescr) {
+                    print $fp ">\n  <desc lang='$defaultLang'>$desc</desc>";
+                }
+                print $fp "$altDescr\n";
+                for (my $i=0; ; ++$i) {
+                    my $conv = $$tagInfo{PrintConv};
+                    my $idx = '';
+                    if (ref $conv eq 'ARRAY') {
+                        last unless $i < @$conv;
+                        $conv = $$conv[$i];
+                        $idx = " index='$i'";
+                    } else {
+                        last if $i;
+                    }
+                    next unless ref $conv eq 'HASH';
+                    # make a list of available alternate languages
+                    my @langConv = sort keys %langConv;
+                    print $fp "  <values$idx>\n";
+                    my $key;
+                    $caseInsensitive = 0;
+                    # add bitmask values to main lookup
+                    if ($$conv{BITMASK}) {
+                        foreach $key (keys %{$$conv{BITMASK}}) {
+                            my $mask = 0x01 << $key;
+                            next if not $mask or $$conv{$mask};
+                            $$conv{$mask} = $$conv{BITMASK}{$key};
+                        }
+                    }
+                    foreach $key (sort NumbersFirst keys %$conv) {
+                        next if $key eq 'BITMASK' or $key eq 'OTHER' or $key eq 'Notes';
+                        my $val = $$conv{$key};
+                        my $xmlVal = Image::ExifTool::XMP::EscapeXML($val);
+                        my $xmlKey = Image::ExifTool::XMP::FullEscapeXML($key);
+                        print $fp "   <key id='$xmlKey'>\n";
+                        # add alternate language values
+                        my $altConv = '';
+                        foreach (@langConv) {
+                            my $lv = $langConv{$_};
+                            # handle indexed PrintConv entries
+                            $lv = $$lv[$i] or next if ref $lv eq 'ARRAY';
+                            $lv = $$lv{$val};
+                            # ignore values that are missing or same as default
+                            next unless defined $lv and $lv ne $val;
+                            $lv = Image::ExifTool::XMP::EscapeXML($lv);
+                            $altConv .= "    <val lang='$_'>$lv</val>\n";
+                        }
+                        unless ($opts{Lang} and $altConv) {
+                            print $fp "    <val lang='$defaultLang'>$xmlVal</val>\n"
+                        }
+                        print $fp "$altConv   </key>\n";
+                    }
+                    print $fp "  </values>\n";
+                }
+                print $fp " </tag>\n";
+            }
+        }
+        print $fp "</table>\n\n" if $didTag;
+    }
+    my $success = 1;
+    print $fp "</taginfo>\n" or $success = 0;
+    close $fp or $success = 0 if defined $file;
+    return $success;
+}
+
+#------------------------------------------------------------------------------
+# Escape backslash and quote in string
+# Inputs: string
+# Returns: escaped string
+sub EscapePerl
+{
+    my $str = shift;
+    $str =~ s/\\/\\\\/g;
+    $str =~ s/'/\\'/g;
+    return $str;
+}
+
+#------------------------------------------------------------------------------
+# Generate Lang modules from input tag info XML database
+# Inputs: 0) XML filename, 1) update flags:
+#       0x01 = preserve version numbers
+#       0x02 = update all modules, even if they didn't change
+#       0x04 = update from scratch, ignoring existing definitions
+#       0x08 = override existing different descriptions and values
+# Returns: Count of updated Lang modules, or -1 on error
+# Notes: Must be run from the directory containing 'lib'
+sub BuildLangModules($;$)
+{
+    local ($_, *XFILE);
+    my ($file, $updateFlag) = @_;
+    my ($table, $tableName, $id, $index, $valIndex, $name, $key, $lang, $defDesc);
+    my (%langInfo, %different, %changed, $overrideDifferent);
+
+    Image::ExifTool::LoadAllTables();   # first load all our tables
+    # generate our flattened tags
+    foreach $tableName (sort keys %allTables) {
+        my $table = GetTagTable($tableName);
+        next unless $$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP';
+        Image::ExifTool::XMP::AddFlattenedTags($table);
+    }
+    LoadLangModules(\%langInfo);        # load all existing Lang modules
+    $updateFlag = 0 unless $updateFlag;
+    %langInfo = () if $updateFlag & 0x04;
+    $overrideDifferent = 1 if $updateFlag & 0x08;
+
+    if (defined $file) {
+        open XFILE, $file or return -1;
+        while (<XFILE>) {
+            next unless /^\s*<(\/?)(\w+)/;
+            my $tok = $2;
+            if ($1) {
+                # close appropriate entities
+                if ($tok eq 'tag') {
+                    undef $id;
+                    undef $index;
+                    undef $name;
+                    undef $defDesc;
+                } elsif ($tok eq 'values') {
+                    undef $key;
+                    undef $valIndex;
+                } elsif ($tok eq 'table') {
+                    undef $table;
+                    undef $id;
+                }
+                next;
+            }
+            if ($tok eq 'table') {
+                /^\s*<table name='([^']+)'[ >]/ or warn('Bad table'), next;
+                $tableName = "Image::ExifTool::$1";
+                # ignore userdefined tables
+                next if $tableName =~ /^Image::ExifTool::UserDefined/;
+                $table = Image::ExifTool::GetTagTable($tableName);
+                $table or warn("Unknown tag table $tableName\n");
+                next;
+            }
+            next unless defined $table;
+            if ($tok eq 'tag') {
+                /^\s*<tag id='([^']*)' name='([^']+)'( index='(\d+)')?[ >]/ or warn('Bad tag'), next;
+                $id = Image::ExifTool::XMP::FullUnescapeXML($1);
+                $name = $2;
+                $index = $4;
+                $id = hex($id) if $id =~ /^0x[\da-fA-F]+$/; # convert hex ID's
+                next;
+            }
+            if ($tok eq 'values') {
+                /^\s*<values index='([^']*)'>/ or next;
+                $valIndex = $1;
+            } elsif ($tok eq 'key') {
+                defined $id or warn('No ID'), next;
+                /^\s*<key id='([^']*)'>/ or warn('Bad key'), next;
+                $key = Image::ExifTool::XMP::FullUnescapeXML($1);
+                $key = hex($key) if $key =~ /^0x[\da-fA-F]+$/; # convert hex keys
+            } elsif ($tok eq 'val' or $tok eq 'desc') {
+                /^\s*<$tok( lang='([-\w]+?)')?>(.*)<\/$tok>/ or warn("Bad $tok"), next;
+                $tok eq 'desc' and defined $key and warn('Out of order "desc"'), next;
+                my $lang = $2 or next; # looking only for alternate languages
+                $lang =~ tr/-A-Z/_a-z/;
+                # use standard ISO 639-1 language codes
+                $lang = $translateLang{$lang} if $translateLang{$lang};
+                my $tval = Image::ExifTool::XMP::UnescapeXML($3);
+                my $val = ucfirst $tval;
+                $val = $tval if $tval =~ /^(cRAW|iTun)/; # special-case non-capitalized values
+                my $cap = ($tval ne $val);
+                if ($makeMissing and $lang eq 'en') {
+                    $lang = $makeMissing;
+                    $val = 'MISSING';
+                }
+                my $isDefault = ($lang eq $Image::ExifTool::defaultLang);
+                unless ($langInfo{$lang} or $isDefault) {
+                    print "Creating new language $lang\n";
+                    $langInfo{$lang} = { };
+                }
+                defined $name or $name = '<unknown>';
+                unless (defined $id) {
+                    next if $isDefault;
+                    # this is a table description
+                    next if $langInfo{$lang}{$tableName} and
+                            $langInfo{$lang}{$tableName} eq $val;
+                    $langInfo{$lang}{$tableName} = $val;
+                    $changed{$lang} = 1;
+                    warn("Capitalized '$lang' val for $name: $val\n") if $cap;
+                    next;
+                }
+                my @infoArray = GetTagInfoList($table, $id);
+
+                # this will fail for UserDefined tags and tags without ID's
+                @infoArray or warn("Error loading tag for $tableName ID='$id'\n"), next;
+                my ($tagInfo, $langInfo);
+                if (defined $index) {
+                    $tagInfo = $infoArray[$index];
+                    $tagInfo or warn('Invalid index'), next;
+                } else {
+                    @infoArray > 1 and warn('Missing index'), next;
+                    $tagInfo = $infoArray[0];
+                }
+                my $tagName = $$tagInfo{Name};
+                if ($isDefault) {
+                    unless ($$tagInfo{Description}) {
+                        $$tagInfo{Description} = Image::ExifTool::MakeDescription($tagName);
+                    }
+                    $defDesc = $$tagInfo{Description};
+                    $langInfo = $tagInfo;
+                } else {
+                    $langInfo = $langInfo{$lang}{$tagName};
+                    if (not defined $langInfo) {
+                        $langInfo = $langInfo{$lang}{$tagName} = { };
+                    } elsif (not ref $langInfo) {
+                        $langInfo = $langInfo{$lang}{$tagName} = { Description => $langInfo };
+                    }
+                }
+                # save new value in langInfo record
+                if ($tok eq 'desc') {
+                    my $oldVal = $$langInfo{Description};
+                    next if defined $oldVal and $oldVal eq $val;
+                    if ($makeMissing) {
+                        next if defined $oldVal and $val eq 'MISSING';
+                    } elsif (defined $oldVal) {
+                        my $t = "$lang $tagName";
+                        unless (defined $different{$t} and $different{$t} eq $val) {
+                            my $a = defined $different{$t} ? 'ANOTHER ' : '';
+                            warn "${a}Different '$lang' desc for $tagName: $val (was $$langInfo{Description})\n";
+                            next if defined $different{$t}; # don't change back again
+                            $different{$t} = $val;
+                        }
+                        next unless $overrideDifferent;
+                    }
+                    next if $isDefault;
+                    if (defined $defDesc and $defDesc eq $val) {
+                        delete $$langInfo{Description}; # delete if same as default language
+                    } else {
+                        $$langInfo{Description} = $val;
+                    }
+                } else {
+                    defined $key or warn("No key for $$tagInfo{Name}"), next;
+                    my $printConv = $$tagInfo{PrintConv};
+                    if (ref $printConv eq 'ARRAY') {
+                        defined $valIndex or warn('No value index'), next;
+                        $printConv = $$printConv[$valIndex];
+                    }
+                    ref $printConv eq 'HASH' or warn('No PrintConv'), next;
+                    my $convVal = $$printConv{$key};
+                    unless (defined $convVal) {
+                        if ($$printConv{BITMASK} and $key =~ /^\d+$/) {
+                            my $i;
+                            for ($i=0; $i<64; ++$i) {
+                                my $mask = (0x01 << $i) or last;
+                                next unless $key == $mask;
+                                $convVal = $$printConv{BITMASK}{$i};
+                            }
+                        }
+                        warn("Missing PrintConv entry for $tableName $$tagInfo{Name} $key\n") and next unless defined $convVal;
+                    }
+                    if ($cap and $convVal =~ /^[a-z]/) {
+                        $val = lcfirst $val;    # change back to lower case
+                        undef $cap;
+                    }
+                    my $lc = $$langInfo{PrintConv};
+                    $lc or $lc = $$langInfo{PrintConv} = { };
+                    $lc = $printConv if ref $lc eq 'ARRAY'; #(default lang only)
+                    my $oldVal = $$lc{$convVal};
+                    next if defined $oldVal and $oldVal eq $val;
+                    if ($makeMissing) {
+                        next if defined $oldVal and $val eq 'MISSING';
+                    } elsif (defined $oldVal and (not $isDefault or not $val=~/^\d+$/)) {
+                        my $t = "$lang $tagName $convVal";
+                        unless (defined $different{$t} and $different{$t} eq $val) {
+                            my $a = defined $different{$t} ? 'ANOTHER ' : '';
+                            warn "${a}Different '$lang' val for $tagName '$convVal': $val (was $oldVal)\n";
+                            next if defined $different{$t}; # don't change back again
+                            $different{$t} = $val;
+                        }
+                        next unless $overrideDifferent;
+                    }
+                    next if $isDefault;
+                    warn("Capitalized '$lang' val for $tagName: $tval\n") if $cap;
+                    $$lc{$convVal} = $val;
+                }
+                $changed{$lang} = 1;
+            }
+        }
+        close XFILE;
+    }
+    # rewrite all changed Lang modules
+    my $rtnVal = 0;
+    foreach $lang ($updateFlag & 0x02 ? @Image::ExifTool::langs : sort keys %changed) {
+        next if $lang eq $Image::ExifTool::defaultLang;
+        ++$rtnVal;
+        # write this module (only increment version number if not forced)
+        WriteLangModule($lang, $langInfo{$lang}, not $updateFlag & 0x01) or $rtnVal = -1, last;
+    }
+    return $rtnVal;
+}
+
+#------------------------------------------------------------------------------
+# Write Lang module
+# Inputs: 0) language string, 1) langInfo lookup reference, 2) flag to increment version
+# Returns: true on success
+sub WriteLangModule($$;$)
+{
+    local ($_, *XOUT);
+    my ($lang, $langTags, $newVersion) = @_;
+    my $err;
+    -e "lib/Image/ExifTool" or die "Must run from directory containing 'lib'\n";
+    my $out = "lib/Image/ExifTool/Lang/$lang.pm";
+    my $tmp = "$out.tmp";
+    open XOUT, ">$tmp" or die "Error creating $tmp\n";
+    my $ver = "Image::ExifTool::Lang::${lang}::VERSION";
+    no strict 'refs';
+    if ($$ver) {
+        $ver = $$ver;
+        $ver = int($ver * 100 + 1.5) / 100 if $newVersion;
+    } else {
+        $ver = 1.0;
+    }
+    $ver = sprintf('%.2f', $ver);
+    use strict 'refs';
+    my $langName = $Image::ExifTool::langName{$lang} || $lang;
+    $langName =~ s/\s*\(.*//;
+    print XOUT <<HEADER;
+#------------------------------------------------------------------------------
+# File:         $lang.pm
+#
+# Description:  ExifTool $langName language translations
+#
+# Notes:        This file generated automatically by Image::ExifTool::TagInfoXML
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::Lang::$lang;
+
+use strict;
+use vars qw(\$VERSION);
+
+\$VERSION = '$ver';
+
+HEADER
+    print XOUT "\%Image::ExifTool::Lang::${lang}::Translate = (\n";
+    # loop through all tag and table names
+    my $tag;
+    foreach $tag (sort keys %$langTags) {
+        my $desc = $$langTags{$tag};
+        my $conv;
+        if (ref $desc) {
+            $conv = $$desc{PrintConv};
+            $desc = $$desc{Description};
+            # remove description if not necessary
+            # (not strictly correct -- should test against tag description, not name)
+            undef $desc if $desc and $desc eq $tag;
+            # remove unnecessary value translations
+            if ($conv) {
+                my @keys = keys %$conv;
+                foreach (@keys) {
+                    delete $$conv{$_} if $_ eq $$conv{$_};
+                }
+                undef $conv unless %$conv;
+            }
+        }
+        if (defined $desc) {
+            $desc = EscapePerl($desc);
+        } else {
+            next unless $conv;
+        }
+        print XOUT "   '$tag' => ";
+        unless ($conv) {
+            print XOUT "'$desc',\n";
+            next;
+        }
+        print XOUT "{\n";
+        print XOUT "      Description => '$desc',\n" if defined $desc;
+        if ($conv) {
+            print XOUT "      PrintConv => {\n";
+            foreach (sort keys %$conv) {
+                my $str = EscapePerl($_);
+                my $val = EscapePerl($$conv{$_});
+                print XOUT "        '$str' => '$val',\n";
+            }
+            print XOUT "      },\n";
+        }
+        print XOUT "    },\n";
+    }
+    # generate acknowledgements for this language
+    my $ack;
+    if ($credits{$lang}) {
+        $ack = "Thanks to $credits{$lang} for providing this translation.";
+        $ack =~ s/(.{1,76})( +|$)/$1\n/sg;  # wrap text to 76 columns
+        $ack = "~head1 ACKNOWLEDGEMENTS\n\n$ack\n";
+    } else {
+        $ack = '';
+    }
+    my $footer = <<FOOTER;
+);
+
+1;  # end
+
+
+__END__
+
+~head1 NAME
+
+Image::ExifTool::Lang::$lang.pm - ExifTool $langName language translations
+
+~head1 DESCRIPTION
+
+This file is used by Image::ExifTool to generate localized tag descriptions
+and values.
+
+~head1 AUTHOR
+
+Copyright 2003-2017, Phil Harvey (phil at owl.phy.queensu.ca)
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+$ack~head1 SEE ALSO
+
+L<Image::ExifTool(3pm)|Image::ExifTool>,
+L<Image::ExifTool::TagInfoXML(3pm)|Image::ExifTool::TagInfoXML>
+
+~cut
+FOOTER
+    $footer =~ s/^~/=/mg;   # un-do pod obfuscation
+    print XOUT $footer or $err = 1;
+    close XOUT or $err = 1;
+    if ($err or not rename($tmp, $out)) {
+        warn "Error writing $out\n";
+        unlink $tmp;
+        $err = 1;
+    }
+    return $err ? 0 : 1;
+}
+
+#------------------------------------------------------------------------------
+# load all lang modules into hash
+# Inputs: 0) Hash reference, 1) specific language to load (undef for all)
+sub LoadLangModules($;$)
+{
+    my ($langHash, $lang) = @_;
+    require Image::ExifTool;
+    my @langs = $lang ? ($lang) : @Image::ExifTool::langs;
+    foreach $lang (@langs) {
+        next if $lang eq $Image::ExifTool::defaultLang;
+        eval "require Image::ExifTool::Lang::$lang" or warn("Can't load Lang::$lang\n"), next;
+        my $xlat = "Image::ExifTool::Lang::${lang}::Translate";
+        no strict 'refs';
+        %$xlat or warn("Missing Info for $lang\n"), next;
+        $$langHash{$lang} = \%$xlat;
+        use strict 'refs';
+    }
+}
+
+#------------------------------------------------------------------------------
+# sort numbers first numerically, then strings alphabetically (case insensitive)
+sub NumbersFirst
+{
+    my $rtnVal;
+    my ($bNum, $bDec);
+    ($bNum, $bDec) = ($1, $3) if $b =~ /^(-?[0-9]+)(\.(\d*))?$/;
+    if ($a =~ /^(-?[0-9]+)(\.(\d*))?$/) {
+        if (defined $bNum) {
+            $bNum += 1e9 if $numbersFirst == 2 and $bNum < 0;
+            my $aInt = $1;
+            $aInt += 1e9 if $numbersFirst == 2 and $aInt < 0;
+            # compare integer part as a number
+            $rtnVal = $aInt <=> $bNum;
+            unless ($rtnVal) {
+                my $aDec = $3 || 0;
+                $bDec or $bDec = 0;
+                # compare decimal part as an integer too
+                # (so that "1.10" comes after "1.9")
+                $rtnVal = $aDec <=> $bDec;
+            }
+        } else {
+            $rtnVal = -$numbersFirst;
+        }
+    } elsif (defined $bNum) {
+        $rtnVal = $numbersFirst;
+    } else {
+        my ($a2, $b2) = ($a, $b);
+        # expand numbers to 3 digits (with restrictions to avoid messing up ascii-hex tags)
+        $a2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $a2 =~ /^(APP|DMC-\w+ )?[.0-9 ]*$/ and length($a2)<16;
+        $b2 =~ s/(\d+)/sprintf("%.3d",$1)/eg if $b2 =~ /^(APP|DMC-\w+ )?[.0-9 ]*$/ and length($b2)<16;
+        $caseInsensitive and $rtnVal = (lc($a2) cmp lc($b2));
+        $rtnVal or $rtnVal = ($a2 cmp $b2);
+    }
+    return $rtnVal;
+}
+
+1;  # end
+
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::TagInfoXML - Read/write tag information XML database
+
+=head1 DESCRIPTION
+
+This module is used to generate an XML database from all ExifTool tag
+information.  The XML database may then be edited and used to re-generate
+the language modules (Image::ExifTool::Lang::*).
+
+=head1 METHODS
+
+=head2 Write
+
+Print complete tag information database in XML format.
+
+  # save list of all tags
+  $success = Image::ExifTool::TagInfoXML::Write('dst.xml');
+
+  # list all IPTC tags to console, including Flags
+  Image::ExifTool::TagInfoXML::Write(undef, 'IPTC', Flags => 1);
+
+  # write all EXIF Camera tags to file
+  Image::ExifTool::TagInfoXML::Write($outfile, 'exif:camera');
+
+=over 4
+
+=item Inputs:
+
+0) [optional] Output file name, or undef for console output.  Output file
+will be overwritten if it already exists.
+
+1) [optional] String of group names separated by colons to specify the group
+to print.  A specific IFD may not be given as a group, since EXIF tags may
+be written to any IFD.  Saves all groups if not specified.
+
+2) [optional] Hash of options values:
+
+    Flags   - Set to output 'flags' attribute
+    NoDesc  - Set to suppress output of descriptions
+    Lang    - Select a single language for output
+
+=item Return Value:
+
+True on success.
+
+=item Sample XML Output:
+
+=back
+
+  <?xml version='1.0' encoding='UTF-8'?>
+  <taginfo>
+
+  <table name='XMP::dc' g0='XMP' g1='XMP-dc' g2='Other'>
+   <desc lang='en'>XMP Dublin Core</desc>
+   <tag id='title' name='Title' type='lang-alt' writable='true' g2='Image'>
+    <desc lang='en'>Title</desc>
+    <desc lang='de'>Titel</desc>
+    <desc lang='fr'>Titre</desc>
+   </tag>
+   ...
+  </table>
+
+  </taginfo>
+
+Flags (if selected and available) are formatted as a comma-separated list of
+the following possible values:  Avoid, Binary, List, Mandatory, Permanent,
+Protected, Unknown and Unsafe.  See the
+L<tag name documentation|Image::ExifTool::TagNames> and
+lib/Image/ExifTool/README for a description of these flags.  For XMP List
+tags, the list type (Alt, Bag or Seq) is also output as a flag if
+applicable.
+
+=head2 BuildLangModules
+
+Build all Image::ExifTool::Lang modules from an XML database file.
+
+    Image::ExifTool::TagInfoXML::BuildLangModules('src.xml');
+
+=over 4
+
+=item Inputs:
+
+0) XML file name
+
+1) Update flags:
+
+    0x01 = preserve version numbers
+    0x02 = update all modules, even if they didn't change
+    0x04 = update from scratch, ignoring existing definitions
+    0x08 = override existing different descriptions and values
+
+=item Return Value:
+
+Number of modules updated, or negative on error.
+
+=back
+
+=head1 AUTHOR
+
+Copyright 2003-2017, Phil Harvey (phil at owl.phy.queensu.ca)
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Image::ExifTool(3pm)|Image::ExifTool>,
+L<Image::ExifTool::TagNames(3pm)|Image::ExifTool::TagNames>
+
+=cut