package makeKML;

# Filename:	makeKML.pm
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License/
# Description:	Make KML files for google maps

use strict;
use IO::File;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $LIBRARY);
use Carp;
use utf8;

use Exporter ();
@ISA = qw(Exporter);
@EXPORT_OK = qw(add write);

$VERSION = '1.00';
$LIBRARY = __PACKAGE__;

my $KEY;

my $KEYFILE = "google_api_key";
   $KEYFILE = ".google_api_key" unless -f $KEYFILE;
   $KEYFILE = "$ENV{HOME}/.google_api_key" unless -f $KEYFILE;

my $CACHEFILE = "latlong.cache";

my $OFFSETDUPLICATES = ".001";

sub debug {
	return unless $MAIN::DEBUG;
	foreach my $msg (@_) { print STDERR "[$LIBRARY] $msg\n"; }
}

##################################################
# LatLong code
##################################################
sub googleKey {
	my ($class,$key) = @_;
	$KEY = $key if defined $key;
	return $KEY;
}

sub googleKeyFile {
	my ($class,$file) = @_;
	$KEYFILE = $file if defined $file;
	return $KEYFILE;
}

sub latlongCache {
	my ($class,$file) = @_;
	$CACHEFILE = $file if defined $file;
	return $CACHEFILE;
}

sub offsetDuplicatePlacemarks {
	my ($class, $amount) = @_;
	$OFFSETDUPLICATES = $amount if defined $amount;
	return $OFFSETDUPLICATES;
}

##################################################
# The "cache" is just a simple flat file
# Feel free to replace with a database.
# Furthermore it doesn't do much to handle
#   identical addresses other than what "escape" does
##################################################
my %CACHE;
sub readLatLongCache {
	my ($this) = @_;
	my $cache = $this->{cache} || $CACHEFILE;
	return unless $cache;
	return unless -f $cache;
	croak("[$LIBRARY] Can't open latlong cache [$cache]")
		unless open(CACHE,"<$cache");
	debug("Reading cache [$cache]");
	while (<CACHE>) {
		$CACHE{$1}=$2 if /^(.+)\t(.+)$/;
	}
	close CACHE;
}

sub writeLatLongCache {
	my ($this) = @_;
	my $cache = $this->{cache} || $CACHEFILE;
	return unless $cache;
	my $write = "$cache.tmp";
	croak("[$LIBRARY] Can't write cache [$write]")
		unless open(CACHE,">$write");
	debug("Writing cache [$write]");
	foreach my $key ( keys %CACHE ) {
		print CACHE "$key\t$CACHE{$key}\n";
	}
	close CACHE;
	rename($write,$cache);
}

##################################################
# The maps request (using HTTP)
##################################################
sub escape {
	my($toencode) = @_;
	$toencode=~s/([^a-zA-Z0-9_\-. ])/uc sprintf("%%%02x",ord($1))/eg;
	$toencode =~ tr/ /+/; # spaces become pluses
	return $toencode;
}

sub getCoords {
	my ($this,$addr) = @_;
	my $eaddr = escape($addr);

	# Check cache
	return $CACHE{$eaddr} if $CACHE{$eaddr};

	my $url = "http://maps.google.com/maps/geo?q=$eaddr&sensor=false&key=$this->{key}";
	debug("URL: $url");
	my $var = qx(GET "$url");
	croak("[$LIBRARY] Couldn't find co-ords [$addr]")
		unless $var =~ /coordinates.*:\s*\[\s*(-?\d+\.\d+),\s*(-?\d+\.\d+)/;

	my $coords = "$1,$2";
	$CACHE{$eaddr} = $coords;
	wantarray ? ($coords,1) : $coords;
}

##################################################
# Google Maps API Key
##################################################
sub getKey {
	my ($this) = @_;

	$this->{key} ||= $KEY;

	return if $this->{key};

	my $keyfile = $this->{keyfile} || $KEYFILE;

	if (open(KEYFILE,"<$keyfile")) {
		debug("Reading keyfile: $keyfile");
		$this->{key} = <KEYFILE>;
		close KEYFILE;
		chomp($this->{key});
	} else {
		croak("[$LIBRARY] Couldn't open keyfile: $keyfile") if $this->{keyfile};
	}
	croak(<<MISSING_KEY) unless $this->{key};
[$LIBRARY] You need a Google Maps API Key.

If you don't have one, visit:
  http://code.google.com/apis/maps/signup.html

If you have one, either save it in a keyfile:
  $keyfile

Or supply it with the -key argument.
MISSING_KEY

	debug("Found key: $this->{key}");
}

##################################################
# The latlong code
##################################################
my %READLATLONG;
sub latlong {
	my ($this,$addr) = @_;
	getKey($this);
	readLatLongCache($this);
	my ($coords,$new) = getCoords($this,$addr),"\n";
	writeLatLongCache($this) if $new;

	return $coords unless $OFFSETDUPLICATES;
	return $coords unless $coords =~ /^(-?\d+(\.\d+)?),(-?\d+(\.\d+)?)$/;
	my ($lat,$long) = ($1,$3);

	while ($READLATLONG{$coords}++) {
		$lat += $OFFSETDUPLICATES; $long += $OFFSETDUPLICATES;
		$coords = "$lat,$long";
	}
	$coords;
}

##################################################
# The KML object
##################################################
sub new {
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = shift || {};

	bless $self, $class;
	return $self;
}

# Returns 0 on success
sub add {
	my ($this,$place) = @_;

	return -1 unless $place->{name};

	$place->{address} ||= $place->{addr};

	return -2 unless $place->{address} || $place->{city} || $place->{state};

	unless ($place->{coords}) {
		my $addr = $place->{address};
		$addr =~ s/\s*\@\s*/ at /g;
		$addr =~ s/\s*\([^\)]+\)\s*//g;
		$addr .= ',' if $addr && ($place->{city} || $place->{state});
		my @a;
		push(@a,$addr) if $addr;
		push(@a,$place->{city}) if $place->{city};
		push(@a,$place->{state}) if $place->{state};
		$addr = join(' ',@a);
		$place->{coords} = $this->latlong($addr);
		chomp($place->{coords});
	}

	return -2 unless $place->{coords};

	# Clean things up
	$place->{clean_name} = $place->{name};
	$place->{clean_name} = $1 if ($place->{name} =~ />([^<]+)</);
	$place->{clean_name} =~ s/<br>/_/g;
	$place->{clean_name} =~ s/[<>\s]/_/g;
	$place->{clean_name} =~ s/[\'\"]//g;
	$place->{clean_name} =~ s/é/e/g;
	$place->{clean_name} =~ s/([\x00-\x20\x7F-\xFF])/"%".sprintf("%2.2x",ord($1))/eg;
	$place->{clean_name} =~ s/&/&amp;/g;

	$place->{link} =~ s/%name%/$place->{clean_name}/g;

	$place->{map_name} = $place->{clean_name};
	$place->{map_name} =~ s/_/ /g;

	if ($place->{desc}) {
		$place->{clean_desc} = $place->{desc};
		$place->{clean_desc} =~ s/(\n|\\n)/<br \/>\n/g;
		$place->{clean_desc} =~ s/\s+/ /g;
		$place->{clean_desc} =~ s/&/&amp;/g;
		$place->{clean_desc} =~ s/<!--.*-->//smg;
		$place->{clean_desc} =~ s/[\'\"]//g;
		$place->{clean_desc} =~ s/<[^>]+>//g;
		$place->{clean_desc} =~ s/é/e/g;
		$place->{clean_desc} =~ s/([\x00-\x09\x0B-\x1F\x7F-\xFF])/"%".sprintf("%2.2x",ord($1))/eg;
	}

	$place->{address} =~ s/&/&amp;/g;
	$place->{link} =~ s/&/&amp;/g;

	push(@{$this->{places}}, $place);

	0;
}

sub kmlOut {
	my ($place,$key,$tag) = @_;
	return unless defined $place->{$key};
	$tag ||= $key;
	"\t\t\t<$tag>$place->{$key}</$tag>\n";
}

sub write {
	my ($this,$file) = @_;
	$file ||= $this->{file};
	croak("[$LIBRARY] Usage:  makeKML->new(file => <file>) or \$kml->write(<file>)\n") unless $file;
	my $fh = new IO::File;
	$fh->open(">$file") || croak("[$LIBRARY] Couldn't write kml: $file\n");

	#########################
	# Header
	#########################
	my $docName = $this->{name} || "Generated KML File";
	print $fh <<KML_HEADER;
<?xml version="1.0" encoding="UTF-8" ?>
<kml xmlns="http://www.opengis.net/kml/2.2"
     xmlns:atom="http://www.w3.org/2005/Atom">
	<Document>
		<name>$docName</name>
KML_HEADER

	#########################
	# Places
	#########################
	foreach my $place ( @{$this->{places}} ) {
		print $fh "\t\t<Placemark>\n";
		print $fh kmlOut($place,'map_name','name');
		print $fh "\t\t\t<atom:link href=\"$place->{link}\" />\n" if $place->{link};
		print $fh <<DESC if $place->{desc};
			<description>
				<![CDATA[$place->{clean_desc}]]>
			</description>
DESC
		print $fh kmlOut($place,'visibility');
		print $fh kmlOut($place,'phone','phoneNumber');
		print $fh kmlOut($place,'address');
		print $fh "\t\t\t<Point><coordinates>$place->{coords}</coordinates></Point>\n";
		print $fh "\t\t</Placemark>\n";
		#<address>$addrFull, $city $STATE</address>
	}

	#########################
	# Footer
	#########################
	print $fh <<KML_FOOTER;
	</Document>
</kml>
KML_FOOTER
}

1;


__END__

=pod

=head1 NAME

makeKML.pm - Builds KML files for Google Maps and Google Earth

=head1 SYNOPSIS

Simple example:

  use makeKML;

  my $kml = makeKML->new({ name => "Some Test Map" });

  $kml->add({
    name => 'The White House',
    desc => 'This is where the president of the U.S.A. hangs out',
    link => 'http://whitehouse.gov/',
    address => '1600 Pennsylvania Ave NW',
    city => 'Washington',
    state => 'DC',   # Not actually a state in this case.
      # Can be a country, municipality, etc..
      # Address formed is "address, city state"
  });

  $kml->write("Map.kml");

=head1 DESCRIPTION

C<makeKML.pm> allows you to create a simple list of places and
write out a KML file to be used by Google Maps or Google Earth.

C<makeKML.pm> will lookup latitude and longitude of locations
by address (Called "geocoding") and will even cache the results
for you.  You will probably need this.  See 'Geocoding' below.

You can view your KML file by putting it on a webserver,
verifying the URL of the raw KML file (and that the webserver
will display the KML file) and then entering that KML file
into the search box of Google Maps.  Google Earth can also
open KML files directly.

=head1 GEOCODING

KML files need latitude and longitude for each placemark,
a simple address will not suffice.  C<makeKML.pm> can
look these up for you using the Google Maps API.

You will need to register with Google to get a key,
but it costs B<nothing>.  Simply visit:

  http://code.google.com/apis/maps/signup.html

Then you can either specify the key a number of ways:

=over

=item As an value in your script:

  makeKML->googleKey("TheKeyValueThatYouGetFromGoogle");

=item Saved in a key file.

Put the key on a single line in one of the following locations:

  google_api_key
  .google_api_key
  $HOME/.google_api_key

Or else put the value in a different file and hand it to the library:

  makeKML->googleKeyFile("KeyFile");

=back

Furthermore, we cache the results in a simple cache file
so that we don't have to go back to google each time to
get the answers.  It's fairly safe to assume that addresses
don't move.  The default file is C<latlong.cache>, you
can change this with:

  makeKML->latlongCache("CacheFile");

You can also set the key parameters on a per-object basis
when calling new:

  my $kml = makeKML->new({
    name => 'Some Test Map',
    ## You would actually only specify one of key/keyfile here:
    key => 'SomeLongKeyFromGoogle',
    keyfile => 'GoogleKeyHere',
    cache => "CacheFile",
  });

If multiple placemarks are at the same location, then the user
won't be able to distinguish them on the map.  C<makeKML> will
offset the lat/long of each placemark by a small amount.  This
amount can be changed (or set to 0) with:

  makeKML->offsetDuplicatePlacemarks(.001);   # Default value

If you are looking for a simple way to lookup latitude and
longitude from an address, but don't need the rest of the
C<makeKML> functionality, then see the 'latlong' tool:

  http://MarginalHacks.com/index.0.html#latlong

=head1 METHODS

=over

=item $kml = new makeKML(%options);

Constructs a new C<makeKML> object.

Options include 'name' (for the map name) and 'file' (to specify
file output).  Also see 'write'

=item $kml->add(%place);

Add a place to the KML file.  Places can have a number of keys:

  Required fields:
name        Name of the place
address     Street address
city        City name
state       State, country or municipality.

At least one of address/city/state is required, it should be enough 
information for a search in google maps to find the location.

  And some optional fields:
link        URL
desc        Long description
phone       Phone number
coords      Latitude,longitude  (if not specified, see GEOCODING)

=item $kml->write();   $kml->write($file);

Write out the KML file.

If a filename is not given, then writes to the file specified in new().

=head1 LIMITATIONS

=over

=item Funky Characters

It tries to take care of funky characters so that it's KML safe,
but there doesn't seem to be a spec on this, and Google Maps will
only tell you that a kml file has errors (and not what they are).

If you find any other characters that need to be cleaned from
any of the KML fields, please let me know.

=back

=head1 COPYRIGHT

  Copyright 2004 <a href="http://GetDave.com/">David Ljung Madison</a>.
  All rights reserved.
  See: <a href="http://MarginalHacks.com/">MarginalHacks.com</a>

=cut