CUFP
McDarren
Greetings!
<p>This is the "final" (..heh) version of the code that's used to generate the Google Earth KMZ files referred to in [id://558846]. It's presented here partly for posterity, and partly to elicit some feedback and (hopefully) some suggestions for improvement.
<p>For some background, read the [id://558846|original thread], or visit the "googlemonks" [http://mcdarren.perlmonk.org/googlemonks/|homepage].
<p><font size=-1><em>Note: I've posted the code here in CUFP (rather than in the original thread) after seeking advice in the CB.
<p>Edit: s/illicit/elicit/ (thanks, [GrandFather])</em></font>
<p>
<readmore title="the code....">
<code>
#!/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(<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://earth.google.com/kml/2.1">
<Folder>
<name>Perl Monks - $types{$type}{desc}</name>
<open>1</open>);
if ($type eq 'by_level') {
my $level = 28;
$kml .= qq(<Folder><name>Level $level - Pope</name><open>0</open>\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(</Folder><Folder><name>Level $level - $level_name</name><open>0</open>\n);
}
$kml .= mk_placemark($id,$mlevel);
}
$kml .= q(</Folder>);
}
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(<Folder><name>Monks $first-$last</name><open>0</open>\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(</Folder>);
}
}
$kml .= q(</Folder></kml>);
return $kml;
}
sub mk_placemark {
my $id = shift;
my $mlevel = shift;
my $p;
$p = qq(
<Placemark>
<description>
<![CDATA[
Level: $mlevel<br \\>
Experience: $monks->{monk}{$id}{xp}<br \\>
Writeups: $monks->{monk}{$id}{writeups}<br \\>
User Since: $monks->{monk}{$id}{since}<br \\>
http://www.perlmonks.org/?node_id=$monks->{monk}{$id}{id}
]]>
</description>
<Snippet></Snippet>
<name>$id</name>
<LookAt>
<longitude>$monks->{monk}{$id}{location}{longitude}</longitude>
<latitude>$monks->{monk}{$id}{location}{latitude}</latitude>
<altitude>0</altitude>
<range>10000</range>
<tilt>0</tilt>
<heading>0</heading>
</LookAt>
<Style>
<IconStyle>
<Icon>
<href>$palette_url</href>
<x>$xy_data->[$mlevel-1][0]</x>
<y>$xy_data->[$mlevel-1][1]</y>
<w>32</w>
<h>32</h>
</Icon>
</IconStyle>
</Style>
<Point>
<coordinates>$monks->{monk}{$id}{location}{longitude},$monks->{monk}{$id}{location}{latitude},0</coordinates>
</Point>
</Placemark>
);
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;
}
</code>
</readmore>
<p>Cheers,<br>
Darren :)