package makeKML;

# Filename:	makeKML.pm
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License/
# Description:	Make KML files for google maps
#
# Google Maps now requires a billing account to get an API key, but the first $300/mon is free
# and they don't start charging unless you upgrade to a paid account.
#
# To get an API key:
#   https://cloud.google.com/maps-platform/#get-started
#   Select Maps
#   Create a project and name it
#   Create billing account
#   Create the API key, and save that info in $KEYFILE
#   Search the APIs for "Geocoding API" and make sure it's enabled.

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

# Versions available:
# 2:  Google v2 API - deprecated - here for historical reasons
# 3:  Google v3 API
# 'opencagedata':  Free API at opencagedata.com, 2500/day but only 1/sec
# Either version 2 or version 3 of the API (google)
# The v2 API seems to be deprecated, it's mostly here for historical note.
$API = 3;
sub useAPI { my ($class,$val) = @_; $API = $val; }

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

$VERSION = '1.05';
$LIBRARY = __PACKAGE__;

my $KEY;

# %s is replaced with either 'google' or 'opencagedata' depending on the API
my $KEYFILE;

my $CACHEFILE = "latlong.cache";

my $OFFSETDUPLICATES = 0.001;

my $LATLONGRE = '(-?\d+(?:\.\d+)?),(-?\d+(?:\.\d+)?)';

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

# Default styles (see 'addIcon')
# This should probably be a member of the class, but isn't currently
my %STYLES = {
	'redpush' => 'http://maps.google.com/mapfiles/kml/pushpin/red-pushpin.png',
	'bluepush' => 'http://maps.google.com/mapfiles/kml/pushpin/blue-pushpin.png',
	'whitepush' => 'http://maps.google.com/mapfiles/kml/pushpin/wht-pushpin.png',
	'yellowpush' => 'http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png',
	'greenpush' => 'http://maps.google.com/mapfiles/kml/pushpin/grn-pushpin.png',
	'ltbluepush' => 'http://maps.google.com/mapfiles/kml/pushpin/ltblu-pushpin.png',
	'purplepush' => 'http://maps.google.com/mapfiles/kml/pushpin/purple-pushpin.png',
	'greenpaddle' => 'http://maps.google.com/mapfiles/kml/paddle/grn-circle.png',
	'ltbluepaddle' => 'http://maps.google.com/mapfiles/kml/paddle/ltblu-circle.png',
	'pinkpaddle' => 'http://maps.google.com/mapfiles/kml/paddle/pink-circle.png',
	'purplepaddle' => 'http://maps.google.com/mapfiles/kml/paddle/purple-circle.png',
	'redpaddle' => 'http://maps.google.com/mapfiles/kml/paddle/red-circle.png',
	'whitepaddle' => 'http://maps.google.com/mapfiles/kml/paddle/white-circle.png',
	'yellowpaddle' => 'http://maps.google.com/mapfiles/kml/paddle/ylw-circle.png',
};
##################################################
# LatLong code
##################################################
sub Key {
	my ($class,$key) = @_;
	$KEY = $key if defined $key;
	return $KEY;
}

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

	my $provider = $API =~ /opencage/i ? "opencagedata" : "google";
  # %s is replaced with the provider
	my @try = $KEYFILE ? ($KEYFILE) :
		( "%s_api_key",
			".%s_api_key",
			"$ENV{HOME}/.%s/maps-api-key",
			"$ENV{HOME}/.%s_api_key" );

	foreach my $try ( @try ) {
		$try =~ s/%s/$provider/g;
		return $try if -f $try;
	}
	return $try[0];
}

# Backwards compat
sub googleKey { return Key(@_); }
sub googleKeyFile { 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 ($self) = @_;
	my $cache = $self->{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 ($self) = @_;
	my $cache = $self->{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 getCoordsV3 {
	my ($self,$addr) = @_;
	my $eaddr = escape($addr);

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

	## API v3
	my $url = "https://maps.googleapis.com/maps/api/geocode/xml?sensor=false&key=$self->{key}&address=$eaddr";
	debug("URL: $url");
	my $var = qx(GET "$url");
#print "$var\n";
	croak("[$LIBRARY] Error message from google API:\n  $1\n\n")
		if $var =~ /<error_message>(.+)<\/error/i;
	croak("[$LIBRARY] Couldn't find location [$addr]")
		unless $var =~ /<location>(.+?)<\/location>/msg;
	$var = $1;
	croak("[$LIBRARY] Couldn't find lat [$addr]")
		unless $var =~ /<lat>(.+?)<\/lat>/msg;
	my $lat = $1;
	croak("[$LIBRARY] Couldn't find long [$addr]")
		unless $var =~ /<lng>(.+?)<\/lng>/msg;
	my $lng = $1;

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

sub getCoordsV2 {
	my ($self,$addr) = @_;
	my $eaddr = escape($addr);

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

	## API v2
	my $url = "http://maps.google.com/maps/geo?q=$eaddr&sensor=false&key=$self->{key}";
	debug("URL: $url");
	my $var = qx(GET "$url");
	croak("[$LIBRARY] Error message from google API:\n  $1\n\n")
		if $var =~ /<error_message>(.+)<\/error/i;
	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;
}

my $OPENCAGETIME = time;
sub getCoordsOpenCageData {
	my ($self,$addr) = @_;
	my $eaddr = escape($addr);

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

	# Limit queries to 1/sec, you can remove this if you have a paid plan.
	# This also falls apart if you run two of these at the same time.
	sleep 1 unless $OPENCAGETIME+1<=time;
	$OPENCAGETIME = time;

	## OPENCAGEDATA
	my $url = "https://api.opencagedata.com/geocode/v1/xml?key=$self->{key}&q=$eaddr&limit=1&no_annotations=1";
	debug("URL: $url");
	my $var = qx(GET "$url");
	croak("[$LIBRARY] Error message from opencagedata API:\n  $2\n\n")
		if $var =~ /<status>.*<code>.*?(\d+).*?<\/code>.*<message>(.+)<\/message/i && $1!=200;
	croak("[$LIBRARY] Couldn't find co-ords [$addr]")
		unless $var =~ /<geometry>.*<lat>\s*(-?\d+\.\d+)\s*<\/lat>.*<lng>(-?\d+\.\d+)\s*<\/lng>/;

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

sub getCoords {
	return getCoordsV2(@_) if $API==2;
	return getCoordsOpenCageData(@_) if $API=~/opencage/i;
	return getCoordsV3(@_); 
}

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

	$self->{key} ||= $KEY;
	return if $self->{key};

	my $keyfile = $self->{keyfile} || KeyFile();

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

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

Or:
  https://opencagedata.com/

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

Or supply it with the -key argument.
MISSING_KEY

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

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

	return $coords unless $OFFSETDUPLICATES;
	return $coords unless $coords =~ /^$LATLONGRE$/;
	my ($lat,$long) = ($1,$2);

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

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

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

sub cleanKML {
	my ($str,$name) = @_;
	return $str unless $str;

	if ($name) {
		$str = $1 if $str =~ />([^<]+)</;
		$str =~ s/<br>/_/g;
		$str =~ s/[<>\s]/_/g;
		$str =~ s/é/e/g;
		$str =~ s/&/&amp;/g;
	} else {
		$str =~ s/[^\S\n]+/ /g;
		$str =~ s/<!--.*-->//smg;
		#$str =~ s/<[^>]+>//g;
		$str =~ s/(\n|\\n)/<br \/>\n/g;
	}

	$str =~ s/&(?!\S+;)/&amp;/g;
	$str =~ s/[\'\"]//g;
	$str =~ s/é/e/g;
	$str =~ s/([\x00-\x09\x0B-\x1F\x7F-\xFF])/"%".sprintf("%2.2x",ord($1))/eg;


	$str;
}

sub addIcon {
	my ($self, $style, $href) = @_;
	return if $STYLES{$style} eq $href;
	print STDERR "WARNING: Replacing $style with $href\n" if $STYLES{$style};
	$STYLES{$style} = $href;
}

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

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

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

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

	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);
		$addr .= ", $place->{country}" if $place->{country};
		my $latlong = $self->latlong($addr);
		$place->{coords} = $latlong =~ /$LATLONGRE/ ? "$2,$1" : $latlong;
		chomp($place->{coords});
	}

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

	# Clean things up
	$place->{clean_name} = cleanKML($place->{name},1);

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

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

	$place->{clean_desc} = cleanKML($place->{desc},0);

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

	push(@{$self->{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 ($self,$file) = @_;
	$file ||= $self->{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 = $self->{name} || "Generated KML File";
	my $desc = cleanKML($self->{desc},0);
	$desc = "<description><![CDATA[$desc]]></description>" if $desc;
	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>
		$desc
KML_HEADER

	foreach my $style (keys %STYLES) {
		print $fh <<STYLE;
		<Style id="$style">
			<IconStyle>
				<scale>1</scale>
				<Icon>
					<href>$STYLES{$style}</href>
				</Icon>              
			</IconStyle>                    
		</Style>                        
STYLE
	}

	#########################
	# Places
	#########################
	foreach my $place ( @{$self->{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
		$place->{style} = "#$place->{style}" if $place->{style};
		print $fh kmlOut($place,'visibility');
		print $fh kmlOut($place,'phone','phoneNumber');
		print $fh kmlOut($place,'phone','phoneNumber');
		print $fh kmlOut($place,'style','styleUrl');
		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;


## To create man pages:
# MAN PAGE:       % perldoc makeKML.pm
# HTML MAN PAGE:  % pod2html makeKML.pm
__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/',
		style => 'yellowpush',
    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.

=head2 API KEY

You will need to register with Google or opencagedata to get
a key, but it costs B<nothing>.

For Google, simply visit:
L<http://code.google.com/apis/maps/signup.html>
or
L<https://console.developers.google.com/>

Turn on the Geocoding API and look at your credentials, you
need to copy the API KEY for B<server applications>.

You can also use opencagedata which allows free geocoding
limited to 1/sec by signing up at:
  https://opencagedata.com/

You can give your key to makeKML.pm a number of ways:

=over

=item As an value in your script:

  makeKML->Key("TheKeyValueThatYouGetFromGoogleOrOpenCageData");

=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

If you're using opencagedata, replace "google" with "opencagedata":

  opencagedata_api_key
  .opencagedata_api_key
  $HOME/.opencagedata_api_key

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

  makeKML->KeyFile("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");

=begin comment
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 => 'YourLongAPIKeyGoesHere',
    keyfile => 'OrAFileThatContainsTheAPIKey',
    cache => "CacheFile",
  });

=end comment

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)
style       One of the predefined pushpin/paddle styles:
	redpush bluepush whitepush yellowpush greenpush
	ltbluepush purplepush greenpaddle ltbluepaddle
	pinkpaddle purplepaddle redpaddle whitepaddle yellowpaddle

=item $kml->addIcon($styleName, $url);

Add an icon as a style, apart from the default set of styles.
See the optional fields in $kml->add() for the defaults.

  Required fields:
styleName   A unique style name that can now be specified to add()
url         URL to the icon/image

=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().

=back

=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 HTML EXAMPLE

Google used to allow direct entry of a KML URL to show a KML
map on maps.google.com, but this has been discontinued as of
Feb 2015.  Now if you want to publish a KML map you have to
use the Google Maps Javascript API v3 to embed the map in an
HTML file.  This is actually fairly simple to do, though there
aren't any good examples and the docs on google are not up-to-date
(as of 2015).  The API v3 now requires a Google API key, though
this was previously not the case and many google docs will tell
you otherwise.  This is B<not> the same key as you use for the
Geocoding, this is the API key for B<browser applications> which
you can also find in your credentials.  Here is some example
HTML and javascript that will embed a map on a web page, replace
API_KEY_GOES_HERE with your browser application API key.

	<script type="text/javascript"
	  src="https://maps.googleapis.com/maps/api/js?key=API_KEY_GOES_HERE">
	</script>
	<script type="text/javascript">
	  function initialize() {
	    var map = new google.maps.Map(
	      document.getElementById('map-canvas'));
	    // Timestamp that changes every 500 seconds
	    var time500 = parseInt((new Date().getTime())/500000);
	    var georssLayer = new google.maps.KmlLayer(
	      'http://SFLindyExchange.com/2013/Map/gmap.kml?a='+time500,
	      { map: map }
	    );
	    georssLayer.setMap(map);
	  }
	  google.maps.event.addDomListener(window, 'load', initialize);
	</script>
	<div style="height: 400px; width: 600px;" id="map-canvas"></div>

We add the fake 'a=<timestamp>' query because browsers will not normally
reload KML files when they change, this will change the URL so that eventually
the KML file will be reloaded.  Since the browser key is embedded in the
Javascript source (and can therefore be read by anyone), you probably
want to protect this by limiting referrers for the API key on the
developers console.

=head1 COPYRIGHT

  Copyright 2004,2020 David Ljung Madison Stellar L<http://GetDave.com/>
  All rights reserved.
  See: L<http://MarginalHacks.com/>

=cut