File Coverage

blib/lib/Geo/Coder/DataScienceToolkit.pm
Criterion Covered Total %
statement 31 77 40.2
branch 0 28 0.0
condition 2 14 14.2
subroutine 10 13 76.9
pod 4 4 100.0
total 47 136 34.5


line stmt bran cond sub pod time code
1             package Geo::Coder::DataScienceToolkit;
2              
3 5     5   549503 use strict;
  5         43  
  5         144  
4 5     5   23 use warnings;
  5         9  
  5         117  
5              
6 5     5   25 use Carp;
  5         9  
  5         253  
7 5     5   2578 use Encode;
  5         45012  
  5         397  
8 5     5   2818 use JSON;
  5         46461  
  5         29  
9 5     5   2651 use HTTP::Request;
  5         94628  
  5         172  
10 5     5   3219 use LWP::UserAgent;
  5         118545  
  5         189  
11 5     5   2330 use LWP::Protocol::http;
  5         219798  
  5         212  
12 5     5   42 use URI;
  5         10  
  5         2975  
13              
14             =head1 NAME
15              
16             Geo::Coder::DataScienceToolkit - Provides a geocoding functionality using
17             http://www.datasciencetoolkit.org/
18              
19             =head1 VERSION
20              
21             Version 0.02
22              
23             =cut
24              
25             our $VERSION = '0.02';
26              
27             =head1 SYNOPSIS
28              
29             use Geo::Coder::DataScienceToolkit;
30              
31             my $geocoder = Geo::Coder::DataScienceToolkit->new();
32             my $location = $geocoder->geocode(location => '10 Downing St., London, UK');
33              
34             =head1 DESCRIPTION
35              
36             Geo::Coder::DataScienceToolkit provides an interface to datasciencetoolkit,
37             a free geocode database covering the US and UK.
38              
39             =head1 METHODS
40              
41             =head2 new
42              
43             $geocoder = Geo::Coder::DataScienceToolkit->new();
44             my $ua = LWP::UserAgent->new();
45             $ua->env_proxy(1);
46             $geocoder = Geo::Coder::DataScienceToolkit->new(ua => $ua);
47              
48             =cut
49              
50             sub new {
51 1     1 1 89 my($class, %param) = @_;
52              
53 1   33     15 my $ua = delete $param{ua} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
54             # if(!defined($param{'host'})) {
55             # $ua->ssl_opts(verify_hostname => 0); # Yuck
56             # }
57 1   50     2921 my $host = delete $param{host} || 'www.datasciencetoolkit.org';
58              
59 1         10 return bless { ua => $ua, host => $host }, $class;
60             }
61              
62             =head2 geocode
63              
64             $location = $geocoder->geocode(location => $location);
65              
66             print 'Latitude: ', $location->{'results'}[0]->{'geometry'}->{'location'}->{'lat'}, 38.90, 1e-2); "\n";
67             print 'Longitude: ', delta_within($location->{'results'}[0]->{'geometry'}->{'location'}->{'lng'}, -77.04, 1e-2); "\n";
68              
69             @locations = $geocoder->geocode('Portland, USA');
70             diag 'There are Portlands in ', join (', ', map { $_->{'state'} } @locations);
71              
72             =cut
73              
74             sub geocode {
75 0     0 1   my $self = shift;
76 0           my %params;
77              
78 0 0 0       if(!ref($self)) {
    0          
    0          
    0          
    0          
79 0 0         if(scalar(@_)) {
80 0           return(__PACKAGE__->new()->parse(@_));
81             }
82 0           return(__PACKAGE__->new()->parse($self));
83             } elsif(ref($self) eq 'HASH') {
84 0           return(__PACKAGE__->new()->parse($self));
85             } elsif(ref($_[0]) eq 'HASH') {
86 0           %params = %{$_[0]};
  0            
87             } elsif(ref($_[0])) {
88 0           Carp::croak('Usage: ', __PACKAGE__, '::geocode(location => $location)');
89             } elsif(scalar(@_) && (scalar(@_) % 2 == 0)) {
90 0           %params = @_;
91             } else {
92 0           $params{'location'} = shift;
93             }
94              
95             my $location = $params{location}
96 0 0         or Carp::croak("Usage: geocode(location => \$location)");
97              
98 0 0         if (Encode::is_utf8($location)) {
99 0           $location = Encode::encode_utf8($location);
100             }
101              
102 0           my $uri = URI->new("http://$self->{host}/maps/api/geocode/json");
103 0           $location =~ s/\s/+/g;
104 0           my %query_parameters = ('address' => $location, 'sensor' => 'false');
105 0           $uri->query_form(%query_parameters);
106 0           my $url = $uri->as_string();
107              
108 0           my $res = $self->{ua}->get($url);
109              
110 0 0         if ($res->is_error) {
111 0           Carp::carp("API returned error: on $url ", $res->status_line());
112 0           return { };
113             }
114              
115 0           my $json = JSON->new()->utf8();
116 0           my $rc;
117 0           eval {
118 0           $rc = $json->decode($res->content());
119             };
120 0 0         if(!defined($rc)) {
121 0 0         if($@) {
122 0           Carp::carp("$url: $@");
123 0           return { };
124             }
125 0           Carp::carp("$url: can't decode the JSON ", $res->content());
126 0           return { };
127             }
128              
129 0 0 0       if($rc->{'otherlocations'} && $rc->{'otherlocations'}->{'loc'} &&
      0        
130             (ref($rc->{'otherlocations'}->{'loc'}) eq 'ARRAY')) {
131 0           my @rc = @{$rc->{'otherlocations'}->{'loc'}};
  0            
132 0 0         if(wantarray) {
133 0           return @rc;
134             }
135 0           return $rc[0];
136             }
137 0           return $rc;
138              
139             # my @results = @{ $data || [] };
140             # wantarray ? @results : $results[0];
141             }
142              
143             =head2 ua
144              
145             Accessor method to get and set UserAgent object used internally. You
146             can call I for example, to get the proxy information from
147             environment variables:
148              
149             $geocoder->ua()->env_proxy(1);
150              
151             You can also set your own User-Agent object:
152              
153             use LWP::UserAgent::Throttled;
154             $geocoder->ua(LWP::UserAgent::Throttled->new());
155              
156             =cut
157              
158             sub ua {
159 0     0 1   my $self = shift;
160 0 0         if (@_) {
161 0           $self->{ua} = shift;
162             }
163 0           $self->{ua};
164             }
165              
166             =head2 reverse_geocode
167              
168             Reverse geocoding is not supported by datasciencetoolkit.org, so calls to
169             this will generate an error.
170              
171             =cut
172              
173             sub reverse_geocode {
174 0     0 1   Carp::carp('datasciencetoolkit.org does not support reverse encoding');
175             }
176              
177             =head1 AUTHOR
178              
179             Nigel Horne
180              
181             Based on L.
182              
183             This library is free software; you can redistribute it and/or modify
184             it under the same terms as Perl itself.
185              
186             Lots of thanks to the folks at DSTK.
187              
188             =head1 SEE ALSO
189              
190             L,
191             L,
192             L.
193              
194             =head1 LICENSE AND COPYRIGHT
195              
196             Copyright 2019 Nigel Horne.
197              
198             This program is released under the following licence: GPL2
199              
200             =cut
201              
202             1;