File Coverage

blib/lib/Geo/Coder/GooglePlaces/V3.pm
Criterion Covered Total %
statement 48 119 40.3
branch 8 48 16.6
condition 8 28 28.5
subroutine 10 17 58.8
pod 5 5 100.0
total 79 217 36.4


line stmt bran cond sub pod time code
1             package Geo::Coder::GooglePlaces::V3;
2              
3 5     5   34 use strict;
  5         11  
  5         135  
4 5     5   29 use warnings;
  5         11  
  5         131  
5              
6 5     5   25 use Carp;
  5         12  
  5         303  
7 5     5   2268 use Encode;
  5         60208  
  5         418  
8 5     5   1797 use JSON::MaybeXS;
  5         26726  
  5         294  
9 5     5   2305 use HTTP::Request;
  5         106801  
  5         178  
10 5     5   3539 use LWP::UserAgent;
  5         147632  
  5         218  
11 5     5   45 use URI;
  5         11  
  5         6004  
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.06
22              
23             =cut
24              
25             our $VERSION = '0.06';
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 L.
65              
66             =cut
67              
68             sub new {
69 12     12 1 32 my($class, %args) = @_;
70              
71 12 50       51 if(!defined($class)) {
    100          
72             # Geo::Coder::GooglePlaces::new() used rather than Geo::Coder::GooglePlaces::new()
73 0         0 $class = __PACKAGE__;
74             } elsif(ref($class)) {
75             # clone the given object
76 1         2 return bless { %{$class}, %args }, ref($class);
  1         13  
77             }
78              
79 11   33     76 my $ua = delete $args{ua} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
80 11   50     10928 my $host = delete $args{host} || 'maps.googleapis.com';
81              
82 11   33     41 my $language = delete $args{language} || delete $args{hl};
83 11   33     41 my $region = delete $args{region} || delete $args{gl};
84 11   50     34 my $oe = delete $args{oe} || 'utf8';
85 11   50     42 my $sensor = delete $args{sensor} || 0;
86 11   50     34 my $client = delete $args{client} || '';
87 11   50     34 my $key = delete $args{key} || '';
88 11         19 my $components = delete $args{components};
89              
90 11         98 return bless {
91             ua => $ua, host => $host, language => $language,
92             region => $region, oe => $oe, sensor => $sensor,
93             client => $client, key => $key,
94             components => $components,
95             }, $class;
96             }
97              
98             =head2 geocode
99              
100             $location = $geocoder->geocode(location => $location);
101             @location = $geocoder->geocode(location => $location);
102              
103             Queries I<$location> to Google Places geocoding API and returns hash
104             reference returned back from API server.
105             When you call the method in
106             an array context, it returns all the candidates got back, while it
107             returns the 1st one in a scalar context.
108              
109             When you'd like to pass non-ASCII string as a location, you should
110             pass it as either UTF-8 bytes or Unicode flagged string.
111              
112             =cut
113              
114             sub geocode {
115 0     0 1 0 my $self = shift;
116              
117 0         0 my %param;
118 0 0       0 if (@_ % 2 == 0) {
119 0         0 %param = @_;
120             } else {
121 0         0 $param{location} = shift;
122             }
123              
124             my $location = $param{location}
125 0 0       0 or Carp::croak('Usage: geocode(location => $location)');
126              
127 0 0       0 if (Encode::is_utf8($location)) {
128 0         0 $location = Encode::encode_utf8($location);
129             }
130              
131 0 0       0 my $loc_param = $param{reverse} ? 'latlng' : 'query';
132              
133 0         0 my $uri = URI->new("https://$self->{host}/maps/api/place/textsearch/json");
134 0         0 my %query_parameters = ($loc_param => $location);
135 0 0       0 $query_parameters{language} = $self->{language} if defined $self->{language};
136 0 0       0 $query_parameters{region} = $self->{region} if defined $self->{region};
137 0         0 $query_parameters{oe} = $self->{oe};
138 0 0       0 $query_parameters{sensor} = $self->{sensor} ? 'true' : 'false';
139 0         0 my $components_params = $self->_get_components_query_params;
140 0 0       0 $query_parameters{components} = $components_params if defined $components_params;
141 0 0 0     0 $query_parameters{key} = $self->{key} if(defined($self->{key}) && (length $self->{key}));
142 0         0 $uri->query_form(%query_parameters);
143 0         0 my $url = $uri->as_string;
144              
145             # Process Places Premier account info
146 0 0 0     0 if ($self->{client} and $self->{key}) {
147 0         0 delete $query_parameters{key};
148 0         0 $query_parameters{client} = $self->{client};
149 0         0 $uri->query_form(%query_parameters);
150              
151 0         0 my $signature = $self->_make_signature($uri);
152             # signature must be last parameter in query string or you get 403's
153 0         0 $url = $uri->as_string();
154 0 0       0 $url .= "&signature=$signature" if $signature;
155             }
156              
157 0         0 my $res = $self->{ua}->get($url);
158              
159 0 0       0 if ($res->is_error) {
160 0         0 Carp::croak('Google Places API returned error: ', $res->status_line());
161             }
162              
163 0         0 my $json = JSON::MaybeXS->new()->utf8();
164 0         0 my $data = $json->decode($res->decoded_content());
165              
166 0 0 0     0 unless($data->{status} eq 'OK' || $data->{status} eq 'ZERO_RESULTS') {
167 0         0 Carp::croak("$url: Google Places API returned status '", $data->{status}, '"');
168             }
169              
170 0 0       0 my @results = @{ $data->{results} || [] };
  0         0  
171 0 0       0 return wantarray ? @results : $results[0];
172             }
173              
174             =head2 reverse_geocode
175              
176             $location = $geocoder->reverse_geocode(latlng => '37.778907,-122.39732');
177             @location = $geocoder->reverse_geocode(latlng => '37.778907,-122.39732');
178              
179             Similar to geocode except it expects a latitude/longitude parameter.
180              
181             =cut
182              
183             sub reverse_geocode {
184 0     0 1 0 my $self = shift;
185              
186 0         0 my %param;
187 0 0       0 if (@_ % 2 == 0) {
188 0         0 %param = @_;
189             } else {
190 0         0 $param{latlng} = shift;
191             }
192              
193             my $latlng = $param{latlng}
194 0 0       0 or Carp::croak('Usage: reverse_geocode(latlng => $latlng)');
195              
196 0         0 return $self->geocode(location => $latlng, reverse => 1);
197             }
198              
199             # methods below adapted from
200             # http://gmaps-samples.googlecode.com/svn/trunk/urlsigning/urlsigner.pl
201             sub _decode_urlsafe_base64 {
202 0     0   0 my ($self, $content) = @_;
203              
204 0         0 $content =~ tr/-/\+/;
205 0         0 $content =~ tr/_/\//;
206              
207 0         0 return MIME::Base64::decode_base64($content);
208             }
209              
210             sub _encode_urlsafe{
211 0     0   0 my ($self, $content) = @_;
212 0         0 $content =~ tr/\+/\-/;
213 0         0 $content =~ tr/\//\_/;
214              
215 0         0 return $content;
216             }
217              
218             sub _make_signature {
219 0     0   0 my ($self, $uri) = @_;
220              
221 0         0 require Digest::HMAC_SHA1;
222 0         0 require MIME::Base64;
223              
224 0         0 my $key = $self->_decode_urlsafe_base64($self->{key});
225 0         0 my $to_sign = $uri->path_query;
226              
227 0         0 my $digest = Digest::HMAC_SHA1->new($key);
228 0         0 $digest->add($to_sign);
229 0         0 my $signature = $digest->b64digest;
230              
231 0         0 return $self->_encode_urlsafe($signature);
232             }
233              
234             # Google API wants the components formatted in the following way:
235             # :|:|....|:
236             sub _get_components_query_params {
237 7     7   29 my $self = shift;
238 7         15 my $components = $self->{components};
239              
240 7         9 my @validated_components;
241 7         26 foreach my $filter (sort keys %$components ) {
242 8 100       16 next unless grep {$_ eq $filter} @ALLOWED_FILTERS;
  40         82  
243 7 50       21 if(my $value = $components->{$filter}) {
244             # Google API expects the parameter to be passed as :
245 7         22 push @validated_components, "$filter:$value";
246             } else {
247 0         0 Carp::croak("Value not specified for filter $filter");
248             }
249             }
250 7 100       22 return unless @validated_components;
251 6         30 return join('|', @validated_components);
252             }
253              
254             =head2 ua
255              
256             Accessor method to get and set UserAgent object used internally. You
257             can call I for example, to get the proxy information from
258             environment variables:
259              
260             $coder->ua->env_proxy(1);
261              
262             You can also set your own User-Agent object:
263              
264             $coder->ua( LWP::UserAgent::Throttled->new() );
265              
266             =cut
267              
268             sub ua {
269 0     0 1   my $self = shift;
270 0 0         if (@_) {
271 0           $self->{ua} = shift;
272             }
273 0           return $self->{ua};
274             }
275              
276             =head2 key
277              
278             Accessor method to get and set your Google API key.
279              
280             print $coder->key(), "\n";
281              
282             =cut
283              
284             sub key {
285 0     0 1   my $self = shift;
286 0 0         if (@_) {
287 0           $self->{key} = shift;
288             }
289 0           return $self->{key};
290             }
291              
292             1;
293             __END__