A modern Music Player Daemon based on Rockbox open source high quality audio player
libadwaita audio rust zig deno mpris rockbox mpd
at master 652 lines 19 kB view raw
1#!/usr/bin/perl -s -w 2# __________ __ ___. 3# Open \______ \ ____ ____ | | _\_ |__ _______ ___ 4# Source | _// _ \_/ ___\| |/ /| __ \ / _ \ \/ / 5# Jukebox | | ( <_> ) \___| < | \_\ ( <_> > < < 6# Firmware |____|_ /\____/ \___ >__|_ \|___ /\____/__/\_ \ 7# \/ \/ \/ \/ \/ 8# 9# Copyright (C) 2020-2024 Solomon Peachy 10# 11 12use utf8; 13use File::Basename; 14use Unicode::Normalize; 15 16use strict; 17 18use open qw( :std :encoding(UTF-8) ); 19binmode(STDOUT, ":encoding(UTF-8)"); 20 21sub trim { 22 my ($string) = @_; 23 $string =~ s/^\s+//; 24 $string =~ s/\s+$//; 25 $string =~ tr/\t//d; 26 return $string; 27} 28 29sub parselangfile { 30 my ($filename) = @_; 31 my %phrases; 32 my @order; 33 my %empty = ( #'phrase' => {}, 34 #'source' => {}, 35 #'dest' => {}, 36 #'voice' => {}, 37 #'targetorder' => {}, 38 'notes' => "", 39 'new' => 0 40 ); 41 my %thisphrase = %empty; 42 my %targetorder; 43 44 open(FH, "<$filename") || die ("Can't open $filename"); 45 my @lines = <FH>; 46 close(FH); 47 48 my $pos = 'lang'; 49 my $id = ''; 50 my @comments; 51 52 foreach my $line (@lines) { 53 $line = trim($line); 54 if($line =~ /^ *###/) { 55 # Filter out warnings from prior runs 56 next; 57 } elsif($line =~ /^ *#/) { 58 push(@comments, "$line\n") if ($pos eq 'lang'); 59 # comments are ignored, but retained! 60 next; 61 } elsif ($pos eq 'phrase' && $line =~ /^([^:]+): ?(.*)$/) { 62 $thisphrase{$pos}->{$1} = $2; 63 if ($1 eq 'id') { 64 push(@order, $2); 65 $id = $2; 66 } 67 } elsif ($pos ne 'phrase' && $line =~ /^([^:]+): ?\"?([^\"]*)\"?$/) { 68 my @targets = split(',', $1); 69 my $w; 70 71 if ($id ne 'VOICE_PAUSE') { 72 $w = trim($2); 73 } else { 74 $w = $2; 75 } 76 77 foreach (@targets) { 78 my $l = trim($_); 79 # Convert some obsolete keys 80 if ($l eq "swcodec") { 81 $l = "*"; 82 } elsif ($l eq "lcd_bitmap") { 83 $l = "*"; 84 } elsif ($l eq "recording_swcodec") { 85 $l = "recording"; 86# } elsif ($id =~ /USB_MODE/ && $l =~ /ibassodx/) { 87# $l = "*"; 88 } 89 90 $w = NFD($w); # Unicode decompose 91 $thisphrase{$pos}->{$l} = $w; 92 93 # Store the ordering of the targets. 94 $targetorder{$l} = scalar(keys(%targetorder)) if (!defined($targetorder{$l})); 95 } 96 } 97 if ($line eq '</voice>' || 98 $line eq '</dest>' || 99 $line eq '</source>' || 100 $line eq '<phrase>') { 101 $pos = 'phrase'; 102 } elsif ($line eq '</phrase>') { 103 my %copy = %thisphrase; 104 my %targetordercopy = %targetorder; 105 $copy{'targetorder'} = \%targetordercopy; 106 $phrases{$id} = \%copy; 107 %thisphrase = %empty; 108 %targetorder = (); 109 $pos = 'lang'; 110 $id = ''; 111 } elsif ($line eq '<source>') { 112 $pos = 'source'; 113 } elsif ($line eq '<dest>') { 114 $pos = 'dest'; 115 } elsif ($line eq '<voice>') { 116 $pos = 'voice'; 117 } 118 } 119 $phrases{'HEADER'} = \@comments; 120 $phrases{'ORDER'} = \@order; 121 return %phrases; 122} 123 124sub combinetgts { 125 my (%tgtmap) = (@_); 126 my %strmap; 127 my %combined; 128 129 # Reverse-map things 130 foreach my $tgt (sort(keys(%tgtmap))) { 131 next if ($tgt eq '*'); # Do not combine anything with fallback 132 if (defined($strmap{$tgtmap{$tgt}})) { 133 $strmap{$tgtmap{$tgt}} .= ",$tgt"; 134 } else { 135 $strmap{$tgtmap{$tgt}} = "$tgt"; 136 } 137 } 138 139 # Copy over default/fallback as it was skipped 140 $combined{'*'} = $tgtmap{'*'}; 141 142 foreach my $str (keys(%strmap)) { 143 $combined{$strmap{$str}} = $str; 144 } 145 146 return %combined; 147} 148 149sub reduceformat($) { 150 my ($in) = @_; 151 my $out = ""; 152 my $infmt = 0; 153 154 for (my $i = 0; $i < length($in) ; $i++) { 155 my $c = substr($in, $i, 1); 156 if (!$infmt && ($c eq '%')) { 157 # First char in a format string! 158 $infmt = 1; 159 next; 160 } 161 next if (!$infmt); 162 163 if ($c ne '%') { 164 # Ignore literal %, otherwise dump specifier over 165 $out .= $c; 166 } 167 168 # Look for a terminating field: 169 my $count = $c =~ tr/sSdDuUxXzZ%//; 170 if ($count) { 171 $infmt = 0; 172 next; 173 } 174 } 175 176 return $out; 177} 178 179################## 180 181if($#ARGV != 2) { 182 print "Usage: [ENGLISHORDER=1] updatelang <english.lang> <otherlang> <outfile|->\n"; 183 exit; 184} 185 186# Parse master file 187my %english = parselangfile($ARGV[0]); 188my @englishorder = @{$english{'ORDER'}}; 189 190# Parse secondary file 191my %lang = parselangfile($ARGV[1]); 192my @langorder = @{$lang{'ORDER'}}; 193my @langheader = @{$lang{'HEADER'}}; 194 195# Clean up 196delete $english{'ORDER'}; 197delete $english{'HEADER'}; 198delete $lang{'ORDER'}; 199delete $lang{'HEADER'}; 200 201# Extract language names 202my @tmp = split(/\./, basename($ARGV[0])); 203my $f1 = $tmp[0]; 204@tmp = split(/\./, basename($ARGV[1])); 205my $f2 = $tmp[0]; 206undef @tmp; 207 208# Read in ignore list 209my $igname = dirname($0) . "/langignorelist.txt"; 210open (FH, "<$igname") || die ("Can't open $igname!"); 211my @ignorelist = <FH>; 212close (FH); 213sub not_ignorelist { 214 my ($key) = @_; 215 foreach (@ignorelist) { 216 chomp; 217 if ($_ eq $key) { 218 return 0; 219 } 220 } 221 return 1; 222} 223undef $igname; 224 225# Do we care about notes? 226my $printnotes = 1; 227my $ignoredups = 0; 228 229if ($f1 eq $f2) { 230 # Ignore all notes for master language 231 $printnotes = 0; 232} 233 234if (index($f2, $f1) > -1) { 235 # Ignore duplicates for sub-languages 236 $ignoredups = 1; 237} 238 239# work out the missing phrases 240my %missing; 241my @missingorder; 242 243foreach (@englishorder) { 244 $missing{$_} = 1; 245} 246foreach (@langorder) { 247 if (!defined($english{$_})) { 248 delete($lang{$_}); 249# print "#!! '$_' no longer needed\n"; 250 next; 251 } 252 delete $missing{$_}; 253} 254foreach (@englishorder) { 255 push(@missingorder, $_) if defined($missing{$_}); 256} 257# And add them to the phrase list. 258foreach (@missingorder) { 259# print "#!! '$_' missing\n"; 260 push(@langorder, $_); 261 if ($_ eq 'VOICE_LANG_NAME') { 262 $lang{$_} = $english{$_}; 263 $lang{$_}{'voice'}{'*'} = ""; 264 $lang{$_}{'notes'} .= "### The phrase '$_' is missing entirely, please fill out\n"; 265 } else { 266 $lang{$_} = $english{$_}; 267 $lang{$_}{'notes'} .= "### The phrase '$_' is missing entirely, copying from english!\n"; 268 } 269 $lang{$_}{'new'} = 1; 270} 271undef @missingorder; 272undef %missing; 273 274# Sanity-check a few things 275foreach my $id (@langorder) { 276 if (!defined($english{$id})) { 277 next; 278 } 279 my %ep = %{$english{$id}{'phrase'}}; 280 my %lp = %{$lang{$id}{'phrase'}}; 281 282 if ($lp{'desc'} ne $ep{'desc'} || $ep{'desc'} eq 'deprecated') { 283 if ($ep{'desc'} eq 'deprecated') { 284 # Nuke all deprecated targets; just copy from English 285# print "#!! '$id' deprecated, deleting\n"; 286 $lang{$id} = $english{$id}; 287 } else { 288 $lang{$id}{'notes'} .= "### The 'desc' field for '$id' differs from English!\n"; 289 $lang{$id}{'notes'} .= "#### the previously used desc is commented below:\n"; 290 $lang{$id}{'notes'} .= "##### desc: $lp{desc}\n"; 291 $lang{$id}{'phrase'}{'desc'} = $english{$id}{'phrase'}{'desc'}; 292 # print "#!! '$id' changed description\n"; 293 } 294 } 295 296 if (!defined($ep{'user'}) || length($ep{'user'}) == 0) { 297 $lp{'user'} = 'core'; 298 } 299 300 if (!defined($lp{'user'}) || $lp{'user'} ne $ep{'user'}) { 301 $lang{$id}{'notes'} .= "### The 'user' field for '$id' differs from English!\n"; 302 $lang{$id}{'notes'} .= "#### the previously used desc is commented below:\n"; 303 $lang{$id}{'notes'} .= "##### desc: $lp{user}\n"; 304 if (!defined($lp{'user'}) || length($lp{'user'}) == 0) { 305 $lp{'user'} = $ep{'user'}; 306 } 307 $lang{$id}{'phrase'}{'user'} = $english{$id}{'phrase'}{'user'}; 308# print "#!! '$id' changed user\n"; 309 } 310} 311 312# Check sources 313foreach my $id (@langorder) { 314 if (!defined($english{$id})) { 315 next; 316 } 317 my %ep = %{$english{$id}{'source'}}; 318 my %lp; 319 320 if (defined($lang{$id}{'source'})) { 321 %lp = %{$lang{$id}{'source'}}; 322 } else { 323 %lp = (); 324 } 325 326 foreach my $tgt (keys(%lp)) { 327 if (!defined($ep{$tgt})) { 328 # Delete any targets that have been nuked in master 329 delete($lang{$id}{'source'}{$tgt}); 330 } 331 } 332 foreach my $tgt (keys(%ep)) { 333 if (!defined($lp{$tgt})) { 334 # If it doesn't exist in the language, copy it from English 335 if ($ep{$tgt} ne 'none' && $ep{$tgt} ne '' ) { 336 $lang{$id}{'notes'} .= "### The <source> section for '$id:$tgt' is missing! Copying from english!\n"; 337# print "#!! '$id:$tgt' source missing\n"; 338 } 339 $lang{$id}{'source'}{$tgt} = $english{$id}{'source'}{$tgt}; 340 } elsif ($lp{$tgt} ne $ep{$tgt}) { 341 # If the source string differs, complain, and copy from English 342 $lang{$id}{'notes'} .= "### The <source> section for '$id:$tgt' differs from English!\n"; 343 $lang{$id}{'notes'} .= "#### the previously used one is commented below:\n"; 344 $lang{$id}{'notes'} .= "##### $english{$id}{source}{$tgt}\n"; 345# print "#!! '$id:$tgt' source changed ('$lp{$tgt}' vs '$ep{$tgt}')\n"; 346 $lang{$id}{'source'}{$tgt} = $english{$id}{'source'}{$tgt}; 347 } 348 } 349} 350 351# Check dests 352foreach my $id (@langorder) { 353 if (!defined($english{$id})) { 354 next; 355 } 356 my %ep = %{$english{$id}{'dest'}}; 357 my %lp; 358 359 if (defined($lang{$id}{'dest'})) { 360 %lp = %{$lang{$id}{'dest'}}; 361 } else { 362 %lp = (); 363 } 364 365 foreach my $tgt (keys(%lp)) { 366 if (!defined($ep{$tgt})) { 367 # Delete any targets that have been nuked in master 368 delete($lang{$id}{'dest'}{$tgt}); 369 } 370 } 371 foreach my $tgt (keys(%ep)) { 372 if (!defined($lp{$tgt}) || ($lp{$tgt} eq 'none')) { 373 # If it doesn't exist in the language, copy it from English 374 if ($ep{$tgt} ne 'none' && $ep{$tgt} ne '' ) { 375 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' is missing! Copying from english!\n"; 376# print "#!! '$id:$tgt' dest missing\n"; 377 } 378 $lang{$id}{'dest'}{$tgt} = $english{$id}{'dest'}{$tgt}; 379 } elsif ($lp{$tgt} ne $ep{$tgt}) { 380 # If the source string differs, complain, and copy from English 381 if ($lp{$tgt} eq '' && $ep{$tgt} ne '') { 382 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' is blank! Copying from english!\n"; 383# print "#!! '$id:$tgt' dest is blank ('$lp{$tgt}' vs '$ep{$tgt}')\n"; 384 $lang{$id}{'dest'}{$tgt} = $english{$id}{'dest'}{$tgt}; 385 } elsif ($lp{$tgt} ne '' && $ep{$tgt} eq '') { 386 # It should be kept blank! 387 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' is not blank!\n"; 388 $lang{$id}{'notes'} .= "#### the previously used one is commented below:\n"; 389 $lang{$id}{'notes'} .= "##### $english{$id}{dest}{$tgt}\n"; 390# print "#!! '$id:$tgt' dest not blank ('$lp{$tgt}' vs '$ep{$tgt}')\n"; 391 $lang{$id}{'dest'}{$tgt} = $english{$id}{'dest'}{$tgt}; 392 } 393 } elsif ($lp{$tgt} ne 'none' && $lp{$tgt} ne '' && not_ignorelist($id) && !$lang{$id}{'new'} && !$ignoredups) { 394 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' is identical to english! (correct or prefix with ~)\n"; 395# print "#!! '$id:$tgt' dest identical ('$lp{$tgt}')\n"; 396 } 397 if ($id eq 'LANG_VOICED_DATE_FORMAT') { 398 my $sane = $lp{$tgt}; 399 $sane =~ s/^~?(.*)/$1/; # Strip off leading ~ if it's there as it's not a legal character for the format. 400 $sane =~ tr/YAmd~//d; 401 if (length($sane) != 0) { 402 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' has illegal characters! Restoring from English!\n"; 403 $lang{$id}{'notes'} .= "#### the previously used one is commented below:\n"; 404 $lang{$id}{'notes'} .= "##### $lang{$id}{dest}{$tgt}\n"; 405 $lang{$id}{'dest'}{$tgt} = $english{$id}{'dest'}{$tgt}; 406 } 407 } 408 my $count1 = $ep{$tgt} =~ tr/%//; 409 my $count2 = 0; 410 if (defined($lp{$tgt})) { 411 $count2 = $lp{$tgt} =~ tr/%//; 412 } 413 if ($count1 || $count2) { 414 my $fmt1 = reduceformat($ep{$tgt}); 415 my $fmt2 = ""; 416 if ($count2) { 417 $fmt2 = reduceformat($lp{$tgt}); 418 } 419 if ($fmt1 ne $fmt2) { 420 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' has incorrect format specifiers! Copying from English!\n"; 421 $lang{$id}{'notes'} .= "#### the previously used one is commented below:\n"; 422 $lang{$id}{'notes'} .= "##### $lang{$id}{dest}{$tgt}\n"; 423 $lang{$id}{'dest'}{$tgt} = $english{$id}{'dest'}{$tgt}; 424# print "#!! '$id:$tgt' dest does not match src format args: '$fmt1' vs '$fmt2'\n"; 425 } 426 } 427 428 my $sane = $lang{$id}{'dest'}{$tgt}; 429 $sane =~ s/^~?(.*)/$1/; # Strip off leading ~ if it's there as it's not a legal character otherwise 430 if ($sane =~ tr/"~<>//) { 431 # If it has suspicious characters that are not allowed 432 $lang{$id}{'notes'} .= "### The <dest> section for '$id:$tgt' has some suspicious characters (eg \",~,<,>), please double-check!\n"; 433# print "#!! '$id:$tgt' suspicious characters\n"; 434 } 435 } 436} 437 438# Check voices 439foreach my $id (@langorder) { 440 if (!defined($english{$id})) { 441 next; 442 } 443 my %ep = %{$english{$id}{'voice'}}; 444 my %lp; 445 446 if (defined($lang{$id}{'voice'})) { 447 %lp = %{$lang{$id}{'voice'}}; 448 } else { 449 %lp = (); 450 } 451 452 foreach my $tgt (keys(%lp)) { 453 if (!defined($ep{$tgt})) { 454 # Delete any targets that have been nuked in master 455 delete($lang{$id}{'voice'}{$tgt}); 456 } 457 } 458 foreach my $tgt (keys(%ep)) { 459 if (!defined($lp{$tgt}) || ($lp{$tgt} eq 'none')) { 460 # If it doesn't exist in the language, copy it from English 461 if ($ep{$tgt} ne 'none' && $ep{$tgt} ne '' ) { 462 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is missing! Copying from english!\n"; 463# print "#!! '$id:$tgt' voice missing\n"; 464 } 465 $lang{$id}{'voice'}{$tgt} = $english{$id}{'voice'}{$tgt}; 466 } elsif ($lp{$tgt} ne $ep{$tgt}) { 467 if ($lp{$tgt} eq '' && $ep{$tgt} ne '') { 468 # If the lang voice string is blank, complain and copy from translation 469# print "#!! '$id:$tgt' voice is blank ('$lp{$tgt}' vs '$ep{$tgt}')\n"; 470 if ($lang{$id}{'dest'}{$tgt} ne '' && 471 $lang{$id}{'dest'}{$tgt} ne $english{$id}{'dest'}{$tgt}) { 472 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is blank! Copying from translated <dest>!\n"; 473 $lang{$id}{'voice'}{$tgt} = $lang{$id}{'dest'}{$tgt}; 474 } elsif ($id eq 'VOICE_LANG_NAME') { 475 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is blank! Please fill out!\n"; 476 } else { 477 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is blank! Copying from english!\n"; 478 479 $lang{$id}{'voice'}{$tgt} = $english{$id}{'voice'}{$tgt}; 480 } 481 } elsif ($lp{$tgt} ne '' && $ep{$tgt} eq '') { 482 if ($id ne 'VOICE_NUMERIC_TENS_SWAP_SEPARATOR') { 483 # If it's not blank, clear it and complain! 484 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is not blank!\n"; 485 $lang{$id}{'notes'} .= "#### the previously used one is commented below:\n"; 486 $lang{$id}{'notes'} .= "##### $english{$id}{voice}{$tgt}\n"; 487 # print "#!! '$id:$tgt' voice not blank ('$lp{$tgt}' vs '$ep{$tgt}')\n"; 488 $lang{$id}{'voice'}{$tgt} = $english{$id}{'voice'}{$tgt}; 489 } 490 } 491 } elsif ($lp{$tgt} ne 'none' && $lp{$tgt} ne '' && not_ignorelist($id) && !$lang{$id}{'new'} && !$ignoredups) { 492# print "#!! '$id:$tgt' voice identical ('$lp{$tgt}')\n"; 493 if ($lang{$id}{'dest'}{$tgt} ne '' && 494 $lang{$id}{'dest'}{$tgt} ne $english{$id}{'dest'}{$tgt} && 495 $lang{$id}{'dest'}{$tgt} ne "~$english{$id}{dest}{$tgt}") { 496 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is identical to english, copying translated <dest>\n"; 497 $lang{$id}{'voice'}{$tgt} = $lang{$id}{'dest'}{$tgt}; 498 } else { 499 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' is identical to english! (correct or prefix with ~)\n"; 500 } 501 } 502 my $sane = $lang{$id}{'voice'}{$tgt}; 503 $sane =~ s/^~?(.*)/$1/; # Strip off leading ~ if it's there as it's not a legal character otherwise 504 if ($sane =~ tr/%"~:\[\]<>{}\|//) { 505 # Suspicious characters that are not typically voiced.. 506 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' has some suspicious characters (eg %,\",~,:,<,>,[,],{,},|), please correct!\n"; 507# print "#!! '$id:$tgt' suspicious characters\n"; 508 } 509 if ($lang{$id}{'voice'}{$tgt} =~ /\.\.\./) { 510 # Ellipses should not be in voice strings 511 $lang{$id}{'notes'} .= "### The <voice> section for '$id:$tgt' has ellipses (...), please remove!\n"; 512# print "#!! '$id:$tgt' ellipses\n"; 513 } 514 } 515} 516 517########## Write new language file 518my $fh; 519if ($ARGV[2] ne '-') { 520 open(FH, ">$ARGV[2]") || die ("Can't open $ARGV[2]"); 521 $fh = *FH; 522} else { 523 $fh = *STDOUT; 524} 525 526foreach (@langheader) { 527 print $fh $_; 528} 529 530my @finalorder; 531 532if ($ENV{'ENGLISHORDER'}) { 533 @finalorder = @englishorder; 534} else { 535 @finalorder = @langorder; 536} 537 538my ($id, %tgtorder); 539 540# When LANG_TIME_SET_BUTTON and LANG_TIME_REVERT are fixed to not 541# include a default 'rtc' value, then this abobmination can be 542# replaced with { $a cmp $b } to restore simple alphabetical 543# ordering. We should NOT be mixing feature and target options 544# in the same phrase. 545sub bytarget { 546 my $xa = $a; 547 my $xb = $b; 548 549 my $rval = 0; 550# print "ORDER: ". join("|", %tgtorder) . "\n"; 551 my $da = defined($tgtorder{$xa}); 552 if (!$da) { # try the first entry of a list 553 my @foo = split(',', $xa); 554 $xa = $foo[0]; 555 $da = defined($tgtorder{$xa}); 556 } 557 my $db = defined($tgtorder{$xb}); 558 if (!$db) { # try the first entry of a list 559 my @foo = split(',', $xb); 560 $xb = $foo[0]; 561 $db = defined($tgtorder{$xb}); 562 } 563 if ($xa eq "*") { 564 $rval = -1; 565 } elsif ($xb eq "*") { 566 $rval = 1; 567 } elsif ($da && $db) { 568 $rval = ($tgtorder{$xa} <=> $tgtorder{$xb}); 569 } elsif (!$da && !$db) { 570 $rval = ($xa cmp $xb); 571 } elsif ($da && !$db) { 572 $rval = -1; 573 } elsif (!$da && $db) { 574 $rval = 1; 575 } 576# print "~~~ '$xa' vs '$xb' ($da/$db) = $rval\n"; 577 578 return $rval; 579} 580 581foreach $id (@finalorder) { 582 if (!defined($english{$id})) { 583 next; 584 } 585 my %lp; 586 587 # phrase 588 %lp = %{$lang{$id}{'phrase'}}; 589 590 %tgtorder = %{ $english{$id}{'targetorder'}}; 591 592 # Drop all deprecated phrases? 593# next if ($lp{'desc'} eq 'deprecated'); 594 595 if (length($lang{$id}{'notes'}) && $printnotes) { 596 print $fh "$lang{$id}{notes}"; 597 } 598 print $fh "<phrase>\n"; 599 print $fh " id: $lp{id}\n"; 600 if ($lp{'desc'} ne '') { 601 print $fh " desc: $lp{desc}\n"; 602 } else { 603 print $fh " desc:\n"; 604 } 605 print $fh " user: $lp{user}\n"; 606 607 # source 608 %lp = combinetgts(%{$lang{$id}{'source'}}); 609 print $fh " <source>\n"; 610 foreach my $tgt (sort bytarget keys(%lp)) { 611 my $w = NFC($lp{$tgt}); 612 if ($w eq 'none') { 613 print $fh " $tgt: $w\n"; 614 } else { 615 print $fh " $tgt: \"$w\"\n"; 616 } 617 } 618 print $fh " </source>\n"; 619 620 # dest 621 %lp = combinetgts(%{$lang{$id}{'dest'}}); 622 print $fh " <dest>\n"; 623 foreach my $tgt (sort bytarget keys(%lp)) { 624 my $w = NFC($lp{$tgt}); 625 if ($w eq 'none') { 626 print $fh " $tgt: $w\n"; 627 } else { 628 print $fh " $tgt: \"$w\"\n"; 629 } 630 } 631 print $fh " </dest>\n"; 632 633 # voice 634 %lp = combinetgts(%{$lang{$id}{'voice'}}); 635 print $fh " <voice>\n"; 636 foreach my $tgt (sort bytarget keys(%lp)) { 637 my $w = NFC($lp{$tgt}); 638 if ($w eq 'none') { 639 print $fh " $tgt: $w\n"; 640 } else { 641 print $fh " $tgt: \"$w\"\n"; 642 } 643 } 644 print $fh " </voice>\n"; 645 646 # FiN 647 print $fh "</phrase>\n"; 648} 649 650if ($ARGV[2] ne '-') { 651 close(FH); 652}