• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

nigelhorne / Geo-Coder-List / 13426423435

20 Feb 2025 02:18AM UTC coverage: 4.826%. Remained the same
13426423435

push

github

18 of 373 relevant lines covered (4.83%)

0.56 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

4.83
/lib/Geo/Coder/List.pm
1
package Geo::Coder::List;
2

3
use 5.10.1;
19✔
4

5
use warnings;
19✔
6
use strict;
19✔
7
use Carp;
19✔
8
use HTML::Entities;
19✔
9
use Params::Get 0.04;
19✔
10
use Object::Configure 0.13;
19✔
11
use Time::HiRes;
12
use Scalar::Util;
19✔
13

14
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
=head1 NAME
20

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

23
=head1 VERSION
24

25
Version 0.36
26

27
=cut
28

29
our $VERSION = '0.36';
30

31
=head1 SYNOPSIS
32

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

38
C<Geo::Coder::List> is designed to simplify geocoding tasks by aggregating multiple geocoding services into a single, unified interface.
39
It allows developers to chain and prioritize various geocoding backends (such as Google Places, OpenStreetMap, and GeoNames)
40
based on specific conditions,
41
such as location or usage limits.
42
The module features built-in caching mechanisms to optimize performance and reduce redundant API calls,
43
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>.
44

45
=head1 SUBROUTINES/METHODS
46

47
=head2 new
48

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

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

57
Takes an optional argument C<debug>,
58
the higher the number,
59
the more debugging.
60

61
    use Geo::Coder::List;
62
    use CHI;
63

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

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

72
=cut
9✔
73

9✔
74
sub new
75
{
1✔
76
        my $class = shift;
77
        my $params = Params::Get::get_params(undef, @_) || {};
78

8✔
79
        if(!defined($class)) {
80
                if((scalar keys %{$params}) > 0) {
81
                        # Using Geo::Coder::List::new(), not Geo::Coder::List->new()
×
82
                        carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
×
83
                        return;
84
                }
85

9✔
86
                # FIXME: this only works when no arguments are given
2✔
87
                $class = __PACKAGE__;
88
        } elsif(Scalar::Util::blessed($class)) {
×
89
                # If $class is an object, clone it with new arguments
×
90
                return bless { %{$class}, %{$params} }, ref($class);
91
        }
92

93
        $params = Object::Configure::configure($class, $params);
2✔
94

95
        # Return the blessed object
96
        # Locations is an L1 cache that is always used
2✔
97
        return bless { debug => DEBUG, locations => {}, geocoders => [], log => [], %{$params} }, $class;
98
}
99

100
=head2 push($self, $geocoder)
7✔
101

102
Add an encoder to the list of encoders.
103

104
    use Geo::Coder::List;
105
    use Geo::Coder::GooglePlaces;
106
    # ...
107
    my $list = Geo::Coder::List->new()->push(Geo::Coder::GooglePlaces->new());
108

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

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

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

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

129
=head3 Parameters
130

131
=over 4
132

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

135
Hashref containing a regex and a geocoding object.
×
136

137
=back
×
138

139
=cut
×
140

141
sub push
142
{
143
        my($self, $geocoder) = @_;        # Don't use Params::Get or else the regex will be lost
144

145
        croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless(defined($geocoder));
146

147
        push @{$self->{geocoders}}, $geocoder;
148

149
        return $self;
150
}
151

152
=head2 geocode
153

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

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

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

×
165
=cut
×
166

167
sub geocode {
168
        my $self = shift;
169
        my $params = Params::Get::get_params('location', @_);
×
170

×
171
        my $location = $params->{'location'};
×
172

173
        if((!defined($location)) || (length($location) == 0)) {
174
                Carp::carp(__PACKAGE__, ' usage: geocode(location => $location)');
×
175
                return;
×
176
        }
×
177

178
        # Fail when the input is just a set of numbers
×
179
        if($params->{'location'} !~ /\D/) {
×
180
                Carp::croak('Usage: ', __PACKAGE__, ": invalid input to geocode(), ", $params->{location});
×
181
                return;
×
182
        }
183

×
184
        $location =~ s/\s\s+/ /g;
×
185
        $location = decode_entities($location);
×
186
        print "location: $location\n" if($self->{'debug'});
187

188
        my @call_details = caller(0);
189
        if((!wantarray) && (my $rc = $self->_cache($location))) {
190
                if(ref($rc) eq 'ARRAY') {
191
                        $rc = $rc->[0];
192
                }
193
                if(ref($rc) eq 'HASH') {
×
194
                        $rc->{'geocoder'} = 'cache';
×
195
                        my $log = {
×
196
                                line => $call_details[2],
197
                                location => $location,
198
                                timetaken => 0,
×
199
                                gecoder => 'cache',
×
200
                                wantarray => 0,
×
201
                                result => $rc
×
202
                        };
×
203
                        CORE::push @{$self->{'log'}}, $log;
×
204
                        print __PACKAGE__, ': ', __LINE__,  ": cached\n" if($self->{'debug'});
×
205
                        return $rc;
×
206
                }
207
        }
×
208
        if(defined($self->_cache($location)) && (ref($self->_cache($location)) eq 'ARRAY') && (my @rc = @{$self->_cache($location)})) {
209
                if(scalar(@rc)) {
210
                        my $allempty = 1;
×
211
                        foreach (@rc) {
×
212
                                if(ref($_) eq 'HASH') {
213
                                        if(defined($_->{geometry}{location}{lat})) {
×
214
                                                $allempty = 0;
×
215
                                                $_->{'geocoder'} = 'cache';
216
                                        } else {
217
                                                delete $_->{'geometry'};
×
218
                                        }
219
                                } elsif(ref($_) eq 'Geo::Location::Point') {
220
                                        $allempty = 0;
221
                                        $_->{'geocoder'} = 'cache';
222
                                } else {
223
                                        print STDERR Data::Dumper->new([\@rc])->Dump();
224
                                        Carp::croak(ref($self), " '$location': unexpected item in the cache");
225
                                }
×
226
                        }
×
227
                        my $log = {
×
228
                                line => $call_details[2],
×
229
                                location => $location,
230
                                timetaken => 0,
×
231
                                gecoder => 'cache',
232
                                wantarray => wantarray,
233
                                result => \@rc
234
                        };
235
                        CORE::push @{$self->{'log'}}, $log;
236
                        print __PACKAGE__, ': ', __LINE__,  ": cached\n" if($self->{'debug'});
×
237
                        if($allempty) {
×
238
                                return;
×
239
                        }
×
240
                        return (wantarray) ? @rc : $rc[0];
×
241
                }
×
242
        }
×
243

244
        # my $error;
×
245

246
        ENCODER: foreach my $g(@{$self->{geocoders}}) {
×
247
                my $geocoder = $g;
×
248
                if(ref($geocoder) eq 'HASH') {
×
249
                        if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
×
250
                                print "limit: $limit\n" if($self->{'debug'});
251
                                if($limit <= 0) {
252
                                        next;
×
253
                                }
254
                                $geocoder->{'limit'}--;
×
255
                        }
×
256
                        if(my $regex = $geocoder->{'regex'}) {
×
257
                                print 'consider ', ref($geocoder->{geocoder}), ": $regex\n" if($self->{'debug'});
258
                                if($location !~ $regex) {
259
                                        next;
×
260
                                }
×
261
                        }
×
262
                        $geocoder = $g->{'geocoder'};
×
263
                }
×
264
                my @rc;
265
                my $timetaken = Time::HiRes::time();
×
266
                eval {
267
                        # e.g. over QUERY LIMIT with this one
268
                        # TODO: remove from the list of geocoders
×
269
                        print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
×
270
                        if(ref($geocoder) eq 'Geo::GeoNames') {
271
                                print 'username => ', $geocoder->username(), "\n" if($self->{'debug'});
272
                                die 'lost username' if(!defined($geocoder->username()));
273
                                @rc = $geocoder->geocode($location);
274
                        } else {
275
                                @rc = $geocoder->geocode(%{$params});
276
                        }
277
                };
×
278
                if($@) {
×
279
                        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
                        CORE::push @{$self->{'log'}}, $log;
288
                        Carp::carp(ref($geocoder), " '$location': $@");
289
                        # $error = $@;
290
                        next ENCODER;
291
                }
292
                $timetaken = Time::HiRes::time() - $timetaken;
293
                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
                        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
                        CORE::push @{$self->{'log'}}, $log;
305
                        next ENCODER;
306
                }
307
                if((scalar(@rc) == 0) ||
308
                   ((ref($rc[0]) eq 'HASH') && (scalar(keys %{$rc[0]}) == 0)) ||
×
309
                   ((ref($rc[0]) eq 'ARRAY') && (scalar(keys %{$rc[0][0]}) == 0))) {
×
310
                        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
                        CORE::push @{$self->{'log'}}, $log;
×
319
                        next ENCODER;
320
                }
321
                POSSIBLE_LOCATION: foreach my $l(@rc) {
322
                        if(ref($l) eq 'ARRAY') {
323
                                # Geo::GeoNames
324
                                # FIXME: should consider all locations in the array
325
                                $l = $l->[0];
326
                        }
×
327
                        if((!defined($l)) || ($l eq '')) {
×
328
                                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
                                CORE::push @{$self->{'log'}}, $log;
337
                                next ENCODER;
338
                        }
339
                        $l->{'geocoder'} = ref($geocoder);
340
                        print ref($geocoder), ': ',
341
                                Data::Dumper->new([\$l])->Dump() if($self->{'debug'} >= 2);
×
342
                        last if(ref($l) eq 'Geo::Location::Point');
343
                        next if(ref($l) ne 'HASH');
×
344
                        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
                                        error => $l->{'error'}
352
                                };
353
                                CORE::push @{$self->{'log'}}, $log;
×
354
                                next ENCODER;
×
355
                        } else {
×
356
                                # Try to create a common interface, helps with HTML::GoogleMaps::V3
357
                                if(!defined($l->{geometry}{location}{lat})) {
358
                                        my ($lat, $long);
×
359
                                        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
                                                $lat = $l->{lat};
×
364
                                                $long = $l->{lon};
×
365
                                                $l->{'debug'} = __LINE__;
×
366
                                        } elsif($l->{BestLocation}) {
367
                                                # Bing
368
                                                $lat = $l->{BestLocation}->{Coordinates}->{Latitude};
×
369
                                                $long = $l->{BestLocation}->{Coordinates}->{Longitude};
×
370
                                                $l->{'debug'} = __LINE__;
×
371
                                        } elsif($l->{point}) {
372
                                                # Bing
373
                                                $lat = $l->{point}->{coordinates}[0];
374
                                                $long = $l->{point}->{coordinates}[1];
×
375
                                                $l->{'debug'} = __LINE__;
×
376
                                        } elsif($l->{latt}) {
×
377
                                                # geocoder.ca
×
378
                                                $lat = $l->{latt};
379
                                                $long = $l->{longt};
×
380
                                                $l->{'debug'} = __LINE__;
381
                                        } elsif($l->{latitude}) {
382
                                                # postcodes.io
×
383
                                                # Geo::Coder::Free
×
384
                                                $lat = $l->{latitude};
×
385
                                                $long = $l->{longitude};
386
                                                if(my $type = $l->{'local_type'}) {
×
387
                                                        $l->{'type'} = lcfirst($type);        # e.g. village
388
                                                }
×
389
                                                $l->{'debug'} = __LINE__;
×
390
                                        } elsif($l->{'properties'}{'geoLatitude'}) {
×
391
                                                # ovi
392
                                                $lat = $l->{properties}{geoLatitude};
393
                                                $long = $l->{properties}{geoLongitude};
×
394
                                                $l->{'debug'} = __LINE__;
×
395
                                        } elsif($l->{'results'}[0]->{'geometry'}) {
×
396
                                                if($l->{'results'}[0]->{'geometry'}->{'location'}) {
397
                                                        # DataScienceToolkit
398
                                                        $lat = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'};
399
                                                        $long = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'};
×
400
                                                        $l->{'debug'} = __LINE__;
×
401
                                                } else {
×
402
                                                        # OpenCage
403
                                                        $lat = $l->{'results'}[0]->{'geometry'}->{'lat'};
404
                                                        $long = $l->{'results'}[0]->{'geometry'}->{'lng'};
405
                                                        $l->{'debug'} = __LINE__;
406
                                                }
×
407
                                        } elsif($l->{'RESULTS'}) {
×
408
                                                # GeoCodeFarm
×
409
                                                $lat = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'};
410
                                                $long = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'};
411
                                                $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
                                                $lat = $l->{result}{addressMatches}[0]->{coordinates}{y};
417
                                                $long = $l->{result}{addressMatches}[0]->{coordinates}{x};
×
418
                                                $l->{'debug'} = __LINE__;
×
419
                                        } elsif($l->{lat}) {
×
420
                                                # Geo::GeoNames
421
                                                $lat = $l->{lat};
422
                                                $long = $l->{lng};
×
423
                                                $l->{'debug'} = __LINE__;
×
424
                                        } elsif($l->{features}) {
×
425
                                                if($l->{features}[0]->{center}) {
426
                                                        # Geo::Coder::Mapbox
427
                                                        $lat = $l->{features}[0]->{center}[1];
×
428
                                                        $long = $l->{features}[0]->{center}[0];
429
                                                        $l->{'debug'} = __LINE__;
430
                                                } elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) {
×
431
                                                        # Geo::Coder::GeoApify
432
                                                        $lat = $l->{'features'}[0]{'geometry'}{'coordinates'}[1];
433
                                                        $long = $l->{'features'}[0]{'geometry'}{'coordinates'}[0];
×
434
                                                        $l->{'debug'} = __LINE__;
×
435
                                                } else {
×
436
                                                        # GeoApify doesn't give an error if a location is not found
437
                                                        next ENCODER;
×
438
                                                }
×
439
                                        } else {
440
                                                $l->{'debug'} = __LINE__;
×
441
                                        }
×
442

×
443
                                        if(defined($lat) && defined($long)) {
444
                                                $l->{geometry}{location}{lat} = $lat;
445
                                                $l->{geometry}{location}{lng} = $long;
×
446
                                                # Compatibility
447
                                                $l->{'lat'} = $lat;
×
448
                                                $l->{'lon'} = $long;
449
                                        } else {
450
                                                delete $l->{'geometry'};
×
451
                                                delete $l->{'lat'};
×
452
                                                delete $l->{'lon'};
×
453
                                        }
×
454

×
455
                                        if($l->{'standard'}{'countryname'}) {
×
456
                                                # geocoder.xyz
×
457
                                                $l->{'address'}{'country'} = $l->{'standard'}{'countryname'};
458
                                        }
459
                                }
460
                                if(defined($l->{geometry}{location}{lat})) {
461
                                        print $l->{geometry}{location}{lat}, '/', $l->{geometry}{location}{lng}, "\n" if($self->{'debug'});
462
                                        $l->{geocoder} = $geocoder;
463
                                        $l->{'lat'} //= $l->{geometry}{location}{lat};
464
                                        $l->{'lng'} //= $l->{geometry}{location}{lng};
×
465
                                        $l->{'lon'} //= $l->{geometry}{location}{lng};
×
466
                                        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
                                        CORE::push @{$self->{'log'}}, $log;
×
475
                                        last POSSIBLE_LOCATION;
×
476
                                }
×
477
                        }
×
478
                }
479

×
480
                if(scalar(@rc)) {
481
                        print 'Number of matches from ', ref($geocoder), ': ', scalar(@rc), "\n" if($self->{'debug'});
×
482
                        $Data::Dumper::Maxdepth = 10;
×
483
                        print Data::Dumper->new([\@rc])->Dump() if($self->{'debug'} >= 2);
484
                        if(defined($rc[0])) {        # check it's not an empty hash
×
485
                                if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) {
×
486
                                        $rc[0]->{'lng'} = $rc[0]->{'long'};
×
487
                                }
488
                                if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lon'})) {
×
489
                                        $rc[0]->{'lon'} = $rc[0]->{'long'};
×
490
                                }
491
                                if((!defined($rc[0]->{lat})) || (!defined($rc[0]->{lng}))) {
492
                                        # ::diag(Data::Dumper->new([\@rc])->Dump());
493
                                        warn Data::Dumper->new([\@rc])->Dump();
494
                                        Carp::croak("BUG: '$location': HASH exists but is not sensible");
495
                                }
496
                                if(wantarray) {
497
                                        $self->_cache($location, \@rc);
×
498
                                        return @rc;
×
499
                                }
×
500
                                $self->_cache($location, $rc[0]);
×
501
                                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
        print "No matches\n" if($self->{'debug'});
510
        if(wantarray) {
511
                $self->_cache($location, ());
512
                return ();
513
        }
514
        $self->_cache($location, undef);
515
}
516

517
=head2 ua($self, $ua)
518

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

524
    my $geocoder_list = Geo::Coder::List->new();
×
525
    my $ua = LWP::UserAgent->new();
×
526
    $ua->env_proxy(1);
527
    $geocoder_list->ua($ua);
×
528

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

532
=head3 Parameters
533

×
534
=over 4
535

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

538
Useragent object.
539

540
=back
541

542
=cut
543

544
sub ua
545
{
×
546
        my($self, $ua) = @_;
×
547
        return unless $ua;
548

×
549
        foreach my $g(@{$self->{geocoders}}) {
550
                my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g;
551
                Carp::croak('No geocoder found') unless defined $geocoder;
×
552
                $geocoder->ua($ua);
×
553
        }
×
554

×
555
        return $ua;
×
556
}
557

×
558
=head2 reverse_geocode
×
559

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

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

×
564
=head3 API SPECIFICATION
×
565

566
=head4 INPUT
567

×
568
  {
×
569
    latlng => {
×
570
      type => 'string',
×
571
      matches => qr/^\s*([-+]?(?:\d*\.?\d+|\d+\.?\d*))\s*,\s*([-+]?(?:\d*\.?\d+|\d+\.?\d*))\s*$/        # Two numbers separated by a comma
×
572
  }
×
573

×
574
=head4 OUTPUT
575

×
576
  {
577
    type => 'string'
×
578
  }
579

×
580
=cut
×
581

×
582
sub reverse_geocode {
×
583
        my $self = shift;
×
584
        my $params = Params::Get::get_params('latlng', @_);
×
585

×
586
        my $latlng = $params->{'latlng'}
587
                or Carp::croak('Usage: reverse_geocode(latlng => $location)');
×
588

589
        my ($latitude, $longitude);
590
        if($latlng) {
×
591
                ($latitude, $longitude) = split(/,/, $latlng);
×
592
                $params->{'lat'} //= $latitude;
×
593
                $params->{'lon'} //= $longitude;
×
594
        } else {
×
595
                $latitude //= $params->{'lat'};
×
596
                $longitude //= $params->{'lon'};
597
                $longitude //= $params->{'long'};
×
598
                $latlng = $params->{'latlng'} = "$latitude,$longitude";
×
599
        }
×
600

601
        if(my $rc = $self->_cache($latlng)) {
×
602
                return $rc;
×
603
        }
×
604

605
        foreach my $g(@{$self->{geocoders}}) {
×
606
                my $geocoder = $g;
×
607
                if(ref($geocoder) eq 'HASH') {
608
                        if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
×
609
                                print "limit: $limit\n" if($self->{'debug'});
×
610
                                if($limit <= 0) {
×
611
                                        next;
×
612
                                }
613
                                $geocoder->{'limit'}--;
×
614
                        }
×
615
                        $geocoder = $g->{'geocoder'};
×
616
                }
617
                print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
×
618
                if(wantarray) {
×
619
                        my @rc;
×
620
                        if(my @locs = $geocoder->reverse_geocode(%{$params})) {
621
                                print Data::Dumper->new([\@locs])->Dump() if($self->{'debug'} >= 2);
622
                                foreach my $loc(@locs) {
×
623
                                        if(my $name = $loc->{'display_name'}) {
624
                                                # OSM
625
                                                CORE::push @rc, $name;
×
626
                                        } elsif($loc->{'city'}) {
627
                                                # Geo::Coder::CA
628
                                                my $name;
629
                                                if(my $usa = $loc->{'usa'}) {
×
630
                                                        $name = $usa->{'usstnumber'};
×
631
                                                        if(my $staddress = $usa->{'usstaddress'}) {
×
632
                                                                $name .= ' ' if($name);
×
633
                                                                $name .= $staddress;
×
634
                                                        }
×
635
                                                        if(my $city = $usa->{'uscity'}) {
636
                                                                $name .= ', ' if($name);
×
637
                                                                $name .= $city;
638
                                                        }
×
639
                                                        if(my $state = $usa->{'state'}) {
640
                                                                $name .= ', ' if($name);
×
641
                                                                $name .= $state;
×
642
                                                        }
643
                                                        $name .= ', ' if($name);
×
644
                                                        $name .= 'USA';
×
645
                                                } else {
×
646
                                                        $name = $loc->{'stnumber'};
×
647
                                                        if(my $staddress = $loc->{'staddress'}) {
648
                                                                $name .= ' ' if($name);
×
649
                                                                $name .= $staddress;
×
650
                                                        }
×
651
                                                        if(my $city = $loc->{'city'}) {
652
                                                                $name .= ', ' if($name);
×
653
                                                                $name .= $city;
×
654
                                                        }
×
655
                                                        if(my $state = $loc->{'prov'}) {
656
                                                                $state .= ', ' if($name);
×
657
                                                                $name .= $state;
658
                                                        }
659
                                                }
×
660
                                                CORE::push @rc, $name;
×
661
                                        } elsif($loc->{features}) {
×
662
                                                # Geo::Coder::Apify
×
663
                                                return CORE::push @rc, $loc->{features}[0]->{properties}{formatted};
664
                                        }
×
665
                                }
×
666
                        }
×
667
                        $self->_cache($latlng, \@rc);
668
                        return @rc;
×
669
                } elsif(my $rc = $self->_cache($latlng) // $geocoder->reverse_geocode(%{$params})) {
×
670
                        return $rc if(!ref($rc));
×
671
                        print Data::Dumper->new([$rc])->Dump() if($self->{'debug'} >= 2);
672
                        if(my $name = $rc->{'display_name'}) {
673
                                # OSM
×
674
                                return $self->_cache($latlng, $name);
675
                        }
×
676
                        if($rc->{'city'}) {
677
                                # Geo::Coder::CA
×
678
                                my $name;
679
                                if(my $usa = $rc->{'usa'}) {
680
                                        # TODO: Use Lingua::Conjunction
681
                                        $name = $usa->{'usstnumber'};
×
682
                                        if(my $staddress = $usa->{'usstaddress'}) {
683
                                                $name .= ' ' if($name);
684
                                                $name .= $staddress;
685
                                        }
686
                                        if(my $city = $usa->{'uscity'}) {
687
                                                $name .= ', ' if($name);
688
                                                $name .= $city;
689
                                        }
690
                                        if(my $state = $usa->{'state'}) {
691
                                                $name .= ', ' if($name);
692
                                                $name .= $state;
693
                                        }
694
                                        return $self->_cache($latlng, "$name, USA");
×
695
                                } else {
696
                                        # TODO: Use Lingua::Conjunction
×
697
                                        $name = $rc->{'stnumber'};
698
                                        if(my $staddress = $rc->{'staddress'}) {
699
                                                $name .= ' ' if($name);
700
                                                $name .= $staddress;
701
                                        }
702
                                        if(my $city = $rc->{'city'}) {
703
                                                $name .= ', ' if($name);
704
                                                $name .= $city;
705
                                        }
706
                                        if(my $state = $rc->{'prov'}) {
×
707
                                                $state = ", $state" if($name);
708
                                                return $self->_cache($latlng, "$name $state");
×
709
                                        }
710
                                }
711
                                return $self->_cache($latlng, $name);
712
                        }
×
713
                        if($rc->{features}) {
×
714
                                # Geo::Coder::Apify
715
                                return $self->_cache($latlng, $rc->{features}[0]->{properties}{formatted});
×
716
                        }
717
                }
×
718
        }
×
719
        return;
×
720
}
×
721

×
722
=head2 log
×
723

×
724
Returns an arrayref of the log of events.
×
725

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

×
728
=head3 API SPECIFICATION
729

730
=head4 INPUT
×
731

×
732
None.
733

734
=head4 OUTPUT
×
735

736
  {
737
    type => 'arrayref'
×
738
  }
739

×
740
=cut
741

742
sub log {
743
        my $self = shift;
×
744

745
        return $self->{'log'};
×
746
}
747

748
=head2 flush
×
749

×
750
Clear the log.
×
751

×
752
=cut
753

754
sub flush {
×
755
        my $self = shift;
×
756

757
        delete $self->{'log'};
758
}
759

×
760
sub _cache {
×
761
        my $self = shift;
762
        my $key = shift;
763

×
764
        if(my $value = shift) {
×
765
                # Put something into the cache
766
                $self->{locations}->{$key} = $value;
767
                my $rc = $value;
×
768
                if($self->{'cache'}) {
769
                        my $duration;
×
770
                        if(ref($value) eq 'ARRAY') {
×
771
                                foreach my $item(@{$value}) {
×
772
                                        if(ref($item) eq 'HASH') {
773
                                                $item->{'geocoder'} = ref($item->{'geocoder'});        # It's an object, not the name
×
774
                                                if(!$self->{'debug'}) {
775
                                                        while(my($k, $v) = each %{$item}) {
776
                                                                delete $item->{$k} unless($k eq 'geometry');
×
777
                                                        }
778
                                                }
779
                                                if(!defined($item->{geometry}{location}{lat})) {
780
                                                        if(defined($item->{geometry})) {
×
781
                                                                # Maybe a temporary lookup failure,
×
782
                                                                # so do a research tomorrow
×
783
                                                                $duration = '1 day';
×
784
                                                        } else {
785
                                                                # Probably the place doesn't exist
×
786
                                                                $duration = '1 week';
787
                                                        }
788
                                                        $rc = undef;
×
789
                                                }
×
790
                                        }
×
791
                                }
×
792
                                if(!defined($duration)) {
793
                                        # Has matched - it won't move
×
794
                                        $duration = '1 month';
×
795
                                }
×
796
                        } elsif(ref($value) eq 'HASH') {
797
                                $value->{'geocoder'} = ref($value->{'geocoder'});        # It's an object, not the name
798
                                if(!$self->{'debug'}) {
×
799
                                        while(my($k, $v) = each %{$value}) {
800
                                                delete $value->{$k} unless ($k eq 'geometry');
801
                                        }
802
                                }
803
                                if(defined($value->{geometry}{location}{lat})) {
804
                                        $duration = '1 month';        # It won't move :-)
805
                                } elsif(defined($value->{geometry})) {
806
                                        # Maybe a temporary lookup failure, so do a research
807
                                        # tomorrow
808
                                        $duration = '1 day';
×
809
                                        $rc = undef;
×
810
                                } else {
811
                                        # Probably the place doesn't exist
812
                                        $duration = '1 week';
×
813
                                        $rc = undef;
814
                                }
×
815
                        } else {
×
816
                                $duration = '1 month';
817
                        }
818
                        print Data::Dumper->new([$value])->Dump() if($self->{'debug'});
×
819
                        if(ref($self->{'cache'}) eq 'HASH') {
820
                                $self->{'cache'}->{$key} = $value;
×
821
                        } elsif(!ref($value)) {
822
                                $self->{'cache'}->set($key, $value, $duration);
×
823
                        }
824
                }
×
825
                return $rc;
826
        }
×
827

828
        # Retrieve from the cache
×
829
        my $rc = $self->{'locations'}->{$key};        # In the L1 cache?
830
        if((!defined($rc)) && $self->{'cache'}) {        # In the L2 cache?
×
831
                if(ref($self->{'cache'}) eq 'HASH') {
832
                        $rc = $self->{'cache'}->{$key};
833
                } else {
×
834
                        $rc = $self->{'cache'}->get($key);
835
                }
836
        }
837
        if(defined($rc)) {
838
                if(ref($rc) eq 'HASH') {        # else - it will be an array of hashes
839
                        if(!defined($rc->{geometry}{location}{lat})) {
840
                                return;
841
                        }
842
                        $rc->{'lat'} //= $rc->{geometry}{location}{lat};
843
                        $rc->{'lng'} //= $rc->{geometry}{location}{lng};
844
                        $rc->{'lon'} //= $rc->{geometry}{location}{lng};
845
                }
846
        }
847
        return $rc;
848
}
849

850
=head1 AUTHOR
851

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

854
=head1 BUGS
855

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

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

865
=head1 SEE ALSO
866

867
=over 4
868

869
=item * L<Test Dashboard|https://nigelhorne.github.io/Geo-Coder-List/coverage/>
870

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

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

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

877
=item * L<Object::Configure>
878

879
=back
880

881
=cut
882

883
=head1 SUPPORT
884

885
This module is provided as-is without any warranty.
886

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

889
    perldoc Geo::Coder::List
890

891
You can also look for information at:
892

893
=over 4
894

895
=item * RT: CPAN's request tracker
896

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

899
=item * MetaCPAN
900

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

903
=back
904

905
=head1 LICENSE AND COPYRIGHT
906

907
Copyright 2016-2026 Nigel Horne.
908

909
This program is released under the following licence: GPL2
910

911
=cut
912

913
1;
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc