| File: | blib/lib/Geo/Coder/List.pm |
| Coverage: | 35.8% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Geo::Coder::List; | |||||
| 2 | ||||||
| 3 | 20 20 | 1278756 28 | use 5.10.1; | |||
| 4 | ||||||
| 5 | 20 20 20 | 41 9 317 | use warnings; | |||
| 6 | 20 20 20 | 32 14 159 | use strict; | |||
| 7 | 20 20 20 | 25 20 455 | use Carp; | |||
| 8 | 20 20 20 | 3589 45904 811 | use HTML::Entities; | |||
| 9 | 20 20 20 | 3137 85327 426 | use Params::Get 0.04; | |||
| 10 | 20 20 20 | 3960 974621 260 | use Object::Configure 0.13; | |||
| 11 | 20 20 20 | 57 23 52 | use Time::HiRes; | |||
| 12 | 20 20 20 | 713 11 300 | use Scalar::Util; | |||
| 13 | ||||||
| 14 | 20 20 20 | 31 11 34287 | use constant DEBUG => 0; # Default debugging level | |||
| 15 | ||||||
| 16 | # TODO: investigate Geo, Coder::ArcGIS | |||||
| 17 | # TODO: return a Geo::Location::Point object all the time | |||||
| 18 | ||||||
| 19 - 27 | =head1 NAME Geo::Coder::List - Call many Geo-Coders =head1 VERSION Version 0.36 =cut | |||||
| 28 | ||||||
| 29 | our $VERSION = '0.36'; | |||||
| 30 | ||||||
| 31 - 72 | =head1 SYNOPSIS
L<Geo::Coder::All>
and
L<Geo::Coder::Many>
are great routines but neither quite does what I want.
C<Geo::Coder::List> is designed to simplify geocoding tasks by aggregating multiple geocoding services into a single, unified interface.
It allows developers to chain and prioritize various geocoding backends (such as Google Places, OpenStreetMap, and GeoNames)
based on specific conditions,
such as location or usage limits.
The module features built-in caching mechanisms to optimize performance and reduce redundant API calls,
while also normalizing responses from different providers into a consistent format for easier integration with mapping systems such as L<HTML::OSM> and <L<HTML::GoogleMaps::V3>.
=head1 SUBROUTINES/METHODS
=head2 new
Creates a C<Geo::Coder::List> object.
Takes an optional argument C<cache> which is a reference to a HASH or an object that supports C<get()> and C<set()> methods.
The licences of some geo coders,
such as Google,
specifically prohibit caching API calls,
so be careful to only use those services that allow it.
Takes an optional argument C<debug>,
the higher the number,
the more debugging.
use Geo::Coder::List;
use CHI;
my $geocoder->new(cache => CHI->new(driver => 'Memory', global => 1));
The class can be configured at runtime using environments and configuration files,
for example,
setting C<$ENV{'GEO__CODER__LIST__carp_on_warn'}> causes warnings to use L<Carp>.
For more information about configuring object constructors at runtime,
see L<Object::Configure>.
=cut | |||||
| 73 | ||||||
| 74 | sub new | |||||
| 75 | { | |||||
| 76 | 14 | 157473 | my $class = shift; | |||
| 77 | 14 | 19 | my $params = Params::Get::get_params(undef, @_) || {}; | |||
| 78 | ||||||
| 79 | 14 | 154 | if(!defined($class)) { | |||
| 80 | 2 2 | 2 4 | if((scalar keys %{$params}) > 0) { | |||
| 81 | # Using Geo::Coder::List::new(), not Geo::Coder::List->new() | |||||
| 82 | 0 | 0 | carp(__PACKAGE__, ' use ->new() not ::new() to instantiate'); | |||
| 83 | 0 | 0 | return; | |||
| 84 | } | |||||
| 85 | ||||||
| 86 | # FIXME: this only works when no arguments are given | |||||
| 87 | 2 | 1 | $class = __PACKAGE__; | |||
| 88 | } elsif(Scalar::Util::blessed($class)) { | |||||
| 89 | # If $class is an object, clone it with new arguments | |||||
| 90 | 2 2 2 | 4 3 7 | return bless { %{$class}, %{$params} }, ref($class); | |||
| 91 | } | |||||
| 92 | ||||||
| 93 | 12 | 15 | $params = Object::Configure::configure($class, $params); | |||
| 94 | ||||||
| 95 | # Return the blessed object | |||||
| 96 | # Locations is an L1 cache that is always used | |||||
| 97 | 12 12 | 58690 35 | return bless { debug => DEBUG, locations => {}, geocoders => [], log => [], %{$params} }, $class; | |||
| 98 | } | |||||
| 99 | ||||||
| 100 - 139 | =head2 push($self, $geocoder)
Add an encoder to the list of encoders.
use Geo::Coder::List;
use Geo::Coder::GooglePlaces;
# ...
my $list = Geo::Coder::List->new()->push(Geo::Coder::GooglePlaces->new());
Different encoders can be preferred for different locations.
For example, this code uses geocode.ca for Canada and US addresses,
and OpenStreetMap for other places:
my $geo_coderlist = Geo::Coder::List->new()
->push({ regex => qr/(Canada|USA|United States)$/, geocoder => Geo::Coder::CA->new() })
->push(Geo::Coder::OSM->new());
# Uses Geo::Coder::CA, and if that fails, uses Geo::Coder::OSM
my $location = $geo_coderlist->geocode(location => '1600 Pennsylvania Ave NW, Washington DC, USA');
# Only uses Geo::Coder::OSM
if($location = $geo_coderlist->geocode('10 Downing St, London, UK')) {
print 'The prime minister lives at co-ordinates ',
$location->{geometry}{location}{lat}, ',',
$location->{geometry}{location}{lng}, "\n";
}
# It is also possible to limit the number of enquires used by a particular encoder
$geo_coderlist->push({ geocoder => Geo::Coder::GooglePlaces->new(key => '1234', limit => 100) });
=head3 Parameters
=over 4
=item * C<$geocoder> hashref (required)
Hashref containing a regex and a geocoding object.
=back
=cut | |||||
| 140 | ||||||
| 141 | sub push | |||||
| 142 | { | |||||
| 143 | 6 | 11 | my($self, $geocoder) = @_; # Don't use Params::Get or else the regex will be lost | |||
| 144 | ||||||
| 145 | 6 | 7 | croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless(defined($geocoder)); | |||
| 146 | ||||||
| 147 | 6 6 | 2 7 | push @{$self->{geocoders}}, $geocoder; | |||
| 148 | ||||||
| 149 | 6 | 9 | return $self; | |||
| 150 | } | |||||
| 151 | ||||||
| 152 - 165 | =head2 geocode
Runs geocode on all of the loaded drivers.
See L<Geo::Coder::GooglePlaces::V3> for an explanation.
The name of the Geo-Coder that gave the result is put into the geocode element of the
return value,
if the value was retrieved from the cache the value will be undefined.
if(defined($location->{'geocoder'})) {
print 'Location information retrieved using ', $location->{'geocoder'}, "\n";
}
=cut | |||||
| 166 | ||||||
| 167 | sub geocode { | |||||
| 168 | 6 | 8 | my $self = shift; | |||
| 169 | 6 | 7 | my $params = Params::Get::get_params('location', @_); | |||
| 170 | ||||||
| 171 | 6 | 53 | my $location = $params->{'location'}; | |||
| 172 | ||||||
| 173 | 6 | 14 | if((!defined($location)) || (length($location) == 0)) { | |||
| 174 | 0 | 0 | Carp::carp(__PACKAGE__, ' usage: geocode(location => $location)'); | |||
| 175 | 0 | 0 | return; | |||
| 176 | } | |||||
| 177 | ||||||
| 178 | # Fail when the input is just a set of numbers | |||||
| 179 | 6 | 12 | if($params->{'location'} !~ /\D/) { | |||
| 180 | 0 | 0 | Carp::croak('Usage: ', __PACKAGE__, ": invalid input to geocode(), ", $params->{location}); | |||
| 181 | 0 | 0 | return; | |||
| 182 | } | |||||
| 183 | ||||||
| 184 | 6 | 4 | $location =~ s/\s\s+/ /g; | |||
| 185 | 6 | 12 | $location = decode_entities($location); | |||
| 186 | 6 | 6 | print "location: $location\n" if($self->{'debug'}); | |||
| 187 | ||||||
| 188 | 6 | 6 | my @call_details = caller(0); | |||
| 189 | 6 | 47 | if((!wantarray) && (my $rc = $self->_cache($location))) { | |||
| 190 | 1 | 1 | if(ref($rc) eq 'ARRAY') { | |||
| 191 | 0 | 0 | $rc = $rc->[0]; | |||
| 192 | } | |||||
| 193 | 1 | 2 | if(ref($rc) eq 'HASH') { | |||
| 194 | 1 | 1 | $rc->{'geocoder'} = 'cache'; | |||
| 195 | 1 | 2 | my $log = { | |||
| 196 | line => $call_details[2], | |||||
| 197 | location => $location, | |||||
| 198 | timetaken => 0, | |||||
| 199 | gecoder => 'cache', | |||||
| 200 | wantarray => 0, | |||||
| 201 | result => $rc | |||||
| 202 | }; | |||||
| 203 | 1 1 | 1 0 | CORE::push @{$self->{'log'}}, $log; | |||
| 204 | 1 | 2 | print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'}); | |||
| 205 | 1 | 1 | return $rc; | |||
| 206 | } | |||||
| 207 | } | |||||
| 208 | 5 0 | 5 0 | if(defined($self->_cache($location)) && (ref($self->_cache($location)) eq 'ARRAY') && (my @rc = @{$self->_cache($location)})) { | |||
| 209 | 0 | 0 | if(scalar(@rc)) { | |||
| 210 | 0 | 0 | my $allempty = 1; | |||
| 211 | 0 | 0 | foreach (@rc) { | |||
| 212 | 0 | 0 | if(ref($_) eq 'HASH') { | |||
| 213 | 0 | 0 | if(defined($_->{geometry}{location}{lat})) { | |||
| 214 | 0 | 0 | $allempty = 0; | |||
| 215 | 0 | 0 | $_->{'geocoder'} = 'cache'; | |||
| 216 | } else { | |||||
| 217 | 0 | 0 | delete $_->{'geometry'}; | |||
| 218 | } | |||||
| 219 | } elsif(ref($_) eq 'Geo::Location::Point') { | |||||
| 220 | 0 | 0 | $allempty = 0; | |||
| 221 | 0 | 0 | $_->{'geocoder'} = 'cache'; | |||
| 222 | } else { | |||||
| 223 | 0 | 0 | print STDERR Data::Dumper->new([\@rc])->Dump(); | |||
| 224 | 0 | 0 | Carp::croak(ref($self), " '$location': unexpected item in the cache"); | |||
| 225 | } | |||||
| 226 | } | |||||
| 227 | 0 | 0 | my $log = { | |||
| 228 | line => $call_details[2], | |||||
| 229 | location => $location, | |||||
| 230 | timetaken => 0, | |||||
| 231 | gecoder => 'cache', | |||||
| 232 | wantarray => wantarray, | |||||
| 233 | result => \@rc | |||||
| 234 | }; | |||||
| 235 | 0 0 | 0 0 | CORE::push @{$self->{'log'}}, $log; | |||
| 236 | 0 | 0 | print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'}); | |||
| 237 | 0 | 0 | if($allempty) { | |||
| 238 | 0 | 0 | return; | |||
| 239 | } | |||||
| 240 | 0 | 0 | return (wantarray) ? @rc : $rc[0]; | |||
| 241 | } | |||||
| 242 | } | |||||
| 243 | ||||||
| 244 | # my $error; | |||||
| 245 | ||||||
| 246 | 5 5 | 1 5 | ENCODER: foreach my $g(@{$self->{geocoders}}) { | |||
| 247 | 6 | 6 | my $geocoder = $g; | |||
| 248 | 6 | 4 | if(ref($geocoder) eq 'HASH') { | |||
| 249 | 0 | 0 | if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) { | |||
| 250 | 0 | 0 | print "limit: $limit\n" if($self->{'debug'}); | |||
| 251 | 0 | 0 | if($limit <= 0) { | |||
| 252 | 0 | 0 | next; | |||
| 253 | } | |||||
| 254 | 0 | 0 | $geocoder->{'limit'}--; | |||
| 255 | } | |||||
| 256 | 0 | 0 | if(my $regex = $geocoder->{'regex'}) { | |||
| 257 | 0 | 0 | print 'consider ', ref($geocoder->{geocoder}), ": $regex\n" if($self->{'debug'}); | |||
| 258 | 0 | 0 | if($location !~ $regex) { | |||
| 259 | 0 | 0 | next; | |||
| 260 | } | |||||
| 261 | } | |||||
| 262 | 0 | 0 | $geocoder = $g->{'geocoder'}; | |||
| 263 | } | |||||
| 264 | 6 | 4 | my @rc; | |||
| 265 | 6 | 6 | my $timetaken = Time::HiRes::time(); | |||
| 266 | 6 | 2 | eval { | |||
| 267 | # e.g. over QUERY LIMIT with this one | |||||
| 268 | # TODO: remove from the list of geocoders | |||||
| 269 | 6 | 6 | print 'trying ', ref($geocoder), "\n" if($self->{'debug'}); | |||
| 270 | 6 | 6 | if(ref($geocoder) eq 'Geo::GeoNames') { | |||
| 271 | 0 | 0 | print 'username => ', $geocoder->username(), "\n" if($self->{'debug'}); | |||
| 272 | 0 | 0 | die 'lost username' if(!defined($geocoder->username())); | |||
| 273 | 0 | 0 | @rc = $geocoder->geocode($location); | |||
| 274 | } else { | |||||
| 275 | 6 6 | 1 16 | @rc = $geocoder->geocode(%{$params}); | |||
| 276 | } | |||||
| 277 | }; | |||||
| 278 | 6 | 644 | if($@) { | |||
| 279 | 1 | 3 | my $log = { | |||
| 280 | line => $call_details[2], | |||||
| 281 | location => $location, | |||||
| 282 | geocoder => ref($geocoder), | |||||
| 283 | timetaken => Time::HiRes::time() - $timetaken, | |||||
| 284 | wantarray => wantarray, | |||||
| 285 | error => $@ | |||||
| 286 | }; | |||||
| 287 | 1 1 | 1 1 | CORE::push @{$self->{'log'}}, $log; | |||
| 288 | 1 | 13 | Carp::carp(ref($geocoder), " '$location': $@"); | |||
| 289 | # $error = $@; | |||||
| 290 | 1 | 647 | next ENCODER; | |||
| 291 | } | |||||
| 292 | 5 | 4 | $timetaken = Time::HiRes::time() - $timetaken; | |||
| 293 | 5 | 6 | if((ref($geocoder) eq 'Geo::Coder::US::Census') && | |||
| 294 | !(defined($rc[0]->{result}{addressMatches}[0]->{coordinates}{y}))) { | |||||
| 295 | # Looks like Geo::Coder::US::Census sometimes says it's worked when it hasn't | |||||
| 296 | 0 | 0 | my $log = { | |||
| 297 | line => $call_details[2], | |||||
| 298 | location => $location, | |||||
| 299 | timetaken => $timetaken, | |||||
| 300 | geocoder => 'Geo::Coder::US::Census', | |||||
| 301 | wantarray => wantarray, | |||||
| 302 | result => 'not found', | |||||
| 303 | }; | |||||
| 304 | 0 0 | 0 0 | CORE::push @{$self->{'log'}}, $log; | |||
| 305 | 0 | 0 | next ENCODER; | |||
| 306 | } | |||||
| 307 | 5 | 8 | if((scalar(@rc) == 0) || | |||
| 308 | 3 | 10 | ((ref($rc[0]) eq 'HASH') && (scalar(keys %{$rc[0]}) == 0)) || | |||
| 309 | 1 | 2 | ((ref($rc[0]) eq 'ARRAY') && (scalar(keys %{$rc[0][0]}) == 0))) { | |||
| 310 | 0 | 0 | my $log = { | |||
| 311 | line => $call_details[2], | |||||
| 312 | location => $location, | |||||
| 313 | timetaken => $timetaken, | |||||
| 314 | geocoder => ref($geocoder), | |||||
| 315 | wantarray => wantarray, | |||||
| 316 | result => 'not found', | |||||
| 317 | }; | |||||
| 318 | 0 0 | 0 0 | CORE::push @{$self->{'log'}}, $log; | |||
| 319 | 0 | 0 | next ENCODER; | |||
| 320 | } | |||||
| 321 | 5 | 6 | POSSIBLE_LOCATION: foreach my $l(@rc) { | |||
| 322 | 5 | 4 | if(ref($l) eq 'ARRAY') { | |||
| 323 | # Geo::GeoNames | |||||
| 324 | # FIXME: should consider all locations in the array | |||||
| 325 | 1 | 1 | $l = $l->[0]; | |||
| 326 | } | |||||
| 327 | 5 | 6 | if((!defined($l)) || ($l eq '')) { | |||
| 328 | 1 | 2 | my $log = { | |||
| 329 | line => $call_details[2], | |||||
| 330 | location => $location, | |||||
| 331 | timetaken => $timetaken, | |||||
| 332 | geocoder => ref($geocoder), | |||||
| 333 | wantarray => wantarray, | |||||
| 334 | result => 'not found', | |||||
| 335 | }; | |||||
| 336 | 1 1 | 1 1 | CORE::push @{$self->{'log'}}, $log; | |||
| 337 | 1 | 2 | next ENCODER; | |||
| 338 | } | |||||
| 339 | 4 | 7 | $l->{'geocoder'} = ref($geocoder); | |||
| 340 | print ref($geocoder), ': ', | |||||
| 341 | 4 | 3 | Data::Dumper->new([\$l])->Dump() if($self->{'debug'} >= 2); | |||
| 342 | 4 | 7 | last if(ref($l) eq 'Geo::Location::Point'); | |||
| 343 | 4 | 5 | next if(ref($l) ne 'HASH'); | |||
| 344 | 4 | 3 | if($l->{'error'}) { | |||
| 345 | my $log = { | |||||
| 346 | line => $call_details[2], | |||||
| 347 | location => $location, | |||||
| 348 | timetaken => $timetaken, | |||||
| 349 | geocoder => ref($geocoder), | |||||
| 350 | wantarray => wantarray, | |||||
| 351 | 0 | 0 | error => $l->{'error'} | |||
| 352 | }; | |||||
| 353 | 0 0 | 0 0 | CORE::push @{$self->{'log'}}, $log; | |||
| 354 | 0 | 0 | next ENCODER; | |||
| 355 | } else { | |||||
| 356 | # Try to create a common interface, helps with HTML::GoogleMaps::V3 | |||||
| 357 | 4 | 6 | if(!defined($l->{geometry}{location}{lat})) { | |||
| 358 | 3 | 2 | my ($lat, $long); | |||
| 359 | 3 | 6 | if($l->{lat} && defined($l->{lon})) { | |||
| 360 | # OSM/RandMcNalley | |||||
| 361 | # This would have been nice, but it doesn't compile | |||||
| 362 | # ($lat, $long) = $l->{'lat', 'lon'}; | |||||
| 363 | 3 | 2 | $lat = $l->{lat}; | |||
| 364 | 3 | 1 | $long = $l->{lon}; | |||
| 365 | 3 | 3 | $l->{'debug'} = __LINE__; | |||
| 366 | } elsif($l->{BestLocation}) { | |||||
| 367 | # Bing | |||||
| 368 | 0 | 0 | $lat = $l->{BestLocation}->{Coordinates}->{Latitude}; | |||
| 369 | 0 | 0 | $long = $l->{BestLocation}->{Coordinates}->{Longitude}; | |||
| 370 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 371 | } elsif($l->{point}) { | |||||
| 372 | # Bing | |||||
| 373 | 0 | 0 | $lat = $l->{point}->{coordinates}[0]; | |||
| 374 | 0 | 0 | $long = $l->{point}->{coordinates}[1]; | |||
| 375 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 376 | } elsif($l->{latt}) { | |||||
| 377 | # geocoder.ca | |||||
| 378 | 0 | 0 | $lat = $l->{latt}; | |||
| 379 | 0 | 0 | $long = $l->{longt}; | |||
| 380 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 381 | } elsif($l->{latitude}) { | |||||
| 382 | # postcodes.io | |||||
| 383 | # Geo::Coder::Free | |||||
| 384 | 0 | 0 | $lat = $l->{latitude}; | |||
| 385 | 0 | 0 | $long = $l->{longitude}; | |||
| 386 | 0 | 0 | if(my $type = $l->{'local_type'}) { | |||
| 387 | 0 | 0 | $l->{'type'} = lcfirst($type); # e.g. village | |||
| 388 | } | |||||
| 389 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 390 | } elsif($l->{'properties'}{'geoLatitude'}) { | |||||
| 391 | # ovi | |||||
| 392 | 0 | 0 | $lat = $l->{properties}{geoLatitude}; | |||
| 393 | 0 | 0 | $long = $l->{properties}{geoLongitude}; | |||
| 394 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 395 | } elsif($l->{'results'}[0]->{'geometry'}) { | |||||
| 396 | 0 | 0 | if($l->{'results'}[0]->{'geometry'}->{'location'}) { | |||
| 397 | # DataScienceToolkit | |||||
| 398 | 0 | 0 | $lat = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'}; | |||
| 399 | 0 | 0 | $long = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'}; | |||
| 400 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 401 | } else { | |||||
| 402 | # OpenCage | |||||
| 403 | 0 | 0 | $lat = $l->{'results'}[0]->{'geometry'}->{'lat'}; | |||
| 404 | 0 | 0 | $long = $l->{'results'}[0]->{'geometry'}->{'lng'}; | |||
| 405 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 406 | } | |||||
| 407 | } elsif($l->{'RESULTS'}) { | |||||
| 408 | # GeoCodeFarm | |||||
| 409 | 0 | 0 | $lat = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'}; | |||
| 410 | 0 | 0 | $long = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'}; | |||
| 411 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 412 | } elsif(defined($l->{result}{addressMatches}[0]->{coordinates}{y})) { | |||||
| 413 | # US Census | |||||
| 414 | # This would have been nice, but it doesn't compile | |||||
| 415 | # ($lat, $long) = $l->{result}{addressMatches}[0]->{coordinates}{y, x}; | |||||
| 416 | 0 | 0 | $lat = $l->{result}{addressMatches}[0]->{coordinates}{y}; | |||
| 417 | 0 | 0 | $long = $l->{result}{addressMatches}[0]->{coordinates}{x}; | |||
| 418 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 419 | } elsif($l->{lat}) { | |||||
| 420 | # Geo::GeoNames | |||||
| 421 | 0 | 0 | $lat = $l->{lat}; | |||
| 422 | 0 | 0 | $long = $l->{lng}; | |||
| 423 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 424 | } elsif($l->{features}) { | |||||
| 425 | 0 | 0 | if($l->{features}[0]->{center}) { | |||
| 426 | # Geo::Coder::Mapbox | |||||
| 427 | 0 | 0 | $lat = $l->{features}[0]->{center}[1]; | |||
| 428 | 0 | 0 | $long = $l->{features}[0]->{center}[0]; | |||
| 429 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 430 | } elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) { | |||||
| 431 | # Geo::Coder::GeoApify | |||||
| 432 | 0 | 0 | $lat = $l->{'features'}[0]{'geometry'}{'coordinates'}[1]; | |||
| 433 | 0 | 0 | $long = $l->{'features'}[0]{'geometry'}{'coordinates'}[0]; | |||
| 434 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 435 | } else { | |||||
| 436 | # GeoApify doesn't give an error if a location is not found | |||||
| 437 | 0 | 0 | next ENCODER; | |||
| 438 | } | |||||
| 439 | } else { | |||||
| 440 | 0 | 0 | $l->{'debug'} = __LINE__; | |||
| 441 | } | |||||
| 442 | ||||||
| 443 | 3 | 5 | if(defined($lat) && defined($long)) { | |||
| 444 | 3 | 2 | $l->{geometry}{location}{lat} = $lat; | |||
| 445 | 3 | 3 | $l->{geometry}{location}{lng} = $long; | |||
| 446 | # Compatibility | |||||
| 447 | 3 | 2 | $l->{'lat'} = $lat; | |||
| 448 | 3 | 3 | $l->{'lon'} = $long; | |||
| 449 | } else { | |||||
| 450 | 0 | 0 | delete $l->{'geometry'}; | |||
| 451 | 0 | 0 | delete $l->{'lat'}; | |||
| 452 | 0 | 0 | delete $l->{'lon'}; | |||
| 453 | } | |||||
| 454 | ||||||
| 455 | 3 | 3 | if($l->{'standard'}{'countryname'}) { | |||
| 456 | # geocoder.xyz | |||||
| 457 | 0 | 0 | $l->{'address'}{'country'} = $l->{'standard'}{'countryname'}; | |||
| 458 | } | |||||
| 459 | } | |||||
| 460 | 4 | 4 | if(defined($l->{geometry}{location}{lat})) { | |||
| 461 | 4 | 4 | print $l->{geometry}{location}{lat}, '/', $l->{geometry}{location}{lng}, "\n" if($self->{'debug'}); | |||
| 462 | 4 | 1 | $l->{geocoder} = $geocoder; | |||
| 463 | 4 | 8 | $l->{'lat'} //= $l->{geometry}{location}{lat}; | |||
| 464 | 4 | 9 | $l->{'lng'} //= $l->{geometry}{location}{lng}; | |||
| 465 | 4 | 3 | $l->{'lon'} //= $l->{geometry}{location}{lng}; | |||
| 466 | 4 | 9 | my $log = { | |||
| 467 | line => $call_details[2], | |||||
| 468 | location => $location, | |||||
| 469 | timetaken => $timetaken, | |||||
| 470 | geocoder => ref($geocoder), | |||||
| 471 | wantarray => wantarray, | |||||
| 472 | result => $l | |||||
| 473 | }; | |||||
| 474 | 4 4 | 3 2 | CORE::push @{$self->{'log'}}, $log; | |||
| 475 | 4 | 4 | last POSSIBLE_LOCATION; | |||
| 476 | } | |||||
| 477 | } | |||||
| 478 | } | |||||
| 479 | ||||||
| 480 | 4 | 4 | if(scalar(@rc)) { | |||
| 481 | 4 | 4 | print 'Number of matches from ', ref($geocoder), ': ', scalar(@rc), "\n" if($self->{'debug'}); | |||
| 482 | 4 | 1 | $Data::Dumper::Maxdepth = 10; | |||
| 483 | 4 | 4 | print Data::Dumper->new([\@rc])->Dump() if($self->{'debug'} >= 2); | |||
| 484 | 4 | 11 | if(defined($rc[0])) { # check it's not an empty hash | |||
| 485 | 4 | 3 | if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) { | |||
| 486 | 0 | 0 | $rc[0]->{'lng'} = $rc[0]->{'long'}; | |||
| 487 | } | |||||
| 488 | 4 | 5 | if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lon'})) { | |||
| 489 | 0 | 0 | $rc[0]->{'lon'} = $rc[0]->{'long'}; | |||
| 490 | } | |||||
| 491 | 4 | 5 | if((!defined($rc[0]->{lat})) || (!defined($rc[0]->{lng}))) { | |||
| 492 | # ::diag(Data::Dumper->new([\@rc])->Dump()); | |||||
| 493 | 0 | 0 | warn Data::Dumper->new([\@rc])->Dump(); | |||
| 494 | 0 | 0 | Carp::croak("BUG: '$location': HASH exists but is not sensible"); | |||
| 495 | } | |||||
| 496 | 4 | 3 | if(wantarray) { | |||
| 497 | 1 | 2 | $self->_cache($location, \@rc); | |||
| 498 | 1 | 2 | return @rc; | |||
| 499 | } | |||||
| 500 | 3 | 5 | $self->_cache($location, $rc[0]); | |||
| 501 | 3 | 6 | return $rc[0]; | |||
| 502 | } | |||||
| 503 | } | |||||
| 504 | } | |||||
| 505 | # Can't do this because we need to return undef in this case | |||||
| 506 | # if($error) { | |||||
| 507 | # return { error => $error }; | |||||
| 508 | # } | |||||
| 509 | 1 | 1 | print "No matches\n" if($self->{'debug'}); | |||
| 510 | 1 | 2 | if(wantarray) { | |||
| 511 | 0 | 0 | $self->_cache($location, ()); | |||
| 512 | 0 | 0 | return (); | |||
| 513 | } | |||||
| 514 | 1 | 1 | $self->_cache($location, undef); | |||
| 515 | } | |||||
| 516 | ||||||
| 517 - 542 | =head2 ua($self, $ua) Accessor method to set the UserAgent object used internally by each of the Geo-Coders. You can call I<env_proxy>, for example, to set the proxy information from environment variables: my $geocoder_list = Geo::Coder::List->new(); my $ua = LWP::UserAgent->new(); $ua->env_proxy(1); $geocoder_list->ua($ua); Note that unlike Geo::Coders, there is no read method since that would be pointless. =head3 Parameters =over 4 =item * C<$ua> object (optional) Useragent object. =back =cut | |||||
| 543 | ||||||
| 544 | sub ua | |||||
| 545 | { | |||||
| 546 | 0 | 0 | my($self, $ua) = @_; | |||
| 547 | 0 | 0 | return unless $ua; | |||
| 548 | ||||||
| 549 | 0 0 | 0 0 | foreach my $g(@{$self->{geocoders}}) { | |||
| 550 | 0 | 0 | my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g; | |||
| 551 | 0 | 0 | Carp::croak('No geocoder found') unless defined $geocoder; | |||
| 552 | 0 | 0 | $geocoder->ua($ua); | |||
| 553 | } | |||||
| 554 | ||||||
| 555 | 0 | 0 | return $ua; | |||
| 556 | } | |||||
| 557 | ||||||
| 558 - 564 | =head2 reverse_geocode Similar to geocode except it expects a latitude/longitude parameter. print $geocoder_list->reverse_geocode(latlng => '37.778907,-122.39732'); =cut | |||||
| 565 | ||||||
| 566 | sub reverse_geocode { | |||||
| 567 | 0 | 0 | my $self = shift; | |||
| 568 | 0 | 0 | my $params = Params::Get::get_params('latlng', @_); | |||
| 569 | ||||||
| 570 | 0 | 0 | my $latlng = $params->{'latlng'} | |||
| 571 | or Carp::croak('Usage: reverse_geocode(latlng => $location)'); | |||||
| 572 | ||||||
| 573 | 0 | 0 | my ($latitude, $longitude); | |||
| 574 | 0 | 0 | if($latlng) { | |||
| 575 | 0 | 0 | ($latitude, $longitude) = split(/,/, $latlng); | |||
| 576 | 0 | 0 | $params->{'lat'} //= $latitude; | |||
| 577 | 0 | 0 | $params->{'lon'} //= $longitude; | |||
| 578 | } else { | |||||
| 579 | 0 | 0 | $latitude //= $params->{'lat'}; | |||
| 580 | 0 | 0 | $longitude //= $params->{'lon'}; | |||
| 581 | 0 | 0 | $longitude //= $params->{'long'}; | |||
| 582 | 0 | 0 | $latlng = $params->{'latlng'} = "$latitude,$longitude"; | |||
| 583 | } | |||||
| 584 | ||||||
| 585 | 0 | 0 | if(my $rc = $self->_cache($latlng)) { | |||
| 586 | 0 | 0 | return $rc; | |||
| 587 | } | |||||
| 588 | ||||||
| 589 | 0 0 | 0 0 | foreach my $g(@{$self->{geocoders}}) { | |||
| 590 | 0 | 0 | my $geocoder = $g; | |||
| 591 | 0 | 0 | if(ref($geocoder) eq 'HASH') { | |||
| 592 | 0 | 0 | if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) { | |||
| 593 | 0 | 0 | print "limit: $limit\n" if($self->{'debug'}); | |||
| 594 | 0 | 0 | if($limit <= 0) { | |||
| 595 | 0 | 0 | next; | |||
| 596 | } | |||||
| 597 | 0 | 0 | $geocoder->{'limit'}--; | |||
| 598 | } | |||||
| 599 | 0 | 0 | $geocoder = $g->{'geocoder'}; | |||
| 600 | } | |||||
| 601 | 0 | 0 | print 'trying ', ref($geocoder), "\n" if($self->{'debug'}); | |||
| 602 | 0 | 0 | if(wantarray) { | |||
| 603 | 0 | 0 | my @rc; | |||
| 604 | 0 0 | 0 0 | if(my @locs = $geocoder->reverse_geocode(%{$params})) { | |||
| 605 | 0 | 0 | print Data::Dumper->new([\@locs])->Dump() if($self->{'debug'} >= 2); | |||
| 606 | 0 | 0 | foreach my $loc(@locs) { | |||
| 607 | 0 | 0 | if(my $name = $loc->{'display_name'}) { | |||
| 608 | # OSM | |||||
| 609 | 0 | 0 | CORE::push @rc, $name; | |||
| 610 | } elsif($loc->{'city'}) { | |||||
| 611 | # Geo::Coder::CA | |||||
| 612 | 0 | 0 | my $name; | |||
| 613 | 0 | 0 | if(my $usa = $loc->{'usa'}) { | |||
| 614 | 0 | 0 | $name = $usa->{'usstnumber'}; | |||
| 615 | 0 | 0 | if(my $staddress = $usa->{'usstaddress'}) { | |||
| 616 | 0 | 0 | $name .= ' ' if($name); | |||
| 617 | 0 | 0 | $name .= $staddress; | |||
| 618 | } | |||||
| 619 | 0 | 0 | if(my $city = $usa->{'uscity'}) { | |||
| 620 | 0 | 0 | $name .= ', ' if($name); | |||
| 621 | 0 | 0 | $name .= $city; | |||
| 622 | } | |||||
| 623 | 0 | 0 | if(my $state = $usa->{'state'}) { | |||
| 624 | 0 | 0 | $name .= ', ' if($name); | |||
| 625 | 0 | 0 | $name .= $state; | |||
| 626 | } | |||||
| 627 | 0 | 0 | $name .= ', ' if($name); | |||
| 628 | 0 | 0 | $name .= 'USA'; | |||
| 629 | } else { | |||||
| 630 | 0 | 0 | $name = $loc->{'stnumber'}; | |||
| 631 | 0 | 0 | if(my $staddress = $loc->{'staddress'}) { | |||
| 632 | 0 | 0 | $name .= ' ' if($name); | |||
| 633 | 0 | 0 | $name .= $staddress; | |||
| 634 | } | |||||
| 635 | 0 | 0 | if(my $city = $loc->{'city'}) { | |||
| 636 | 0 | 0 | $name .= ', ' if($name); | |||
| 637 | 0 | 0 | $name .= $city; | |||
| 638 | } | |||||
| 639 | 0 | 0 | if(my $state = $loc->{'prov'}) { | |||
| 640 | 0 | 0 | $state .= ', ' if($name); | |||
| 641 | 0 | 0 | $name .= $state; | |||
| 642 | } | |||||
| 643 | } | |||||
| 644 | 0 | 0 | CORE::push @rc, $name; | |||
| 645 | } elsif($loc->{features}) { | |||||
| 646 | # Geo::Coder::Apify | |||||
| 647 | 0 | 0 | return CORE::push @rc, $loc->{features}[0]->{properties}{formatted}; | |||
| 648 | } | |||||
| 649 | } | |||||
| 650 | } | |||||
| 651 | 0 | 0 | $self->_cache($latlng, \@rc); | |||
| 652 | 0 | 0 | return @rc; | |||
| 653 | 0 | 0 | } elsif(my $rc = $self->_cache($latlng) // $geocoder->reverse_geocode(%{$params})) { | |||
| 654 | 0 | 0 | return $rc if(!ref($rc)); | |||
| 655 | 0 | 0 | print Data::Dumper->new([$rc])->Dump() if($self->{'debug'} >= 2); | |||
| 656 | 0 | 0 | if(my $name = $rc->{'display_name'}) { | |||
| 657 | # OSM | |||||
| 658 | 0 | 0 | return $self->_cache($latlng, $name); | |||
| 659 | } | |||||
| 660 | 0 | 0 | if($rc->{'city'}) { | |||
| 661 | # Geo::Coder::CA | |||||
| 662 | 0 | 0 | my $name; | |||
| 663 | 0 | 0 | if(my $usa = $rc->{'usa'}) { | |||
| 664 | # TODO: Use Lingua::Conjunction | |||||
| 665 | 0 | 0 | $name = $usa->{'usstnumber'}; | |||
| 666 | 0 | 0 | if(my $staddress = $usa->{'usstaddress'}) { | |||
| 667 | 0 | 0 | $name .= ' ' if($name); | |||
| 668 | 0 | 0 | $name .= $staddress; | |||
| 669 | } | |||||
| 670 | 0 | 0 | if(my $city = $usa->{'uscity'}) { | |||
| 671 | 0 | 0 | $name .= ', ' if($name); | |||
| 672 | 0 | 0 | $name .= $city; | |||
| 673 | } | |||||
| 674 | 0 | 0 | if(my $state = $usa->{'state'}) { | |||
| 675 | 0 | 0 | $name .= ', ' if($name); | |||
| 676 | 0 | 0 | $name .= $state; | |||
| 677 | } | |||||
| 678 | 0 | 0 | return $self->_cache($latlng, "$name, USA"); | |||
| 679 | } else { | |||||
| 680 | # TODO: Use Lingua::Conjunction | |||||
| 681 | 0 | 0 | $name = $rc->{'stnumber'}; | |||
| 682 | 0 | 0 | if(my $staddress = $rc->{'staddress'}) { | |||
| 683 | 0 | 0 | $name .= ' ' if($name); | |||
| 684 | 0 | 0 | $name .= $staddress; | |||
| 685 | } | |||||
| 686 | 0 | 0 | if(my $city = $rc->{'city'}) { | |||
| 687 | 0 | 0 | $name .= ', ' if($name); | |||
| 688 | 0 | 0 | $name .= $city; | |||
| 689 | } | |||||
| 690 | 0 | 0 | if(my $state = $rc->{'prov'}) { | |||
| 691 | 0 | 0 | $state = ", $state" if($name); | |||
| 692 | 0 | 0 | return $self->_cache($latlng, "$name $state"); | |||
| 693 | } | |||||
| 694 | } | |||||
| 695 | 0 | 0 | return $self->_cache($latlng, $name); | |||
| 696 | } | |||||
| 697 | 0 | 0 | if($rc->{features}) { | |||
| 698 | # Geo::Coder::Apify | |||||
| 699 | 0 | 0 | return $self->_cache($latlng, $rc->{features}[0]->{properties}{formatted}); | |||
| 700 | } | |||||
| 701 | } | |||||
| 702 | } | |||||
| 703 | 0 | 0 | return; | |||
| 704 | } | |||||
| 705 | ||||||
| 706 - 713 | =head2 log
Returns the log of events to help you debug failures,
optimize lookup order and fix quota breakage.
my @log = @{$geocoderlist->log()};
=cut | |||||
| 714 | ||||||
| 715 | sub log { | |||||
| 716 | 2 | 531 | my $self = shift; | |||
| 717 | ||||||
| 718 | 2 | 13 | return $self->{'log'}; | |||
| 719 | } | |||||
| 720 | ||||||
| 721 - 725 | =head2 flush Clear the log. =cut | |||||
| 726 | ||||||
| 727 | sub flush { | |||||
| 728 | 0 | 0 | my $self = shift; | |||
| 729 | ||||||
| 730 | 0 | 0 | delete $self->{'log'}; | |||
| 731 | } | |||||
| 732 | ||||||
| 733 | sub _cache { | |||||
| 734 | 15 | 8 | my $self = shift; | |||
| 735 | 15 | 9 | my $key = shift; | |||
| 736 | ||||||
| 737 | 15 | 11 | if(my $value = shift) { | |||
| 738 | # Put something into the cache | |||||
| 739 | 4 | 5 | $self->{locations}->{$key} = $value; | |||
| 740 | 4 | 1 | my $rc = $value; | |||
| 741 | 4 | 3 | if($self->{'cache'}) { | |||
| 742 | 1 | 1 | my $duration; | |||
| 743 | 1 | 2 | if(ref($value) eq 'ARRAY') { | |||
| 744 | 0 0 | 0 0 | foreach my $item(@{$value}) { | |||
| 745 | 0 | 0 | if(ref($item) eq 'HASH') { | |||
| 746 | 0 | 0 | $item->{'geocoder'} = ref($item->{'geocoder'}); # It's an object, not the name | |||
| 747 | 0 | 0 | if(!$self->{'debug'}) { | |||
| 748 | 0 0 | 0 0 | while(my($k, $v) = each %{$item}) { | |||
| 749 | 0 | 0 | delete $item->{$k} unless($k eq 'geometry'); | |||
| 750 | } | |||||
| 751 | } | |||||
| 752 | 0 | 0 | if(!defined($item->{geometry}{location}{lat})) { | |||
| 753 | 0 | 0 | if(defined($item->{geometry})) { | |||
| 754 | # Maybe a temporary lookup failure, | |||||
| 755 | # so do a research tomorrow | |||||
| 756 | 0 | 0 | $duration = '1 day'; | |||
| 757 | } else { | |||||
| 758 | # Probably the place doesn't exist | |||||
| 759 | 0 | 0 | $duration = '1 week'; | |||
| 760 | } | |||||
| 761 | 0 | 0 | $rc = undef; | |||
| 762 | } | |||||
| 763 | } | |||||
| 764 | } | |||||
| 765 | 0 | 0 | if(!defined($duration)) { | |||
| 766 | # Has matched - it won't move | |||||
| 767 | 0 | 0 | $duration = '1 month'; | |||
| 768 | } | |||||
| 769 | } elsif(ref($value) eq 'HASH') { | |||||
| 770 | 1 | 2 | $value->{'geocoder'} = ref($value->{'geocoder'}); # It's an object, not the name | |||
| 771 | 1 | 1 | if(!$self->{'debug'}) { | |||
| 772 | 1 8 | 1 8 | while(my($k, $v) = each %{$value}) { | |||
| 773 | 7 | 7 | delete $value->{$k} unless ($k eq 'geometry'); | |||
| 774 | } | |||||
| 775 | } | |||||
| 776 | 1 | 1 | if(defined($value->{geometry}{location}{lat})) { | |||
| 777 | 1 | 1 | $duration = '1 month'; # It won't move :-) | |||
| 778 | } elsif(defined($value->{geometry})) { | |||||
| 779 | # Maybe a temporary lookup failure, so do a research | |||||
| 780 | # tomorrow | |||||
| 781 | 0 | 0 | $duration = '1 day'; | |||
| 782 | 0 | 0 | $rc = undef; | |||
| 783 | } else { | |||||
| 784 | # Probably the place doesn't exist | |||||
| 785 | 0 | 0 | $duration = '1 week'; | |||
| 786 | 0 | 0 | $rc = undef; | |||
| 787 | } | |||||
| 788 | } else { | |||||
| 789 | 0 | 0 | $duration = '1 month'; | |||
| 790 | } | |||||
| 791 | 1 | 1 | print Data::Dumper->new([$value])->Dump() if($self->{'debug'}); | |||
| 792 | 1 | 2 | if(ref($self->{'cache'}) eq 'HASH') { | |||
| 793 | 1 | 1 | $self->{'cache'}->{$key} = $value; | |||
| 794 | } elsif(!ref($value)) { | |||||
| 795 | 0 | 0 | $self->{'cache'}->set($key, $value, $duration); | |||
| 796 | } | |||||
| 797 | } | |||||
| 798 | 4 | 3 | return $rc; | |||
| 799 | } | |||||
| 800 | ||||||
| 801 | # Retrieve from the cache | |||||
| 802 | 11 | 7 | my $rc = $self->{'locations'}->{$key}; # In the L1 cache? | |||
| 803 | 11 | 13 | if((!defined($rc)) && $self->{'cache'}) { # In the L2 cache? | |||
| 804 | 2 | 3 | if(ref($self->{'cache'}) eq 'HASH') { | |||
| 805 | 2 | 1 | $rc = $self->{'cache'}->{$key}; | |||
| 806 | } else { | |||||
| 807 | 0 | 0 | $rc = $self->{'cache'}->get($key); | |||
| 808 | } | |||||
| 809 | } | |||||
| 810 | 11 | 12 | if(defined($rc)) { | |||
| 811 | 1 | 1 | if(ref($rc) eq 'HASH') { # else - it will be an array of hashes | |||
| 812 | 1 | 1 | if(!defined($rc->{geometry}{location}{lat})) { | |||
| 813 | 0 | 0 | return; | |||
| 814 | } | |||||
| 815 | 1 | 3 | $rc->{'lat'} //= $rc->{geometry}{location}{lat}; | |||
| 816 | 1 | 2 | $rc->{'lng'} //= $rc->{geometry}{location}{lng}; | |||
| 817 | 1 | 2 | $rc->{'lon'} //= $rc->{geometry}{location}{lng}; | |||
| 818 | } | |||||
| 819 | } | |||||
| 820 | 11 | 15 | return $rc; | |||
| 821 | } | |||||
| 822 | ||||||
| 823 - 854 | =head1 AUTHOR Nigel Horne, C<< <njh at nigelhorne.com> >> =head1 BUGS Please report any bugs or feature requests to C<bug-geo-coder-list at rt.cpan.org>, or through the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Geo-Coder-List>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. reverse_geocode() doesn't update the logger. reverse_geocode() should support L<Geo::Location::Point> objects. =head1 SEE ALSO =over 4 =item * Test coverage report: L<https://nigelhorne.github.io/Geo-Coder-List/coverage/> =item * L<Geo::Coder::All> =item * L<Geo::Coder::GooglePlaces> =item * L<Geo::Coder::Many> =item * L<Object::Configure> =back =cut | |||||
| 855 | ||||||
| 856 - 884 | =head1 SUPPORT This module is provided as-is without any warranty. You can find documentation for this module with the perldoc command. perldoc Geo::Coder::List You can also look for information at: =over 4 =item * RT: CPAN's request tracker L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Coder-List> =item * MetaCPAN L<https://metacpan.org/release/Geo-Coder-List> =back =head1 LICENSE AND COPYRIGHT Copyright 2016-2026 Nigel Horne. This program is released under the following licence: GPL2 =cut | |||||
| 885 | ||||||
| 886 | 1; | |||||