| 1 | #------------------------------------------------------------------------------
|
|---|
| 2 | # File: TagInfoXML.pm
|
|---|
| 3 | #
|
|---|
| 4 | # Description: Read/write tag information XML database
|
|---|
| 5 | #
|
|---|
| 6 | # Revisions: 2009/01/28 - P. Harvey Created
|
|---|
| 7 | #------------------------------------------------------------------------------
|
|---|
| 8 |
|
|---|
| 9 | package Image::ExifTool::TagInfoXML;
|
|---|
| 10 |
|
|---|
| 11 | use strict;
|
|---|
| 12 | require Exporter;
|
|---|
| 13 |
|
|---|
| 14 | use vars qw($VERSION @ISA $makeMissing);
|
|---|
| 15 | use Image::ExifTool qw(:Utils :Vars);
|
|---|
| 16 | use Image::ExifTool::XMP;
|
|---|
| 17 |
|
|---|
| 18 | $VERSION = '1.31';
|
|---|
| 19 | @ISA = qw(Exporter);
|
|---|
| 20 |
|
|---|
| 21 | # set this to a language code to generate Lang module with 'MISSING' entries
|
|---|
| 22 | $makeMissing = '';
|
|---|
| 23 |
|
|---|
| 24 | sub LoadLangModules($;$);
|
|---|
| 25 | sub WriteLangModule($$;$);
|
|---|
| 26 | sub NumbersFirst;
|
|---|
| 27 |
|
|---|
| 28 | # names for acknowledgements in the POD documentation
|
|---|
| 29 | my %credits = (
|
|---|
| 30 | cs => 'Jens Duttke and Petr MichE<aacute>lek',
|
|---|
| 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',
|
|---|
| 36 | ja => 'Jens Duttke and Kazunari Nishina',
|
|---|
| 37 | ko => 'Jens Duttke and Jeong Beom Kim',
|
|---|
| 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',
|
|---|
| 41 | sv => 'Jens Duttke and BjE<ouml>rn SE<ouml>derstrE<ouml>m',
|
|---|
| 42 | 'tr' => 'Jens Duttke, Hasan Yildirim and Cihan Ulusoy',
|
|---|
| 43 | zh_cn => 'Jens Duttke and Haibing Zhong',
|
|---|
| 44 | zh_tw => 'Jens Duttke and MikeF',
|
|---|
| 45 | );
|
|---|
| 46 |
|
|---|
| 47 | # translate country codes to language codes
|
|---|
| 48 | my %translateLang = (
|
|---|
| 49 | ch_s => 'zh_cn',
|
|---|
| 50 | ch_cn => 'zh_cn',
|
|---|
| 51 | ch_tw => 'zh_tw',
|
|---|
| 52 | cz => 'cs',
|
|---|
| 53 | jp => 'ja',
|
|---|
| 54 | kr => 'ko',
|
|---|
| 55 | se => 'sv',
|
|---|
| 56 | );
|
|---|
| 57 |
|
|---|
| 58 | my $numbersFirst = 1; # set to -1 to sort numbers last, or 2 to put negative numbers last
|
|---|
| 59 | my $caseInsensitive; # used internally by sort routine
|
|---|
| 60 |
|
|---|
| 61 | #------------------------------------------------------------------------------
|
|---|
| 62 | # Utility to print tag information database as an XML list
|
|---|
| 63 | # Inputs: 0) output file name (undef to send to console),
|
|---|
| 64 | # 1) group name (may be undef), 2) options hash ('Flags','NoDesc','Lang')
|
|---|
| 65 | # Returns: true on success
|
|---|
| 66 | sub Write(;$$%)
|
|---|
| 67 | {
|
|---|
| 68 | local ($_, *PTIFILE);
|
|---|
| 69 | my ($file, $group, %opts) = @_;
|
|---|
| 70 | my $et = new Image::ExifTool;
|
|---|
| 71 | my ($fp, $tableName, %langInfo, @langs, $defaultLang, @groups);
|
|---|
| 72 | @groups = split ':', $group if $group;
|
|---|
| 73 |
|
|---|
| 74 | Image::ExifTool::LoadAllTables(); # first load all our tables
|
|---|
| 75 | unless ($opts{NoDesc}) {
|
|---|
| 76 | $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 | }
|
|---|
| 83 | }
|
|---|
| 84 | if (defined $file) {
|
|---|
| 85 | open PTIFILE, ">$file" or return 0;
|
|---|
| 86 | $fp = \*PTIFILE;
|
|---|
| 87 | } else {
|
|---|
| 88 | $fp = \*STDOUT;
|
|---|
| 89 | }
|
|---|
| 90 | print $fp "<?xml version='1.0' encoding='UTF-8'?>\n";
|
|---|
| 91 | print $fp "<!-- Generated by Image::ExifTool $Image::ExifTool::VERSION -->\n";
|
|---|
| 92 | print $fp "<taginfo>\n\n";
|
|---|
| 93 |
|
|---|
| 94 | # loop through all tables and save tag names to %allTags hash
|
|---|
| 95 | foreach $tableName (sort keys %allTables) {
|
|---|
| 96 | my $table = GetTagTable($tableName);
|
|---|
| 97 | my $grps = $$table{GROUPS};
|
|---|
| 98 | my ($tagID, $didTag);
|
|---|
| 99 | # sort in same order as tag name documentation
|
|---|
| 100 | $caseInsensitive = ($tableName =~ /::XMP::/);
|
|---|
| 101 | # get list of languages defining elements in this table
|
|---|
| 102 | my $isBinary = ($$table{PROCESS_PROC} and
|
|---|
| 103 | $$table{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData);
|
|---|
| 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
|
|---|
| 113 | foreach $tagID (@keys) {
|
|---|
| 114 | my @infoArray = GetTagInfoList($table, $tagID);
|
|---|
| 115 | my $xmlID = Image::ExifTool::XMP::FullEscapeXML($tagID);
|
|---|
| 116 | # get a list of languages defining elements for this ID
|
|---|
| 117 | my ($index, $fam);
|
|---|
| 118 | PTILoop: for ($index=0; $index<@infoArray; ++$index) {
|
|---|
| 119 | my $tagInfo = $infoArray[$index];
|
|---|
| 120 | # don't list subdirectories unless they are writable
|
|---|
| 121 | next unless $$tagInfo{Writable} or not $$tagInfo{SubDirectory};
|
|---|
| 122 | if (@groups) {
|
|---|
| 123 | my @tg = $et->GetGroup($tagInfo);
|
|---|
| 124 | foreach $group (@groups) {
|
|---|
| 125 | next PTILoop unless grep /^$group$/i, @tg;
|
|---|
| 126 | }
|
|---|
| 127 | }
|
|---|
| 128 | unless ($didTag) {
|
|---|
| 129 | my $tname = $$table{SHORT_NAME};
|
|---|
| 130 | print $fp "<table name='${tname}' g0='$$grps{0}' g1='$$grps{1}' g2='$$grps{2}'>\n";
|
|---|
| 131 | unless ($opts{NoDesc}) {
|
|---|
| 132 | # print table description
|
|---|
| 133 | my $desc = $$table{TABLE_DESC};
|
|---|
| 134 | unless ($desc) {
|
|---|
| 135 | ($desc = $tname) =~ s/::Main$//;
|
|---|
| 136 | $desc =~ s/::/ /g;
|
|---|
| 137 | }
|
|---|
| 138 | # print alternate language descriptions
|
|---|
| 139 | print $fp " <desc lang='en'>$desc</desc>\n";
|
|---|
| 140 | foreach (@langs) {
|
|---|
| 141 | $desc = $langInfo{$_}{$tableName} or next;
|
|---|
| 142 | $desc = Image::ExifTool::XMP::EscapeXML($desc);
|
|---|
| 143 | print $fp " <desc lang='${_}'>$desc</desc>\n";
|
|---|
| 144 | }
|
|---|
| 145 | }
|
|---|
| 146 | $didTag = 1;
|
|---|
| 147 | }
|
|---|
| 148 | my $name = $$tagInfo{Name};
|
|---|
| 149 | my $ind = @infoArray > 1 ? " index='${index}'" : '';
|
|---|
| 150 | my $format = $$tagInfo{Writable} || $$table{WRITABLE};
|
|---|
| 151 | my $writable = $format ? 'true' : 'false';
|
|---|
| 152 | # check our conversions to make sure we can really write this tag
|
|---|
| 153 | if ($writable eq 'true') {
|
|---|
| 154 | foreach ('PrintConv','ValueConv') {
|
|---|
| 155 | next unless $$tagInfo{$_};
|
|---|
| 156 | next if $$tagInfo{$_ . 'Inv'};
|
|---|
| 157 | next if ref($$tagInfo{$_}) =~ /^(HASH|ARRAY)$/;
|
|---|
| 158 | next if $$tagInfo{WriteAlso};
|
|---|
| 159 | $writable = 'false';
|
|---|
| 160 | last;
|
|---|
| 161 | }
|
|---|
| 162 | }
|
|---|
| 163 | $format = $$tagInfo{Format} || $$table{FORMAT} if not defined $format or $format eq '1';
|
|---|
| 164 | $format = 'struct' if $$tagInfo{Struct};
|
|---|
| 165 | if (defined $format) {
|
|---|
| 166 | $format =~ s/\[.*\$.*\]//; # remove expressions from format
|
|---|
| 167 | } elsif ($isBinary) {
|
|---|
| 168 | $format = 'int8u';
|
|---|
| 169 | } else {
|
|---|
| 170 | $format = '?';
|
|---|
| 171 | }
|
|---|
| 172 | my $count = '';
|
|---|
| 173 | if ($format =~ s/\[.*?(\d*)\]$//) {
|
|---|
| 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);
|
|---|
| 179 | my $writeGroup = $$tagInfo{WriteGroup} || $$table{WRITE_GROUP};
|
|---|
| 180 | if ($writeGroup and $writeGroup ne 'Comment') {
|
|---|
| 181 | $groups[1] = $writeGroup; # use common write group for group 1
|
|---|
| 182 | }
|
|---|
| 183 | # add group names if different from table defaults
|
|---|
| 184 | my $grp = '';
|
|---|
| 185 | for ($fam=0; $fam<3; ++$fam) {
|
|---|
| 186 | $grp .= " g$fam='$groups[$fam]'" if $groups[$fam] ne $$grps{$fam};
|
|---|
| 187 | }
|
|---|
| 188 | # add flags if necessary
|
|---|
| 189 | if ($opts{Flags}) {
|
|---|
| 190 | my @flags;
|
|---|
| 191 | foreach (qw(Avoid Binary List Mandatory Unknown)) {
|
|---|
| 192 | push @flags, $_ if $$tagInfo{$_};
|
|---|
| 193 | }
|
|---|
| 194 | push @flags, $$tagInfo{List} if $$tagInfo{List} and $$tagInfo{List} =~ /^(Alt|Bag|Seq)$/;
|
|---|
| 195 | push @flags, 'Flattened' if defined $$tagInfo{Flat};
|
|---|
| 196 | push @flags, 'Unsafe' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x01;
|
|---|
| 197 | push @flags, 'Protected' if $$tagInfo{Protected} and $$tagInfo{Protected} & 0x02;
|
|---|
| 198 | push @flags, 'Permanent' if $$tagInfo{Permanent} or
|
|---|
| 199 | ($groups[0] eq 'MakerNotes' and not defined $$tagInfo{Permanent});
|
|---|
| 200 | $grp = " flags='" . join(',', sort @flags) . "'$grp" if @flags;
|
|---|
| 201 | }
|
|---|
| 202 | print $fp " <tag id='${xmlID}' name='${name}'$ind type='${format}'$count writable='${writable}'$grp";
|
|---|
| 203 | if ($opts{NoDesc}) {
|
|---|
| 204 | # short output format
|
|---|
| 205 | print $fp "/>\n"; # empty tag element
|
|---|
| 206 | next; # no descriptions or values
|
|---|
| 207 | } else {
|
|---|
| 208 | print $fp ">";
|
|---|
| 209 | }
|
|---|
| 210 | my $desc = $$tagInfo{Description};
|
|---|
| 211 | $desc = Image::ExifTool::MakeDescription($name) unless defined $desc;
|
|---|
| 212 | # add alternate language descriptions and get references
|
|---|
| 213 | # to alternate language PrintConv hashes
|
|---|
| 214 | my $altDescr = '';
|
|---|
| 215 | my %langConv;
|
|---|
| 216 | foreach (@langs) {
|
|---|
| 217 | my $ld = $langInfo{$_}{$name} or next;
|
|---|
| 218 | if (ref $ld) {
|
|---|
| 219 | $langConv{$_} = $$ld{PrintConv};
|
|---|
| 220 | $ld = $$ld{Description} or next;
|
|---|
| 221 | }
|
|---|
| 222 | # ignore descriptions that are the same as the default language
|
|---|
| 223 | next if $ld eq $desc;
|
|---|
| 224 | $ld = Image::ExifTool::XMP::EscapeXML($ld);
|
|---|
| 225 | $altDescr .= "\n <desc lang='${_}'>$ld</desc>";
|
|---|
| 226 | }
|
|---|
| 227 | # print tag descriptions
|
|---|
| 228 | $desc = Image::ExifTool::XMP::EscapeXML($desc);
|
|---|
| 229 | unless ($opts{Lang} and $altDescr) {
|
|---|
| 230 | print $fp "\n <desc lang='${defaultLang}'>$desc</desc>";
|
|---|
| 231 | }
|
|---|
| 232 | print $fp "$altDescr\n";
|
|---|
| 233 | for (my $i=0; ; ++$i) {
|
|---|
| 234 | my $conv = $$tagInfo{PrintConv};
|
|---|
| 235 | my $idx = '';
|
|---|
| 236 | if (ref $conv eq 'ARRAY') {
|
|---|
| 237 | last unless $i < @$conv;
|
|---|
| 238 | $conv = $$conv[$i];
|
|---|
| 239 | $idx = " index='${i}'";
|
|---|
| 240 | } else {
|
|---|
| 241 | last if $i;
|
|---|
| 242 | }
|
|---|
| 243 | next unless ref $conv eq 'HASH';
|
|---|
| 244 | # make a list of available alternate languages
|
|---|
| 245 | my @langConv = sort keys %langConv;
|
|---|
| 246 | print $fp " <values$idx>\n";
|
|---|
| 247 | my $key;
|
|---|
| 248 | $caseInsensitive = 0;
|
|---|
| 249 | # add bitmask values to main lookup
|
|---|
| 250 | if ($$conv{BITMASK}) {
|
|---|
| 251 | foreach $key (keys %{$$conv{BITMASK}}) {
|
|---|
| 252 | my $mask = 0x01 << $key;
|
|---|
| 253 | next if not $mask or $$conv{$mask};
|
|---|
| 254 | $$conv{$mask} = $$conv{BITMASK}{$key};
|
|---|
| 255 | }
|
|---|
| 256 | }
|
|---|
| 257 | foreach $key (sort NumbersFirst keys %$conv) {
|
|---|
| 258 | next if $key eq 'BITMASK' or $key eq 'OTHER' or $key eq 'Notes';
|
|---|
| 259 | my $val = $$conv{$key};
|
|---|
| 260 | my $xmlVal = Image::ExifTool::XMP::EscapeXML($val);
|
|---|
| 261 | my $xmlKey = Image::ExifTool::XMP::FullEscapeXML($key);
|
|---|
| 262 | print $fp " <key id='${xmlKey}'>\n";
|
|---|
| 263 | # add alternate language values
|
|---|
| 264 | my $altConv = '';
|
|---|
| 265 | foreach (@langConv) {
|
|---|
| 266 | my $lv = $langConv{$_};
|
|---|
| 267 | # handle indexed PrintConv entries
|
|---|
| 268 | $lv = $$lv[$i] or next if ref $lv eq 'ARRAY';
|
|---|
| 269 | $lv = $$lv{$val};
|
|---|
| 270 | # ignore values that are missing or same as default
|
|---|
| 271 | next unless defined $lv and $lv ne $val;
|
|---|
| 272 | $lv = Image::ExifTool::XMP::EscapeXML($lv);
|
|---|
| 273 | $altConv .= " <val lang='${_}'>$lv</val>\n";
|
|---|
| 274 | }
|
|---|
| 275 | unless ($opts{Lang} and $altConv) {
|
|---|
| 276 | print $fp " <val lang='${defaultLang}'>$xmlVal</val>\n"
|
|---|
| 277 | }
|
|---|
| 278 | print $fp "$altConv </key>\n";
|
|---|
| 279 | }
|
|---|
| 280 | print $fp " </values>\n";
|
|---|
| 281 | }
|
|---|
| 282 | print $fp " </tag>\n";
|
|---|
| 283 | }
|
|---|
| 284 | }
|
|---|
| 285 | print $fp "</table>\n\n" if $didTag;
|
|---|
| 286 | }
|
|---|
| 287 | my $success = 1;
|
|---|
| 288 | print $fp "</taginfo>\n" or $success = 0;
|
|---|
| 289 | close $fp or $success = 0 if defined $file;
|
|---|
| 290 | return $success;
|
|---|
| 291 | }
|
|---|
| 292 |
|
|---|
| 293 | #------------------------------------------------------------------------------
|
|---|
| 294 | # Escape backslash and quote in string
|
|---|
| 295 | # Inputs: string
|
|---|
| 296 | # Returns: escaped string
|
|---|
| 297 | sub EscapePerl
|
|---|
| 298 | {
|
|---|
| 299 | my $str = shift;
|
|---|
| 300 | $str =~ s/\\/\\\\/g;
|
|---|
| 301 | $str =~ s/'/\\'/g;
|
|---|
| 302 | return $str;
|
|---|
| 303 | }
|
|---|
| 304 |
|
|---|
| 305 | #------------------------------------------------------------------------------
|
|---|
| 306 | # Generate Lang modules from input tag info XML database
|
|---|
| 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
|
|---|
| 312 | # Returns: Count of updated Lang modules, or -1 on error
|
|---|
| 313 | # Notes: Must be run from the directory containing 'lib'
|
|---|
| 314 | sub BuildLangModules($;$)
|
|---|
| 315 | {
|
|---|
| 316 | local ($_, *XFILE);
|
|---|
| 317 | my ($file, $updateFlag) = @_;
|
|---|
| 318 | my ($table, $tableName, $id, $index, $valIndex, $name, $key, $lang, $defDesc);
|
|---|
| 319 | my (%langInfo, %different, %changed, $overrideDifferent);
|
|---|
| 320 |
|
|---|
| 321 | 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 | }
|
|---|
| 328 | LoadLangModules(\%langInfo); # load all existing Lang modules
|
|---|
| 329 | $updateFlag = 0 unless $updateFlag;
|
|---|
| 330 | %langInfo = () if $updateFlag & 0x04;
|
|---|
| 331 | $overrideDifferent = 1 if $updateFlag & 0x08;
|
|---|
| 332 |
|
|---|
| 333 | if (defined $file) {
|
|---|
| 334 | open XFILE, $file or return -1;
|
|---|
| 335 | while (<XFILE>) {
|
|---|
| 336 | next unless /^\s*<(\/?)(\w+)/;
|
|---|
| 337 | my $tok = $2;
|
|---|
| 338 | if ($1) {
|
|---|
| 339 | # close appropriate entities
|
|---|
| 340 | if ($tok eq 'tag') {
|
|---|
| 341 | undef $id;
|
|---|
| 342 | undef $index;
|
|---|
| 343 | undef $name;
|
|---|
| 344 | undef $defDesc;
|
|---|
| 345 | } elsif ($tok eq 'values') {
|
|---|
| 346 | undef $key;
|
|---|
| 347 | undef $valIndex;
|
|---|
| 348 | } elsif ($tok eq 'table') {
|
|---|
| 349 | undef $table;
|
|---|
| 350 | undef $id;
|
|---|
| 351 | }
|
|---|
| 352 | next;
|
|---|
| 353 | }
|
|---|
| 354 | if ($tok eq 'table') {
|
|---|
| 355 | /^\s*<table name='([^']+)'[ >]/ or warn('Bad table'), next;
|
|---|
| 356 | $tableName = "Image::ExifTool::$1";
|
|---|
| 357 | # ignore userdefined tables
|
|---|
| 358 | next if $tableName =~ /^Image::ExifTool::UserDefined/;
|
|---|
| 359 | $table = Image::ExifTool::GetTagTable($tableName);
|
|---|
| 360 | $table or warn("Unknown tag table $tableName\n");
|
|---|
| 361 | next;
|
|---|
| 362 | }
|
|---|
| 363 | next unless defined $table;
|
|---|
| 364 | if ($tok eq 'tag') {
|
|---|
| 365 | /^\s*<tag id='([^']*)' name='([^']+)'( index='(\d+)')?[ >]/ or warn('Bad tag'), next;
|
|---|
| 366 | $id = Image::ExifTool::XMP::FullUnescapeXML($1);
|
|---|
| 367 | $name = $2;
|
|---|
| 368 | $index = $4;
|
|---|
| 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 | }
|
|---|
| 375 | next;
|
|---|
| 376 | }
|
|---|
| 377 | if ($tok eq 'values') {
|
|---|
| 378 | /^\s*<values index='([^']*)'>/ or next;
|
|---|
| 379 | $valIndex = $1;
|
|---|
| 380 | } elsif ($tok eq 'key') {
|
|---|
| 381 | defined $id or warn('No ID'), next;
|
|---|
| 382 | /^\s*<key id='([^']*)'>/ or warn('Bad key'), next;
|
|---|
| 383 | $key = Image::ExifTool::XMP::FullUnescapeXML($1);
|
|---|
| 384 | $key = hex($key) if $key =~ /^0x[\da-fA-F]+$/; # convert hex keys
|
|---|
| 385 | } elsif ($tok eq 'val' or $tok eq 'desc') {
|
|---|
| 386 | /^\s*<$tok( lang='([-\w]+?)')?>(.*)<\/$tok>/ or warn("Bad $tok"), next;
|
|---|
| 387 | $tok eq 'desc' and defined $key and warn('Out of order "desc"'), next;
|
|---|
| 388 | my $lang = $2 or next; # looking only for alternate languages
|
|---|
| 389 | $lang =~ tr/-A-Z/_a-z/;
|
|---|
| 390 | # use standard ISO 639-1 language codes
|
|---|
| 391 | $lang = $translateLang{$lang} if $translateLang{$lang};
|
|---|
| 392 | my $tval = Image::ExifTool::XMP::UnescapeXML($3);
|
|---|
| 393 | my $val = ucfirst $tval;
|
|---|
| 394 | $val = $tval if $tval =~ /^(cRAW|iTun)/; # special-case non-capitalized values
|
|---|
| 395 | my $cap = ($tval ne $val);
|
|---|
| 396 | if ($makeMissing and $lang eq 'en') {
|
|---|
| 397 | $lang = $makeMissing;
|
|---|
| 398 | $val = 'MISSING';
|
|---|
| 399 | undef $cap;
|
|---|
| 400 | }
|
|---|
| 401 | my $isDefault = ($lang eq $Image::ExifTool::defaultLang);
|
|---|
| 402 | unless ($langInfo{$lang} or $isDefault) {
|
|---|
| 403 | print "Creating new language $lang\n";
|
|---|
| 404 | $langInfo{$lang} = { };
|
|---|
| 405 | }
|
|---|
| 406 | defined $name or $name = '<unknown>';
|
|---|
| 407 | unless (defined $id) {
|
|---|
| 408 | next if $isDefault;
|
|---|
| 409 | # this is a table description
|
|---|
| 410 | next if $langInfo{$lang}{$tableName} and
|
|---|
| 411 | $langInfo{$lang}{$tableName} eq $val;
|
|---|
| 412 | $langInfo{$lang}{$tableName} = $val;
|
|---|
| 413 | $changed{$lang} = 1;
|
|---|
| 414 | warn("Capitalized '${lang}' val for $name: $val\n") if $cap;
|
|---|
| 415 | next;
|
|---|
| 416 | }
|
|---|
| 417 | my @infoArray = GetTagInfoList($table, $id);
|
|---|
| 418 |
|
|---|
| 419 | # this will fail for UserDefined tags and tags without ID's
|
|---|
| 420 | @infoArray or warn("Error loading tag for $tableName ID='${id}'\n"), next;
|
|---|
| 421 | my ($tagInfo, $langInfo);
|
|---|
| 422 | if (defined $index) {
|
|---|
| 423 | $tagInfo = $infoArray[$index];
|
|---|
| 424 | $tagInfo or warn('Invalid index'), next;
|
|---|
| 425 | } else {
|
|---|
| 426 | @infoArray > 1 and warn('Missing index'), next;
|
|---|
| 427 | $tagInfo = $infoArray[0];
|
|---|
| 428 | }
|
|---|
| 429 | my $tagName = $$tagInfo{Name};
|
|---|
| 430 | if ($isDefault) {
|
|---|
| 431 | unless ($$tagInfo{Description}) {
|
|---|
| 432 | $$tagInfo{Description} = Image::ExifTool::MakeDescription($tagName);
|
|---|
| 433 | }
|
|---|
| 434 | $defDesc = $$tagInfo{Description};
|
|---|
| 435 | $langInfo = $tagInfo;
|
|---|
| 436 | } else {
|
|---|
| 437 | $langInfo = $langInfo{$lang}{$tagName};
|
|---|
| 438 | if (not defined $langInfo) {
|
|---|
| 439 | $langInfo = $langInfo{$lang}{$tagName} = { };
|
|---|
| 440 | } elsif (not ref $langInfo) {
|
|---|
| 441 | $langInfo = $langInfo{$lang}{$tagName} = { Description => $langInfo };
|
|---|
| 442 | }
|
|---|
| 443 | }
|
|---|
| 444 | # save new value in langInfo record
|
|---|
| 445 | if ($tok eq 'desc') {
|
|---|
| 446 | my $oldVal = $$langInfo{Description};
|
|---|
| 447 | next if defined $oldVal and $oldVal eq $val;
|
|---|
| 448 | if ($makeMissing) {
|
|---|
| 449 | next if defined $oldVal and $val eq 'MISSING';
|
|---|
| 450 | } elsif (defined $oldVal) {
|
|---|
| 451 | my $t = "$lang $tagName";
|
|---|
| 452 | unless (defined $different{$t} and $different{$t} eq $val) {
|
|---|
| 453 | my $a = defined $different{$t} ? 'ANOTHER ' : '';
|
|---|
| 454 | warn "${a}Different '${lang}' desc for $tagName: $val (was $$langInfo{Description})\n";
|
|---|
| 455 | next if defined $different{$t}; # don't change back again
|
|---|
| 456 | $different{$t} = $val;
|
|---|
| 457 | }
|
|---|
| 458 | next unless $overrideDifferent;
|
|---|
| 459 | }
|
|---|
| 460 | next if $isDefault;
|
|---|
| 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 | }
|
|---|
| 466 | } else {
|
|---|
| 467 | defined $key or warn("No key for $$tagInfo{Name}"), next;
|
|---|
| 468 | my $printConv = $$tagInfo{PrintConv};
|
|---|
| 469 | if (ref $printConv eq 'ARRAY') {
|
|---|
| 470 | defined $valIndex or warn('No value index'), next;
|
|---|
| 471 | $printConv = $$printConv[$valIndex];
|
|---|
| 472 | }
|
|---|
| 473 | ref $printConv eq 'HASH' or warn('No PrintConv'), next;
|
|---|
| 474 | my $convVal = $$printConv{$key};
|
|---|
| 475 | unless (defined $convVal) {
|
|---|
| 476 | if ($$printConv{BITMASK} and $key =~ /^\d+$/) {
|
|---|
| 477 | my $i;
|
|---|
| 478 | for ($i=0; $i<64; ++$i) {
|
|---|
| 479 | my $mask = (0x01 << $i) or last;
|
|---|
| 480 | next unless $key == $mask;
|
|---|
| 481 | $convVal = $$printConv{BITMASK}{$i};
|
|---|
| 482 | }
|
|---|
| 483 | }
|
|---|
| 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;
|
|---|
| 489 | }
|
|---|
| 490 | my $lc = $$langInfo{PrintConv};
|
|---|
| 491 | $lc or $lc = $$langInfo{PrintConv} = { };
|
|---|
| 492 | $lc = $printConv if ref $lc eq 'ARRAY'; #(default lang only)
|
|---|
| 493 | my $oldVal = $$lc{$convVal};
|
|---|
| 494 | next if defined $oldVal and $oldVal eq $val;
|
|---|
| 495 | if ($makeMissing) {
|
|---|
| 496 | next if defined $oldVal and $val eq 'MISSING';
|
|---|
| 497 | } elsif (defined $oldVal and (not $isDefault or not $val=~/^\d+$/)) {
|
|---|
| 498 | my $t = "$lang $tagName $convVal";
|
|---|
| 499 | unless (defined $different{$t} and $different{$t} eq $val) {
|
|---|
| 500 | my $a = defined $different{$t} ? 'ANOTHER ' : '';
|
|---|
| 501 | warn "${a}Different '${lang}' val for $tagName '${convVal}': $val (was $oldVal)\n";
|
|---|
| 502 | next if defined $different{$t}; # don't change back again
|
|---|
| 503 | $different{$t} = $val;
|
|---|
| 504 | }
|
|---|
| 505 | next unless $overrideDifferent;
|
|---|
| 506 | }
|
|---|
| 507 | next if $isDefault;
|
|---|
| 508 | warn("Capitalized '${lang}' val for $tagName: $tval\n") if $cap;
|
|---|
| 509 | $$lc{$convVal} = $val;
|
|---|
| 510 | }
|
|---|
| 511 | $changed{$lang} = 1;
|
|---|
| 512 | }
|
|---|
| 513 | }
|
|---|
| 514 | close XFILE;
|
|---|
| 515 | }
|
|---|
| 516 | # rewrite all changed Lang modules
|
|---|
| 517 | my $rtnVal = 0;
|
|---|
| 518 | foreach $lang ($updateFlag & 0x02 ? @Image::ExifTool::langs : sort keys %changed) {
|
|---|
| 519 | next if $lang eq $Image::ExifTool::defaultLang;
|
|---|
| 520 | ++$rtnVal;
|
|---|
| 521 | # write this module (only increment version number if not forced)
|
|---|
| 522 | WriteLangModule($lang, $langInfo{$lang}, not $updateFlag & 0x01) or $rtnVal = -1, last;
|
|---|
| 523 | }
|
|---|
| 524 | return $rtnVal;
|
|---|
| 525 | }
|
|---|
| 526 |
|
|---|
| 527 | #------------------------------------------------------------------------------
|
|---|
| 528 | # Write Lang module
|
|---|
| 529 | # Inputs: 0) language string, 1) langInfo lookup reference, 2) flag to increment version
|
|---|
| 530 | # Returns: true on success
|
|---|
| 531 | sub WriteLangModule($$;$)
|
|---|
| 532 | {
|
|---|
| 533 | local ($_, *XOUT);
|
|---|
| 534 | my ($lang, $langTags, $newVersion) = @_;
|
|---|
| 535 | my $err;
|
|---|
| 536 | -e "lib/Image/ExifTool" or die "Must run from directory containing 'lib'\n";
|
|---|
| 537 | my $out = "lib/Image/ExifTool/Lang/$lang.pm";
|
|---|
| 538 | my $tmp = "$out.tmp";
|
|---|
| 539 | open XOUT, ">$tmp" or die "Error creating $tmp\n";
|
|---|
| 540 | my $ver = "Image::ExifTool::Lang::${lang}::VERSION";
|
|---|
| 541 | no strict 'refs';
|
|---|
| 542 | if ($$ver) {
|
|---|
| 543 | $ver = $$ver;
|
|---|
| 544 | $ver = int($ver * 100 + 1.5) / 100 if $newVersion;
|
|---|
| 545 | } else {
|
|---|
| 546 | $ver = 1.0;
|
|---|
| 547 | }
|
|---|
| 548 | $ver = sprintf('%.2f', $ver);
|
|---|
| 549 | use strict 'refs';
|
|---|
| 550 | my $langName = $Image::ExifTool::langName{$lang} || $lang;
|
|---|
| 551 | $langName =~ s/\s*\(.*//;
|
|---|
| 552 | print XOUT <<HEADER;
|
|---|
| 553 | #------------------------------------------------------------------------------
|
|---|
| 554 | # File: $lang.pm
|
|---|
| 555 | #
|
|---|
| 556 | # Description: ExifTool $langName language translations
|
|---|
| 557 | #
|
|---|
| 558 | # Notes: This file generated automatically by Image::ExifTool::TagInfoXML
|
|---|
| 559 | #------------------------------------------------------------------------------
|
|---|
| 560 |
|
|---|
| 561 | package Image::ExifTool::Lang::$lang;
|
|---|
| 562 |
|
|---|
| 563 | use strict;
|
|---|
| 564 | use vars qw(\$VERSION);
|
|---|
| 565 |
|
|---|
| 566 | \$VERSION = '${ver}';
|
|---|
| 567 |
|
|---|
| 568 | HEADER
|
|---|
| 569 | print XOUT "\%Image::ExifTool::Lang::${lang}::Translate = (\n";
|
|---|
| 570 | # loop through all tag and table names
|
|---|
| 571 | my $tag;
|
|---|
| 572 | foreach $tag (sort keys %$langTags) {
|
|---|
| 573 | my $desc = $$langTags{$tag};
|
|---|
| 574 | my $conv;
|
|---|
| 575 | if (ref $desc) {
|
|---|
| 576 | $conv = $$desc{PrintConv};
|
|---|
| 577 | $desc = $$desc{Description};
|
|---|
| 578 | # remove description if not necessary
|
|---|
| 579 | # (not strictly correct -- should test against tag description, not name)
|
|---|
| 580 | undef $desc if $desc and $desc eq $tag;
|
|---|
| 581 | # remove unnecessary value translations
|
|---|
| 582 | if ($conv) {
|
|---|
| 583 | my @keys = keys %$conv;
|
|---|
| 584 | foreach (@keys) {
|
|---|
| 585 | delete $$conv{$_} if $_ eq $$conv{$_};
|
|---|
| 586 | }
|
|---|
| 587 | undef $conv unless %$conv;
|
|---|
| 588 | }
|
|---|
| 589 | }
|
|---|
| 590 | if (defined $desc) {
|
|---|
| 591 | $desc = EscapePerl($desc);
|
|---|
| 592 | } else {
|
|---|
| 593 | next unless $conv;
|
|---|
| 594 | }
|
|---|
| 595 | print XOUT " '${tag}' => ";
|
|---|
| 596 | unless ($conv) {
|
|---|
| 597 | print XOUT "'${desc}',\n";
|
|---|
| 598 | next;
|
|---|
| 599 | }
|
|---|
| 600 | print XOUT "{\n";
|
|---|
| 601 | print XOUT " Description => '${desc}',\n" if defined $desc;
|
|---|
| 602 | if ($conv) {
|
|---|
| 603 | print XOUT " PrintConv => {\n";
|
|---|
| 604 | foreach (sort keys %$conv) {
|
|---|
| 605 | my $str = EscapePerl($_);
|
|---|
| 606 | my $val = EscapePerl($$conv{$_});
|
|---|
| 607 | print XOUT " '${str}' => '${val}',\n";
|
|---|
| 608 | }
|
|---|
| 609 | print XOUT " },\n";
|
|---|
| 610 | }
|
|---|
| 611 | print XOUT " },\n";
|
|---|
| 612 | }
|
|---|
| 613 | # generate acknowledgements for this language
|
|---|
| 614 | my $ack;
|
|---|
| 615 | if ($credits{$lang}) {
|
|---|
| 616 | $ack = "Thanks to $credits{$lang} for providing this translation.";
|
|---|
| 617 | $ack =~ s/(.{1,76})( +|$)/$1\n/sg; # wrap text to 76 columns
|
|---|
| 618 | $ack = "~head1 ACKNOWLEDGEMENTS\n\n$ack\n";
|
|---|
| 619 | } else {
|
|---|
| 620 | $ack = '';
|
|---|
| 621 | }
|
|---|
| 622 | my $footer = <<FOOTER;
|
|---|
| 623 | );
|
|---|
| 624 |
|
|---|
| 625 | 1; # end
|
|---|
| 626 |
|
|---|
| 627 | __END__
|
|---|
| 628 |
|
|---|
| 629 | ~head1 NAME
|
|---|
| 630 |
|
|---|
| 631 | Image::ExifTool::Lang::$lang.pm - ExifTool $langName language translations
|
|---|
| 632 |
|
|---|
| 633 | ~head1 DESCRIPTION
|
|---|
| 634 |
|
|---|
| 635 | This file is used by Image::ExifTool to generate localized tag descriptions
|
|---|
| 636 | and values.
|
|---|
| 637 |
|
|---|
| 638 | ~head1 AUTHOR
|
|---|
| 639 |
|
|---|
| 640 | Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
|
|---|
| 641 |
|
|---|
| 642 | This library is free software; you can redistribute it and/or modify it
|
|---|
| 643 | under the same terms as Perl itself.
|
|---|
| 644 |
|
|---|
| 645 | $ack~head1 SEE ALSO
|
|---|
| 646 |
|
|---|
| 647 | L<Image::ExifTool(3pm)|Image::ExifTool>,
|
|---|
| 648 | L<Image::ExifTool::TagInfoXML(3pm)|Image::ExifTool::TagInfoXML>
|
|---|
| 649 |
|
|---|
| 650 | ~cut
|
|---|
| 651 | FOOTER
|
|---|
| 652 | $footer =~ s/^~/=/mg; # un-do pod obfuscation
|
|---|
| 653 | print XOUT $footer or $err = 1;
|
|---|
| 654 | close XOUT or $err = 1;
|
|---|
| 655 | if ($err or not rename($tmp, $out)) {
|
|---|
| 656 | warn "Error writing $out\n";
|
|---|
| 657 | unlink $tmp;
|
|---|
| 658 | $err = 1;
|
|---|
| 659 | }
|
|---|
| 660 | return $err ? 0 : 1;
|
|---|
| 661 | }
|
|---|
| 662 |
|
|---|
| 663 | #------------------------------------------------------------------------------
|
|---|
| 664 | # load all lang modules into hash
|
|---|
| 665 | # Inputs: 0) Hash reference, 1) specific language to load (undef for all)
|
|---|
| 666 | sub LoadLangModules($;$)
|
|---|
| 667 | {
|
|---|
| 668 | my ($langHash, $lang) = @_;
|
|---|
| 669 | require Image::ExifTool;
|
|---|
| 670 | my @langs = $lang ? ($lang) : @Image::ExifTool::langs;
|
|---|
| 671 | foreach $lang (@langs) {
|
|---|
| 672 | next if $lang eq $Image::ExifTool::defaultLang;
|
|---|
| 673 | eval "require Image::ExifTool::Lang::$lang" or warn("Can't load Lang::$lang\n"), next;
|
|---|
| 674 | my $xlat = "Image::ExifTool::Lang::${lang}::Translate";
|
|---|
| 675 | no strict 'refs';
|
|---|
| 676 | %$xlat or warn("Missing Info for $lang\n"), next;
|
|---|
| 677 | $$langHash{$lang} = \%$xlat;
|
|---|
| 678 | use strict 'refs';
|
|---|
| 679 | }
|
|---|
| 680 | }
|
|---|
| 681 |
|
|---|
| 682 | #------------------------------------------------------------------------------
|
|---|
| 683 | # sort numbers first numerically, then strings alphabetically (case insensitive)
|
|---|
| 684 | sub NumbersFirst
|
|---|
| 685 | {
|
|---|
| 686 | my $rtnVal;
|
|---|
| 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;
|
|---|
| 708 | } else {
|
|---|
| 709 | my ($a2, $b2) = ($a, $b);
|
|---|
| 710 | # expand numbers to 3 digits (with restrictions to avoid messing up ascii-hex tags)
|
|---|
| 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;
|
|---|
| 713 | $caseInsensitive and $rtnVal = (lc($a2) cmp lc($b2));
|
|---|
| 714 | $rtnVal or $rtnVal = ($a2 cmp $b2);
|
|---|
| 715 | }
|
|---|
| 716 | return $rtnVal;
|
|---|
| 717 | }
|
|---|
| 718 |
|
|---|
| 719 | 1; # end
|
|---|
| 720 |
|
|---|
| 721 |
|
|---|
| 722 | __END__
|
|---|
| 723 |
|
|---|
| 724 | =head1 NAME
|
|---|
| 725 |
|
|---|
| 726 | Image::ExifTool::TagInfoXML - Read/write tag information XML database
|
|---|
| 727 |
|
|---|
| 728 | =head1 DESCRIPTION
|
|---|
| 729 |
|
|---|
| 730 | This module is used to generate an XML database from all ExifTool tag
|
|---|
| 731 | information. The XML database may then be edited and used to re-generate
|
|---|
| 732 | the language modules (Image::ExifTool::Lang::*).
|
|---|
| 733 |
|
|---|
| 734 | =head1 METHODS
|
|---|
| 735 |
|
|---|
| 736 | =head2 Write
|
|---|
| 737 |
|
|---|
| 738 | Print complete tag information database in XML format.
|
|---|
| 739 |
|
|---|
| 740 | # save list of all tags
|
|---|
| 741 | $success = Image::ExifTool::TagInfoXML::Write('dst.xml');
|
|---|
| 742 |
|
|---|
| 743 | # list all IPTC tags to console, including Flags
|
|---|
| 744 | Image::ExifTool::TagInfoXML::Write(undef, 'IPTC', Flags => 1);
|
|---|
| 745 |
|
|---|
| 746 | # write all EXIF Camera tags to file
|
|---|
| 747 | Image::ExifTool::TagInfoXML::Write($outfile, 'exif:camera');
|
|---|
| 748 |
|
|---|
| 749 | =over 4
|
|---|
| 750 |
|
|---|
| 751 | =item Inputs:
|
|---|
| 752 |
|
|---|
| 753 | 0) [optional] Output file name, or undef for console output. Output file
|
|---|
| 754 | will be overwritten if it already exists.
|
|---|
| 755 |
|
|---|
| 756 | 1) [optional] String of group names separated by colons to specify the group
|
|---|
| 757 | to print. A specific IFD may not be given as a group, since EXIF tags may
|
|---|
| 758 | be written to any IFD. Saves all groups if not specified.
|
|---|
| 759 |
|
|---|
| 760 | 2) [optional] Hash of options values:
|
|---|
| 761 |
|
|---|
| 762 | Flags - Set to output 'flags' attribute
|
|---|
| 763 | NoDesc - Set to suppress output of descriptions
|
|---|
| 764 | Lang - Select a single language for output
|
|---|
| 765 |
|
|---|
| 766 | =item Return Value:
|
|---|
| 767 |
|
|---|
| 768 | True on success.
|
|---|
| 769 |
|
|---|
| 770 | =item Sample XML Output:
|
|---|
| 771 |
|
|---|
| 772 | =back
|
|---|
| 773 |
|
|---|
| 774 | <?xml version='1.0' encoding='UTF-8'?>
|
|---|
| 775 | <taginfo>
|
|---|
| 776 |
|
|---|
| 777 | <table name='XMP::dc' g0='XMP' g1='XMP-dc' g2='Other'>
|
|---|
| 778 | <desc lang='en'>XMP Dublin Core</desc>
|
|---|
| 779 | <tag id='title' name='Title' type='lang-alt' writable='true' g2='Image'>
|
|---|
| 780 | <desc lang='en'>Title</desc>
|
|---|
| 781 | <desc lang='de'>Titel</desc>
|
|---|
| 782 | <desc lang='fr'>Titre</desc>
|
|---|
| 783 | </tag>
|
|---|
| 784 | ...
|
|---|
| 785 | </table>
|
|---|
| 786 |
|
|---|
| 787 | </taginfo>
|
|---|
| 788 |
|
|---|
| 789 | Flags (if selected and available) are formatted as a comma-separated list of
|
|---|
| 790 | the following possible values: Avoid, Binary, List, Mandatory, Permanent,
|
|---|
| 791 | Protected, Unknown and Unsafe. See the
|
|---|
| 792 | L<tag name documentation|Image::ExifTool::TagNames> and
|
|---|
| 793 | lib/Image/ExifTool/README for a description of these flags. For XMP List
|
|---|
| 794 | tags, the list type (Alt, Bag or Seq) is also output as a flag if
|
|---|
| 795 | applicable.
|
|---|
| 796 |
|
|---|
| 797 | =head2 BuildLangModules
|
|---|
| 798 |
|
|---|
| 799 | Build all Image::ExifTool::Lang modules from an XML database file.
|
|---|
| 800 |
|
|---|
| 801 | Image::ExifTool::TagInfoXML::BuildLangModules('src.xml');
|
|---|
| 802 |
|
|---|
| 803 | =over 4
|
|---|
| 804 |
|
|---|
| 805 | =item Inputs:
|
|---|
| 806 |
|
|---|
| 807 | 0) XML file name
|
|---|
| 808 |
|
|---|
| 809 | 1) 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 |
|
|---|
| 816 | =item Return Value:
|
|---|
| 817 |
|
|---|
| 818 | Number of modules updated, or negative on error.
|
|---|
| 819 |
|
|---|
| 820 | =back
|
|---|
| 821 |
|
|---|
| 822 | =head1 AUTHOR
|
|---|
| 823 |
|
|---|
| 824 | Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
|
|---|
| 825 |
|
|---|
| 826 | This library is free software; you can redistribute it and/or modify it
|
|---|
| 827 | under the same terms as Perl itself.
|
|---|
| 828 |
|
|---|
| 829 | =head1 SEE ALSO
|
|---|
| 830 |
|
|---|
| 831 | L<Image::ExifTool(3pm)|Image::ExifTool>,
|
|---|
| 832 | L<Image::ExifTool::TagNames(3pm)|Image::ExifTool::TagNames>
|
|---|
| 833 |
|
|---|
| 834 | =cut
|
|---|
