File Coverage

lib/Geo/Coder/OpenCage.pm

Criterion	Covered	Total	%
statement	28	74	37.8
branch	3	24	12.5
condition	2	6	33.3
subroutine	7	10	70.0
pod	4	4	100.0
total	44	118	37.2

package Geo::Coder::OpenCage;
# ABSTRACT: Geocode coordinates and addresses with the OpenCage Geocoder
$Geo::Coder::OpenCage::VERSION = '0.34';
use strict;
use warnings;

use Carp;
use HTTP::Tiny;
use JSON::MaybeXS;
use URI;
# FIXME - must be a way to get this from dist.ini?
my $version = 0.34;
my $ua_string;

sub new {
    my $class  = shift;
    my %params = @_;

    if (!$params{api_key}) {
        croak "api_key is a required parameter for new()";
    }

    $ua_string = $class . ' ' . $version;
    my $ua   = $params{ua} || HTTP::Tiny->new(agent => $ua_string);
    my $api_url = 'https://api.opencagedata.com/geocode/v1/json';

    if (defined($params{http} && $params{http} == 1 )){
        $api_url =~ s|^https|http|;
    }
    my $self = {
        version => $version,
        api_key => $params{api_key},
        ua      => $ua,
        json    => JSON::MaybeXS->new(utf8 => 1),
        url     => URI->new($api_url),
    };

    return bless $self, $class;
}

sub ua {
    my $self = shift;
    my $ua   = shift;
    if (defined($ua)) {
        $ua->agent($ua_string);
        $self->{ua} = $ua;
    }
    return $self->{ua};
}

# see list: https://opencagedata.com/api#forward-opt
my %valid_params = (
    abbrv          => 1,
    address_only   => 1,
    add_request    => 1,
    bounds         => 1,
    countrycode    => 1,
    format         => 0,
    jsonp          => 0,
    language       => 1,
    limit          => 1,
    min_confidence => 1,
    no_annotations => 1,
    no_dedupe      => 1,
    no_record      => 1,
    q              => 1,
    pretty         => 1, # makes no actual difference
    proximity      => 1,
    roadinfo       => 1,
);

sub geocode {
    my $self   = shift;
    my %params = @_;

    if (defined($params{location})) {
        $params{q} = delete $params{location};
    } else {
        warn "location is a required parameter for geocode()";
        return undef;
    }

    for my $k (keys %params) {
        if (!defined($params{$k})) {
            warn "Unknown geocode parameter: $k";
            delete $params{$k};
        }
        if (!$params{$k}) { # is a real parameter but we dont support it
            warn "Unsupported geocode parameter: $k";
            delete $params{$k};
        }
    }

    $params{key} = $self->{api_key};

    # sort the params for better cachability
    my @final_params;
    foreach my $k (sort keys %params){
        push(@final_params, $k => $params{$k})

    }
    my $URL = $self->{url}->clone();
    $URL->query_form(\@final_params);
    # print STDERR 'url: ' . $URL->as_string . "\n";
    my $response = $self->{ua}->get($URL);

    if (!$response) {
        my $reason = (ref($response) eq 'HTTP::Response')
                    ? $response->status_line() #
                    : $response->{reason};
        warn "failed to fetch '$URL': ", $reason;
        return undef;
    }

    # Support HTTP::Tiny and LWP:: CPAN packages
    my $content = (ref($response) eq 'HTTP::Response')
                    ? $response->decoded_content()
                    : $response->{content};
    my $is_success = (ref($response) eq 'HTTP::Response')
                       ? $response->is_success()
                       : $response->{success};

    my $rh_content = $self->{json}->decode($content);


    if (!$is_success) {
        warn "response when requesting '$URL': " . $rh_content->{status}{code} . ', ' . $rh_content->{status}{message};
        return undef;
    }
    return $rh_content;
}

sub reverse_geocode {
    my $self   = shift;
    my %params = @_;

    foreach my $k (qw(lat lng)) {
        if (!defined($params{$k})) {
            warn "$k is a required parameter";
            return undef;
        }
    }

    $params{location} = join(',', delete @params{'lat', 'lng'});
    return $self->geocode(%params);
}

1;

__END__