view release on metacpan or  search on metacpan

lib/Global/Rainbow/Map.pm  view on Meta::CPAN

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.002';
}

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);