File Coverage

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

linestmtbrancondsubtimecode
1package Geo::Coder::List;
2
3
20
20
1278756
28
use 5.10.1;
4
5
20
20
20
41
9
317
use warnings;
6
20
20
20
32
14
159
use strict;
7
20
20
20
25
20
455
use Carp;
8
20
20
20
3589
45904
811
use HTML::Entities;
9
20
20
20
3137
85327
426
use Params::Get 0.04;
10
20
20
20
3960
974621
260
use Object::Configure 0.13;
11
20
20
20
57
23
52
use Time::HiRes;
12
20
20
20
713
11
300
use Scalar::Util;
13
14
20
20
20
31
11
34287
use constant DEBUG => 0;     # Default debugging level
15
16# TODO: investigate Geo, Coder::ArcGIS
17# TODO: return a Geo::Location::Point object all the time
18
19 - 27
=head1 NAME

Geo::Coder::List - Call many Geo-Coders

=head1 VERSION

Version 0.36

=cut
28
29our $VERSION = '0.36';
30
31 - 72
=head1 SYNOPSIS

L<Geo::Coder::All>
and
L<Geo::Coder::Many>
are great routines but neither quite does what I want.

C<Geo::Coder::List> is designed to simplify geocoding tasks by aggregating multiple geocoding services into a single, unified interface.
It allows developers to chain and prioritize various geocoding backends (such as Google Places, OpenStreetMap, and GeoNames)
based on specific conditions,
such as location or usage limits.
The module features built-in caching mechanisms to optimize performance and reduce redundant API calls,
while also normalizing responses from different providers into a consistent format for easier integration with mapping systems such as L<HTML::OSM> and <L<HTML::GoogleMaps::V3>.

=head1 SUBROUTINES/METHODS

=head2 new

Creates a C<Geo::Coder::List> object.

Takes an optional argument C<cache> which is a reference to a HASH or an object that supports C<get()> and C<set()> methods.
The licences of some geo coders,
such as Google,
specifically prohibit caching API calls,
so be careful to only use those services that allow it.

Takes an optional argument C<debug>,
the higher the number,
the more debugging.

    use Geo::Coder::List;
    use CHI;

    my $geocoder->new(cache => CHI->new(driver => 'Memory', global => 1));

The class can be configured at runtime using environments and configuration files,
for example,
setting C<$ENV{'GEO__CODER__LIST__carp_on_warn'}> causes warnings to use L<Carp>.
For more information about configuring object constructors at runtime,
see L<Object::Configure>.

=cut
73
74sub new
75{
76
14
157473
        my $class = shift;
77
14
19
        my $params = Params::Get::get_params(undef, @_) || {};
78
79
14
154
        if(!defined($class)) {
80
2
2
2
4
                if((scalar keys %{$params}) > 0) {
81                        # Using Geo::Coder::List::new(), not Geo::Coder::List->new()
82
0
0
                        carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
83
0
0
                        return;
84                }
85
86                # FIXME: this only works when no arguments are given
87
2
1
                $class = __PACKAGE__;
88        } elsif(Scalar::Util::blessed($class)) {
89                # If $class is an object, clone it with new arguments
90
2
2
2
4
3
7
                return bless { %{$class}, %{$params} }, ref($class);
91        }
92
93
12
15
        $params = Object::Configure::configure($class, $params);
94
95        # Return the blessed object
96        # Locations is an L1 cache that is always used
97
12
12
58690
35
        return bless { debug => DEBUG, locations => {}, geocoders => [], log => [], %{$params} }, $class;
98}
99
100 - 139
=head2 push($self, $geocoder)

Add an encoder to the list of encoders.

    use Geo::Coder::List;
    use Geo::Coder::GooglePlaces;
    # ...
    my $list = Geo::Coder::List->new()->push(Geo::Coder::GooglePlaces->new());

Different encoders can be preferred for different locations.
For example, this code uses geocode.ca for Canada and US addresses,
and OpenStreetMap for other places:

    my $geo_coderlist = Geo::Coder::List->new()
        ->push({ regex => qr/(Canada|USA|United States)$/, geocoder => Geo::Coder::CA->new() })
        ->push(Geo::Coder::OSM->new());

    # Uses Geo::Coder::CA, and if that fails, uses Geo::Coder::OSM
    my $location = $geo_coderlist->geocode(location => '1600 Pennsylvania Ave NW, Washington DC, USA');
    # Only uses Geo::Coder::OSM
    if($location = $geo_coderlist->geocode('10 Downing St, London, UK')) {
        print 'The prime minister lives at co-ordinates ',
            $location->{geometry}{location}{lat}, ',',
            $location->{geometry}{location}{lng}, "\n";
    }

    # It is also possible to limit the number of enquires used by a particular encoder
    $geo_coderlist->push({ geocoder => Geo::Coder::GooglePlaces->new(key => '1234', limit => 100) });

=head3 Parameters

=over 4

=item * C<$geocoder> hashref (required)

Hashref containing a regex and a geocoding object.

=back

=cut
140
141sub push
142{
143
6
11
        my($self, $geocoder) = @_;      # Don't use Params::Get or else the regex will be lost
144
145
6
7
        croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless(defined($geocoder));
146
147
6
6
2
7
        push @{$self->{geocoders}}, $geocoder;
148
149
6
9
        return $self;
150}
151
152 - 165
=head2 geocode

Runs geocode on all of the loaded drivers.
See L<Geo::Coder::GooglePlaces::V3> for an explanation.

The name of the Geo-Coder that gave the result is put into the geocode element of the
return value,
if the value was retrieved from the cache the value will be undefined.

    if(defined($location->{'geocoder'})) {
        print 'Location information retrieved using ', $location->{'geocoder'}, "\n";
    }

=cut
166
167sub geocode {
168
6
8
        my $self = shift;
169
6
7
        my $params = Params::Get::get_params('location', @_);
170
171
6
53
        my $location = $params->{'location'};
172
173
6
14
        if((!defined($location)) || (length($location) == 0)) {
174
0
0
                Carp::carp(__PACKAGE__, ' usage: geocode(location => $location)');
175
0
0
                return;
176        }
177
178        # Fail when the input is just a set of numbers
179
6
12
        if($params->{'location'} !~ /\D/) {
180
0
0
                Carp::croak('Usage: ', __PACKAGE__, ": invalid input to geocode(), ", $params->{location});
181
0
0
                return;
182        }
183
184
6
4
        $location =~ s/\s\s+/ /g;
185
6
12
        $location = decode_entities($location);
186
6
6
        print "location: $location\n" if($self->{'debug'});
187
188
6
6
        my @call_details = caller(0);
189
6
47
        if((!wantarray) && (my $rc = $self->_cache($location))) {
190
1
1
                if(ref($rc) eq 'ARRAY') {
191
0
0
                        $rc = $rc->[0];
192                }
193
1
2
                if(ref($rc) eq 'HASH') {
194
1
1
                        $rc->{'geocoder'} = 'cache';
195
1
2
                        my $log = {
196                                line => $call_details[2],
197                                location => $location,
198                                timetaken => 0,
199                                gecoder => 'cache',
200                                wantarray => 0,
201                                result => $rc
202                        };
203
1
1
1
0
                        CORE::push @{$self->{'log'}}, $log;
204
1
2
                        print __PACKAGE__, ': ', __LINE__,  ": cached\n" if($self->{'debug'});
205
1
1
                        return $rc;
206                }
207        }
208
5
0
5
0
        if(defined($self->_cache($location)) && (ref($self->_cache($location)) eq 'ARRAY') && (my @rc = @{$self->_cache($location)})) {
209
0
0
                if(scalar(@rc)) {
210
0
0
                        my $allempty = 1;
211
0
0
                        foreach (@rc) {
212
0
0
                                if(ref($_) eq 'HASH') {
213
0
0
                                        if(defined($_->{geometry}{location}{lat})) {
214
0
0
                                                $allempty = 0;
215
0
0
                                                $_->{'geocoder'} = 'cache';
216                                        } else {
217
0
0
                                                delete $_->{'geometry'};
218                                        }
219                                } elsif(ref($_) eq 'Geo::Location::Point') {
220
0
0
                                        $allempty = 0;
221
0
0
                                        $_->{'geocoder'} = 'cache';
222                                } else {
223
0
0
                                        print STDERR Data::Dumper->new([\@rc])->Dump();
224
0
0
                                        Carp::croak(ref($self), " '$location': unexpected item in the cache");
225                                }
226                        }
227
0
0
                        my $log = {
228                                line => $call_details[2],
229                                location => $location,
230                                timetaken => 0,
231                                gecoder => 'cache',
232                                wantarray => wantarray,
233                                result => \@rc
234                        };
235
0
0
0
0
                        CORE::push @{$self->{'log'}}, $log;
236
0
0
                        print __PACKAGE__, ': ', __LINE__,  ": cached\n" if($self->{'debug'});
237
0
0
                        if($allempty) {
238
0
0
                                return;
239                        }
240
0
0
                        return (wantarray) ? @rc : $rc[0];
241                }
242        }
243
244        # my $error;
245
246
5
5
1
5
        ENCODER: foreach my $g(@{$self->{geocoders}}) {
247
6
6
                my $geocoder = $g;
248
6
4
                if(ref($geocoder) eq 'HASH') {
249
0
0
                        if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
250
0
0
                                print "limit: $limit\n" if($self->{'debug'});
251
0
0
                                if($limit <= 0) {
252
0
0
                                        next;
253                                }
254
0
0
                                $geocoder->{'limit'}--;
255                        }
256
0
0
                        if(my $regex = $geocoder->{'regex'}) {
257
0
0
                                print 'consider ', ref($geocoder->{geocoder}), ": $regex\n" if($self->{'debug'});
258
0
0
                                if($location !~ $regex) {
259
0
0
                                        next;
260                                }
261                        }
262
0
0
                        $geocoder = $g->{'geocoder'};
263                }
264
6
4
                my @rc;
265
6
6
                my $timetaken = Time::HiRes::time();
266
6
2
                eval {
267                        # e.g. over QUERY LIMIT with this one
268                        # TODO: remove from the list of geocoders
269
6
6
                        print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
270
6
6
                        if(ref($geocoder) eq 'Geo::GeoNames') {
271
0
0
                                print 'username => ', $geocoder->username(), "\n" if($self->{'debug'});
272
0
0
                                die 'lost username' if(!defined($geocoder->username()));
273
0
0
                                @rc = $geocoder->geocode($location);
274                        } else {
275
6
6
1
16
                                @rc = $geocoder->geocode(%{$params});
276                        }
277                };
278
6
644
                if($@) {
279
1
3
                        my $log = {
280                                line => $call_details[2],
281                                location => $location,
282                                geocoder => ref($geocoder),
283                                timetaken => Time::HiRes::time() - $timetaken,
284                                wantarray => wantarray,
285                                error => $@
286                        };
287
1
1
1
1
                        CORE::push @{$self->{'log'}}, $log;
288
1
13
                        Carp::carp(ref($geocoder), " '$location': $@");
289                        # $error = $@;
290
1
647
                        next ENCODER;
291                }
292
5
4
                $timetaken = Time::HiRes::time() - $timetaken;
293
5
6
                if((ref($geocoder) eq 'Geo::Coder::US::Census') &&
294                   !(defined($rc[0]->{result}{addressMatches}[0]->{coordinates}{y}))) {
295                        # Looks like Geo::Coder::US::Census sometimes says it's worked when it hasn't
296
0
0
                        my $log = {
297                                line => $call_details[2],
298                                location => $location,
299                                timetaken => $timetaken,
300                                geocoder => 'Geo::Coder::US::Census',
301                                wantarray => wantarray,
302                                result => 'not found',
303                        };
304
0
0
0
0
                        CORE::push @{$self->{'log'}}, $log;
305
0
0
                        next ENCODER;
306                }
307
5
8
                if((scalar(@rc) == 0) ||
308
3
10
                   ((ref($rc[0]) eq 'HASH') && (scalar(keys %{$rc[0]}) == 0)) ||
309
1
2
                   ((ref($rc[0]) eq 'ARRAY') && (scalar(keys %{$rc[0][0]}) == 0))) {
310
0
0
                        my $log = {
311                                line => $call_details[2],
312                                location => $location,
313                                timetaken => $timetaken,
314                                geocoder => ref($geocoder),
315                                wantarray => wantarray,
316                                result => 'not found',
317                        };
318
0
0
0
0
                        CORE::push @{$self->{'log'}}, $log;
319
0
0
                        next ENCODER;
320                }
321
5
6
                POSSIBLE_LOCATION: foreach my $l(@rc) {
322
5
4
                        if(ref($l) eq 'ARRAY') {
323                                # Geo::GeoNames
324                                # FIXME: should consider all locations in the array
325
1
1
                                $l = $l->[0];
326                        }
327
5
6
                        if((!defined($l)) || ($l eq '')) {
328
1
2
                                my $log = {
329                                        line => $call_details[2],
330                                        location => $location,
331                                        timetaken => $timetaken,
332                                        geocoder => ref($geocoder),
333                                        wantarray => wantarray,
334                                        result => 'not found',
335                                };
336
1
1
1
1
                                CORE::push @{$self->{'log'}}, $log;
337
1
2
                                next ENCODER;
338                        }
339
4
7
                        $l->{'geocoder'} = ref($geocoder);
340                        print ref($geocoder), ': ',
341
4
3
                                Data::Dumper->new([\$l])->Dump() if($self->{'debug'} >= 2);
342
4
7
                        last if(ref($l) eq 'Geo::Location::Point');
343
4
5
                        next if(ref($l) ne 'HASH');
344
4
3
                        if($l->{'error'}) {
345                                my $log = {
346                                        line => $call_details[2],
347                                        location => $location,
348                                        timetaken => $timetaken,
349                                        geocoder => ref($geocoder),
350                                        wantarray => wantarray,
351
0
0
                                        error => $l->{'error'}
352                                };
353
0
0
0
0
                                CORE::push @{$self->{'log'}}, $log;
354
0
0
                                next ENCODER;
355                        } else {
356                                # Try to create a common interface, helps with HTML::GoogleMaps::V3
357
4
6
                                if(!defined($l->{geometry}{location}{lat})) {
358
3
2
                                        my ($lat, $long);
359
3
6
                                        if($l->{lat} && defined($l->{lon})) {
360                                                # OSM/RandMcNalley
361                                                # This would have been nice, but it doesn't compile
362                                                # ($lat, $long) = $l->{'lat', 'lon'};
363
3
2
                                                $lat = $l->{lat};
364
3
1
                                                $long = $l->{lon};
365
3
3
                                                $l->{'debug'} = __LINE__;
366                                        } elsif($l->{BestLocation}) {
367                                                # Bing
368
0
0
                                                $lat = $l->{BestLocation}->{Coordinates}->{Latitude};
369
0
0
                                                $long = $l->{BestLocation}->{Coordinates}->{Longitude};
370
0
0
                                                $l->{'debug'} = __LINE__;
371                                        } elsif($l->{point}) {
372                                                # Bing
373
0
0
                                                $lat = $l->{point}->{coordinates}[0];
374
0
0
                                                $long = $l->{point}->{coordinates}[1];
375
0
0
                                                $l->{'debug'} = __LINE__;
376                                        } elsif($l->{latt}) {
377                                                # geocoder.ca
378
0
0
                                                $lat = $l->{latt};
379
0
0
                                                $long = $l->{longt};
380
0
0
                                                $l->{'debug'} = __LINE__;
381                                        } elsif($l->{latitude}) {
382                                                # postcodes.io
383                                                # Geo::Coder::Free
384
0
0
                                                $lat = $l->{latitude};
385
0
0
                                                $long = $l->{longitude};
386
0
0
                                                if(my $type = $l->{'local_type'}) {
387
0
0
                                                        $l->{'type'} = lcfirst($type);       # e.g. village
388                                                }
389
0
0
                                                $l->{'debug'} = __LINE__;
390                                        } elsif($l->{'properties'}{'geoLatitude'}) {
391                                                # ovi
392
0
0
                                                $lat = $l->{properties}{geoLatitude};
393
0
0
                                                $long = $l->{properties}{geoLongitude};
394
0
0
                                                $l->{'debug'} = __LINE__;
395                                        } elsif($l->{'results'}[0]->{'geometry'}) {
396
0
0
                                                if($l->{'results'}[0]->{'geometry'}->{'location'}) {
397                                                        # DataScienceToolkit
398
0
0
                                                        $lat = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'};
399
0
0
                                                        $long = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'};
400
0
0
                                                        $l->{'debug'} = __LINE__;
401                                                } else {
402                                                        # OpenCage
403
0
0
                                                        $lat = $l->{'results'}[0]->{'geometry'}->{'lat'};
404
0
0
                                                        $long = $l->{'results'}[0]->{'geometry'}->{'lng'};
405
0
0
                                                        $l->{'debug'} = __LINE__;
406                                                }
407                                        } elsif($l->{'RESULTS'}) {
408                                                # GeoCodeFarm
409
0
0
                                                $lat = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'};
410
0
0
                                                $long = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'};
411
0
0
                                                $l->{'debug'} = __LINE__;
412                                        } elsif(defined($l->{result}{addressMatches}[0]->{coordinates}{y})) {
413                                                # US Census
414                                                # This would have been nice, but it doesn't compile
415                                                # ($lat, $long) = $l->{result}{addressMatches}[0]->{coordinates}{y, x};
416
0
0
                                                $lat = $l->{result}{addressMatches}[0]->{coordinates}{y};
417
0
0
                                                $long = $l->{result}{addressMatches}[0]->{coordinates}{x};
418
0
0
                                                $l->{'debug'} = __LINE__;
419                                        } elsif($l->{lat}) {
420                                                # Geo::GeoNames
421
0
0
                                                $lat = $l->{lat};
422
0
0
                                                $long = $l->{lng};
423
0
0
                                                $l->{'debug'} = __LINE__;
424                                        } elsif($l->{features}) {
425
0
0
                                                if($l->{features}[0]->{center}) {
426                                                        # Geo::Coder::Mapbox
427
0
0
                                                        $lat = $l->{features}[0]->{center}[1];
428
0
0
                                                        $long = $l->{features}[0]->{center}[0];
429
0
0
                                                        $l->{'debug'} = __LINE__;
430                                                } elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) {
431                                                        # Geo::Coder::GeoApify
432
0
0
                                                        $lat = $l->{'features'}[0]{'geometry'}{'coordinates'}[1];
433
0
0
                                                        $long = $l->{'features'}[0]{'geometry'}{'coordinates'}[0];
434
0
0
                                                        $l->{'debug'} = __LINE__;
435                                                } else {
436                                                        # GeoApify doesn't give an error if a location is not found
437
0
0
                                                        next ENCODER;
438                                                }
439                                        } else {
440
0
0
                                                $l->{'debug'} = __LINE__;
441                                        }
442
443
3
5
                                        if(defined($lat) && defined($long)) {
444
3
2
                                                $l->{geometry}{location}{lat} = $lat;
445
3
3
                                                $l->{geometry}{location}{lng} = $long;
446                                                # Compatibility
447
3
2
                                                $l->{'lat'} = $lat;
448
3
3
                                                $l->{'lon'} = $long;
449                                        } else {
450
0
0
                                                delete $l->{'geometry'};
451
0
0
                                                delete $l->{'lat'};
452
0
0
                                                delete $l->{'lon'};
453                                        }
454
455
3
3
                                        if($l->{'standard'}{'countryname'}) {
456                                                # geocoder.xyz
457
0
0
                                                $l->{'address'}{'country'} = $l->{'standard'}{'countryname'};
458                                        }
459                                }
460
4
4
                                if(defined($l->{geometry}{location}{lat})) {
461
4
4
                                        print $l->{geometry}{location}{lat}, '/', $l->{geometry}{location}{lng}, "\n" if($self->{'debug'});
462
4
1
                                        $l->{geocoder} = $geocoder;
463
4
8
                                        $l->{'lat'} //= $l->{geometry}{location}{lat};
464
4
9
                                        $l->{'lng'} //= $l->{geometry}{location}{lng};
465
4
3
                                        $l->{'lon'} //= $l->{geometry}{location}{lng};
466
4
9
                                        my $log = {
467                                                line => $call_details[2],
468                                                location => $location,
469                                                timetaken => $timetaken,
470                                                geocoder => ref($geocoder),
471                                                wantarray => wantarray,
472                                                result => $l
473                                        };
474
4
4
3
2
                                        CORE::push @{$self->{'log'}}, $log;
475
4
4
                                        last POSSIBLE_LOCATION;
476                                }
477                        }
478                }
479
480
4
4
                if(scalar(@rc)) {
481
4
4
                        print 'Number of matches from ', ref($geocoder), ': ', scalar(@rc), "\n" if($self->{'debug'});
482
4
1
                        $Data::Dumper::Maxdepth = 10;
483
4
4
                        print Data::Dumper->new([\@rc])->Dump() if($self->{'debug'} >= 2);
484
4
11
                        if(defined($rc[0])) {   # check it's not an empty hash
485
4
3
                                if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) {
486
0
0
                                        $rc[0]->{'lng'} = $rc[0]->{'long'};
487                                }
488
4
5
                                if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lon'})) {
489
0
0
                                        $rc[0]->{'lon'} = $rc[0]->{'long'};
490                                }
491
4
5
                                if((!defined($rc[0]->{lat})) || (!defined($rc[0]->{lng}))) {
492                                        # ::diag(Data::Dumper->new([\@rc])->Dump());
493
0
0
                                        warn Data::Dumper->new([\@rc])->Dump();
494
0
0
                                        Carp::croak("BUG: '$location': HASH exists but is not sensible");
495                                }
496
4
3
                                if(wantarray) {
497
1
2
                                        $self->_cache($location, \@rc);
498
1
2
                                        return @rc;
499                                }
500
3
5
                                $self->_cache($location, $rc[0]);
501
3
6
                                return $rc[0];
502                        }
503                }
504        }
505        # Can't do this because we need to return undef in this case
506        # if($error) {
507                # return { error => $error };
508        # }
509
1
1
        print "No matches\n" if($self->{'debug'});
510
1
2
        if(wantarray) {
511
0
0
                $self->_cache($location, ());
512
0
0
                return ();
513        }
514
1
1
        $self->_cache($location, undef);
515}
516
517 - 542
=head2 ua($self, $ua)

Accessor method to set the UserAgent object used internally by each of the Geo-Coders.
You can call I<env_proxy>,
for example,
to set the proxy information from environment variables:

    my $geocoder_list = Geo::Coder::List->new();
    my $ua = LWP::UserAgent->new();
    $ua->env_proxy(1);
    $geocoder_list->ua($ua);

Note that unlike Geo::Coders,
there is no read method since that would be pointless.

=head3 Parameters

=over 4

=item * C<$ua> object (optional)

Useragent object.

=back

=cut
543
544sub ua
545{
546
0
0
        my($self, $ua) = @_;
547
0
0
        return unless $ua;
548
549
0
0
0
0
        foreach my $g(@{$self->{geocoders}}) {
550
0
0
                my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g;
551
0
0
                Carp::croak('No geocoder found') unless defined $geocoder;
552
0
0
                $geocoder->ua($ua);
553        }
554
555
0
0
        return $ua;
556}
557
558 - 564
=head2 reverse_geocode

Similar to geocode except it expects a latitude/longitude parameter.

    print $geocoder_list->reverse_geocode(latlng => '37.778907,-122.39732');

=cut
565
566sub reverse_geocode {
567
0
0
        my $self = shift;
568
0
0
        my $params = Params::Get::get_params('latlng', @_);
569
570
0
0
        my $latlng = $params->{'latlng'}
571                or Carp::croak('Usage: reverse_geocode(latlng => $location)');
572
573
0
0
        my ($latitude, $longitude);
574
0
0
        if($latlng) {
575
0
0
                ($latitude, $longitude) = split(/,/, $latlng);
576
0
0
                $params->{'lat'} //= $latitude;
577
0
0
                $params->{'lon'} //= $longitude;
578        } else {
579
0
0
                $latitude //= $params->{'lat'};
580
0
0
                $longitude //= $params->{'lon'};
581
0
0
                $longitude //= $params->{'long'};
582
0
0
                $latlng = $params->{'latlng'} = "$latitude,$longitude";
583        }
584
585
0
0
        if(my $rc = $self->_cache($latlng)) {
586
0
0
                return $rc;
587        }
588
589
0
0
0
0
        foreach my $g(@{$self->{geocoders}}) {
590
0
0
                my $geocoder = $g;
591
0
0
                if(ref($geocoder) eq 'HASH') {
592
0
0
                        if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
593
0
0
                                print "limit: $limit\n" if($self->{'debug'});
594
0
0
                                if($limit <= 0) {
595
0
0
                                        next;
596                                }
597
0
0
                                $geocoder->{'limit'}--;
598                        }
599
0
0
                        $geocoder = $g->{'geocoder'};
600                }
601
0
0
                print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
602
0
0
                if(wantarray) {
603
0
0
                        my @rc;
604
0
0
0
0
                        if(my @locs = $geocoder->reverse_geocode(%{$params})) {
605
0
0
                                print Data::Dumper->new([\@locs])->Dump() if($self->{'debug'} >= 2);
606
0
0
                                foreach my $loc(@locs) {
607
0
0
                                        if(my $name = $loc->{'display_name'}) {
608                                                # OSM
609
0
0
                                                CORE::push @rc, $name;
610                                        } elsif($loc->{'city'}) {
611                                                # Geo::Coder::CA
612
0
0
                                                my $name;
613
0
0
                                                if(my $usa = $loc->{'usa'}) {
614
0
0
                                                        $name = $usa->{'usstnumber'};
615
0
0
                                                        if(my $staddress = $usa->{'usstaddress'}) {
616
0
0
                                                                $name .= ' ' if($name);
617
0
0
                                                                $name .= $staddress;
618                                                        }
619
0
0
                                                        if(my $city = $usa->{'uscity'}) {
620
0
0
                                                                $name .= ', ' if($name);
621
0
0
                                                                $name .= $city;
622                                                        }
623
0
0
                                                        if(my $state = $usa->{'state'}) {
624
0
0
                                                                $name .= ', ' if($name);
625
0
0
                                                                $name .= $state;
626                                                        }
627
0
0
                                                        $name .= ', ' if($name);
628
0
0
                                                        $name .= 'USA';
629                                                } else {
630
0
0
                                                        $name = $loc->{'stnumber'};
631
0
0
                                                        if(my $staddress = $loc->{'staddress'}) {
632
0
0
                                                                $name .= ' ' if($name);
633
0
0
                                                                $name .= $staddress;
634                                                        }
635
0
0
                                                        if(my $city = $loc->{'city'}) {
636
0
0
                                                                $name .= ', ' if($name);
637
0
0
                                                                $name .= $city;
638                                                        }
639
0
0
                                                        if(my $state = $loc->{'prov'}) {
640
0
0
                                                                $state .= ', ' if($name);
641
0
0
                                                                $name .= $state;
642                                                        }
643                                                }
644
0
0
                                                CORE::push @rc, $name;
645                                        } elsif($loc->{features}) {
646                                                # Geo::Coder::Apify
647
0
0
                                                return CORE::push @rc, $loc->{features}[0]->{properties}{formatted};
648                                        }
649                                }
650                        }
651
0
0
                        $self->_cache($latlng, \@rc);
652
0
0
                        return @rc;
653
0
0
                } elsif(my $rc = $self->_cache($latlng) // $geocoder->reverse_geocode(%{$params})) {
654
0
0
                        return $rc if(!ref($rc));
655
0
0
                        print Data::Dumper->new([$rc])->Dump() if($self->{'debug'} >= 2);
656
0
0
                        if(my $name = $rc->{'display_name'}) {
657                                # OSM
658
0
0
                                return $self->_cache($latlng, $name);
659                        }
660
0
0
                        if($rc->{'city'}) {
661                                # Geo::Coder::CA
662
0
0
                                my $name;
663
0
0
                                if(my $usa = $rc->{'usa'}) {
664                                        # TODO: Use Lingua::Conjunction
665
0
0
                                        $name = $usa->{'usstnumber'};
666
0
0
                                        if(my $staddress = $usa->{'usstaddress'}) {
667
0
0
                                                $name .= ' ' if($name);
668
0
0
                                                $name .= $staddress;
669                                        }
670
0
0
                                        if(my $city = $usa->{'uscity'}) {
671
0
0
                                                $name .= ', ' if($name);
672
0
0
                                                $name .= $city;
673                                        }
674
0
0
                                        if(my $state = $usa->{'state'}) {
675
0
0
                                                $name .= ', ' if($name);
676
0
0
                                                $name .= $state;
677                                        }
678
0
0
                                        return $self->_cache($latlng, "$name, USA");
679                                } else {
680                                        # TODO: Use Lingua::Conjunction
681
0
0
                                        $name = $rc->{'stnumber'};
682
0
0
                                        if(my $staddress = $rc->{'staddress'}) {
683
0
0
                                                $name .= ' ' if($name);
684
0
0
                                                $name .= $staddress;
685                                        }
686
0
0
                                        if(my $city = $rc->{'city'}) {
687
0
0
                                                $name .= ', ' if($name);
688
0
0
                                                $name .= $city;
689                                        }
690
0
0
                                        if(my $state = $rc->{'prov'}) {
691
0
0
                                                $state = ", $state" if($name);
692
0
0
                                                return $self->_cache($latlng, "$name $state");
693                                        }
694                                }
695
0
0
                                return $self->_cache($latlng, $name);
696                        }
697
0
0
                        if($rc->{features}) {
698                                # Geo::Coder::Apify
699
0
0
                                return $self->_cache($latlng, $rc->{features}[0]->{properties}{formatted});
700                        }
701                }
702        }
703
0
0
        return;
704}
705
706 - 713
=head2 log

Returns the log of events to help you debug failures,
optimize lookup order and fix quota breakage.

    my @log = @{$geocoderlist->log()};

=cut
714
715sub log {
716
2
531
        my $self = shift;
717
718
2
13
        return $self->{'log'};
719}
720
721 - 725
=head2 flush

Clear the log.

=cut
726
727sub flush {
728
0
0
        my $self = shift;
729
730
0
0
        delete $self->{'log'};
731}
732
733sub _cache {
734
15
8
        my $self = shift;
735
15
9
        my $key = shift;
736
737
15
11
        if(my $value = shift) {
738                # Put something into the cache
739
4
5
                $self->{locations}->{$key} = $value;
740
4
1
                my $rc = $value;
741
4
3
                if($self->{'cache'}) {
742
1
1
                        my $duration;
743
1
2
                        if(ref($value) eq 'ARRAY') {
744
0
0
0
0
                                foreach my $item(@{$value}) {
745
0
0
                                        if(ref($item) eq 'HASH') {
746
0
0
                                                $item->{'geocoder'} = ref($item->{'geocoder'});   # It's an object, not the name
747
0
0
                                                if(!$self->{'debug'}) {
748
0
0
0
0
                                                        while(my($k, $v) = each %{$item}) {
749
0
0
                                                                delete $item->{$k} unless($k eq 'geometry');
750                                                        }
751                                                }
752
0
0
                                                if(!defined($item->{geometry}{location}{lat})) {
753
0
0
                                                        if(defined($item->{geometry})) {
754                                                                # Maybe a temporary lookup failure,
755                                                                # so do a research tomorrow
756
0
0
                                                                $duration = '1 day';
757                                                        } else {
758                                                                # Probably the place doesn't exist
759
0
0
                                                                $duration = '1 week';
760                                                        }
761
0
0
                                                        $rc = undef;
762                                                }
763                                        }
764                                }
765
0
0
                                if(!defined($duration)) {
766                                        # Has matched - it won't move
767
0
0
                                        $duration = '1 month';
768                                }
769                        } elsif(ref($value) eq 'HASH') {
770
1
2
                                $value->{'geocoder'} = ref($value->{'geocoder'}); # It's an object, not the name
771
1
1
                                if(!$self->{'debug'}) {
772
1
8
1
8
                                        while(my($k, $v) = each %{$value}) {
773
7
7
                                                delete $value->{$k} unless ($k eq 'geometry');
774                                        }
775                                }
776
1
1
                                if(defined($value->{geometry}{location}{lat})) {
777
1
1
                                        $duration = '1 month';  # It won't move :-)
778                                } elsif(defined($value->{geometry})) {
779                                        # Maybe a temporary lookup failure, so do a research
780                                        # tomorrow
781
0
0
                                        $duration = '1 day';
782
0
0
                                        $rc = undef;
783                                } else {
784                                        # Probably the place doesn't exist
785
0
0
                                        $duration = '1 week';
786
0
0
                                        $rc = undef;
787                                }
788                        } else {
789
0
0
                                $duration = '1 month';
790                        }
791
1
1
                        print Data::Dumper->new([$value])->Dump() if($self->{'debug'});
792
1
2
                        if(ref($self->{'cache'}) eq 'HASH') {
793
1
1
                                $self->{'cache'}->{$key} = $value;
794                        } elsif(!ref($value)) {
795
0
0
                                $self->{'cache'}->set($key, $value, $duration);
796                        }
797                }
798
4
3
                return $rc;
799        }
800
801        # Retrieve from the cache
802
11
7
        my $rc = $self->{'locations'}->{$key};    # In the L1 cache?
803
11
13
        if((!defined($rc)) && $self->{'cache'}) {    # In the L2 cache?
804
2
3
                if(ref($self->{'cache'}) eq 'HASH') {
805
2
1
                        $rc = $self->{'cache'}->{$key};
806                } else {
807
0
0
                        $rc = $self->{'cache'}->get($key);
808                }
809        }
810
11
12
        if(defined($rc)) {
811
1
1
                if(ref($rc) eq 'HASH') {        # else - it will be an array of hashes
812
1
1
                        if(!defined($rc->{geometry}{location}{lat})) {
813
0
0
                                return;
814                        }
815
1
3
                        $rc->{'lat'} //= $rc->{geometry}{location}{lat};
816
1
2
                        $rc->{'lng'} //= $rc->{geometry}{location}{lng};
817
1
2
                        $rc->{'lon'} //= $rc->{geometry}{location}{lng};
818                }
819        }
820
11
15
        return $rc;
821}
822
823 - 854
=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-geo-coder-list at rt.cpan.org>,
or through the web interface at
L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Geo-Coder-List>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

reverse_geocode() doesn't update the logger.
reverse_geocode() should support L<Geo::Location::Point> objects.

=head1 SEE ALSO

=over 4

=item * Test coverage report: L<https://nigelhorne.github.io/Geo-Coder-List/coverage/>

=item * L<Geo::Coder::All>

=item * L<Geo::Coder::GooglePlaces>

=item * L<Geo::Coder::Many>

=item * L<Object::Configure>

=back

=cut
855
856 - 884
=head1 SUPPORT

This module is provided as-is without any warranty.

You can find documentation for this module with the perldoc command.

    perldoc Geo::Coder::List

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Coder-List>

=item * MetaCPAN

L<https://metacpan.org/release/Geo-Coder-List>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2016-2026 Nigel Horne.

This program is released under the following licence: GPL2

=cut
885
8861;