#------------------------------------------------------------------------------
# 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 $makeMissing);
use Image::ExifTool qw(:Utils :Vars);
use Image::ExifTool::XMP;
$VERSION = '1.30';
@ISA = qw(Exporter);
# set this to a language code to generate Lang module with 'MISSING' entries
$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
} else {
print $fp ">";
}
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';
undef $cap;
}
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-2018, 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-2018, 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