#!/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;
}