A modern Music Player Daemon based on Rockbox open source high quality audio player
libadwaita
audio
rust
zig
deno
mpris
rockbox
mpd
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}