File Coverage

blib/lib/Locale/Object/Continent.pm
Criterion Covered Total %
statement 57 63 90.4
branch 12 22 54.5
condition n/a
subroutine 13 13 100.0
pod 3 5 60.0
total 85 103 82.5


line stmt bran cond sub pod time code
1             package Locale::Object::Continent;
2              
3 7     7   96245 use strict;
  7         21  
  7         167  
4 7     7   30 use warnings;;
  7         11  
  7         157  
5 7     7   28 use Carp qw(croak);
  7         12  
  7         281  
6              
7 7     7   433 use Locale::Object;
  7         11  
  7         191  
8 7     7   33 use base qw( Locale::Object );
  7         21  
  7         909  
9              
10 7     7   1225 use Locale::Object::Country;
  7         17  
  7         205  
11 7     7   1162 use Locale::Object::DB;
  7         27  
  7         29650  
12              
13             our $VERSION = '0.78';
14              
15             my $db = Locale::Object::DB->new();
16              
17             # Initialize the hash where we'll keep our singleton continent objects.
18             my $existing = {};
19              
20             # Yours is the hash, and everything that's in it.
21             my %continents = map { $_ => undef }
22             ('Africa', 'Asia', 'Europe', 'North America', 'Oceania', 'South America');
23            
24             # Initialize the object.
25             sub init
26             {
27 363     363 0 587 my $self = shift;
28 363         693 my %params = @_;
29 363 50       734 return unless %params;
30            
31             # Two's a crowd.
32 363         585 my $num_params = keys %params;
33            
34 363 50       704 croak "Error: No continent name specified for initialization." unless $params{name};
35 363 50       751 croak "Error: You can only specify a single continent name for initialization."
36             if $num_params > 1;
37            
38             # Check for pre-existing objects. Return it if there is one.
39 363         843 my $continent = $self->exists($params{name});
40 363 100       1545 return $continent if $continent;
41            
42             # Initialize with a continent name.
43 20         43 my $name = $params{name};
44 20         64 $self->{_name} = $name;
45              
46             # Register the new object.
47 20         66 $self->register();
48            
49             # Return the object.
50 20         69 $self;
51             }
52              
53             # Check if objects exist in the singletons hash.
54             sub exists {
55 363     363 1 485 my $self = shift;
56            
57             # Check existence of a object with the given parameter or with
58             # the name of the current object.
59 363         482 my $name = shift;
60            
61             # Return the singleton object, if it exists.
62 363         732 $existing->{$name};
63             }
64              
65             # Register the object as a singleton.
66             sub register {
67 20     20 0 38 my $self = shift;
68            
69             # Do nothing unless the object has a name.
70 20 50       78 my $name = $self->name or return;
71            
72             # Put the current object into the singleton hash.
73 20         56 $existing->{$name} = $self;
74             }
75              
76             sub name
77             {
78 22     22 1 606 my $self = shift;
79 22         33 my $name = shift;
80            
81             # If no arguments were given, return the name attribute of the current object.
82             # Otherwise, carry on and set one on the current object.
83 22 50       98 return $self->{_name} unless defined $name;
84            
85             # Check we didn't fall off the edge of the world.
86             # http://www.maphist.nl/extra/herebedragons.html
87 0 0       0 croak "Error: unknown continent name given for initialization: '$name'" unless exists $continents{$name};
88            
89             # Set the name.
90 0         0 $self->{_name} = $name;
91            
92             # If a Continent object with that name exists, return it.
93 0 0       0 if (my $continent = $self->exists( $name ))
94             {
95 0         0 return $continent;
96             }
97             # Otherwise, register the current object as a singleton.
98             else
99             {
100 0         0 $self->register();
101             }
102            
103             # Return the current object.
104 0         0 $self;
105             }
106              
107             # Method for retrieving all countries in this continent.
108             sub countries
109             {
110 3     3 1 594 my $self = shift;
111            
112             # No name, no countries.
113 3 50       13 return unless $self->{_name};
114            
115             # Check for countries attribute. Set it if we don't have it.
116 3 100       18 _set_countries($self) unless $self->{_countries};
117              
118             # Give an array if requested in array context, otherwise a reference.
119 3 100       12 return @{$self->{_countries}} if wantarray;
  2         26  
120 1         9 return $self->{_countries};
121             }
122              
123             # Private method to set an attribute with an array of objects for all countries in this continent.
124             sub _set_countries
125             {
126 2     2   5 my $self = shift;
127              
128 2         5 my (%country_codes, @countries);
129            
130             # If it doesn't, find all countries in this continent.
131             my $result = $db->lookup(
132             table => 'continent',
133             result_column => 'country_code',
134             search_column => 'name',
135 2         14 value => $self->{'_name'}
136             );
137              
138             # Create new country objects and put them into an array.
139 2         1005 foreach my $place (@{$result})
  2         8  
140             {
141 94         197 my $where = $place->{'country_code'};
142              
143 94         465 my $obj = Locale::Object::Country->new( code_alpha2 => $where );
144 94         282 push @countries, $obj;
145             }
146            
147             # Set a reference to that array as an attribute.
148 2         37 $self->{'_countries'} = \@countries;
149             }
150              
151             1;
152              
153             __END__
154              
155             =head1 NAME
156              
157             Locale::Object::Continent - continent information objects
158              
159             =head1 DESCRIPTION
160              
161             C<Locale::Object::Continent> allows you to create objects representing continents, that contain other objects representing the continent in question's countries.
162              
163             =head1 SYNOPSIS
164              
165             my $asia = Locale::Object::Continent->new( name => 'Asia' );
166              
167             my $name = $asia->name;
168             my @countries = $asia->countries;
169              
170             =head1 METHODS
171              
172             =head2 C<new()>
173              
174             my $asia = Locale::Object::Continent->new( name => 'Asia' );
175            
176             The C<new> method creates an object. It takes a single-item hash as an argument - the only valid options to it is 'name', which must be one of 'Africa', 'Asia', 'Europe', 'North America', 'Oceania' or 'South America'. Support for Antarctic territories is not currently provided.
177              
178             The objects created are singletons; if you try and create a continent object when one matching your specification already exists, C<new()> will return the original one.
179              
180             =head2 C<name()>
181              
182             my $name = $asia->name;
183            
184             Retrieves the value of the continent object's name.
185              
186             =head2 C<countries()>
187              
188             my @countries = $asia->countries;
189              
190             Returns an array of L<Locale::Object::Country> objects with their ISO 3166 alpha2 codes as keys in array context, or a reference in scalar context. The objects have their own attribute methods, so you can do things like this:
191              
192             foreach my $place (@countries)
193             {
194             print $place->name, "\n";
195             }
196            
197             Which will list you all the currencies used in that continent. See the documentation for L<Locale::Object::Country> for a listing of country attributes. Note that you can chain methods as well.
198              
199             foreach my $place (@countries)
200             {
201             print $place->currency->name, "\n";
202             }
203              
204             =head1 AUTHOR
205              
206             Originally by Earle Martin
207              
208             =head1 COPYRIGHT AND LICENSE
209              
210             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/>.
211              
212             =cut