Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 462 lines (394 sloc) 16.684 kb
#! env perl
use strict;
use warnings;
use Data::Dumper qw(Dumper);
use File::Copy qw(copy);
use File::Find::Rule;
use File::Path qw(mkpath);
use File::Spec::Functions qw(splitpath);
use Template;
use XML::LibXML;
# Added by Leo for perl_mongers.json
use JSON;
use File::Slurp;
my $src_file = shift || './perl_mongers.xml';
my %ids;
$| = 1;
# longitude, latitude, zoom
my %map_coordinates = (
africa => [ 20, -1, 3 ],
asia => [ 95, 45, 2 ],
central_america => [ -76, 9, 3 ],
europe => [ 15.029297, 49.61071, 3 ],
north_america => [ -90, 40, 3 ],
oceania => [ 134.296875, -25.641526, 3 ],
south_america => [ -63.63, -20.00, 3 ],
non_geographical => [ 0, 0, 2 ],
'South Africa' => [ 24, -29, 5 ],
Uganda => [ 32, 1.5, 6 ],
Armenia => [ 95, 45, 2 ],
China => [ 95, 35, 3 ],
India => [ 80, 20, 4 ],
Indonesia => [ 115, -5, 4 ],
Iran => [ 54, 33, 5 ],
Israel => [ 35, 31.5, 7 ],
Japan => [ 95, 45, 2 ],
'Korea (Republic of)' => [ 95, 45, 2 ],
Malaysia => [ 95, 45, 2 ],
Nepal => [ 84, 28, 6 ],
Philippines => [ 120, 12, 5 ],
Qatar => [ 95, 45, 2 ],
Russia => [ 95, 45, 2 ],
Singapore => [ 95, 45, 2 ],
Taiwan => [ 95, 45, 2 ],
Thailand => [ 101, 13, 5 ],
Turkey => [ 95, 45, 2 ],
Austria => [ 15.029297, 49.61071, 3 ],
Belgium => [ 4.4, 51, 9 ],
Bulgaria => [ 15.029297, 49.61071, 3 ],
'Czech Republic' => [ 15.4, 49.67, 7 ],
Denmark => [ 15.029297, 49.61071, 3 ],
Estonia => [ 15.029297, 49.61071, 3 ],
Finland => [ 15.029297, 49.61071, 3 ],
France => [ 15.029297, 49.61071, 3 ],
Germany => [ 15.029297, 49.61071, 3 ],
Greece => [ 23, 39, 6 ],
'Hrvatska (Croatia)' => [ 15.029297, 49.61071, 3 ],
Hungary => [ 15.029297, 49.61071, 3 ],
Ireland => [ 15.029297, 49.61071, 3 ],
Italy => [ 15.029297, 49.61071, 3 ],
'Moldova, Republic of' => [ 15.029297, 49.61071, 3 ],
Netherlands => [ 15.029297, 49.61071, 3 ],
Norway => [ 15.029297, 49.61071, 3 ],
Poland => [ 15.029297, 49.61071, 3 ],
Portugal => [ 15.029297, 49.61071, 3 ],
Romania => [ 15.029297, 49.61071, 3 ],
'Russian Federation' => [ 15.029297, 49.61071, 3 ],
'Slovak Republic' => [ 15.029297, 49.61071, 3 ],
Spain => [ 15.029297, 49.61071, 3 ],
Sweden => [ 15.029297, 49.61071, 3 ],
Switzerland => [ 15.029297, 49.61071, 3 ],
'The Republic of Belarus' => [ 15.029297, 49.61071, 3 ],
Ukraine => [ 15.029297, 49.61071, 3 ],
'United Kingdom' => [ 15.029297, 49.61071, 3 ],
Yugoslavia => [ 15.029297, 49.61071, 3 ],
Canada => [ -90, 40, 3 ],
Mexico => [ -102, 23, 5 ],
Guatemala => [ -90.4, 15.8, 7 ],
USA => [ -90, 40, 3 ],
'United States of America' => [ -90, 40, 3 ],
'Costa Rica' => [ -76, 9, 3 ],
Argentina => [ -63.63, -20.00, 3 ],
Brazil => [ -50.63, -14.00, 4 ],
Chile => [ -63.63, -20.00, 3 ],
Colombia => [ -63.63, -20.00, 3 ],
Ecuador => [ -63.63, -20.00, 3 ],
Paraguay => [ -63.63, -20.00, 3 ],
Peru => [ -63.63, -20.00, 3 ],
Venezuela => [ -63.63, -20.00, 3 ],
'Australia' => [ 134.296875, -25.641526, 3 ],
'New Zealand' => [ 134.296875, -25.641526, 3 ],
'Non-geographical' => [ 0, 0, 1 ],
);
my $tt = Template->new(
{ PRE_PROCESS => ['lib/macros'],
POST_CHOMP => 1,
PRE_CHOMP => 1,
TRIM => 1,
EVAL_PERL => 1,
INCLUDE_PATH => [ '.', 'lib', 'src' ],
ENCODING => 'utf8',
# PROCESS => 'layout',
}
);
my %allgroups;
# Array containing all the group names order by continent
my %groups;
mkdir 'www/groups/graphics';
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 $linkedin = $g->findvalue('linkedin/text()');
my $googleplus = $g->findvalue('googleplus/text()');
my $facebook = $g->findvalue('facebook/text()');
my $twitter = $g->findvalue('twitter/text()');
my $meetup = $g->findvalue('meetup/text()');
my @tsar;
foreach my $t ( $g->findnodes('tsar') ) {
my $tsar = $t->findvalue('name/text()');
my $tsaremail = $t->findvalue('email/user/text()');
#$tsaremail .= ' <' . int(rand(100)) . '> ';
$tsaremail .= ' <replace me by @> ';
$tsaremail .= $t->findvalue('email/domain/text()');
push @tsar, { name => $tsar, mail => $tsaremail };
}
my $mailing_lists_name = $g->findvalue('mailing_list/name/text()');
# if ($mailing_lists_name) { print STDERR "M $mailing_lists_name\n" }
die "Duplicate group id $id\n" if $ids{$id}++;
next unless $status eq 'active';
die "$name has no id\n" unless defined $id;
unless ($continent) {
warn "$name has no continent. Assuming Non-geographical.\n";
$continent = 'Non-geographical';
}
unless ($country) {
warn "$name has no country. Assuming Non-geographical.\n";
$country = 'Non-geographical';
}
# joined up city, state, region, country, continent
my $location = join ', ',
grep {$_} ( $city, $state, $region, $country, $continent );
my $linked_location = join ', ', grep {$_} ( $city, $state, $region );
if ( $country and $country ne 'Non-geographical' ) {
my $country_link = lc $country;
$country_link =~ s/\W/_/g;
$linked_location .= qq(, <a href="$country_link.html">$country</a>);
}
if ($continent) {
my $continent_link
= $continent eq 'Non-geographical'
? 'non_geographical'
: lc($continent);
$continent_link =~ s/ /_/;
$linked_location
.= qq(, <a href="$continent_link.html">$continent</a>);
}
#$tsaremail =~ s/@/ at /g;
my $group = {
continent => $continent,
id => $id,
location => $location,
linked_location => $linked_location,
longitude => $longitude,
latitude => $latitude,
zoom => 11,
name => $name,
tsar => \@tsar,
state => $state,
status => $status,
web => $web,
mailing_list => { name => $mailing_lists_name, },
linkedin => $linkedin,
googleplus => $googleplus,
facebook => $facebook,
twitter => $twitter,
meetup => $meetup,
};
$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" ) {
$group->{description}
= "Perl Mongers $location is the Perl users group that organizes meetings";
#print "PROCESS group: www/groups/$id.html\n";
$tt->process(
'src/groups/group.html', $group,
"www/groups/$id.html", binmode => ':utf8'
) || 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 %country_links;
my %states;
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} } ];
$states{$state} = 'usa_' . lc $state;
$states{$state} =~ s/\W/_/g;
$states{$state} .= '.html';
#warn "WARN: Missing map_coordinates for $country" if not $map_coordinates{$country};
my $conf = {
groups => $groups->{$country}{$state},
country => $state,
continent => $continent,
continent_link => "$name.html",
longitude => $map_coordinates{$country}[0],
latitude => $map_coordinates{$country}[1],
zoom => $map_coordinates{$country}[2],
#states => \%states,
};
$conf->{description}
= "Perl Mongers in $state are the Perl users groups that organize meetings";
#print "PROCESS US state: www/groups/$states{$state}\n";
$tt->process(
'src/groups/country.html', $conf,
"www/groups/$states{$state}", binmode => ':utf8'
) || die $tt->error();
}
} else {
$groups->{$country} = [ sort { lc $a->{name} cmp lc $b->{name} }
@{ $groups{$continent}{$country} } ];
}
my $country_file = lc $country;
$country_file =~ s/\W/_/g;
$country_links{$country} = "$country_file.html";
$country_file = "www/groups/$country_file.html";
warn "WARN: Missing map_coordinates for $country"
if not $map_coordinates{$country};
my $conf = {
groups => $groups->{$country},
country => $country,
#country_file => $country_file,
continent => $continent,
continent_link => "$name.html",
longitude => $map_coordinates{$country}[0],
latitude => $map_coordinates{$country}[1],
zoom => $map_coordinates{$country}[2],
states => \%states,
};
$conf->{description}
= "Perl Mongers in $country are the Perl users groups that organize meetings";
#print "PROCESS country: $country_file\n";
$tt->process( 'src/groups/country.html', $conf, $country_file,
binmode => ':utf8' )
|| die $tt->error();
}
warn "WARN: Missing map_coordinates for $name"
if not $map_coordinates{$name};
my $conf = {
country_links => \%country_links,
groups => $groups,
continent => $continent,
longitude => $map_coordinates{$name}[0],
latitude => $map_coordinates{$name}[1],
zoom => $map_coordinates{$name}[2],
states => \%states,
};
$conf->{description}
= "Perl Mongers in $continent are the Perl users groups that organize meetings";
#print "PROCESS continent: $file\n";
$tt->process( 'src/groups/continent.html', $conf, $file,
binmode => ':utf8' )
|| die $tt->error();
}
{
# just want a list
my @allgroups = values %allgroups;
# Get the perl_monger data as json, makes the map stuff easier
my $j = JSON->new->utf8;
my $json = $j->pretty->encode( \@allgroups );
write_file( 'www/groups/perl_mongers.json', $json );
}
{
my $source = 'src';
my $destination = 'www';
my $parms = {
allgroups => \%allgroups,
allgroupsnum => scalar( keys %allgroups ),
};
my $rule = File::Find::Rule->new;
$rule->or(
$rule->new->file->name(qr/.swp$/)->prune->discard,
$rule->new->directory->name('census')->prune->discard,
$rule->new
);
my @files = $rule->file()->name(qr/^.[^~]+$/)->in($source);
foreach my $file (@files) {
next if $file =~ /country.html$/;
next if $file =~ /group.html$/;
next if $file =~ /continent.html$/;
print STDERR $file, "\n";
my $destfile = $file;
$destfile =~ s/^$source/$destination/;
my ( $volume, $directories, $filepart ) = splitpath($destfile);
mkpath $directories;
warn "$file -> $destfile\n";
if ( $file =~ /\.png$/ || $file =~ /\.jpg$/ ) {
copy( $file, $destfile );
} else {
$parms->{description}
= "Perl Mongers organise local Perl user groups and meetings";
#print "PROCESS: $destfile\n";
$tt->process( $file, $parms, $destfile, binmode => ':utf8' )
|| die $tt->error;
}
}
}
__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.