Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 6e01bb2f07
Fetching contributors…

Cannot retrieve contributors at this time

269 lines (228 sloc) 8.343 kb
#!/usr/bin/perl -w
use strict;
use File::Copy;
# use Image::WorldMap;
use Template;
use XML::LibXML;
my $src_file = shift || './perl_mongers.xml';
my %ids;
my %colours = (
africa => [64,255,64],
asia => [255,255,0],
europe => [128,128,255],
north_america => [255,0,0],
central_america => [0,255,0],
south_america => [255,0,255],
oceania => [0,255,255],
);
$| = 1;
my $tt = Template->new({
PRE_PROCESS => [ 'lib/macros' ],
POST_CHOMP => 1,
PRE_CHOMP => 1,
TRIM => 1,
EVAL_PERL => 1 ,
INCLUDE_PATH => ['.', 'lib', 'src'],
# PROCESS => 'layout',
});
my %allgroups;
# Array containing all the group names order by continent
my %groups;
mkdir 'www/groups/graphics';
# my $worldmap = Image::WorldMap->new('titchy.png');
my $xml = XML::LibXML->new();
my $doc = $xml->parse_file($src_file);
foreach my $g ($doc->findnodes('//group')) {
my $id = $g->getAttribute('id');
my $status = $g->getAttribute('status') || 'not-specified-in-xml-file';
my $name = $g->findvalue('name/text()');
my $city = $g->findvalue('location/city/text()');
my $state = $g->findvalue('location/state/text()');
my $region = $g->findvalue('location/region/text()');
my $country = $g->findvalue('location/country/text()');
my $continent = $g->findvalue('location/continent/text()');
my $longitude = $g->findvalue('location/longitude/text()');
my $latitude = $g->findvalue('location/latitude/text()');
my $web = $g->findvalue('web/text()');
my $tsar = $g->findvalue('tsar/name/text()');
my $tsaremail = $g->findvalue('tsar/email/text()');
my $image; # points to little world map if we have one
die "Duplicate group id $id\n" if $ids{$id}++;
next unless $status eq 'active' || $status eq 'sleeping';
die "$name has no id\n" unless defined $id;
if ($name eq 'MarsNeedsWomen.pm' ||
$name eq 'Nomads.pm' ||
$name eq 'PerlMonks.pm' ||
$name eq 'Camelot.pm' ||
$name eq 'German.pm' ||
$name eq 'Amiga.pm' ||
$name eq '#Perl.pm' ||
$name eq 'PBP.pm' ||
$name eq 'dahut.pm'
) {
$continent = 'Non-geographical';
$country = 'Non-geographical';
}
if ($name eq 'EU.pm') {
$country = 'Non-geographical';
}
unless ($continent) {
warn "$name has no continent";
next;
}
unless ($country) {
warn "$name has no country";
next;
}
# joined up city, state, region, country, continent
my $location = join ', ', grep { $_ }
($city, $state, $region, $country, $continent);
if ($longitude && $latitude) {
# first add to world map
my $c = lc $continent;
$c =~ s/\W/_/g;
my $colour = $colours{$c} || die;
# $worldmap->add($longitude, $latitude, 'group', $colour);
# have we drawn the single-country map already?
unless (-f 'www/groups/graphics/$id.png') {
# my $map = Image::WorldMap->new('titchy.png');
# $map->add($longitude, $latitude, 'group', $colour);
# $map->draw('foo.png');
# system("pngtopnm foo.png | ppmquant 64 2>/dev/null | pnmtopng -compression 9 > www/groups/graphics/$id.png");
# $image = "graphics/$id.png";
}
} else {
warn "Group $name in $location missing location\n";
}
$tsaremail =~ s/@/ at /g;
my $group = {
continent => $continent,
id => $id,
image => $image,
latitude => $latitude,
location => $location,
longitude => $longitude,
name => $name,
tsar => $tsar,
tsaremail => $tsaremail,
state => $state,
status => $status,
web => $web,
};
$allgroups{$name} = $group;
if ($country eq 'United States of America') {
push @{$groups{$continent}{$country}{$state}}, $group;
} else {
push @{$groups{$continent}{$country}}, $group;
}
unless (-f "www/groups/$id.html") {
$tt->process('src/groups/group.html', $group, "www/groups/$id.html")
|| die $tt->error();
}
}
copy('./perl_mongers.xml', 'www/groups/perl_mongers.xml');
copy('./perl_mongers.dtd', 'www/groups/perl_mongers.dtd');
my @continents = ('Africa', 'Asia', 'Europe', 'North America',
'Central America', 'South America', 'Oceania',
'Non-geographical');
foreach my $continent (@continents) {
my $name = lc $continent;
$name =~ s/\W/_/g;
my $file = "www/groups/$name.html";
my $groups;
# my $map = Image::WorldMap->new('titchy.png');
foreach my $country (sort keys %{$groups{$continent}}) {
if ($country eq 'United States of America') {
foreach my $state (keys %{$groups{$continent}{$country}}) {
$groups->{$country}{$state} = [ sort { lc $a->{name} cmp
lc $b->{name} }
@{$groups{$continent}{$country}{$state}} ];
}
} else {
$groups->{$country} = [ sort { lc $a->{name} cmp lc $b->{name} }
@{$groups{$continent}{$country}} ];
}
}
my $colour = $colours{$name};
foreach my $group (values %allgroups) {
my $name = $group->{name};
my $status = $group->{status} || 'not-specified-in-xml-file';
next unless $status eq 'active' || $status eq 'sleeping';
next unless $group->{continent} eq $continent;
if ($group->{longitude} && $group->{latitude}) {
# $map->add($group->{longitude}, $group->{latitude}, 'group', $colour);
}
}
# $map->draw('foo.png');
# system("pngtopnm foo.png | ppmquant 127 2>/dev/null | pnmtopng -compression 9 > www/groups/graphics/$name.png");
my $conf = {
groups => $groups,
continent => $continent,
};
$conf->{image} = "graphics/$name.png" unless $name eq 'non_geographical';
$tt->process('src/groups/continent.html', $conf, $file)
|| die $tt->error();
#use YAML; die Dump($groups);
#use Data::Dumper; die Dumper($groups);
}
# $worldmap->draw('foo.png');
# system('pngtopnm foo.png | ppmquant 255 2> /dev/null | pnmtopng -compression 9 > www/groups/graphics/world.png');
__END__
=head1 NAME
draw.pl - draw the master copies of the Perl Monger World Maps
=head1 SYNOPSIS
draw.pl [-huge]
=head1 DESCRIPTION
This uses the two large earth.png, earth-small.png, and the Perl Monger
Group XML file, perl_mongers.xml. It takes the longitude and latitude
location information contained in the XML file and produces one of
two image files: mongers.png and mongers-small.png.
It also outputs a list of all the groups which do not current have
location information.
=head1 AUTHOR
Leon Brocard, leon@astray.com
=cut
__END__
Example data structure for a group:
$VAR1 = {
'location' => {
'state' => {},
'country' => 'Ireland',
'latitude' => '52.664',
'region' => {},
'city' => 'Limerick',
'longitude' => '-8.623',
'continent' => 'Europe'
},
'web' => {},
'tsar' => {
'email' => {
'content' => 'foranp@tinet.ie',
'type' => 'personal'
},
'name' => 'Paul Foran'
},
'date' => {
'content' => '19990214',
'type' => 'inception'
},
'id' => '134',
'mailing-list' => {
'subscribe' => 'subscribe limerick-pm-list email_address',
'unsubscribe' => 'unsubscribe limerick-pm-list email_address',
'email' => [
{
'content' => 'limerick-pm-list@pm.org',
'type' => 'list'
},
{
'content' => 'majordomo@pm.org',
'type' => 'list_admin'
}
],
'name' => 'General Limerick.pm discussion'
},
'email' => {
'type' => 'group'
}
};
Jump to Line
Something went wrong with that request. Please try again.