ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/lib/Locale/Script.pm
Revision: 1.1
Committed: Thu Jun 30 14:27:12 2005 UTC (21 years, 3 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #
2     # Locale::Script - ISO codes for script identification (ISO 15924)
3     #
4     # $Id: Script.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
5     #
6    
7     package Locale::Script;
8     use strict;
9     require 5.002;
10    
11     require Exporter;
12     use Carp;
13     use Locale::Constants;
14    
15    
16     #-----------------------------------------------------------------------
17     # Public Global Variables
18     #-----------------------------------------------------------------------
19     use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
20     $VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
21     @ISA = qw(Exporter);
22     @EXPORT = qw(code2script script2code
23     all_script_codes all_script_names
24     script_code2code
25     LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC);
26    
27     #-----------------------------------------------------------------------
28     # Private Global Variables
29     #-----------------------------------------------------------------------
30     my $CODES = [];
31     my $COUNTRIES = [];
32    
33    
34     #=======================================================================
35     #
36     # code2script ( CODE [, CODESET ] )
37     #
38     #=======================================================================
39     sub code2script
40     {
41     my $code = shift;
42     my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
43    
44    
45     return undef unless defined $code;
46    
47     #-------------------------------------------------------------------
48     # Make sure the code is in the right form before we use it
49     # to look up the corresponding script.
50     # We have to sprintf because the codes are given as 3-digits,
51     # with leading 0's. Eg 070 for Egyptian demotic.
52     #-------------------------------------------------------------------
53     if ($codeset == LOCALE_CODE_NUMERIC)
54     {
55     return undef if ($code =~ /\D/);
56     $code = sprintf("%.3d", $code);
57     }
58     else
59     {
60     $code = lc($code);
61     }
62    
63     if (exists $CODES->[$codeset]->{$code})
64     {
65     return $CODES->[$codeset]->{$code};
66     }
67     else
68     {
69     #---------------------------------------------------------------
70     # no such script code!
71     #---------------------------------------------------------------
72     return undef;
73     }
74     }
75    
76    
77     #=======================================================================
78     #
79     # script2code ( SCRIPT [, CODESET ] )
80     #
81     #=======================================================================
82     sub script2code
83     {
84     my $script = shift;
85     my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
86    
87    
88     return undef unless defined $script;
89     $script = lc($script);
90     if (exists $COUNTRIES->[$codeset]->{$script})
91     {
92     return $COUNTRIES->[$codeset]->{$script};
93     }
94     else
95     {
96     #---------------------------------------------------------------
97     # no such script!
98     #---------------------------------------------------------------
99     return undef;
100     }
101     }
102    
103    
104     #=======================================================================
105     #
106     # script_code2code ( CODE, IN-CODESET, OUT-CODESET )
107     #
108     #=======================================================================
109     sub script_code2code
110     {
111     (@_ == 3) or croak "script_code2code() takes 3 arguments!";
112    
113     my $code = shift;
114     my $inset = shift;
115     my $outset = shift;
116     my $outcode;
117     my $script;
118    
119    
120     return undef if $inset == $outset;
121     $script = code2script($code, $inset);
122     return undef if not defined $script;
123     $outcode = script2code($script, $outset);
124     return $outcode;
125     }
126    
127    
128     #=======================================================================
129     #
130     # all_script_codes()
131     #
132     #=======================================================================
133     sub all_script_codes
134     {
135     my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
136    
137     return keys %{ $CODES->[$codeset] };
138     }
139    
140    
141     #=======================================================================
142     #
143     # all_script_names()
144     #
145     #=======================================================================
146     sub all_script_names
147     {
148     my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
149    
150     return values %{ $CODES->[$codeset] };
151     }
152    
153    
154     #=======================================================================
155     #
156     # initialisation code - stuff the DATA into the ALPHA2 hash
157     #
158     #=======================================================================
159     {
160     my ($alpha2, $alpha3, $numeric);
161     my $script;
162     local $_;
163    
164    
165     while (<DATA>)
166     {
167     next unless /\S/;
168     chop;
169     ($alpha2, $alpha3, $numeric, $script) = split(/:/, $_, 4);
170    
171     $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $script;
172     $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$script"} = $alpha2;
173    
174     if ($alpha3)
175     {
176     $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $script;
177     $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$script"} = $alpha3;
178     }
179    
180     if ($numeric)
181     {
182     $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $script;
183     $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$script"} = $numeric;
184     }
185    
186     }
187    
188     close(DATA);
189     }
190    
191     1;
192    
193     __DATA__
194     am:ama:130:Aramaic
195     ar:ara:160:Arabic
196     av:ave:151:Avestan
197     bh:bhm:300:Brahmi (Ashoka)
198     bi:bid:372:Buhid
199     bn:ben:325:Bengali
200     bo:bod:330:Tibetan
201     bp:bpm:285:Bopomofo
202     br:brl:570:Braille
203     bt:btk:365:Batak
204     bu:bug:367:Buginese (Makassar)
205     by:bys:550:Blissymbols
206     ca:cam:358:Cham
207     ch:chu:221:Old Church Slavonic
208     ci:cir:291:Cirth
209     cm:cmn:402:Cypro-Minoan
210     co:cop:205:Coptic
211     cp:cpr:403:Cypriote syllabary
212     cy:cyr:220:Cyrillic
213     ds:dsr:250:Deserel (Mormon)
214     dv:dvn:315:Devanagari (Nagari)
215     ed:egd:070:Egyptian demotic
216     eg:egy:050:Egyptian hieroglyphs
217     eh:egh:060:Egyptian hieratic
218     el:ell:200:Greek
219     eo:eos:210:Etruscan and Oscan
220     et:eth:430:Ethiopic
221     gl:glg:225:Glagolitic
222     gm:gmu:310:Gurmukhi
223     gt:gth:206:Gothic
224     gu:guj:320:Gujarati
225     ha:han:500:Han ideographs
226     he:heb:125:Hebrew
227     hg:hgl:420:Hangul
228     hm:hmo:450:Pahawh Hmong
229     ho:hoo:371:Hanunoo
230     hr:hrg:410:Hiragana
231     hu:hun:176:Old Hungarian runic
232     hv:hvn:175:Kok Turki runic
233     hy:hye:230:Armenian
234     iv:ivl:610:Indus Valley
235     ja:jap:930:(alias for Han + Hiragana + Katakana)
236     jl:jlg:445:Cherokee syllabary
237     jw:jwi:360:Javanese
238     ka:kam:241:Georgian (Mxedruli)
239     kh:khn:931:(alias for Hangul + Han)
240     kk:kkn:411:Katakana
241     km:khm:354:Khmer
242     kn:kan:345:Kannada
243     kr:krn:357:Karenni (Kayah Li)
244     ks:kst:305:Kharoshthi
245     kx:kax:240:Georgian (Xucuri)
246     la:lat:217:Latin
247     lf:laf:215:Latin (Fraktur variant)
248     lg:lag:216:Latin (Gaelic variant)
249     lo:lao:356:Lao
250     lp:lpc:335:Lepcha (Rong)
251     md:mda:140:Mandaean
252     me:mer:100:Meroitic
253     mh:may:090:Mayan hieroglyphs
254     ml:mlm:347:Malayalam
255     mn:mon:145:Mongolian
256     my:mya:350:Burmese
257     na:naa:400:Linear A
258     nb:nbb:401:Linear B
259     og:ogm:212:Ogham
260     or:ory:327:Oriya
261     os:osm:260:Osmanya
262     ph:phx:115:Phoenician
263     ph:pah:150:Pahlavi
264     pl:pld:282:Pollard Phonetic
265     pq:pqd:295:Klingon plQaD
266     pr:prm:227:Old Permic
267     ps:pst:600:Phaistos Disk
268     rn:rnr:211:Runic (Germanic)
269     rr:rro:620:Rongo-rongo
270     sa:sar:110:South Arabian
271     si:sin:348:Sinhala
272     sj:syj:137:Syriac (Jacobite variant)
273     sl:slb:440:Unified Canadian Aboriginal Syllabics
274     sn:syn:136:Syriac (Nestorian variant)
275     sw:sww:281:Shavian (Shaw)
276     sy:syr:135:Syriac (Estrangelo)
277     ta:tam:346:Tamil
278     tb:tbw:373:Tagbanwa
279     te:tel:340:Telugu
280     tf:tfn:120:Tifnagh
281     tg:tag:370:Tagalog
282     th:tha:352:Thai
283     tn:tna:170:Thaana
284     tw:twr:290:Tengwar
285     va:vai:470:Vai
286     vs:vsp:280:Visible Speech
287     xa:xas:000:Cuneiform, Sumero-Akkadian
288     xf:xfa:105:Cuneiform, Old Persian
289     xk:xkn:412:(alias for Hiragana + Katakana)
290     xu:xug:106:Cuneiform, Ugaritic
291     yi:yii:460:Yi
292     zx:zxx:997:Unwritten language
293     zy:zyy:998:Undetermined script
294     zz:zzz:999:Uncoded script