File Coverage

blib/lib/Geo/Coder/XYZ.pm
Criterion Covered Total %
statement 33 82 40.2
branch 1 28 3.5
condition 2 11 18.1
subroutine 10 13 76.9
pod 4 4 100.0
total 50 138 36.2


line stmt bran cond sub pod time code
1             package Geo::Coder::XYZ;
2              
3 6     6   630723 use strict;
  6         53  
  6         146  
4 6     6   26 use warnings;
  6         8  
  6         136  
5              
6 6     6   36 use Carp;
  6         10  
  6         290  
7 6     6   2995 use Encode;
  6         46915  
  6         363  
8 6     6   2905 use JSON;
  6         48060  
  6         25  
9 6     6   2673 use HTTP::Request;
  6         98624  
  6         179  
10 6     6   3222 use LWP::UserAgent;
  6         125036  
  6         214  
11 6     6   2383 use LWP::Protocol::https;
  6         492036  
  6         257  
12 6     6   58 use URI;
  6         10  
  6         3482  
13              
14             =head1 NAME
15              
16             Geo::Coder::XYZ - Provides a geocoding functionality using https://geocode.xyz
17              
18             =head1 VERSION
19              
20             Version 0.07
21              
22             =cut
23              
24             our $VERSION = '0.07';
25              
26             =head1 SYNOPSIS
27              
28             use Geo::Coder::XYZ;
29              
30             my $geocoder = Geo::Coder::XYZ->new();
31             my $location = $geocoder->geocode(location => '10 Downing St., London, UK');
32              
33             =head1 DESCRIPTION
34              
35             Geo::Coder::XYZ provides an interface to geocode.xyz, a free geocode database covering many countries.
36              
37             =head1 METHODS
38              
39             =head2 new
40              
41             $geocoder = Geo::Coder::XYZ->new();
42             my $ua = LWP::UserAgent->new();
43             $ua->env_proxy(1);
44             $geocoder = Geo::Coder::XYZ->new(ua => $ua);
45              
46             =cut
47              
48             sub new {
49 1     1 1 99 my($class, %param) = @_;
50              
51 1   33     11 my $ua = delete $param{ua} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
52 1 50       2402 if(!defined($param{'host'})) {
53 1         5 $ua->ssl_opts(verify_hostname => 0); # Yuck
54             }
55 1   50     27 my $host = delete $param{host} || 'geocode.xyz';
56              
57 1         8 return bless { ua => $ua, host => $host }, $class;
58             }
59              
60             =head2 geocode
61              
62             $location = $geocoder->geocode(location => $location);
63              
64             print 'Latitude: ', $location->{'latt'}, "\n";
65             print 'Longitude: ', $location->{'longt'}, "\n";
66              
67             @locations = $geocoder->geocode('Portland, USA');
68             diag 'There are Portlands in ', join (', ', map { $_->{'state'} } @locations);
69              
70             =cut
71              
72             sub geocode {
73 0     0 1   my $self = shift;
74              
75 0           my %param;
76 0 0         if (@_ % 2 == 0) {
77 0           %param = @_;
78             } else {
79 0           $param{location} = shift;
80             }
81              
82             my $location = $param{location}
83 0 0         or Carp::croak("Usage: geocode(location => \$location)");
84              
85 0 0         if (Encode::is_utf8($location)) {
86 0           $location = Encode::encode_utf8($location);
87             }
88              
89 0           my $uri = URI->new("https://$self->{host}/some_location/");
90 0 0         if($location =~ /(.+),\s*England$/i) {
91 0           $location = "$1, United Kingdom"; # geocode.xyz gets confused between England and New England
92             }
93 0           $location =~ s/\s/+/g;
94 0           my %query_parameters = ('locate' => $location, 'json' => 1);
95 0 0         if(wantarray) {
96             # moreinfo is needed to find alternatives when the given location is ambiguous
97 0           $query_parameters{'moreinfo'} = 1;
98             }
99 0           $uri->query_form(%query_parameters);
100 0           my $url = $uri->as_string;
101              
102 0           my $res = $self->{ua}->get($url);
103              
104 0 0         if ($res->is_error) {
105 0           Carp::carp("geocode.xyz API returned error: on $url " . $res->status_line());
106 0           return { };
107             }
108              
109 0           my $json = JSON->new()->utf8();
110 0           my $rc;
111 0           eval {
112 0           $rc = $json->decode($res->content());
113             };
114 0 0         if(!defined($rc)) {
115 0 0         if($@) {
116 0           Carp::carp("$url: $@");
117 0           return { };
118             }
119 0           Carp::carp("$url: can't decode the JSON ", $res->content());
120 0           return { };
121             }
122              
123 0 0 0       if($rc->{'otherlocations'} && $rc->{'otherlocations'}->{'loc'} &&
      0        
124             (ref($rc->{'otherlocations'}->{'loc'}) eq 'ARRAY')) {
125 0           my @rc = @{$rc->{'otherlocations'}->{'loc'}};
  0            
126 0 0         if(wantarray) {
127 0           return @rc;
128             }
129 0           return $rc[0];
130             }
131 0           return $rc;
132              
133             # my @results = @{ $data || [] };
134             # wantarray ? @results : $results[0];
135             }
136              
137             =head2 ua
138              
139             Accessor method to get and set UserAgent object used internally. You
140             can call I for example, to get the proxy information from
141             environment variables:
142              
143             $geocoder->ua()->env_proxy(1);
144              
145             You can also set your own User-Agent object:
146              
147             use LWP::UserAgent::Throttled;
148             $geocoder->ua(LWP::UserAgent::Throttled->new());
149              
150             =cut
151              
152             sub ua {
153 0     0 1   my $self = shift;
154 0 0         if (@_) {
155 0           $self->{ua} = shift;
156             }
157 0           $self->{ua};
158             }
159              
160             =head2 reverse_geocode
161              
162             $location = $geocoder->reverse_geocode(latlng => '37.778907,-122.39732');
163              
164             Similar to geocode except it expects a latitude/longitude parameter.
165              
166             =cut
167              
168             sub reverse_geocode {
169 0     0 1   my $self = shift;
170              
171 0           my %param;
172 0 0         if (@_ % 2 == 0) {
173 0           %param = @_;
174             } else {
175 0           $param{latlng} = shift;
176             }
177              
178             my $latlng = $param{latlng}
179 0 0         or Carp::carp("Usage: reverse_geocode(latlng => \$latlng)");
180              
181 0           return $self->geocode(location => $latlng, reverse => 1);
182             }
183              
184             =head1 AUTHOR
185              
186             Nigel Horne
187              
188             Based on L.
189              
190             This library is free software; you can redistribute it and/or modify
191             it under the same terms as Perl itself.
192              
193             Lots of thanks to the folks at geocode.xyz.
194              
195             =head1 SEE ALSO
196              
197             L, L
198              
199             =head1 LICENSE AND COPYRIGHT
200              
201             Copyright 2017-2018 Nigel Horne.
202              
203             This program is released under the following licence: GPL2
204              
205             =cut
206              
207             1;