File Coverage

blib/lib/Geo/Coder/TomTom.pm

Criterion	Covered	Total	%
statement	37	59	62.7
branch	7	28	25.0
condition	1	5	20.0
subroutine	9	12	75.0
pod	4	4	100.0
total	58	108	53.7

package Geo::Coder::TomTom;

use strict;
use warnings;

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

our $VERSION = '0.03';
$VERSION = eval $VERSION;

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

    my $self = bless \ %params, $class;

    $self->{apikey} ||= '1e2099c7-eea9-476b-aac9-b20dc7100af1';

    if ($params{ua}) {
        $self->ua($params{ua});
    }
    else {
        $self->{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);
    }

    $self->{compress} = 1 unless exists $self->{compress};
    $self->ua->default_header(accept_encoding => 'gzip,deflate')
        if $self->{compress};

    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;

    my $uri = URI->new('http://routes.tomtom.com');
    $uri->path(
        '/lbs/services/geocode/1/query/' . uri_escape_utf8($location) .
        '/json/' . $self->{apikey} . ';language=en;map=basic'
    );

    my $res = $self->{response} = $self->ua->get(
        $uri, referer => 'http://routes.tomtom.com/'
    );
    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 $content = $res->decoded_content;
    return unless $content;

    my $data = eval { from_json($content) };
    return unless $data;

    # Result is a list only if there is more than one item.
    my $results = $data->{geoResponse}{geoResult};
    my @results = 'ARRAY' eq ref $results ? @$results : ($results);

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


1;

__END__