File Coverage

blib/lib/Locale/Object/Country.pm
Criterion Covered Total %
statement 155 162 95.6
branch 44 56 78.5
condition 3 3 100.0
subroutine 26 26 100.0
pod 12 14 85.7
total 240 261 91.9


line stmt bran cond sub pod time code
1             package Locale::Object::Country;
2              
3 7     7   450843 use strict;
  7         30  
  7         178  
4 7     7   30 use warnings;;
  7         13  
  7         222  
5 7     7   31 use Carp;
  7         12  
  7         322  
6              
7 7     7   1717 use Locale::Object;
  7         15  
  7         168  
8 7     7   43 use base qw( Locale::Object );
  7         20  
  7         618  
9              
10 7     7   1417 use Locale::Object::DB;
  7         19  
  7         264  
11 7     7   1101 use Locale::Object::Currency;
  7         12  
  7         137  
12 7     7   34 use Locale::Object::Continent;
  7         11  
  7         149  
13 7     7   1664 use Locale::Object::Language;
  7         16  
  7         176  
14              
15 7     7   3126 use DateTime::TimeZone;
  7         1098076  
  7         8667  
16              
17             our $VERSION = '0.78';
18              
19             my $db = Locale::Object::DB->new();
20              
21             # Initialize the hash where we'll keep our continent objects.
22             my $existing = {};
23              
24              
25             # Initialize the object.
26             sub init
27             {
28 378     378 0 674 my $self = shift;
29 378         738 my %params = @_;
30              
31             # One parameter is allowed.
32 378 50       903 croak "Error: You must specify a single parameter for initialization."
33             unless scalar(keys %params) == 1;
34              
35             # It's the only key in %params.
36 378         703 my $parameter = (keys %params)[0];
37            
38             # Make a hash of valid parameters.
39 378         756 my %allowed_params = map { $_ => undef }
  1512         2879  
40             qw(code_alpha2 code_alpha3 code_numeric name);
41            
42             # Go no further if the specified parameter wasn't one.
43 378 50       894 croak "Error: You can only specify a country name, alpha2 code, alpha3 code or numeric code for initialization." unless exists $allowed_params{$parameter};
44              
45             # Get the value given for the parameter.
46 378         587 my $value = $params{$parameter};
47              
48             # Make sure input matches style of values in the db.
49 378 100 100     1309 if ($parameter eq 'name')
    100          
50             {
51 4         11 $value = ucfirst($value);
52             }
53             elsif ($parameter eq 'code_alpha2' or $parameter eq 'code_alpha3')
54             {
55 373         680 $value = lc($value);
56             }
57              
58             # Look in the database for a match.
59 378         1154 my $result = $db->lookup(
60             table => 'country',
61             result_column => '*',
62             search_column => $parameter,
63             value => $value
64             );
65            
66 378 50       31709 croak "Error: Unknown $parameter given for initialization: $value" unless $result;
67              
68 378 100       593 if (defined @{$result}[0])
  378         964  
69             {
70             # Get the values from the result of our database query.
71 377         776 my $code_alpha2 = $result->[0]->{'code_alpha2'};
72 377         557 my $code_alpha3 = $result->[0]->{'code_alpha3'};
73 377         498 my $code_numeric = $result->[0]->{'code_numeric'};
74 377         583 my $name = $result->[0]->{'name'};
75 377         515 my $dialing_code = $result->[0]->{'dialing_code'};
76              
77 377         1235 $result = $db->lookup_dual(
78             table => 'timezone',
79             result_col => 'timezone',
80             col_1 => 'country_code',
81             val_1 => $code_alpha2,
82             col_2 => 'is_default',
83             val_2 => 'true'
84             );
85            
86 377         32993 my $timezone = $result->[0]->{timezone};
87              
88             # Check for pre-existing objects. Return it if there is one.
89 377         1060 my $country = $self->exists($code_alpha2);
90 377 100       903 return $country if $country;
91            
92             # If not, make a new object.
93 361         932 _make_country($self, $code_alpha2, $code_alpha3, $code_numeric, $name, $dialing_code, $timezone);
94            
95             # Register the new object.
96 361         1143 $self->register();
97            
98             # Return the object.
99 361         2239 $self;
100             }
101             else
102             {
103 1         288 carp "Warning: No result found in country table for '$value' in $parameter.";
104 1         15 return;
105             }
106             }
107              
108             # Check if objects exist.
109             sub exists {
110 377     377 1 564 my $self = shift;
111            
112             # Check existence of a object with the given parameter or with
113             # the alpha2 code of the current object.
114 377         532 my $code = shift;
115              
116             # Return the singleton object, if it exists.
117 377         763 $existing->{$code};
118             }
119              
120             # Register the object in our hash of existing objects.
121             sub register {
122 361     361 0 557 my $self = shift;
123            
124             # Do nothing unless the object exists.
125 361 50       666 my $code = $self->code_alpha2 or return;
126            
127             # Put the current object into the singleton hash.
128 361         994 $existing->{$code} = $self;
129             }
130              
131             sub _make_country
132             {
133 361     361   522 my $self = shift;
134 361         1028 my @attributes = @_;
135              
136             # The first attribute we get is the alpha2 country code.
137 361         531 my $code = $attributes[0];
138              
139             # The attributes we want to set.
140 361         816 my @attr_names = qw(code_alpha2 code_alpha3 code_numeric name dialing_code timezone);
141            
142             # Initialize a loop counter.
143 361         468 my $counter = 0;
144            
145             # For each of those attributes,
146 361         654 foreach my $current_attribute (@attr_names)
147             {
148             # set it on the object.
149 2166         5131 $self->$current_attribute( $attributes[$counter] );
150 2166         2948 $counter++;
151             }
152              
153             # Check there's a continent row matching our current country.
154 361         1313 my $result = $db->lookup(
155             table => 'continent',
156             result_column => '*',
157             search_column => 'country_code',
158             value => $code
159             );
160            
161 361 50       28588 croak "Error: no continent found in the database for country code $code." unless @{$result}[0];
  361         1124  
162            
163 361         527 my $continent = @{$result}[0]->{'name'};
  361         763  
164            
165             # Make new continent and currency objects as attributes.
166 361         2100 $self->{_continent} = Locale::Object::Continent->new( name => $continent );
167 361         1358 $self->{_currency} = Locale::Object::Currency->new( country_code => $code );
168            
169             }
170              
171             # Method for retrieving all languages spoken in this country.
172             sub languages
173             {
174 33     33 1 1001 my $self = shift;
175              
176             # No name, no languages.
177 33 50       69 return unless $self->{_name};
178            
179             # Check for languages attribute. Set it if we don't have it.
180 33 100       78 _set_languages($self) unless $self->{_languages};
181              
182             # Give an array if requested in array context, otherwise a reference.
183 33 50       97 return @{$self->{_languages}} if wantarray;
  33         103  
184 0         0 return $self->{_languages};
185             }
186              
187             # Method for retrieving the official language(s) of this country.
188             sub languages_official
189             {
190 4     4 1 10 my $self = shift;
191              
192             # No name, no languages.
193 4 50       14 return unless $self->{_name};
194            
195             # Check for languages attribute. Set it if we don't have it.
196 4 100       16 _set_languages($self) unless $self->{_languages};
197            
198 4         10 my @official_languages;
199              
200 4         12 foreach ($self->languages)
201             {
202 20 100       57 push (@official_languages, $_) if $_->official($self) eq 'true';
203             }
204            
205             # Give an array if requested in array context, otherwise a reference.
206 4 100       20 return @official_languages if wantarray;
207 3         12 return \@official_languages;
208             }
209              
210             # Private method to set an attribute with an array of objects for all languages spoken in this country.
211             sub _set_languages
212             {
213 8     8   13 my $self = shift;
214              
215 8         51 my @languages;
216            
217             # If it doesn't, find all countries in this continent and put them in a hash.
218             my $result = $db->lookup(
219             table => 'language_mappings',
220             result_column => 'language',
221             search_column => 'country',
222 8         35 value => $self->{'_code_alpha2'}
223             );
224              
225             # Create new country objects and put them into an array.
226 8         900 foreach my $lang (@{$result})
  8         23  
227             {
228 39         67 my $lang_code = $lang->{'language'};
229            
230 39         132 my $obj = Locale::Object::Language->new( code_alpha3 => $lang_code );
231 39         139 push @languages, $obj;
232             }
233            
234             # Set a reference to that array as an attribute.
235 8         34 $self->{'_languages'} = \@languages;
236             }
237              
238             # Small methods that return object attributes.
239             # Will refactor these into an AUTOLOAD later.
240              
241             sub code_alpha2
242             {
243 1320     1320 1 1825 my $self = shift;
244              
245 1320 100       2220 if (@_)
246             {
247 361         751 $self->{_code_alpha2} = shift;
248 361         586 return $self;
249             }
250            
251 959         2229 $self->{_code_alpha2};
252             }
253              
254             sub code_alpha3
255             {
256 362     362 1 507 my $self = shift;
257            
258 362 100       627 if (@_)
259             {
260 361         639 $self->{_code_alpha3} = shift;
261 361         495 return $self;
262             }
263              
264 1         5 $self->{_code_alpha3};
265             }
266              
267             sub code_numeric
268             {
269 363     363 1 465 my $self = shift;
270            
271 363 100       669 if (@_)
272             {
273 361         605 $self->{_code_numeric} = shift;
274 361         482 return $self;
275             }
276              
277 2         10 $self->{_code_numeric};
278             }
279              
280             sub continent
281             {
282 2     2 1 3 my $self = shift;
283              
284 2 50       8 if (@_)
285             {
286 0         0 $self->{_continent} = shift;
287 0         0 return $self;
288             }
289              
290 2         10 $self->{_continent};
291             }
292              
293             sub currency
294             {
295 8     8 1 23 my $self = shift;
296            
297 8 50       22 if (@_)
298             {
299 0         0 $self->{_currency} = shift;
300 0         0 return $self;
301             }
302              
303 8         21 $self->{_currency};
304             }
305              
306             sub dialing_code
307             {
308 362     362 1 457 my $self = shift;
309            
310 362 100       596 if (@_)
311             {
312 361         570 $self->{_dialing_code} = shift;
313 361         463 return $self;
314             }
315              
316 1         5 $self->{_dialing_code};
317             }
318              
319             sub name
320             {
321 365     365 1 2175 my $self = shift;
322            
323 365 100       605 if (@_)
324             {
325 361         636 $self->{_name} = shift;
326 361         461 return $self;
327             }
328              
329 4         19 $self->{_name};
330             }
331              
332             sub timezone
333             {
334 362     362 1 463 my $self = shift;
335            
336 362 100       612 if (@_)
337             {
338 361         447 my $timezone = shift;
339 361 100       590 return $self unless $timezone;
340 360         1132 $self->{_timezone} = DateTime::TimeZone->new( name => $timezone );
341              
342 360         2489247 return $self;
343             }
344              
345 1         11 $self->{_timezone};
346             }
347              
348             sub all_timezones
349             {
350 2     2 1 623 my $self = shift;
351              
352             # Get the country alpha2 code.
353 2         6 my $code = $self->code_alpha2;
354              
355             # If the all_timezones attribute exists, return it.
356 2 100       7 if ($self->{_all_timezones})
357             {
358 1 50       22 return @{$self->{_all_timezones}} if wantarray;
  0         0  
359 1         5 return $self->{_all_timezones};
360             }
361             # Otherwise, set it.
362             else
363             {
364             # Get all time zones for the country code.
365 1         5 my $results = $db->lookup(
366             table => 'timezone',
367             search_column => 'country_code',
368             result_column => '*',
369             value => $code
370             );
371 1         110 my @timezones;
372            
373 1         3 foreach my $search_result (@{$results})
  1         4  
374             {
375             # Get the timezone from each result.
376 2         7 my $zone = $search_result->{timezone};
377            
378             # Make a new object.
379 2         10 my $tz_object = DateTime::TimeZone->new( name => $zone );
380            
381             # Stick it in an array.
382 2         200 push @timezones, $tz_object;
383             }
384              
385 1         3 $self->{_all_timezones} = \@timezones;
386              
387 1 50       11 return @{$self->{_all_timezones}} if wantarray;
  0         0  
388 1         12 return $self->{_all_timezones};
389             }
390             }
391              
392             1;
393              
394             __END__
395              
396             =head1 NAME
397              
398             Locale::Object::Country - country information objects
399              
400             =head1 DESCRIPTION
401              
402             C<Locale::Object::Country> allows you to create objects containing information about countries such as their ISO codes, currencies and so on.
403              
404             =head1 SYNOPSIS
405              
406             use Locale::Object::Country;
407            
408             my $country = Locale::Object::Country->new( code_alpha2 => 'af' );
409            
410             my $name = $country->name; # 'Afghanistan'
411             my $code_alpha3 = $country->code_alpha3; # 'afg'
412             my $dialing_code = $country->dialing_code; # '93'
413            
414             my $currency = $country->currency;
415             my $continent = $country->continent;
416              
417             my @languages = $country->languages;
418             my @official = $country->languages_official;
419            
420             my $timezone = $country->timezone;
421             my @allzones = @{$country->all_timezones};
422            
423             =head1 METHODS
424              
425             =head2 C<new()>
426              
427             my $country = Locale::Object::Country->new( code => 'af' );
428            
429             The C<new> method creates an object. It takes a single-item hash as an argument - valid options to pass are ISO 3166 values - 'code_alpha2', 'code_alpha3', 'code_numeric' and 'name'.
430              
431             The objects created are singletons; if you try and create a country object when one matching your specification already exists, C<new()> will return the original one.
432              
433             =head2 C<code_alpha2(), code_alpha3(), code_numeric(), name(), dialing_code()>
434              
435             my $name = $country->name;
436            
437             These methods retrieve the values of the attributes whose name they share in the object.
438              
439             =head2 C<currency(), continent()>
440              
441             These methods return L<Locale::Object::Currency> and L<Locale::Object::Continent> objects respectively. Both of those have their own attribute methods, so you can do things like this:
442              
443             my $currency = $country->currency;
444             my $currency_name = $currency->name;
445              
446             See the documentation for those two modules for a listing of currency and continent attributes.
447              
448             =head2 C<languages(), languages_official()>
449              
450             my @languages = $country->languages;
451              
452             C<languages()> returns an array of L<Locale::Object::Language> objects in array context, or a reference in scalar context. The objects have their own attribute methods, so you can do things like this:
453              
454             foreach my $lang (@languages)
455             {
456             print $lang->name, "\n";
457             }
458              
459             C<languages_official()> does much the same thing, but only gives languages that are official in that country. Note: you can also use the C<official()> method of a L<Locale::Object::Language> object on a country object; this will return a boolean value describing whether the language is official in that country.
460              
461             =head2 C<timezone()>
462              
463             my $timezone = $country->timezone;
464            
465             This method will return you a L<DateTime::TimeZone> object corresponding with the time zone in the capital of the country your object represents. See the documentation for that module to see what methods it provides; as a simple example:
466              
467             my $timezone_name = $timezone->name;
468              
469             =head2 C<all_timezones()>
470              
471             my @allzones = @{$country->all_timezones};
472              
473             This method will return an array or array reference, depending on context, of L<DateTime::TimeZone> objects for all time zones that occur in the country your object represents. In most cases this will be only one, and in some cases it will be quite a few (for example, the US, Canada, and Russian Federation).
474              
475             =head1 AUTHOR
476              
477             Originally by Earle Martin
478              
479             =head1 COPYRIGHT AND LICENSE
480              
481             Originally by Earle Martin. To the extent possible under law, the author has dedicated all copyright and related and neighboring rights to this software to the public domain worldwide. This software is distributed without any warranty. You should have received a copy of the CC0 Public Domain Dedication along with this software. If not, see <http://creativecommons.org/publicdomain/zero/1.0/>.
482              
483             =cut