File Coverage

blib/lib/Geo/Coder/GeocodeFarm.pm
Criterion Covered Total %
statement 72 74 97.3
branch 23 30 76.6
condition 18 30 60.0
subroutine 15 15 100.0
pod 3 3 100.0
total 131 152 86.1


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