Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
532 | rain-er | 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 |