File Coverage

blib/lib/Geo/Coder/ArcGIS.pm
Criterion Covered Total %
statement 35 58 60.3
branch 10 30 33.3
condition 4 11 36.3
subroutine 8 11 72.7
pod 4 4 100.0
total 61 114 53.5


line stmt bran cond sub pod time code
1             package Geo::Coder::ArcGIS;
2              
3 2     2   78536 use strict;
  2         6  
  2         79  
4 2     2   12 use warnings;
  2         3  
  2         67  
5              
6 2     2   9 use Carp qw(croak);
  2         8  
  2         165  
7 2     2   2526 use JSON;
  2         37659  
  2         11  
8 2     2   3220 use LWP::UserAgent;
  2         130321  
  2         76  
9 2     2   24 use URI;
  2         4  
  2         1163  
10              
11             our $VERSION = '0.01';
12             $VERSION = eval $VERSION;
13              
14             sub new {
15 2     2 1 1116 my ($class, %params) = @_;
16              
17 2         6 my $self = bless \ %params, $class;
18              
19 2   33     53 $self->ua(
20             $params{ua} || LWP::UserAgent->new(agent => "$class/$VERSION")
21             );
22              
23 2 100       7 if ($self->{debug}) {
24 1     0   5 my $dump_sub = sub { $_[0]->dump(maxlength => 0); return };
  0         0  
  0         0  
25 1         4 $self->ua->set_my_handler(request_send => $dump_sub);
26 1         39 $self->ua->set_my_handler(response_done => $dump_sub);
27 1   50     40 $self->{compress} ||= 0;
28             }
29 2 100       10 if (exists $self->{compress} ? $self->{compress} : 1) {
    100          
30 1         3 $self->ua->default_header(accept_encoding => 'gzip,deflate');
31             }
32              
33 2 50 33     80 croak q('https' requires LWP::Protocol::https)
34             if $self->{https} and not $self->ua->is_protocol_supported('https');
35              
36 2         10 return $self;
37             }
38              
39 0     0 1 0 sub response { $_[0]->{response} }
40              
41             sub ua {
42 5     5 1 13322 my ($self, $ua) = @_;
43 5 100       13 if ($ua) {
44 2 50 33     53 croak q('ua' must be (or derived from) an LWP::UserAgent')
45             unless ref $ua and $ua->isa(q(LWP::UserAgent));
46 2         9 $self->{ua} = $ua;
47             }
48 5         16 return $self->{ua};
49             }
50              
51             sub geocode {
52 0     0 1   my ($self, @params) = @_;
53 0 0         my %params = (@params % 2) ? (location => @params) : @params;
54 0           my $raw = delete $params{raw};
55              
56 0 0         my $location = $params{location} or return;
57 0           $location = Encode::encode('utf-8', $location);
58              
59 0           my $uri = URI->new(
60             'http://tasks.arcgis.com/ArcGIS/rest/services/WorldLocator/'
61             . 'GeocodeServer/findAddressCandidates'
62             );
63 0 0         $uri->scheme('https') if $self->{https};
64 0           $uri->query_form(
65             SingleLine => $location,
66             f => 'json',
67             outFields => '*',
68             );
69              
70 0           my $res = $self->{response} = $self->ua->get(
71             $uri, referer => 'http://www.arcgis.com/home/webmap/viewer.html'
72             );
73 0 0         return unless $res->is_success;
74              
75             # Change the content type of the response from 'application/json' so
76             # HTTP::Message will decode the character encoding.
77 0           $res->content_type('text/plain');
78              
79 0           my $content = $res->decoded_content;
80 0 0         return unless $content;
81              
82 0           my $data = eval { from_json($content) };
  0            
83 0 0         return unless $data;
84 0 0         return $data if $raw;
85              
86 0 0         my @results = @{ $data->{candidates} || [] };
  0            
87 0 0         return wantarray ? @results : $results[0];
88             }
89              
90              
91             1;
92              
93             __END__