package makeKML; # Filename: makeKML.pm # Author: David Ljung Madison # 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($VERSION @ISA @EXPORT @EXPORT_OK $LIBRARY); use Carp; use utf8; # Either version 2 or version 3 of the API # The v2 API seems to be deprecated, it's mostly here for historical note. my $VERSION = 3; use Exporter (); @ISA = qw(Exporter); @EXPORT_OK = qw(add write); $VERSION = '1.02'; $LIBRARY = __PACKAGE__; my $KEY; my $KEYFILE = "google_api_key"; $KEYFILE = ".google_api_key" unless -f $KEYFILE; $KEYFILE = "$ENV{HOME}/.google/maps-api-key" unless -f $KEYFILE; $KEYFILE = "$ENV{HOME}/.google_api_key" unless -f $KEYFILE; my $CACHEFILE = "latlong.cache"; my $OFFSETDUPLICATES = 0.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{$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 getCoordsV3 { my ($this,$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=$this->{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/i; croak("[$LIBRARY] Couldn't find location [$addr]") unless $var =~ /(.+?)<\/location>/msg; $var = $1; croak("[$LIBRARY] Couldn't find lat [$addr]") unless $var =~ /(.+?)<\/lat>/msg; my $lat = $1; croak("[$LIBRARY] Couldn't find long [$addr]") unless $var =~ /(.+?)<\/lng>/msg; my $lng = $1; my $coords = "$lng,$lat"; $CACHE{$eaddr} = $coords; wantarray ? ($coords,1) : $coords; } sub getCoordsV2 { my ($this,$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=$this->{key}"; debug("URL: $url"); my $var = qx(GET "$url"); croak("[$LIBRARY] Error message from google API:\n $1\n\n") if $var =~ /(.+)<\/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; } sub getCoords { $VERSION==2 ? getCoordsV2(@_) : getCoordsV3(@_); } ################################################## # 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} = ; close KEYFILE; chomp($this->{key}); } else { croak("[$LIBRARY] Couldn't open keyfile: $keyfile") if $this->{keyfile}; } croak(<{key}; [$LIBRARY] You need a Google Maps API Key. If you don't have one, visit: http://code.google.com/apis/maps/signup.html https://console.developers.google.com/ 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); if ($OFFSETDUPLICATES>0) { 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; } sub cleanKML { my ($str,$name) = @_; return $str unless $str; if ($name) { $str = $1 if $str =~ />([^<]+)/_/g; $str =~ s/[<>\s]/_/g; $str =~ s/é/e/g; $str =~ s/&/&/g; } else { $str =~ s/[^\S\n]+/ /g; $str =~ s///smg; #$str =~ s/<[^>]+>//g; $str =~ s/(\n|\\n)/
\n/g; } $str =~ s/&(?!\S+;)/&/g; $str =~ s/[\'\"]//g; $str =~ s/é/e/g; $str =~ s/([\x00-\x09\x0B-\x1F\x7F-\xFF])/"%".sprintf("%2.2x",ord($1))/eg; $str; } # 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} || $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}; $place->{coords} ||= $this->latlong($addr); 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/&/&/g; $place->{link} =~ s/&/&/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}\n"; } sub write { my ($this,$file) = @_; $file ||= $this->{file}; croak("[$LIBRARY] Usage: makeKML->new(file => ) or \$kml->write()\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"; my $desc = cleanKML($this->{desc},0); $desc = "" if $desc; print $fh < $docName $desc KML_HEADER ######################### # Places ######################### foreach my $place ( @{$this->{places}} ) { print $fh "\t\t\n"; print $fh kmlOut($place,'map_name','name'); print $fh "\t\t\t{link}\" />\n" if $place->{link}; print $fh <{desc}; {clean_desc}]]> 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$place->{coords}\n"; print $fh "\t\t\n"; #
$addrFull, $city $STATE
} ######################### # Footer ######################### print $fh <
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/', 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 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 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 can look these up for you using the Google Maps API. =head2 API KEY You will need to register with Google to get a key, but it costs B. Simply visit: L or L Turn on the Geocoding API and look at your credentials, you need to copy the API KEY for B. You can give your key to makeKML.pm 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, 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 => 'SomeLongKeyFromGoogle', keyfile => 'GoogleKeyHere', 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 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 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 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->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 the same key as you use for the Geocoding, this is the API key for B 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.
We add the fake 'a=' 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 David Ljung Madison L All rights reserved. See: L =cut