File Coverage

blib/lib/Geo/Coder/RandMcnally.pm
Criterion Covered Total %
statement 34 56 60.7
branch 6 22 27.2
condition 2 6 33.3
subroutine 9 12 75.0
pod 4 4 100.0
total 55 100 55.0


line stmt bran cond sub pod time code
1             package Geo::Coder::RandMcnally;
2              
3 2     2   93187 use strict;
  2         6  
  2         91  
4 2     2   11 use warnings;
  2         4  
  2         72  
5              
6 2     2   12 use Carp qw(croak);
  2         8  
  2         175  
7 2     2   12859 use Encode ();
  2         76733  
  2         62  
8 2     2   2713 use JSON;
  2         62544  
  2         13  
9 2     2   4161 use LWP::UserAgent;
  2         230748  
  2         81  
10 2     2   26 use URI;
  2         5  
  2         1174  
11              
12             our $VERSION = '0.01';
13             $VERSION = eval $VERSION;
14              
15             sub new {
16 2     2 1 1372 my ($class, %params) = @_;
17              
18 2         9 my $self = bless \ %params, $class;
19              
20 2   33     60 $self->ua(
21             $params{ua} || LWP::UserAgent->new(agent => "$class/$VERSION")
22             );
23              
24 2 100       94 if ($self->{debug}) {
    50          
25 1     0   6 my $dump_sub = sub { $_[0]->dump(maxlength => 0); return };
  0         0  
  0         0  
26 1         4 $self->ua->set_my_handler(request_send => $dump_sub);
27 1         52 $self->ua->set_my_handler(response_done => $dump_sub);
28             }
29             elsif ($self->{compress}) {
30 0         0 $self->ua->default_header(accept_encoding => 'gzip,deflate');
31             }
32              
33 2         56 return $self;
34             }
35              
36 0     0 1 0 sub response { $_[0]->{response} }
37              
38             sub ua {
39 4     4 1 5260 my ($self, $ua) = @_;
40 4 100       13 if ($ua) {
41 2 50 33     30 croak q('ua' must be (or derived from) an LWP::UserAgent')
42             unless ref $ua and $ua->isa(q(LWP::UserAgent));
43 2         10 $self->{ua} = $ua;
44             }
45 4         14 return $self->{ua};
46             }
47              
48             sub geocode {
49 0     0 1   my ($self, @params) = @_;
50 0 0         my %params = (@params % 2) ? (location => @params) : @params;
51              
52 0           while (my ($key, $val) = each %params) {
53 0           $params{$key} = Encode::encode('utf-8', $val);
54             }
55 0 0         my $location = delete $params{location} or return;
56              
57 0           my $uri = URI->new('http://a2ageo.rmservers.com/mapengine3/sli');
58 0           $uri->query_form(
59             tid => rand,
60             line => $location,
61             %params,
62             );
63              
64 0           my $res = $self->{response} = $self->ua->get(
65             $uri, referer => 'http://maps.randmcnally.com/'
66             );
67 0 0         return unless $res->is_success;
68              
69             # Change the content type of the response from 'application/json' so
70             # HTTP::Message will decode the character encoding.
71 0           $res->content_type('text/plain');
72              
73 0           my $content = $res->decoded_content;
74 0 0         return unless $content;
75              
76 0           my $data = eval { from_json($content) };
  0            
77 0 0         return unless $data;
78              
79 0 0         my @results = @{ $data->{geocodedLocation} || [] };
  0            
80 0 0         return wantarray ? @results : $results[0];
81             }
82              
83              
84             1;
85              
86             __END__