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

package Global::Rainbow::Map;

use 5.010;
use constant { false => !1, true => !!1 };
use strict;
use warnings;
use utf8;

use constant {
	stylesheet_xpath  => '//*[@id="style_css_sheet"]',
};

BEGIN {
	$Global::Rainbow::Map::AUTHORITY = 'cpan:TOBYINK';
	$Global::Rainbow::Map::VERSION   = '0.001';
}

use Color::Library 0      ();
use XML::LibXML 0         ();

sub get_template
{
	state $template = XML::LibXML->load_xml(IO => \*DATA);
	return $template;
}

sub clone_template
{
	my ($class) = @_;
	$class->get_template->cloneNode(true);
}

sub new
{
	my ($class, %args) = @_;
	bless \%args => $class;
}

sub countries
{
	my ($self) = @_;
	grep { /^[a-z][a-z0-9-]*[a-z0-9]$/ } sort keys %$self;
}

sub colour_for_country
{
	my ($self, $country) = @_;

	my $colour = $self->{$country};
	defined $colour or return;

	my $hex;
	if ($colour =~ m{^\#?([0-9a-f]{6})$}i)
	{
		$hex = lc sprintf('#%s', $1);
	}
	elsif ($colour =~ m{^\#?([0-9a-f])([0-9a-f])([0-9a-f])$}i)
	{
		$hex = lc sprintf('#%s%s%s%s%s%s', $1, $1, $2, $2, $3, $3);
	}

	defined $hex and return Color::Library::Color->new(
		id         => $hex,
		name       => $hex,
		title      => $hex,
		dictionary => undef,
		value      => $hex,
	);

	state $library = Color::Library->dictionary(qw/svg x11/);
	return scalar $library->color($colour);
}

sub generate_css
{
	my ($self) = @_;
	my $str = '';

	foreach my $country ($self->countries)
	{
		my $colour = $self->colour_for_country($country)->svg;
		$str .= <<"CSS";
.${country} {
	fill: $colour;
	opacity: 1;
}
CSS
	}

	return $str;
}

sub libxml_document
{
	my ($self) = @_;
	my $class  = (ref $self // $self);
	my $doc    = $class->clone_template;
	my $styles = $doc->findnodes($class->stylesheet_xpath)->get_node(1);
	$styles->appendText($self->generate_css);
	return $doc;
}

sub svg
{
	my ($self) = @_;
	$self->libxml_document->toString;
}

# This just doesn't seem to work. :-(
our $png =
q{
	use File::Temp 0          ();
	use SVG::Parser 0         ();
	use SVG::Parser::Expat 0  ();
	use SVG::Parser::SAX 0    ();
	use SVG::Rasterize 0      ();

	my ($self, $width, $height) = @_;
	$width  ||= 640;
	$height ||= 480;

	my $temp_file = File::Temp->new(UNLINK => 1);

	state $parser = SVG::Parser->new;
	my $svg = $parser->parse($self->svg);

	my $rasterize = SVG::Rasterize->new(
		svg     => $svg,
		width   => $width,
		height  => $height,
	);
	$rasterize->rasterize;
	$rasterize->write(
		type      => 'png',
		file_name => $temp_file->filename,
	);

	return do { local(@ARGV, $/) = $temp_file->filename; <> };
};


=encoding utf8

=head1 NAME

Global::Rainbow::Map - make the world look like a rainbow, but usefully

=head1 SYNOPSIS

 my $map = Global::Rainbow::Map->new(
   gb => 'red',
   ca => 'orange',
   in => 'yellow',
   nz => 'green',
   au => 'blue',
   lk => 'purple',
 );
 print $map->svg;

=head1 DESCRIPTION

Global::Rainbow::Map generates a map of the world (Robinson projection)
with each country shaded whatever colour you like. In fact, you can even
choose colours that don't appear in the rainbow... like magenta!

The possibilities for such a module are clearly endless. If you had a
table listing per-capita alcohol consumption, you could create a map of
the world in different colours to illustrate per-capita alcohol
consumption. Or if you had a table of which countries had won the most
Olympic medals for swimming, then you could create a map of the world
in different colours to illustrate which countries had won the most
Olympic medals for swimming.

The template map used is Wikipedia's public domain blank world map
L, the 14 Feb
2012 revision.

=head2 Constructor

=over

=item C<< new(%colours) >>

Creates a new map. The hash is a list of country code to colour pairings.

Country codes are typically ISO 3166-1 two letter codes. If you don't
know the code for a particular country, L can help
you out. There are a number of additional codes like "eu" (the whole
European Union) and "aq" (Antarctica). These codes are all lower case.

Colours can be hexadecimal codes like '#ff0000' or named colours from
the SVG or X11 palettes. Countries not coloured will remain a pale
grey.

Hash keys which do not match the regular expression
C<< /^[a-z][a-z0-9-]*[a-z0-9]$/ >>, in particular hash keys starting
with a hyphen are reserved for future use.

=back

=head2 Object Methods

The useful ones:

=over

=item C<< svg >>

Returns the coloured SVG map as a string.

=item C<< libxml_document >>

Returns the same coloured SVG map, but as an L.

=back

Somewhat less useful for everyday use, but may be useful for people
subclassing this module...

=over

=item C<< countries >>

Returns the list of country codes which have been explicitly assigned a
colour (i.e. the keys to the hash given in the constructor).

=item C<< colour_for_country($country_code) >>

Returns the colour for a country, as a blessed L
object.

Will return undef if the country has not been explicitly assigned a
colour.

=item C<< generate_css >>

Generates the CSS that would be inserted into the SVG output.

=back

=head2 Class Methods

Again, these are mostly useful for people subclassing the module.

=over

=item C<< get_template >>

Returns the template used for maps as an L.

Fetching the template and modifying it using DOM methods will affect all
maps subsequently generated for the lifetime of the process. So beware.

=item C<< clone_template >>

As per C, but returns a clone of the template.

=back

=head1 BUGS

Please report any bugs to
L.

=head1 SEE ALSO

L.

L.

=head1 AUTHOR

Toby Inkster [e-mail].

=head1 COPYRIGHT AND LICENCE

Toby Inkster, 2012. No rights reserved.

To the extent possible under law, Toby Inkster has waived all copyright
and related or neighboring rights to Global::Rainbow::Map. This work is
published from: United Kingdom.

L.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

=cut

__PACKAGE__

__DATA__