File Coverage

blib/lib/Geo/Coder/Mapquest.pm

Criterion	Covered	Total	%
statement	47	89	52.8
branch	19	56	33.9
condition	5	9	55.5
subroutine	11	14	78.5
pod	5	5	100.0
total	87	173	50.2

package Geo::Coder::Mapquest;

use strict;
use warnings;

use Carp qw(croak);
use Encode ();
use JSON;
use LWP::UserAgent;
use URI;
use URI::Escape qw(uri_unescape);

our $VERSION = '0.06';
$VERSION = eval $VERSION;

sub new {
    my ($class, @params) = @_;
    my %params = (@params % 2) ? (apikey => @params) : @params;

    my $key = $params{apikey} or croak q('apikey' is required);

    my $self = bless \ %params, $class;
    $self->{key} = uri_unescape($key),

    $self->{host} = $params{host} ? $params{host}
        : ($params{open} ? 'open' : 'www') . '.mapquestapi.com';

    $self->ua(
        $params{ua} || LWP::UserAgent->new(agent => "$class/$VERSION")
    );

    if ($self->{debug}) {
        my $dump_sub = sub { $_[0]->dump(maxlength => 0); return };
        $self->ua->set_my_handler(request_send  => $dump_sub);
        $self->ua->set_my_handler(response_done => $dump_sub);
    }
    elsif (exists $self->{compress} ? $self->{compress} : 1) {
        $self->ua->default_header(accept_encoding => 'gzip,deflate');
    }

    croak q('https' requires LWP::Protocol::https)
        if $self->{https} and not $self->ua->is_protocol_supported('https');

    return $self;
}

sub response { $_[0]->{response} }

sub ua {
    my ($self, $ua) = @_;
    if ($ua) {
        croak q('ua' must be (or derived from) an LWP::UserAgent')
            unless ref $ua and $ua->isa(q(LWP::UserAgent));
        $self->{ua} = $ua;
    }
    return $self->{ua};
}

sub geocode {
    my ($self, @params) = @_;
    my %params = (@params % 2) ? (location => @params) : @params;

    my $location = $params{location} or return;
    $location = Encode::encode('utf-8', $location);

    my $country = $params{country};

    my $uri = URI->new("http://$self->{host}/geocoding/v1/address");
    $uri->query_form(
        key      => $self->{key},
        location => $location,
        $country ? (adminArea1 => $country) : (),
    );
    $uri->scheme('https') if $self->{https};

    my $res = $self->{response} = $self->ua->get($uri);
    return unless $res->is_success;

    # Change the content type of the response from 'application/json' so
    # HTTP::Message will decode the character encoding.
    $res->content_type('text/plain');

    my $data = eval { from_json($res->decoded_content) };
    return unless $data;

    my @results = @{ $data->{results}[0]{locations} || [] };
    if (@results) {
        $#results = 0 unless wantarray;

        # Keep the location data structure flat.
        my $provided = $data->{results}[0]{providedLocation}{location};
        $_->{providedLocation} = $provided for @results;
    }

    return wantarray ? @results : $results[0];
}

sub batch {
    my ($self, @params) = @_;
    my %params = (@params % 2) ? (locations => @params) : @params;

    my $locations = $params{locations} or return;
    $locations = \@params unless 'ARRAY' eq ref $locations;
    croak 'too many locations- limit is 100' if 100 < @$locations;

    $_ = Encode::encode('utf-8', $_) for @$locations;

    my $uri = URI->new("http://$self->{host}/geocoding/v1/batch");
    $uri->query_form(
        key      => $self->{key},
        location => $locations,
    );
    $uri->scheme('https') if $self->{https};

    my $res = $self->{response} = $self->ua->get($uri);
    return unless $res->is_success;

    # Change the content type of the response from 'application/json' so
    # HTTP::Message will decode the character encoding.
    $res->content_type('text/plain');

    my $data = eval { from_json($res->decoded_content) };
    return unless $data;

    my @results;
    for my $result (@{ $data->{results} || [] }) {
        my $locations = $result->{locations};

        # Keep the location data structure flat.
        my $provided = $result->{providedLocation}{location};
        $_->{providedLocation} = $provided for @$locations;

        push @results, $locations;
    }

    return @results;
}


1;

__END__