| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Geo::Coder::GeocodeFarm; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Geo::Coder::GeocodeFarm - Geocode addresses with the GeocodeFarm API |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=for markdown ```perl |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Geo::Coder::GeocodeFarm; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $geocoder = Geo::Coder::GeocodeFarm->new( |
|
14
|
|
|
|
|
|
|
key => 'YOUR-API-KEY-HERE', |
|
15
|
|
|
|
|
|
|
); |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $result = $geocoder->geocode( |
|
18
|
|
|
|
|
|
|
location => '530 W Main St Anoka MN 55303 US', |
|
19
|
|
|
|
|
|
|
); |
|
20
|
|
|
|
|
|
|
printf "%f,%f\n", |
|
21
|
|
|
|
|
|
|
$result->{coordinates}{lat}, |
|
22
|
|
|
|
|
|
|
$result->{coordinates}{lon}; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $reverse = $geocoder->reverse_geocode( |
|
25
|
|
|
|
|
|
|
lat => '45.2040305', |
|
26
|
|
|
|
|
|
|
lon => '-93.3995728', |
|
27
|
|
|
|
|
|
|
); |
|
28
|
|
|
|
|
|
|
print $reverse->{formatted_address}, "\n"; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=for markdown ``` |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
The C module provides an interface to the geocoding |
|
35
|
|
|
|
|
|
|
functionality of the GeocodeFarm API v4. |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=cut |
|
38
|
|
|
|
|
|
|
|
|
39
|
6
|
|
|
6
|
|
953275
|
use 5.008_001; |
|
|
6
|
|
|
|
|
28
|
|
|
40
|
6
|
|
|
6
|
|
37
|
use strict; |
|
|
6
|
|
|
|
|
13
|
|
|
|
6
|
|
|
|
|
238
|
|
|
41
|
6
|
|
|
6
|
|
36
|
use warnings; |
|
|
6
|
|
|
|
|
11
|
|
|
|
6
|
|
|
|
|
554
|
|
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our $VERSION = '0.0500'; |
|
44
|
|
|
|
|
|
|
|
|
45
|
6
|
|
|
6
|
|
73
|
use Carp qw(croak); |
|
|
6
|
|
|
|
|
37
|
|
|
|
6
|
|
|
|
|
441
|
|
|
46
|
6
|
|
|
6
|
|
3944
|
use Encode; |
|
|
6
|
|
|
|
|
150808
|
|
|
|
6
|
|
|
|
|
1142
|
|
|
47
|
6
|
|
|
6
|
|
5307
|
use HTTP::Tiny; |
|
|
6
|
|
|
|
|
442107
|
|
|
|
6
|
|
|
|
|
391
|
|
|
48
|
6
|
|
|
6
|
|
4797
|
use URI; |
|
|
6
|
|
|
|
|
50553
|
|
|
|
6
|
|
|
|
|
290
|
|
|
49
|
6
|
|
|
6
|
|
3274
|
use URI::QueryParam; |
|
|
6
|
|
|
|
|
1005
|
|
|
|
6
|
|
|
|
|
227
|
|
|
50
|
6
|
|
|
6
|
|
4434
|
use JSON; |
|
|
6
|
|
|
|
|
83353
|
|
|
|
6
|
|
|
|
|
47
|
|
|
51
|
6
|
|
|
6
|
|
1096
|
use Scalar::Util qw(blessed); |
|
|
6
|
|
|
|
|
14
|
|
|
|
6
|
|
|
|
|
568
|
|
|
52
|
|
|
|
|
|
|
|
|
53
|
6
|
|
|
6
|
|
47
|
use constant DEBUG => !!$ENV{PERL_GEO_CODER_GEOCODEFARM_DEBUG}; |
|
|
6
|
|
|
|
|
13
|
|
|
|
6
|
|
|
|
|
6401
|
|
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 METHODS |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head2 new |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=for markdown ```perl |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
$geocoder = Geo::Coder::GeocodeFarm->new( |
|
62
|
|
|
|
|
|
|
key => 'YOUR-API-KEY-HERE', |
|
63
|
|
|
|
|
|
|
url => 'https://api.geocode.farm/', |
|
64
|
|
|
|
|
|
|
ua => HTTP::Tiny->new, |
|
65
|
|
|
|
|
|
|
parser => JSON->new->utf8, |
|
66
|
|
|
|
|
|
|
raise_failure => 1, |
|
67
|
|
|
|
|
|
|
); |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=for markdown ``` |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Creates a new geocoding object with optional arguments. |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
An API key is required and can be obtained at |
|
74
|
|
|
|
|
|
|
L |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub new { |
|
79
|
9
|
|
|
9
|
1
|
1394417
|
my ($class, %args) = @_; |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $self = bless +{ |
|
82
|
|
|
|
|
|
|
ua => $args{ua} || HTTP::Tiny->new( |
|
83
|
|
|
|
|
|
|
agent => __PACKAGE__ . "/$VERSION", |
|
84
|
|
|
|
|
|
|
), |
|
85
|
|
|
|
|
|
|
url => $args{url} || 'https://api.geocode.farm/', |
|
86
|
|
|
|
|
|
|
parser => $args{parser} || JSON->new->utf8, |
|
87
|
9
|
100
|
33
|
|
|
426
|
raise_failure => defined $args{raise_failure} ? $args{raise_failure} : 1, |
|
|
|
|
50
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
88
|
|
|
|
|
|
|
%args, |
|
89
|
|
|
|
|
|
|
} => $class; |
|
90
|
|
|
|
|
|
|
|
|
91
|
9
|
50
|
|
|
|
55
|
croak "API key is required" unless $self->{key}; |
|
92
|
|
|
|
|
|
|
|
|
93
|
9
|
|
|
|
|
42
|
return $self; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 geocode |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=for markdown ```perl |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
$result = $geocoder->geocode( |
|
101
|
|
|
|
|
|
|
location => $location, |
|
102
|
|
|
|
|
|
|
) |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=for markdown ``` |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Forward geocoding takes a provided address or location and returns the |
|
107
|
|
|
|
|
|
|
coordinate set for the requested location. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Method throws an error (or returns failure as nested list if raise_failure |
|
110
|
|
|
|
|
|
|
argument is false) if the service failed to find coordinates or wrong key was |
|
111
|
|
|
|
|
|
|
used. |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=cut |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub geocode { |
|
116
|
5
|
|
|
5
|
1
|
5833
|
my ($self, %args) = @_; |
|
117
|
5
|
|
66
|
|
|
47
|
my $addr = $args{location} || croak "Attribute (location) is required"; |
|
118
|
4
|
|
|
|
|
22
|
my $results = $self->_request('forward', addr => $addr); |
|
119
|
3
|
|
|
|
|
21
|
return $results->{result}; # Adjust based on actual API response structure |
|
120
|
|
|
|
|
|
|
} |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 reverse_geocode |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=for markdown ```perl |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
$result = $geocoder->reverse_geocode( |
|
127
|
|
|
|
|
|
|
lat => $latitude, |
|
128
|
|
|
|
|
|
|
lon => $longitude, |
|
129
|
|
|
|
|
|
|
) |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=for markdown ``` |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Reverse geocoding takes a provided coordinate set and returns the address for |
|
134
|
|
|
|
|
|
|
the requested coordinates. |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Method throws an error (or returns failure as nested list if raise_failure |
|
137
|
|
|
|
|
|
|
argument is false) if the service failed to find coordinates or wrong key was |
|
138
|
|
|
|
|
|
|
used. |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub reverse_geocode { |
|
143
|
4
|
|
|
4
|
1
|
10820
|
my ($self, %args) = @_; |
|
144
|
4
|
100
|
|
|
|
38
|
my $lat = defined $args{lat} ? $args{lat} : croak "Attribute (lat) is required"; |
|
145
|
3
|
50
|
|
|
|
14
|
my $lon = defined $args{lon} ? $args{lon} : croak "Attribute (lon) is required"; |
|
146
|
3
|
|
|
|
|
25
|
my $results = $self->_request('reverse', lat => $lat, lon => $lon); |
|
147
|
2
|
100
|
66
|
|
|
42
|
return unless $results->{result}{"0"} and $results->{result}{accuracy}; |
|
148
|
1
|
|
|
|
|
2
|
my %result = %{ $results->{result}{"0"} }; |
|
|
1
|
|
|
|
|
10
|
|
|
149
|
1
|
|
|
|
|
6
|
$result{accuracy} = $results->{result}{accuracy}; |
|
150
|
1
|
|
|
|
|
10
|
return \%result; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub _request { |
|
154
|
7
|
|
|
7
|
|
67
|
my ($self, $type, %args) = @_; |
|
155
|
|
|
|
|
|
|
|
|
156
|
7
|
100
|
|
|
|
128
|
my $url = URI->new_abs($type eq 'forward' ? 'forward/' : 'reverse/', $self->{url}); |
|
157
|
|
|
|
|
|
|
|
|
158
|
7
|
100
|
|
|
|
93470
|
if ($type eq 'forward') { |
|
|
|
50
|
|
|
|
|
|
|
159
|
4
|
|
|
|
|
50
|
$url->query_param_append(addr => $args{addr}); |
|
160
|
|
|
|
|
|
|
} elsif ($type eq 'reverse') { |
|
161
|
3
|
|
|
|
|
53
|
$url->query_param_append(lat => $args{lat}); |
|
162
|
3
|
|
|
|
|
535
|
$url->query_param_append(lon => $args{lon}); |
|
163
|
|
|
|
|
|
|
} else { |
|
164
|
0
|
|
|
|
|
0
|
croak "Unknown type for request"; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
7
|
|
|
|
|
1269
|
$url->query_param_append(key => $self->{key}); |
|
168
|
7
|
|
|
|
|
1522
|
warn $url if DEBUG; |
|
169
|
|
|
|
|
|
|
|
|
170
|
7
|
|
|
|
|
58
|
my $res = $self->{ua}->get($url); |
|
171
|
|
|
|
|
|
|
|
|
172
|
7
|
|
|
|
|
194
|
my $content = do { |
|
173
|
7
|
100
|
66
|
|
|
86
|
if (blessed $res and $res->isa('HTTP::Response')) { |
|
|
|
50
|
|
|
|
|
|
|
174
|
3
|
100
|
100
|
|
|
25
|
croak $res->status_line if $self->{raise_failure} and not $res->is_success; |
|
175
|
2
|
|
|
|
|
16
|
$res->decoded_content; |
|
176
|
|
|
|
|
|
|
} elsif (ref $res eq 'HASH') { |
|
177
|
4
|
100
|
100
|
|
|
67
|
croak "@{[$res->{status}, $res->{reason}]}" if $self->{raise_failure} and not $res->{success}; |
|
|
1
|
|
|
|
|
33
|
|
|
178
|
3
|
|
|
|
|
10
|
$res->{content}; |
|
179
|
|
|
|
|
|
|
} else { |
|
180
|
0
|
|
|
|
|
0
|
croak "Wrong response $res"; |
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
}; |
|
183
|
|
|
|
|
|
|
|
|
184
|
5
|
|
|
|
|
21
|
warn $content if DEBUG; |
|
185
|
5
|
50
|
|
|
|
21
|
return unless $content; |
|
186
|
|
|
|
|
|
|
|
|
187
|
5
|
|
|
|
|
15
|
my $data = eval { $self->{parser}->decode(Encode::encode_utf8($content)) }; |
|
|
5
|
|
|
|
|
329
|
|
|
188
|
5
|
50
|
|
|
|
67
|
croak $@ if $@; |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
croak "GeocodeFarm API returned status: ", $data->{STATUS}{status} || 'unknown' |
|
191
|
5
|
50
|
0
|
|
|
50
|
if ($self->{raise_failure} and ($data->{STATUS}{status} || '') ne 'SUCCESS'); |
|
|
|
|
50
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
|
193
|
5
|
|
|
|
|
58
|
return $data->{RESULTS}; |
|
194
|
|
|
|
|
|
|
} |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
1; |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
L |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 BUGS |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
If you find the bug or want to implement new features, please report it at |
|
205
|
|
|
|
|
|
|
L |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
The code repository is available at |
|
208
|
|
|
|
|
|
|
L |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head1 AUTHOR |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Piotr Roszatycki |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 LICENSE |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Copyright (c) 2013, 2015, 2025 Piotr Roszatycki . |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
|
219
|
|
|
|
|
|
|
the same terms as perl itself. |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
See L |