File Coverage

File:blib/lib/Geo/Coder/List.pm
Coverage:92.3%

linestmtbrancondsubtimecode
1package 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
30our $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
43my $NOT_FOUND_SENTINEL = bless {}, _NOT_FOUND_CLASS;
44
45# String placed in the 'geocoder' field of a result served from cache
46Readonly::Scalar my $CACHE_SOURCE => 'cache';
47
48# String used as the 'result' value in log entries for a geocoder miss
49Readonly::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
58my %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
149sub 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
225sub 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
299sub 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
799sub 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
873sub 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
1096sub 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
1126sub 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
1152sub _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
1207sub _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
1346sub _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
1358sub _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
1369sub _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
15691;