| File: | blib/lib/Geo/Coder/List.pm |
| Coverage: | 92.3% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Geo::Coder::List; | |||||
| 2 | ||||||
| 3 | # Geo::Coder::List - Aggregate and chain multiple geocoding backends | |||||
| 4 | ||||||
| 5 | 25 25 | 1864492 37 | use 5.10.1; | |||
| 6 | ||||||
| 7 | 25 25 25 | 38 40 230 | use strict; | |||
| 8 | 25 25 25 | 38 18 483 | use warnings; | |||
| 9 | 25 25 25 | 3602 122123 46 | use autodie qw(:all); | |||
| 10 | ||||||
| 11 | 25 25 25 | 161612 16 619 | use Carp; | |||
| 12 | 25 25 25 | 57 16 420 | use Data::Dumper; | |||
| 13 | 25 25 25 | 4878 60312 1075 | use HTML::Entities; | |||
| 14 | 25 25 25 | 6424 1304605 517 | use Object::Configure 0.13; | |||
| 15 | 25 25 25 | 83 115 379 | use Params::Get 0.04; | |||
| 16 | 25 25 25 | 45 15 458 | use Readonly; | |||
| 17 | 25 25 25 | 44 20 398 | use Scalar::Util qw(blessed); | |||
| 18 | 25 25 25 | 39 16 56 | use Time::HiRes; | |||
| 19 | ||||||
| 20 - 28 | =head1 NAME Geo::Coder::List - Call many Geo-Coders =head1 VERSION Version 0.37 =cut | |||||
| 29 | ||||||
| 30 | our $VERSION = '0.37'; | |||||
| 31 | ||||||
| 32 | # ââ Module-level constants (not user-configurable) ââââââââââââââââââââââââââââ | |||||
| 33 | ||||||
| 34 | # Default verbosity: 0 = silent, 1 = basic trace, 2 = full Data::Dumper dumps | |||||
| 35 | 25 25 25 | 977 21 638 | use constant DEBUG_DEFAULT => 0; | |||
| 36 | ||||||
| 37 | # Internal sentinel class: a cached not-found result stored in L1. | |||||
| 38 | # Using a blessed ref lets _cache() distinguish "never looked up" from | |||||
| 39 | # "looked up and found nothing" without requiring a special undef convention. | |||||
| 40 | 25 25 25 | 44 21 60994 | use constant _NOT_FOUND_CLASS => __PACKAGE__ . '::_NotFound'; | |||
| 41 | ||||||
| 42 | # The singleton value stored in L1 when a location is confirmed missing | |||||
| 43 | my $NOT_FOUND_SENTINEL = bless {}, _NOT_FOUND_CLASS; | |||||
| 44 | ||||||
| 45 | # String placed in the 'geocoder' field of a result served from cache | |||||
| 46 | Readonly::Scalar my $CACHE_SOURCE => 'cache'; | |||||
| 47 | ||||||
| 48 | # String used as the 'result' value in log entries for a geocoder miss | |||||
| 49 | Readonly::Scalar my $RESULT_NONE => 'not found'; | |||||
| 50 | ||||||
| 51 | # ââ Configurable defaults âââââââââââââââââââââââââââââââââââââââââââââââââââââ | |||||
| 52 | # | |||||
| 53 | # Any key here can be overridden at run time via an environment variable named | |||||
| 54 | # GEO__CODER__LIST__<key>, which Object::Configure reads automatically in new(). | |||||
| 55 | # Example: | |||||
| 56 | # export GEO__CODER__LIST__cache_hit_duration='7 days' | |||||
| 57 | ||||||
| 58 | my %config = ( | |||||
| 59 | debug => DEBUG_DEFAULT, | |||||
| 60 | # How long a confirmed location stays in the L2 cache | |||||
| 61 | cache_hit_duration => '1 month', | |||||
| 62 | # How long a transient/partial failure is cached (retry tomorrow) | |||||
| 63 | cache_part_duration => '1 day', | |||||
| 64 | # How long a definite not-found is cached (place probably does not exist) | |||||
| 65 | cache_miss_duration => '1 week', | |||||
| 66 | ); | |||||
| 67 | ||||||
| 68 | # ============================================================================= | |||||
| 69 | # PUBLIC API | |||||
| 70 | # ============================================================================= | |||||
| 71 | ||||||
| 72 - 147 | =head1 SYNOPSIS
L<Geo::Coder::All> and L<Geo::Coder::Many> are great modules but neither
quite does what I want.
C<Geo::Coder::List> aggregates multiple geocoding services into a single,
unified interface. It chains and prioritizes backends based on regex routing
and per-geocoder query limits, caches results at two levels (L1 in-memory
always; optional L2 via CHI or a plain HASH), and normalizes every provider's
idiosyncratic response into the common structure expected by
L<HTML::GoogleMaps::V3> and L<HTML::OSM>:
$result->{geometry}{location}{lat} # canonical latitude
$result->{geometry}{location}{lng} # canonical longitude
$result->{geocoder} # source object (or 'cache')
use Geo::Coder::List;
use Geo::Coder::OSM;
use Geo::Coder::CA;
my $list = Geo::Coder::List->new()
->push({ regex => qr/(Canada|USA)$/, geocoder => Geo::Coder::CA->new() })
->push(Geo::Coder::OSM->new());
my $loc = $list->geocode('10 Downing St, London, UK');
printf "lat=%.4f lng=%.4f\n",
$loc->{geometry}{location}{lat},
$loc->{geometry}{location}{lng};
=head1 SUBROUTINES/METHODS
=head2 new
Creates a new C<Geo::Coder::List> object. When called on an existing object
it returns a clone of that object merged with the supplied arguments.
The constructor reads configuration from environment variables via
L<Object::Configure>; for example, setting
C<GEO__CODER__LIST__carp_on_warn=1> causes warnings to use L<Carp>.
use Geo::Coder::List;
use CHI;
# With an optional L2 cache (any CHI driver works)
my $geocoder = Geo::Coder::List->new(
cache => CHI->new(driver => 'Memory', global => 1),
debug => 0,
);
# Clone an existing object with a higher debug level
my $verbose = $geocoder->new(debug => 2);
=head3 API SPECIFICATION
=head4 INPUT
# Params::Validate::Strict schema
{
cache => {
type => [ 'hashref', 'object' ], # OBJECT must implement get($key) and set($key, $value, $ttl)
optional => 1,
},
debug => {
type => 'boolean',
optional => 1,
default => 0,
},
# Any additional key is forwarded to Object::Configure
}
=head4 OUTPUT
# Return::Set schema
OBJECT blessed into Geo::Coder::List
=cut | |||||
| 148 | ||||||
| 149 | sub new | |||||
| 150 | { | |||||
| 151 | 333 | 1045476 | my $class = shift; | |||
| 152 | 333 | 496 | my $params = Params::Get::get_params(undef, \@_) || {}; | |||
| 153 | ||||||
| 154 | # Handle the rare Geo::Coder::List::new() (function-style) invocation | |||||
| 155 | 333 | 3987 | if(!defined($class)) { | |||
| 156 | 8 8 | 5 16 | if(scalar keys %{$params} > 0) { | |||
| 157 | # Using ::new() with arguments is not supported | |||||
| 158 | 4 | 39 | carp(__PACKAGE__, ' use ->new() not ::new() to instantiate'); | |||
| 159 | 4 | 741 | return; | |||
| 160 | } | |||||
| 161 | # FIXME: cloning does not work when called as ::new() with arguments | |||||
| 162 | 4 | 4 | $class = __PACKAGE__; | |||
| 163 | } elsif(blessed($class)) { | |||||
| 164 | # Shallow clone merged with new params; log is always fresh so the | |||||
| 165 | # clone starts with an empty event history independent of the original | |||||
| 166 | 6 6 6 | 4 11 20 | return bless { %{$class}, %{$params}, log => [] }, ref($class); | |||
| 167 | } | |||||
| 168 | ||||||
| 169 | # Let Object::Configure overlay defaults from environment / config files | |||||
| 170 | 323 | 388 | $params = Object::Configure::configure($class, $params); | |||
| 171 | ||||||
| 172 | # Fill in any %config defaults the caller did not explicitly supply | |||||
| 173 | 323 | 641397 | for my $key (keys %config) { | |||
| 174 | 1292 | 1609 | $params->{$key} //= $config{$key}; | |||
| 175 | } | |||||
| 176 | ||||||
| 177 | # Bless and return; params override scalar defaults but locations/log | |||||
| 178 | # are always initialised fresh so callers cannot inject stale state | |||||
| 179 | return bless { | |||||
| 180 | debug => DEBUG_DEFAULT, | |||||
| 181 | geocoders => [], | |||||
| 182 | 323 323 | 241 1182 | %{$params}, | |||
| 183 | locations => {}, | |||||
| 184 | log => [], | |||||
| 185 | }, $class; | |||||
| 186 | } | |||||
| 187 | ||||||
| 188 | # ============================================================================= | |||||
| 189 | ||||||
| 190 - 223 | =head2 push
Appends a geocoder to the chain. Geocoders are tried in the order they
were pushed. Returns C<$self> so calls can be chained.
A plain geocoder object is tried for every location. A hashref with
C<regex>, C<geocoder>, and optional C<limit> keys restricts the geocoder to
locations matching the regex and caps total queries at C<limit>.
my $list = Geo::Coder::List->new()
->push({ regex => qr/USA$/, geocoder => Geo::Coder::CA->new(), limit => 100 })
->push(Geo::Coder::OSM->new());
=head3 API SPECIFICATION
=head4 INPUT
# Params::Validate::Strict schema
{
geocoder => {
type => OBJECT | HASHREF,
required => 1,
# HASHREF must contain: geocoder => OBJECT
# HASHREF may contain: regex => Regexp
# limit => SCALAR (positive integer)
},
}
=head4 OUTPUT
# Return::Set schema
OBJECT blessed into Geo::Coder::List # $self, for chaining
=cut | |||||
| 224 | ||||||
| 225 | sub push | |||||
| 226 | { | |||||
| 227 | # Deliberately NOT using Params::Get here: passing the hashref through it | |||||
| 228 | # would stringify the compiled qr// object, destroying the regex. | |||||
| 229 | 260 | 2138 | my ($self, $geocoder) = @_; | |||
| 230 | ||||||
| 231 | # A geocoder argument is mandatory | |||||
| 232 | 260 | 266 | croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless defined($geocoder); | |||
| 233 | ||||||
| 234 | # Append to the ordered chain and return $self for chaining | |||||
| 235 | 256 256 | 126 204 | CORE::push @{$self->{geocoders}}, $geocoder; | |||
| 236 | ||||||
| 237 | 256 | 254 | return $self; | |||
| 238 | } | |||||
| 239 | ||||||
| 240 | # ============================================================================= | |||||
| 241 | ||||||
| 242 - 297 | =head2 geocode
Resolves a location string to geographic coordinates by trying each geocoder
in turn. The first successful result is returned and cached.
In scalar context returns a single hashref (or C<undef> on failure).
In list context returns all results from the winning geocoder.
The C<geocoder> field of the returned hashref holds the geocoder object that
supplied the result; it is set to the string C<'cache'> when the result was
served from cache.
See L<Geo::Coder::GooglePlaces::V3> for the canonical result structure.
my $result = $list->geocode(location => 'Paris, France');
if($result) {
printf "lat=%.4f lng=%.4f via %s\n",
$result->{geometry}{location}{lat},
$result->{geometry}{location}{lng},
ref($result->{geocoder}) || $result->{geocoder};
}
# List context returns all candidates from the winning geocoder
my @results = $list->geocode('London, UK');
=head3 API SPECIFICATION
=head4 INPUT
# Params::Validate::Strict schema
{
location => {
type => SCALAR,
required => 1,
# Must contain at least one non-digit character
},
}
=head4 OUTPUT
# Return::Set schema (scalar context)
HASHREF | undef
{
geometry => { location => { lat => Num, lng => Num } },
geocoder => OBJECT | 'cache',
lat => Num, # convenience alias
lng => Num, # convenience alias
lon => Num, # compatibility alias for lng
debug => Int, # source line of the normalisation branch taken
# ... provider-specific keys are preserved
}
# Return::Set schema (list context)
ARRAY of the above HASHREFs
=cut | |||||
| 298 | ||||||
| 299 | sub geocode { | |||||
| 300 | 202 | 10360 | my $self = shift; | |||
| 301 | ||||||
| 302 | # Params::Get enforces 'location'; calling geocode() with no args causes | |||||
| 303 | # get_params itself to croak with "Usage:" matching t/carp.t expectations | |||||
| 304 | 202 | 207 | my $params = Params::Get::get_params('location', @_); | |||
| 305 | ||||||
| 306 | 200 | 2014 | my $location = $params->{'location'}; | |||
| 307 | ||||||
| 308 | # Reject empty or whitespace-only location strings | |||||
| 309 | 200 | 320 | if((!defined($location)) || (length($location) == 0)) { | |||
| 310 | 6 | 10 | $self->_warn(__PACKAGE__, ' usage: geocode(location => $location)'); | |||
| 311 | 6 | 1618 | return; | |||
| 312 | } | |||||
| 313 | ||||||
| 314 | # A purely numeric string is almost certainly an error (e.g. a bare postcode) | |||||
| 315 | 194 | 294 | if($params->{'location'} !~ /\D/) { | |||
| 316 | 4 | 8 | $self->_error('Usage: ', __PACKAGE__, ': invalid input to geocode(), ', $params->{location}); | |||
| 317 | } | |||||
| 318 | ||||||
| 319 | # Collapse runs of whitespace and expand any HTML entities | |||||
| 320 | 190 | 339 | $location =~ s/\s\s+/ /g; | |||
| 321 | 190 | 511 | $location = decode_entities($location); | |||
| 322 | # Propagate the cleaned-up string so geocoders also receive the decoded form | |||||
| 323 | 190 | 162 | $params->{'location'} = $location; | |||
| 324 | ||||||
| 325 | 190 | 174 | print "location: $location\n" if($self->{'debug'}); | |||
| 326 | ||||||
| 327 | # Capture the caller's line number once for all log entries in this call | |||||
| 328 | 190 | 176 | my @call_details = caller(0); | |||
| 329 | ||||||
| 330 | # ââ L1 / L2 cache lookup ââââââââââââââââââââââââââââââââââââââââââââââ | |||||
| 331 | ||||||
| 332 | # _cache() returns undef for both "not in cache" and "cached not-found"; | |||||
| 333 | # the not-found sentinel is handled internally so callers see undef either way | |||||
| 334 | 190 | 1374 | my $cached = $self->_cache($location); | |||
| 335 | ||||||
| 336 | 190 | 155 | if(defined $cached) { | |||
| 337 | # A defined value means we have a genuine cached positive result | |||||
| 338 | 28 5 | 33 6 | my @rc = ref($cached) eq 'ARRAY' ? @{$cached} : ($cached); | |||
| 339 | ||||||
| 340 | # Mark every element as coming from cache. Shallow-copy HASH results | |||||
| 341 | # first so that neither the L1 cache entry nor any caller-held reference | |||||
| 342 | # to the same hashref is mutated in place. | |||||
| 343 | 28 | 22 | for my $r (@rc) { | |||
| 344 | 28 | 22 | next unless ref($r); | |||
| 345 | 28 26 | 31 47 | $r = { %{$r} } if ref($r) eq 'HASH'; | |||
| 346 | 28 | 34 | $r->{'geocoder'} = $CACHE_SOURCE; | |||
| 347 | } | |||||
| 348 | ||||||
| 349 | # Scalar context: return the first (and usually only) element | |||||
| 350 | 28 | 20 | if(!wantarray) { | |||
| 351 | 22 | 17 | my $rc = $rc[0]; | |||
| 352 | 22 22 | 9 74 | CORE::push @{$self->{'log'}}, { | |||
| 353 | line => $call_details[2], | |||||
| 354 | location => $location, | |||||
| 355 | timetaken => 0, | |||||
| 356 | geocoder => $CACHE_SOURCE, | |||||
| 357 | wantarray => 0, | |||||
| 358 | result => $rc, | |||||
| 359 | }; | |||||
| 360 | 22 | 521 | print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'}); | |||
| 361 | 22 | 39 | return $rc; | |||
| 362 | } | |||||
| 363 | ||||||
| 364 | # List context: return all cached candidates | |||||
| 365 | 6 6 | 3 21 | CORE::push @{$self->{'log'}}, { | |||
| 366 | line => $call_details[2], | |||||
| 367 | location => $location, | |||||
| 368 | timetaken => 0, | |||||
| 369 | geocoder => $CACHE_SOURCE, | |||||
| 370 | wantarray => 1, | |||||
| 371 | result => \@rc, | |||||
| 372 | }; | |||||
| 373 | 6 | 8 | print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'}); | |||
| 374 | ||||||
| 375 | # Determine if every element is empty; if so return nothing | |||||
| 376 | 6 | 4 | my $allempty = 1; | |||
| 377 | 6 | 6 | for my $r (@rc) { | |||
| 378 | 6 | 7 | if(ref($r) eq 'HASH') { | |||
| 379 | 5 | 9 | $allempty = 0 if defined $r->{geometry}{location}{lat}; | |||
| 380 | } elsif(ref($r) eq 'Geo::Location::Point') { | |||||
| 381 | 1 | 1 | $allempty = 0; | |||
| 382 | } | |||||
| 383 | } | |||||
| 384 | 6 | 9 | return if $allempty; | |||
| 385 | 4 | 8 | return @rc; | |||
| 386 | } | |||||
| 387 | ||||||
| 388 | # Also check if this location is cached as a definite not-found in L1, | |||||
| 389 | # without going through _cache() (which masks the sentinel as undef) | |||||
| 390 | 162 | 145 | if(exists $self->{'locations'}{$location}) { | |||
| 391 | 5 | 5 | my $stored = $self->{'locations'}{$location}; | |||
| 392 | 5 | 16 | if(ref($stored) && ref($stored) eq _NOT_FOUND_CLASS) { | |||
| 393 | 5 | 6 | print "No matches (cached)\n" if($self->{'debug'}); | |||
| 394 | 5 | 13 | return wantarray ? () : undef; | |||
| 395 | } | |||||
| 396 | } | |||||
| 397 | ||||||
| 398 | # ââ Try each geocoder in turn âââââââââââââââââââââââââââââââââââââââââ | |||||
| 399 | ||||||
| 400 | 157 157 | 82 125 | ENCODER: foreach my $g (@{$self->{geocoders}}) { | |||
| 401 | 164 | 100 | my $geocoder = $g; | |||
| 402 | ||||||
| 403 | # Unpack a hashref entry and apply regex / limit guards | |||||
| 404 | 164 | 141 | if(ref($geocoder) eq 'HASH') { | |||
| 405 | # Decrement and check the per-geocoder query limit | |||||
| 406 | 14 | 25 | if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) { | |||
| 407 | 10 | 11 | print "limit: $limit\n" if($self->{'debug'}); | |||
| 408 | 10 | 12 | if($limit <= 0) { | |||
| 409 | 6 | 9 | next; | |||
| 410 | } | |||||
| 411 | 4 | 3 | $geocoder->{'limit'}--; | |||
| 412 | } | |||||
| 413 | ||||||
| 414 | # Skip this entry if the location does not match its regex | |||||
| 415 | 8 | 11 | if(my $regex = $geocoder->{'regex'}) { | |||
| 416 | print 'consider ', ref($geocoder->{geocoder}), ": $regex\n" | |||||
| 417 | 4 | 5 | if($self->{'debug'}); | |||
| 418 | 4 | 17 | if($location !~ $regex) { | |||
| 419 | 3 | 4 | next; | |||
| 420 | } | |||||
| 421 | } | |||||
| 422 | ||||||
| 423 | # Unwrap the actual geocoder object from the hashref | |||||
| 424 | 5 | 5 | $geocoder = $g->{'geocoder'}; | |||
| 425 | } | |||||
| 426 | ||||||
| 427 | # Start timing before the network call | |||||
| 428 | 155 | 73 | my @rc; | |||
| 429 | 155 | 174 | my $timetaken = Time::HiRes::time(); | |||
| 430 | ||||||
| 431 | 155 | 76 | eval { | |||
| 432 | # Geo::GeoNames uses a positional argument, not a hash | |||||
| 433 | 155 | 144 | print 'trying ', ref($geocoder), "\n" if($self->{'debug'}); | |||
| 434 | 155 | 144 | if(ref($geocoder) eq 'Geo::GeoNames') { | |||
| 435 | print 'username => ', $geocoder->username(), "\n" | |||||
| 436 | 2 | 3 | if($self->{'debug'}); | |||
| 437 | 2 | 2 | die 'lost username' if(!defined($geocoder->username())); | |||
| 438 | 1 | 3 | @rc = $geocoder->geocode($location); | |||
| 439 | } else { | |||||
| 440 | 153 153 | 59 244 | @rc = $geocoder->geocode(%{$params}); | |||
| 441 | } | |||||
| 442 | }; | |||||
| 443 | ||||||
| 444 | 155 | 1154 | if($@) { | |||
| 445 | # Log the failure and move on; do not abort the whole chain | |||||
| 446 | 9 | 33 | my $log = { | |||
| 447 | line => $call_details[2], | |||||
| 448 | location => $location, | |||||
| 449 | geocoder => ref($geocoder), | |||||
| 450 | timetaken => Time::HiRes::time() - $timetaken, | |||||
| 451 | wantarray => wantarray, | |||||
| 452 | error => $@, | |||||
| 453 | }; | |||||
| 454 | 9 9 | 12 6 | CORE::push @{$self->{'log'}}, $log; | |||
| 455 | 9 | 22 | $self->_warn(ref($geocoder), " '$location': $@"); | |||
| 456 | 9 | 2081 | next ENCODER; | |||
| 457 | } | |||||
| 458 | ||||||
| 459 | 146 | 134 | $timetaken = Time::HiRes::time() - $timetaken; | |||
| 460 | ||||||
| 461 | # Geo::Coder::US::Census sometimes returns a truthy but empty result | |||||
| 462 | 146 | 155 | if((ref($geocoder) eq 'Geo::Coder::US::Census') && | |||
| 463 | !(defined($rc[0]->{result}{addressMatches}[0]->{coordinates}{y}))) { | |||||
| 464 | 2 | 5 | my $log = { | |||
| 465 | line => $call_details[2], | |||||
| 466 | location => $location, | |||||
| 467 | timetaken => $timetaken, | |||||
| 468 | geocoder => ref($geocoder), | |||||
| 469 | wantarray => wantarray, | |||||
| 470 | result => $RESULT_NONE, | |||||
| 471 | }; | |||||
| 472 | 2 2 | 1 9 | CORE::push @{$self->{'log'}}, $log; | |||
| 473 | 2 | 4 | next ENCODER; | |||
| 474 | } | |||||
| 475 | ||||||
| 476 | # Reject empty result sets and trivially empty hashes / arrays | |||||
| 477 | 144 | 202 | if((scalar(@rc) == 0) || | |||
| 478 | 110 | 225 | ((ref($rc[0]) eq 'HASH') && (scalar(keys %{$rc[0]}) == 0)) || | |||
| 479 | # UNREACHABLE: if $rc[0] is an ARRAY ref, $rc[0][0] may be undef, | |||||
| 480 | # which causes keys(%{undef}) to die under strict refs. No known | |||||
| 481 | # geocoder returns an ARRAY-of-ARRAYs with an empty-hash sub-element. | |||||
| 482 | # A safe rewrite would guard with: ref($rc[0][0]) eq 'HASH' first. | |||||
| 483 | # ((ref($rc[0]) eq 'ARRAY') && (scalar(keys %{$rc[0][0]}) == 0)) || | |||||
| 484 | 0) { | |||||
| 485 | 22 | 56 | my $log = { | |||
| 486 | line => $call_details[2], | |||||
| 487 | location => $location, | |||||
| 488 | timetaken => $timetaken, | |||||
| 489 | geocoder => ref($geocoder), | |||||
| 490 | wantarray => wantarray, | |||||
| 491 | result => $RESULT_NONE, | |||||
| 492 | }; | |||||
| 493 | 22 22 | 12 19 | CORE::push @{$self->{'log'}}, $log; | |||
| 494 | 22 | 26 | next ENCODER; | |||
| 495 | } | |||||
| 496 | ||||||
| 497 | # ââ Normalise each candidate result ââââââââââââââââââââââââââââââ | |||||
| 498 | ||||||
| 499 | # Track which element was successfully normalised so we return it, | |||||
| 500 | # not blindly return $rc[0] when a later element was the good one | |||||
| 501 | 122 | 68 | my $good_result; | |||
| 502 | ||||||
| 503 | 122 | 69 | POSSIBLE_LOCATION: foreach my $l (@rc) { | |||
| 504 | # Geo::GeoNames wraps each result in a one-element array | |||||
| 505 | 122 | 109 | if(ref($l) eq 'ARRAY') { | |||
| 506 | # FIXME: only the first element of the sub-array is considered | |||||
| 507 | 2 | 3 | $l = $l->[0]; | |||
| 508 | } | |||||
| 509 | ||||||
| 510 | # Skip undefined or empty-string candidates | |||||
| 511 | 122 | 188 | if((!defined($l)) || ($l eq '')) { | |||
| 512 | 5 | 12 | my $log = { | |||
| 513 | line => $call_details[2], | |||||
| 514 | location => $location, | |||||
| 515 | timetaken => $timetaken, | |||||
| 516 | geocoder => ref($geocoder), | |||||
| 517 | wantarray => wantarray, | |||||
| 518 | result => $RESULT_NONE, | |||||
| 519 | }; | |||||
| 520 | 5 5 | 2 6 | CORE::push @{$self->{'log'}}, $log; | |||
| 521 | 5 | 7 | next ENCODER; | |||
| 522 | } | |||||
| 523 | ||||||
| 524 | # Skip bare scalars (e.g. integer 0, plain strings) that are | |||||
| 525 | # not references; they cannot be hash-dereferenced below | |||||
| 526 | 117 | 96 | next unless ref($l); | |||
| 527 | ||||||
| 528 | # Stamp the source geocoder on the result before normalisation | |||||
| 529 | 114 | 102 | $l->{'geocoder'} = ref($geocoder); | |||
| 530 | ||||||
| 531 | print ref($geocoder), ': ', | |||||
| 532 | 114 | 103 | Data::Dumper->new([\$l])->Dump() if($self->{'debug'} >= 2); | |||
| 533 | ||||||
| 534 | # Geo::Location::Point objects carry their own accessors; | |||||
| 535 | # upgrade the geocoder field and populate the canonical geometry | |||||
| 536 | # structure so callers can rely on geometry.location.{lat,lng} | |||||
| 537 | 114 | 185 | if(ref($l) eq 'Geo::Location::Point') { | |||
| 538 | 4 | 5 | $l->{'geocoder'} = $geocoder; | |||
| 539 | ||||||
| 540 | # Populate canonical geometry structure from the GLP's own fields | |||||
| 541 | 4 | 8 | if(!defined($l->{geometry}{location}{lat}) && defined($l->{lat})) { | |||
| 542 | 3 | 5 | $l->{geometry}{location}{lat} = $l->{lat}; | |||
| 543 | 3 | 6 | $l->{geometry}{location}{lng} = $l->{lng} // $l->{lon}; | |||
| 544 | } | |||||
| 545 | ||||||
| 546 | # Convenience aliases (idempotent if already set by GLP) | |||||
| 547 | 4 | 7 | $l->{'lat'} //= $l->{geometry}{location}{lat}; | |||
| 548 | 4 | 5 | $l->{'lng'} //= $l->{geometry}{location}{lng}; | |||
| 549 | 4 | 8 | $l->{'lon'} //= $l->{geometry}{location}{lng}; | |||
| 550 | ||||||
| 551 | 4 4 | 2 15 | CORE::push @{$self->{'log'}}, { | |||
| 552 | line => $call_details[2], | |||||
| 553 | location => $location, | |||||
| 554 | timetaken => $timetaken, | |||||
| 555 | geocoder => ref($geocoder), | |||||
| 556 | wantarray => wantarray, | |||||
| 557 | result => $l, | |||||
| 558 | }; | |||||
| 559 | 4 | 3 | $good_result = $l; | |||
| 560 | 4 | 3 | last POSSIBLE_LOCATION; | |||
| 561 | } | |||||
| 562 | ||||||
| 563 | # Only HASH results need normalisation | |||||
| 564 | 110 | 83 | next if(ref($l) ne 'HASH'); | |||
| 565 | ||||||
| 566 | 110 | 87 | if($l->{'error'}) { | |||
| 567 | # A top-level 'error' key signals a provider-level failure | |||||
| 568 | my $log = { | |||||
| 569 | line => $call_details[2], | |||||
| 570 | location => $location, | |||||
| 571 | timetaken => $timetaken, | |||||
| 572 | geocoder => ref($geocoder), | |||||
| 573 | wantarray => wantarray, | |||||
| 574 | 1 | 4 | error => $l->{'error'}, | |||
| 575 | }; | |||||
| 576 | 1 1 | 0 2 | CORE::push @{$self->{'log'}}, $log; | |||
| 577 | 1 | 2 | next ENCODER; | |||
| 578 | } else { | |||||
| 579 | # Map provider-specific fields to the canonical geometry structure | |||||
| 580 | 109 | 136 | if(!defined($l->{geometry}{location}{lat})) { | |||
| 581 | 105 | 59 | my ($lat, $long); | |||
| 582 | ||||||
| 583 | 105 | 221 | if(defined($l->{lat}) && defined($l->{lon})) { | |||
| 584 | # OSM / RandMcNally: top-level lat/lon fields | |||||
| 585 | 79 | 46 | $lat = $l->{lat}; | |||
| 586 | 79 | 43 | $long = $l->{lon}; | |||
| 587 | 79 | 55 | $l->{'debug'} = __LINE__; | |||
| 588 | } elsif($l->{BestLocation}) { | |||||
| 589 | # Bing Maps: BestLocation.Coordinates.{Latitude,Longitude} | |||||
| 590 | 2 | 2 | $lat = $l->{BestLocation}->{Coordinates}->{Latitude}; | |||
| 591 | 2 | 2 | $long = $l->{BestLocation}->{Coordinates}->{Longitude}; | |||
| 592 | 2 | 2 | $l->{'debug'} = __LINE__; | |||
| 593 | } elsif($l->{point}) { | |||||
| 594 | # Bing Maps alternative: point.coordinates[lat, lng] | |||||
| 595 | 3 | 4 | $lat = $l->{point}->{coordinates}[0]; | |||
| 596 | 3 | 4 | $long = $l->{point}->{coordinates}[1]; | |||
| 597 | 3 | 5 | $l->{'debug'} = __LINE__; | |||
| 598 | } elsif(defined($l->{latt})) { | |||||
| 599 | # geocoder.ca: latt / longt fields | |||||
| 600 | 2 | 2 | $lat = $l->{latt}; | |||
| 601 | 2 | 1 | $long = $l->{longt}; | |||
| 602 | 2 | 2 | $l->{'debug'} = __LINE__; | |||
| 603 | } elsif(defined($l->{latitude})) { | |||||
| 604 | # postcodes.io, Geo::Coder::Free: latitude / longitude | |||||
| 605 | 3 | 3 | $lat = $l->{latitude}; | |||
| 606 | 3 | 3 | $long = $l->{longitude}; | |||
| 607 | 3 | 6 | if(my $type = $l->{'local_type'}) { | |||
| 608 | # Carry the local_type hint forward as a normalised 'type' | |||||
| 609 | 1 | 2 | $l->{'type'} = lcfirst($type); | |||
| 610 | } | |||||
| 611 | 3 | 3 | $l->{'debug'} = __LINE__; | |||
| 612 | } elsif(defined($l->{'properties'}{'geoLatitude'})) { | |||||
| 613 | # HERE / Ovi: properties.geoLatitude / geoLongitude | |||||
| 614 | 1 | 1 | $lat = $l->{properties}{geoLatitude}; | |||
| 615 | 1 | 1 | $long = $l->{properties}{geoLongitude}; | |||
| 616 | 1 | 1 | $l->{'debug'} = __LINE__; | |||
| 617 | } elsif($l->{'results'}[0]->{'geometry'}) { | |||||
| 618 | 3 | 6 | if($l->{'results'}[0]->{'geometry'}->{'location'}) { | |||
| 619 | # DataScienceToolkit mirrors the Google Maps shape | |||||
| 620 | 1 | 1 | $lat = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'}; | |||
| 621 | 1 | 1 | $long = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'}; | |||
| 622 | 1 | 2 | $l->{'debug'} = __LINE__; | |||
| 623 | } else { | |||||
| 624 | # OpenCage places lat/lng directly under geometry | |||||
| 625 | 2 | 2 | $lat = $l->{'results'}[0]->{'geometry'}->{'lat'}; | |||
| 626 | 2 | 3 | $long = $l->{'results'}[0]->{'geometry'}->{'lng'}; | |||
| 627 | 2 | 2 | $l->{'debug'} = __LINE__; | |||
| 628 | } | |||||
| 629 | } elsif($l->{'RESULTS'}) { | |||||
| 630 | # GeoCodeFarm: RESULTS[0].COORDINATES.{latitude,longitude} | |||||
| 631 | 2 | 4 | $lat = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'}; | |||
| 632 | 2 | 2 | $long = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'}; | |||
| 633 | 2 | 2 | $l->{'debug'} = __LINE__; | |||
| 634 | } elsif(defined($l->{result}{addressMatches}[0]->{coordinates}{y})) { | |||||
| 635 | # US Census Bureau: result.addressMatches[0].coordinates.{y,x} | |||||
| 636 | 1 | 1 | $lat = $l->{result}{addressMatches}[0]->{coordinates}{y}; | |||
| 637 | 1 | 2 | $long = $l->{result}{addressMatches}[0]->{coordinates}{x}; | |||
| 638 | 1 | 1 | $l->{'debug'} = __LINE__; | |||
| 639 | } elsif(defined($l->{lat})) { | |||||
| 640 | # Geo::GeoNames: lat / lng (reached only after lat+lon check fails) | |||||
| 641 | 3 | 22 | $lat = $l->{lat}; | |||
| 642 | 3 | 4 | $long = $l->{lng}; | |||
| 643 | 3 | 3 | $l->{'debug'} = __LINE__; | |||
| 644 | } elsif($l->{features}) { | |||||
| 645 | 4 | 6 | if($l->{features}[0]->{center}) { | |||
| 646 | # Geo::Coder::Mapbox: center is [lng, lat] | |||||
| 647 | 1 | 1 | $lat = $l->{features}[0]->{center}[1]; | |||
| 648 | 1 | 1 | $long = $l->{features}[0]->{center}[0]; | |||
| 649 | 1 | 1 | $l->{'debug'} = __LINE__; | |||
| 650 | } elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) { | |||||
| 651 | # Geo::Coder::GeoApify: coordinates is [lng, lat] | |||||
| 652 | 1 | 2 | $lat = $l->{'features'}[0]{'geometry'}{'coordinates'}[1]; | |||
| 653 | 1 | 1 | $long = $l->{'features'}[0]{'geometry'}{'coordinates'}[0]; | |||
| 654 | 1 | 1 | $l->{'debug'} = __LINE__; | |||
| 655 | } else { | |||||
| 656 | # GeoApify signals not-found via empty features, not an error | |||||
| 657 | 2 | 6 | next ENCODER; | |||
| 658 | } | |||||
| 659 | } else { | |||||
| 660 | 2 | 2 | $l->{'debug'} = __LINE__; | |||
| 661 | } | |||||
| 662 | ||||||
| 663 | 103 | 134 | if(defined($lat) && defined($long)) { | |||
| 664 | # Populate the canonical geometry structure | |||||
| 665 | 101 | 79 | $l->{geometry}{location}{lat} = $lat; | |||
| 666 | 101 | 78 | $l->{geometry}{location}{lng} = $long; | |||
| 667 | # Compatibility aliases expected by callers | |||||
| 668 | 101 | 59 | $l->{'lat'} = $lat; | |||
| 669 | 101 | 55 | $l->{'lon'} = $long; | |||
| 670 | } else { | |||||
| 671 | # No coordinates extracted; clean up any partial data | |||||
| 672 | 2 | 1 | delete $l->{'geometry'}; | |||
| 673 | 2 | 2 | delete $l->{'lat'}; | |||
| 674 | 2 | 2 | delete $l->{'lon'}; | |||
| 675 | } | |||||
| 676 | ||||||
| 677 | # geocoder.xyz provides a country name under 'standard' | |||||
| 678 | 103 | 128 | if($l->{'standard'}{'countryname'}) { | |||
| 679 | 1 | 1 | $l->{'address'}{'country'} = $l->{'standard'}{'countryname'}; | |||
| 680 | } | |||||
| 681 | } | |||||
| 682 | ||||||
| 683 | 107 | 96 | if(defined($l->{geometry}{location}{lat})) { | |||
| 684 | print $l->{geometry}{location}{lat}, '/', | |||||
| 685 | $l->{geometry}{location}{lng}, "\n" | |||||
| 686 | 105 | 87 | if($self->{'debug'}); | |||
| 687 | ||||||
| 688 | # Store the geocoder object (not just its name) on the result | |||||
| 689 | 105 | 71 | $l->{geocoder} = $geocoder; | |||
| 690 | 105 | 91 | $l->{'lat'} //= $l->{geometry}{location}{lat}; | |||
| 691 | 105 | 170 | $l->{'lng'} //= $l->{geometry}{location}{lng}; | |||
| 692 | 105 | 78 | $l->{'lon'} //= $l->{geometry}{location}{lng}; | |||
| 693 | ||||||
| 694 | 105 | 220 | my $log = { | |||
| 695 | line => $call_details[2], | |||||
| 696 | location => $location, | |||||
| 697 | timetaken => $timetaken, | |||||
| 698 | geocoder => ref($geocoder), | |||||
| 699 | wantarray => wantarray, | |||||
| 700 | result => $l, | |||||
| 701 | }; | |||||
| 702 | 105 105 | 50 66 | CORE::push @{$self->{'log'}}, $log; | |||
| 703 | ||||||
| 704 | # Record which element succeeded, then exit the inner loop | |||||
| 705 | 105 | 50 | $good_result = $l; | |||
| 706 | 105 | 82 | last POSSIBLE_LOCATION; | |||
| 707 | } | |||||
| 708 | } | |||||
| 709 | } | |||||
| 710 | ||||||
| 711 | # Only attempt to return / cache if normalisation actually succeeded | |||||
| 712 | 114 | 104 | next ENCODER unless defined $good_result; | |||
| 713 | ||||||
| 714 | print 'Number of matches from ', ref($geocoder), ': ', | |||||
| 715 | 109 | 91 | scalar(@rc), "\n" if($self->{'debug'}); | |||
| 716 | ||||||
| 717 | 109 | 85 | if($self->{'debug'} >= 2) { | |||
| 718 | # Use 'local' to avoid permanently altering the global Maxdepth | |||||
| 719 | 2 | 3 | local $Data::Dumper::Maxdepth = 10; | |||
| 720 | 2 | 3 | print Data::Dumper->new([\@rc])->Dump(); | |||
| 721 | } | |||||
| 722 | ||||||
| 723 | # NOTE (latent unreachable path): if a geocoder returned a list whose | |||||
| 724 | # first element is undef (e.g. (undef, {lat=>1,lon=>2})), $good_result | |||||
| 725 | # would be set from a later element but defined($rc[0]) is false, so | |||||
| 726 | # the block below is skipped and the valid result is silently discarded. | |||||
| 727 | # No known geocoder produces a leading undef, making this scenario | |||||
| 728 | # unreachable in practice. A safer guard would be defined($good_result). | |||||
| 729 | 109 | 161 | if(defined($rc[0])) { | |||
| 730 | # Normalise the legacy 'long' key some geocoders emit | |||||
| 731 | 109 | 109 | if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) { | |||
| 732 | 1 | 1 | $rc[0]->{'lng'} = $rc[0]->{'long'}; | |||
| 733 | } | |||||
| 734 | 109 | 89 | if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lon'})) { | |||
| 735 | 1 | 7 | $rc[0]->{'lon'} = $rc[0]->{'long'}; | |||
| 736 | } | |||||
| 737 | ||||||
| 738 | # Sanity check: the good result must have lat and lng | |||||
| 739 | 109 | 139 | if((!defined($good_result->{lat})) || (!defined($good_result->{lng}))) { | |||
| 740 | 1 | 5 | $self->_warn(Data::Dumper->new([\@rc])->Dump()); | |||
| 741 | 1 | 385 | $self->_error("BUG: '$location': HASH exists but is not sensible"); | |||
| 742 | } | |||||
| 743 | ||||||
| 744 | 108 | 78 | if(wantarray) { | |||
| 745 | 4 | 8 | $self->_cache($location, \@rc); | |||
| 746 | 4 | 9 | return @rc; | |||
| 747 | } | |||||
| 748 | ||||||
| 749 | 104 | 95 | $self->_cache($location, $good_result); | |||
| 750 | 104 | 189 | return $good_result; | |||
| 751 | } | |||||
| 752 | } | |||||
| 753 | ||||||
| 754 | # ââ No geocoder produced a usable result ââââââââââââââââââââââââââââââ | |||||
| 755 | ||||||
| 756 | 48 | 54 | print "No matches\n" if($self->{'debug'}); | |||
| 757 | ||||||
| 758 | # Cache the not-found result so repeated calls do not hammer all backends | |||||
| 759 | 48 | 49 | $self->_cache($location, undef); | |||
| 760 | ||||||
| 761 | 48 | 103 | return wantarray ? () : undef; | |||
| 762 | } | |||||
| 763 | ||||||
| 764 | # ============================================================================= | |||||
| 765 | ||||||
| 766 - 797 | =head2 ua
Sets the L<LWP::UserAgent> (or compatible) object on every geocoder in the
chain. Useful when you need proxy support or custom timeouts across all
backends at once.
There is intentionally no read accessor since that would be meaningless
(each geocoder could have a different UA).
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
$ua->env_proxy(1);
$list->ua($ua);
=head3 API SPECIFICATION
=head4 INPUT
# Params::Validate::Strict schema
{
ua => {
type => OBJECT,
optional => 1,
},
}
=head4 OUTPUT
# Return::Set schema
OBJECT # the same $ua that was passed in
=cut | |||||
| 798 | ||||||
| 799 | sub ua | |||||
| 800 | { | |||||
| 801 | 31 | 1428 | my ($self, $ua) = @_; | |||
| 802 | ||||||
| 803 | # Nothing to propagate if no UA was supplied | |||||
| 804 | 31 | 55 | return unless $ua; | |||
| 805 | ||||||
| 806 | # Push the UA into every geocoder in the chain | |||||
| 807 | 27 27 | 10 30 | foreach my $g (@{$self->{geocoders}}) { | |||
| 808 | 30 | 41 | my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g; | |||
| 809 | # Guard against a misconfigured entry that has no geocoder object | |||||
| 810 | 30 | 64 | Carp::croak('No geocoder found') unless defined $geocoder; | |||
| 811 | ||||||
| 812 | # When the incoming UA supports clone(), create a per-geocoder copy | |||||
| 813 | # and set the geocoder's own agent string on that copy. | |||||
| 814 | # Some APIs (e.g. OSM Nominatim) require a specific User-Agent and | |||||
| 815 | # refuse requests that carry the generic libwww-perl default. | |||||
| 816 | # The agent string is derived from the geocoder class name and version | |||||
| 817 | # (e.g. 'Geo::Coder::OSM/0.03') without reading the geocoder's current | |||||
| 818 | # UA, which would trigger any spy or hook installed on its ua() method. | |||||
| 819 | 27 | 620 | if($ua->can('clone') && $ua->can('agent')) { | |||
| 820 | 13 | 13 | my $per_ua = $ua->clone(); | |||
| 821 | 13 | 37 | my $class = ref($geocoder); | |||
| 822 | 13 13 | 7 48 | my $version = eval { $geocoder->VERSION() } // ''; | |||
| 823 | 13 | 37 | $per_ua->agent($version ? "$class/$version" : $class); | |||
| 824 | 13 | 38 | $geocoder->ua($per_ua); | |||
| 825 | } else { | |||||
| 826 | 14 | 14 | $geocoder->ua($ua); | |||
| 827 | } | |||||
| 828 | } | |||||
| 829 | ||||||
| 830 | # Return the UA so callers can verify what was set (API contract) | |||||
| 831 | 24 | 51 | return $ua; | |||
| 832 | } | |||||
| 833 | ||||||
| 834 | # ============================================================================= | |||||
| 835 | ||||||
| 836 - 871 | =head2 reverse_geocode
Converts a latitude/longitude pair into a human-readable address string.
In scalar context returns a single address string (or C<undef>).
In list context returns all address strings from the winning geocoder.
my $address = $list->reverse_geocode(latlng => '51.5074,-0.1278');
print "Address: $address\n" if $address;
my @addresses = $list->reverse_geocode(latlng => '51.5074,-0.1278');
=head3 API SPECIFICATION
=head4 INPUT
# Params::Validate::Strict schema
{
latlng => {
type => SCALAR,
required => 1,
regex => qr/^\s*[-+]?(?:\d*\.?\d+|\d+\.?\d*)
\s*,\s*
[-+]?(?:\d*\.?\d+|\d+\.?\d*)\s*$/x,
},
}
=head4 OUTPUT
# Return::Set schema (scalar context)
SCALAR (address string) | undef
# Return::Set schema (list context)
ARRAY of SCALAR
=cut | |||||
| 872 | ||||||
| 873 | sub reverse_geocode { | |||||
| 874 | 62 | 3115 | my $self = shift; | |||
| 875 | 62 | 69 | my $params = Params::Get::get_params('latlng', \@_); | |||
| 876 | ||||||
| 877 | 60 | 483 | my $latlng = $params->{'latlng'} or Carp::croak('Usage: reverse_geocode(latlng => $location)'); | |||
| 878 | ||||||
| 879 | # Split into components; populate convenience keys for geocoders that want them | |||||
| 880 | 58 | 76 | my ($latitude, $longitude) = split(/,/, $latlng); | |||
| 881 | 58 | 116 | $params->{'lat'} //= $latitude; | |||
| 882 | 58 | 81 | $params->{'lon'} //= $longitude; | |||
| 883 | ||||||
| 884 | # Check L1 / L2 cache before hitting any backend | |||||
| 885 | 58 | 59 | if(my $rc = $self->_cache($latlng)) { | |||
| 886 | 5 | 9 | return $rc; | |||
| 887 | } | |||||
| 888 | ||||||
| 889 | 53 | 50 | my @call_details = caller(0); | |||
| 890 | ||||||
| 891 | 53 53 | 358 46 | foreach my $g (@{$self->{geocoders}}) { | |||
| 892 | 54 | 32 | my $geocoder = $g; | |||
| 893 | ||||||
| 894 | # Apply the per-geocoder limit guard for hashref entries | |||||
| 895 | 54 | 54 | if(ref($geocoder) eq 'HASH') { | |||
| 896 | 5 | 9 | if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) { | |||
| 897 | 4 | 5 | print "limit: $limit\n" if($self->{'debug'}); | |||
| 898 | 4 | 5 | if($limit <= 0) { | |||
| 899 | 3 | 3 | next; | |||
| 900 | } | |||||
| 901 | 1 | 1 | $geocoder->{'limit'}--; | |||
| 902 | } | |||||
| 903 | 2 | 2 | $geocoder = $g->{'geocoder'}; | |||
| 904 | } | |||||
| 905 | ||||||
| 906 | 51 | 49 | print 'trying ', ref($geocoder), "\n" if($self->{'debug'}); | |||
| 907 | ||||||
| 908 | 51 | 44 | if(wantarray) { | |||
| 909 | # ââ List context: collect all address strings from this geocoder âââ | |||||
| 910 | 17 | 13 | my @rc; | |||
| 911 | my @locs; | |||||
| 912 | 17 17 17 | 7 13 33 | eval { @locs = $geocoder->reverse_geocode(%{$params}) }; | |||
| 913 | ||||||
| 914 | # Some geocoders (e.g. Geo::Coder::GeoApify) use strict parameter | |||||
| 915 | # validation and reject the 'latlng' key as unknown. Retry without | |||||
| 916 | # it -- lat and lon are already in %params from the split above. | |||||
| 917 | # Other geocoders (e.g. Geo::Coder::CA) require 'latlng', so the | |||||
| 918 | # first attempt must include it. | |||||
| 919 | 17 | 81 | if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) { | |||
| 920 | 2 2 | 2 4 | my %no_latlng = %{$params}; | |||
| 921 | 2 | 2 | delete $no_latlng{'latlng'}; | |||
| 922 | 2 | 2 | $@ = ''; | |||
| 923 | 2 2 | 1 3 | eval { @locs = $geocoder->reverse_geocode(%no_latlng) }; | |||
| 924 | } | |||||
| 925 | ||||||
| 926 | 17 | 23 | if($@) { | |||
| 927 | 3 3 | 2 26 | CORE::push @{$self->{'log'}}, { | |||
| 928 | line => $call_details[2], | |||||
| 929 | location => $latlng, | |||||
| 930 | geocoder => ref($geocoder), | |||||
| 931 | timetaken => 0, | |||||
| 932 | wantarray => 1, | |||||
| 933 | error => $@, | |||||
| 934 | }; | |||||
| 935 | 3 | 7 | $self->_warn(ref($geocoder), " '$latlng': $@"); | |||
| 936 | 3 | 586 | next; | |||
| 937 | } | |||||
| 938 | ||||||
| 939 | 14 | 17 | print Data::Dumper->new([\@locs])->Dump() if($self->{'debug'} >= 2); | |||
| 940 | ||||||
| 941 | 14 | 15 | foreach my $loc (@locs) { | |||
| 942 | 19 | 26 | if(my $name = $loc->{'display_name'}) { | |||
| 943 | # OSM returns the full address in display_name | |||||
| 944 | 15 | 15 | CORE::push @rc, $name; | |||
| 945 | } elsif($loc->{'city'}) { | |||||
| 946 | # Geo::Coder::CA: build the address from individual fields | |||||
| 947 | 2 | 4 | CORE::push @rc, _build_ca_address($loc); | |||
| 948 | } elsif($loc->{features}) { | |||||
| 949 | # GeoApify: formatted string inside a features array | |||||
| 950 | CORE::push @rc, | |||||
| 951 | 2 | 2 | $loc->{features}[0]->{properties}{formatted}; | |||
| 952 | 2 | 3 | last; # only one result from this provider | |||
| 953 | } | |||||
| 954 | } | |||||
| 955 | ||||||
| 956 | 14 14 | 5 43 | CORE::push @{$self->{'log'}}, { | |||
| 957 | line => $call_details[2], | |||||
| 958 | location => $latlng, | |||||
| 959 | geocoder => ref($geocoder), | |||||
| 960 | timetaken => 0, | |||||
| 961 | wantarray => 1, | |||||
| 962 | result => \@rc, | |||||
| 963 | }; | |||||
| 964 | ||||||
| 965 | 14 | 18 | $self->_cache($latlng, \@rc); | |||
| 966 | 14 | 42 | return @rc; | |||
| 967 | ||||||
| 968 | } else { | |||||
| 969 | # ââ Scalar context: return the first address string ââââââââââââââââ | |||||
| 970 | my $rc = $self->_cache($latlng) | |||||
| 971 | 34 34 34 | 32 21 44 | // eval { $geocoder->reverse_geocode(%{$params}) }; | |||
| 972 | ||||||
| 973 | # Same strict-validation fallback as the list-context path above | |||||
| 974 | 34 | 192 | if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) { | |||
| 975 | 7 7 | 6 11 | my %no_latlng = %{$params}; | |||
| 976 | 7 | 8 | delete $no_latlng{'latlng'}; | |||
| 977 | 7 | 8 | $@ = ''; | |||
| 978 | 7 7 | 4 11 | $rc = eval { $geocoder->reverse_geocode(%no_latlng) }; | |||
| 979 | } | |||||
| 980 | ||||||
| 981 | 34 | 60 | if($@) { | |||
| 982 | 7 7 | 6 27 | CORE::push @{$self->{'log'}}, { | |||
| 983 | line => $call_details[2], | |||||
| 984 | location => $latlng, | |||||
| 985 | geocoder => ref($geocoder), | |||||
| 986 | timetaken => 0, | |||||
| 987 | wantarray => 0, | |||||
| 988 | error => $@, | |||||
| 989 | }; | |||||
| 990 | 7 | 17 | $self->_warn(ref($geocoder), " '$latlng': $@"); | |||
| 991 | 7 | 1564 | next; | |||
| 992 | } | |||||
| 993 | ||||||
| 994 | # A bare string needs no further processing | |||||
| 995 | 27 | 29 | next unless defined $rc; | |||
| 996 | 26 | 22 | if(!ref($rc)) { | |||
| 997 | 3 3 | 2 11 | CORE::push @{$self->{'log'}}, { | |||
| 998 | line => $call_details[2], | |||||
| 999 | location => $latlng, | |||||
| 1000 | geocoder => ref($geocoder), | |||||
| 1001 | timetaken => 0, | |||||
| 1002 | wantarray => 0, | |||||
| 1003 | result => $rc, | |||||
| 1004 | }; | |||||
| 1005 | 3 | 7 | return $rc; | |||
| 1006 | } | |||||
| 1007 | ||||||
| 1008 | 23 | 30 | print Data::Dumper->new([$rc])->Dump() if($self->{'debug'} >= 2); | |||
| 1009 | ||||||
| 1010 | 23 | 47 | if(my $name = $rc->{'display_name'}) { | |||
| 1011 | # OSM | |||||
| 1012 | 18 18 | 13 51 | CORE::push @{$self->{'log'}}, { | |||
| 1013 | line => $call_details[2], | |||||
| 1014 | location => $latlng, | |||||
| 1015 | geocoder => ref($geocoder), | |||||
| 1016 | timetaken => 0, | |||||
| 1017 | wantarray => 0, | |||||
| 1018 | result => $name, | |||||
| 1019 | }; | |||||
| 1020 | 18 | 16 | return $self->_cache($latlng, $name); | |||
| 1021 | } | |||||
| 1022 | ||||||
| 1023 | 5 | 6 | if($rc->{'city'}) { | |||
| 1024 | # Geo::Coder::CA | |||||
| 1025 | 3 | 7 | my $name = _build_ca_address($rc); | |||
| 1026 | 3 3 | 2 9 | CORE::push @{$self->{'log'}}, { | |||
| 1027 | line => $call_details[2], | |||||
| 1028 | location => $latlng, | |||||
| 1029 | geocoder => ref($geocoder), | |||||
| 1030 | timetaken => 0, | |||||
| 1031 | wantarray => 0, | |||||
| 1032 | result => $name, | |||||
| 1033 | }; | |||||
| 1034 | 3 | 4 | return $self->_cache($latlng, $name); | |||
| 1035 | } | |||||
| 1036 | ||||||
| 1037 | 2 | 5 | if($rc->{features}) { | |||
| 1038 | # GeoApify | |||||
| 1039 | 2 | 2 | my $name = $rc->{features}[0]->{properties}{formatted}; | |||
| 1040 | 2 2 | 3 6 | CORE::push @{$self->{'log'}}, { | |||
| 1041 | line => $call_details[2], | |||||
| 1042 | location => $latlng, | |||||
| 1043 | geocoder => ref($geocoder), | |||||
| 1044 | timetaken => 0, | |||||
| 1045 | wantarray => 0, | |||||
| 1046 | result => $name, | |||||
| 1047 | }; | |||||
| 1048 | 2 | 3 | return $self->_cache($latlng, $name); | |||
| 1049 | } | |||||
| 1050 | } | |||||
| 1051 | } | |||||
| 1052 | ||||||
| 1053 | 13 | 28 | return; | |||
| 1054 | } | |||||
| 1055 | ||||||
| 1056 | # ============================================================================= | |||||
| 1057 | ||||||
| 1058 - 1094 | =head2 log
Returns an arrayref of log entries accumulated since the last C<flush()>.
Each entry is a hashref with the keys: C<line>, C<location>, C<timetaken>,
C<geocoder>, C<wantarray>, and either C<result> or C<error>.
foreach my $entry (@{ $list->log() }) {
printf "%s: %.3fs via %s\n",
$entry->{location},
$entry->{timetaken},
$entry->{geocoder};
}
=head3 API SPECIFICATION
=head4 INPUT
# No parameters accepted
=head4 OUTPUT
# Return::Set schema
ARRAYREF of HASHREF
[
{
line => Int,
location => Str,
timetaken => Num,
geocoder => Str | 'cache',
wantarray => Bool,
result => HASHREF | ARRAYREF | Str, # on success
error => Str, # on failure
},
...
]
=cut | |||||
| 1095 | ||||||
| 1096 | sub log { | |||||
| 1097 | 37 | 2748 | my $self = shift; | |||
| 1098 | ||||||
| 1099 | # Guard against the state left by flush(); always return a valid arrayref | |||||
| 1100 | 37 | 75 | return $self->{'log'} // []; | |||
| 1101 | } | |||||
| 1102 | ||||||
| 1103 | # ============================================================================= | |||||
| 1104 | ||||||
| 1105 - 1124 | =head2 flush
Clears all accumulated log entries and returns C<$self> to allow chaining.
$list->geocode('Paris, France');
my $entries = $list->log();
$list->flush()->geocode('London, UK'); # chained
=head3 API SPECIFICATION
=head4 INPUT
# No parameters accepted
=head4 OUTPUT
# Return::Set schema
OBJECT blessed into Geo::Coder::List # $self, for chaining
=cut | |||||
| 1125 | ||||||
| 1126 | sub flush { | |||||
| 1127 | 15 | 74 | my $self = shift; | |||
| 1128 | ||||||
| 1129 | # Reset to an empty arrayref so log() always returns a valid reference | |||||
| 1130 | 15 | 18 | $self->{'log'} = []; | |||
| 1131 | ||||||
| 1132 | 15 | 12 | return $self; | |||
| 1133 | } | |||||
| 1134 | ||||||
| 1135 | # ============================================================================= | |||||
| 1136 | # PRIVATE HELPERS | |||||
| 1137 | # ============================================================================= | |||||
| 1138 | ||||||
| 1139 | # _build_ca_address | |||||
| 1140 | # | |||||
| 1141 | # Purpose: Assemble a printable address string from a Geo::Coder::CA | |||||
| 1142 | # reverse-geocode response. The CA response uses different keys | |||||
| 1143 | # for US addresses (nested under 'usa') vs Canadian ones. | |||||
| 1144 | # | |||||
| 1145 | # Entry: $loc - HASHREF from Geo::Coder::CA reverse_geocode() | |||||
| 1146 | # | |||||
| 1147 | # Exit: Returns a plain string, or empty string if nothing was found. | |||||
| 1148 | # | |||||
| 1149 | # Notes: Street number and name are joined with a space; other parts | |||||
| 1150 | # (city, province/state, country) are joined with ', '. | |||||
| 1151 | ||||||
| 1152 | sub _build_ca_address | |||||
| 1153 | { | |||||
| 1154 | 16 | 17173 | my $loc = $_[0]; | |||
| 1155 | 16 | 10 | my $name = ''; | |||
| 1156 | ||||||
| 1157 | 16 | 22 | if(my $usa = $loc->{'usa'}) { | |||
| 1158 | # US address layout inside a CA result | |||||
| 1159 | 5 | 11 | $name = $usa->{'usstnumber'} // ''; | |||
| 1160 | # Street name follows number with a space; if no number, no leading space | |||||
| 1161 | 5 | 11 | $name .= ($name ? ' ' : '') . $usa->{'usstaddress'} if $usa->{'usstaddress'}; | |||
| 1162 | # City, state, country each separated by ', '; skip separator if name empty | |||||
| 1163 | 5 | 11 | $name .= ($name ? ', ' : '') . $usa->{'uscity'} if $usa->{'uscity'}; | |||
| 1164 | 5 | 8 | $name .= ($name ? ', ' : '') . $usa->{'state'} if $usa->{'state'}; | |||
| 1165 | # Country is always appended for the US branch | |||||
| 1166 | 5 | 5 | $name .= ($name ? ', ' : '') . 'USA'; | |||
| 1167 | } else { | |||||
| 1168 | # Canadian address layout | |||||
| 1169 | 11 | 16 | $name = $loc->{'stnumber'} // ''; | |||
| 1170 | # Street name follows number with a space; if no number, no leading space | |||||
| 1171 | 11 | 525 | $name .= ($name ? ' ' : '') . $loc->{'staddress'} if $loc->{'staddress'}; | |||
| 1172 | 11 | 18 | $name .= ($name ? ', ' : '') . $loc->{'city'} if $loc->{'city'}; | |||
| 1173 | 11 | 20 | $name .= ($name ? ', ' : '') . $loc->{'prov'} if $loc->{'prov'}; | |||
| 1174 | } | |||||
| 1175 | ||||||
| 1176 | 16 | 19 | return $name; | |||
| 1177 | } | |||||
| 1178 | ||||||
| 1179 | # ----------------------------------------------------------------------------- | |||||
| 1180 | ||||||
| 1181 | # _cache | |||||
| 1182 | # | |||||
| 1183 | # Read from or write to the two-level cache. | |||||
| 1184 | # L1 is an in-process HASH (always active). | |||||
| 1185 | # L2 is an optional CHI-compatible object or a plain HASH ref. | |||||
| 1186 | # | |||||
| 1187 | # Entry (write): _cache($key, $value) | |||||
| 1188 | # $value may be undef, which is stored as $NOT_FOUND_SENTINEL so | |||||
| 1189 | # subsequent reads can distinguish "cached not-found" from "never | |||||
| 1190 | # looked up". Detect the write path by testing scalar(@_) before | |||||
| 1191 | # shifting, not by truthiness of the value. | |||||
| 1192 | # | |||||
| 1193 | # Entry (read): _cache($key) | |||||
| 1194 | # | |||||
| 1195 | # Exit (write): Returns $value (undef if the location was not found). | |||||
| 1196 | # Exit (read): Returns the cached value, or undef if not in cache. | |||||
| 1197 | # $NOT_FOUND_SENTINEL is never surfaced to callers; undef is | |||||
| 1198 | # returned in its place so callers handle both cases identically. | |||||
| 1199 | # | |||||
| 1200 | # Side effects: May update $self->{locations} (L1) and $self->{'cache'} (L2). | |||||
| 1201 | # | |||||
| 1202 | # Notes: Cache TTLs are taken from $self->{cache_*_duration}, which are | |||||
| 1203 | # initialised from %config and overridable via Object::Configure. | |||||
| 1204 | # Not-found sentinels are stored only in L1 to avoid leaking | |||||
| 1205 | # internal implementation details into an external L2 store. | |||||
| 1206 | ||||||
| 1207 | sub _cache { | |||||
| 1208 | 510 | 898 | my $self = shift; | |||
| 1209 | 510 | 249 | my $key = shift; | |||
| 1210 | ||||||
| 1211 | # ââ Write path ââââââââââââââââââââââââââââââââââââââââââââââââââââââââ | |||||
| 1212 | # Detect a write call by the presence of a third argument (even if undef). | |||||
| 1213 | # Testing truthiness of the value would silently swallow not-found results. | |||||
| 1214 | ||||||
| 1215 | 510 | 393 | if(scalar(@_)) { | |||
| 1216 | 218 | 91 | my $value = shift; | |||
| 1217 | ||||||
| 1218 | # Store a sentinel for not-found so we can skip backends on repeat calls | |||||
| 1219 | 218 | 148 | my $stored = defined($value) ? $value : $NOT_FOUND_SENTINEL; | |||
| 1220 | 218 | 263 | $self->{locations}->{$key} = $stored; | |||
| 1221 | ||||||
| 1222 | 218 | 96 | my $rc = $value; | |||
| 1223 | ||||||
| 1224 | 218 | 167 | if($self->{'cache'}) { | |||
| 1225 | 24 | 12 | my $duration; | |||
| 1226 | ||||||
| 1227 | 24 | 39 | if(ref($value) eq 'ARRAY') { | |||
| 1228 | 8 8 | 2 6 | foreach my $item (@{$value}) { | |||
| 1229 | # Blessed objects (e.g. Geo::Location::Point) may hold | |||||
| 1230 | # unserializable handles; stringify their geocoder field too | |||||
| 1231 | 8 | 15 | if(blessed($item) && ref($item->{'geocoder'})) { | |||
| 1232 | 2 | 3 | $item->{'geocoder'} = ref($item->{'geocoder'}); | |||
| 1233 | } | |||||
| 1234 | ||||||
| 1235 | 8 | 28 | next unless ref($item) eq 'HASH'; | |||
| 1236 | ||||||
| 1237 | # Serialise the geocoder object to its class name for storage | |||||
| 1238 | 6 | 6 | $item->{'geocoder'} = ref($item->{'geocoder'}); | |||
| 1239 | ||||||
| 1240 | # Strip everything except geometry to keep the L2 entry small | |||||
| 1241 | 6 | 6 | unless($self->{'debug'}) { | |||
| 1242 | 5 15 | 18 18 | while(my ($k, $v) = each %{$item}) { | |||
| 1243 | 10 | 12 | delete $item->{$k} unless($k eq 'geometry'); | |||
| 1244 | } | |||||
| 1245 | } | |||||
| 1246 | ||||||
| 1247 | 6 | 7 | unless(defined($item->{geometry}{location}{lat})) { | |||
| 1248 | # Partial or temporary failure: use the shorter TTL. | |||||
| 1249 | # UNREACHABLE ARM: the access above auto-vivifies | |||||
| 1250 | # $item->{geometry} as {}, so defined($item->{geometry}) | |||||
| 1251 | # is always true here; the false arm never executes. | |||||
| 1252 | # Original ternary preserved for documentation: | |||||
| 1253 | # $duration //= defined($item->{geometry}) | |||||
| 1254 | # ? $self->{'cache_part_duration'} | |||||
| 1255 | # : $self->{'cache_miss_duration'}; | |||||
| 1256 | 4 | 6 | $duration //= $self->{'cache_part_duration'}; | |||
| 1257 | 4 | 5 | $rc = undef; | |||
| 1258 | } | |||||
| 1259 | } | |||||
| 1260 | ||||||
| 1261 | # All items were clean: use the full hit duration | |||||
| 1262 | 8 | 12 | $duration //= $self->{'cache_hit_duration'}; | |||
| 1263 | ||||||
| 1264 | } elsif(ref($value) eq 'HASH') { | |||||
| 1265 | 13 | 522 | $value->{'geocoder'} = ref($value->{'geocoder'}); | |||
| 1266 | ||||||
| 1267 | 13 | 18 | unless($self->{'debug'}) { | |||
| 1268 | 12 52 | 26 53 | while(my ($k, $v) = each %{$value}) { | |||
| 1269 | 40 | 43 | delete $value->{$k} unless($k eq 'geometry'); | |||
| 1270 | } | |||||
| 1271 | } | |||||
| 1272 | ||||||
| 1273 | 13 | 22 | if(defined($value->{geometry}{location}{lat})) { | |||
| 1274 | # Confirmed location: cache for a full month | |||||
| 1275 | 8 | 9 | $duration = $self->{'cache_hit_duration'}; | |||
| 1276 | } elsif(defined($value->{geometry})) { | |||||
| 1277 | # Partial geometry: may be a transient failure, retry soon | |||||
| 1278 | 5 | 5 | $duration = $self->{'cache_part_duration'}; | |||
| 1279 | 5 | 2 | $rc = undef; | |||
| 1280 | } | |||||
| 1281 | # UNREACHABLE: the else branch below is dead. The access | |||||
| 1282 | # defined($value->{geometry}{location}{lat}) above auto-vivifies | |||||
| 1283 | # $value->{geometry} as {}, so the elsif is always taken when | |||||
| 1284 | # the if fails. Original else preserved for documentation: | |||||
| 1285 | # } else { | |||||
| 1286 | # # No geometry at all: place probably does not exist | |||||
| 1287 | # $duration = $self->{'cache_miss_duration'}; | |||||
| 1288 | # $rc = undef; | |||||
| 1289 | # } | |||||
| 1290 | } else { | |||||
| 1291 | # Scalar string or a blessed object (e.g. Geo::Location::Point). | |||||
| 1292 | # Blessed objects may hold unserializable handles; stringify the | |||||
| 1293 | # geocoder field so CHI (Storable) can freeze the value safely. | |||||
| 1294 | 3 | 6 | if(ref($value) && ref($value->{'geocoder'})) { | |||
| 1295 | 0 | 0 | $value->{'geocoder'} = ref($value->{'geocoder'}); | |||
| 1296 | } | |||||
| 1297 | 3 | 3 | $duration = $self->{'cache_hit_duration'}; | |||
| 1298 | } | |||||
| 1299 | ||||||
| 1300 | 24 | 45 | print Data::Dumper->new([$value])->Dump() if($self->{'debug'}); | |||
| 1301 | ||||||
| 1302 | # Do not push the not-found sentinel into L2 | |||||
| 1303 | 24 | 145 | if(!defined($value)) { | |||
| 1304 | # value is not-found; L1 sentinel is sufficient | |||||
| 1305 | } elsif(ref($self->{'cache'}) eq 'HASH') { | |||||
| 1306 | 11 | 13 | $self->{'cache'}->{$key} = $value; | |||
| 1307 | } else { | |||||
| 1308 | 10 | 14 | $self->{'cache'}->set($key, $value, $duration); | |||
| 1309 | } | |||||
| 1310 | } | |||||
| 1311 | ||||||
| 1312 | 218 | 216 | return $rc; | |||
| 1313 | } | |||||
| 1314 | ||||||
| 1315 | # ââ Read path âââââââââââââââââââââââââââââââââââââââââââââââââââââââââ | |||||
| 1316 | ||||||
| 1317 | # Check L1 first (in-process, no serialisation cost) | |||||
| 1318 | 292 | 201 | my $rc = $self->{'locations'}->{$key}; | |||
| 1319 | ||||||
| 1320 | # Fall through to L2 only when L1 has no entry for this key | |||||
| 1321 | 292 | 393 | if((!defined($rc)) && $self->{'cache'}) { | |||
| 1322 | 7 | 10 | if(ref($self->{'cache'}) eq 'HASH') { | |||
| 1323 | 5 | 6 | $rc = $self->{'cache'}->{$key}; | |||
| 1324 | } else { | |||||
| 1325 | 2 | 4 | $rc = $self->{'cache'}->get($key); | |||
| 1326 | } | |||||
| 1327 | } | |||||
| 1328 | ||||||
| 1329 | 292 | 307 | return unless defined $rc; | |||
| 1330 | ||||||
| 1331 | # Translate the not-found sentinel back to undef for the caller | |||||
| 1332 | 46 | 89 | return if ref($rc) && (ref($rc) eq _NOT_FOUND_CLASS); | |||
| 1333 | ||||||
| 1334 | # Restore the convenience aliases that were stripped before L2 storage | |||||
| 1335 | 39 | 35 | if(ref($rc) eq 'HASH') { | |||
| 1336 | 28 | 30 | return unless defined($rc->{geometry}{location}{lat}); | |||
| 1337 | 27 | 40 | $rc->{'lat'} //= $rc->{geometry}{location}{lat}; | |||
| 1338 | 27 | 28 | $rc->{'lng'} //= $rc->{geometry}{location}{lng}; | |||
| 1339 | 27 | 30 | $rc->{'lon'} //= $rc->{geometry}{location}{lng}; | |||
| 1340 | } | |||||
| 1341 | ||||||
| 1342 | 38 | 33 | return $rc; | |||
| 1343 | } | |||||
| 1344 | ||||||
| 1345 | # Emit a debug message somewhere | |||||
| 1346 | sub _debug { | |||||
| 1347 | 0 | 0 | my $self = shift; | |||
| 1348 | ||||||
| 1349 | 0 | 0 | if(my $logger = $self->{logger}) { | |||
| 1350 | 0 | 0 | $logger->debug(@_); | |||
| 1351 | } | |||||
| 1352 | 0 | 0 | if($self->{debug}) { | |||
| 1353 | 0 | 0 | print @_, "\n"; | |||
| 1354 | } | |||||
| 1355 | } | |||||
| 1356 | ||||||
| 1357 | # Emit a warning message somewhere | |||||
| 1358 | sub _warn { | |||||
| 1359 | 26 | 78 | my $self = shift; | |||
| 1360 | ||||||
| 1361 | 26 | 35 | if(my $logger = $self->{logger}) { | |||
| 1362 | 26 | 65 | $logger->warn(@_); | |||
| 1363 | } else { | |||||
| 1364 | 0 | 0 | Carp::carp(@_); | |||
| 1365 | } | |||||
| 1366 | } | |||||
| 1367 | ||||||
| 1368 | # Emit an error message somewhere | |||||
| 1369 | sub _error { | |||||
| 1370 | 5 | 5 | my $self = shift; | |||
| 1371 | ||||||
| 1372 | 5 | 8 | if(my $logger = $self->{logger}) { | |||
| 1373 | 5 | 18 | $logger->error(@_); | |||
| 1374 | 5 | 2045 | die @_; | |||
| 1375 | } else { | |||||
| 1376 | 0 | Carp::croak(@_); | ||||
| 1377 | } | |||||
| 1378 | } | |||||
| 1379 | ||||||
| 1380 | # ============================================================================= | |||||
| 1381 | # DOCUMENTATION | |||||
| 1382 | # ============================================================================= | |||||
| 1383 | ||||||
| 1384 - 1567 | =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>.
Known limitations:
=over 4
=item * C<reverse_geocode()> does not yet support L<Geo::Location::Point> objects.
=item * When C<Geo::GeoNames> returns multiple candidates, only the first
element of each sub-array is considered.
=back
=head1 SEE ALSO
=over 4
=item * L<Test Dashboard|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<Configure an Object at Runtime|Object::Configure>
=item * L<Readonly>
=back
=head1 SUPPORT
You can find documentation for this module with the perldoc command:
perldoc Geo::Coder::List
=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
=encoding utf-8
=head2 FORMAL SPECIFICATION
=head3 new
List_State
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
geocoders : seq (Geocoder | RegexGeocoder)
L1 : LocationStr â (GeoResult | NotFound)
log : seq LogEntry
debug : â
cache? : L2Cache
new
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
List_State
params? : â(Key à Value)
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
geocoders = â¨â©
L1 = â
log = â¨â©
debug = params?.debug ⣠DEBUG_DEFAULT
cache = params?.cache ⣠â¥
=head3 push
push
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
g? : Geocoder | RegexGeocoder
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
geocoders' = geocoders ⢠â¨g?â©
L1' = L1
log' = log
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
where RegexGeocoder ::= { regex : Regex
; geocoder : Geocoder
; limit? : â }
=head3 geocode
LocationStr ::= { s : seq Char | s â â¨â© â§ â c : s ⢠c â Digit }
GeoResult ::= HASHREF with geometry.location.{lat,lng} : â
geocode
ââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
loc? : LocationStr
result! : GeoResult | â¥
ââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
loc? â dom L1
â¹ result! = L1(loc?)
â§ log' = log ⢠â¨{geocoder ⦠cache; timetaken ⦠0}â©
loc? â dom L1
â¹ (â i : 1..#geocoders â¢
applies(geocoders i, loc?)
â§ result! = Normalize(geocoders i . geocode(loc?))
â§ L1' = L1 â {loc? ⦠result!}
â§ log' = log ⢠â¨{geocoder ⦠class(geocoders i)}â©)
⨠(result! = ⥠⧠L1' = L1 â {loc? ⦠â¥})
applies(g, loc) â
(g isa Geocoder)
⨠(g isa RegexGeocoder â§ loc â matches(g.regex) â§ g.limit > 0)
=head3 ua SPECIFICATION
ua
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
ua? : UserAgent
ua! : UserAgent
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
â g : ran geocoders ⢠g.ua = ua?
ua! = ua?
=head3 reverse_geocode
LatLngStr ::= { s : seq Char
| s matches /^[-+]?\d+\.?\d*,[-+]?\d+\.?\d*$/ }
reverse_geocode
ââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
latlng? : LatLngStr
result! : seq Char | â¥
ââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
latlng? â dom L1
â¹ result! = L1(latlng?)
latlng? â dom L1
â¹ (â i : 1..#geocoders â¢
applies(geocoders i, latlng?)
â§ result! = geocoders i . reverse_geocode(latlng?)
â§ L1' = L1 â {latlng? ⦠result!})
⨠result! = â¥
=head3 log
log
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
result! : seq LogEntry
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
result! = log
=head3 flush
flush
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
ÎList_State
ââââââââââââââââââââââââââââââââââââââââââââââââââââââ
log' = â¨â©
geocoders' = geocoders
L1' = L1
=head1 LICENSE AND COPYRIGHT
Copyright 2016-2026 Nigel Horne.
Usage is subject to the GPL2 licence terms.
If you use it,
please let me know.
=cut | |||||
| 1568 | ||||||
| 1569 | 1; | |||||