1N/A#
1N/A# Locale::Script - ISO codes for script identification (ISO 15924)
1N/A#
1N/A# $Id: Script.pm,v 2.2 2002/07/10 16:33:28 neilb Exp $
1N/A#
1N/A
1N/Apackage Locale::Script;
1N/Ause strict;
1N/Arequire 5.002;
1N/A
1N/Arequire Exporter;
1N/Ause Carp;
1N/Ause Locale::Constants;
1N/A
1N/A
1N/A#-----------------------------------------------------------------------
1N/A# Public Global Variables
1N/A#-----------------------------------------------------------------------
1N/Ause vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
1N/A$VERSION = sprintf("%d.%02d", q$Revision: 2.21 $ =~ /(\d+)\.(\d+)/);
1N/A@ISA = qw(Exporter);
1N/A@EXPORT = qw(code2script script2code
1N/A all_script_codes all_script_names
1N/A script_code2code
1N/A LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC);
1N/A
1N/A#-----------------------------------------------------------------------
1N/A# Private Global Variables
1N/A#-----------------------------------------------------------------------
1N/Amy $CODES = [];
1N/Amy $COUNTRIES = [];
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# code2script ( CODE [, CODESET ] )
1N/A#
1N/A#=======================================================================
1N/Asub code2script
1N/A{
1N/A my $code = shift;
1N/A my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
1N/A
1N/A
1N/A return undef unless defined $code;
1N/A
1N/A #-------------------------------------------------------------------
1N/A # Make sure the code is in the right form before we use it
1N/A # to look up the corresponding script.
1N/A # We have to sprintf because the codes are given as 3-digits,
1N/A # with leading 0's. Eg 070 for Egyptian demotic.
1N/A #-------------------------------------------------------------------
1N/A if ($codeset == LOCALE_CODE_NUMERIC)
1N/A {
1N/A return undef if ($code =~ /\D/);
1N/A $code = sprintf("%.3d", $code);
1N/A }
1N/A else
1N/A {
1N/A $code = lc($code);
1N/A }
1N/A
1N/A if (exists $CODES->[$codeset]->{$code})
1N/A {
1N/A return $CODES->[$codeset]->{$code};
1N/A }
1N/A else
1N/A {
1N/A #---------------------------------------------------------------
1N/A # no such script code!
1N/A #---------------------------------------------------------------
1N/A return undef;
1N/A }
1N/A}
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# script2code ( SCRIPT [, CODESET ] )
1N/A#
1N/A#=======================================================================
1N/Asub script2code
1N/A{
1N/A my $script = shift;
1N/A my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
1N/A
1N/A
1N/A return undef unless defined $script;
1N/A $script = lc($script);
1N/A if (exists $COUNTRIES->[$codeset]->{$script})
1N/A {
1N/A return $COUNTRIES->[$codeset]->{$script};
1N/A }
1N/A else
1N/A {
1N/A #---------------------------------------------------------------
1N/A # no such script!
1N/A #---------------------------------------------------------------
1N/A return undef;
1N/A }
1N/A}
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# script_code2code ( CODE, IN-CODESET, OUT-CODESET )
1N/A#
1N/A#=======================================================================
1N/Asub script_code2code
1N/A{
1N/A (@_ == 3) or croak "script_code2code() takes 3 arguments!";
1N/A
1N/A my $code = shift;
1N/A my $inset = shift;
1N/A my $outset = shift;
1N/A my $outcode;
1N/A my $script;
1N/A
1N/A
1N/A return undef if $inset == $outset;
1N/A $script = code2script($code, $inset);
1N/A return undef if not defined $script;
1N/A $outcode = script2code($script, $outset);
1N/A return $outcode;
1N/A}
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# all_script_codes()
1N/A#
1N/A#=======================================================================
1N/Asub all_script_codes
1N/A{
1N/A my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
1N/A
1N/A return keys %{ $CODES->[$codeset] };
1N/A}
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# all_script_names()
1N/A#
1N/A#=======================================================================
1N/Asub all_script_names
1N/A{
1N/A my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
1N/A
1N/A return values %{ $CODES->[$codeset] };
1N/A}
1N/A
1N/A
1N/A#=======================================================================
1N/A#
1N/A# initialisation code - stuff the DATA into the ALPHA2 hash
1N/A#
1N/A#=======================================================================
1N/A{
1N/A my ($alpha2, $alpha3, $numeric);
1N/A my $script;
1N/A
1N/A local $_;
1N/A
1N/A while (<DATA>)
1N/A {
1N/A next unless /\S/;
1N/A chop;
1N/A ($alpha2, $alpha3, $numeric, $script) = split(/:/, $_, 4);
1N/A
1N/A $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $script;
1N/A $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$script"} = $alpha2;
1N/A
1N/A if ($alpha3)
1N/A {
1N/A $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $script;
1N/A $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$script"} = $alpha3;
1N/A }
1N/A
1N/A if ($numeric)
1N/A {
1N/A $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $script;
1N/A $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$script"} = $numeric;
1N/A }
1N/A
1N/A }
1N/A
1N/A close(DATA);
1N/A}
1N/A
1N/A1;
1N/A
1N/A__DATA__
1N/Aam:ama:130:Aramaic
1N/Aar:ara:160:Arabic
1N/Aav:ave:151:Avestan
1N/Abh:bhm:300:Brahmi (Ashoka)
1N/Abi:bid:372:Buhid
1N/Abn:ben:325:Bengali
1N/Abo:bod:330:Tibetan
1N/Abp:bpm:285:Bopomofo
1N/Abr:brl:570:Braille
1N/Abt:btk:365:Batak
1N/Abu:bug:367:Buginese (Makassar)
1N/Aby:bys:550:Blissymbols
1N/Aca:cam:358:Cham
1N/Ach:chu:221:Old Church Slavonic
1N/Aci:cir:291:Cirth
1N/Acm:cmn:402:Cypro-Minoan
1N/Aco:cop:205:Coptic
1N/Acp:cpr:403:Cypriote syllabary
1N/Acy:cyr:220:Cyrillic
1N/Ads:dsr:250:Deserel (Mormon)
1N/Adv:dvn:315:Devanagari (Nagari)
1N/Aed:egd:070:Egyptian demotic
1N/Aeg:egy:050:Egyptian hieroglyphs
1N/Aeh:egh:060:Egyptian hieratic
1N/Ael:ell:200:Greek
1N/Aeo:eos:210:Etruscan and Oscan
1N/Aet:eth:430:Ethiopic
1N/Agl:glg:225:Glagolitic
1N/Agm:gmu:310:Gurmukhi
1N/Agt:gth:206:Gothic
1N/Agu:guj:320:Gujarati
1N/Aha:han:500:Han ideographs
1N/Ahe:heb:125:Hebrew
1N/Ahg:hgl:420:Hangul
1N/Ahm:hmo:450:Pahawh Hmong
1N/Aho:hoo:371:Hanunoo
1N/Ahr:hrg:410:Hiragana
1N/Ahu:hun:176:Old Hungarian runic
1N/Ahv:hvn:175:Kok Turki runic
1N/Ahy:hye:230:Armenian
1N/Aiv:ivl:610:Indus Valley
1N/Aja:jap:930:(alias for Han + Hiragana + Katakana)
1N/Ajl:jlg:445:Cherokee syllabary
1N/Ajw:jwi:360:Javanese
1N/Aka:kam:241:Georgian (Mxedruli)
1N/Akh:khn:931:(alias for Hangul + Han)
1N/Akk:kkn:411:Katakana
1N/Akm:khm:354:Khmer
1N/Akn:kan:345:Kannada
1N/Akr:krn:357:Karenni (Kayah Li)
1N/Aks:kst:305:Kharoshthi
1N/Akx:kax:240:Georgian (Xucuri)
1N/Ala:lat:217:Latin
1N/Alf:laf:215:Latin (Fraktur variant)
1N/Alg:lag:216:Latin (Gaelic variant)
1N/Alo:lao:356:Lao
1N/Alp:lpc:335:Lepcha (Rong)
1N/Amd:mda:140:Mandaean
1N/Ame:mer:100:Meroitic
1N/Amh:may:090:Mayan hieroglyphs
1N/Aml:mlm:347:Malayalam
1N/Amn:mon:145:Mongolian
1N/Amy:mya:350:Burmese
1N/Ana:naa:400:Linear A
1N/Anb:nbb:401:Linear B
1N/Aog:ogm:212:Ogham
1N/Aor:ory:327:Oriya
1N/Aos:osm:260:Osmanya
1N/Aph:phx:115:Phoenician
1N/Aph:pah:150:Pahlavi
1N/Apl:pld:282:Pollard Phonetic
1N/Apq:pqd:295:Klingon plQaD
1N/Apr:prm:227:Old Permic
1N/Aps:pst:600:Phaistos Disk
1N/Arn:rnr:211:Runic (Germanic)
1N/Arr:rro:620:Rongo-rongo
1N/Asa:sar:110:South Arabian
1N/Asi:sin:348:Sinhala
1N/Asj:syj:137:Syriac (Jacobite variant)
1N/Asl:slb:440:Unified Canadian Aboriginal Syllabics
1N/Asn:syn:136:Syriac (Nestorian variant)
1N/Asw:sww:281:Shavian (Shaw)
1N/Asy:syr:135:Syriac (Estrangelo)
1N/Ata:tam:346:Tamil
1N/Atb:tbw:373:Tagbanwa
1N/Ate:tel:340:Telugu
1N/Atf:tfn:120:Tifnagh
1N/Atg:tag:370:Tagalog
1N/Ath:tha:352:Thai
1N/Atn:tna:170:Thaana
1N/Atw:twr:290:Tengwar
1N/Ava:vai:470:Vai
1N/Avs:vsp:280:Visible Speech
1N/Axa:xas:000:Cuneiform, Sumero-Akkadian
1N/Axf:xfa:105:Cuneiform, Old Persian
1N/Axk:xkn:412:(alias for Hiragana + Katakana)
1N/Axu:xug:106:Cuneiform, Ugaritic
1N/Ayi:yii:460:Yi
1N/Azx:zxx:997:Unwritten language
1N/Azy:zyy:998:Undetermined script
1N/Azz:zzz:999:Uncoded script