tools/genlang

   1 #!/usr/bin/perl -s
   2 #             __________               __   ___.
   3 #   Open      \______   \ ____   ____ |  | _\_ |__   _______  ___
   4 #   Source     |       _//  _ \_/ ___\|  |/ /| __ \ /  _ \  \/  /
   5 #   Jukebox    |    |   (  <_> )  \___|    < | \_\ (  <_> > <  <
   6 #   Firmware   |____|_  /\____/ \___  >__|_ \|___  /\____/__/\_ \
   7 #                     \/            \/     \/    \/            \/
   8 # $Id$
   9 #
  10 # Copyright (C) 2006 - 2008 by Daniel Stenberg
  11 #
  12
  13 # See apps/language.c (TODO: Use common include for both)
  14 # Cookie and binary version for the binary lang file
  15 my $LANGUAGE_COOKIE   = 0x1a;
  16 my $VOICE_COOKIE      = 0x9a;
  17 my $LANGUAGE_VERSION  = 0x06;
  18 my $LANGUAGE_FLAG_RTL = 0x01;
  19
  20 my $HEADER_SIZE       = 4;
  21 my $SUBHEADER_SIZE    = 6;
  22
  23 # A note for future users and readers: The original v1 language system allowed
  24 # the build to create and use a different language than english built-in. We
  25 # removed that feature from our build-system, but the build scripts still had
  26 # the ability. But, starting now, this ability is no longer provided since I
  27 # figured it was boring and unnecessary to write support for now since we
  28 # don't use it anymore.
  29
  30
  31 if(!$ARGV[0]) {
  32     print <<MOO
  33 Usage: genlang [options] <langv2 file>
  34
  35  -p=<prefix>
  36     Make the tool create a [prefix].c and [prefix].h file.
  37
  38  -b=<outfile>
  39     Make the tool create a binary language (.lng) file named [outfile].
  40     The use of this option requires that you also use -e, -t and -i.
  41
  42  -c=<outfile>
  43     Create binary voicestring file named [outfile]. Works like -b and can be
  44     used the same time.
  45
  46  -u
  47     Update language file. Given the translated file and the most recent english
  48     file, you\'ll get an updated version sent to stdout. Suitable action to do
  49     when you intend to update a translation.
  50
  51  -e=<english lang file>
  52     Point out the english (original source) file, to use that as master
  53     language template. Used in combination with -b, -u or -s.
  54
  55  -s
  56     Sort the Update language file in the same order as the strings in the
  57     English file.
  58
  59  -t=<target>
  60     Specify which target you want the translations/phrases for. Required when
  61     -b or -p is used.
  62
  63     The target can in fact be specified as numerous different strings,
  64     separated with colons. This will make genlang to use all the specified
  65     strings when searching for a matching phrase.
  66
  67  -i=<target id>
  68     The target id number, needed for -b.
  69
  70  -o
  71     Voice mode output. Outputs all id: and voice: lines for the given target!
  72
  73  -v
  74     Enables verbose (debug) output.
  75 MOO
  76 ;
  77     exit;
  78 }
  79
  80 # How update works:
  81 #
  82 # 1) scan the english file, keep the whole <phrase> for each phrase.
  83 # 2) read the translated file, for each end of phrase, compare:
  84 #  A) all source strings, if there's any change there should be a comment about
  85 #     it output
  86 #  B) the desc fields
  87 #
  88 # 3) output the phrase with the comments from above
  89 # 4) check which phrases that the translated version didn't have, and spit out
  90 #    the english version of those
  91 #
  92
  93 my $prefix = $p;
  94 my $binary = $b;
  95 my $update = $u;
  96 my $sortfile = $s;
  97 my $binvoice = $c;
  98
  99 my $english = $e;
 100 my $voiceout = $o;
 101
 102 my $check = ($binary?.5:0) + ($prefix?1:0) + ($update?1:0) + ($voiceout?1:0) + ($sortfile?1:0) + ($binvoice?.5:0);
 103
 104 if($check > 1) {
 105     print STDERR "Please use only one of -p, -u, -o, -b, -c and -s\n";
 106     exit;
 107 }
 108 if(!$check) {
 109     print STDERR "Please use at least one of -p, -u, -o, -c, -e and -s\n";
 110     exit;
 111 }
 112
 113
 114 if(($binary || $update || $voiceout || $sortfile) && !$english) {
 115     print STDERR "Please use -e too when you use -b, -o, -u or -s\n";
 116     exit;
 117 }
 118
 119 my $target_id = $i;
 120 if($binary && !$target_id) {
 121     print STDERR "Please specify a target id number (with -i)!\n";
 122     exit;
 123 }
 124
 125 my $target = $t;
 126 if(!$target && !$update && !$sortfile) {
 127     print STDERR "Please specify a target (with -t)!\n";
 128     exit;
 129 }
 130
 131 # Build up a regex which can be applied to target wildcard lists. We only need
 132 # to support prefix matches, so a target parameter of foo:bar can be expanded
 133 # to the regex "\*|f\*|fo\*|foo|b\*|ba\*|bar" and applied to the wildcard list
 134 # (plus end-of-string or commas on either side). The regex engine should
 135 # discard any duplicates generated for us in the process of constructing the
 136 # state machine, so we don't bother to check.
 137 my $target_regex = "(?:^|,) *(?:\\*";
 138 foreach my $target_part (split ':', $target) {
 139     for (my $c=1; $c<=length $target_part; $c++) {
 140         my $partial = substr $target_part, 0, $c;
 141         $target_regex .= "|$partial\\*";
 142     }
 143     $target_regex .= "|$target_part";
 144 }
 145 $target_regex .= ") *(?:,|\$)";
 146 $target_regex = qr/$target_regex/;
 147
 148 my $binpath = "";
 149 if ($binary =~ m|(.*)/[^/]+|) {
 150     $binpath = $1;
 151 }
 152
 153 my $verbose=$v;
 154
 155 my %id; # string to num hash
 156 my @idnum; # num to string array
 157
 158 my %allphrases;  # For sorting - an array of the <phrase> elements
 159 my %source; # id string to source phrase hash
 160 my %dest; # id string to dest phrase hash
 161 my %voice; # id string to voice phrase hash
 162
 163 my %users =
 164   ('core' => 0);
 165
 166 my $input = $ARGV[0];
 167
 168 my @m;
 169 my $m="blank";
 170
 171 sub trim {
 172     my ($string) = @_;
 173     $string =~ s/^\s+//;
 174     $string =~ s/\s+$//;
 175     return $string;
 176 }
 177
 178 sub blank {
 179     # nothing to do
 180 }
 181
 182 my %head;
 183 sub header {
 184     my ($full, $n, $v)=@_;
 185     $head{$n}=$v;
 186 }
 187
 188 my %phrase;
 189 sub phrase {
 190     my ($full, $n, $v)=@_;
 191     $phrase{$n}=$v;
 192 }
 193
 194 my %options;
 195 sub options {
 196     my ($full, $n, $v)=@_;
 197     $options{$n}=$v;
 198 }
 199
 200 sub parsetarget {
 201     my ($debug, $strref, $full, $n, $v)=@_;
 202     my $string;
 203     if ($n =~ $target_regex) {
 204         $string = $v;
 205         $$strref = $string;
 206         return $string;
 207     }
 208 }
 209
 210 my $src;
 211 sub source {
 212     parsetarget("src", \$src, @_);
 213 }
 214
 215 my $dest;
 216 sub dest {
 217     parsetarget("dest", \$dest, @_);
 218 }
 219
 220 my $voice;
 221 sub voice {
 222     parsetarget("voice", \$voice, @_);
 223 }
 224
 225 sub file_is_newer {
 226     my ($file1, $file2) = @_;
 227
 228     my @s1 = stat $file1;
 229     my @s2 = stat $file2;
 230
 231     return 1 if ($s1[9] > $s2[9]);
 232     return 0;
 233 }
 234
 235 my %idmap;
 236 my %english;
 237 if($english) {
 238     readenglish();
 239 }
 240
 241 sub readenglish {
 242     # For the cases where the english file needs to be scanned/read, we do
 243     # it before we read the translated file. For -b it isn't necessary, but for
 244     # -u it is convenient.
 245
 246     my @idnum = ((0));       # start with a true number
 247     my @vidnum = ((0x8000)); # first voice id
 248
 249
 250     if ($binary and file_is_newer("$binpath/english.list", $english)) {
 251         open(ENG, "<$binpath/english.list") ||
 252             die "Error: can't open $binpath/english.list";
 253         while (<ENG>) {
 254             my ($user, $id, $value) = split ':', $_;
 255             $idmap[$user]{$id} = $value;
 256             $english{$id} = 1;
 257         }
 258         close ENG;
 259
 260         return;
 261     }
 262
 263     open(ENG, "<$english") || die "Error: can't open $english";
 264     my @phrase;
 265     my $id;
 266     my $maybeid;
 267     my $user;
 268     my $withindest;
 269     my $numphrases = 0;
 270     my $numusers = 1; # core is already in the users map
 271
 272     while(<ENG>) {
 273
 274         # get rid of DOS newlines
 275         $_ =~ tr/\r//d;
 276
 277         if($_ =~ /^ *\<phrase\>/) {
 278             # this is the start of a phrase
 279         }
 280         elsif($_ =~ /\<\/phrase\>/) {
 281
 282             # if id is something, when we count and store this phrase
 283             if($id) {
 284                 # voice-only entries get a difference range
 285                 if($id =~ /^VOICE_/) {
 286                     # Assign an ID number to this entry
 287                     $idmap[$user]{$id}=$vidnum[$user];
 288                     $vidnum[$user]++;
 289                 }
 290                 else {
 291                     # Assign an ID number to this entry
 292                     $idmap[$user]{$id}=$idnum[$user];
 293                     $idnum[$user]++;
 294    #                 print STDERR "DEST: bumped idnum to $idnum[$user]\n";
 295                 }
 296
 297                 # this is the end of a phrase, add it to the english hash
 298                 $english{$id}=join("", @phrase);
 299             }
 300             undef @phrase;
 301             $id="";
 302         }
 303         elsif($_ ne "\n") {
 304             # gather everything related to this phrase
 305             push @phrase, $_;
 306             if($_ =~ /^ *\<dest\>/i) {
 307                 $withindest=1;
 308                 $deststr="";
 309             }
 310             elsif($withindest && ($_ =~ /^ *\<\/dest\>/i)) {
 311                 $withindest=0;
 312
 313                 if($update || ($deststr && ($deststr !~ /^none\z/i))) {
 314                     # we unconditionally always use all IDs when the "update"
 315                     # feature is used
 316                     $id = $maybeid;
 317     #                print "DEST: use this id $id\n";
 318                 }
 319                 else {
 320     #                print "skip $maybeid for $name\n";
 321                 }
 322             }
 323             elsif($withindest && ($_ =~ / *([^:]+): *(.*)/)) {
 324                 my ($name, $val)=($1, $2);
 325                 $dest=""; # in case it is left untouched for when the
 326                 # model name isn't "our"
 327                 dest($_, $name, $val);
 328
 329                 if($dest) {
 330                     # Store the current dest string. If this target matches
 331                     # multiple strings, it will get updated several times.
 332                     $deststr = $dest;
 333                 }
 334             }
 335         }
 336
 337         if($_ =~ /^ *id: ([^ \t\n]+)/i) {
 338             $maybeid=$1;
 339             $sortorder{$maybeid}=$numphrases++;
 340         }
 341         if($_ =~ /^ *user: ([^ \t\n]+)/i) {
 342             $user = $users{$1};
 343             if(!(defined $user)) {
 344                 $user = ++$numusers;
 345                 $users{$1} = $user;
 346             }
 347         }
 348     }
 349     close(ENG);
 350 }
 351
 352 # a function that compares the english phrase with the translated one.
 353 # compare source strings and desc
 354
 355 # Then output the updated version!
 356 sub compare {
 357     my ($idstr, $engref, $locref)=@_;
 358     my ($edesc, $ldesc);
 359     my ($esource, $lsource);
 360     my $mode=0;
 361
 362     for my $l (@$engref) {
 363         if($l =~ /^ *#/) {
 364             # comment
 365             next;
 366         }
 367         if($l =~ /^ *desc: (.*)/) {
 368             $edesc=$1;
 369         }
 370         elsif($l =~ / *\<source\>/i) {
 371             $mode=1;
 372         }
 373         elsif($mode) {
 374             if($l =~ / *\<\/source\>/i) {
 375                 last;
 376             }
 377             $esource .= "$l\n";
 378         }
 379     }
 380
 381     my @show;
 382     my @source;
 383
 384     $mode = 0;
 385     for my $l (@$locref) {
 386         if($l =~ /^ *desc: (.*)/) {
 387             $ldesc=$1;
 388             if(trim($edesc) ne trim($ldesc)) {
 389                 $l = "### The 'desc' field differs from the english!\n### the previously used desc is commented below:\n### desc: $ldesc\n  desc: $edesc\n";
 390             }
 391             push @show, $l;
 392         }
 393         elsif($l =~ / *\<source\>/i) {
 394             $mode=1;
 395             push @show, $l;
 396         }
 397         elsif($mode) {
 398             if($l =~ / *\<\/source\>/i) {
 399                 $mode = 0;
 400                 print @show;
 401                 if(trim($esource) ne trim($lsource)) {
 402                     print "### The <source> section differs from the english!\n",
 403                     "### the previously used one is commented below:\n";
 404                     for(split("\n", $lsource)) {
 405                         print "### $_\n";
 406                     }
 407                     print $esource;
 408                 }
 409                 else {
 410                     print $lsource;
 411                 }
 412                 undef @show; # start over
 413
 414                 push @show, $l;
 415             }
 416             else {
 417                 $lsource .= "$l";
 418             }
 419         }
 420         else {
 421             push @show, $l;
 422         }
 423     }
 424
 425
 426     print @show;
 427 }
 428
 429 my @idcount;           # counter for lang ID numbers
 430 my @voiceid;           # counter for voice-only ID numbers
 431
 432 for (keys %users) {
 433     push @idcount, 0;
 434     push @voiceid, 0x8001;
 435 }
 436
 437 #
 438 # Now start the scanning of the selected language string
 439 #
 440
 441 open(LANG, "<$input") || die "Error: couldn't read language file named $input\n";
 442 my @phrase;
 443 my $header = 1;
 444 my $langoptions = 0;
 445
 446 while(<LANG>) {
 447
 448     $line++;
 449
 450     # get rid of DOS newlines
 451     $_ =~ tr/\r//d;
 452
 453     if($_ =~ /^( *\#|[ \t\n\r]*\z)/) {
 454         # comment or empty line - output it if it's part of the header
 455         if ($header and ($update || $sortfile)) {
 456             print($_);
 457         }
 458         next;
 459     }
 460     $header = 0;
 461
 462     my $ll = $_;
 463
 464     # print "M: $m\n";
 465
 466     push @phrase, $ll;
 467
 468     # this is an XML-lookalike tag
 469     if (/^(<|[^\"<]+<)([^>]*)>/) {
 470         my $part = $2;
 471         # print "P: $part\n";
 472
 473         if($part =~ /^\//) {
 474             # this was a closing tag
 475
 476             if($part eq "/phrase") {
 477                 # closing the phrase
 478
 479                 my $idstr = $phrase{'id'};
 480                 my $idnum;
 481
 482                 if($binary && !$english{$idstr}) {
 483                     # $idstr doesn't exist for english, skip it\n";
 484                 }
 485                 elsif($dest =~ /^none\z/i) {
 486                     # "none" as dest (without quotes) means that this entire
 487                     # phrase is to be ignored
 488                 }
 489                 elsif($sortfile) {
 490                     $allphrases{$idstr}=join('',@phrase);
 491                 }
 492                 elsif(!$update) {
 493                     # we don't do the fully detailed analysis when we "update"
 494                     # since we don't do it for a particular target etc
 495
 496                     # allow the keyword 'deprecated' to be used on dest and
 497                     # voice strings to mark that as deprecated. It will then
 498                     # be replaced with "".
 499
 500                     $dest =~ s/^deprecate(|d)\z/\"\"/i;
 501                     $voice =~ s/^deprecate(|d)\z/\"\"/i;
 502
 503                     # basic syntax error alerts, if there are no quotes we
 504                     # will assume an empty string was intended
 505                     if($dest !~ /^\"/) {
 506                         print STDERR "$input:$line:1: warning: dest before line lacks quotes ($dest)!\n";
 507                         $dest='""';
 508                     }
 509                     if($src !~ /^\"/) {
 510                         print STDERR "$input:$line:1: warning: source before line lacks quotes ($src)!\n";
 511                         $src='""';
 512                     }
 513                     if($voice !~ /^\"/ and $voice !~ /^none\z/i) {
 514                         print STDERR "$input:$line:1: warning: voice before line lacks quotes ($voice)!\n";
 515                         $voice='""';
 516                     }
 517                     if($dest eq '""' && $phrase{'desc'} !~ /deprecated/i && $idstr !~ /^VOICE/) {
 518                         print STDERR "$input:$line:1: warning: empty dest before line in non-deprecated phrase!\n";
 519                     }
 520
 521                     my $userstr = trim($phrase{'user'});
 522                     my $user = $users{$userstr};
 523                     if ($userstr eq "") {
 524                         print STDERR "$input:$line:1: warning: missing user!\n";
 525                         $user = $users{"core"};
 526                     }
 527                     elsif(!(defined $user)) {
 528                         if($english) {
 529                            print STDERR "$input:$line:1: warning: user was not found in $english!\n";
 530                            $user = keys %users;  # set to an invalid user so it won't be added
 531                         }
 532                         else {
 533                             # we found a new user, add it to the usermap
 534                             $user = ++$numusers;
 535                             $users{$userstr} = $user;
 536                         }
 537                     }
 538
 539                     # Use the ID name to figure out which id number range we
 540                     # should use for this phrase. Voice-only strings are
 541                     # separated.
 542
 543                     if($idstr =~ /^VOICE/) {
 544                         $idnum = $voiceid[$user]++;
 545                     }
 546                     else {
 547                         $idnum = $idcount[$user]++;
 548                     }
 549
 550                     $id{$idstr} = $idnum;
 551                     $idnum[$user][$idnum]=$idstr;
 552
 553                     $source{$idstr}=$src;
 554                     $dest{$idstr}=$dest;
 555                     $voice{$idstr}=$voice;
 556
 557                     if($verbose) {
 558                         print "id: $phrase{id} ($idnum)\n";
 559                         print "source: $src\n";
 560                         print "dest: $dest\n";
 561                         print "voice: $voice\n";
 562                         print "user: $user\n";
 563                     }
 564
 565                     undef $src;
 566                     undef $dest;
 567                     undef $voice;
 568                     undef $user;
 569                     undef %phrase;
 570                 }
 571
 572                 if($update) {
 573                     my $e = $english{$idstr};
 574
 575                     if($e) {
 576                         # compare original english with this!
 577                         my @eng = split("\n", $english{$idstr});
 578
 579                         compare($idstr, \@eng, \@phrase);
 580
 581                         $english{$idstr}=""; # clear it
 582                     }
 583                     else {
 584                         print "### $idstr: The phrase is not used. Skipped\n";
 585                     }
 586                 }
 587                 undef @phrase;
 588             } # end of </phrase>
 589             elsif($part eq "/options") {
 590                 # closing the options
 591                 if ($options{'rtl'}) {
 592                     $langoptions |= $LANGUAGE_FLAG_RTL;
 593                 }
 594             } # end of </options>
 595
 596             # starts with a slash, this _ends_ this section
 597             $m = pop @m; # get back old value, the previous level's tag
 598             next;
 599         } # end of tag close
 600
 601         # This is an opening (sub) tag
 602
 603         push @m, $m; # store old value
 604         $m = $part;
 605         next;
 606     }
 607
 608     if(/^ *([^:]+): *(.*)/) {
 609         my ($name, $val)=($1, $2);
 610         &$m($_, $name, $val);
 611     }
 612 }
 613 close(LANG);
 614
 615 if($update) {
 616     my $any=0;
 617     for(keys %english) {
 618         if($english{$_}) {
 619             print "###\n",
 620             "### This phrase below was not present in the translated file\n",
 621             "<phrase>\n";
 622             print $english{$_};
 623             print "</phrase>\n";
 624         }
 625     }
 626 }
 627
 628 if ($sortfile) {
 629     for(sort { $sortorder{$a} <=> $sortorder{$b} } keys %allphrases) {
 630          print $allphrases{$_};
 631     }
 632 }
 633
 634 if($prefix) {
 635     # We create a .c and .h file
 636
 637     open(HFILE_CORE, ">$prefix/lang.h") ||
 638         die "Error: couldn't create file $prefix/lang.h\n";
 639     open(CFILE_CORE, ">$prefix/lang_core.c") ||
 640         die "Error: couldn't create file $prefix/lang_core.c\n";
 641
 642    # get header file name
 643    $headername = "$prefix/lang.h";
 644    $headername =~ s/(.*\/)*//;
 645
 646     print HFILE_CORE <<MOO
 647 /* This file was automatically generated using genlang */
 648 /*
 649  * The str() macro/functions is how to access strings that might be
 650  * translated. Use it like str(MACRO) and expect a string to be
 651  * returned!
 652  */
 653 #define str(x) language_strings[x]
 654
 655 /* this is the array for holding the string pointers.
 656    It will be initialized at runtime. */
 657 extern unsigned char *language_strings[];
 658 /* this contains the concatenation of all strings, separated by \\0 chars */
 659 extern const unsigned char core_language_builtin[];
 660
 661 /* The enum below contains all available strings */
 662 enum \{
 663 MOO
 664     ;
 665
 666     print CFILE_CORE <<MOO
 667 /* This file was automatically generated using genlang, the strings come
 668    from "$input" */
 669
 670 #include "$headername"
 671
 672 unsigned char *language_strings[LANG_LAST_INDEX_IN_ARRAY];
 673 const unsigned char core_language_builtin[] =
 674 MOO
 675 ;
 676
 677     # Output the ID names for the enum in the header file
 678     my $i;
 679     for $i (0 .. $idcount[$users{"core"}]-1) {
 680         my $name=$idnum[$users{"core"}][$i]; # get the ID name
 681
 682         $name =~ tr/\"//d; # cut off the quotes
 683
 684         printf HFILE_CORE ("    %s, /* %d */\n", $name, $i);
 685     }
 686
 687 # Output separation marker for last string ID and the upcoming voice IDs
 688
 689     print HFILE_CORE <<MOO
 690     LANG_LAST_INDEX_IN_ARRAY, /* this is not a string, this is a marker */
 691     /* --- below this follows voice-only strings --- */
 692     VOICEONLY_DELIMITER = 0x8000,
 693 MOO
 694     ;
 695
 696 # Output the ID names for the enum in the header file
 697     for $i (0x8001 .. ($voiceid[$users{"core"}]-1)) {
 698         my $name=$idnum[$users{"core"}][$i]; # get the ID name
 699
 700         $name =~ tr/\"//d; # cut off the quotes
 701
 702         printf HFILE_CORE ("    %s, /* 0x%x */\n", $name, $i);
 703     }
 704
 705     # Output end of enum
 706     print HFILE_CORE "\n};\n/* end of generated enum list */\n";
 707
 708     # Output the target phrases for the source file
 709     for $i (0 .. $idcount[$users{"core"}]-1) {
 710         my $name=$idnum[$users{"core"}][$i]; # get the ID
 711         my $dest = $dest{$name}; # get the destination phrase
 712
 713         $dest =~ s:\"$:\\0\":; # insert a \0 before the second quote
 714
 715         if(!$dest) {
 716             # this is just to be on the safe side
 717             $dest = '"\0"';
 718         }
 719
 720         printf CFILE_CORE ("    %s\n", $dest);
 721     }
 722
 723 # Output end of string chunk
 724     print CFILE_CORE <<MOO
 725 ;
 726 /* end of generated string list */
 727 MOO
 728 ;
 729
 730     close(HFILE_CORE);
 731     close(CFILE_CORE);
 732 } # end of the c/h file generation
 733 elsif($binary || $binvoice) {
 734     # Creation of a binary lang file was requested
 735
 736     # We must first scan the english file to get the correct order of the id
 737     # numbers used there, as that is what sets the id order for all language
 738     # files. The english file is scanned before the translated file was
 739     # scanned.
 740
 741     if($binary) {
 742         open(OUTF, ">$binary") or die "Error: Can't create $binary";
 743         binmode OUTF;
 744         printf OUTF ("%c%c%c%c", $LANGUAGE_COOKIE, $LANGUAGE_VERSION, $target_id,
 745             $langoptions); # magic lang file header
 746     }
 747     if($binvoice) {
 748         open(OUTV, ">$binvoice") or die "Error: Can't create $binary";
 749         binmode OUTV;
 750         printf OUTV ("%c%c%c%c", $VOICE_COOKIE, $LANGUAGE_VERSION, $target_id,
 751             $langoptions); # magic lang file header
 752     }
 753
 754     # output the number of strings for each user
 755     my $foffset = $HEADER_SIZE + $SUBHEADER_SIZE * keys(%users);
 756     for (keys %users) {
 757         my $size;
 758         for $n (0 .. $idcount[$_]-1) {
 759             $size += length(trim($dest{$idnum[$_][$n]})) + 1;
 760         }
 761         if($binary) {
 762             printf OUTF ("%c%c%c%c%c%c", ($idcount[$_] >> 8), ($idcount[$_] & 0xff),
 763                 ($size >> 8), ($size & 0xff), ($foffset >> 8), ($foffset & 0xff));
 764         }
 765         if($binvoice) {
 766             printf OUTV ("%c%c%c%c%c%c", ($idcount[$_] >> 8), ($idcount[$_] & 0xff),
 767                 ($size >> 8), ($size & 0xff), ($foffset >> 8), ($foffset & 0xff));
 768         }
 769         $foffset += $size;
 770     }
 771
 772     for (keys %users) {
 773         # loop over the target phrases
 774         # This loops over the strings in the translated language file order
 775         my @ids = ((0 .. ($idcount[$_]-1)));
 776         push @ids, (0x8000 .. ($voiceid[$_]-1));
 777         for $n (@ids) {
 778             my $name=$idnum[$_][$n]; # get the ID
 779             my $dest = $dest{$name}; # get the destination phrase
 780             my $voice = $voice{$name}; # get the destination voice string
 781
 782             if($dest && $n < 0x8000 && $binary) {
 783                 $dest =~ s/^\"(.*)\"\s*$/$1/g; # cut off quotes
 784
 785                 # Now, make sure we get the number from the english sort order:
 786                 $idnum = $idmap[$_]{$name};
 787
 788                 printf OUTF ("%c%c%s\x00", ($idnum>>8), ($idnum&0xff), $dest);
 789             }
 790             if($voice && $binvoice) {
 791                 $voice =~ s/^\"(.*)\"\s*$/$1/g; # cut off quotes
 792                 # Now, make sure we get the number from the english sort order:
 793                 $idnum = $idmap[$_]{$name};
 794                 printf OUTV ("%c%c%s\x00", ($idnum>>8), ($idnum&0xff), $voice);
 795             }
 796         }
 797     }
 798     if($binary) {
 799         close(OUTF);
 800     }
 801     if($binvoice) {
 802         close(OUTV);
 803     }
 804 }
 805 elsif($voiceout) {
 806     # voice output requested, display id: and voice: strings in a v1-like
 807     # fashion
 808
 809     my @engl;
 810
 811     # This loops over the strings in the translated language file order
 812     my @ids = ((0 .. ($idcount[$users{"core"}]-1)));
 813     push @ids, (0x8000 .. ($voiceid[$users{"core"}]-1));
 814
 815     #for my $id (@ids) {
 816     #    print "$id\n";
 817     #}
 818
 819     for $i (@ids) {
 820         my $name=$idnum[$users{"core"}][$i]; # get the ID
 821         my $dest = $voice{$name}; # get the destination voice string
 822
 823         if($dest) {
 824             $dest =~ s/^\"(.*)\"\s*$/$1/g; # cut off quotes
 825
 826             # Now, make sure we get the number from the english sort order:
 827             $idnum = $idmap[$users{"core"}]{$name};
 828
 829             if(length($idnum)) {
 830                 $engl[$idnum] = $i;
 831
 832                 #print "Input index $i output index $idnum\n";
 833             }
 834             else {
 835                 # not used, mark it so
 836                 $engl[$i] = -1
 837             }
 838
 839         }
 840     }
 841     for my $i (@ids) {
 842
 843         my $o = $engl[$i];
 844
 845         if(($o < 0) || !length($o)) {
 846             if($i < 0x8000) {
 847                 print "#$i\nid: NOT_USED_$i\nvoice: \"\"\n";
 848             }
 849             else {
 850                 print "#$i\nid: VOICE_NOT_USED_$i\nvoice: \"\"\n";
 851             }
 852             next;
 853         }
 854
 855         my $name=$idnum[$users{"core"}][$o]; # get the ID
 856         my $dest = $voice{$name}; # get the destination voice string
 857
 858         print "#$i ($o)\nid: $name\nvoice: $dest\n";
 859     }
 860
 861 }
 862
 863
 864 if($verbose) {
 865     my $num_str = 0;
 866
 867     for (keys %users) {
 868         $num_str += $idcount[$_];
 869     }
 870
 871     printf("%d ID strings scanned\n", $num_str);
 872
 873     print "* head *\n";
 874     for(keys %head) {
 875         printf "$_: %s\n", $head{$_};
 876     }
 877 }
 878
 879 if ($binary and !file_is_newer("$binpath/english.list", $english)) {
 880     open(ENGLIST, ">$binpath/english.list") ||
 881         die "Failed creating $binpath/english.list";
 882     for my $user (keys %users) {
 883         for my $id (keys %{$idmap[$user]}) {
 884             print ENGLIST "$user:$id:$idmap[$user]{$id}\n";
 885         }
 886     }
 887     close ENGLIST;
 888 }