File Coverage

blib/lib/Geo/Coder/GooglePlaces/V3.pm
Criterion Covered Total %
statement 46 116 39.6
branch 5 44 11.3
condition 8 28 28.5
subroutine 10 17 58.8
pod 5 5 100.0
total 74 210 35.2


line stmt bran cond sub pod time code
1             package Geo::Coder::GooglePlaces::V3;
2              
3 4     4   25 use strict;
  4         7  
  4         109  
4 4     4   18 use warnings;
  4         15  
  4         88  
5              
6 4     4   19 use Carp;
  4         5  
  4         226  
7 4     4   1564 use Encode;
  4         43233  
  4         321  
8 4     4   2539 use JSON;
  4         44065  
  4         24  
9 4     4   2210 use HTTP::Request;
  4         65603  
  4         131  
10 4     4   2753 use LWP::UserAgent;
  4         98702  
  4         159  
11 4     4   33 use URI;
  4         24  
  4         4521  
12              
13             my @ALLOWED_FILTERS = qw/route locality administrative_area postal_code country/;
14              
15             =head1 NAME
16              
17             Geo::Coder::GooglePlaces::V3 - Google Places Geocoding API V3
18              
19             =head1 VERSION
20              
21             Version 0.04
22              
23             =cut
24              
25             our $VERSION = '0.04';
26              
27             =head1 SYNOPSIS
28              
29             use Geo::Coder::GooglePlaces;
30              
31             my $geocoder = Geo::Coder::GooglePlaces->new();
32             my $location = $geocoder->geocode(location => 'Hollywood and Highland, Los Angeles, CA');
33              
34             =head1 DESCRIPTION
35              
36             Geo::Coder::GooglePlaces::V3 provides a geocoding functionality using Google Places API V3.
37              
38             =head1 SUBROUTINES/METHODS
39              
40             =head2 new
41              
42             $geocoder = Geo::Coder::GooglePlaces->new();
43             $geocoder = Geo::Coder::GooglePlaces->new(language => 'ru');
44             $geocoder = Geo::Coder::GooglePlaces->new(gl => 'ca');
45             $geocoder = Geo::Coder::GooglePlaces->new(oe => 'latin1');
46              
47             To specify the language of Google's response add C parameter
48             with a two-letter value. Note that adding that parameter does not
49             guarantee that every request returns translated data.
50              
51             You can also set C parameter to set country code (e.g. I for Canada).
52              
53             You can ask for a character encoding other than utf-8 by setting the I
54             parameter, but this is not recommended.
55              
56             You can optionally use your Places Premier Client ID, by passing your client
57             code as the C parameter and your private key as the C parameter.
58             The URL signing for Premier Client IDs requires the I
59             and I modules. To test your client, set the environment
60             variables GMAP_CLIENT and GMAP_KEY before running v3_live.t
61              
62             GMAP_CLIENT=your_id GMAP_KEY='your_key' make test
63              
64             You can get a key from https://console.developers.google.com/apis/credentials.
65              
66             =cut
67              
68             sub new {
69 9     9 1 21 my($class, %param) = @_;
70              
71 9   33     65 my $ua = delete $param{ua} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
72 9   50     6956 my $host = delete $param{host} || 'maps.googleapis.com';
73              
74 9   33     42 my $language = delete $param{language} || delete $param{hl};
75 9   33     25 my $region = delete $param{region} || delete $param{gl};
76 9   50     27 my $oe = delete $param{oe} || 'utf8';
77 9   50     23 my $sensor = delete $param{sensor} || 0;
78 9   50     29 my $client = delete $param{client} || '';
79 9   50     28 my $key = delete $param{key} || '';
80 9         13 my $components = delete $param{components};
81              
82 9         73 bless {
83             ua => $ua, host => $host, language => $language,
84             region => $region, oe => $oe, sensor => $sensor,
85             client => $client, key => $key,
86             components => $components,
87             }, $class;
88             }
89              
90             =head2 geocode
91              
92             $location = $geocoder->geocode(location => $location);
93             @location = $geocoder->geocode(location => $location);
94              
95             Queries I<$location> to Google Places geocoding API and returns hash
96             reference returned back from API server. When you cann the method in
97             an array context, it returns all the candidates got back, while it
98             returns the 1st one in a scalar context.
99              
100             When you'd like to pass non-ASCII string as a location, you should
101             pass it as either UTF-8 bytes or Unicode flagged string.
102              
103             =cut
104              
105             sub geocode {
106 0     0 1 0 my $self = shift;
107              
108 0         0 my %param;
109 0 0       0 if (@_ % 2 == 0) {
110 0         0 %param = @_;
111             } else {
112 0         0 $param{location} = shift;
113             }
114              
115             my $location = $param{location}
116 0 0       0 or Carp::croak("Usage: geocode(location => \$location)");
117              
118 0 0       0 if (Encode::is_utf8($location)) {
119 0         0 $location = Encode::encode_utf8($location);
120             }
121              
122 0 0       0 my $loc_param = $param{reverse} ? 'latlng' : 'query';
123              
124 0         0 my $uri = URI->new("https://$self->{host}/maps/api/place/textsearch/json");
125 0         0 my %query_parameters = ($loc_param => $location);
126 0 0       0 $query_parameters{language} = $self->{language} if defined $self->{language};
127 0 0       0 $query_parameters{region} = $self->{region} if defined $self->{region};
128 0         0 $query_parameters{oe} = $self->{oe};
129 0 0       0 $query_parameters{sensor} = $self->{sensor} ? 'true' : 'false';
130 0         0 my $components_params = $self->_get_components_query_params;
131 0 0       0 $query_parameters{components} = $components_params if defined $components_params;
132 0 0 0     0 $query_parameters{key} = $self->{key} if(defined($self->{key}) && (length $self->{key}));
133 0         0 $uri->query_form(%query_parameters);
134 0         0 my $url = $uri->as_string;
135              
136             # Process Places Premier account info
137 0 0 0     0 if ($self->{client} and $self->{key}) {
138 0         0 delete $query_parameters{key};
139 0         0 $query_parameters{client} = $self->{client};
140 0         0 $uri->query_form(%query_parameters);
141              
142 0         0 my $signature = $self->_make_signature($uri);
143             # signature must be last parameter in query string or you get 403's
144 0         0 $url = $uri->as_string;
145 0 0       0 $url .= '&signature='.$signature if $signature;
146             }
147              
148 0         0 my $res = $self->{ua}->get($url);
149              
150 0 0       0 if ($res->is_error) {
151 0         0 Carp::croak("Google Places API returned error: " . $res->status_line);
152             }
153              
154 0         0 my $json = JSON->new->utf8;
155 0         0 my $data = $json->decode($res->content);
156              
157 0 0 0     0 unless ($data->{status} eq 'OK' || $data->{status} eq 'ZERO_RESULTS') {
158 0         0 Carp::croak(sprintf "Google Places API returned status '%s'", $data->{status});
159             }
160              
161 0 0       0 my @results = @{ $data->{results} || [] };
  0         0  
162 0 0       0 wantarray ? @results : $results[0];
163             }
164              
165             =head2 reverse_geocode
166              
167             $location = $geocoder->reverse_geocode(latlng => '37.778907,-122.39732');
168             @location = $geocoder->reverse_geocode(latlng => '37.778907,-122.39732');
169              
170             Similar to geocode except it expects a latitude/longitude parameter.
171              
172             =cut
173              
174             sub reverse_geocode {
175 0     0 1 0 my $self = shift;
176              
177 0         0 my %param;
178 0 0       0 if (@_ % 2 == 0) {
179 0         0 %param = @_;
180             } else {
181 0         0 $param{latlng} = shift;
182             }
183              
184             my $latlng = $param{latlng}
185 0 0       0 or Carp::croak("Usage: reverse_geocode(latlng => \$latlng)");
186              
187 0         0 return $self->geocode(location => $latlng, reverse => 1);
188             }
189              
190             # methods below adapted from
191             # http://gmaps-samples.googlecode.com/svn/trunk/urlsigning/urlsigner.pl
192             sub _decode_urlsafe_base64 {
193 0     0   0 my ($self, $content) = @_;
194              
195 0         0 $content =~ tr/-/\+/;
196 0         0 $content =~ tr/_/\//;
197              
198 0         0 return MIME::Base64::decode_base64($content);
199             }
200              
201             sub _encode_urlsafe{
202 0     0   0 my ($self, $content) = @_;
203 0         0 $content =~ tr/\+/\-/;
204 0         0 $content =~ tr/\//\_/;
205              
206 0         0 return $content;
207             }
208              
209             sub _make_signature {
210 0     0   0 my ($self, $uri) = @_;
211              
212 0         0 require Digest::HMAC_SHA1;
213 0         0 require MIME::Base64;
214              
215 0         0 my $key = $self->_decode_urlsafe_base64($self->{key});
216 0         0 my $to_sign = $uri->path_query;
217              
218 0         0 my $digest = Digest::HMAC_SHA1->new($key);
219 0         0 $digest->add($to_sign);
220 0         0 my $signature = $digest->b64digest;
221              
222 0         0 return $self->_encode_urlsafe($signature);
223             }
224              
225             # Google API wants the components formatted in the following way:
226             # :|:|....|:
227             sub _get_components_query_params {
228 7     7   29 my ($self, ) = @_;
229 7         16 my $components = $self->{components};
230              
231 7         8 my @validated_components;
232 7         23 foreach my $filter (sort keys %$components ) {
233 8 100       14 next unless grep {$_ eq $filter} @ALLOWED_FILTERS;
  40         78  
234 7         10 my $value = $components->{$filter};
235 7 50       14 if (!defined $value) {
236 0         0 Carp::croak("Value not specified for filter $filter");
237             }
238             # Google API expects the parameter to be passed as :
239 7         20 push @validated_components, "$filter:$value";
240             }
241 7 100       47 return unless @validated_components;
242 6         32 return join('|', @validated_components);
243             }
244              
245             =head2 ua
246              
247             Accessor method to get and set UserAgent object used internally. You
248             can call I for example, to get the proxy information from
249             environment variables:
250              
251             $coder->ua->env_proxy(1);
252              
253             You can also set your own User-Agent object:
254              
255             $coder->ua( LWP::UserAgent::Throttled->new() );
256              
257             =cut
258              
259             sub ua {
260 0     0 1   my $self = shift;
261 0 0         if (@_) {
262 0           $self->{ua} = shift;
263             }
264 0           $self->{ua};
265             }
266              
267             =head2 key
268              
269             Accessor method to get and set your Google API key.
270              
271             print $coder->key(), "\n";
272              
273             =cut
274              
275             sub key {
276 0     0 1   my $self = shift;
277 0 0         if (@_) {
278 0           $self->{key} = shift;
279             }
280 0           $self->{key};
281             }
282              
283             1;
284             __END__