File Coverage

blib/lib/Geo/Distance/Google.pm

Criterion	Covered	Total	%
statement	30	133	22.5
branch	0	54	0.0
condition	0	43	0.0
subroutine	10	20	50.0
pod	9	9	100.0
total	49	259	18.9

package Geo::Distance::Google;

use strict;
use warnings;

our $VERSION = '0.01';

use Carp;
use Data::Dumper qw( Dumper );
use Encode;
use JSON;
use HTTP::Request;
use LWP::UserAgent;
use Params::Validate;
use URI;

sub new {
    my($class, %param) = @_;

    my $ua       = delete $param{ua}       || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
    my $host     = delete $param{host}     || 'maps.googleapis.com';

    my $language = delete $param{language} || delete $param{hl};
    my $region   = delete $param{region}   || delete $param{gl};
    my $oe       = delete $param{oe}       || 'utf8';
    my $sensor   = delete $param{sensor}   || 0;
    my $client   = delete $param{client}   || '';
    my $key      = delete $param{key}      || '';
    my $units    = delete $param{units}    || '';
    my $mode     = delete $param{mode};
    my $avoid    = delete $param{avoid};
    my $https    = delete $param{https}    || 0;
    my $debug    = delete $param{debug}    || 0;

    bless {
        ua => $ua,
        host => $host,
        language => $language,
        region => $region,
        oe => $oe,
        sensor => $sensor,
        client => $client,
        key => $key,
        units  => $units,
        mode => $mode,
        avoid => $avoid,
        https => $https,
        __debug__ => $debug
    }, $class;
}

sub debug_level {
    my $self = shift;

    if ( @_ ) { $self->{__debug__} = shift; }

    return $self->{__debug__};
}

sub ua {
    my $self = shift;
    if (@_) {
        $self->{ua} = shift;
    }
    $self->{ua};
}

sub raw_distance {
    my $self = shift;

    $self->{__raw_response__} = shift if @_;

    return $self->{__raw_response__};
}

sub distance {
    my $self = shift;
    my %p    = validate @_, {
        origins      => 1,
        destinations => 1,
        mode         => 0,
        avoid        => 0,
        units        => 0
    };

    my $origins;
    my $destinations;

    # both can be array refs or single items
    foreach my $k ( qw( origins destinations ) ) {
        # convert to google format

        # TODO: in future allow seperate lat & long in hash ref
        if ( ref $p{$k} ne 'ARRAY' ) {
            $p{$k} = [ $p{$k} ];
        }
    }

    $origins      = join '|', @{ $p{origins} };
    $destinations = join '|', @{ $p{destinations} };


    $origins      = Encode::is_utf8( $origins ) ? Encode::encode_utf8( $origins ) : $origins;
    $destinations = Encode::is_utf8( $destinations ) ? Encode::encode_utf8( $destinations ) : $destinations;

    my $url = sprintf "%s://%s/maps/api/distancematrix/json",
        ( $self->{https} ? 'https' : 'http' ), $self->{host};

    my $uri = URI->new($url);

    # build query
    my %query_parameters = (
        origins      => $origins,
        destinations => $destinations,
        oe           => $self->{oe},
        sensor       => ( $self->{sensor} ? 'true' : 'false' ),
        # optional parameters
        ( $self->{units} ? ( units => $self->{units} ) : () ),
        ( $p{mode}       ? ( mode => $p{mode} )
            : defined $self->{mode} ? ( mode => $self->{mode} ) : ()),
        # TODO: add support for avoid as list ref process too
        ( $p{avoid} ? ( avoid => $p{avoid} )
            : defined $self->{avoid} ? ( avoid => $self->{avoid} ) : () )
    );

    # not sure about these
    $query_parameters{language} = $self->{language} if defined $self->{language};
    $query_parameters{region}   = $self->{region}   if defined $self->{region};

    $uri->query_form(%query_parameters);

    # setup request
    $url = $uri->as_string;

    # Process Maps Premier account info
    if ($self->{client} and $self->{key}) {
        $query_parameters{client} = $self->{client};
        $uri->query_form(%query_parameters);

        my $signature = $self->make_signature($uri);
        # signature must be last parameter in query string or you get 403's
        $url = $uri->as_string;
        $url .= '&signature='.$signature if $signature;
    }

    $self->debug( "Sending request: $url" );

    my $res = $self->{ua}->get($url);

    if ($res->is_error) {
        Carp::croak("Google Maps API returned error: " . $res->status_line);
    }

    if ( $res->headers->content_type !~ /json/ ) {
        my $ct = $res->headers->content_type;
        croak "Invalid content-type '$ct' returned from webserver";
    }

    my $json = JSON->new->utf8;
    my $data = $json->decode($res->content);

    $self->raw_distance( $data );

    $self->debug( "data: " . Dumper( $data ) );

    if ( ! defined $data->{status} || $data->{status} ne 'OK' ) {
        croak "Google Maps API status error: " . ( $data->{status} || 'Invalid status' );
    }

    # reprocess to make more friendly (IMO)
    my $distance = [];

    # origins[0] correspond to rows[0]
    # destinations[0] correspond to rows->[x]->elements[0]
    for ( my $oid = 0; $oid < scalar( @{ $p{origins} } ); $oid++ ) {

        # verify origin information
        next unless defined $data->{origin_addresses} &&
            defined $data->{origin_addresses}->[$oid];

        # missing return data
        next unless defined $data->{rows} && $data->{rows}->[$oid];

        $distance->[$oid]->{origin_address} = $data->{origin_addresses}->[$oid];

        my $elements = $data->{rows}->[$oid]->{elements};

        # loop through each destination address
        foreach ( my $did = 0; $did < scalar( @{ $p{destinations} } ); $did++ ) {
            next unless defined $elements->[$did];

            # reformat it to be a bit nicer for the consumer
            $distance->[$oid]->{destinations}->[$did] = {
                address  => $data->{destination_addresses}->[$did],
                distance => $elements->[$did]->{distance},
                duration => $elements->[$did]->{duration},
                status   => $elements->[$did]->{status}
            };
        }

    }

    $self->debug( "distance: " . Dumper($distance) );

    return $distance;
}

# methods below adapted from
# http://gmaps-samples.googlecode.com/svn/trunk/urlsigning/urlsigner.pl
sub decode_urlsafe_base64 {
  my ($self, $content) = @_;

  $content =~ tr/-/\+/;
  $content =~ tr/_/\//;

  return MIME::Base64::decode_base64($content);
}

sub encode_urlsafe{
  my ($self, $content) = @_;
  $content =~ tr/\+/\-/;
  $content =~ tr/\//\_/;

  return $content;
}

sub make_signature {
  my ($self, $uri) = @_;

  require Digest::HMAC_SHA1;
  require MIME::Base64;

  my $key = $self->decode_urlsafe_base64($self->{key});
  my $to_sign = $uri->path_query;

  my $digest = Digest::HMAC_SHA1->new($key);
  $digest->add($to_sign);
  my $signature = $digest->b64digest;

  return $self->encode_urlsafe($signature);
}

# search input hash ref, then self for defined parameter or
# return empty list
sub _get_multiple {
    my $self = shift;
    my $p    = shift || return (); # params
    my $key  = shift || return (); # key

    return () unless ref $p eq 'HASH';

    return defined $p->{$key} ? ( $key => $p->{$key} )
        : defined $self->{$key} ? ( $key => $self->{$key} ) : ();
}

sub debug {
    my $self = shift;
    my $f = (caller(1))[3];

    return unless $self->debug_level;

    printf STDERR "%s [%s] %s\n", scalar( localtime ), $f, shift;
}


1;

__END__