File Coverage

blib/lib/Geo/Coder/Google/V3.pm
Criterion Covered Total %
statement 44 111 39.6
branch 5 42 11.9
condition 9 27 33.3
subroutine 9 15 60.0
pod 4 7 57.1
total 71 202 35.1


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