File Coverage

lib/Geo/Coder/OpenCage.pm
Criterion Covered Total %
statement 31 73 42.4
branch 3 20 15.0
condition 2 9 22.2
subroutine 8 11 72.7
pod 4 4 100.0
total 48 117 41.0


line stmt bran cond sub pod time code
1             package Geo::Coder::OpenCage;
2             # ABSTRACT: Geocode coordinates and addresses with the OpenCage Geocoder
3             $Geo::Coder::OpenCage::VERSION = '0.35';
4 8     8   741596 use strict;
  8         90  
  8         594  
5 8     8   48 use warnings;
  8         18  
  8         187  
6              
7 8     8   37 use Carp;
  8         12  
  8         432  
8 8     8   5959 use HTTP::Tiny;
  8         331043  
  8         357  
9 8     8   3330 use JSON::MaybeXS;
  8         57566  
  8         580  
10 8     8   71 use Scalar::Util 'blessed';
  8         45  
  8         471  
11 8     8   4064 use URI;
  8         32777  
  8         6094  
12              
13             my $version = our $VERSION || 'dev';
14             my $ua_string;
15              
16             sub new {
17 2     2 1 1016 my $class = shift;
18 2         6 my %params = @_;
19              
20 2 100       8 if (!$params{api_key}) {
21 1         16 croak "api_key is a required parameter for new()";
22             }
23              
24 1         5 $ua_string = $class . ' ' . $version;
25 1   33     13 my $ua = $params{ua} || HTTP::Tiny->new(agent => $ua_string);
26 1         92 my $api_url = 'https://api.opencagedata.com/geocode/v1/json';
27            
28 1 50 33     8 if (defined($params{http} && $params{http} == 1 )){
29 0         0 $api_url =~ s|^https|http|;
30             }
31             my $self = {
32             version => $version,
33             api_key => $params{api_key},
34 1         8 ua => $ua,
35             json => JSON::MaybeXS->new(utf8 => 1),
36             url => URI->new($api_url),
37             };
38              
39 1         9322 return bless $self, $class;
40             }
41              
42             sub ua {
43 0     0 1   my $self = shift;
44 0           my $ua = shift;
45 0 0         if (defined($ua)) {
46 0           $ua->agent($ua_string);
47 0           $self->{ua} = $ua;
48             }
49 0           return $self->{ua};
50             }
51              
52             # see list: https://opencagedata.com/api#forward-opt
53             my %valid_params = (
54             abbrv => 1,
55             address_only => 1,
56             add_request => 1,
57             bounds => 1,
58             countrycode => 1,
59             format => 0,
60             jsonp => 0,
61             language => 1,
62             limit => 1,
63             min_confidence => 1,
64             no_annotations => 1,
65             no_dedupe => 1,
66             no_record => 1,
67             q => 1,
68             pretty => 1, # makes no actual difference
69             proximity => 1,
70             roadinfo => 1,
71             );
72              
73             sub geocode {
74 0     0 1   my $self = shift;
75 0           my %params = @_;
76              
77 0 0         if (defined($params{location})) {
78 0           $params{q} = delete $params{location};
79             } else {
80 0           warn "location is a required parameter for geocode()";
81 0           return undef;
82             }
83              
84 0           for my $k (keys %params) {
85 0 0         if (!defined($params{$k})) {
86 0           warn "Unknown geocode parameter: $k";
87 0           delete $params{$k};
88             }
89 0 0         if (!$params{$k}) { # is a real parameter but we dont support it
90 0           warn "Unsupported geocode parameter: $k";
91 0           delete $params{$k};
92             }
93             }
94              
95 0           $params{key} = $self->{api_key};
96            
97             # sort the params for better cachability
98 0           my @final_params;
99 0           foreach my $k (sort keys %params){
100 0           push(@final_params, $k => $params{$k})
101            
102             }
103 0           my $URL = $self->{url}->clone();
104 0           $URL->query_form(\@final_params);
105             # print STDERR 'url: ' . $URL->as_string . "\n";
106 0           my $response = $self->{ua}->get($URL);
107              
108             # Support HTTP::Tiny and LWP:: CPAN packages
109             my $content = ( blessed $response and $response->isa('HTTP::Response') )
110             ? $response->decoded_content()
111 0 0 0       : $response->{content};
112              
113             my $is_success = (ref($response) eq 'HTTP::Response')
114             ? $response->is_success()
115 0 0         : $response->{success};
116              
117 0           my $rh_content = $self->{json}->decode($content);
118              
119 0 0         if (!$is_success) {
120 0           warn "response when requesting '$URL': " . $rh_content->{status}{code} . ', ' . $rh_content->{status}{message};
121 0           return undef;
122             }
123 0           return $rh_content;
124             }
125              
126             sub reverse_geocode {
127 0     0 1   my $self = shift;
128 0           my %params = @_;
129              
130 0           foreach my $k (qw(lat lng)) {
131 0 0         if (!defined($params{$k})) {
132 0           warn "$k is a required parameter";
133 0           return undef;
134             }
135             }
136              
137 0           $params{location} = join(',', delete @params{'lat', 'lng'});
138 0           return $self->geocode(%params);
139             }
140              
141             1;
142              
143             __END__