diff options
Diffstat (limited to 'perllib/FixMyStreet/Geocode')
| -rw-r--r-- | perllib/FixMyStreet/Geocode/Bing.pm | 9 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode/FixaMinGata.pm | 204 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode/Google.pm | 7 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode/OSM.pm | 7 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode/Zurich.pm | 114 |
5 files changed, 338 insertions, 3 deletions
diff --git a/perllib/FixMyStreet/Geocode/Bing.pm b/perllib/FixMyStreet/Geocode/Bing.pm index 18e6b56ce..85eef3d0f 100644 --- a/perllib/FixMyStreet/Geocode/Bing.pm +++ b/perllib/FixMyStreet/Geocode/Bing.pm @@ -15,14 +15,21 @@ use File::Path (); use LWP::Simple; use Digest::MD5 qw(md5_hex); +use mySociety::Locale; + # string STRING CONTEXT # Looks up on Bing Maps API, and caches, a user-inputted location. # Returns array of (LAT, LON, ERROR), where ERROR is either undef, a string, or # an array of matches if there are more than one. The information in the query # may be used to disambiguate the location in cobranded versions of the site. sub string { - my ( $s, $c, $params ) = @_; + my ( $s, $c ) = @_; + + my $params = $c->cobrand->disambiguate_location($s); + + $s = FixMyStreet::Geocode::escape($s); $s .= '+' . $params->{town} if $params->{town} and $s !~ /$params->{town}/i; + my $url = "http://dev.virtualearth.net/REST/v1/Locations?q=$s"; $url .= '&userMapView=' . join(',', @{$params->{bounds}}) if $params->{bounds}; diff --git a/perllib/FixMyStreet/Geocode/FixaMinGata.pm b/perllib/FixMyStreet/Geocode/FixaMinGata.pm new file mode 100644 index 000000000..2db25f504 --- /dev/null +++ b/perllib/FixMyStreet/Geocode/FixaMinGata.pm @@ -0,0 +1,204 @@ +#!/usr/bin/perl +# +# FixMyStreet:Geocode::FixaMinGata +# OpenStreetmap forward and reverse geocoding for FixMyStreet. +# +# Copyright (c) 2011 Petter Reinholdtsen. Some rights reserved. +# Email: pere@hungry.com + +# This module is a slightly derived version of OSM.pm. + +# As of January 2014, the FixaMinGata developers are considering to make further +# changes related to OSM, so it's probably best to keep this module separate +# from the OSM module for now. + +package FixMyStreet::Geocode::FixaMinGata; + +use warnings; +use strict; +use Data::Dumper; + +use Digest::MD5 qw(md5_hex); +use Encode; +use File::Slurp; +use File::Path (); +use LWP::Simple qw($ua); +use Memcached; +use XML::Simple; +use mySociety::Locale; + +my $osmapibase = "http://www.openstreetmap.org/api/"; +my $nominatimbase = "http://nominatim.openstreetmap.org/"; + +# string STRING CONTEXT +# Looks up on Nominatim, and caches, a user-inputted location. +# Returns array of (LAT, LON, ERROR), where ERROR is either undef, a string, or +# an array of matches if there are more than one. The information in the query +# may be used to disambiguate the location in cobranded versions of the site. +sub string { + my ( $s, $c ) = @_; + + my $params = $c->cobrand->disambiguate_location($s); + + $s = FixMyStreet::Geocode::escape($s); + # $s .= '+' . $params->{town} if $params->{town} and $s !~ /$params->{town}/i; + + my $url = "${nominatimbase}search?"; + my %query_params = ( + q => $s, + format => 'json', + addressdetails => 1, + limit => 20, + #'accept-language' => '', + email => 'info' . chr(64) . 'morus.se', + ); + # $query_params{viewbox} = $params->{bounds}[1] . ',' . $params->{bounds}[2] . ',' . $params->{bounds}[3] . ',' . $params->{bounds}[0] + # if $params->{bounds}; + $query_params{countrycodes} = $params->{country} + if $params->{country}; + $url .= join('&', map { "$_=$query_params{$_}" } keys %query_params); + + my $cache_dir = FixMyStreet->config('GEO_CACHE') . 'osm/'; + my $cache_file = $cache_dir . md5_hex($url); + my $js; + if (-s $cache_file) { + $js = File::Slurp::read_file($cache_file); + } else { + $ua->timeout(15); + $js = LWP::Simple::get($url); + $js = encode_utf8($js) if utf8::is_utf8($js); + File::Path::mkpath($cache_dir); + File::Slurp::write_file($cache_file, $js) if $js; + } + + if (!$js) { + return { error => _('Sorry, we could not find that location.') }; + } + + $js = JSON->new->utf8->allow_nonref->decode($js); + + my ( %locations, $error, @valid_locations, $latitude, $longitude ); + foreach (@$js) { + # These co-ordinates are output as query parameters in a URL, make sure they have a "." + next if $_->{class} eq "boundary"; + + my @s = split(/,/, $_->{display_name}); + + my $address = join(",", @s[0,1,2]); + + $locations{$address} = [$_->{lat}, $_->{lon}]; + } + + my ($key) = keys %locations; + + return { latitude => $locations{$key}[0], longitude => $locations{$key}[1] } if scalar keys %locations == 1; + return { error => _('Sorry, we could not find that location.') } if scalar keys %locations == 0; + + foreach $key (keys %locations) { + ( $latitude, $longitude ) = ($locations{$key}[0], $locations{$key}[1]); + mySociety::Locale::in_gb_locale { + push (@$error, { + address => $key, + latitude => sprintf('%0.6f', $latitude), + longitude => sprintf('%0.6f', $longitude) + }); + }; + } + + return { error => $error }; +} + +sub reverse_geocode { + my ($latitude, $longitude, $zoom) = @_; + my $url = + "${nominatimbase}reverse?format=xml&zoom=$zoom&lat=$latitude&lon=$longitude"; + my $key = "OSM:reverse_geocode:$url"; + my $result = Memcached::get($key); + unless ($result) { + my $j = LWP::Simple::get($url); + if ($j) { + Memcached::set($key, $j, 3600); + my $ref = XMLin($j); + return $ref; + } else { + print STDERR "No reply from $url\n"; + } + return undef; + } + return XMLin($result); +} + +sub _osmxml_to_hash { + my ($xml, $type) = @_; + my $ref = XMLin($xml); + my %tags; + if ('ARRAY' eq ref $ref->{$type}->{tag}) { + map { $tags{$_->{'k'}} = $_->{'v'} } @{$ref->{$type}->{tag}}; + return \%tags; + } else { + return undef; + } +} + +sub get_object_tags { + my ($type, $id) = @_; + my $url = "${osmapibase}0.6/$type/$id"; + my $key = "OSM:get_object_tags:$url"; + my $result = Memcached::get($key); + unless ($result) { + my $j = LWP::Simple::get($url); + if ($j) { + Memcached::set($key, $j, 3600); + return _osmxml_to_hash($j, $type); + } else { + print STDERR "No reply from $url\n"; + } + return undef; + } + return _osmxml_to_hash($result, $type); +} + +# A better alternative might be +# http://www.geonames.org/maps/osm-reverse-geocoder.html#findNearbyStreetsOSM +sub get_nearest_road_tags { + my ( $cobrand, $latitude, $longitude ) = @_; + my $inforef = reverse_geocode($latitude, $longitude, 16); + if (exists $inforef->{result}->{osm_type} + && 'way' eq $inforef->{result}->{osm_type}) { + my $osmtags = get_object_tags('way', + $inforef->{result}->{osm_id}); + unless ( exists $osmtags->{operator} ) { + $osmtags->{operatorguess} = $cobrand->guess_road_operator( $osmtags ); + } + return $osmtags; + } + return undef; +} + +sub closest_road_text { + my ( $cobrand, $latitude, $longitude ) = @_; + my $str = ''; + my $osmtags = get_nearest_road_tags( $cobrand, $latitude, $longitude ); + if ($osmtags) { + my ($name, $ref) = ('',''); + $name = $osmtags->{name} if exists $osmtags->{name}; + $ref = " ($osmtags->{ref})" if exists $osmtags->{ref}; + if ($name || $ref) { + $str .= _('The following information about the nearest road might be inaccurate or irrelevant, if the problem is close to several roads or close to a road without a name registered in OpenStreetMap.') . "\n\n"; + $str .= sprintf(_("Nearest named road to the pin placed on the map (automatically generated using OpenStreetMap): %s%s"), + $name, $ref) . "\n\n"; + + if (my $operator = $osmtags->{operator}) { + $str .= sprintf(_("Road operator for this named road (from OpenStreetMap): %s"), + $operator) . "\n\n"; + } elsif ($operator = $osmtags->{operatorguess}) { + $str .= sprintf(_("Road operator for this named road (derived from road reference number and type): %s"), + $operator) . "\n\n"; + } + } + } + return $str; +} + +1; + diff --git a/perllib/FixMyStreet/Geocode/Google.pm b/perllib/FixMyStreet/Geocode/Google.pm index db3a8ae91..fd65b89b1 100644 --- a/perllib/FixMyStreet/Geocode/Google.pm +++ b/perllib/FixMyStreet/Geocode/Google.pm @@ -14,6 +14,7 @@ use File::Slurp; use File::Path (); use LWP::Simple; use Digest::MD5 qw(md5_hex); +use mySociety::Locale; # string STRING CONTEXT # Looks up on Google Maps API, and caches, a user-inputted location. @@ -21,7 +22,11 @@ use Digest::MD5 qw(md5_hex); # an array of matches if there are more than one. The information in the query # may be used to disambiguate the location in cobranded versions of the site. sub string { - my ( $s, $c, $params ) = @_; + my ( $s, $c ) = @_; + + my $params = $c->cobrand->disambiguate_location($s); + + $s = FixMyStreet::Geocode::escape($s); my $url = 'http://maps.google.com/maps/geo?q=' . $s; $url .= '&ll=' . $params->{centre} if $params->{centre}; diff --git a/perllib/FixMyStreet/Geocode/OSM.pm b/perllib/FixMyStreet/Geocode/OSM.pm index d96338c16..fd14b0acc 100644 --- a/perllib/FixMyStreet/Geocode/OSM.pm +++ b/perllib/FixMyStreet/Geocode/OSM.pm @@ -29,8 +29,13 @@ my $nominatimbase = "http://nominatim.openstreetmap.org/"; # an array of matches if there are more than one. The information in the query # may be used to disambiguate the location in cobranded versions of the site. sub string { - my ( $s, $c, $params ) = @_; + my ( $s, $c ) = @_; + + my $params = $c->cobrand->disambiguate_location($s); + + $s = FixMyStreet::Geocode::escape($s); $s .= '+' . $params->{town} if $params->{town} and $s !~ /$params->{town}/i; + my $url = "${nominatimbase}search?"; my %query_params = ( q => $s, diff --git a/perllib/FixMyStreet/Geocode/Zurich.pm b/perllib/FixMyStreet/Geocode/Zurich.pm new file mode 100644 index 000000000..7ba3d27ad --- /dev/null +++ b/perllib/FixMyStreet/Geocode/Zurich.pm @@ -0,0 +1,114 @@ +#!/usr/bin/perl +# +# FixMyStreet::Geocode::Zurich +# Geocoding with Zurich web service. +# +# Thanks to http://msdn.microsoft.com/en-us/library/ms995764.aspx +# and http://noisemore.wordpress.com/2009/03/19/perl-soaplite-wsse-web-services-security-soapheader/ +# for SOAP::Lite pointers +# +# Copyright (c) 2012 UK Citizens Online Democracy. All rights reserved. +# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ + +package FixMyStreet::Geocode::Zurich; + +use strict; +use Digest::MD5 qw(md5_hex); +use File::Path (); +use Geo::Coordinates::CH1903; +use SOAP::Lite; +use Storable; +use mySociety::Locale; + +my ($soap, $method, $security); + +sub setup_soap { + return if $soap; + + # Variables for the SOAP web service + my $geocoder = FixMyStreet->config('GEOCODER'); + my $url = $geocoder->{url}; + my $username = $geocoder->{username}; + my $password = $geocoder->{password}; + my $attr = 'http://ch/geoz/fixmyzuerich/service'; + my $action = "$attr/IFixMyZuerich/"; + + # Set up the SOAP handler + $security = SOAP::Header->name("Security")->attr({ + 'mustUnderstand' => 'true', + 'xmlns' => 'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd' + })->value( + \SOAP::Header->name( + "UsernameToken" => \SOAP::Header->value( + SOAP::Header->name('Username', $username), + SOAP::Header->name('Password', $password) + ) + ) + ); + $soap = SOAP::Lite->on_action( sub { $action . $_[1]; } )->proxy($url); + $method = SOAP::Data->name('getLocation')->attr({ xmlns => $attr }); +} + +# string STRING CONTEXT +# Looks up on Zurich web service a user-inputted location. +# Returns array of (LAT, LON, ERROR), where ERROR is either undef, a string, or +# an array of matches if there are more than one. +# If there is no ambiguity, returns only a {lat,long} hash, unless allow_single_match_string is true +# (because the auto-complete use of this (in /around) should send the matched name even though it's not ambiguous). +# +# The information in the query may be used to disambiguate the location in cobranded +# versions of the site. + +sub string { + my ( $s, $c ) = @_; + + setup_soap(); + + my $cache_dir = FixMyStreet->config('GEO_CACHE') . 'zurich/'; + my $cache_file = $cache_dir . md5_hex($s); + my $result; + if (-s $cache_file) { + $result = retrieve($cache_file); + } else { + my $search = SOAP::Data->name('search' => $s)->type(''); + my $count = SOAP::Data->name('count' => 10)->type(''); + eval { + $result = $soap->call($method, $security, $search, $count); + }; + if ($@) { + warn $@ if FixMyStreet->config('STAGING_SITE'); + return { error => 'The geocoder appears to be down.' }; + } + $result = $result->result; + File::Path::mkpath($cache_dir); + store $result, $cache_file if $result; + } + + if (!$result || !$result->{Location}) { + return { error => _('Sorry, we could not parse that location. Please try again.') }; + } + + my $results = $result->{Location}; + $results = [ $results ] unless ref $results eq 'ARRAY'; + + my ( $error, @valid_locations, $latitude, $longitude ); + foreach (@$results) { + ($latitude, $longitude) = Geo::Coordinates::CH1903::to_latlon($_->{easting}, $_->{northing}); + mySociety::Locale::in_gb_locale { + push (@$error, { + address => $_->{text}, + latitude => sprintf('%0.6f', $latitude), + longitude => sprintf('%0.6f', $longitude) + }); + }; + push (@valid_locations, $_); + last if lc($_->{text}) eq lc($s); + } + if (scalar @valid_locations == 1 && ! $c->stash->{allow_single_geocode_match_strings} ) { + return { latitude => $latitude, longitude => $longitude }; + } + return { error => $error }; +} + +1; + |