#!/usr/bin/perl

use strict;
use warnings;
use POSIX qw(strftime);

my $title = shift or die "Must specify a title for map on the command line";
my $date = strftime("%Y-%m-%d", gmtime());

my @LABELS = split /\|/,  <>; # make header manageable
chomp $LABELS[-1];

my $COORDS = 0;
my $ID = 1;
my $URL = 2;
my $NAME = 3;
my $CITY = 4;
my $STATE = 5;
my $LOC_LABEL = 6;
my $LOC_ADDR_JUNK = 7;
my $LOC_ADDR_LAST = 8;
my $LOC_CSZ = 9;
my $THIS_YEAR = 10;
my $NEXT_YEAR = 11;
my $LENGTH = 12;
my $NUM_POS = 13;
my $AVG_HOURS = 14;
my $MAX_HOURS = 15;
my $MOON = 16;
my $SALARY = 17;
my $TYPE = 18;
my $COORDS_FROM = 19;

my %TYPES = 
    (1 => "uni", 
     2 => "commun", 
     3 => "mil", 
     4 => "other", 
     5 => "uni_commun",
     );
my %TYPE_LABELS = 
    ('uni' => "University Based", 
     'commun' => "Community Based", 
     'mil' => "Military", 
     'other' => "Other/Unknown",
     'uni_commun' => "Community Hospital, Uni Affiliated",
     );

my %known_coords = ();
my $RAND_FACTOR = 0.020000; # random jiggle for places w/identicle coords

my %states;
my %lengths;
my %types;

my $num_programs;

# crunch the input
while (<>) {
    chomp;
    my @data = split /\s*\|\s*/, $_, -1;
    $num_programs++;

    # tweak our coords if we have a collision
    if (exists $known_coords{$data[$COORDS]}) {
	my @coords = split /,/, $data[$COORDS];
	$coords[0] += $RAND_FACTOR/2 - rand $RAND_FACTOR; 
	$coords[1] += $RAND_FACTOR/2 - rand $RAND_FACTOR; 
	$data[$COORDS] = "$coords[0],$coords[1]";
    }
    $known_coords{$data[$COORDS]}=1;

    # type num to string, deal with missing type
    $data[$TYPE] = (exists $TYPES{$data[$TYPE]} 
		    ? $TYPES{$data[$TYPE]} 
		    : 'other');

    # group by state
    $states{$data[$STATE]} = [] unless exists $states{$data[$STATE]};
    push @{$states{$data[$STATE]}}, \@data;

    # group by length
    $lengths{$data[$LENGTH]} = [] unless exists $lengths{$data[$LENGTH]};
    push @{$lengths{$data[$LENGTH]}}, \@data;
    
    # group by program type
    $types{$data[$TYPE]} = [] unless exists $types{$data[$TYPE]};
    push @{$types{$data[$TYPE]}}, \@data;

}

# figure out how the various lenghts map to colors
my %lengthcolors = ();
{
    my @lens = sort keys %lengths;
    $lengthcolors{shift @lens} = 'green';
    $lengthcolors{shift @lens} = 'yellow' if (@lens);
    $lengthcolors{$_} = 'red' foreach @lens;
}

# start output
print_header();

print_folder_start("By Program Type", 1, 0);
for my $t (sort { $TYPE_LABELS{$a} cmp $TYPE_LABELS{$b} } keys %types) {
    print_folder_start($TYPE_LABELS{$t} .' ('.scalar(@{$types{$t}}).')', 0,0);
    for my $data (sort { $a->[$NAME] cmp $b->[$NAME] } @{$types{$t}}) {
	print_record(@{$data});
    }
    print_folder_end();
}
print_folder_end();


print_folder_start("By Length", 1, 0);
for my $len (sort keys %lengths) {
    print_folder_start($len .' ('.scalar(@{$lengths{$len}}).')', 0,0);
    for my $data (sort { $a->[$NAME] cmp $b->[$NAME] } @{$lengths{$len}}) {
	print_record(@{$data});
    }
    print_folder_end();
}
print_folder_end();

print_folder_start("By State", 0, 0);
for my $state (sort keys %states) {
    print_folder_start($state .' ('.scalar(@{$states{$state}}).')', 0, 0);
    for my $data (sort { $a->[$NAME] cmp $b->[$NAME] } @{$states{$state}}) {
	print_record(@{$data});
    }
    print_folder_end();
}
print_folder_end();


print "</Document>\n</kml>\n\n";

sub print_header { 
    print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
    print "<kml xmlns=\"http://earth.google.com/kml/2.2\">\n";
    print "<Document>\n";
    print "<name>$title Residency Programs</name>\n";
    print "<description><![CDATA[";
    print "<b>$num_programs</b> $title Residency Programs as of $date<br/>\n";
    print "<p>(<a href=\"http://fucit.org/residency-maps/\">What is This???</a>)</p>";
    print "<p>Icon shape indicates Program Type, color indicates Length.</p>\n";
    print "<p><b>NOTE:</b> Each program appears redundantly in each ";
    print "section where it is applicable, and that Google Maps will ";
    print "frequently leave out icons if you try to view all at once with ";
    print "the top most check boxes.</p>\n";
    print "<p>(And no: I can't make it stop auto checking all the boxes by default)</p>\n";
    print "]]></description>\n";

    print_styles();
}


sub print_record {
    my @data = @_;
    print "<Placemark>\n<name><![CDATA[$data[$NAME]]]></name>\n";
    my $type = $data[$TYPE];
    print "<styleUrl>#$type-$lengthcolors{$data[$LENGTH]}</styleUrl>\n";
    # funny story, KML wants the coords backwards
    my @coords = split /,/, $data[$COORDS];
    print "<Point><coordinates>$coords[1],$coords[0]</coordinates></Point>\n";
    print "<Snippet maxLines=\"1\"><![CDATA[$data[$LOC_LABEL]]]></Snippet>\n";
    print "<visibility>0</visibility>\n";
    print "<description>\n<![CDATA[$TYPE_LABELS{$type}<br/>\n";
    print "<table border=\"1\">\n";
    for my $col ($CITY..$COORDS_FROM) {
	print qq{<tr><td>$LABELS[$col]:</td>};
	my $val = defined $data[$col] ? $data[$col] : '???';
	print qq{<td>$val</td></tr>\n};
    }
    print "</table>\n<a href=\"$data[$URL]\">AMA Info #$data[$ID]</a>\n]]>\n";
    print "</description>\n</Placemark>\n";
}

sub print_folder_start {
    my ($name, $open, $vis) = @_;
    print "<Folder>\n<name>$name</name>\n";
    print "<open>$open</open>\n<visibility>$vis</visibility>\n";
}
sub print_folder_end {
    print "</Folder>\n";
}

sub print_styles {
    foreach my $type (keys %TYPE_LABELS) {
	foreach my $col (qw(green yellow red)) {
	    print "<Style id=\"$type-$col\">\n<IconStyle>\n<Icon>\n";
	    print "<href>http://fucit.org/residency-maps/icons/$type/$col.png</href>\n";
	    print "</Icon>\n<scale>0.5</scale>\n";
	    print "<hotSpot x=\"0.5\" y=\"0.5\" xunits=\"fraction\" yunits=\"fraction\"/>\n";
	    print "</IconStyle>\n</Style>\n";
	}
    }
}