File Coverage

blib/lib/Geo/Coder/Google/V3.pm
Criterion Covered Total %
statement 43 107 40.1
branch 5 40 12.5
condition 8 25 32.0
subroutine 9 15 60.0
pod 4 7 57.1
total 69 194 35.5


line stmt bran cond sub pod time code
1             package Geo::Coder::Google::V3;
2              
3 1     1   6 use strict;
  1         1  
  1         22  
4 1     1   5 use warnings;
  1         1  
  1         31  
5             our $VERSION = '0.19';
6              
7 1     1   4 use Carp;
  1         2  
  1         44  
8 1     1   438 use JSON;
  1         5533  
  1         4  
9 1     1   330 use HTTP::Request;
  1         14527  
  1         25  
10 1     1   417 use LWP::UserAgent;
  1         17442  
  1         31  
11 1     1   7 use URI;
  1         3  
  1         772  
12              
13             my @ALLOWED_FILTERS = qw/route locality administrative_area postal_code country/;
14              
15             sub new {
16 7     7 1 18 my($class, %param) = @_;
17              
18 7   33     36 my $ua = delete $param{ua} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
19 7   50     3184 my $host = delete $param{host} || 'maps.googleapis.com';
20 7   33     23 my $language = delete $param{language} || delete $param{hl};
21 7   33     19 my $region = delete $param{region} || delete $param{gl};
22 7   50     22 my $oe = delete $param{oe} || 'utf8';
23 7   50     19 my $channel = delete $param{channel} || undef;
24 7   50     18 my $client = delete $param{client} || '';
25 7   50     18 my $key = delete $param{key} || '';
26 7         13 my $components = delete $param{components};
27            
28 7         56 bless {
29             ua => $ua, host => $host, language => $language,
30             region => $region, oe => $oe, channel => $channel,
31             client => $client, key => $key, components => $components,
32             }, $class;
33             }
34              
35             sub ua {
36 0     0 1 0 my $self = shift;
37 0 0       0 if (@_) {
38 0         0 $self->{ua} = shift;
39             }
40 0         0 $self->{ua};
41             }
42              
43             sub reverse_geocode {
44 0     0 1 0 my $self = shift;
45              
46 0         0 my %param;
47 0 0       0 if (@_ % 2 == 0) {
48 0         0 %param = @_;
49             } else {
50 0         0 $param{latlng} = shift;
51             }
52              
53             my $latlng = $param{latlng}
54 0 0       0 or Carp::croak("Usage: reverse_geocode(latlng => \$latlng)");
55              
56 0         0 return $self->geocode(location => $latlng, reverse => 1);
57             };
58              
59             sub geocode {
60 0     0 1 0 my $self = shift;
61              
62 0         0 my %param;
63 0 0       0 if (@_ % 2 == 0) {
64 0         0 %param = @_;
65             } else {
66 0         0 $param{location} = shift;
67             }
68              
69             my $location = $param{location}
70 0 0       0 or Carp::croak("Usage: geocode(location => \$location)");
71              
72 0 0       0 my $loc_param = $param{reverse} ? 'latlng' : 'address';
73              
74 0         0 my $uri = URI->new("https://$self->{host}/maps/api/geocode/json");
75 0         0 my %query_parameters = ($loc_param => $location);
76 0 0       0 $query_parameters{language} = $self->{language} if defined $self->{language};
77 0 0       0 $query_parameters{region} = $self->{region} if defined $self->{region};
78 0         0 $query_parameters{oe} = $self->{oe};
79 0 0       0 $query_parameters{channel} = $self->{channel} if defined $self->{channel};
80 0         0 my $components_params = $self->_get_components_query_params;
81 0 0       0 $query_parameters{components} = $components_params if defined $components_params;
82 0 0       0 $query_parameters{key} = $self->{key} if defined $self->{key};
83 0         0 $uri->query_form(%query_parameters);
84 0         0 my $url = $uri->as_string;
85              
86             # Process Maps Premier account info
87 0 0 0     0 if ($self->{client} and $self->{key}) {
88 0         0 delete $query_parameters{key};
89 0         0 $query_parameters{client} = $self->{client};
90 0         0 $uri->query_form(%query_parameters);
91              
92 0         0 my $signature = $self->make_signature($uri);
93             # signature must be last parameter in query string or you get 403's
94 0         0 $url = $uri->as_string;
95 0 0       0 $url .= '&signature='.$signature if $signature;
96             }
97              
98 0         0 my $res = $self->{ua}->get($url);
99              
100 0 0       0 if ($res->is_error) {
101 0         0 Carp::croak("Google Maps API returned error: " . $res->status_line);
102             }
103              
104 0         0 my $json = JSON->new->utf8;
105 0         0 my $data = $json->decode($res->content);
106              
107 0 0 0     0 unless ($data->{status} eq 'OK' || $data->{status} eq 'ZERO_RESULTS') {
108 0         0 Carp::croak(sprintf "Google Maps API returned status '%s'", $data->{status});
109             }
110              
111 0 0       0 my @results = @{ $data->{results} || [] };
  0         0  
112 0 0       0 wantarray ? @results : $results[0];
113             }
114              
115             # methods below adapted from
116             # http://gmaps-samples.googlecode.com/svn/trunk/urlsigning/urlsigner.pl
117             sub decode_urlsafe_base64 {
118 0     0 0 0 my ($self, $content) = @_;
119              
120 0         0 $content =~ tr/-/\+/;
121 0         0 $content =~ tr/_/\//;
122              
123 0         0 return MIME::Base64::decode_base64($content);
124             }
125              
126             sub encode_urlsafe{
127 0     0 0 0 my ($self, $content) = @_;
128 0         0 $content =~ tr/\+/\-/;
129 0         0 $content =~ tr/\//\_/;
130              
131 0         0 return $content;
132             }
133              
134             sub make_signature {
135 0     0 0 0 my ($self, $uri) = @_;
136              
137 0         0 require Digest::HMAC_SHA1;
138 0         0 require MIME::Base64;
139              
140 0         0 my $key = $self->decode_urlsafe_base64($self->{key});
141 0         0 my $to_sign = $uri->path_query;
142              
143 0         0 my $digest = Digest::HMAC_SHA1->new($key);
144 0         0 $digest->add($to_sign);
145 0         0 my $signature = $digest->b64digest;
146              
147 0         0 return $self->encode_urlsafe($signature);
148             }
149              
150             # Google API wants the components formatted in the following way:
151             # :|:|....|:
152             sub _get_components_query_params {
153 7     7   31 my ($self, ) = @_;
154 7         15 my $components = $self->{components};
155              
156 7         10 my @validated_components;
157 7         23 foreach my $filter (sort keys %$components ) {
158 8 100       13 next unless grep {$_ eq $filter} @ALLOWED_FILTERS;
  40         72  
159 7         12 my $value = $components->{$filter};
160 7 50       12 if (!defined $value) {
161 0         0 Carp::croak("Value not specified for filter $filter");
162             }
163             # Google API expects the parameter to be passed as :
164 7         21 push @validated_components, "$filter:$value";
165             }
166 7 100       20 return unless @validated_components;
167 6         32 return join('|', @validated_components);
168             }
169              
170             1;
171             __END__