1 package Locale::Country;
2 # Copyright (C) 2001 Canon Research Centre Europe (CRE).
3 # Copyright (C) 2002-2009 Neil Bowers
4 # Copyright (c) 2010-2010 Sullivan Beck
5 # This program is free software; you can redistribute it and/or modify it
6 # under the same terms as Perl itself.
15 use Locale::Constants;
16 use Locale::Codes::Country;
18 #=======================================================================
19 # Public Global Variables
20 #=======================================================================
22 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
26 @EXPORT = qw(code2country
39 my($code,$codeset) = @_;
40 $code = "" if (! $code);
42 $codeset = LOCALE_CODE_DEFAULT if (! defined($codeset) || $codeset eq "");
44 if ($codeset =~ /^\d+$/) {
45 if ($codeset == LOCALE_CODE_ALPHA_2) {
47 } elsif ($codeset == LOCALE_CODE_ALPHA_3) {
49 } elsif ($codeset == LOCALE_CODE_NUMERIC) {
51 } elsif ($codeset == LOCALE_CODE_FIPS) {
53 } elsif ($codeset == LOCALE_CODE_DOM) {
60 if ($codeset eq "alpha2" ||
61 $codeset eq "alpha3") {
63 } elsif ($codeset eq "num") {
64 if (defined($code) && $code ne "") {
65 return (1) unless ($code =~ /^\d+$/);
66 $code = sprintf("%.3d", $code);
68 } elsif ($codeset eq "fips" ||
75 return (0,$code,$codeset);
78 #=======================================================================
80 # code2country ( CODE [,CODESET] )
82 #=======================================================================
85 my($err,$code,$codeset) = _code(@_);
86 return undef if ($err ||
89 return Locale::Codes::_code2name("country",$code,$codeset);
92 #=======================================================================
94 # country2code ( COUNTRY [,CODESET] )
96 #=======================================================================
99 my($country,$codeset) = @_;
101 ($err,$tmp,$codeset) = _code("",$codeset);
102 return undef if ($err ||
105 return Locale::Codes::_name2code("country",$country,$codeset);
108 #=======================================================================
110 # country_code2code ( CODE,CODESET_IN,CODESET_OUT )
112 #=======================================================================
114 sub country_code2code {
115 (@_ == 3) or croak "country_code2code() takes 3 arguments!";
116 my($code,$inset,$outset) = @_;
118 ($err,$code,$inset) = _code($code,$inset);
119 return undef if ($err);
120 ($err,$tmp,$outset) = _code("",$outset);
121 return undef if ($err);
123 return Locale::Codes::_code2code("country",$code,$inset,$outset);
126 #=======================================================================
128 # all_country_codes ( [CODESET] )
130 #=======================================================================
132 sub all_country_codes {
135 ($err,$tmp,$codeset) = _code("",$codeset);
136 return undef if ($err);
138 return Locale::Codes::_all_codes("country",$codeset);
142 #=======================================================================
144 # all_country_names ( [CODESET] )
146 #=======================================================================
148 sub all_country_names {
151 ($err,$tmp,$codeset) = _code("",$codeset);
152 return undef if ($err);
154 return Locale::Codes::_all_names("country",$codeset);
157 #=======================================================================
159 # rename_country ( CODE,NAME [,CODESET] )
161 #=======================================================================
164 my($code,$new_name,@args) = @_;
166 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
167 my $codeset = shift(@args);
169 ($err,$code,$codeset) = _code($code,$codeset);
171 return Locale::Codes::_rename("country",$code,$new_name,$codeset,$nowarn);
174 #=======================================================================
176 # add_country ( CODE,NAME [,CODESET] )
178 #=======================================================================
181 my($code,$name,@args) = @_;
183 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
184 my $codeset = shift(@args);
186 ($err,$code,$codeset) = _code($code,$codeset);
188 return Locale::Codes::_add_code("country",$code,$name,$codeset,$nowarn);
191 #=======================================================================
193 # delete_country ( CODE [,CODESET] )
195 #=======================================================================
198 my($code,@args) = @_;
200 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
201 my $codeset = shift(@args);
203 ($err,$code,$codeset) = _code($code,$codeset);
205 return Locale::Codes::_delete_code("country",$code,$codeset,$nowarn);
208 #=======================================================================
210 # add_country_alias ( NAME,NEW_NAME )
212 #=======================================================================
214 sub add_country_alias {
215 my($name,$new_name,$nowarn) = @_;
216 $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
218 return Locale::Codes::_add_alias("country",$name,$new_name,$nowarn);
221 #=======================================================================
223 # delete_country_alias ( NAME )
225 #=======================================================================
227 sub delete_country_alias {
228 my($name,$nowarn) = @_;
229 $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
231 return Locale::Codes::_delete_alias("country",$name,$nowarn);
234 #=======================================================================
236 # rename_country_code ( CODE,NEW_CODE [,CODESET] )
238 #=======================================================================
240 sub rename_country_code {
241 my($code,$new_code,@args) = @_;
243 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
244 my $codeset = shift(@args);
246 ($err,$code,$codeset) = _code($code,$codeset);
247 ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
249 return Locale::Codes::_rename_code("country",$code,$new_code,$codeset,$nowarn);
252 #=======================================================================
254 # add_country_code_alias ( CODE,NEW_CODE [,CODESET] )
256 #=======================================================================
258 sub add_country_code_alias {
259 my($code,$new_code,@args) = @_;
261 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
262 my $codeset = shift(@args);
264 ($err,$code,$codeset) = _code($code,$codeset);
265 ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
267 return Locale::Codes::_add_code_alias("country",$code,$new_code,$codeset,$nowarn);
270 #=======================================================================
272 # delete_country_code_alias ( CODE [,CODESET] )
274 #=======================================================================
276 sub delete_country_code_alias {
277 my($code,@args) = @_;
279 $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
280 my $codeset = shift(@args);
282 ($err,$code,$codeset) = _code($code,$codeset);
284 return Locale::Codes::_delete_code_alias("country",$code,$codeset,$nowarn);
287 #=======================================================================
289 # Old function for backward compatibility
291 #=======================================================================
294 my($alias,$code,@args) = @_;
295 my $success = rename_country_code($code,$alias,@args);
296 return 0 if (! $success);
303 # indent-tabs-mode: nil
304 # cperl-indent-level: 3
305 # cperl-continued-statement-offset: 2
306 # cperl-continued-brace-offset: 0
307 # cperl-brace-offset: 0
308 # cperl-brace-imaginary-offset: 0
309 # cperl-label-offset: -2