i18npool/source/isolang/langid.pl

   1 : # -*- perl -*-  vim: ft=perl
   2 eval 'exec perl -w -S $0 ${1+"$@"}'
   3 if 0;
   4 #*************************************************************************
   5 #
   6 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   7 #
   8 # Copyright 2000, 2010 Oracle and/or its affiliates.
   9 #
  10 # OpenOffice.org - a multi-platform office productivity suite
  11 #
  12 # This file is part of OpenOffice.org.
  13 #
  14 # OpenOffice.org is free software: you can redistribute it and/or modify
  15 # it under the terms of the GNU Lesser General Public License version 3
  16 # only, as published by the Free Software Foundation.
  17 #
  18 # OpenOffice.org is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 # GNU Lesser General Public License version 3 for more details
  22 # (a copy is included in the LICENSE file that accompanied this code).
  23 #
  24 # You should have received a copy of the GNU Lesser General Public License
  25 # version 3 along with OpenOffice.org.  If not, see
  26 # <http://www.openoffice.org/license.html>
  27 # for a copy of the LGPLv3 License.
  28 #
  29 #*************************************************************************
  30
  31 # See Usage() below or invoke without arguments for short instructions.
  32 # For long instructions use the source, Luke ;-)
  33
  34 use strict;
  35
  36 sub Usage()
  37 {
  38     print STDERR
  39         "\n",
  40         "langid - a hackish utility to lookup lang.h language defines and LangIDs,\n",
  41         "isolang.cxx ISO639/ISO3166 mapping, locale data files, langtab.src language\n",
  42         "listbox entries, langlist.mk, file_ooo.scp registry name, globals.pm and\n",
  43         "msi-encodinglist.txt\n\n",
  44
  45         "Usage: $0 [--single] {language string} | {LangID} | {primarylanguage sublanguage} | {language-country}\n\n",
  46
  47         "A language string will be used as a generic string match in all searched files.\n",
  48         "You may enclose the language string in word delimiters,\n",
  49         "e.g. \\blanguage_german\\b for a specific match.\n",
  50         "If the language string expression matches more than one define,\n",
  51         "e.g. as in 'german', all matching defines will be processed.\n",
  52         "If the language string does not match a define or an identifier in\n",
  53         "langtab.src, a generic string match of the listbox entries will be tried.\n\n",
  54
  55         "Numeric values of LangID,primarylanguage,sublanguage can be given\n",
  56         "decimal, hexadecimal (leading 0x), octal (leading 0) or binary (leading 0b).\n",
  57         "The exact language_define of an exact match will be used in remaining lookups.\n\n",
  58
  59         "A language-country pair will lookup a xx-YY mapping from isolang.cxx,\n",
  60         "for example: 'en-US' or 'de-' or '-CH',\n",
  61         "xx and YY can be given case insensitive, will be lowered-uppered internally,\n",
  62         "and xx and YY themselves may be regular expressions.\n",
  63         "Also here a list of matches will be processed.\n\n",
  64
  65         "If option --single is given, only the first match will be processed.\n\n";
  66 }
  67
  68 my $SOLARVERSION = $ENV{"SOLARVERSION"};
  69 my $INPATH       = $ENV{"INPATH"};
  70 my $SRC_ROOT     = $ENV{"SRC_ROOT"};
  71 my $UPDMINOREXT  = $ENV{"UPDMINOREXT"};
  72 if (!defined($SOLARVERSION) || !defined($INPATH) || !defined($SRC_ROOT))
  73 {
  74     print "\nNeed \$SOLARVERSION, \$INPATH and \$SRC_ROOT, please set your OOo environment!\n";
  75     Usage();
  76     exit 1;
  77 }
  78 if (!defined($UPDMINOREXT)) {
  79     $UPDMINOREXT  = '';
  80 }
  81 my $SOLENVINC = "$SOLARVERSION/$INPATH/inc$UPDMINOREXT";
  82
  83 my $LANGUAGE_MASK_PRIMARY = 0x03ff;
  84
  85 sub getPrimaryLanguage($)
  86 {
  87     my($lcid) = @_;
  88     return $lcid & $LANGUAGE_MASK_PRIMARY;
  89 }
  90
  91 sub getSubLanguage($)
  92 {
  93     my($lcid) = @_;
  94     return $lcid >> 10;
  95 }
  96
  97 sub makeLangID($$)
  98 {
  99     my( $sub, $pri) = @_;
 100     return ($sub << 10) | $pri;
 101 }
 102
 103
 104 sub grepFile($$$$@)
 105 {
 106     my( $regex, $path, $module, $name, @addregex) = @_;
 107     my @result;
 108     my $found = 0;
 109     my $areopen = 0;
 110     my $arecloser = '';
 111     my $file;
 112     # Try module under current working directory first to catch local
 113     # modifications. A Not yet delivered lang.h is a special case.
 114     if ("$path/$module/$name" eq "$SOLENVINC/i18npool/lang.h") {
 115         $file = "./$module/inc/i18npool/lang.h"; }
 116     else {
 117         $file = "./$module/$name"; }
 118     if (!($found = open( IN, $file)))
 119     {
 120         # Then with the given path.
 121         $file = "$path/$module/$name";
 122         if (!($found = open( IN, $file)))
 123         {
 124             print "No $file\n";
 125             $file = "$path/$module.lnk/$name";
 126             if (!($found = open( IN, $file))) {
 127                 print "No $file.\n";
 128                 $file = "$path/$module.link/$name";
 129                 if (!($found = open( IN, $file))) {
 130                     print "No $file either.\n"; }
 131             }
 132         }
 133     }
 134     if ($found)
 135     {
 136         $found = 0;
 137         while (my $line = <IN>)
 138         {
 139             if ($line =~ /$regex/)
 140             {
 141                 if (!$found)
 142                 {
 143                     $found = 1;
 144                     print "$file:\n";
 145                 }
 146                 chomp( $line);
 147                 print "$line\n";
 148                 push( @result, $line);
 149             }
 150             elsif (@addregex)
 151             {
 152                 # By convention first element is opener, second element is closer.
 153                 if (!$areopen)
 154                 {
 155                     if ($line =~ /$addregex[0]/)
 156                     {
 157                         $areopen = 1;
 158                         $arecloser = $addregex[1];
 159                     }
 160                 }
 161                 if ($areopen)
 162                 {
 163                     for (my $i = 2; $i < @addregex; ++$i)
 164                     {
 165                         if ($line =~ /$addregex[$i]/)
 166                         {
 167                             if (!$found)
 168                             {
 169                                 $found = 1;
 170                                 print "$file:\n";
 171                             }
 172                             chomp( $line);
 173                             print "$line\n";
 174                             push( @result, $line);
 175                         }
 176                     }
 177                     if ($line =~ /$arecloser/)
 178                     {
 179                         $areopen = 0;
 180                     }
 181                 }
 182             }
 183         }
 184         close( IN);
 185     }
 186     if (!$found) {
 187         print "Not found in $file\n";
 188         #print "Not found in $file for $regex @addregex\n";
 189     }
 190     return @result;
 191 }
 192
 193
 194 sub main()
 195 {
 196     my( $lcid, @parts, $grepdef, $options, $single);
 197     $grepdef = 0;
 198     $single = 0;
 199     for ($options = 0; $options < @ARGV && $ARGV[$options] =~ /^--/; ++$options)
 200     {
 201         if ($ARGV[$options] eq '--single') { $single = 1; }
 202         else { print "Unknown option: $ARGV[$options]\n"; }
 203     }
 204     if (@ARGV == 1 + $options)
 205     {
 206         # 0x hex, 0b bin, 0 oct
 207         if ($ARGV[$options] =~ /^0/) {
 208             $lcid = oct( $ARGV[0]); }
 209         elsif ($ARGV[$options] =~ /^[0-9]/) {
 210             $lcid = $ARGV[$options]; }
 211         else
 212         {
 213             $grepdef = $ARGV[$options];
 214             $lcid = 0;
 215         }
 216         $parts[0] = getPrimaryLanguage( $lcid);
 217         $parts[1] = getSubLanguage( $lcid);
 218     }
 219     elsif (@ARGV == 2 + $options)
 220     {
 221         for (my $i = $options; $i < 2 + $options; ++$i)
 222         {
 223             if ($ARGV[$i] =~ /^0/) {
 224                 $parts[$i] = oct( $ARGV[$i]); }
 225             else {
 226                 $parts[$i] = $ARGV[$i]; }
 227         }
 228         $lcid = makeLangID( $parts[1], $parts[0]);
 229     }
 230     else
 231     {
 232         Usage();
 233         return 1;
 234     }
 235     my $modifier = "(?i)";
 236     my (@resultlist, @greplist, $result);
 237     # If no string was given on the command line, but value(s) were, lookup the
 238     # LangID value to obtain the define identifier.
 239     if ($grepdef)
 240     {
 241         # #define LANGUAGE_AFRIKAANS                  0x0436
 242         @resultlist = grepFile(
 243             $modifier . '^\s*#\s*define\s+[A-Z_]*' . $grepdef,
 244             $SOLENVINC, "i18npool", "lang.h", ());
 245     }
 246     else
 247     {
 248         printf( "LangID: 0x%04X (dec %d), primary: 0x%03x, sub 0x%02x\n", $lcid,
 249                 $lcid, $parts[0], $parts[1]);
 250         my $buf = sprintf( "0x%04X", $lcid);
 251         @resultlist = grepFile(
 252             '^\s*#\s*define\s+\w+\s+' . $buf,
 253             $SOLENVINC, "i18npool", "lang.h", ());
 254     }
 255     for $result (@resultlist)
 256     {
 257         # #define LANGUAGE_AFRIKAANS                  0x0436
 258         if ($result =~ /^\s*#\s*define\s+(\w+)\s+(0x[0-9a-fA-F]+)/)
 259         {
 260             push( @greplist, '\b' . $1 . '\b');
 261             $modifier = "";     # complete identifier now case sensitive
 262             if ($single) {
 263                 last; }
 264         }
 265     }
 266     # If the string given is of the form xx-yy lookup a language,country pair
 267     # to obtain the define identifier. xx and yy themselfs may be regexps.
 268     # xx- is a short form for 'xx-.*' and -yy a short form for '.*-yy'
 269     if ($grepdef =~ /^(.*)-$/) {
 270         $grepdef = $1 . "-.*"; }
 271     if ($grepdef =~ /^-(.*)$/) {
 272         $grepdef = ".*-" . $1; }
 273     if ($grepdef =~ /^(.*)-(.*)$/)
 274     {
 275         my $lang = $1;
 276         my $coun = $2;
 277         $lang = lc($lang);
 278         $coun = uc($coun);
 279         #     { LANGUAGE_AFRIKAANS,                   "af", "ZA" },
 280         @resultlist = grepFile(
 281             '^\s*\{\s*\w+\s*,\s*\"' . $lang . '\"\s*,\s*\"'  . $coun . '\"\s*\}\s*,',
 282             "$SRC_ROOT", "i18npool", "source/isolang/isolang.cxx", ());
 283         for $result (@resultlist)
 284         {
 285             if ($result =~ /^\s*\{\s*(\w+)\s*,\s*\"\w+\"\s*,\s*\"(\w+)?\"\s*\}\s*,/)
 286             {
 287                 push( @greplist, '\b' . $1 . '\b');
 288                 $modifier = "";     # complete identifier now case sensitive
 289                 if ($single) {
 290                     last; }
 291             }
 292         }
 293         $grepdef = 0;
 294     }
 295     if (!@greplist && $grepdef) {
 296         push( @greplist, $grepdef); }
 297     for $grepdef (@greplist)
 298     {
 299         print "\nUsing: " . $grepdef . "\n";
 300
 301         # Decimal LCID, was needed for Langpack.ulf but isn't used anymore,
 302         # keep just in case we'd need it again.
 303         # #define LANGUAGE_AFRIKAANS                  0x0436
 304         @resultlist = grepFile(
 305             $modifier . '^\s*#\s*define\s+[A-Z_]*' . $grepdef,
 306             $SOLENVINC, "i18npool", "lang.h", ());
 307         my @lcidlist;
 308         for $result (@resultlist)
 309         {
 310             # #define LANGUAGE_AFRIKAANS                  0x0436
 311             if ($result =~ /^\s*#\s*define\s+(\w+)\s+(0x[0-9a-fA-F]+)/)
 312             {
 313                 push( @lcidlist, oct( $2));
 314             }
 315         }
 316
 317         #     { LANGUAGE_AFRIKAANS,                   "af", "ZA" },
 318         @resultlist = grepFile(
 319             $modifier . '^\s*\{\s*.*' . $grepdef . '.*\s*,\s*\".*\"\s*,\s*\".*\"\s*\}\s*,',
 320             "$SRC_ROOT", "i18npool", "source/isolang/isolang.cxx", ());
 321
 322         my @langcoungreplist;
 323         for $result (@resultlist)
 324         {
 325             if ($result =~ /^\s*\{\s*\w+\s*,\s*\"(\w+)\"\s*,\s*\"(\w+)?\"\s*\}\s*,/)
 326             {
 327                 my $lang = $1;
 328                 my $coun = $2;
 329                 my $loca;
 330                 if ($coun)
 331                 {
 332                     $loca = $lang . "_" . $coun;
 333                     push( @langcoungreplist, '\b' . $lang . '\b(-' . $coun . ')?');
 334                 }
 335                 else
 336                 {
 337                     $loca = $lang;
 338                     $coun = "";
 339                     push( @langcoungreplist, '\b' . $lang . '\b');
 340                 }
 341                 my $file = "$SRC_ROOT/i18npool/source/localedata/data/$loca.xml";
 342                 my $found;
 343                 if (!($found = open( LD, $file)))
 344                 {
 345                     $file = "$SRC_ROOT/i18npool.lnk/source/localedata/data/$loca.xml";
 346                     if (!($found = open( LD, $file)))
 347                     {
 348                         $file = "$SRC_ROOT/i18npool.link/source/localedata/data/$loca.xml";
 349                         $found = open( LD, $file);
 350                     }
 351                 }
 352                 if ($found)
 353                 {
 354                     print "Found $file:\n";
 355                     my $on = 0;
 356                     while (my $line = <LD>)
 357                     {
 358                         if ($line =~ /<(Language|Country)>/) {
 359                             $on = 1; }
 360                         if ($on) {
 361                             print $line; }
 362                         if ($line =~ /<\/(Language|Country)>/) {
 363                             $on = 0; }
 364                     }
 365                     close( LD);
 366                 }
 367                 else {
 368                     print "No $SRC_ROOT/i18npool/source/localedata/data/$loca.xml\n"; }
 369             }
 370         }
 371
 372         #         case LANGUAGE_ARABIC:
 373         grepFile(
 374             $modifier . '^\s*case\s*.*' . $grepdef . '.*\s*:',
 375             "$SRC_ROOT", "i18npool", "source/isolang/mslangid.cxx", ());
 376
 377         # With CWS 'langstatusbar' the language listbox resource file gets a new location.
 378         my $module = "svx";
 379         my $name = "source/dialog/langtab.src";
 380         if (!(-e "$SRC_ROOT/$module/$name")) {
 381             $module = "svtools";
 382             $name = "source/misc/langtab.src";
 383         }
 384         #         < "Afrikaans" ; LANGUAGE_AFRIKAANS ; > ;
 385         # lookup define
 386         @resultlist = grepFile(
 387             $modifier . '^\s*<\s*\".*\"\s*;\s*.*' . $grepdef . '.*\s*;\s*>\s*;',
 388             "$SRC_ROOT", $module, $name, ());
 389         # lookup string
 390         if (!@resultlist) {
 391             grepFile(
 392                 $modifier . '^\s*<\s*\".*' . $grepdef . '.*\"\s*;\s*.*\s*;\s*>\s*;',
 393                 "$SRC_ROOT", $module, $name, ()); }
 394
 395         for my $langcoun (@langcoungreplist)
 396         {
 397             # Name (xxx) = "/registry/spool/org/openoffice/Office/Common-ctl.xcu";
 398             grepFile(
 399                 '^\s*Name\s*\(' . $langcoun . '\)\s*=',
 400                 "$SRC_ROOT", "scp2", "source/ooo/file_ooo.scp", ());
 401
 402             # completelangiso=af ar as-IN ... zu
 403             grepFile(
 404                 '^\s*completelangiso\s*=\s*(\s*([a-z]{2,3})(-[A-Z][A-Z])?)*' . $langcoun . '',
 405                 "$SRC_ROOT", "solenv", "inc/langlist.mk",
 406                 # needs a duplicated pair of backslashes to produce a literal \\
 407                 ('^\s*completelangiso\s*=', '^\s*$', '^\s*' . $langcoun . '\s*\\\\*$'));
 408
 409             # @noMSLocaleLangs = ( "br", "bs", ... )
 410             grepFile(
 411                 '^\s*@noMSLocaleLangs\s*=\s*\(\s*(\s*"([a-z]{2,3})(-[A-Z][A-Z])?"\s*,?)*' . $langcoun . '',
 412                 "$SRC_ROOT", "solenv", "bin/modules/installer/globals.pm",
 413                 ('^\s*@noMSLocaleLangs\s*=', '\)\s*$', '"' . $langcoun . '"'));
 414
 415             # af    1252  1078   # Afrikaans
 416             grepFile(
 417                 '^\s*' . $langcoun . '',
 418                 "$SRC_ROOT", "setup_native", "source/win32/msi-encodinglist.txt", ());
 419         }
 420     }
 421     return 0;
 422 }
 423
 424 main();