#!/usr/bin/perl -w
#
# pmgoogle.pl
# Generates compressed KMZ (Google Earth) files
# with placemarks for Perlmonks monks
# See: earth.google.com
#
# Darren - July 2006
use strict;
use XML::Simple;
use LWP::UserAgent;
use Storable;
use Time::HiRes qw( time );
my $start = time();
say("$0 started at ", scalar localtime($start));
# Where everything lives
my $monkfile = '/home/mcdarren/scripts/monks.store';
my $kmlfile = '/home/mcdarren/temp.kml';
my $www_dir = '/home/mcdarren/var/www/googlemonks';
my $palette_url = 'http://mcdarren.perlmonk.org/googlemonks/img/monk-palette.png';
my $monks; # hashref
$|++;
# Uncomment this for testing
# Avoids re-fetching the data
#if (! -f $monkfile) {
# Fetch and parse the XML from tinymicros
$monks = get_monk_data();
store $monks, $monkfile;
#}
$monks = retrieve($monkfile)
or die "Could not retrieve $monkfile:$!\n";
# A pretty lousy attempt at abstraction :/
my %types = (
by_level => {
desc => 'By Level',
outfile => 'perlmonks_by_level.kmz',
},
by_name => {
desc => 'By Monk',
outfile => 'perlmonks_by_monk.kmz',
}
);
my @levels = qw(
Initiate Novice Acolyte Sexton
Beadle Scribe Monk Pilgrim
Friar Hermit Chaplain Deacon
Curate Priest Vicar Parson
Prior Monsignor Abbot Canon
Chancellor Bishop Archbishop Cardinal
Sage Saint Apostle Pope
);
# Create a reference to a LoL,
# which represents xy offsets to each of the
# icons on the palette image
# The palette consists of 28 icons in a 7x4 grid
my $xy_data = get_xy();
my @t = time();
print "Writing and compressing output files...";
for (keys %types) {
open OUT, ">", $kmlfile
or die "Could not open $kmlfile:$!\n";
my $kml = build_kml($monks, $_);
print OUT $kml;
close OUT;
write_zip($kmlfile, "$www_dir/$types{$_}{outfile}");
}
$t[1] = time();
say("done (", formatted_time_diff(@t), " secs)");
my $end = time();
say("Total run time ", formatted_time_diff($start, $end), " secs");
say("Total monks: ", scalar keys %{$monks->{monk}});
exit;
####################################
# End of main - subs below
####################################
sub say {
# Perl Hacks #86
print @_, "\n";
}
sub formatted_time_diff {
return sprintf("%.2f", $_[1]-$_[0])
}
sub by_level {
return $monks->{monk}{$b}{level} <=> $monks->{monk}{$a}{level}
|| lc($a) cmp lc($b);
}
sub by_name {
return lc($a) cmp lc($b);
}
sub write_zip {
my ($infile, $outfile) = @_;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
my $zip = Archive::Zip->new();
my $member = $zip->addFile($infile);
return undef unless $zip->writeToFileNamed($outfile) == AZ_OK;
}
sub build_kml {
# This whole subroutine is pretty fugly
# I really wanted to do it without an if/elsif,
# but I couldn't figure out how
my $ref = shift;
my $type = shift;
my $kml = qq(
Perl Monks - $types{$type}{desc}
1);
if ($type eq 'by_level') {
my $level = 28;
$kml .= qq(Level $level - Pope0\n);
for my $id (sort by_level keys %{$ref->{monk}}) {
my $mlevel = $ref->{monk}{$id}{level};
if ($mlevel < $level) {
$level = $mlevel;
my $level_name = $levels[$level-1];
$kml .= qq(Level $level - $level_name0\n);
}
$kml .= mk_placemark($id,$mlevel);
}
$kml .= q();
}
elsif ($type eq 'by_name') {
my @monks = sort by_name keys %{$ref->{monk}};
my $nummonks = scalar @monks;
my $mpf = 39; # monks-per-folder
my $start = 0;
while ($start < $nummonks) {
my $first = lc(substr($monks[$start],0,2));
my $last = defined $monks[$start+$mpf]
? lc(substr($monks[$start+$mpf],0,2))
: lc(substr($monks[-1],0,2));
$kml .= qq(Monks $first-$last0\n);
MONK:
for my $cnt ($start .. $start+$mpf) {
last MONK if !$monks[$cnt];
my $monk = $monks[$cnt];
my $mlevel = $ref->{monk}{$monk}{level};
$kml .= mk_placemark($monk,$mlevel);
}
$start += ($mpf + 1);
$kml .= q();
}
}
$kml .= q();
return $kml;
}
sub mk_placemark {
my $id = shift;
my $mlevel = shift;
my $p;
$p = qq(
Experience: $monks->{monk}{$id}{xp}
Writeups: $monks->{monk}{$id}{writeups}
User Since: $monks->{monk}{$id}{since}
http://www.perlmonks.org/?node_id=$monks->{monk}{$id}{id}
]]>
$id
$monks->{monk}{$id}{location}{longitude}
$monks->{monk}{$id}{location}{latitude}
0
10000
0
0
$monks->{monk}{$id}{location}{longitude},$monks->{monk}{$id}{location}{latitude},0
);
return $p;
}
sub get_xy {
# This returns an AoA, which represents xy-offsets
# to each of the monk level icons on the image palette
my @xy;
for my $y (qw(96 64 32 0)) {
for my $x (qw(0 32 64 96 128 160 192)) {
push @xy, [ $x, $y ];
}
}
return \@xy;
}
sub get_monk_data {
my $monk_url = 'http://tinymicros.com/pm/monks.xml';
my @t = time();
print "Fetching data....";
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET=>"$monk_url");
my $result = $ua->request($req);
return 0 if !$result->is_success;
my $content = $result->content;
$t[1] = time();
say("done (", formatted_time_diff(@t), " secs)");
print "Parsing XML....";
my $monks = XMLin($content, Cache => 'storable');
$t[2] = time();
say("done (", formatted_time_diff(@t[1,2]), " secs)");
return $monks;
}