home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Locale.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-11  |  14.3 KB  |  372 lines
  1.  
  2. package Win32::Locale;
  3. # Time-stamp: "2004-01-11 18:56:06 AST"
  4. use strict;
  5. use vars qw($VERSION %MSLocale2LangTag);
  6. $VERSION = '0.04';
  7. %MSLocale2LangTag = (
  8.  
  9.   0x0436 => 'af'   ,  # <AFK> <Afrikaans> <Afrikaans>
  10.   0x041c => 'sq'   ,  # <SQI> <Albanian> <Albanian>
  11.  
  12.   0x0401 => 'ar-sa',  # <ARA> <Arabic> <Arabic (Saudi Arabia)>
  13.   0x0801 => 'ar-iq',  # <ARI> <Arabic> <Arabic (Iraq)>
  14.   0x0C01 => 'ar-eg',  # <ARE> <Arabic> <Arabic (Egypt)>
  15.   0x1001 => 'ar-ly',  # <ARL> <Arabic> <Arabic (Libya)>
  16.   0x1401 => 'ar-dz',  # <ARG> <Arabic> <Arabic (Algeria)>
  17.   0x1801 => 'ar-ma',  # <ARM> <Arabic> <Arabic (Morocco)>
  18.   0x1C01 => 'ar-tn',  # <ART> <Arabic> <Arabic (Tunisia)>
  19.   0x2001 => 'ar-om',  # <ARO> <Arabic> <Arabic (Oman)>
  20.   0x2401 => 'ar-ye',  # <ARY> <Arabic> <Arabic (Yemen)>
  21.   0x2801 => 'ar-sy',  # <ARS> <Arabic> <Arabic (Syria)>
  22.   0x2C01 => 'ar-jo',  # <ARJ> <Arabic> <Arabic (Jordan)>
  23.   0x3001 => 'ar-lb',  # <ARB> <Arabic> <Arabic (Lebanon)>
  24.   0x3401 => 'ar-kw',  # <ARK> <Arabic> <Arabic (Kuwait)>
  25.   0x3801 => 'ar-ae',  # <ARU> <Arabic> <Arabic (U.A.E.)>
  26.   0x3C01 => 'ar-bh',  # <ARH> <Arabic> <Arabic (Bahrain)>
  27.   0x4001 => 'ar-qa',  # <ARQ> <Arabic> <Arabic (Qatar)>
  28.  
  29.   0x042b => 'hy'   ,  # <HYE> <Armenian> <Armenian>
  30.   0x044d => 'as'   ,  # <ASM> <Assamese> <Assamese>
  31.   0x042c => 'az-latn',  # <AZE> <Azeri> <Azeri (Latin)>
  32.   0x082c => 'az-cyrl',  # <AZC> <Azeri> <Azeri (Cyrillic)>
  33.   0x042D => 'eu'   ,  # <EUQ> <Basque> <Basque>
  34.   0x0423 => 'be'   ,  # <BEL> <Belarussian> <Belarussian>
  35.   0x0445 => 'bn'   ,  # <BEN> <Bengali> <Bengali>
  36.   0x0402 => 'bg'   ,  # <BGR> <Bulgarian> <Bulgarian>
  37.   0x0403 => 'ca'   ,  # <CAT> <Catalan> <Catalan>
  38.  
  39.   # Chinese is zh, not cn!
  40.   0x0404 => 'zh-tw',  # <CHT> <Chinese> <Chinese (Taiwan)>
  41.   0x0804 => 'zh-cn',  # <CHS> <Chinese> <Chinese (PRC)>
  42.   0x0C04 => 'zh-hk',  # <ZHH> <Chinese> <Chinese (Hong Kong)>
  43.   0x1004 => 'zh-sg',  # <ZHI> <Chinese> <Chinese (Singapore)>
  44.   0x1404 => 'zh-mo',  # <ZHM> <Chinese> <Chinese (Macau SAR)>
  45.  
  46.   0x041a => 'hr'   ,  # <HRV> <Croatian> <Croatian>
  47.   0x0405 => 'cs'   ,  # <CSY> <Czech> <Czech>
  48.   0x0406 => 'da'   ,  # <DAN> <Danish> <Danish>
  49.   0x0413 => 'nl-nl',  # <NLD> <Dutch> <Dutch (Netherlands)>
  50.   0x0813 => 'nl-be',  # <NLB> <Dutch> <Dutch (Belgium)>
  51.   
  52.   0x0409 => 'en-us',  # <ENU> <English> <English (United States)>
  53.   0x0809 => 'en-gb',  # <ENG> <English> <English (United Kingdom)>
  54.   0x0c09 => 'en-au',  # <ENA> <English> <English (Australia)>
  55.   0x1009 => 'en-ca',  # <ENC> <English> <English (Canada)>
  56.   0x1409 => 'en-nz',  # <ENZ> <English> <English (New Zealand)>
  57.   0x1809 => 'en-ie',  # <ENI> <English> <English (Ireland)>
  58.   0x1c09 => 'en-za',  # <ENS> <English> <English (South Africa)>
  59.   0x2009 => 'en-jm',  # <ENJ> <English> <English (Jamaica)>
  60.   0x2409 => 'en-jm',  # <ENB> <English> <English (Caribbean)>  # a hack
  61.   0x2809 => 'en-bz',  # <ENL> <English> <English (Belize)>
  62.   0x2c09 => 'en-tt',  # <ENT> <English> <English (Trinidad)>
  63.   0x3009 => 'en-zw',  # <ENW> <English> <English (Zimbabwe)>
  64.   0x3409 => 'en-ph',  # <ENP> <English> <English (Philippines)>
  65.   
  66.   0x0425 => 'et'   ,  # <ETI> <Estonian> <Estonian>
  67.   0x0438 => 'fo'   ,  # <FOS> <Faeroese> <Faeroese>
  68.   0x0429 => 'pa'   ,  # <FAR> <Farsi> <Farsi>   # =Persian
  69.   0x040b => 'fi'   ,  # <FIN> <Finnish> <Finnish>
  70.   
  71.   0x040c => 'fr-fr',  # <FRA> <French> <French (France)>
  72.   0x080c => 'fr-be',  # <FRB> <French> <French (Belgium)>
  73.   0x0c0c => 'fr-ca',  # <FRC> <French> <French (Canada)>
  74.   0x100c => 'fr-ch',  # <FRS> <French> <French (Switzerland)>
  75.   0x140c => 'fr-lu',  # <FRL> <French> <French (Luxembourg)>
  76.   0x180c => 'fr-mc',  # <FRM> <French> <French (Monaco)>
  77.   
  78.   0x0437 => 'ka'   ,  # <KAT> <Georgian> <Georgian>
  79.   
  80.   0x0407 => 'de-de',  # <DEU> <German> <German (Germany)>
  81.   0x0807 => 'de-ch',  # <DES> <German> <German (Switzerland)>
  82.   0x0c07 => 'de-at',  # <DEA> <German> <German (Austria)>
  83.   0x1007 => 'de-lu',  # <DEL> <German> <German (Luxembourg)>
  84.   0x1407 => 'de-li',  # <DEC> <German> <German (Liechtenstein)>
  85.   
  86.   0x0408 => 'el'   ,  # <ELL> <Greek> <Greek>
  87.   0x0447 => 'gu'   ,  # <GUJ> <Gujarati> <Gujarati>
  88.   0x040D => 'he'   ,  # <HEB> <Hebrew> <Hebrew>  # formerly 'iw'
  89.   0x0439 => 'hi'   ,  # <HIN> <Hindi> <Hindi>
  90.   0x040e => 'hu'   ,  # <HUN> <Hungarian> <Hungarian>
  91.   0x040F => 'is'   ,  # <ISL> <Icelandic> <Icelandic>
  92.   0x0421 => 'id'   ,  # <IND> <Indonesian> <Indonesian>  # formerly 'in'
  93.   0x0410 => 'it-it',  # <ITA> <Italian> <Italian (Italy)>
  94.   0x0810 => 'it-ch',  # <ITS> <Italian> <Italian (Switzerland)>
  95.   0x0411 => 'ja'   ,  # <JPN> <Japanese> <Japanese>  # not "jp"!
  96.   0x044b => 'kn'   ,  # <KAN> <Kannada> <Kannada>
  97.   0x0860 => 'ks'   ,  # <KAI> <Kashmiri> <Kashmiri (India)>
  98.   0x043f => 'kk'   ,  # <KAZ> <Kazakh> <Kazakh>
  99.   0x0457 => 'kok'  ,  # <KOK> <Konkani> <Konkani>    3-letters!
  100.   0x0412 => 'ko'   ,  # <KOR> <Korean> <Korean>
  101.   0x0812 => 'ko'   ,  # <KOJ> <Korean> <Korean (Johab)>  ?
  102.   0x0426 => 'lv'   ,  # <LVI> <Latvian> <Latvian>  # = lettish
  103.   0x0427 => 'lt'   ,  # <LTH> <Lithuanian> <Lithuanian>
  104.   0x0827 => 'lt'   ,  # <LTH> <Lithuanian> <Lithuanian (Classic)>  ?
  105.   0x042f => 'mk'   ,  # <MKD> <FYOR Macedonian> <FYOR Macedonian>
  106.   0x043e => 'ms'   ,  # <MSL> <Malay> <Malaysian>
  107.   0x083e => 'ms-bn',  # <MSB> <Malay> <Malay Brunei Darussalam>
  108.   0x044c => 'ml'   ,  # <MAL> <Malayalam> <Malayalam>
  109.   0x044e => 'mr'   ,  # <MAR> <Marathi> <Marathi>
  110.   0x0461 => 'ne-np',  # <NEP> <Nepali> <Nepali (Nepal)>
  111.   0x0861 => 'ne-in',  # <NEI> <Nepali> <Nepali (India)>
  112.   0x0414 => 'nb'   ,  # <NOR> <Norwegian> <Norwegian (Bokmal)>   #was no-bok
  113.   0x0814 => 'nn'   ,  # <NON> <Norwegian> <Norwegian (Nynorsk)>  #was no-nyn
  114.                         # note that this leaves nothing using "no" ("Norwegian")
  115.   0x0448 => 'or'   ,  # <ORI> <Oriya> <Oriya>
  116.   0x0415 => 'pl'   ,  # <PLK> <Polish> <Polish>
  117.   0x0416 => 'pt-br',  # <PTB> <Portuguese> <Portuguese (Brazil)>
  118.   0x0816 => 'pt-pt',  # <PTG> <Portuguese> <Portuguese (Portugal)>
  119.   0x0446 => 'pa'   ,  # <PAN> <Punjabi> <Punjabi>
  120.   0x0417 => 'rm'   ,  # <RMS> <Rhaeto-Romanic> <Rhaeto-Romanic>
  121.   0x0418 => 'ro'   ,  # <ROM> <Romanian> <Romanian>
  122.   0x0818 => 'ro-md',  # <ROV> <Romanian> <Romanian (Moldova)>
  123.   0x0419 => 'ru'   ,  # <RUS> <Russian> <Russian>
  124.   0x0819 => 'ru-md',  # <RUM> <Russian> <Russian (Moldova)>
  125.   0x043b => 'se'   ,  # <SZI> <Sami> <Sami (Lappish)>  assuming == "Northern Sami"
  126.   0x044f => 'sa'   ,  # <SAN> <Sanskrit> <Sanskrit>
  127.   0x0c1a => 'sr-cyrl', # <SRB> <Serbian> <Serbian (Cyrillic)>
  128.   0x081a => 'sr-latn', # <SRL> <Serbian> <Serbian (Latin)>
  129.   0x0459 => 'sd'   ,  # <SND> <Sindhi> <Sindhi>
  130.   0x041b => 'sk'   ,  # <SKY> <Slovak> <Slovak>
  131.   0x0424 => 'sl'   ,  # <SLV> <Slovenian> <Slovenian>
  132.   0x042e => 'wen'  ,  # <SBN> <Sorbian> <Sorbian>  # !!! 3 letters
  133.   
  134.   0x040a => 'es-es',  # <ESP> <Spanish> <Spanish (Spain - Traditional Sort)>
  135.   0x080a => 'es-mx',  # <ESM> <Spanish> <Spanish (Mexico)>
  136.   0x0c0a => 'es-es',  # <ESN> <Spanish> <Spanish (Spain - Modern Sort)>
  137.   0x100a => 'es-gt',  # <ESG> <Spanish> <Spanish (Guatemala)>
  138.   0x140a => 'es-cr',  # <ESC> <Spanish> <Spanish (Costa Rica)>
  139.   0x180a => 'es-pa',  # <ESA> <Spanish> <Spanish (Panama)>
  140.   0x1c0a => 'es-do',  # <ESD> <Spanish> <Spanish (Dominican Republic)>
  141.   0x200a => 'es-ve',  # <ESV> <Spanish> <Spanish (Venezuela)>
  142.   0x240a => 'es-co',  # <ESO> <Spanish> <Spanish (Colombia)>
  143.   0x280a => 'es-pe',  # <ESR> <Spanish> <Spanish (Peru)>
  144.   0x2c0a => 'es-ar',  # <ESS> <Spanish> <Spanish (Argentina)>
  145.   0x300a => 'es-ec',  # <ESF> <Spanish> <Spanish (Ecuador)>
  146.   0x340a => 'es-cl',  # <ESL> <Spanish> <Spanish (Chile)>
  147.   0x380a => 'es-uy',  # <ESY> <Spanish> <Spanish (Uruguay)>
  148.   0x3c0a => 'es-py',  # <ESZ> <Spanish> <Spanish (Paraguay)>
  149.   0x400a => 'es-bo',  # <ESB> <Spanish> <Spanish (Bolivia)>
  150.   0x440a => 'es-sv',  # <ESE> <Spanish> <Spanish (El Salvador)>
  151.   0x480a => 'es-hn',  # <ESH> <Spanish> <Spanish (Honduras)>
  152.   0x4c0a => 'es-ni',  # <ESI> <Spanish> <Spanish (Nicaragua)>
  153.   0x500a => 'es-pr',  # <ESU> <Spanish> <Spanish (Puerto Rico)>
  154.   
  155.   0x0430 => 'st'   ,  # <SXT> <Sutu> <Sutu>  == soto, sesotho
  156.   0x0441 => 'sw-ke',  # <SWK> <Swahili> <Swahili (Kenya)>
  157.   0x041D => 'sv'   ,  # <SVE> <Swedish> <Swedish>
  158.   0x081d => 'sv-fi',  # <SVF> <Swedish> <Swedish (Finland)>
  159.   0x0449 => 'ta'   ,  # <TAM> <Tamil> <Tamil>
  160.   0x0444 => 'tt'   ,  # <TAT> <Tatar> <Tatar (Tatarstan)>
  161.   0x044a => 'te'   ,  # <TEL> <Telugu> <Telugu>
  162.   0x041E => 'th'   ,  # <THA> <Thai> <Thai>
  163.   0x0431 => 'ts'   ,  # <TSG> <Tsonga> <Tsonga>    (not Tonga!)
  164.   0x0432 => 'tn'   ,  # <TNA> <Tswana> <Tswana>    == Setswana
  165.   0x041f => 'tr'   ,  # <TRK> <Turkish> <Turkish>
  166.   0x0422 => 'uk'   ,  # <UKR> <Ukrainian> <Ukrainian>
  167.   0x0420 => 'ur-pk',  # <URD> <Urdu> <Urdu (Pakistan)>
  168.   0x0820 => 'ur-in',  # <URI> <Urdu> <Urdu (India)>
  169.   0x0443 => 'uz-latn',  # <UZB> <Uzbek> <Uzbek (Latin)>
  170.   0x0843 => 'uz-cyrl',  # <UZC> <Uzbek> <Uzbek (Cyrillic)>
  171.   0x0433 => 'ven'  ,  # <VEN> <Venda> <Venda>
  172.   0x042a => 'vi'   ,  # <VIT> <Vietnamese> <Vietnamese>
  173.   0x0434 => 'xh'   ,  # <XHS> <Xhosa> <Xhosa>
  174.   0x043d => 'yi'   ,  # <JII> <Yiddish> <Yiddish>  # formetly ji
  175.   0x0435 => 'zu'   ,  # <ZUL> <Zulu> <Zulu>
  176. );
  177. #-----------------------------------------------------------------------------
  178.  
  179. sub get_ms_locale {
  180.   my $locale;
  181.   return unless defined do {
  182.     # see if there's a W32 registry on this machine, and if so, look in it
  183.     local $SIG{"__DIE__"} = "";
  184.     eval '
  185.       use Win32::TieRegistry ();
  186.       my $i18n = Win32::TieRegistry->new(
  187.          "HKEY_CURRENT_USER/Control Panel/International",
  188.          { Delimiter => "/" }
  189.       );
  190.       #print "no key!" unless $i18n;
  191.       $locale = $i18n->GetValue("Locale") if $i18n;
  192.       undef $i18n;
  193.     ';
  194.     #print "<$@>\n" if $@;
  195.     $locale;
  196.   };
  197.   return unless $locale =~ m/^[0-9a-fA-F]+$/s;
  198.   return hex($locale);
  199. }
  200.  
  201. sub get_language {
  202.   my $lang = $MSLocale2LangTag{ $_[0] || get_ms_locale() || '' };
  203.   return unless $lang;
  204.   return $lang;
  205. }
  206.  
  207. sub get_locale {
  208.   # I guess this is right.
  209.   my $lang = get_language(@_);
  210.   return unless $lang and $lang =~ m/^[a-z]{2}(?:-[a-z]{2})?$/s;
  211.   
  212.   # should we try to turn "fi" into "fi_FI"?
  213.   
  214.   $lang =~ tr/-/_/;
  215.   return $lang;
  216. }
  217. #-----------------------------------------------------------------------------
  218.  
  219. # If we're just executed...
  220. unless(caller) {
  221.   my $locale = get_ms_locale();
  222.   if($locale) {
  223.     printf "Locale 0x%08x (%s => %s) => Lang %s\n",
  224.       $locale, $locale,
  225.       get_locale($locale)   || '?',
  226.       get_language($locale) || '?',
  227.   } else {
  228.     print "Can't get ms-locale\n";
  229.   }
  230. }
  231.  
  232. #-----------------------------------------------------------------------------
  233. 1;
  234.  
  235. __END__
  236.  
  237. =head1 NAME
  238.  
  239. Win32::Locale - get the current MSWin locale or language
  240.  
  241. =head1 SYNOPSIS
  242.  
  243.   use Win32::Locale;
  244.   my $language = Win32::Locale::get_language();
  245.   if($language eq 'en-us') {
  246.     print "Wasaaap homeslice!\n";
  247.   } else {
  248.     print "You $language people ain't FROM around here, are ya?\n";
  249.   }
  250.  
  251. =head1 DESCRIPTION
  252.  
  253. This library provides some simple functions allowing Perl under MSWin
  254. to ask what the current locale/language setting is.  (Yes, MSWin
  255. conflates locales and languages, it seems; and the way it's
  256. conflated is even stranger after MSWin98.)
  257.  
  258. Note that you should be able to safely use this module under any
  259. OS; the functions just won't be able to access any current
  260. locale value.
  261.  
  262. =head1 FUNCTIONS
  263.  
  264. Note that these functions are not exported,
  265. nor are they exportable:
  266.  
  267. =over
  268.  
  269. =item Win32::Locale::get_language()
  270.  
  271. Returns the (all-lowercase) RFC3066 language tag corresponding
  272. to the currently currently selected MS locale.
  273.  
  274. Returns nothing if the MS locale value isn't accessible
  275. (notably, if you're not running under MSWin!), or if it
  276. corresponds to no known language tag.  Example: "en-us".
  277.  
  278. In list context, this may in the future be made to return
  279. multiple values.
  280.  
  281. =item Win32::Locale::get_locale()
  282.  
  283. Returns the (all-lowercase) Unixish locale tag corresponding
  284. to the currently currently selected MS locale.  Example: "en_us".
  285.  
  286. Returns nothing if the MS locale value isn't accessible
  287. (notably, if you're not running under MSWin!), or if it
  288. corresponds to no locale.
  289.  
  290. In list context, this may in the future be made to return
  291. multiple values.
  292.  
  293. Note that this function is B<experimental>, and I greatly welcome
  294. suggestions.
  295.  
  296. =item Win32::Locale::get_ms_locale()
  297.  
  298. Returns the MS locale ID code for the currently selected MSWindows
  299. locale.  For example, returns the number 1033 for "US
  300. English".  (You may know the number 1033 better as 0x00000409,
  301. as these numbers are usually given in hex in MS documents).
  302.  
  303. Returns nothing if the value isn't accessible (notably, if you're
  304. not running under MSWin!).
  305.  
  306. =item Win32::Locale::get_language($msid)
  307.  
  308. Returns the (all-lowercase) RFC3066 language tag corresponding
  309. to the given MS locale code, or nothing if none.
  310.  
  311. In list context, this may in the future be made to return
  312. multiple values.
  313.  
  314. =item Win32::Locale::get_locale($msid)
  315.  
  316. Returns the (all-lowercase) Unixish locale tag corresponding
  317. to the given MS locale code, or nothing if none.
  318.  
  319. In list context, this may in the future be made to return
  320. multiple values.
  321.  
  322. =back
  323.  
  324. ("Nothing", above, means "in scalar context, undef; in list
  325. context, empty-list".)
  326.  
  327. =head1 AND MORE
  328.  
  329. This module provides an (unexported) public hash,
  330. %Win32::Locale::MSLocale2LangTag, that maps
  331. from the MS locale ID code to my idea of the single best corresponding
  332. RFC3066 language tag.
  333.  
  334. The hash's contents are relatively certain for well-known
  335. languages (US English is "en-us"), but are still experimental
  336. in its finer details (like Konkani being "kok").
  337.  
  338. =head1 SEE ALSO
  339.  
  340. L<I18N::LangTags|I18N::LangTags>,
  341. L<I18N::LangTags::List|I18N::LangTags::List>,
  342. L<Locale::Maketext|Locale::Maketext>.
  343.  
  344. =head1 COPYRIGHT AND DISCLAIMER
  345.  
  346. Copyright (c) 2001,2003 Sean M. Burke.  All rights reserved.
  347.  
  348. This library is free software; you can redistribute it and/or modify
  349. it under the same terms as Perl itself.
  350.  
  351. This program is distributed in the hope that it will be useful, but
  352. without any warranty; without even the implied warranty of
  353. merchantability or fitness for a particular purpose.
  354.  
  355. I am not affiliated with the Microsoft corporation, nor the ActiveState
  356. corporation.
  357.  
  358. Product and company names mentioned in this document may be the
  359. trademarks or service marks of their respective owners.  Trademarks 
  360. and service marks might not be identified as such, although
  361. this must not be construed as anyone's expression of validity
  362. or invalidity of each trademark or service mark.
  363.  
  364. =head1 AUTHOR
  365.  
  366. Sean M. Burke C<sburke@cpan.org>
  367.  
  368. =cut
  369.  
  370. # No big whoop.
  371.  
  372.