File Coverage

blib/lib/Geo/Coder/CA.pm
Criterion Covered Total %
statement 46 84 54.7
branch 8 30 26.6
condition 1 5 20.0
subroutine 11 14 78.5
pod 5 5 100.0
total 71 138 51.4


line stmt bran cond sub pod time code
1             package Geo::Coder::CA;
2              
3             # See also https://geocoding.geo.census.gov/geocoder/Geocoding_Services_API.html for the US for the future
4              
5 5     5   748942 use strict;
  5         50  
  5         140  
6 5     5   25 use warnings;
  5         9  
  5         131  
7              
8 5     5   23 use Carp;
  5         8  
  5         244  
9 5     5   2497 use Encode;
  5         70364  
  5         410  
10 5     5   2232 use JSON::MaybeXS;
  5         26991  
  5         287  
11 5     5   2545 use HTTP::Request;
  5         85676  
  5         162  
12 5     5   3196 use LWP::UserAgent;
  5         137857  
  5         190  
13 5     5   2590 use LWP::Protocol::https;
  5         441101  
  5         213  
14 5     5   39 use URI;
  5         11  
  5         3624  
15              
16             =head1 NAME
17              
18             Geo::Coder::CA - Provides a Geo-Coding functionality using http:://geocoder.ca for both Canada and the US.
19              
20             =head1 VERSION
21              
22             Version 0.13
23              
24             =cut
25              
26             our $VERSION = '0.13';
27              
28             =head1 SYNOPSIS
29              
30             use Geo::Coder::CA;
31              
32             my $geo_coder = Geo::Coder::CA->new();
33             my $location = $geo_coder->geocode(location => '9235 Main St, Richibucto, New Brunswick, Canada');
34              
35             =head1 DESCRIPTION
36              
37             Geo::Coder::CA provides an interface to geocoder.ca. Geo::Coder::Canada no longer seems to work.
38              
39             =head1 METHODS
40              
41             =head2 new
42              
43             $geo_coder = Geo::Coder::CA->new();
44             my $ua = LWP::UserAgent->new();
45             $ua->env_proxy(1);
46             $geo_coder = Geo::Coder::CA->new(ua => $ua);
47              
48             =cut
49              
50             sub new {
51 3     3 1 2528 my($class, %param) = @_;
52              
53 3 100       12 if(!defined($class)) {
54             # Geo::Coder::CA::new() used rather than Geo::Coder::CA->new()
55 1         3 $class = __PACKAGE__;
56             }
57              
58 3         5 my $ua = $param{ua};
59 3 50       10 if(!defined($ua)) {
60 3         29 $ua = LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
61 3         5759 $ua->default_header(accept_encoding => 'gzip,deflate');
62             }
63 3   50     177 my $host = $param{host} || 'geocoder.ca';
64              
65 3         35 return bless { ua => $ua, host => $host }, $class;
66             }
67              
68             =head2 geocode
69              
70             $location = $geo_coder->geocode(location => $location);
71             # @location = $geo_coder->geocode(location => $location);
72              
73             print 'Latitude: ', $location->{'latt'}, "\n";
74             print 'Longitude: ', $location->{'longt'}, "\n";
75              
76             =cut
77              
78             sub geocode {
79 3     3 1 1282 my $self = shift;
80 3         4 my %param;
81              
82 3 100       15 if(ref($_[0]) eq 'HASH') {
    50          
    50          
83 1         1 %param = %{$_[0]};
  1         4  
84             } elsif(ref($_[0])) {
85 0         0 Carp::croak('Usage: geocode(location => $location)');
86 0         0 return;
87             } elsif(@_ % 2 == 0) {
88 2         6 %param = @_;
89             } else {
90 0         0 $param{location} = shift;
91             }
92              
93 3         6 my $location = $param{location};
94 3 50       8 if(!defined($location)) {
95 3         15 Carp::croak('Usage: geocode(location => $location)');
96 2         660 return;
97             }
98              
99 0 0         if (Encode::is_utf8($location)) {
100 0           $location = Encode::encode_utf8($location);
101             }
102              
103 0           my $uri = URI->new("https://$self->{host}/some_location");
104 0           $location =~ s/\s/+/g;
105 0           my %query_parameters = ('locate' => $location, 'json' => 1, 'strictmode' => 1);
106 0           $uri->query_form(%query_parameters);
107 0           my $url = $uri->as_string();
108              
109 0           my $res = $self->{ua}->get($url);
110              
111 0 0         if($res->is_error()) {
112 0           Carp::croak("$url API returned error: ", $res->status_line());
113 0           return;
114             }
115             # $res->content_type('text/plain'); # May be needed to decode correctly
116              
117 0           my $json = JSON::MaybeXS->new()->utf8();
118 0 0         if(my $rc = $json->decode($res->decoded_content())) {
119 0 0         if($rc->{'error'}) {
120             # Sorry - you lose the error code, but HTML::GoogleMaps::V3 relies on this
121             # TODO - send patch to the H:G:V3 author
122 0           return;
123             }
124 0 0 0       if(defined($rc->{'latt'}) && defined($rc->{'longt'})) {
125 0           return $rc; # No support for list context, yet
126             }
127              
128             # if($location =~ /^(\w+),\+*(\w+),\+*(USA|US|United States)$/i) {
129             # $query_parameters{'locate'} = "$1 County, $2, $3";
130             # $uri->query_form(%query_parameters);
131             # $url = $uri->as_string();
132             #
133             # $res = $self->{ua}->get($url);
134             #
135             # if($res->is_error()) {
136             # Carp::croak("geocoder.ca API returned error: " . $res->status_line());
137             # return;
138             # }
139             # return $json->decode($res->content());
140             # }
141             }
142              
143             # my @results = @{ $data || [] };
144             # wantarray ? @results : $results[0];
145             }
146              
147             =head2 ua
148              
149             Accessor method to get and set UserAgent object used internally. You
150             can call I for example, to get the proxy information from
151             environment variables:
152              
153             $geo_coder->ua()->env_proxy(1);
154              
155             You can also set your own User-Agent object:
156              
157             my $ua = LWP::UserAgent::Throttled->new();
158             $ua->throttle('geocoder.ca' => 1);
159             $geo_coder->ua($ua);
160              
161             =cut
162              
163             sub ua {
164 0     0 1   my $self = shift;
165 0 0         if (@_) {
166 0           $self->{ua} = shift;
167             }
168 0           $self->{ua};
169             }
170              
171             =head2 reverse_geocode
172              
173             $location = $geo_coder->reverse_geocode(latlng => '37.778907,-122.39732');
174              
175             Similar to geocode except it expects a latitude/longitude parameter.
176              
177             =cut
178              
179             sub reverse_geocode {
180 0     0 1   my $self = shift;
181              
182 0           my %param;
183 0 0         if (@_ % 2 == 0) {
184 0           %param = @_;
185             } else {
186 0           $param{latlng} = shift;
187             }
188              
189             my $latlng = $param{latlng}
190 0 0         or Carp::croak('Usage: reverse_geocode(latlng => $latlng)');
191              
192 0           return $self->geocode(location => $latlng, reverse => 1);
193             }
194              
195             =head2 run
196              
197             You can also run this module from the command line:
198              
199             perl CA.pm 1600 Pennsylvania Avenue NW, Washington DC
200              
201             =cut
202              
203             __PACKAGE__->run(@ARGV) unless caller();
204              
205             sub run {
206 0     0 1   require Data::Dumper;
207              
208 0           my $class = shift;
209              
210 0           my $location = join(' ', @_);
211              
212 0           my @rc = $class->new()->geocode($location);
213              
214 0 0         if(scalar(@rc)) {
215 0           print Data::Dumper->new([\@rc])->Dump();
216             } else {
217 0           die "$0: geo-coding failed";
218             }
219             }
220              
221             =head1 AUTHOR
222              
223             Nigel Horne
224              
225             Based on L.
226              
227             This library is free software; you can redistribute it and/or modify
228             it under the same terms as Perl itself.
229              
230             Lots of thanks to the folks at geocoder.ca.
231              
232             =head1 BUGS
233              
234             Should be called Geo::Coder::NA for North America.
235              
236             =head1 SEE ALSO
237              
238             L, L
239              
240             =head1 LICENSE AND COPYRIGHT
241              
242             Copyright 2017-2022 Nigel Horne.
243              
244             This program is released under the following licence: GPL2
245              
246             =cut
247              
248             1;