File Coverage

blib/lib/Geo/Coder/Bing/Bulk.pm

Criterion	Covered	Total	%
statement	42	116	36.2
branch	11	60	18.3
condition	3	18	16.6
subroutine	10	19	52.6
pod	7	7	100.0
total	73	220	33.1

package Geo::Coder::Bing::Bulk;

use strict;
use warnings;

use Carp qw(croak);
use Encode ();
use HTTP::Request::Common ();
use JSON;
use LWP::UserAgent;
use URI;

our $VERSION = '0.04';
$VERSION = eval $VERSION;

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

    croak q('key' is required) unless $params{key};

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

    $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');

    $self->{status}  = '';

    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 upload {
    my $self = shift;

    my $locs = (1 == @_ and 'ARRAY' eq ref $_[0]) ? $_[0] : \@_;
    return unless @$locs;

    my $uri = URI->new(
        'http://spatial.virtualearth.net/REST/v1/Dataflows/Geocode',
    );
    $uri->scheme('https') if $self->{https};
    $uri->query_form(
        key   => $self->{key},
        input => 'pipe',
    );

    my $req = HTTP::Request::Common::POST(
        $uri, content_type => 'text/plain',
    );

    my $id = 0;
    for my $loc (@$locs) {
        (my $str = $loc) =~ tr/|\n\r/ /s;
        $req->add_content_utf8("$id||$str\n");
        $id++;
    }
    # Prevents LWP warning about wrong content length.
    $req->content_length(length(${$req->content_ref}));

    my $res = $self->{response} = $self->ua->request($req);
    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;

    return $self->{id} = $data->{resourceSets}[0]{resources}[0]{id};
}

sub is_pending {
    my ($self) = @_;

    my $status = $self->_status;
    return 1 if not $status or 'pending' eq $status;
}

sub _status {
    my ($self) = @_;

    return unless $self->{content} or $self->{id};

    my $uri = URI->new(
        'http://spatial.virtualearth.net/REST/v1/Dataflows/Geocode/' .
        $self->{id}
    );
    $uri->scheme('https') if $self->{https};
    $uri->query_form(
        key => $self->{key},
    );

    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 $content = $res->decoded_content;
    return unless $content;

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

    my $resources = $data->{resourceSets}[0]{resources}[0];
    return unless $resources->{status};

    $self->{failed}    = 1 if $resources->{failedEntityCount};
    $self->{succeeded} = 1 if $resources->{processedEntityCount};

    return $self->{status} = lc $resources->{status};
}

sub download { $_[0]->_download('succeeded') }
sub failed   { $_[0]->_download('failed') }

sub _download {
    my ($self, $type) = @_;

    return unless 'completed' eq $self->{status};
    return unless $self->{$type};

    my $uri = URI->new(
        'http://spatial.virtualearth.net/REST/v1/Dataflows/Geocode/' .
        $self->{id} . '/output/' . $type
    );
    $uri->scheme('https') if $self->{https};
    $uri->query_form(
        key => $self->{key},
    );

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

    my $content_ref = $res->decoded_content(ref => 1);
    return unless $$content_ref;

    return $self->_parse_output($content_ref);
}

# Convert the pipe-delimited output to a data structure conforming
# to the data schema described here [1].
# [1] http://msdn.microsoft.com/en-us/library/ff701736.aspx
my %field_mapping = (
    0  => 'Id',
    2  => 'Query',
    12 => [ Address => 'AddressLine' ],
    13 => [ Address => 'AdminDistrict' ],
    14 => [ Address => 'CountryRegion' ],
    15 => [ Address => 'District' ],
    16 => [ Address => 'FormattedAddress' ],
    17 => [ Address => 'Locality' ],
    18 => [ Address => 'PostalCode' ],
    19 => [ Address => 'PostalTown' ],
    20 => [ RooftopLocation => 'Latitude' ],
    21 => [ RooftopLocation => 'Longitude' ],
    22 => [ InterpolatedLocation => 'Latitude' ],
    23 => [ InterpolatedLocation => 'Longitude' ],
    24 => 'Confidence',
    25 => 'DisplayName',
    26 => 'EntityType',
    27 => 'StatusCode',
    28 => 'FaultReason',
);

sub _parse_output {
    my ($self, $ref) = @_;

    my @data;
    while ($$ref =~ /([^\n\r]+)/g) {
        my @fields = split '\|', $1, 31;
        my $data = {};
        for my $i (keys %field_mapping) {
            my $val = $fields[$i];
            if (length $val) {
                my $key = $field_mapping{$i};
                if (ref $key) {
                    $data->{$key->[0]}{$key->[1]} = $val;
                }
                else {
                    $data->{$key} = $val;
                }
            }
        }
        push @data, $data;
    }

    return \@data;
}


1;

__END__