File Coverage

blib/lib/Global/Rainbow/Map.pm
Criterion Covered Total %
statement 24 26 92.3
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 33 35 94.2


line stmt bran cond sub pod time code
1             package Global::Rainbow::Map;
2              
3 2     2   90667 use 5.010;
  2         11  
  2         284  
4 2     2   14 use constant { false => !1, true => !!1 };
  2         4  
  2         241  
5 2     2   14 use strict;
  2         8  
  2         102  
6 2     2   12 use warnings;
  2         2  
  2         91  
7 2     2   2449 use utf8;
  2         21  
  2         10  
8              
9             use constant {
10 2         144 stylesheet_xpath => '//*[@id="style_css_sheet"]',
11 2     2   110 };
  2         4  
12              
13             BEGIN {
14 2     2   4 $Global::Rainbow::Map::AUTHORITY = 'cpan:TOBYINK';
15 2         37 $Global::Rainbow::Map::VERSION = '0.001';
16             }
17              
18 2     2   1929 use Color::Library 0 ();
  2         437805  
  2         117  
19 2     2   2319 use XML::LibXML 0 ();
  0            
  0            
20              
21             sub get_template
22             {
23             state $template = XML::LibXML->load_xml(IO => \*DATA);
24             return $template;
25             }
26              
27             sub clone_template
28             {
29             my ($class) = @_;
30             $class->get_template->cloneNode(true);
31             }
32              
33             sub new
34             {
35             my ($class, %args) = @_;
36             bless \%args => $class;
37             }
38              
39             sub countries
40             {
41             my ($self) = @_;
42             grep { /^[a-z][a-z0-9-]*[a-z0-9]$/ } sort keys %$self;
43             }
44              
45             sub colour_for_country
46             {
47             my ($self, $country) = @_;
48            
49             my $colour = $self->{$country};
50             defined $colour or return;
51            
52             my $hex;
53             if ($colour =~ m{^\#?([0-9a-f]{6})$}i)
54             {
55             $hex = lc sprintf('#%s', $1);
56             }
57             elsif ($colour =~ m{^\#?([0-9a-f])([0-9a-f])([0-9a-f])$}i)
58             {
59             $hex = lc sprintf('#%s%s%s%s%s%s', $1, $1, $2, $2, $3, $3);
60             }
61            
62             defined $hex and return Color::Library::Color->new(
63             id => $hex,
64             name => $hex,
65             title => $hex,
66             dictionary => undef,
67             value => $hex,
68             );
69            
70             state $library = Color::Library->dictionary(qw/svg x11/);
71             return scalar $library->color($colour);
72             }
73              
74             sub generate_css
75             {
76             my ($self) = @_;
77             my $str = '';
78            
79             foreach my $country ($self->countries)
80             {
81             my $colour = $self->colour_for_country($country)->svg;
82             $str .= <<"CSS";
83             .${country} {
84             fill: $colour;
85             opacity: 1;
86             }
87             CSS
88             }
89            
90             return $str;
91             }
92              
93             sub libxml_document
94             {
95             my ($self) = @_;
96             my $class = (ref $self // $self);
97             my $doc = $class->clone_template;
98             my $styles = $doc->findnodes($class->stylesheet_xpath)->get_node(1);
99             $styles->appendText($self->generate_css);
100             return $doc;
101             }
102              
103             sub svg
104             {
105             my ($self) = @_;
106             $self->libxml_document->toString;
107             }
108              
109             # This just doesn't seem to work. :-(
110             our $png =
111             q{
112             use File::Temp 0 ();
113             use SVG::Parser 0 ();
114             use SVG::Parser::Expat 0 ();
115             use SVG::Parser::SAX 0 ();
116             use SVG::Rasterize 0 ();
117            
118             my ($self, $width, $height) = @_;
119             $width ||= 640;
120             $height ||= 480;
121            
122             my $temp_file = File::Temp->new(UNLINK => 1);
123            
124             state $parser = SVG::Parser->new;
125             my $svg = $parser->parse($self->svg);
126            
127             my $rasterize = SVG::Rasterize->new(
128             svg => $svg,
129             width => $width,
130             height => $height,
131             );
132             $rasterize->rasterize;
133             $rasterize->write(
134             type => 'png',
135             file_name => $temp_file->filename,
136             );
137            
138             return do { local(@ARGV, $/) = $temp_file->filename; <> };
139             };
140              
141              
142             =encoding utf8
143              
144             =head1 NAME
145              
146             Global::Rainbow::Map - make the world look like a rainbow, but usefully
147              
148             =head1 SYNOPSIS
149              
150             my $map = Global::Rainbow::Map->new(
151             gb => 'red',
152             ca => 'orange',
153             in => 'yellow',
154             nz => 'green',
155             au => 'blue',
156             lk => 'purple',
157             );
158             print $map->svg;
159              
160             =head1 DESCRIPTION
161              
162             Global::Rainbow::Map generates a map of the world (Robinson projection)
163             with each country shaded whatever colour you like. In fact, you can even
164             choose colours that don't appear in the rainbow... like magenta!
165              
166             The possibilities for such a module are clearly endless. If you had a
167             table listing per-capita alcohol consumption, you could create a map of
168             the world in different colours to illustrate per-capita alcohol
169             consumption. Or if you had a table of which countries had won the most
170             Olympic medals for swimming, then you could create a map of the world
171             in different colours to illustrate which countries had won the most
172             Olympic medals for swimming.
173              
174             The template map used is Wikipedia's public domain blank world map
175             L, the 14 Feb
176             2012 revision.
177              
178             =head2 Constructor
179              
180             =over
181              
182             =item C<< new(%colours) >>
183              
184             Creates a new map. The hash is a list of country code to colour pairings.
185              
186             Country codes are typically ISO 3166-1 two letter codes. If you don't
187             know the code for a particular country, L can help
188             you out. There are a number of additional codes like "eu" (the whole
189             European Union) and "aq" (Antarctica). These codes are all lower case.
190              
191             Colours can be hexadecimal codes like '#ff0000' or named colours from
192             the SVG or X11 palettes. Countries not coloured will remain a pale
193             grey.
194              
195             Hash keys which do not match the regular expression
196             C<< /^[a-z][a-z0-9-]*[a-z0-9]$/ >>, in particular hash keys starting
197             with a hyphen are reserved for future use.
198              
199             =back
200              
201             =head2 Object Methods
202              
203             The useful ones:
204              
205             =over
206              
207             =item C<< svg >>
208              
209             Returns the coloured SVG map as a string.
210              
211             =item C<< libxml_document >>
212              
213             Returns the same coloured SVG map, but as an L.
214              
215             =back
216              
217             Somewhat less useful for everyday use, but may be useful for people
218             subclassing this module...
219              
220             =over
221              
222             =item C<< countries >>
223              
224             Returns the list of country codes which have been explicitly assigned a
225             colour (i.e. the keys to the hash given in the constructor).
226              
227             =item C<< colour_for_country($country_code) >>
228              
229             Returns the colour for a country, as a blessed L
230             object.
231              
232             Will return undef if the country has not been explicitly assigned a
233             colour.
234              
235             =item C<< generate_css >>
236              
237             Generates the CSS that would be inserted into the SVG output.
238              
239             =back
240              
241             =head2 Class Methods
242              
243             Again, these are mostly useful for people subclassing the module.
244              
245             =over
246              
247             =item C<< get_template >>
248              
249             Returns the template used for maps as an L.
250              
251             Fetching the template and modifying it using DOM methods will affect all
252             maps subsequently generated for the lifetime of the process. So beware.
253              
254             =item C<< clone_template >>
255              
256             As per C, but returns a clone of the template.
257              
258             =back
259              
260             =head1 BUGS
261              
262             Please report any bugs to
263             L.
264              
265             =head1 SEE ALSO
266              
267             L.
268              
269             L.
270              
271             =head1 AUTHOR
272              
273             Toby Inkster Etobyink@cpan.orgE.
274              
275             =head1 COPYRIGHT AND LICENCE
276              
277             Toby Inkster, 2012. No rights reserved.
278              
279             To the extent possible under law, Toby Inkster has waived all copyright
280             and related or neighboring rights to Global::Rainbow::Map. This work is
281             published from: United Kingdom.
282              
283             L.
284              
285             =head1 DISCLAIMER OF WARRANTIES
286              
287             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
288             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
289             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
290              
291             =cut
292              
293             __PACKAGE__
294              
295             __DATA__