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

nigelhorne / Geo-Coder-List / 17216054822

25 Aug 2025 05:33PM UTC coverage: 38.44% (+0.5%) from 37.921%
17216054822

push

github

138 of 359 relevant lines covered (38.44%)

2.06 hits per line

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

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

3
use 5.10.1;
20✔
4

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

14
use constant DEBUG => 0;        # Default debugging level
20✔
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,
70
see L<Object::Configure>.
71

72
=cut
73

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

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

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

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

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

100
=head2 push($self, $geocoder)
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

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

135
Hashref containing a regex and a geocoding object.
6✔
136

137
=back
6✔
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

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

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

165
=cut
166

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

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

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

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

1✔
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];
1✔
192
                }
1✔
193
                if(ref($rc) eq 'HASH') {
1✔
194
                        $rc->{'geocoder'} = 'cache';
195
                        my $log = {
196
                                line => $call_details[2],
5✔
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
                        };
5✔
235
                        CORE::push @{$self->{'log'}}, $log;
6✔
236
                        print __PACKAGE__, ': ', __LINE__,  ": cached\n" if($self->{'debug'});
6✔
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;
6✔
253
                                }
6✔
254
                                $geocoder->{'limit'}--;
6✔
255
                        }
256
                        if(my $regex = $geocoder->{'regex'}) {
257
                                print 'consider ', ref($geocoder->{geocoder}), ": $regex\n" if($self->{'debug'});
6✔
258
                                if($location !~ $regex) {
6✔
259
                                        next;
×
260
                                }
×
261
                        }
×
262
                        $geocoder = $g->{'geocoder'};
263
                }
6✔
264
                my @rc;
265
                my $timetaken = Time::HiRes::time();
266
                eval {
6✔
267
                        # e.g. over QUERY LIMIT with this one
1✔
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});
1✔
276
                        }
1✔
277
                };
278
                if($@) {
1✔
279
                        my $log = {
280
                                line => $call_details[2],
5✔
281
                                location => $location,
5✔
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
5✔
296
                        my $log = {
3✔
297
                                line => $call_details[2],
1✔
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))) {
5✔
310
                        my $log = {
5✔
311
                                line => $call_details[2],
312
                                location => $location,
313
                                timetaken => $timetaken,
1✔
314
                                geocoder => ref($geocoder),
315
                                wantarray => wantarray,
5✔
316
                                result => 'not found',
1✔
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
1✔
325
                                $l = $l->[0];
1✔
326
                        }
327
                        if((!defined($l)) || ($l eq '')) {
4✔
328
                                my $log = {
329
                                        line => $call_details[2],
4✔
330
                                        location => $location,
4✔
331
                                        timetaken => $timetaken,
4✔
332
                                        geocoder => ref($geocoder),
4✔
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 = {
4✔
346
                                        line => $call_details[2],
3✔
347
                                        location => $location,
3✔
348
                                        timetaken => $timetaken,
349
                                        geocoder => ref($geocoder),
350
                                        wantarray => wantarray,
351
                                        error => $l->{'error'}
3✔
352
                                };
3✔
353
                                CORE::push @{$self->{'log'}}, $log;
3✔
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
3✔
432
                                                        $lat = $l->{'features'}[0]{'geometry'}{'coordinates'}[1];
3✔
433
                                                        $long = $l->{'features'}[0]{'geometry'}{'coordinates'}[0];
3✔
434
                                                        $l->{'debug'} = __LINE__;
435
                                                } else {
3✔
436
                                                        # GeoApify doesn't give an error if a location is not found
3✔
437
                                                        next ENCODER;
438
                                                }
×
439
                                        } else {
×
440
                                                $l->{'debug'} = __LINE__;
×
441
                                        }
442

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

4✔
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;
4✔
463
                                        $l->{'lat'} //= $l->{geometry}{location}{lat};
4✔
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,
4✔
470
                                                geocoder => ref($geocoder),
4✔
471
                                                wantarray => wantarray,
4✔
472
                                                result => $l
4✔
473
                                        };
4✔
474
                                        CORE::push @{$self->{'log'}}, $log;
4✔
475
                                        last POSSIBLE_LOCATION;
×
476
                                }
477
                        }
4✔
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;
4✔
483
                        print Data::Dumper->new([\@rc])->Dump() if($self->{'debug'} >= 2);
1✔
484
                        if(defined($rc[0])) {        # check it's not an empty hash
1✔
485
                                if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) {
486
                                        $rc[0]->{'lng'} = $rc[0]->{'long'};
3✔
487
                                }
3✔
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
                                }
1✔
496
                                if(wantarray) {
1✔
497
                                        $self->_cache($location, \@rc);
×
498
                                        return @rc;
×
499
                                }
500
                                $self->_cache($location, $rc[0]);
1✔
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
=cut
565

×
566
sub reverse_geocode {
×
567
        my $self = shift;
×
568
        my $params = Params::Get::get_params('latlng', @_);
×
569

×
570
        my $latlng = $params->{'latlng'}
×
571
                or Carp::croak('Usage: reverse_geocode(latlng => $location)');
×
572

573
        my ($latitude, $longitude);
×
574
        if($latlng) {
575
                ($latitude, $longitude) = split(/,/, $latlng);
×
576
                $params->{'lat'} //= $latitude;
577
                $params->{'lon'} //= $longitude;
×
578
        } else {
×
579
                $latitude //= $params->{'lat'};
×
580
                $longitude //= $params->{'lon'};
×
581
                $longitude //= $params->{'long'};
×
582
                $latlng = $params->{'latlng'} = "$latitude,$longitude";
×
583
        }
×
584

585
        if(my $rc = $self->_cache($latlng)) {
×
586
                return $rc;
587
        }
588

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

706
=head2 log
×
707

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

15✔
711
    my @log = @{$geocoderlist->log()};
15✔
712

713
=cut
15✔
714

715
sub log {
4✔
716
        my $self = shift;
4✔
717

4✔
718
        return $self->{'log'};
1✔
719
}
1✔
720

×
721
=head2 flush
×
722

×
723
Clear the log.
×
724

×
725
=cut
×
726

727
sub flush {
728
        my $self = shift;
×
729

×
730
        delete $self->{'log'};
731
}
732

×
733
sub _cache {
734
        my $self = shift;
735
        my $key = shift;
×
736

737
        if(my $value = shift) {
×
738
                # Put something into the cache
739
                $self->{locations}->{$key} = $value;
740
                my $rc = $value;
741
                if($self->{'cache'}) {
×
742
                        my $duration;
743
                        if(ref($value) eq 'ARRAY') {
×
744
                                foreach my $item(@{$value}) {
745
                                        if(ref($item) eq 'HASH') {
746
                                                $item->{'geocoder'} = ref($item->{'geocoder'});        # It's an object, not the name
1✔
747
                                                if(!$self->{'debug'}) {
1✔
748
                                                        while(my($k, $v) = each %{$item}) {
1✔
749
                                                                delete $item->{$k} unless($k eq 'geometry');
7✔
750
                                                        }
751
                                                }
752
                                                if(!defined($item->{geometry}{location}{lat})) {
1✔
753
                                                        if(defined($item->{geometry})) {
1✔
754
                                                                # Maybe a temporary lookup failure,
755
                                                                # so do a research tomorrow
756
                                                                $duration = '1 day';
757
                                                        } else {
×
758
                                                                # Probably the place doesn't exist
×
759
                                                                $duration = '1 week';
760
                                                        }
761
                                                        $rc = undef;
×
762
                                                }
×
763
                                        }
764
                                }
765
                                if(!defined($duration)) {
×
766
                                        # Has matched - it won't move
767
                                        $duration = '1 month';
1✔
768
                                }
1✔
769
                        } elsif(ref($value) eq 'HASH') {
1✔
770
                                $value->{'geocoder'} = ref($value->{'geocoder'});        # It's an object, not the name
771
                                if(!$self->{'debug'}) {
×
772
                                        while(my($k, $v) = each %{$value}) {
773
                                                delete $value->{$k} unless ($k eq 'geometry');
774
                                        }
4✔
775
                                }
776
                                if(defined($value->{geometry}{location}{lat})) {
777
                                        $duration = '1 month';        # It won't move :-)
778
                                } elsif(defined($value->{geometry})) {
11✔
779
                                        # Maybe a temporary lookup failure, so do a research
11✔
780
                                        # tomorrow
2✔
781
                                        $duration = '1 day';
2✔
782
                                        $rc = undef;
783
                                } else {
×
784
                                        # Probably the place doesn't exist
785
                                        $duration = '1 week';
786
                                        $rc = undef;
11✔
787
                                }
1✔
788
                        } else {
1✔
789
                                $duration = '1 month';
×
790
                        }
791
                        print Data::Dumper->new([$value])->Dump() if($self->{'debug'});
1✔
792
                        if(ref($self->{'cache'}) eq 'HASH') {
1✔
793
                                $self->{'cache'}->{$key} = $value;
1✔
794
                        } elsif(!ref($value)) {
795
                                $self->{'cache'}->set($key, $value, $duration);
796
                        }
11✔
797
                }
798
                return $rc;
799
        }
800

801
        # Retrieve from the cache
802
        my $rc = $self->{'locations'}->{$key};        # In the L1 cache?
803
        if((!defined($rc)) && $self->{'cache'}) {        # In the L2 cache?
804
                if(ref($self->{'cache'}) eq 'HASH') {
805
                        $rc = $self->{'cache'}->{$key};
806
                } else {
807
                        $rc = $self->{'cache'}->get($key);
808
                }
809
        }
810
        if(defined($rc)) {
811
                if(ref($rc) eq 'HASH') {        # else - it will be an array of hashes
812
                        if(!defined($rc->{geometry}{location}{lat})) {
813
                                return;
814
                        }
815
                        $rc->{'lat'} //= $rc->{geometry}{location}{lat};
816
                        $rc->{'lng'} //= $rc->{geometry}{location}{lng};
817
                        $rc->{'lon'} //= $rc->{geometry}{location}{lng};
818
                }
819
        }
820
        return $rc;
821
}
822

823
=head1 AUTHOR
824

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

827
=head1 BUGS
828

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

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

838
=head1 SEE ALSO
839

840
=over 4
841

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

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

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

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

850
=item * L<Object::Configure>
851

852
=back
853

854
=cut
855

856
=head1 SUPPORT
857

858
This module is provided as-is without any warranty.
859

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

862
    perldoc Geo::Coder::List
863

864
You can also look for information at:
865

866
=over 4
867

868
=item * RT: CPAN's request tracker
869

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

872
=item * MetaCPAN
873

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

876
=back
877

878
=head1 LICENSE AND COPYRIGHT
879

880
Copyright 2016-2026 Nigel Horne.
881

882
This program is released under the following licence: GPL2
883

884
=cut
885

886
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