Permalink
Browse files

new release

    - Added https option.
    - Added batch method.
    - Added providedLocation field to the returned locations.
  • Loading branch information...
1 parent 676f070 commit f83bb813715c348cf254661b1d1b999f06eeafab @gray committed Jun 17, 2010
Showing with 202 additions and 31 deletions.
  1. +6 −1 Changes
  2. +1 −0 MANIFEST
  3. +20 −5 Makefile.PL
  4. +2 −1 README
  5. +88 −16 lib/Geo/Coder/Mapquest.pm
  6. +24 −4 t/01_new.t
  7. +13 −0 t/02_batch.t
  8. +48 −4 xt/live.t
View
@@ -1,6 +1,11 @@
Revision history for Geo-Coder-Mapquest
-0.03
+0.04 Wed Jun 16 21:07:08 UTC 2010
+ - Added https option.
+ - Added batch method.
+ - Added providedLocation field to the returned locations.
+
+0.03 Wed Dec 2 09:36:30 PST 2009
- Updated to reflect Mapquest moved the service out of beta.
- Location is no longer limited to only unicode-flagged strings or
UTF-8 bytes.
View
@@ -6,6 +6,7 @@ MANIFEST This list of files
README
t/00_compile.t
t/01_new.t
+t/02_batch.t
xt/kwalitee.t
xt/live.t
xt/perlcritic.t
View
@@ -2,36 +2,51 @@ use strict;
use warnings;
use ExtUtils::MakeMaker;
+my @recommends;
+unless (eval { require IO::Socket::SSL; 1 }) {
+ push @recommends, 'Crypt::SSLeay' => 0;
+}
+
my %conf = (
NAME => 'Geo::Coder::Mapquest',
AUTHOR => 'gray <gray@cpan.org>',
LICENSE => 'perl',
VERSION_FROM => 'lib/Geo/Coder/Mapquest.pm',
ABSTRACT_FROM => 'lib/Geo/Coder/Mapquest.pm',
- PREREQ_PM => {
+ PREREQ_PM => {
'Encode' => 0,
'JSON' => 2.0,
'LWP::UserAgent' => 0,
- 'Test::More' => 0,
'URI' => 1.36,
'URI::Escape' => 0,
},
+ BUILD_REQUIRES => {
+ 'Devel::Hide' => 0,
+ 'Test::More' => 0.82,
+ },
META_MERGE => {
resources => {
repository => 'http://github.com/gray/geo-coder-mapquest',
},
recommends => {
- 'JSON::XS' => 2.0,
+ 'JSON::XS' => 2.0,
+ 'Net::HTTPS' => 0,
+ @recommends,
},
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Geo-Coder-Mapquest-*' },
);
-unless (eval { ExtUtils::MakeMaker->VERSION(6.46) }) {
- delete $conf{META_MERGE};
+my $eumm_version=$ExtUtils::MakeMaker::VERSION;
+delete $conf{META_MERGE} if $eumm_version < 6.46;
+if ($conf{BUILD_REQUIRES} and $eumm_version < 6.5503) {
+ $conf{PREREQ_PM} = {
+ %{ $conf{PREREQ_PM} || {} }, %{ delete $conf{BUILD_REQUIRES} },
+ };
}
+
WriteMakefile(%conf);
View
3 README
@@ -16,6 +16,7 @@ DEPENDENCIES
This module requires these other modules and libraries:
+ Devel::Hide
Encode
JSON
LWP::UserAgent
@@ -25,7 +26,7 @@ This module requires these other modules and libraries:
COPYRIGHT AND LICENCE
-Copyright (C) 2009 by gray <gray@cpan.org>
+Copyright (C) 2009-2010 by gray <gray@cpan.org>
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
View
@@ -10,11 +10,12 @@ use LWP::UserAgent;
use URI;
use URI::Escape qw(uri_unescape);
-our $VERSION = '0.03';
+our $VERSION = '0.04';
$VERSION = eval $VERSION;
sub new {
- my ($class, %params) = @_;
+ my ($class, @params) = @_;
+ my %params = (@params % 2) ? (apikey => @params) : @params;
my $key = $params{apikey} or croak q('apikey' is required);
@@ -27,8 +28,16 @@ sub new {
);
if ($params{debug}) {
- $self->ua->add_handler(request_send => sub { warn shift->dump; return });
- $self->ua->add_handler(response_done => sub { warn shift->dump; return });
+ 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);
+ }
+
+ if ($params{https}) {
+ croak q('https' requires Crypt::SSLeay or IO::Socket::SSL)
+ unless eval { require Net::HTTPS; 1 };
+
+ $self->{https} = 1;
}
return $self;
@@ -45,32 +54,83 @@ sub ua {
}
sub geocode {
- my $self = shift;
+ my ($self, @params) = @_;
+ my %params = (@params % 2) ? (location => @params) : @params;
- my %params = (@_ % 2) ? (location => shift, @_) : @_;
my $location = $params{location} or return;
- my $country = $params{country};
-
$location = Encode::encode('utf-8', $location);
- my $uri = URI->new(
- 'http://www.mapquestapi.com/geocoding/v1/address'
- );
+ my $country = $params{country};
+
+ my $proto = $self->{https} ? 'https' : 'http';
+ my $uri = URI->new("$proto://www.mapquestapi.com/geocoding/v1/address");
$uri->query_form(
key => $self->{key},
location => $location,
$country ? (adminArea1 => $country) : (),
+ );
+
+ my $res = $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 @locations = @{ $data->{results}[0]{locations} || [] };
+ if (@locations) {
+ $#locations = 0 unless wantarray;
+
+ # Keep the location data structure flat.
+ my $provided = $data->{results}[0]{providedLocation}{location};
+ $_->{providedLocation} = $provided for @locations;
+ }
+ return wantarray ? @locations : $locations[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 $proto = $self->{https} ? 'https' : 'http';
+ my $uri = URI->new("$proto://www.mapquestapi.com/geocoding/v1/batch");
+ $uri->query_form(
+ key => $self->{key},
+ location => $locations,
);
my $res = $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} || [] };
- return wantarray ? @results : $results[0];
+ 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;
}
@@ -86,7 +146,7 @@ Geo::Coder::Mapquest - Geocode addresses with Mapquest
use Geo::Coder::Mapquest;
- my $geocoder = Geo::Coder::Mapquest->new(apikey => 'Your API Key');
+ my $geocoder = Geo::Coder::Mapquest->new(apikey => 'Your API key');
my $location = $geocoder->geocode(
location => 'Hollywood and Highland, Los Angeles, CA'
);
@@ -100,13 +160,15 @@ Geocoding Web Service.
=head2 new
- $geocoder = Geo::Coder::Mapquest->new(apikey => 'Your API Key')
+ $geocoder = Geo::Coder::Mapquest->new(apikey => 'Your API key')
Creates a new geocoding object.
A valid developer 'apikey' is required. See L</NOTES> on how to obtain one
and set it up.
+Accepts an optional B<https> parameter for securing network traffic.
+
Accepts an optional B<ua> parameter for passing in a custom LWP::UserAgent
object.
@@ -137,11 +199,21 @@ Each location result is a hashref; a typical example looks like:
linkId => 0,
mapUrl => "http://www.mapquestapi.com/staticmap/v3/getmap?type=map&size=225,160&pois=purple-1,34.10155,-118.33869,0,0|&center=34.10155,-118.33869&zoom=12&key=Dmjtd|lu612ha7ng,ag=o5-5at2u&rand=1659284599",
postalCode => 90028,
+ providedLocation => "Hollywood and Highland, Los Angeles, CA",
sideOfStreet => "N",
street => "Hollywood Blvd & N Highland Ave",
type => "s",
}
+=head2 batch
+
+ @results = $geocoder->geocode(locations => [ $location, ... ])
+
+Allows up to 100 locations to be geocoded in the same request. Returns
+a list of results, each of which is a reference to a list of locations.
+Will croak if more than 100 locations are given.
+
+
=head2 ua
$ua = $geocoder->ua()
@@ -212,7 +284,7 @@ L<http://search.cpan.org/dist/Geo-Coder-Mapquest>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2009 gray <gray at cpan.org>, all rights reserved.
+Copyright (C) 2009-2010 gray <gray at cpan.org>, all rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
View
@@ -1,8 +1,28 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 7;
use Geo::Coder::Mapquest;
-my $geo = Geo::Coder::Mapquest->new(apikey => 'placeholder');
-isa_ok($geo, 'Geo::Coder::Mapquest', 'new');
-can_ok('Geo::Coder::Mapquest', qw(geocode ua));
+new_ok('Geo::Coder::Mapquest' => ['Your API key']);
+new_ok('Geo::Coder::Mapquest' => ['Your API key', debug => 1]);
+new_ok('Geo::Coder::Mapquest' => [apikey => 'Your API key']);
+new_ok('Geo::Coder::Mapquest' => [apikey => 'Your API key', debug => 1]);
+
+{
+ local $@;
+ eval {
+ my $geocoder = Geo::Coder::Mapquest->new(debug => 1);
+ };
+ like($@, qr/^'apikey' is required/, 'apikey is required');
+
+ use Devel::Hide qw( Net::HTTPS );
+ my $geocoder = eval {
+ Geo::Coder::Mapquest->new(
+ apikey => 'Your API key',
+ https => 1,
+ );
+ };
+ like($@, qr/^'https' requires/, 'https fails w/o an SSL module');
+}
+
+can_ok('Geo::Coder::Mapquest', qw(geocode batch ua));
View
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Geo::Coder::Mapquest;
+
+my $geocoder = Geo::Coder::Mapquest->new('You API key');
+{
+ local $@;
+ eval {
+ my @locations = $geocoder->batch([ (0..101) ]);
+ };
+ like($@, qr/^too many locations- limit is 100/, 'too many locations');
+}
Oops, something went wrong.

0 comments on commit f83bb81

Please sign in to comment.