File Coverage

blib/lib/Geo/Coder/Mappy.pm
Criterion Covered Total %
statement 35 62 56.4
branch 11 32 34.3
condition 3 9 33.3
subroutine 9 12 75.0
pod 4 4 100.0
total 62 119 52.1


line stmt bran cond sub pod time code
1             package Geo::Coder::Mappy;
2              
3 2     2   58304 use strict;
  2         7  
  2         78  
4 2     2   11 use warnings;
  2         4  
  2         78  
5              
6 2     2   9 use Carp qw(croak);
  2         7  
  2         134  
7 2     2   1805 use Encode ();
  2         27422  
  2         51  
8 2     2   2301 use JSON;
  2         43476  
  2         12  
9 2     2   2562 use LWP::UserAgent;
  2         114554  
  2         82  
10 2     2   24 use URI;
  2         4  
  2         1483  
11              
12             our $VERSION = '0.02';
13             $VERSION = eval $VERSION;
14              
15             sub new {
16 3     3 1 1569 my ($class, @params) = @_;
17 3 100       17 my %params = (@params % 2) ? (token => @params) : @params;
18              
19 3 100       227 croak q('token' is required) unless $params{token};
20              
21 2         6 my $self = bless \ %params, $class;
22              
23 2   33     42 $self->ua(
24             $params{ua} || LWP::UserAgent->new(agent => "$class/$VERSION")
25             );
26              
27 2 50       13 if ($self->{debug}) {
    50          
    50          
28 0     0   0 my $dump_sub = sub { $_[0]->dump(maxlength => 0); return };
  0         0  
  0         0  
29 0         0 $self->ua->set_my_handler(request_send => $dump_sub);
30 0         0 $self->ua->set_my_handler(response_done => $dump_sub);
31             }
32             elsif (exists $self->{compress} ? $self->{compress} : 1) {
33 2         6 $self->ua->default_header(accept_encoding => 'gzip,deflate');
34             }
35              
36 2 50 33     97 croak q('https' requires LWP::Protocol::https)
37             if $params{https} and not $self->ua->is_protocol_supported('https');
38              
39 2         8 return $self;
40             }
41              
42 0     0 1 0 sub response { $_[0]->{response} }
43              
44             sub ua {
45 4     4 1 3748 my ($self, $ua) = @_;
46 4 100       12 if ($ua) {
47 2 50 33     23 croak q('ua' must be (or derived from) an LWP::UserAgent')
48             unless ref $ua and $ua->isa(q(LWP::UserAgent));
49 2         7 $self->{ua} = $ua;
50             }
51 4         12 return $self->{ua};
52             }
53              
54             sub geocode {
55 0     0 1   my ($self, @params) = @_;
56 0 0         my %params = (@params % 2) ? (location => @params) : @params;
57              
58 0           while (my ($key, $val) = each %params) {
59 0           $params{$key} = Encode::encode('utf-8', $val);
60             }
61 0 0         my $location = delete $params{location} or return;
62              
63 0           my $uri = URI->new('http://axe.mappy.com/1v1/loc/get.aspx');
64 0           $uri->query_form(
65             auth => $self->{token},
66             fullAddress => $location,
67             'opt.format' => 'json',
68             'opt.interactive' => 1,
69             'opt.language' => 'ENG',
70             'opt.xmlOutput' => '3v0',
71             %params,
72             );
73 0 0         if ($self->{https}) {
74 0           $uri->scheme('https');
75 0           $uri->host('ssl.mappy.com');
76             }
77              
78 0           my $res = $self->{response} = $self->ua->get($uri);
79 0 0         return unless $res->is_success;
80              
81             # Change the content type of the response to force HTTP::Message to
82             # decode the character encoding.
83 0           $res->content_type('text/plain');
84              
85 0           my $content = $res->decoded_content;
86 0 0         return unless $content;
87              
88 0           my $data = eval { from_json($content) };
  0            
89 0 0         return unless $data;
90              
91             # Result is a list only if there is more than one item.
92 0           my $results = $data->{kml}{Document}{Placemark};
93 0 0         my @results = 'ARRAY' eq ref $results ? @$results : ($results);
94 0 0         return wantarray ? @results : $results[0];
95             }
96              
97              
98             1;
99              
100             __END__