Subversion Repositories Projects

package Win32::Locale;

# Time-stamp: "2004-01-11 18:56:06 AST"

use strict;

use vars qw($VERSION %MSLocale2LangTag);

$VERSION = '0.04';

%MSLocale2LangTag = (

  0x0436 => 'af'   ,  # <AFK> <Afrikaans> <Afrikaans>

  0x041c => 'sq'   ,  # <SQI> <Albanian> <Albanian>

  0x0401 => 'ar-sa',  # <ARA> <Arabic> <Arabic (Saudi Arabia)>

  0x0801 => 'ar-iq',  # <ARI> <Arabic> <Arabic (Iraq)>

  0x0C01 => 'ar-eg',  # <ARE> <Arabic> <Arabic (Egypt)>

  0x1001 => 'ar-ly',  # <ARL> <Arabic> <Arabic (Libya)>

  0x1401 => 'ar-dz',  # <ARG> <Arabic> <Arabic (Algeria)>

  0x1801 => 'ar-ma',  # <ARM> <Arabic> <Arabic (Morocco)>

  0x1C01 => 'ar-tn',  # <ART> <Arabic> <Arabic (Tunisia)>

  0x2001 => 'ar-om',  # <ARO> <Arabic> <Arabic (Oman)>

  0x2401 => 'ar-ye',  # <ARY> <Arabic> <Arabic (Yemen)>

  0x2801 => 'ar-sy',  # <ARS> <Arabic> <Arabic (Syria)>

  0x2C01 => 'ar-jo',  # <ARJ> <Arabic> <Arabic (Jordan)>

  0x3001 => 'ar-lb',  # <ARB> <Arabic> <Arabic (Lebanon)>

  0x3401 => 'ar-kw',  # <ARK> <Arabic> <Arabic (Kuwait)>

  0x3801 => 'ar-ae',  # <ARU> <Arabic> <Arabic (U.A.E.)>

  0x3C01 => 'ar-bh',  # <ARH> <Arabic> <Arabic (Bahrain)>

  0x4001 => 'ar-qa',  # <ARQ> <Arabic> <Arabic (Qatar)>

  0x042b => 'hy'   ,  # <HYE> <Armenian> <Armenian>

  0x044d => 'as'   ,  # <ASM> <Assamese> <Assamese>

  0x042c => 'az-latn',  # <AZE> <Azeri> <Azeri (Latin)>

  0x082c => 'az-cyrl',  # <AZC> <Azeri> <Azeri (Cyrillic)>

  0x042D => 'eu'   ,  # <EUQ> <Basque> <Basque>

  0x0423 => 'be'   ,  # <BEL> <Belarussian> <Belarussian>

  0x0445 => 'bn'   ,  # <BEN> <Bengali> <Bengali>

  0x0402 => 'bg'   ,  # <BGR> <Bulgarian> <Bulgarian>

  0x0403 => 'ca'   ,  # <CAT> <Catalan> <Catalan>

  # Chinese is zh, not cn!

  0x0404 => 'zh-tw',  # <CHT> <Chinese> <Chinese (Taiwan)>

  0x0804 => 'zh-cn',  # <CHS> <Chinese> <Chinese (PRC)>

  0x0C04 => 'zh-hk',  # <ZHH> <Chinese> <Chinese (Hong Kong)>

  0x1004 => 'zh-sg',  # <ZHI> <Chinese> <Chinese (Singapore)>

  0x1404 => 'zh-mo',  # <ZHM> <Chinese> <Chinese (Macau SAR)>

  0x041a => 'hr'   ,  # <HRV> <Croatian> <Croatian>

  0x0405 => 'cs'   ,  # <CSY> <Czech> <Czech>

  0x0406 => 'da'   ,  # <DAN> <Danish> <Danish>

  0x0413 => 'nl-nl',  # <NLD> <Dutch> <Dutch (Netherlands)>

  0x0813 => 'nl-be',  # <NLB> <Dutch> <Dutch (Belgium)>

  0x0409 => 'en-us',  # <ENU> <English> <English (United States)>

  0x0809 => 'en-gb',  # <ENG> <English> <English (United Kingdom)>

  0x0c09 => 'en-au',  # <ENA> <English> <English (Australia)>

  0x1009 => 'en-ca',  # <ENC> <English> <English (Canada)>

  0x1409 => 'en-nz',  # <ENZ> <English> <English (New Zealand)>

  0x1809 => 'en-ie',  # <ENI> <English> <English (Ireland)>

  0x1c09 => 'en-za',  # <ENS> <English> <English (South Africa)>

  0x2009 => 'en-jm',  # <ENJ> <English> <English (Jamaica)>

  0x2409 => 'en-jm',  # <ENB> <English> <English (Caribbean)>  # a hack

  0x2809 => 'en-bz',  # <ENL> <English> <English (Belize)>

  0x2c09 => 'en-tt',  # <ENT> <English> <English (Trinidad)>

  0x3009 => 'en-zw',  # <ENW> <English> <English (Zimbabwe)>

  0x3409 => 'en-ph',  # <ENP> <English> <English (Philippines)>

  0x0425 => 'et'   ,  # <ETI> <Estonian> <Estonian>

  0x0438 => 'fo'   ,  # <FOS> <Faeroese> <Faeroese>

  0x0429 => 'pa'   ,  # <FAR> <Farsi> <Farsi>   # =Persian

  0x040b => 'fi'   ,  # <FIN> <Finnish> <Finnish>

  0x040c => 'fr-fr',  # <FRA> <French> <French (France)>

  0x080c => 'fr-be',  # <FRB> <French> <French (Belgium)>

  0x0c0c => 'fr-ca',  # <FRC> <French> <French (Canada)>

  0x100c => 'fr-ch',  # <FRS> <French> <French (Switzerland)>

  0x140c => 'fr-lu',  # <FRL> <French> <French (Luxembourg)>

  0x180c => 'fr-mc',  # <FRM> <French> <French (Monaco)>

  0x0437 => 'ka'   ,  # <KAT> <Georgian> <Georgian>

  0x0407 => 'de-de',  # <DEU> <German> <German (Germany)>

  0x0807 => 'de-ch',  # <DES> <German> <German (Switzerland)>

  0x0c07 => 'de-at',  # <DEA> <German> <German (Austria)>

  0x1007 => 'de-lu',  # <DEL> <German> <German (Luxembourg)>

  0x1407 => 'de-li',  # <DEC> <German> <German (Liechtenstein)>

  0x0408 => 'el'   ,  # <ELL> <Greek> <Greek>

  0x0447 => 'gu'   ,  # <GUJ> <Gujarati> <Gujarati>

  0x040D => 'he'   ,  # <HEB> <Hebrew> <Hebrew>  # formerly 'iw'

  0x0439 => 'hi'   ,  # <HIN> <Hindi> <Hindi>

  0x040e => 'hu'   ,  # <HUN> <Hungarian> <Hungarian>

  0x040F => 'is'   ,  # <ISL> <Icelandic> <Icelandic>

  0x0421 => 'id'   ,  # <IND> <Indonesian> <Indonesian>  # formerly 'in'

  0x0410 => 'it-it',  # <ITA> <Italian> <Italian (Italy)>

  0x0810 => 'it-ch',  # <ITS> <Italian> <Italian (Switzerland)>

  0x0411 => 'ja'   ,  # <JPN> <Japanese> <Japanese>  # not "jp"!

  0x044b => 'kn'   ,  # <KAN> <Kannada> <Kannada>

  0x0860 => 'ks'   ,  # <KAI> <Kashmiri> <Kashmiri (India)>

  0x043f => 'kk'   ,  # <KAZ> <Kazakh> <Kazakh>

  0x0457 => 'kok'  ,  # <KOK> <Konkani> <Konkani>    3-letters!

  0x0412 => 'ko'   ,  # <KOR> <Korean> <Korean>

  0x0812 => 'ko'   ,  # <KOJ> <Korean> <Korean (Johab)>  ?

  0x0426 => 'lv'   ,  # <LVI> <Latvian> <Latvian>  # = lettish

  0x0427 => 'lt'   ,  # <LTH> <Lithuanian> <Lithuanian>

  0x0827 => 'lt'   ,  # <LTH> <Lithuanian> <Lithuanian (Classic)>  ?

  0x042f => 'mk'   ,  # <MKD> <FYOR Macedonian> <FYOR Macedonian>

  0x043e => 'ms'   ,  # <MSL> <Malay> <Malaysian>

  0x083e => 'ms-bn',  # <MSB> <Malay> <Malay Brunei Darussalam>

  0x044c => 'ml'   ,  # <MAL> <Malayalam> <Malayalam>

  0x044e => 'mr'   ,  # <MAR> <Marathi> <Marathi>

  0x0461 => 'ne-np',  # <NEP> <Nepali> <Nepali (Nepal)>

  0x0861 => 'ne-in',  # <NEI> <Nepali> <Nepali (India)>

  0x0414 => 'nb'   ,  # <NOR> <Norwegian> <Norwegian (Bokmal)>   #was no-bok

  0x0814 => 'nn'   ,  # <NON> <Norwegian> <Norwegian (Nynorsk)>  #was no-nyn

                        # note that this leaves nothing using "no" ("Norwegian")

  0x0448 => 'or'   ,  # <ORI> <Oriya> <Oriya>

  0x0415 => 'pl'   ,  # <PLK> <Polish> <Polish>

  0x0416 => 'pt-br',  # <PTB> <Portuguese> <Portuguese (Brazil)>

  0x0816 => 'pt-pt',  # <PTG> <Portuguese> <Portuguese (Portugal)>

  0x0446 => 'pa'   ,  # <PAN> <Punjabi> <Punjabi>

  0x0417 => 'rm'   ,  # <RMS> <Rhaeto-Romanic> <Rhaeto-Romanic>

  0x0418 => 'ro'   ,  # <ROM> <Romanian> <Romanian>

  0x0818 => 'ro-md',  # <ROV> <Romanian> <Romanian (Moldova)>

  0x0419 => 'ru'   ,  # <RUS> <Russian> <Russian>

  0x0819 => 'ru-md',  # <RUM> <Russian> <Russian (Moldova)>

  0x043b => 'se'   ,  # <SZI> <Sami> <Sami (Lappish)>  assuming == "Northern Sami"

  0x044f => 'sa'   ,  # <SAN> <Sanskrit> <Sanskrit>

  0x0c1a => 'sr-cyrl', # <SRB> <Serbian> <Serbian (Cyrillic)>

  0x081a => 'sr-latn', # <SRL> <Serbian> <Serbian (Latin)>

  0x0459 => 'sd'   ,  # <SND> <Sindhi> <Sindhi>

  0x041b => 'sk'   ,  # <SKY> <Slovak> <Slovak>

  0x0424 => 'sl'   ,  # <SLV> <Slovenian> <Slovenian>

  0x042e => 'wen'  ,  # <SBN> <Sorbian> <Sorbian>  # !!! 3 letters

  0x040a => 'es-es',  # <ESP> <Spanish> <Spanish (Spain - Traditional Sort)>

  0x080a => 'es-mx',  # <ESM> <Spanish> <Spanish (Mexico)>

  0x0c0a => 'es-es',  # <ESN> <Spanish> <Spanish (Spain - Modern Sort)>

  0x100a => 'es-gt',  # <ESG> <Spanish> <Spanish (Guatemala)>

  0x140a => 'es-cr',  # <ESC> <Spanish> <Spanish (Costa Rica)>

  0x180a => 'es-pa',  # <ESA> <Spanish> <Spanish (Panama)>

  0x1c0a => 'es-do',  # <ESD> <Spanish> <Spanish (Dominican Republic)>

  0x200a => 'es-ve',  # <ESV> <Spanish> <Spanish (Venezuela)>

  0x240a => 'es-co',  # <ESO> <Spanish> <Spanish (Colombia)>

  0x280a => 'es-pe',  # <ESR> <Spanish> <Spanish (Peru)>

  0x2c0a => 'es-ar',  # <ESS> <Spanish> <Spanish (Argentina)>

  0x300a => 'es-ec',  # <ESF> <Spanish> <Spanish (Ecuador)>

  0x340a => 'es-cl',  # <ESL> <Spanish> <Spanish (Chile)>

  0x380a => 'es-uy',  # <ESY> <Spanish> <Spanish (Uruguay)>

  0x3c0a => 'es-py',  # <ESZ> <Spanish> <Spanish (Paraguay)>

  0x400a => 'es-bo',  # <ESB> <Spanish> <Spanish (Bolivia)>

  0x440a => 'es-sv',  # <ESE> <Spanish> <Spanish (El Salvador)>

  0x480a => 'es-hn',  # <ESH> <Spanish> <Spanish (Honduras)>

  0x4c0a => 'es-ni',  # <ESI> <Spanish> <Spanish (Nicaragua)>

  0x500a => 'es-pr',  # <ESU> <Spanish> <Spanish (Puerto Rico)>

  0x0430 => 'st'   ,  # <SXT> <Sutu> <Sutu>  == soto, sesotho

  0x0441 => 'sw-ke',  # <SWK> <Swahili> <Swahili (Kenya)>

  0x041D => 'sv'   ,  # <SVE> <Swedish> <Swedish>

  0x081d => 'sv-fi',  # <SVF> <Swedish> <Swedish (Finland)>

  0x0449 => 'ta'   ,  # <TAM> <Tamil> <Tamil>

  0x0444 => 'tt'   ,  # <TAT> <Tatar> <Tatar (Tatarstan)>

  0x044a => 'te'   ,  # <TEL> <Telugu> <Telugu>

  0x041E => 'th'   ,  # <THA> <Thai> <Thai>

  0x0431 => 'ts'   ,  # <TSG> <Tsonga> <Tsonga>    (not Tonga!)

  0x0432 => 'tn'   ,  # <TNA> <Tswana> <Tswana>    == Setswana

  0x041f => 'tr'   ,  # <TRK> <Turkish> <Turkish>

  0x0422 => 'uk'   ,  # <UKR> <Ukrainian> <Ukrainian>

  0x0420 => 'ur-pk',  # <URD> <Urdu> <Urdu (Pakistan)>

  0x0820 => 'ur-in',  # <URI> <Urdu> <Urdu (India)>

  0x0443 => 'uz-latn',  # <UZB> <Uzbek> <Uzbek (Latin)>

  0x0843 => 'uz-cyrl',  # <UZC> <Uzbek> <Uzbek (Cyrillic)>

  0x0433 => 'ven'  ,  # <VEN> <Venda> <Venda>

  0x042a => 'vi'   ,  # <VIT> <Vietnamese> <Vietnamese>

  0x0434 => 'xh'   ,  # <XHS> <Xhosa> <Xhosa>

  0x043d => 'yi'   ,  # <JII> <Yiddish> <Yiddish>  # formetly ji

  0x0435 => 'zu'   ,  # <ZUL> <Zulu> <Zulu>

);

#-----------------------------------------------------------------------------

sub get_ms_locale {

  my $locale;

  return unless defined do {

    # see if there's a W32 registry on this machine, and if so, look in it

    local $SIG{"__DIE__"} = "";

    eval '

      use Win32::TieRegistry ();

      my $i18n = Win32::TieRegistry->new(

         "HKEY_CURRENT_USER/Control Panel/International",

         { Delimiter => "/" }

      );

      #print "no key!" unless $i18n;

      $locale = $i18n->GetValue("Locale") if $i18n;

      undef $i18n;

    ';

    #print "<$@>\n" if $@;

    $locale;

  };

  return unless $locale =~ m/^[0-9a-fA-F]+$/s;

  return hex($locale);

}

sub get_language {

  my $lang = $MSLocale2LangTag{ $_[0] || get_ms_locale() || '' };

  return unless $lang;

  return $lang;

}

sub get_locale {

  # I guess this is right.

  my $lang = get_language(@_);

  return unless $lang and $lang =~ m/^[a-z]{2}(?:-[a-z]{2})?$/s;

  # should we try to turn "fi" into "fi_FI"?

  $lang =~ tr/-/_/;

  return $lang;

}

#-----------------------------------------------------------------------------

# If we're just executed...

unless(caller) {

  my $locale = get_ms_locale();

  if($locale) {

    printf "Locale 0x%08x (%s => %s) => Lang %s\n",

      $locale, $locale,

      get_locale($locale)   || '?',

      get_language($locale) || '?',

  } else {

    print "Can't get ms-locale\n";

  }

}

#-----------------------------------------------------------------------------

1;

__END__

=head1 NAME

Win32::Locale - get the current MSWin locale or language

=head1 SYNOPSIS

  use Win32::Locale;

  my $language = Win32::Locale::get_language();

  if($language eq 'en-us') {

    print "Wasaaap homeslice!\n";

  } else {

    print "You $language people ain't FROM around here, are ya?\n";

  }

=head1 DESCRIPTION

This library provides some simple functions allowing Perl under MSWin

to ask what the current locale/language setting is.  (Yes, MSWin

conflates locales and languages, it seems; and the way it's

conflated is even stranger after MSWin98.)

Note that you should be able to safely use this module under any

OS; the functions just won't be able to access any current

locale value.

=head1 FUNCTIONS

Note that these functions are not exported,

nor are they exportable:

=over

=item Win32::Locale::get_language()

Returns the (all-lowercase) RFC3066 language tag corresponding

to the currently currently selected MS locale.

Returns nothing if the MS locale value isn't accessible

(notably, if you're not running under MSWin!), or if it

corresponds to no known language tag.  Example: "en-us".

In list context, this may in the future be made to return

multiple values.

=item Win32::Locale::get_locale()

Returns the (all-lowercase) Unixish locale tag corresponding

to the currently currently selected MS locale.  Example: "en_us".

Returns nothing if the MS locale value isn't accessible

(notably, if you're not running under MSWin!), or if it

corresponds to no locale.

In list context, this may in the future be made to return

multiple values.

Note that this function is B<experimental>, and I greatly welcome

suggestions.

=item Win32::Locale::get_ms_locale()

Returns the MS locale ID code for the currently selected MSWindows

locale.  For example, returns the number 1033 for "US

English".  (You may know the number 1033 better as 0x00000409,

as these numbers are usually given in hex in MS documents).

Returns nothing if the value isn't accessible (notably, if you're

not running under MSWin!).

=item Win32::Locale::get_language($msid)

Returns the (all-lowercase) RFC3066 language tag corresponding

to the given MS locale code, or nothing if none.

In list context, this may in the future be made to return

multiple values.

=item Win32::Locale::get_locale($msid)

Returns the (all-lowercase) Unixish locale tag corresponding

to the given MS locale code, or nothing if none.

In list context, this may in the future be made to return

multiple values.

=back

("Nothing", above, means "in scalar context, undef; in list

context, empty-list".)

=head1 AND MORE

This module provides an (unexported) public hash,

%Win32::Locale::MSLocale2LangTag, that maps

from the MS locale ID code to my idea of the single best corresponding

RFC3066 language tag.

The hash's contents are relatively certain for well-known

languages (US English is "en-us"), but are still experimental

in its finer details (like Konkani being "kok").

=head1 SEE ALSO

L<I18N::LangTags|I18N::LangTags>,

L<I18N::LangTags::List|I18N::LangTags::List>,

L<Locale::Maketext|Locale::Maketext>.

=head1 COPYRIGHT AND DISCLAIMER

Copyright (c) 2001,2003 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but

without any warranty; without even the implied warranty of

merchantability or fitness for a particular purpose.

I am not affiliated with the Microsoft corporation, nor the ActiveState

corporation.

Product and company names mentioned in this document may be the

trademarks or service marks of their respective owners.  Trademarks

and service marks might not be identified as such, although

this must not be construed as anyone's expression of validity

or invalidity of each trademark or service mark.

=head1 AUTHOR

Sean M. Burke C<sburke@cpan.org>

=cut

# No big whoop.