Geo-Coder-Googlev3-0.16/000755 001750 001750 00000000000 13132216557 015514 5ustar00eserteeserte000000 000000 Geo-Coder-Googlev3-0.16/t/000755 001750 001750 00000000000 13132216556 015756 5ustar00eserteeserte000000 000000 Geo-Coder-Googlev3-0.16/Changes000644 001750 001750 00000003331 13132215035 016775 0ustar00eserteeserte000000 000000 Revision history for Perl extension Geo::Coder::Googlev3. 0.16 2017-07-14 - new parameter key - new parameter use_https - no default for sensor is set anymore - failing bounds test is now marked as TODO (RT #122485) - improved test diagnostics 0.15 - fixed test for changed results (Brandenburger Tor vs Pariser Platz) 0.14 - documentation fix [github.com pull request #2] - fixed test for changed results (Oeschelbronner Weg vs. Path) 0.13 - stable release with all changes in 0.12_50..0.12_51 0.12_51 - all test cases (also the first one) are run using safe_geocode 0.12_50 - sensor is settable [rt.cpan.org #78520] - specified POD encoding [rt.cpan.org #89213] 0.12 - fixed test for changed results (Toledo, ES moved) 0.11 - stable release with all changes in 0.10_50..0.10_52 0.10_52 - implemented bounds parameter and accessor 0.10_51 - again just test fixes, protecting against OVER_QUERY_LIMIT in tests 0.10_50 - various test fixes for changed Google output, and protect from floating point inaccuracy 0.10 - accessors for region and language (provided by abh) 0.09 - default LWP::UserAgent object sets env_proxy [rt.cpan.org #66480] and sets timeout to 15s - tests are skipped if there's no network connection [rt.cpan.org #65873] 0.08 - fixed test for changed results [rt.cpan.org #68437] 0.07 - ZERO_RESULTS is not anymore an error, but is returned as an empty result - raw option 0.06 - more diagnostics if an API call failed (status!=OK) 0.05 - geocode method now returns multiple results in list context 0.04 - just another test fix 0.03 - fixed test to accommodate changed results from Google 0.02 - more Pod - more tests (region-specific) 0.01 - first working version Geo-Coder-Googlev3-0.16/.gitignore000644 001750 001750 00000000150 11777613031 017501 0ustar00eserteeserte000000 000000 /.prove /Geo-Coder-Googlev3-*.tar.gz /MYMETA.json /MYMETA.yml /Makefile /Makefile.old /blib /pm_to_blib Geo-Coder-Googlev3-0.16/MANIFEST000644 001750 001750 00000000440 13132216560 016635 0ustar00eserteeserte000000 000000 .gitignore Changes lib/Geo/Coder/Googlev3.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/geocode.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Geo-Coder-Googlev3-0.16/MANIFEST.SKIP000644 001750 001750 00000001776 13040501213 017405 0ustar00eserteeserte000000 000000 #!start included /usr/local/lib/perl5/5.16/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid MYMETA files ^MYMETA\. #!end included /usr/local/lib/perl5/5.16/ExtUtils/MANIFEST.SKIP ^.travis.yml ^appveyor.yml ^Geo-Coder-Googlev3-\d+\.\d+\.tar\.gz$ Geo-Coder-Googlev3-0.16/lib/000755 001750 001750 00000000000 13132216556 016261 5ustar00eserteeserte000000 000000 Geo-Coder-Googlev3-0.16/Makefile.PL000644 001750 001750 00000002075 11777613031 017473 0ustar00eserteeserte000000 000000 use strict; use 5.6.0; use ExtUtils::MakeMaker; my $is_devel_host = defined $ENV{USER} && $ENV{USER} eq 'eserte' && $^O =~ /bsd/i && -f "../../perl.release.mk"; my $eumm_recent_enough = $ExtUtils::MakeMaker::VERSION >= 6.54; if (!$eumm_recent_enough) { *MY::dist_core = sub { <<'EOF'; dist : $(NOECHO) $(ECHO) "Sorry, use a newer EUMM!" EOF }; } WriteMakefile( NAME => 'Geo::Coder::Googlev3', VERSION_FROM => 'lib/Geo/Coder/Googlev3.pm', PREREQ_PM => { 'Encode' => 0, 'JSON::XS' => 0, 'LWP::UserAgent' => 0, 'URI' => 0, }, LICENSE => 'perl', ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/Geo/Coder/Googlev3.pm', AUTHOR => 'Slaven Rezic ') : ()), ($eumm_recent_enough ? (META_ADD => { resources => { repository => 'git://github.com/eserte/Geo-Coder-Googlev3.git' } }) : ()), ); sub MY::postamble { my $postamble = ''; if ($is_devel_host) { $postamble .= <<'EOF'; .include "../../perl.release.mk" .include "../../perl.git.mk" EOF } $postamble; } Geo-Coder-Googlev3-0.16/README000644 001750 001750 00000000276 11777613031 016402 0ustar00eserteeserte000000 000000 Geo::Coder::Googlev3 -------------------- An implementation of version 3 of Google's Geocoding API. Notable difference to version 2: an API key is not needed anymore. Author: Slaven Rezic Geo-Coder-Googlev3-0.16/META.yml000644 001750 001750 00000001136 13132216556 016765 0ustar00eserteeserte000000 000000 --- abstract: 'Google Maps v3 Geocoding API ' author: - 'Slaven Rezic ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Geo-Coder-Googlev3 no_index: directory: - t - inc requires: Encode: 0 JSON::XS: 0 LWP::UserAgent: 0 URI: 0 resources: repository: git://github.com/eserte/Geo-Coder-Googlev3.git version: 0.16 Geo-Coder-Googlev3-0.16/META.json000644 001750 001750 00000002104 13132216557 017132 0ustar00eserteeserte000000 000000 { "abstract" : "Google Maps v3 Geocoding API ", "author" : [ "Slaven Rezic " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Geo-Coder-Googlev3", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Encode" : "0", "JSON::XS" : "0", "LWP::UserAgent" : "0", "URI" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "git://github.com/eserte/Geo-Coder-Googlev3.git" } }, "version" : "0.16" } Geo-Coder-Googlev3-0.16/lib/Geo/000755 001750 001750 00000000000 13132216556 016773 5ustar00eserteeserte000000 000000 Geo-Coder-Googlev3-0.16/lib/Geo/Coder/000755 001750 001750 00000000000 13132216556 020027 5ustar00eserteeserte000000 000000 Geo-Coder-Googlev3-0.16/lib/Geo/Coder/Googlev3.pm000644 001750 001750 00000022207 13132214716 022051 0ustar00eserteeserte000000 000000 # -*- mode:perl; coding:iso-8859-1 -*- # # Author: Slaven Rezic # # Copyright (C) 2010,2011,2013,2014,2017 Slaven Rezic. All rights reserved. # This package is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # package Geo::Coder::Googlev3; use strict; use vars qw($VERSION); our $VERSION = '0.16'; use Carp ('croak'); use Encode (); use JSON::XS (); use LWP::UserAgent (); use URI (); use URI::QueryParam (); sub new { my($class, %args) = @_; my $self = bless {}, $class; $self->{ua} = delete $args{ua} || LWP::UserAgent->new( agent => __PACKAGE__ . "/$VERSION libwww-perl/$LWP::VERSION", env_proxy => 1, timeout => 15, ); $self->{region} = delete $args{region} || delete $args{gl}; $self->{language} = delete $args{language}; { my $sensor; if ($args{sensor}) { $sensor = delete $args{sensor}; if ($sensor !~ m{^(false|true)$}) { croak "sensor argument has to be either 'false' or 'true'"; } } $self->{sensor} = $sensor; } if ($args{bounds}) { $self->bounds(delete $args{bounds}); } $self->{key} = delete $args{key}; $self->{use_https} = delete $args{use_https}; croak "Unsupported arguments: " . join(" ", %args) if %args; $self; } sub ua { my $self = shift; if (@_) { $self->{ua} = shift; } $self->{ua}; } sub geocode { my($self, %args) = @_; my $raw = delete $args{raw}; my $url = $self->geocode_url(%args); my $ua = $self->ua; my $resp = $ua->get($url); if ($resp->is_success) { my $content = $resp->decoded_content(charset => "none"); my $res = JSON::XS->new->utf8->decode($content); if ($raw) { return $res; } if ($res->{status} eq 'OK') { if (wantarray) { return @{ $res->{results} }; } else { return $res->{results}->[0]; } } elsif ($res->{status} eq 'ZERO_RESULTS') { return; } else { croak "Fetching $url did not return OK status, but '" . $res->{status} . "'"; } } else { croak "Fetching $url failed: " . $resp->status_line; } } # private! sub geocode_url { my($self, %args) = @_; my $loc = $args{location}; my $url = URI->new(($self->{use_https} ? 'https' : 'http') . '://maps.google.com/maps/api/geocode/json'); my %url_params; $url_params{address} = $loc; $url_params{sensor} = $self->{sensor} if defined $self->{sensor}; $url_params{region} = $self->{region} if defined $self->{region}; $url_params{language} = $self->{language} if defined $self->{language}; if (defined $self->{bounds}) { $url_params{bounds} = join '|', map { $_->{lat}.','.$_->{lng} } @{ $self->{bounds} }; } $url_params{key} = $self->{key} if defined $self->{key}; while(my($k,$v) = each %url_params) { $url->query_param($k => Encode::encode_utf8($v)); } $url = $url->as_string; $url; } sub region { my $self = shift; $self->{region} = shift if @_; return $self->{region}; } sub language { my $self = shift; $self->{language} = shift if @_; return $self->{language}; } sub sensor { my $self = shift; $self->{sensor} = shift if @_; return $self->{sensor}; } use constant _BOUNDS_ERROR_MSG => "bounds must be in the form [{lat=>...,lng=>...}, {lat=>...,lng=>...}]"; sub bounds { my $self = shift; if (@_) { my $bounds = shift; if (ref $bounds ne 'ARRAY') { croak _BOUNDS_ERROR_MSG . ', but the supplied parameter is not even an array reference.'; } if (@$bounds != 2) { croak _BOUNDS_ERROR_MSG . ', but the supplied parameter has not exactly two array elements.'; } if ((grep { ref $_ eq 'HASH' && exists $_->{lng} && exists $_->{lat} ? 1 : 0 } @$bounds) != 2) { croak _BOUNDS_ERROR_MSG . ', but the supplied elements are not lat/lng hashes.'; } $self->{bounds} = $bounds; } return $self->{bounds}; } 1; __END__ =encoding ISO8859-1 =head1 NAME Geo::Coder::Googlev3 - Google Maps v3 Geocoding API =head1 SYNOPSIS use Geo::Coder::Googlev3; my $geocoder = Geo::Coder::Googlev3->new; my $location = $geocoder->geocode(location => 'Brandenburger Tor, Berlin'); my @locations = $geocoder->geocode(location => 'Berliner Straße, Berlin, Germany'); =head1 DESCRIPTION Use this module just like L. Note that no C is used in Google's v3 API, and the returned data structure differs. Please check also L for more information about Google's Geocoding API and especially usage limits. =head2 CONSTRUCTOR =over =item new $geocoder = Geo::Coder::Googlev3->new; $geocoder = Geo::Coder::Googlev3->new(language => 'de', gl => 'es'); Creates a new geocoding object. The C parameter may be supplied to override the default L object. The default C object sets the C to 15 seconds and enables the C option. The L's C parameter is not supported. The parameters C, C, C, and C are also accepted. The C parameter should be in the form: [{lat => ..., lng => ...}, {lat => ..., lng => ...}] The parameter C should be set to the string C if the geocoding request comes from a device with a location sensor (see L). There's no default. By default queries are done using C. By setting the C parameter to a true value C is used. =back =head2 METHODS =over =item geocode $location = $geocoder->geocode(location => $location); @locations = $geocoder->geocode(location => $location); Queries I<$location> to Google Maps geocoding API. In scalar context it returns a hash reference of the first (best matching?) location. In list context it returns a list of such hash references. The returned data structure looks like this: { "formatted_address" => "Brandenburger Tor, Pariser Platz 7, 10117 Berlin, Germany", "types" => [ "point_of_interest", "establishment" ], "address_components" => [ { "types" => [ "point_of_interest", "establishment" ], "short_name" => "Brandenburger Tor", "long_name" => "Brandenburger Tor" }, { "types" => [ "street_number" ], "short_name" => 7, "long_name" => 7 }, { "types" => [ "route" ], "short_name" => "Pariser Platz", "long_name" => "Pariser Platz" }, { "types" => [ "sublocality", "political" ], "short_name" => "Mitte", "long_name" => "Mitte" }, { "types" => [ "locality", "political" ], "short_name" => "Berlin", "long_name" => "Berlin" }, { "types" => [ "administrative_area_level_2", "political" ], "short_name" => "Berlin", "long_name" => "Berlin" }, { "types" => [ "administrative_area_level_1", "political" ], "short_name" => "Berlin", "long_name" => "Berlin" }, { "types" => [ "country", "political" ], "short_name" => "DE", "long_name" => "Germany" }, { "types" => [ "postal_code" ], "short_name" => 10117, "long_name" => 10117 } ], "geometry" => { "viewport" => { "southwest" => { "lat" => "52.5094785", "lng" => "13.3617711" }, "northeast" => { "lat" => "52.5230586", "lng" => "13.3937859" } }, "location" => { "lat" => "52.5162691", "lng" => "13.3777785" }, "location_type" => "APPROXIMATE" } }; The B option may be set to a true value to get the uninterpreted, raw result from the API. Just the JSON data will be translated into a perl hash. $raw_result = $geocoder->geocode(location => $location, raw => 1); =item region Accessor for the C parameter. The value should be a country code ("es", "dk", "us", etc). Use this to tell the webservice to prefer matches from that region. See the Google documentation for more information. =item language Accessor for the C parameter. =item bounds Accessor for the C parameter. =item sensor Accessor for the C parameter. =back =head1 AUTHOR Slaven Rezic This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L. =cut # Local Variables: # mode: cperl # cperl-indent-level: 4 # indent-tabs-mode: nil # End: # vim:sw=4:ts=8:sta:et Geo-Coder-Googlev3-0.16/t/geocode.t000644 001750 001750 00000023646 13132214650 017554 0ustar00eserteeserte000000 000000 # -*- coding:iso-8859-1; -*- use strict; use FindBin; use lib "$FindBin::RealBin"; use Test::More 'no_plan'; sub within ($$$$$$;$); sub safe_geocode (&;$); use_ok 'Geo::Coder::Googlev3'; my $geocoder = Geo::Coder::Googlev3->new; isa_ok $geocoder, 'Geo::Coder::Googlev3'; SKIP: { { # key my $geocoder = Geo::Coder::Googlev3->new(key => "INVALID_KEY"); my %info; safe_geocode { $geocoder->geocode(location => 'Berlin') } \%info; like $info{err}, qr{REQUEST_DENIED}, 'invalid api key'; } { # list context ## There are eight hits in Berlin. Google uses to know seven of them. ## But beginning from approx. 2010-05, only one location is returned. #my @locations = $geocoder->geocode(location => 'Berliner Straße, Berlin, Germany'); #cmp_ok scalar(@locations), ">=", 1, "One or more results found"; #like $locations[0]->{formatted_address}, qr{Berliner Straße}, 'First result looks OK'; my @locations = safe_geocode { $geocoder->geocode(location => 'Waterloo, UK') }; # Since approx. 2011-12 there's only one result, previously it was more cmp_ok scalar(@locations), ">=", 1, "One or more results found"; like $locations[0]->{formatted_address}, qr{Waterloo}, 'First result looks OK'; } { my $location = safe_geocode { $geocoder->geocode(location => 'Brandenburger Tor, Berlin, Germany') }; # Since approx. 2011-12 "brandenburg gate" instead of "brandenburger tor" is returned # Since approx. 2017-01 "pariser platz" is returned like $location->{formatted_address}, qr{(brandenburger tor.*berlin|brandenburg gate|pariser platz.*berlin.*germany)}i; my($lat, $lng) = @{$location->{geometry}->{location}}{qw(lat lng)}; within $lat, $lng, 52.5, 52.6, 13.3, 13.4; } { # ... but if language=>"de" is forced, then the German name is returned my $geocoder_de = Geo::Coder::Googlev3->new(language => 'de'); my $location = safe_geocode { $geocoder_de->geocode(location => 'Brandenburger Tor, Berlin, Germany') }; # Since approx. 2017-01 "pariser platz" is returned like $location->{formatted_address}, qr{(brandenburger tor.*berlin|pariser platz.*berlin.*deutschland)}i; my($lat, $lng) = @{$location->{geometry}->{location}}{qw(lat lng)}; within $lat, $lng, 52.5, 52.6, 13.3, 13.4; } # Since approx. 2014-10 "Oeschelbronner Path" instead of "Öschelbronner Weg" is returned (!) { # encoding checks - bytes my $location = safe_geocode { $geocoder->geocode(location => 'Öschelbronner Weg, Berlin, Germany') }; like $location->{formatted_address}, qr{schelbronner (weg|path).*berlin}i; my($lat, $lng) = @{$location->{geometry}->{location}}{qw(lat lng)}; within $lat, $lng, 52.6, 52.7, 13.3, 13.4; } { # encoding checks - utf8 my $street = 'Öschelbronner Weg'; utf8::upgrade($street); my $location = safe_geocode { $geocoder->geocode(location => "$street, Berlin, Germany") }; like $location->{formatted_address}, qr{schelbronner (weg|path).*berlin}i; my($lat, $lng) = @{$location->{geometry}->{location}}{qw(lat lng)}; within $lat, $lng, 52.6, 52.7, 13.3, 13.4; } { # encoding checks - more utf8 my $street = "Trg bana Josipa Jela\x{10d}i\x{107}a"; my $alternative = "Ban Jela\x{10d}i\x{107} Square"; # outcome as of 2011-02-02 my $alternative2 = 'City of Zagreb, Croatia'; # happened once in February 2011, see http://www.cpantesters.org/cpan/report/447c31b8-6cb5-1014-b648-c13506c0976e my $location = safe_geocode { $geocoder->geocode(location => "$street, Zagreb, Croatia") }; like $location->{formatted_address}, qr{($street|$alternative|$alternative2)}i; my($lat, $lng) = @{$location->{geometry}->{location}}{qw(lat lng)}; within $lat, $lng, 45.8, 45.9, 15.9, 16.0; } { my $postal_code = 'E1A 7G1'; my $location = safe_geocode { $geocoder->geocode(location => "$postal_code, Canada") }; my $postal_code_component; for my $address_component (@{ $location->{address_components} }) { if (grep { $_ eq 'postal_code' } @{ $address_component->{types} }) { $postal_code_component = $address_component; last; } } is $postal_code_component->{long_name}, $postal_code; } { # region my $geocoder_es = Geo::Coder::Googlev3->new(gl => 'es', language => 'de'); is $geocoder_es->language, 'de', 'language accessor'; is $geocoder_es->region, 'es', 'region accessor'; my $location_es = safe_geocode { $geocoder_es->geocode(location => 'Toledo') }; within $location_es->{geometry}->{location}->{lat}, $location_es->{geometry}->{location}->{lng}, 39.852434, 39.881947, -4.04314, -4.012585; my $geocoder_us = Geo::Coder::Googlev3->new(); my $location_us = safe_geocode { $geocoder_us->geocode(location => 'Toledo') }; within $location_us->{geometry}->{location}->{lat}, $location_us->{geometry}->{location}->{lng}, 41.663938, 41.663939, -83.55522, -83.55521; } { # bounds local $TODO = "Started to fail (RT #122485)"; # XXX check! my $location_chicago = safe_geocode { $geocoder->geocode(location => 'Winnetka') }; within $location_chicago->{geometry}->{location}->{lat}, $location_chicago->{geometry}->{location}->{lng}, 42.1080830, 42.1080840, -87.735900, -87.735890, 'Winnetka without bounds'; my $bounds = [{lat=>34.172684,lng=>-118.604794},{lat=>34.236144,lng=>-118.500938}]; my $geocoder_la = Geo::Coder::Googlev3->new(bounds => $bounds); is_deeply $geocoder_la->bounds, $bounds, 'bounds accessor'; my $location_la = safe_geocode { $geocoder_la->geocode(location => 'Winnetka') }; within $location_la->{geometry}->{location}->{lat}, $location_la->{geometry}->{location}->{lng}, 34.172684, 34.236144, -118.604794, -118.500938, 'Winnetka with bounds'; } { # invalid bounds eval { $geocoder->bounds('scalar') }; like $@, qr{array reference}, 'bounds is not an array'; eval { $geocoder->bounds([]) }; like $@, qr{two array elements}, 'bounds has not enough elements'; eval { $geocoder->bounds([1,2]) }; like $@, qr{lat/lng hashes}, 'bound elements are not hashes'; eval { $geocoder->bounds([{lng=>1},{lat=>2}]) }; like $@, qr{lat/lng hashes}, 'bound elements are missing keys'; is $geocoder->bounds, undef, 'bounds is still unchanged'; } { # zero results my @locations = safe_geocode { $geocoder->geocode(location => 'This query should not find anything but return ZERO_RESULTS, Foobartown') }; cmp_ok scalar(@locations), "==", 0, "No result found"; my $location = safe_geocode { $geocoder->geocode(location => 'This query should not find anything but return ZERO_RESULTS, Foobartown') }; is $location, undef, "No result found"; } { # raw my $raw_result = $geocoder->geocode(location => 'Brandenburger Tor, Berlin, Germany', raw => 1); # This is the 11th query here, so it's very likely that the API # limits are hit. like $raw_result->{status}, qr{^(OK|OVER_QUERY_LIMIT)$}, 'raw query'; if ($raw_result->{status} eq 'OVER_QUERY_LIMIT') { diag 'over query limit hit, sleep a little bit'; sleep 1; # in case a smoker tries this module with another perl... } } { # sensor { my $geocoder = Geo::Coder::Googlev3->new(sensor => "false"); ok $geocoder; is $geocoder->sensor, 'false'; my $url = $geocoder->geocode_url(location => 'Hauptstr., Berlin'); like $url, qr{sensor=false}, 'sensor=false detected in URL'; my $geocoder_default = Geo::Coder::Googlev3->new(); ok $geocoder_default; is $geocoder_default->sensor, undef, "There's no default"; my $url_default = $geocoder_default->geocode_url(location => 'Hauptstr., Berlin'); unlike $url_default, qr{sensor=false}, 'no sensor=false required anymore in URL without explicit sensor setting'; } { my $geocoder = Geo::Coder::Googlev3->new(sensor => "true"); ok $geocoder; is $geocoder->sensor, 'true'; my $url = $geocoder->geocode_url(location => 'Hauptstr., Berlin'); like $url, qr{sensor=true}, 'sensor=false detected in URL'; } eval { Geo::Coder::Googlev3->new(sensor => "nonsense"); }; like $@, qr{sensor argument has to be either 'false' or 'true'}, 'expected error message for unsupported sensor argument'; } { # https my $geocoder = Geo::Coder::Googlev3->new(use_https => 1); # Probably should not use nested SKIP blocks here if ($geocoder->ua->is_protocol_supported('https')) { my $location = safe_geocode { $geocoder->geocode(location => 'Berlin') }; like $location->{formatted_address}, qr{berlin}i, 'https query'; } else { # but here is OK SKIP: { skip "UA does not support https (maybe you have to install LWP::Protocol::https or so", 1; } } } } # SKIP sub within ($$$$$$;$) { my($lat,$lng,$lat_min,$lat_max,$lng_min,$lng_max,$testname_prefix) = @_; my $testname = sub ($) { (defined $testname_prefix ? "$testname_prefix (" : "") . $_[0] . (defined $testname_prefix ? ")" : ""); }; local $Test::Builder::Level = $Test::Builder::Level + 1; cmp_ok $lat, ">=", $lat_min, $testname->("southern latitude"); cmp_ok $lat, "<=", $lat_max, $testname->("northern latitude"); cmp_ok $lng, ">=", $lng_min, $testname->("western longitude"); cmp_ok $lng, "<=", $lng_max, $testname->("eastern longitude"); } sub safe_geocode (&;$) { my($code0, $inforef) = @_; my @locations; my $code; if (wantarray) { $code = sub { @locations = eval { &$code0 } }; } else { $code = sub { $locations[0] = eval { &$code0 } }; } $code->(); if ($@ =~ m{OVER_QUERY_LIMIT}) { diag $@; diag "Hit OVER_QUERY_LIMIT, sleep some seconds before retrying..."; sleep 3; $code->(); if ($@ =~ m{OVER_QUERY_LIMIT}) { diag $@; diag "Hit OVER_QUERY_LIMIT, skipping remaining tests..."; no warnings 'exiting'; last SKIP; } } elsif ($@ =~ m{Fetching.*failed: 500}) { diag $@; diag "Fetch failed, probably network connection problems, skipping remaining tests"; no warnings 'exiting'; last SKIP; } if ($inforef) { $inforef->{err} = $@; } if (wantarray) { @locations; } else { $locations[0]; } } # Local Variables: # mode: cperl # cperl-indent-level: 4 # End: # vim:ft=perl:et:sw=4