From: Jarkko Hietaniemi Date: Thu, 15 Mar 2001 14:54:23 +0000 (+0000) Subject: Add Locale::Codes 1.06, from Neil Bowers. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=47a334e99a6f8afdee73613c4a17ed090015ff78;p=p5sagit%2Fp5-mst-13.2.git Add Locale::Codes 1.06, from Neil Bowers. p4raw-id: //depot/perl@9170 --- diff --git a/MANIFEST b/MANIFEST index 55f90cf..5c750ea 100644 --- a/MANIFEST +++ b/MANIFEST @@ -721,6 +721,10 @@ lib/Getopt/Std.pm Fetch command options (getopt, getopts) lib/I18N/Collate.pm Routines to do strxfrm-based collation lib/IPC/Open2.pm Open a two-ended pipe lib/IPC/Open3.pm Open a three-ended pipe! +lib/Locale/Constants.pm Locale::Codes +lib/Locale/Country.pm Locale::Codes +lib/Locale/Currency.pm Locale::Codes +lib/Locale/Language.pm Locale::Codes lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/Complex.pm A Complex package @@ -1475,6 +1479,12 @@ t/lib/io_udp.t See if UDP socket-related methods from IO work t/lib/io_unix.t See if UNIX socket-related methods from IO work t/lib/io_xs.t See if XSUB methods from IO work t/lib/ipc_sysv.t See if IPC::SysV works +t/lib/lc-all.t See if Locale::Codes work +t/lib/lc-constants.t See if Locale::Codes work +t/lib/lc-country.t See if Locale::Codes work +t/lib/lc-currency.t See if Locale::Codes work +t/lib/lc-language.t See if Locale::Codes work +t/lib/lc-uk.t See if Locale::Codes work t/lib/ndbm.t See if NDBM_File works t/lib/net-hostent.t See if Net::hostent works t/lib/odbm.t See if ODBM_File works diff --git a/lib/Locale/Constants.pm b/lib/Locale/Constants.pm new file mode 100644 index 0000000..cc11969 --- /dev/null +++ b/lib/Locale/Constants.pm @@ -0,0 +1,94 @@ +package Locale::Constants; +# +# Locale::Constants - defined constants for identifying codesets +# +# $Id: Constants.pm,v 1.1 2001/03/04 17:58:15 neilb Exp $ +# + +use strict; + +require Exporter; + +use vars qw($VERSION @ISA @EXPORT); +@ISA = qw(Exporter); +@EXPORT = qw(LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC + LOCALE_CODE_DEFAULT); + +use constant LOCALE_CODE_ALPHA_2 => 1; +use constant LOCALE_CODE_ALPHA_3 => 2; +use constant LOCALE_CODE_NUMERIC => 3; + +use constant LOCALE_CODE_DEFAULT => LOCALE_CODE_ALPHA_2; + +1; + +__END__ + +=head1 NAME + +Locale::Constants - constants for Locale codes + +=head1 SYNOPSIS + + use Locale::Constants; + + $codeset = LOCALE_CODE_ALPHA_2; + +=head1 DESCRIPTION + +B defines symbols which are used in +the three modules from the Locale-Codes distribution: + + Locale::Language + Locale::Country + Locale::Currency + +B at the moment only Locale::Country supports +more than one code set. + +The symbols defined are used to specify which codes you +want to be used: + + LOCALE_CODE_ALPHA_2 + LOCALE_CODE_ALPHA_3 + LOCALE_CODE_NUMERIC + +You shouldn't have to C this module directly yourself - +it is used by the three Locale modules, which in turn export +the symbols. + +=head1 KNOWN BUGS AND LIMITATIONS + +None at the moment. + +=head1 SEE ALSO + +=over 4 + +=item Locale::Language + +Codes for identification of languages. + +=item Locale::Country + +Codes for identification of countries. + +=item Locale::Currency + +Codes for identification of currencies and funds. + +=back + +=head1 AUTHOR + +Neil Bowers Eneilb@cre.canon.co.ukE + +=head1 COPYRIGHT + +Copyright (C) 2001, Canon Research Centre Europe (CRE). + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + diff --git a/lib/Locale/Country.pm b/lib/Locale/Country.pm new file mode 100644 index 0000000..f60b135 --- /dev/null +++ b/lib/Locale/Country.pm @@ -0,0 +1,702 @@ +#----------------------------------------------------------------------- + +=head1 NAME + +Locale::Country - ISO codes for country identification (ISO 3166) + +=head1 SYNOPSIS + + use Locale::Country; + + $country = code2country('jp'); # $country gets 'Japan' + $code = country2code('Norway'); # $code gets 'no' + + @codes = all_country_codes(); + @names = all_country_names(); + + # add "uk" as a pseudo country code for United Kingdom + Locale::Country::_alias_code('uk' => 'gb'); + +=cut + +#----------------------------------------------------------------------- + +package Locale::Country; +use strict; +require 5.002; + +#----------------------------------------------------------------------- + +=head1 DESCRIPTION + +The C module provides access to the ISO +codes for identifying countries, as defined in ISO 3166. +You can either access the codes via the L +(described below), or with the two functions which return lists +of all country codes or all country names. + +There are three different code sets you can use for identifying +countries: + +=over 4 + +=item B + +Two letter codes, such as 'tv' for Tuvalu. +This code set is identified with the symbol C. + +=item B + +Three letter codes, such as 'brb' for Barbados. +This code set is identified with the symbol C. + +=item B + +Numeric codes, such as 064 for Bhutan. +This code set is identified with the symbol C. + +=back + +All of the routines take an optional additional argument +which specifies the code set to use. +If not specified, it defaults to the two-letter codes. +This is partly for backwards compatibility (previous versions +of this module only supported the alpha-2 codes), and +partly because they are the most widely used codes. + +The alpha-2 and alpha-3 codes are not case-dependent, +so you can use 'BO', 'Bo', 'bO' or 'bo' for Bolivia. +When a code is returned by one of the functions in +this module, it will always be lower-case. + +=cut + +#----------------------------------------------------------------------- + +require Exporter; +use Carp; +use Locale::Constants; + + +#----------------------------------------------------------------------- +# Public Global Variables +#----------------------------------------------------------------------- +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +$VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); +@ISA = qw(Exporter); +@EXPORT = qw(code2country country2code + all_country_codes all_country_names + country_code2code + LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC); + +#----------------------------------------------------------------------- +# Private Global Variables +#----------------------------------------------------------------------- +my $CODES = []; +my $COUNTRIES = []; + + +#======================================================================= + +=head1 CONVERSION ROUTINES + +There are three conversion routines: C, C, +and C. + +=over 8 + +=item code2country( CODE, [ CODESET ] ) + +This function takes a country code and returns a string +which contains the name of the country identified. +If the code is not a valid country code, as defined by ISO 3166, +then C will be returned: + + $country = code2country('fi'); + +=item country2code( STRING, [ CODESET ] ) + +This function takes a country name and returns the corresponding +country code, if such exists. +If the argument could not be identified as a country name, +then C will be returned: + + $code = country2code('Norway', LOCALE_CODE_ALPHA_3); + # $code will now be 'nor' + +The case of the country name is not important. +See the section L below. + +=item country_code2code( CODE, CODESET, CODESET ) + +This function takes a country code from one code set, +and returns the corresponding code from another code set. + + $alpha2 = country_code2code('fin', + LOCALE_CODE_ALPHA_3 => LOCALE_CODE_ALPHA_2); + # $alpha2 will now be 'fi' + +If the code passed is not a valid country code in +the first code set, or if there isn't a code for the +corresponding country in the second code set, +then C will be returned. + +=back + +=cut + +#======================================================================= +sub code2country +{ + my $code = shift; + my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; + + + return undef unless defined $code; + + #------------------------------------------------------------------- + # Make sure the code is in the right form before we use it + # to look up the corresponding country. + # We have to sprintf because the codes are given as 3-digits, + # with leading 0's. Eg 052 for Barbados. + #------------------------------------------------------------------- + if ($codeset == LOCALE_CODE_NUMERIC) + { + return undef if ($code =~ /\D/); + $code = sprintf("%.3d", $code); + } + else + { + $code = lc($code); + } + + if (exists $CODES->[$codeset]->{$code}) + { + return $CODES->[$codeset]->{$code}; + } + else + { + #--------------------------------------------------------------- + # no such country code! + #--------------------------------------------------------------- + return undef; + } +} + +sub country2code +{ + my $country = shift; + my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; + + + return undef unless defined $country; + $country = lc($country); + if (exists $COUNTRIES->[$codeset]->{$country}) + { + return $COUNTRIES->[$codeset]->{$country}; + } + else + { + #--------------------------------------------------------------- + # no such country! + #--------------------------------------------------------------- + return undef; + } +} + +sub country_code2code +{ + (@_ == 3) or croak "country_code2code() takes 3 arguments!"; + + my $code = shift; + my $inset = shift; + my $outset = shift; + my $outcode = shift; + my $country; + + + return undef if $inset == $outset; + $country = code2country($code, $inset); + return undef if not defined $country; + $outcode = country2code($country, $outset); + return $outcode; +} + +#======================================================================= + +=head1 QUERY ROUTINES + +There are two function which can be used to obtain a list of all codes, +or all country names: + +=over 8 + +=item C + +Returns a list of all two-letter country codes. +The codes are guaranteed to be all lower-case, +and not in any particular order. + +=item C + +Returns a list of all country names for which there is a corresponding +country code in the specified code set. +The names are capitalised, and not returned in any particular order. + +Not all countries have alpha-3 and numeric codes - +some just have an alpha-2 code, +so you'll get a different number of countries +depending on which code set you specify. + +=back + +=cut + +#======================================================================= +sub all_country_codes +{ + my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; + + return keys %{ $CODES->[$codeset] }; +} + +sub all_country_names +{ + my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; + + return values %{ $CODES->[$codeset] }; +} + +#----------------------------------------------------------------------- + +=head1 CODE ALIASING + +This module supports a semi-private routine for specifying two letter +code aliases. + + Locale::Country::_alias_code( ALIAS => CODE [, CODESET ] ) + +This feature was added as a mechanism for handling +a "uk" code. The ISO standard says that the two-letter code for +"United Kingdom" is "gb", whereas domain names are all .uk. + +By default the module does not understand "uk", since it is implementing +an ISO standard. If you would like 'uk' to work as the two-letter +code for United Kingdom, use the following: + + use Locale::Country; + + Locale::Country::_alias_code('uk' => 'gb'); + +With this code, both "uk" and "gb" are valid codes for United Kingdom, +with the reverse lookup returning "uk" rather than the usual "gb". + +=cut + +#----------------------------------------------------------------------- + +sub _alias_code +{ + my $alias = shift; + my $real = shift; + my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT; + + my $country; + + + if (not exists $CODES->[$codeset]->{$real}) + { + carp "attempt to alias \"$alias\" to unknown country code \"$real\"\n"; + return undef; + } + $country = $CODES->[$codeset]->{$real}; + $CODES->[$codeset]->{$alias} = $country; + $COUNTRIES->[$codeset]->{"\L$country"} = $alias; + + return $alias; +} + +#----------------------------------------------------------------------- + +=head1 EXAMPLES + +The following example illustrates use of the C function. +The user is prompted for a country code, and then told the corresponding +country name: + + $| = 1; # turn off buffering + + print "Enter country code: "; + chop($code = ); + $country = code2country($code, LOCALE_CODE_ALPHA_2); + if (defined $country) + { + print "$code = $country\n"; + } + else + { + print "'$code' is not a valid country code!\n"; + } + +=head1 DOMAIN NAMES + +Most top-level domain names are based on these codes, +but there are certain codes which aren't. +If you are using this module to identify country from hostname, +your best bet is to preprocess the country code. + +For example, B, B, B and friends would map to B; +B would map to B. Any others? + +=head1 KNOWN BUGS AND LIMITATIONS + +=over 4 + +=item * + +When using C, the country name must currently appear +exactly as it does in the source of the module. For example, + + country2code('United States') + +will return B, as expected. But the following will all return C: + + country2code('United States of America') + country2code('Great Britain') + country2code('U.S.A.') + +If there's need for it, a future version could have variants +for country names. + +=item * + +In the current implementation, all data is read in when the +module is loaded, and then held in memory. +A lazy implementation would be more memory friendly. + +=back + +=head1 SEE ALSO + +=over 4 + +=item Locale::Language + +ISO two letter codes for identification of language (ISO 639). + +=item Locale::Currency + +ISO three letter codes for identification of currencies +and funds (ISO 4217). + +=item ISO 3166 + +The ISO standard which defines these codes. + +=item http://www.din.de/gremien/nas/nabd/iso3166ma/ + +Official home page for ISO 3166 + +=item http://www.egt.ie/standards/iso3166/iso3166-1-en.html + +Another useful, but not official, home page. + +=item http://www.cia.gov/cia/publications/factbook/docs/app-f.html + +An appendix in the CIA world fact book which lists country codes +as defined by ISO 3166, FIPS 10-4, and internet domain names. + +=back + + +=head1 AUTHOR + +Neil Bowers Eneilb@cre.canon.co.ukE + +=head1 COPYRIGHT + +Copyright (c) 1997-2001 Canon Research Centre Europe (CRE). + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +#----------------------------------------------------------------------- + +#======================================================================= +# initialisation code - stuff the DATA into the ALPHA2 hash +#======================================================================= +{ + my ($alpha2, $alpha3, $numeric); + my $country; + + + while () + { + next unless /\S/; + chop; + ($alpha2, $alpha3, $numeric, $country) = split(/:/, $_, 4); + + $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $country; + $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$country"} = $alpha2; + + if ($alpha3) + { + $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $country; + $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$country"} = $alpha3; + } + + if ($numeric) + { + $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $country; + $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$country"} = $numeric; + } + + } +} + +1; + +__DATA__ +ad:and:020:Andorra +ae:are:784:United Arab Emirates +af:afg:004:Afghanistan +ag:atg:028:Antigua and Barbuda +ai:aia:660:Anguilla +al:alb:008:Albania +am:arm:051:Armenia +an:ant:530:Netherlands Antilles +ao:ago:024:Angola +aq:::Antarctica +ar:arg:032:Argentina +as:asm:016:American Samoa +at:aut:040:Austria +au:aus:036:Australia +aw:abw:533:Aruba +az:aze:031:Azerbaijan +ba:bih:070:Bosnia and Herzegovina +bb:brb:052:Barbados +bd:bgd:050:Bangladesh +be:bel:056:Belgium +bf:bfa:854:Burkina Faso +bg:bgr:100:Bulgaria +bh:bhr:048:Bahrain +bi:bdi:108:Burundi +bj:ben:204:Benin +bm:bmu:060:Bermuda +bn:brn:096:Brunei Darussalam +bo:bol:068:Bolivia +br:bra:076:Brazil +bs:bhs:044:Bahamas +bt:btn:064:Bhutan +bv:::Bouvet Island +bw:bwa:072:Botswana +by:blr:112:Belarus +bz:blz:084:Belize +ca:can:124:Canada +cc:::Cocos (Keeling) Islands +cd:cod:180:Congo, The Democratic Republic of the +cf:caf:140:Central African Republic +cg:cog:178:Congo +ch:che:756:Switzerland +ci:civ:384:Cote D'Ivoire +ck:cok:184:Cook Islands +cl:chl:152:Chile +cm:cmr:120:Cameroon +cn:chn:156:China +co:col:170:Colombia +cr:cri:188:Costa Rica +cu:cub:192:Cuba +cv:cpv:132:Cape Verde +cx:::Christmas Island +cy:cyp:196:Cyprus +cz:cze:203:Czech Republic +de:deu:276:Germany +dj:dji:262:Djibouti +dk:dnk:208:Denmark +dm:dma:212:Dominica +do:dom:214:Dominican Republic +dz:dza:012:Algeria +ec:ecu:218:Ecuador +ee:est:233:Estonia +eg:egy:818:Egypt +eh:esh:732:Western Sahara +er:eri:232:Eritrea +es:esp:724:Spain +et:eth:231:Ethiopia +fi:fin:246:Finland +fj:fji:242:Fiji +fk:flk:238:Falkland Islands (Malvinas) +fm:fsm:583:Micronesia, Federated States of +fo:fro:234:Faroe Islands +fr:fra:250:France +fx:::France, Metropolitan +ga:gab:266:Gabon +gb:gbr:826:United Kingdom +gd:grd:308:Grenada +ge:geo:268:Georgia +gf:guf:254:French Guiana +gh:gha:288:Ghana +gi:gib:292:Gibraltar +gl:grl:304:Greenland +gm:gmb:270:Gambia +gn:gin:324:Guinea +gp:glp:312:Guadeloupe +gq:gnq:226:Equatorial Guinea +gr:grc:300:Greece +gs:::South Georgia and the South Sandwich Islands +gt:gtm:320:Guatemala +gu:gum:316:Guam +gw:gnb:624:Guinea-Bissau +gy:guy:328:Guyana +hk:hkg:344:Hong Kong +hm:::Heard Island and McDonald Islands +hn:hnd:340:Honduras +hr:hrv:191:Croatia +ht:hti:332:Haiti +hu:hun:348:Hungary +id:idn:360:Indonesia +ie:irl:372:Ireland +il:isr:376:Israel +in:ind:356:India +io:::British Indian Ocean Territory +iq:irq:368:Iraq +ir:irn:364:Iran, Islamic Republic of +is:isl:352:Iceland +it:ita:380:Italy +jm:jam:388:Jamaica +jo:jor:400:Jordan +jp:jpn:392:Japan +ke:ken:404:Kenya +kg:kgz:417:Kyrgyzstan +kh:khm:116:Cambodia +ki:kir:296:Kiribati +km:com:174:Comoros +kn:kna:659:Saint Kitts and Nevis +kp:prk:408:Korea, Democratic People's Republic of +kr:kor:410:Korea, Republic of +kw:kwt:414:Kuwait +ky:cym:136:Cayman Islands +kz:kaz:398:Kazakstan +la:lao:418:Lao People's Democratic Republic +lb:lbn:422:Lebanon +lc:lca:662:Saint Lucia +li:lie:438:Liechtenstein +lk:lka:144:Sri Lanka +lr:lbr:430:Liberia +ls:lso:426:Lesotho +lt:ltu:440:Lithuania +lu:lux:442:Luxembourg +lv:lva:428:Latvia +ly:lby:434:Libyan Arab Jamahiriya +ma:mar:504:Morocco +mc:mco:492:Monaco +md:mda:498:Moldova, Republic of +mg:mdg:450:Madagascar +mh:mhl:584:Marshall Islands +mk:mkd:807:Macedonia, the Former Yugoslav Republic of +ml:mli:466:Mali +mm:mmr:104:Myanmar +mn:mng:496:Mongolia +mo:mac:446:Macau +mp:mnp:580:Northern Mariana Islands +mq:mtq:474:Martinique +mr:mrt:478:Mauritania +ms:msr:500:Montserrat +mt:mlt:470:Malta +mu:mus:480:Mauritius +mv:mdv:462:Maldives +mw:mwi:454:Malawi +mx:mex:484:Mexico +my:mys:458:Malaysia +mz:moz:508:Mozambique +na:nam:516:Namibia +nc:ncl:540:New Caledonia +ne:ner:562:Niger +nf:nfk:574:Norfolk Island +ng:nga:566:Nigeria +ni:nic:558:Nicaragua +nl:nld:528:Netherlands +no:nor:578:Norway +np:npl:524:Nepal +nr:nru:520:Nauru +nu:niu:570:Niue +nz:nzl:554:New Zealand +om:omn:512:Oman +pa:pan:591:Panama +pe:per:604:Peru +pf:pyf:258:French Polynesia +pg:png:598:Papua New Guinea +ph:phl:608:Philippines +pk:pak:586:Pakistan +pl:pol:616:Poland +pm:spm:666:Saint Pierre and Miquelon +pn:pcn:612:Pitcairn +pr:pri:630:Puerto Rico +ps:pse:275:Palestinian Territory, Occupied +pt:prt:620:Portugal +pw:plw:585:Palau +py:pry:600:Paraguay +qa:qat:634:Qatar +re:reu:638:Reunion +ro:rom:642:Romania +ru:rus:643:Russian Federation +rw:rwa:646:Rwanda +sa:sau:682:Saudi Arabia +sb:slb:090:Solomon Islands +sc:syc:690:Seychelles +sd:sdn:736:Sudan +se:swe:752:Sweden +sg:sgp:702:Singapore +sh:shn:654:Saint Helena +si:svn:705:Slovenia +sj:sjm:744:Svalbard and Jan Mayen +sk:svk:703:Slovakia +sl:sle:694:Sierra Leone +sm:smr:674:San Marino +sn:sen:686:Senegal +so:som:706:Somalia +sr:sur:740:Suriname +st:stp:678:Sao Tome and Principe +sv:slv:222:El Salvador +sy:syr:760:Syrian Arab Republic +sz:swz:748:Swaziland +tc:tca:796:Turks and Caicos Islands +td:tcd:148:Chad +tf:::French Southern Territories +tg:tgo:768:Togo +th:tha:764:Thailand +tj:tjk:762:Tajikistan +tk:tkl:772:Tokelau +tm:tkm:795:Turkmenistan +tn:tun:788:Tunisia +to:ton:776:Tonga +tp:tmp:626:East Timor +tr:tur:792:Turkey +tt:tto:780:Trinidad and Tobago +tv:tuv:798:Tuvalu +tw:twn:158:Taiwan, Province of China +tz:tza:834:Tanzania, United Republic of +ua:ukr:804:Ukraine +ug:uga:800:Uganda +um:::United States Minor Outlying Islands +us:usa:840:United States +uy:ury:858:Uruguay +uz:uzb:860:Uzbekistan +va:vat:336:Holy See (Vatican City State) +vc:vct:670:Saint Vincent and the Grenadines +ve:ven:862:Venezuela +vg:vgb:092:Virgin Islands, British +vi:vir:850:Virgin Islands, U.S. +vn:vnm:704:Vietnam +vu:vut:548:Vanuatu +wf:wlf:876:Wallis and Futuna +ws:wsm:882:Samoa +ye:yem:887:Yemen +yt:::Mayotte +yu:yug:891:Yugoslavia +za:zaf:710:South Africa +zm:zmb:894:Zambia +zr:::Zaire +zw:zwe:716:Zimbabwe diff --git a/lib/Locale/Currency.pm b/lib/Locale/Currency.pm new file mode 100644 index 0000000..054ac1b --- /dev/null +++ b/lib/Locale/Currency.pm @@ -0,0 +1,529 @@ +#----------------------------------------------------------------------- + +=head1 NAME + +Locale::Currency - ISO three letter codes for currency identification (ISO 4217) + +=head1 SYNOPSIS + + use Locale::Currency; + + $curr = code2currency('usd'); # $curr gets 'US Dollar' + $code = currency2code('Euro'); # $code gets 'eur' + + @codes = all_currency_codes(); + @names = all_currency_names(); + +=cut + +#----------------------------------------------------------------------- + +package Locale::Currency; +use strict; +require 5.002; + +#----------------------------------------------------------------------- + +=head1 DESCRIPTION + +The C module provides access to the ISO three-letter +codes for identifying currencies and funds, as defined in ISO 4217. +You can either access the codes via the L +(described below), +or with the two functions which return lists of all currency codes or +all currency names. + +There are two special codes defined by the standard which aren't +understood by this module: + +=over 4 + +=item XTS + +Specifically reserved for testing purposes. + +=item XXX + +For transactions where no currency is involved. + +=back + +=cut + +#----------------------------------------------------------------------- + +require Exporter; + +#----------------------------------------------------------------------- +# Public Global Variables +#----------------------------------------------------------------------- +use vars qw($VERSION @ISA @EXPORT); +$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); +@ISA = qw(Exporter); +@EXPORT = qw(&code2currency ¤cy2code + &all_currency_codes &all_currency_names ); + +#----------------------------------------------------------------------- +# Private Global Variables +#----------------------------------------------------------------------- +my %CODES = (); +my %CURRENCIES = (); + + +#======================================================================= + +=head1 CONVERSION ROUTINES + +There are two conversion routines: C and C. + +=over 8 + +=item code2currency() + +This function takes a three letter currency code and returns a string +which contains the name of the currency identified. If the code is +not a valid currency code, as defined by ISO 4217, then C +will be returned. + + $curr = code2currency($code); + +=item currency2code() + +This function takes a currency name and returns the corresponding +three letter currency code, if such exists. +If the argument could not be identified as a currency name, +then C will be returned. + + $code = currency2code('French Franc'); + +The case of the currency name is not important. +See the section L below. + +=back + +=cut + +#======================================================================= +sub code2currency +{ + my $code = shift; + + + return undef unless defined $code; + $code = lc($code); + if (exists $CODES{$code}) + { + return $CODES{$code}; + } + else + { + #--------------------------------------------------------------- + # no such currency code! + #--------------------------------------------------------------- + return undef; + } +} + +sub currency2code +{ + my $curr = shift; + + + return undef unless defined $curr; + $curr = lc($curr); + if (exists $CURRENCIES{$curr}) + { + return $CURRENCIES{$curr}; + } + else + { + #--------------------------------------------------------------- + # no such currency! + #--------------------------------------------------------------- + return undef; + } +} + +#======================================================================= + +=head1 QUERY ROUTINES + +There are two function which can be used to obtain a list of all +currency codes, or all currency names: + +=over 8 + +=item C + +Returns a list of all three-letter currency codes. +The codes are guaranteed to be all lower-case, +and not in any particular order. + +=item C + +Returns a list of all currency names for which there is a corresponding +three-letter currency code. The names are capitalised, and not returned +in any particular order. + +=back + +=cut + +#======================================================================= +sub all_currency_codes +{ + return keys %CODES; +} + +sub all_currency_names +{ + return values %CODES; +} + +#----------------------------------------------------------------------- + +=head1 EXAMPLES + +The following example illustrates use of the C function. +The user is prompted for a currency code, and then told the corresponding +currency name: + + $| = 1; # turn off buffering + + print "Enter currency code: "; + chop($code = ); + $curr = code2currency($code); + if (defined $curr) + { + print "$code = $curr\n"; + } + else + { + print "'$code' is not a valid currency code!\n"; + } + +=head1 KNOWN BUGS AND LIMITATIONS + +=over 4 + +=item * + +In the current implementation, all data is read in when the +module is loaded, and then held in memory. +A lazy implementation would be more memory friendly. + +=item * + +This module also includes the special codes which are +not for a currency, such as Gold, Platinum, etc. +This might cause a problem if you're using this module +to display a list of currencies. +Let Neil know if this does cause a problem, and we can +do something about it. + +=item * + +ISO 4217 also defines a numeric code for each currency. +Currency codes are not currently supported by this module. + +=item * + +There are three cases where there is more than one +code for the same currency name. +Kwacha has two codes: mwk for Malawi, and zmk for Zambia. +The Russian Ruble has two codes: rub and rur. +The Belarussian Ruble has two codes: byr and byb. +The currency2code() function only returns one code, so +you might not get back the code you expected. + +=back + +=head1 SEE ALSO + +=over 4 + +=item Locale::Country + +ISO codes for identification of country (ISO 3166). +Supports alpha-2, alpha-3, and numeric codes. +The currency codes use the alpha-2 codeset. + +=item ISO 4217:1995 + +Code for the representation of currencies and funds. + +=item http://www.bsi-global.com/iso4217currency + +Official web page for the ISO 4217 maintenance agency. +This has the latest list of codes, in MS Word format. Boo. + +=back + +=head1 AUTHOR + +Michael Hennecke Ehennecke@rz.uni-karlsruhe.deE +and +Neil Bowers Eneilb@cre.canon.co.ukE + +=head1 COPYRIGHT + +Copyright (c) 2001 Michael Hennecke and +Canon Research Centre Europe (CRE). + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +#----------------------------------------------------------------------- + +#======================================================================= +# initialisation code - stuff the DATA into the CODES hash +#======================================================================= +{ + my $code; + my $currency; + + + while () + { + next unless /\S/; + chop; + ($code, $currency) = split(/:/, $_, 2); + $CODES{$code} = $currency; + $CURRENCIES{"\L$currency"} = $code; + } +} + +1; + +__DATA__ +adp:Andorran Peseta +aed:UAE Dirham +afa:Afghani +all:Lek +amd:Armenian Dram +ang:Netherlands Antillean Guilder +aoa:Kwanza +aon:New Kwanza +aor:Kwanza Reajustado +ars:Argentine Peso +ats:Schilling +aud:Australian Dollar +awg:Aruban Guilder +azm:Azerbaijanian Manat + +bam:Convertible Marks +bbd:Barbados Dollar +bdt:Taka +bef:Belgian Franc +bgl:Lev +bgn:Bulgarian Lev +bhd:Bahraini Dinar +bhd:Dinar +bif:Burundi Franc +bmd:Bermudian Dollar +bnd:Brunei Dollar +bob:Boliviano +bov:MVDol +brl:Brazilian Real +bsd:Bahamian Dollar +btn:Ngultrum +bwp:Pula +byb:Belarussian Ruble +byr:Belarussian Ruble +bzd:Belize Dollar + +cad:Candian Dollar +cdf:Franc Congolais +chf:Swiss Franc +clf:Unidades de Formento +clp:Chilean Peso +cny:Yuan Renminbi +cop:Colombian Peso +crc:Costa Rican Colon +cup:Cuban Peso +cve:Cape Verde Escudo +cyp:Cyprus Pound +czk:Czech Koruna + +dem:German Mark +djf:Djibouti Franc +dkk:Danish Krone +dop:Dominican Peso +dzd:Algerian Dinar + +ecs:Sucre +ecv:Unidad de Valor Constante (UVC) +eek:Kroon +egp:Egyptian Pound +ern:Nakfa +esp:Spanish Peseta +etb:Ethiopian Birr +eur:Euro + +fim:Markka +fjd:Fiji Dollar +fkp:Falkland Islands Pound +frf:French Franc + +gbp:Pound Sterling +gel:Lari +ghc:Cedi +gip:Gibraltar Pound +gmd:Dalasi +gnf:Guinea Franc +grd:Drachma +gtq:Quetzal +gwp:Guinea-Bissau Peso +gyd:Guyana Dollar + +hkd:Hong Kong Dollar +hnl:Lempira +hrk:Kuna +htg:Gourde +huf:Forint + +idr:Rupiah +iep:Irish Pound +ils:Shekel +inr:Indian Rupee +iqd:Iraqi Dinar +irr:Iranian Rial +isk:Iceland Krona +itl:Italian Lira + +jmd:Jamaican Dollar +jod:Jordanian Dinar +jpy:Yen + +kes:Kenyan Shilling +kgs:Som +khr:Riel +kmf:Comoro Franc +kpw:North Korean Won +krw:Won +kwd:Kuwaiti Dinar +kyd:Cayman Islands Dollar +kzt:Tenge + +lak:Kip +lbp:Lebanese Pound +lkr:Sri Lanka Rupee +lrd:Liberian Dollar +lsl:Loti +ltl:Lithuanian Litas +luf:Luxembourg Franc +lvl:Latvian Lats +lyd:Libyan Dinar + +mad:Moroccan Dirham +mdl:Moldovan Leu +mgf:Malagasy Franc +mkd:Denar +mmk:Kyat +mnt:Tugrik +mop:Pataca +mro:Ouguiya +mtl:Maltese Lira +mur:Mauritius Rupee +mvr:Rufiyaa +mwk:Kwacha +mxn:Mexican Nuevo Peso +myr:Malaysian Ringgit +mzm:Metical + +nad:Namibia Dollar +ngn:Naira +nio:Cordoba Oro +nlg:Netherlands Guilder +nok:Norwegian Krone +npr:Nepalese Rupee +nzd:New Zealand Dollar + +omr:Rial Omani + +pab:Balboa +pen:Nuevo Sol +pgk:Kina +php:Philippine Peso +pkr:Pakistan Rupee +pln:Zloty +pte:Portuguese Escudo +pyg:Guarani + +qar:Qatari Rial + +rol:Leu +rub:Russian Ruble +rur:Russian Ruble +rwf:Rwanda Franc + +sar:Saudi Riyal +sbd:Solomon Islands Dollar +scr:Seychelles Rupee +sdd:Sudanese Dinar +sek:Swedish Krona +sgd:Singapore Dollar +shp:St. Helena Pound +sit:Tolar +skk:Slovak Koruna +sll:Leone +sos:Somali Shilling +srg:Surinam Guilder +std:Dobra +svc:El Salvador Colon +syp:Syrian Pound +szl:Lilangeni + +thb:Baht +tjr:Tajik Ruble +tmm:Manat +tnd:Tunisian Dollar +top:Pa'anga +tpe:Timor Escudo +trl:Turkish Lira +ttd:Trinidad and Tobago Dollar +twd:New Taiwan Dollar +tzs:Tanzanian Shilling + +uah:Hryvnia +uak:Karbovanets +ugx:Uganda Shilling +usd:US Dollar +usn:US Dollar (Next day) +uss:US Dollar (Same day) +uyu:Peso Uruguayo +uzs:Uzbekistan Sum + +veb:Bolivar +vnd:Dong +vuv:Vatu + +wst:Tala + +xaf:CFA Franc BEAC +xag:Silver +xau:Gold +xba:European Composite Unit +xbb:European Monetary Unit +xbc:European Unit of Account 9 +xb5:European Unit of Account 17 +xcd:East Caribbean Dollar +xdr:SDR +xeu:ECU (until 1998-12-31) +xfu:UIC-Franc +xfo:Gold-Franc +xof:CFA Franc BCEAO +xpd:Palladium +xpf:CFP Franc +xpt:Platinum + +yer:Yemeni Rial +yum:New Dinar + +zal:Financial Rand +zar:Rand +zmk:Kwacha +zrn:New Zaire +zwd:Zimbabwe Dollar diff --git a/lib/Locale/Language.pm b/lib/Locale/Language.pm new file mode 100644 index 0000000..391cffa --- /dev/null +++ b/lib/Locale/Language.pm @@ -0,0 +1,455 @@ +#----------------------------------------------------------------------- + +=head1 NAME + +Locale::Language - ISO two letter codes for language identification (ISO 639) + +=head1 SYNOPSIS + + use Locale::Language; + + $lang = code2language('en'); # $lang gets 'English' + $code = language2code('French'); # $code gets 'fr' + + @codes = all_language_codes(); + @names = all_language_names(); + +=cut + +#----------------------------------------------------------------------- + +package Locale::Language; +use strict; +require 5.002; + +#----------------------------------------------------------------------- + +=head1 DESCRIPTION + +The C module provides access to the ISO two-letter +codes for identifying languages, as defined in ISO 639. You can either +access the codes via the L (described below), +or with the two functions which return lists of all language codes or +all language names. + +=cut + +#----------------------------------------------------------------------- + +require Exporter; + +#----------------------------------------------------------------------- +# Public Global Variables +#----------------------------------------------------------------------- +use vars qw($VERSION @ISA @EXPORT); +$VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/); +@ISA = qw(Exporter); +@EXPORT = qw(&code2language &language2code + &all_language_codes &all_language_names ); + +#----------------------------------------------------------------------- +# Private Global Variables +#----------------------------------------------------------------------- +my %CODES = (); +my %LANGUAGES = (); + + +#======================================================================= + +=head1 CONVERSION ROUTINES + +There are two conversion routines: C and C. + +=over 8 + +=item code2language() + +This function takes a two letter language code and returns a string +which contains the name of the language identified. If the code is +not a valid language code, as defined by ISO 639, then C +will be returned. + + $lang = code2language($code); + +=item language2code() + +This function takes a language name and returns the corresponding +two letter language code, if such exists. +If the argument could not be identified as a language name, +then C will be returned. + + $code = language2code('French'); + +The case of the language name is not important. +See the section L below. + +=back + +=cut + +#======================================================================= +sub code2language +{ + my $code = shift; + + + return undef unless defined $code; + $code = lc($code); + if (exists $CODES{$code}) + { + return $CODES{$code}; + } + else + { + #--------------------------------------------------------------- + # no such language code! + #--------------------------------------------------------------- + return undef; + } +} + +sub language2code +{ + my $lang = shift; + + + return undef unless defined $lang; + $lang = lc($lang); + if (exists $LANGUAGES{$lang}) + { + return $LANGUAGES{$lang}; + } + else + { + #--------------------------------------------------------------- + # no such language! + #--------------------------------------------------------------- + return undef; + } +} + +#======================================================================= + +=head1 QUERY ROUTINES + +There are two function which can be used to obtain a list of all +language codes, or all language names: + +=over 8 + +=item C + +Returns a list of all two-letter language codes. +The codes are guaranteed to be all lower-case, +and not in any particular order. + +=item C + +Returns a list of all language names for which there is a corresponding +two-letter language code. The names are capitalised, and not returned +in any particular order. + +=back + +=cut + +#======================================================================= +sub all_language_codes +{ + return keys %CODES; +} + +sub all_language_names +{ + return values %CODES; +} + +#----------------------------------------------------------------------- + +=head1 EXAMPLES + +The following example illustrates use of the C function. +The user is prompted for a language code, and then told the corresponding +language name: + + $| = 1; # turn off buffering + + print "Enter language code: "; + chop($code = ); + $lang = code2language($code); + if (defined $lang) + { + print "$code = $lang\n"; + } + else + { + print "'$code' is not a valid language code!\n"; + } + +=head1 KNOWN BUGS AND LIMITATIONS + +=over 4 + +=item * + +In the current implementation, all data is read in when the +module is loaded, and then held in memory. +A lazy implementation would be more memory friendly. + +=item * + +Currently just supports the two letter language codes - +there are also three-letter codes, and numbers. +Would these be of any use to anyone? + +=back + +=head1 SEE ALSO + +=over 4 + +=item Locale::Country + +ISO codes for identification of country (ISO 3166). +Supports 2-letter, 3-letter, and numeric country codes. + +=item Locale::Currency + +ISO three letter codes for identification of currencies and funds (ISO 4217). + +=item ISO 639:1988 (E/F) + +Code for the representation of names of languages. + +=item http://lcweb.loc.gov/standards/iso639-2/langhome.html + +Home page for ISO 639-2 + +=back + + +=head1 AUTHOR + +Neil Bowers Eneilb@cre.canon.co.ukE + +=head1 COPYRIGHT + +Copyright (c) 1997-2001 Canon Research Centre Europe (CRE). + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +#----------------------------------------------------------------------- + +#======================================================================= +# initialisation code - stuff the DATA into the CODES hash +#======================================================================= +{ + my $code; + my $language; + + + while () + { + next unless /\S/; + chop; + ($code, $language) = split(/:/, $_, 2); + $CODES{$code} = $language; + $LANGUAGES{"\L$language"} = $code; + } +} + +1; + +__DATA__ +aa:Afar +ab:Abkhazian +ae:Avestan +af:Afrikaans +am:Amharic +ar:Arabic +as:Assamese +ay:Aymara +az:Azerbaijani + +ba:Bashkir +be:Belarusian +bg:Bulgarian +bh:Bihari +bi:Bislama +bn:Bengali +bo:Tibetan +br:Breton +bs:Bosnian + +ca:Catalan +ce:Chechen +ch:Chamorro +co:Corsican +cs:Czech +cu:Church Slavic +cv:Chuvash +cy:Welsh + +da:Danish +de:German +dz:Dzongkha + +el:Greek +en:English +eo:Esperanto +es:Spanish +et:Estonian +eu:Basque + +fa:Persian +fi:Finnish +fj:Fijian +fo:Faeroese +fr:French +fy:Frisian + +ga:Irish +gd:Gaelic (Scots) +gl:Gallegan +gn:Guarani +gu:Gujarati +gv:Manx + +ha:Hausa +he:Hebrew +hi:Hindi +ho:Hiri Motu +hr:Croatian +hu:Hungarian +hy:Armenian +hz:Herero + +ia:Interlingua +id:Indonesian +ie:Interlingue +ik:Inupiaq +is:Icelandic +it:Italian +iu:Inuktitut + +ja:Japanese +jw:Javanese + +ka:Georgian +ki:Kikuyu +kj:Kuanyama +kk:Kazakh +kl:Kalaallisut +km:Khmer +kn:Kannada +ko:Korean +ks:Kashmiri +ku:Kurdish +kv:Komi +kw:Cornish +ky:Kirghiz + +la:Latin +lb:Letzeburgesch +ln:Lingala +lo:Lao +lt:Lithuanian +lv:Latvian + +mg:Malagasy +mh:Marshall +mi:Maori +mk:Macedonian +ml:Malayalam +mn:Mongolian +mo:Moldavian +mr:Marathi +ms:Malay +mt:Maltese +my:Burmese + +na:Nauru +nb:Norwegian Bokmål +nd:Ndebele, North +ne:Nepali +ng:Ndonga +nl:Dutch +nn:Norwegian Nynorsk +no:Norwegian +nr:Ndebele, South +nv:Navajo +ny:Chichewa; Nyanja + +oc:Occitan (post 1500) +om:Oromo +or:Oriya +os:Ossetian; Ossetic + +pa:Panjabi +pi:Pali +pl:Polish +ps:Pushto +pt:Portuguese + +qu:Quechua + +rm:Rhaeto-Romance +rn:Rundi +ro:Romanian +ru:Russian +rw:Kinyarwanda + +sa:Sanskrit +sc:Sardinian +sd:Sindhi +se:Sami +sg:Sango +si:Sinhalese +sk:Slovak +sl:Slovenian +sm:Samoan +sn:Shona +so:Somali +sq:Albanian +sr:Serbian +ss:Swati +st:Sotho +su:Sundanese +sv:Swedish +sw:Swahili + +ta:Tamil +te:Telugu +tg:Tajik +th:Thai +ti:Tigrinya +tk:Turkmen +tl:Tagalog +tn:Tswana +to:Tonga +tr:Turkish +ts:Tsonga +tt:Tatar +tw:Twi + +ug:Uighur +uk:Ukrainian +ur:Urdu +uz:Uzbek + +vi:Vietnamese +vo:Volapük + +wo:Wolof + +xh:Xhosa + +yi:Yiddish +yo:Yoruba + +za:Zhuang +zh:Chinese +zu:Zulu diff --git a/t/lib/lc-all.t b/t/lib/lc-all.t new file mode 100644 index 0000000..d34feca --- /dev/null +++ b/t/lib/lc-all.t @@ -0,0 +1,361 @@ +#!./perl +# +# all.t - tests for all_* routines in +# Locale::Country +# Locale::Language +# Locale::Currency +# +# There are four tests. We get a list of all codes, convert to +# language/country/currency, # convert back to code, +# and check that they're the same. Then we do the same, +# starting with list of languages/countries/currencies. +# + +use Locale::Country; +use Locale::Language; +use Locale::Currency; + +print "1..12\n"; + +my $code; +my $language; +my $country; +my $ok; +my $reverse; +my $currency; + + +#----------------------------------------------------------------------- +# Old API - without codeset specified, default to ALPHA_2 +#----------------------------------------------------------------------- +$ok = 1; +foreach $code (all_country_codes()) +{ + $country = code2country($code); + if (!defined $country) + { + $ok = 0; + last; + } + $reverse = country2code($country); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $code) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 1\n" : "not ok 1\n"); + +#----------------------------------------------------------------------- +# code to country, back to code, for ALPHA2 +#----------------------------------------------------------------------- +$ok = 1; +foreach $code (all_country_codes(LOCALE_CODE_ALPHA_2)) +{ + $country = code2country($code, LOCALE_CODE_ALPHA_2); + if (!defined $country) + { + $ok = 0; + last; + } + $reverse = country2code($country, LOCALE_CODE_ALPHA_2); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $code) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 2\n" : "not ok 2\n"); + +#----------------------------------------------------------------------- +# code to country, back to code, for ALPHA3 +#----------------------------------------------------------------------- +$ok = 1; +foreach $code (all_country_codes(LOCALE_CODE_ALPHA_3)) +{ + $country = code2country($code, LOCALE_CODE_ALPHA_3); + if (!defined $country) + { + $ok = 0; + last; + } + $reverse = country2code($country, LOCALE_CODE_ALPHA_3); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $code) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 3\n" : "not ok 3\n"); + +#----------------------------------------------------------------------- +# code to country, back to code, for NUMERIC +#----------------------------------------------------------------------- +$ok = 1; +foreach $code (all_country_codes(LOCALE_CODE_NUMERIC)) +{ + $country = code2country($code, LOCALE_CODE_NUMERIC); + if (!defined $country) + { + $ok = 0; + last; + } + $reverse = country2code($country, LOCALE_CODE_NUMERIC); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $code) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 4\n" : "not ok 4\n"); + + +#----------------------------------------------------------------------- +# Old API - country to code, back to country, using default of ALPHA_2 +#----------------------------------------------------------------------- +$ok = 1; +foreach $country (all_country_names()) +{ + $code = country2code($country); + if (!defined $code) + { + $ok = 0; + last; + } + $reverse = code2country($code); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $country) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 5\n" : "not ok 5\n"); + +#----------------------------------------------------------------------- +# country to code, back to country, using LOCALE_CODE_ALPHA_2 +#----------------------------------------------------------------------- +$ok = 1; +foreach $country (all_country_names()) +{ + $code = country2code($country, LOCALE_CODE_ALPHA_2); + if (!defined $code) + { + $ok = 0; + last; + } + $reverse = code2country($code, LOCALE_CODE_ALPHA_2); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $country) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 6\n" : "not ok 6\n"); + +#----------------------------------------------------------------------- +# country to code, back to country, using LOCALE_CODE_ALPHA_3 +#----------------------------------------------------------------------- +$ok = 1; +foreach $country (all_country_names()) +{ + $code = country2code($country, LOCALE_CODE_ALPHA_3); + if (!defined $code) + { + next if ($country eq 'Antarctica' + || $country eq 'Bouvet Island' + || $country eq 'Cocos (Keeling) Islands' + || $country eq 'Christmas Island' + || $country eq 'France, Metropolitan' + || $country eq 'South Georgia and the South Sandwich Islands' + || $country eq 'Heard Island and McDonald Islands' + || $country eq 'British Indian Ocean Territory' + || $country eq 'French Southern Territories' + || $country eq 'United States Minor Outlying Islands' + || $country eq 'Mayotte' + || $country eq 'Zaire'); + $ok = 0; + last; + } + $reverse = code2country($code, LOCALE_CODE_ALPHA_3); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $country) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 7\n" : "not ok 7\n"); + +#----------------------------------------------------------------------- +# country to code, back to country, using LOCALE_CODE_NUMERIC +#----------------------------------------------------------------------- +$ok = 1; +foreach $country (all_country_names()) +{ + $code = country2code($country, LOCALE_CODE_NUMERIC); + if (!defined $code) + { + next if ($country eq 'Antarctica' + || $country eq 'Bouvet Island' + || $country eq 'Cocos (Keeling) Islands' + || $country eq 'Christmas Island' + || $country eq 'France, Metropolitan' + || $country eq 'South Georgia and the South Sandwich Islands' + || $country eq 'Heard Island and McDonald Islands' + || $country eq 'British Indian Ocean Territory' + || $country eq 'French Southern Territories' + || $country eq 'United States Minor Outlying Islands' + || $country eq 'Mayotte' + || $country eq 'Zaire'); + $ok = 0; + last; + } + $reverse = code2country($code, LOCALE_CODE_NUMERIC); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $country) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 8\n" : "not ok 8\n"); + + +$ok = 1; +foreach $code (all_language_codes()) +{ + $language = code2language($code); + if (!defined $language) + { + $ok = 0; + last; + } + $reverse = language2code($language); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $code) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 9\n" : "not ok 9\n"); + + +$ok = 1; +foreach $language (all_language_names()) +{ + $code = language2code($language); + if (!defined $code) + { + $ok = 0; + last; + } + $reverse = code2language($code); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $language) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 10\n" : "not ok 10\n"); + +$ok = 1; +foreach $code (all_currency_codes()) +{ + $currency = code2currency($code); + if (!defined $currency) + { + $ok = 0; + last; + } + $reverse = currency2code($currency); + if (!defined $reverse) + { + $ok = 0; + last; + } + # + # three special cases: + # The Kwacha has two codes - used in Zambia and Malawi + # The Russian Ruble has two codes - rub and rur + # The Belarussian Ruble has two codes - byb and byr + if ($reverse ne $code + && $code ne 'mwk' && $code ne 'zmk' + && $code ne 'byr' && $code ne 'byb' + && $code ne 'rub' && $code ne 'rur') + { + $ok = 0; + last; + } +} +print ($ok ? "ok 11\n" : "not ok 11\n"); + +$ok = 1; +foreach $currency (all_currency_names()) +{ + $code = currency2code($currency); + if (!defined $code) + { + $ok = 0; + last; + } + $reverse = code2currency($code); + if (!defined $reverse) + { + $ok = 0; + last; + } + if ($reverse ne $currency) + { + $ok = 0; + last; + } +} +print ($ok ? "ok 12\n" : "not ok 12\n"); diff --git a/t/lib/lc-constants.t b/t/lib/lc-constants.t new file mode 100644 index 0000000..e71103d --- /dev/null +++ b/t/lib/lc-constants.t @@ -0,0 +1,44 @@ +#!./perl +# +# constants.t - tests for Locale::Constants +# + +use Locale::Constants; + +print "1..3\n"; + +if (defined LOCALE_CODE_ALPHA_2 + && defined LOCALE_CODE_ALPHA_3 + && defined LOCALE_CODE_NUMERIC) +{ + print "ok 1\n"; +} +else +{ + print "not ok 1\n"; +} + +if (LOCALE_CODE_ALPHA_2 != LOCALE_CODE_ALPHA_3 + && LOCALE_CODE_ALPHA_2 != LOCALE_CODE_NUMERIC + && LOCALE_CODE_ALPHA_3 != LOCALE_CODE_NUMERIC) +{ + print "ok 2\n"; +} +else +{ + print "not ok 2\n"; +} + +if (defined LOCALE_CODE_DEFAULT + && (LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_2 + || LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_3 + || LOCALE_CODE_DEFAULT == LOCALE_CODE_NUMERIC)) +{ + print "ok 3\n"; +} +else +{ + print "not ok 3\n"; +} + +exit 0; diff --git a/t/lib/lc-country.t b/t/lib/lc-country.t new file mode 100644 index 0000000..535291e --- /dev/null +++ b/t/lib/lc-country.t @@ -0,0 +1,109 @@ +#!./perl +# +# country.t - tests for Locale::Country +# + +use Locale::Country; + +#----------------------------------------------------------------------- +# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE] +# Each TEST is eval'd as an expression. +# If it evaluates to FALSE, then "not ok N" is printed for the test, +# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked. +# If it is true (1), the test is treated as passing, otherwise it failed. +#----------------------------------------------------------------------- +@TESTS = +( + #================================================ + # TESTS FOR code2country + #================================================ + + #---- selection of examples which should all result in undef ----------- + ['!defined code2country()', 0], # no argument + ['!defined code2country(undef)', 0], # undef argument + ['!defined code2country("zz")', 0], # illegal code + ['!defined code2country("zz", LOCALE_CODE_ALPHA_2)', 0], # illegal code + ['!defined code2country("zz", LOCALE_CODE_ALPHA_3)', 0], # illegal code + ['!defined code2country("zz", LOCALE_CODE_NUMERIC)', 0], # illegal code + ['!defined code2country("ja")', 0], # should be jp for country + ['!defined code2country("uk")', 0], # should be jp for country + + #---- some successful examples ----------------------------------------- + ['code2country("BO") eq "Bolivia"', 0], + ['code2country("BO", LOCALE_CODE_ALPHA_2) eq "Bolivia"', 0], + ['code2country("bol", LOCALE_CODE_ALPHA_3) eq "Bolivia"', 0], + ['code2country("pk") eq "Pakistan"', 0], + ['code2country("sn") eq "Senegal"', 0], + ['code2country("us") eq "United States"', 0], + ['code2country("ad") eq "Andorra"', 0], # first in DATA segment + ['code2country("ad", LOCALE_CODE_ALPHA_2) eq "Andorra"', 0], + ['code2country("and", LOCALE_CODE_ALPHA_3) eq "Andorra"', 0], + ['code2country("020", LOCALE_CODE_NUMERIC) eq "Andorra"', 0], + ['code2country(48, LOCALE_CODE_NUMERIC) eq "Bahrain"', 0], + ['code2country("zw") eq "Zimbabwe"', 0], # last in DATA segment + ['code2country("gb") eq "United Kingdom"', 0], # United Kingdom is "gb", not "uk" + + #================================================ + # TESTS FOR country2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + ['!defined code2country("BO", LOCALE_CODE_ALPHA_3)', 0], + ['!defined code2country("BO", LOCALE_CODE_NUMERIC)', 0], + ['!defined country2code()', 0], # no argument + ['!defined country2code(undef)', 0], # undef argument + ['!defined country2code("Banana")', 0], # illegal country name + + #---- some successful examples ----------------------------------------- + ['country2code("japan") eq "jp"', 0], + ['country2code("japan") ne "ja"', 0], + ['country2code("Japan") eq "jp"', 0], + ['country2code("United States") eq "us"', 0], + ['country2code("United Kingdom") eq "gb"', 0], + ['country2code("Andorra") eq "ad"', 0], # first in DATA segment + ['country2code("Zimbabwe") eq "zw"', 0], # last in DATA segment + + #================================================ + # TESTS FOR country_code2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0], + ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0], + ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0], + ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2)', 1], + ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_2)', 1], + ['!defined country_code2code()', 1], # no argument + ['!defined country_code2code(undef)', 1], # undef argument + + #---- some successful examples ----------------------------------------- + ['country_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bol"', 0], + ['country_code2code("bol", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0], + ['country_code2code("zwe", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "zw"', 0], + ['country_code2code("858", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0], + ['country_code2code(858, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0], + ['country_code2code("tr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "792"', 0], + +); + +print "1..", int(@TESTS), "\n"; + +$testid = 1; +foreach $test (@TESTS) +{ + eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )"; + if ($@) + { + if (!$test->[1]) + { + print "not ok $testid\n"; + } + else + { + print "ok $testid\n"; + } + } + ++$testid; +} + +exit 0; diff --git a/t/lib/lc-currency.t b/t/lib/lc-currency.t new file mode 100644 index 0000000..f66353c --- /dev/null +++ b/t/lib/lc-currency.t @@ -0,0 +1,79 @@ +#!./perl +# +# currency.t - tests for Locale::Currency +# +use Locale::Currency; + +#----------------------------------------------------------------------- +# This is an array of tests. Each test is eval'd as an expression. +# If it evaluates to FALSE, then "not ok N" is printed for the test, +# otherwise "ok N". +#----------------------------------------------------------------------- +@TESTS = +( + #================================================ + # TESTS FOR code2currency + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined code2currency()', # no argument => undef returned + '!defined code2currency(undef)', # undef arg => undef returned + '!defined code2currency("zz")', # illegal code => undef + '!defined code2currency("zzzz")', # illegal code => undef + '!defined code2currency("zzz")', # illegal code => undef + '!defined code2currency("ukp")', # gbp for sterling, not ukp + + #---- misc tests ------------------------------------------------------- + 'code2currency("all") eq "Lek"', + 'code2currency("ats") eq "Schilling"', + 'code2currency("bob") eq "Boliviano"', + 'code2currency("bnd") eq "Brunei Dollar"', + 'code2currency("cop") eq "Colombian Peso"', + 'code2currency("dkk") eq "Danish Krone"', + 'code2currency("fjd") eq "Fiji Dollar"', + 'code2currency("idr") eq "Rupiah"', + 'code2currency("chf") eq "Swiss Franc"', + 'code2currency("mvr") eq "Rufiyaa"', + 'code2currency("mmk") eq "Kyat"', + 'code2currency("mwk") eq "Kwacha"', # two different codes for Kwacha + 'code2currency("zmk") eq "Kwacha"', # used in Zambia and Malawi + 'code2currency("byr") eq "Belarussian Ruble"', # 2 codes for belarussian ruble + 'code2currency("byb") eq "Belarussian Ruble"', # + 'code2currency("rub") eq "Russian Ruble"', # 2 codes for russian ruble + 'code2currency("rur") eq "Russian Ruble"', # + + #---- some successful examples ----------------------------------------- + 'code2currency("BOB") eq "Boliviano"', + 'code2currency("adp") eq "Andorran Peseta"', # first in DATA segment + 'code2currency("zwd") eq "Zimbabwe Dollar"', # last in DATA segment + + #================================================ + # TESTS FOR currency2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined currency2code()', # no argument => undef returned + '!defined currency2code(undef)', # undef arg => undef returned + '!defined currency2code("")', # empty string => undef returned + '!defined currency2code("Banana")', # illegal curr name => undef + + #---- some successful examples ----------------------------------------- + 'currency2code("Kroon") eq "eek"', + 'currency2code("Markka") eq "fim"', + 'currency2code("Riel") eq "khr"', + 'currency2code("PULA") eq "bwp"', + 'currency2code("Andorran Peseta") eq "adp"', # first in DATA segment + 'currency2code("Zimbabwe Dollar") eq "zwd"', # last in DATA segment +); + +print "1..", int(@TESTS), "\n"; + +$testid = 1; +foreach $test (@TESTS) +{ + eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )"; + print "not ok $testid\n" if $@; + ++$testid; +} + +exit 0; diff --git a/t/lib/lc-language.t b/t/lib/lc-language.t new file mode 100644 index 0000000..b9c25f1 --- /dev/null +++ b/t/lib/lc-language.t @@ -0,0 +1,102 @@ +#!./perl +# +# language.t - tests for Locale::Language +# +use Locale::Language; + +#----------------------------------------------------------------------- +# This is an array of tests. Each test is eval'd as an expression. +# If it evaluates to FALSE, then "not ok N" is printed for the test, +# otherwise "ok N". +#----------------------------------------------------------------------- +@TESTS = +( + #================================================ + # TESTS FOR code2language + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined code2language()', # no argument => undef returned + '!defined code2language(undef)', # undef arg => undef returned + '!defined code2language("zz")', # illegal code => undef + '!defined code2language("jp")', # ja for lang, jp for country + + #---- test recent changes ---------------------------------------------- + 'code2language("ae") eq "Avestan"', + 'code2language("bs") eq "Bosnian"', + 'code2language("ch") eq "Chamorro"', + 'code2language("ce") eq "Chechen"', + 'code2language("cu") eq "Church Slavic"', + 'code2language("cv") eq "Chuvash"', + 'code2language("hz") eq "Herero"', + 'code2language("ho") eq "Hiri Motu"', + 'code2language("ki") eq "Kikuyu"', + 'code2language("kj") eq "Kuanyama"', + 'code2language("kv") eq "Komi"', + 'code2language("mh") eq "Marshall"', + 'code2language("nv") eq "Navajo"', + 'code2language("nr") eq "Ndebele, South"', + 'code2language("nd") eq "Ndebele, North"', + 'code2language("ng") eq "Ndonga"', + 'code2language("nn") eq "Norwegian Nynorsk"', + 'code2language("nb") eq "Norwegian Bokmål"', + 'code2language("ny") eq "Chichewa; Nyanja"', + 'code2language("oc") eq "Occitan (post 1500)"', + 'code2language("os") eq "Ossetian; Ossetic"', + 'code2language("pi") eq "Pali"', + '!defined code2language("sh")', # Serbo-Croatian withdrawn + 'code2language("se") eq "Sami"', + 'code2language("sc") eq "Sardinian"', + 'code2language("kw") eq "Cornish"', + 'code2language("gv") eq "Manx"', + 'code2language("lb") eq "Letzeburgesch"', + 'code2language("he") eq "Hebrew"', + '!defined code2language("iw")', # Hebrew withdrawn + 'code2language("id") eq "Indonesian"', + '!defined code2language("in")', # Indonesian withdrawn + 'code2language("iu") eq "Inuktitut"', + 'code2language("ug") eq "Uighur"', + '!defined code2language("ji")', # Yiddish withdrawn + 'code2language("yi") eq "Yiddish"', + 'code2language("za") eq "Zhuang"', + + #---- some successful examples ----------------------------------------- + 'code2language("DA") eq "Danish"', + 'code2language("eo") eq "Esperanto"', + 'code2language("fi") eq "Finnish"', + 'code2language("en") eq "English"', + 'code2language("aa") eq "Afar"', # first in DATA segment + 'code2language("zu") eq "Zulu"', # last in DATA segment + + #================================================ + # TESTS FOR language2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined language2code()', # no argument => undef returned + '!defined language2code(undef)', # undef arg => undef returned + '!defined language2code("Banana")', # illegal lang name => undef + + #---- some successful examples ----------------------------------------- + 'language2code("Japanese") eq "ja"', + 'language2code("japanese") eq "ja"', + 'language2code("japanese") ne "jp"', + 'language2code("French") eq "fr"', + 'language2code("Greek") eq "el"', + 'language2code("english") eq "en"', + 'language2code("ESTONIAN") eq "et"', + 'language2code("Afar") eq "aa"', # first in DATA segment + 'language2code("Zulu") eq "zu"', # last in DATA segment +); + +print "1..", int(@TESTS), "\n"; + +$testid = 1; +foreach $test (@TESTS) +{ + eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )"; + print "not ok $testid\n" if $@; + ++$testid; +} + +exit 0; diff --git a/t/lib/lc-uk.t b/t/lib/lc-uk.t new file mode 100644 index 0000000..98f71d2 --- /dev/null +++ b/t/lib/lc-uk.t @@ -0,0 +1,65 @@ +#!./perl +# +# uk.t - tests for Locale::Country with "uk" aliases to "gb" +# + +use Locale::Country; + +Locale::Country::_alias_code('uk' => 'gb'); + +#----------------------------------------------------------------------- +# This is an array of tests. Each test is eval'd as an expression. +# If it evaluates to FALSE, then "not ok N" is printed for the test, +# otherwise "ok N". +#----------------------------------------------------------------------- +@TESTS = +( + #================================================ + # TESTS FOR code2country + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined code2country()', # no argument + '!defined code2country(undef)', # undef argument + '!defined code2country("zz")', # illegal code + '!defined code2country("ja")', # should be jp for country + + #---- some successful examples ----------------------------------------- + 'code2country("BO") eq "Bolivia"', + 'code2country("pk") eq "Pakistan"', + 'code2country("sn") eq "Senegal"', + 'code2country("us") eq "United States"', + 'code2country("ad") eq "Andorra"', # first in DATA segment + 'code2country("zw") eq "Zimbabwe"', # last in DATA segment + 'code2country("uk") eq "United Kingdom"', # normally "gb" + + #================================================ + # TESTS FOR country2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined country2code()', # no argument + '!defined country2code(undef)', # undef argument + '!defined country2code("Banana")', # illegal country name + + #---- some successful examples ----------------------------------------- + 'country2code("japan") eq "jp"', + 'country2code("japan") ne "ja"', + 'country2code("Japan") eq "jp"', + 'country2code("United States") eq "us"', + 'country2code("United Kingdom") eq "uk"', + 'country2code("Andorra") eq "ad"', # first in DATA segment + 'country2code("Zimbabwe") eq "zw"', # last in DATA segment +); + +print "1..", int(@TESTS), "\n"; + +$testid = 1; +foreach $test (@TESTS) +{ + eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )"; + print "not ok $testid\n" if $@; + ++$testid; +} + +exit 0;