lib/Geo/Coder/List.pm

        start → end → jump
        

    1: package Geo::Coder::List;
    2: 
    3: # Geo::Coder::List - Aggregate and chain multiple geocoding backends
    4: 
    5: use 5.10.1;
    6: 
    7: use strict;
    8: use warnings;
    9: 
   10: use Carp;
   11: use Data::Dumper;
   12: # One definition of what counts as a location: Geo::Location::Predicate holds
   13: # the rule the facade and its backends apply, so what is refused here is refused
   14: # there for the same reason.  It is called by name rather than imported - an
   15: # import copies the code reference into this package, and then a test could not
   16: # swap the rule for a spy to prove that it is the rule being consulted.
   17: #
   18: # The rule is an optional dependency, not a prerequisite: it is a distribution of
   19: # its own (Geo-Location-Predicate), declared in Makefile.PL under META_MERGE's
   20: # recommends, so an installer fetches it by default and a standalone install that
   21: # leaves it out still gets the one answer this module can give alone - a
   22: # reference is refused.  It is looked for when it is first needed rather than
   23: # when this module is loaded, so importing this module reads no file it may not
   24: # need, and a rule installed after this module is loaded is still found.
   25: my $HAVE_RULE;	# undef until the rule is first looked for
   26: use HTML::Entities;
   27: use Object::Configure 0.13;
   28: use Params::Get 0.04;
   29: use Readonly;
   30: use Scalar::Util qw(blessed reftype);
   31: use Time::HiRes;
   32: 
   33: =head1 NAME
   34: 
   35: Geo::Coder::List - Call many Geo-Coders
   36: 
   37: =head1 VERSION
   38: 
   39: Version 0.39
   40: 
   41: =cut
   42: 
   43: our $VERSION = '0.39';
   44: 
   45: # ── Module-level constants (not user-configurable) ────────────────────────────
   46: 
   47: # Default verbosity: 0 = silent, 1 = basic trace, 2 = full Data::Dumper dumps
   48: use constant DEBUG_DEFAULT => 0;
   49: 
   50: # Internal sentinel class: a cached not-found result stored in L1.
   51: # Using a blessed ref lets _cache() distinguish "never looked up" from
   52: # "looked up and found nothing" without requiring a special undef convention.
   53: use constant _NOT_FOUND_CLASS => __PACKAGE__ . '::_NotFound';
   54: 
   55: # The singleton value stored in L1 when a location is confirmed missing
   56: my $NOT_FOUND_SENTINEL = bless {}, _NOT_FOUND_CLASS;
   57: 
   58: # String placed in the 'geocoder' field of a result served from cache
   59: Readonly::Scalar my $CACHE_SOURCE => 'cache';
   60: 
   61: # A latlng argument to reverse_geocode(): two decimal numbers and a comma.
   62: # The classes are spelt out rather than written \d and \s: those match
   63: # Arabic-Indic and other Unicode digits, which no backend reads as numbers,
   64: # and the /a flag that would restrict them needs Perl 5.14.
   65: Readonly::Scalar my $LATLNG_RE => qr/^[ \t]*[-+]?(?:[0-9]*\.?[0-9]+|[0-9]+\.?[0-9]*)[ \t]*,[ \t]*[-+]?(?:[0-9]*\.?[0-9]+|[0-9]+\.?[0-9]*)[ \t]*$/;
   66: 
   67: # String used as the 'result' value in log entries for a geocoder miss
   68: Readonly::Scalar my $RESULT_NONE => 'not found';
   69: 
   70: # ── Configurable defaults ─────────────────────────────────────────────────────
   71: #
   72: # Any key here can be overridden at run time via an environment variable named
   73: # GEO__CODER__LIST__<key>, which Object::Configure reads automatically in new().
   74: # Example:
   75: #   export GEO__CODER__LIST__cache_hit_duration='7 days'
   76: 
   77: my %config = (
   78: 	debug               => DEBUG_DEFAULT,
   79: 	# How long a confirmed location stays in the L2 cache
   80: 	cache_hit_duration  => '1 month',
   81: 	# How long a transient/partial failure is cached (retry tomorrow)
   82: 	cache_part_duration => '1 day',
   83: 	# How long a definite not-found is cached (place probably does not exist)
   84: 	cache_miss_duration => '1 week',
   85: );
   86: 
   87: # =============================================================================
   88: # PUBLIC API
   89: # =============================================================================
   90: 
   91: =head1 SYNOPSIS
   92: 
   93:     use Geo::Coder::List;
   94:     use Geo::Coder::OSM;
   95: 
   96:     # 1. The simplest use: one list, one geocoder
   97:     my $list = Geo::Coder::List->new()->push(Geo::Coder::OSM->new());
   98: 
   99:     my $place = $list->geocode('10 Downing St, London, UK');
  100:     if($place) {
  101:         print "Latitude:  $place->{geometry}{location}{lat}\n";
  102:         print "Longitude: $place->{geometry}{location}{lng}\n";
  103:     } else {
  104:         print "Not found\n";
  105:     }
  106: 
  107:     # 2. Several geocoders, tried in order.  Geo::Coder::CA is asked only
  108:     #    about places in Canada or the USA, and at most 1000 times.
  109:     use Geo::Coder::CA;
  110: 
  111:     my $chain = Geo::Coder::List->new()
  112:         ->push({ regex => qr/(Canada|USA)$/, geocoder => Geo::Coder::CA->new(), limit => 1000 })
  113:         ->push(Geo::Coder::OSM->new());
  114: 
  115:     my $ottawa = $chain->geocode('Ottawa, ON, Canada');    # asks CA first
  116:     my $paris  = $chain->geocode('Paris, France');         # CA is skipped
  117: 
  118:     # 3. A cache that lives longer than the object (any CHI driver works)
  119:     use CHI;
  120: 
  121:     my $cached = Geo::Coder::List->new(
  122:         cache => CHI->new(driver => 'File', root_dir => '/var/cache/geocode'),
  123:     )->push(Geo::Coder::OSM->new());
  124: 
  125:     # 4. Every candidate, not only the best one: call geocode() in list context
  126:     my @candidates = $list->geocode('Springfield, USA');
  127:     print scalar(@candidates), " places are called Springfield\n";
  128: 
  129:     # 5. From a position to an address
  130:     my $address = $list->reverse_geocode(latlng => '51.5034,-0.1276');
  131:     print "$address\n" if defined($address);
  132: 
  133:     # 6. Bad input is fatal, so check it when the text comes from a user
  134:     my $text_from_a_form = $ARGV[0];
  135:     my $result = eval { $list->geocode($text_from_a_form) };
  136:     warn "Not a place: $@" if $@;
  137: 
  138:     # 7. See what happened, then clear the record
  139:     $list->geocode('Rome, Italy');
  140:     for my $entry (@{ $list->log() }) {
  141:         printf "%s: %s in %.3fs\n", $entry->{location}, $entry->{geocoder}, $entry->{timetaken};
  142:     }
  143:     $list->flush();
  144: 
  145: =head1 DESCRIPTION
  146: 
  147: L<Geo::Coder::All> and L<Geo::Coder::Many> are great modules but neither
  148: quite does what I want.
  149: 
  150: A I<geocoder> turns the name of a place, such as C<'Paris, France'>, into
  151: a position on the Earth (a latitude and a longitude).  There are many
  152: geocoding services.  Each one knows some places better than others, each
  153: one has its own limits, and each one returns its answer in its own format.
  154: 
  155: C<Geo::Coder::List> lets you use many geocoders as if they were one:
  156: 
  157: =over 4
  158: 
  159: =item * B<A chain.>
  160: You add geocoders with C<push()>.  When you ask for a place, the geocoders
  161: are asked one at a time, in the order you added them.  The first one that
  162: gives a usable answer wins, and the others are not asked.
  163: 
  164: =item * B<Routing.>
  165: A geocoder can be given a regular expression.  It is then asked only
  166: about places whose names match it.
  167: 
  168: =item * B<Limits.>
  169: A geocoder can be given a limit: the number of questions it may answer.
  170: When the limit is used up, the geocoder is skipped.
  171: 
  172: =item * B<One answer format.>
  173: Every answer is changed into the same structure, whichever service gave
  174: it.  The structure is the one used by L<HTML::GoogleMaps::V3> and
  175: L<HTML::OSM>:
  176: 
  177:     $result->{geometry}{location}{lat}   # latitude
  178:     $result->{geometry}{location}{lng}   # longitude
  179:     $result->{lat}                       # the same latitude, for convenience
  180:     $result->{lng}                       # the same longitude, for convenience
  181:     $result->{lon}                       # the same longitude, another common name
  182:     $result->{geocoder}                  # the geocoder object that answered,
  183:                                          # or the string 'cache'
  184: 
  185: =item * B<A cache in two levels.>
  186: Level 1 (L1) is a hash inside the object.  It is always used, and it lasts
  187: as long as the object.  Level 2 (L2) is optional.  It can be a plain hash
  188: or any object with C<get()> and C<set()> methods, such as a L<CHI> cache.
  189: L2 can last longer than the object and can be shared between programs.
  190: How long L2 keeps an answer depends on the answer:
  191: 
  192:     found                      1 month   (cache_hit_duration)
  193:     found, but no latitude     1 day     (cache_part_duration)
  194:     not found                  1 week    (cache_miss_duration)
  195: 
  196: A place that was not found is remembered in L1 only, never in L2.
  197: 
  198: =back
  199: 
  200: =head1 SUPPORTED ANSWER FORMATS
  201: 
  202: Each geocoding service answers in its own format.  C<geocode()> finds the
  203: latitude and longitude in each of the formats below and copies them into
  204: the common structure.  Any geocoder whose answers use one of these formats
  205: works without extra code.  The provider's own fields are kept as well.
  206: 
  207:     Service (module)                Where the position is found
  208:     ------------------------------  -----------------------------------------
  209:     OpenStreetMap, RandMcNally      lat, lon
  210:     Bing Maps                       BestLocation.Coordinates.Latitude/Longitude
  211:     Bing Maps (other form)          point.coordinates [lat, lng]
  212:     geocoder.ca (Geo::Coder::CA)    latt, longt
  213:     postcodes.io, Geo::Coder::Free  latitude, longitude
  214:     HERE / Ovi                      properties.geoLatitude/geoLongitude
  215:     DataScienceToolkit              results[0].geometry.location.lat/lng
  216:     OpenCage                        results[0].geometry.lat/lng
  217:     GeocodeFarm                     RESULTS[0].COORDINATES.latitude/longitude
  218:     US Census Bureau                result.addressMatches[0].coordinates.y/x
  219:     GeoNames                        lat, lng
  220:     Mapbox                          features[0].center [lng, lat]
  221:     GeoApify                        features[0].geometry.coordinates [lng, lat]
  222:     Google, and anything already    geometry.location.lat/lng
  223:     in the common structure
  224: 
  225: Notice that Mapbox and GeoApify give the longitude B<first>.
  226: 
  227: Some services need special handling, which is done for you:
  228: 
  229: =over 4
  230: 
  231: =item * B<Geo::Location::Point.>
  232: A geocoder may answer with a L<Geo::Location::Point> object.  Its
  233: C<geometry> is filled in from its own C<lat> and C<lng> (or C<lon>).
  234: 
  235: =item * B<postcodes.io.>
  236: Its C<local_type> field is copied to C<type>, with the first letter made
  237: lower case.
  238: 
  239: =item * B<geocoder.xyz.>
  240: Its C<standard.countryname> field is copied to C<address.country>.
  241: 
  242: =item * B<GeoNames.>
  243: L<Geo::GeoNames> is called with the place name alone, not with
  244: C<location =E<gt> ...>.  If it has no C<username>, it fails with
  245: C<lost username>, which is logged, and the next geocoder is asked.
  246: GeoNames puts its answers in arrays; every answer in them is considered.
  247: 
  248: =item * B<US Census Bureau.>
  249: An answer with no C<addressMatches> means "not found", and the next
  250: geocoder is asked.
  251: 
  252: =item * B<GeoApify.>
  253: An answer with an empty C<features> list means "not found", and the next
  254: geocoder is asked.
  255: 
  256: =item * B<Errors.>
  257: An answer with a top-level C<error> key is treated as a refusal, not as a
  258: place.  The error is logged, and the next geocoder is asked.
  259: 
  260: =back
  261: 
  262: Every answer that went through this process also has a C<debug> key.  It
  263: holds the line number, in this module, of the code that read the answer.
  264: It is there to help when a new format is not read correctly.
  265: 
  266: =head1 SUBROUTINES/METHODS
  267: 
  268: =head2 new
  269: 
  270: Creates a new C<Geo::Coder::List> object with no geocoders in it.
  271: 
  272: Settings can also come from the environment, through
  273: L<Object::Configure>.  The variable name is C<GEO__CODER__LIST__> followed
  274: by the setting name.  For example, C<GEO__CODER__LIST__carp_on_warn=1>
  275: makes warnings go through L<Carp>, and
  276: C<GEO__CODER__LIST__cache_hit_duration='7 days'> changes how long a found
  277: place stays in L2.
  278: 
  279: When you call C<new()> on an object that already exists, you get a
  280: I<clone>: a new object with the same settings and the same geocoders,
  281: merged with any arguments you give.  The clone has its own list of
  282: geocoders and its own limits, and it starts with an empty log.  The clone
  283: B<shares> the L1 and L2 caches with the original.
  284: 
  285:     use Geo::Coder::List;
  286:     use CHI;
  287: 
  288:     # With an L2 cache
  289:     my $geocoder = Geo::Coder::List->new(
  290:         cache => CHI->new(driver => 'Memory', global => 1),
  291:     );
  292: 
  293:     # A clone of it that prints what it is doing
  294:     my $verbose = $geocoder->new(debug => 1);
  295: 
  296: Arguments can be given as a list of pairs or as one hash reference.
  297: 
  298: =over 4
  299: 
  300: =item * C<cache> - Optional.  The L2 cache: a hash reference, or an object
  301: with C<get($key)> and C<set($key, $value, $ttl)> methods.
  302: 
  303: =item * C<debug> - Optional.  C<0> (the default) prints nothing, C<1>
  304: prints what is tried, C<2> also prints every answer in full.
  305: 
  306: =item * C<cache_hit_duration>, C<cache_part_duration>,
  307: C<cache_miss_duration> - Optional.  How long L2 keeps each kind of
  308: answer, in any form your L2 cache understands, such as C<'1 week'>.
  309: 
  310: =item * C<geocoders> - Optional.  An array reference of geocoders, as if
  311: each had been given to C<push()>.
  312: 
  313: =item * C<logger> - Optional.  Where warnings and errors go.  See
  314: L<Object::Configure>.
  315: 
  316: =item * C<carp_on_warn> - Optional.  When true, warnings go through
  317: L<Carp>.
  318: 
  319: =back
  320: 
  321: If C<new> is called as a function, C<Geo::Coder::List::new()>, with no
  322: arguments, it still returns an object.  Called as a function with
  323: arguments, it warns and returns C<undef>.
  324: 
  325: =head3 API SPECIFICATION
  326: 
  327: =head4 INPUT
  328: 
  329:     {
  330:         cache               => { type => 'hashref|object', optional => 1 },
  331:         debug               => { type => 'integer', optional => 1, min => 0, max => 2 },
  332:         cache_hit_duration  => { type => 'string', optional => 1 },
  333:         cache_part_duration => { type => 'string', optional => 1 },
  334:         cache_miss_duration => { type => 'string', optional => 1 },
  335:         geocoders           => { type => 'arrayref', optional => 1 },
  336:         logger              => { type => 'object|coderef|arrayref|string', optional => 1 },
  337:         carp_on_warn        => { type => 'boolean', optional => 1 },
  338:     }
  339: 
  340: =head4 OUTPUT
  341: 
  342:     {
  343:         type => 'object',
  344:         isa  => 'Geo::Coder::List',
  345:     }
  346: 
  347:     # undef only when called as Geo::Coder::List::new() with arguments
  348: 
  349: =cut
  350: 
  351: sub new
  352: {
●353 → 357 → 380  353: 	my $class = shift;
  354: 	my $params = Params::Get::get_params(undef, \@_) || {};
  355: 
  356: 	# Handle the rare Geo::Coder::List::new() (function-style) invocation
  357: 	if(!defined($class)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  358: 		if(scalar keys %{$params} > 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
  359: 			# Using ::new() with arguments is not supported
  360: 			carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
  361: 			return;
  362: 		}
  363: 		# With no arguments there is nothing to lose, so build a default
  364: 		# object; with arguments the caller has mistaken the calling form and
  365: 		# is told so above, rather than having the arguments silently ignored
  366: 		$class = __PACKAGE__;
  367: 	} elsif(blessed($class)) {
  368: 		# Shallow clone merged with new params; log is always fresh so the
  369: 		# clone starts with an empty event history independent of the original
  370: 		# The chain is copied, hashref entries included, so pushing onto the
  371: 		# clone or spending one of its limits leaves the original's alone
  372: 		my $clone = bless { %{$class}, %{$params}, log => [] }, ref($class);
  373: 		$clone->{'geocoders'} = [
  374: 			map { ref($_) eq 'HASH' ? { %{$_} } : $_ } @{$clone->{'geocoders'} // []}
  375: 		];
  376: 		return $clone;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  377: 	}
  378: 
  379: 	# Let Object::Configure overlay defaults from environment / config files
●380 → 383 → 389  380: 	$params = Object::Configure::configure($class, $params);
  381: 
  382: 	# Fill in any %config defaults the caller did not explicitly supply
  383: 	for my $key (keys %config) {
  384: 		$params->{$key} //= $config{$key};
  385: 	}
  386: 
  387: 	# Bless and return; params override scalar defaults but locations/log
  388: 	# are always initialised fresh so callers cannot inject stale state
  389: 	return bless {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  390: 		debug     => DEBUG_DEFAULT,
  391: 		geocoders => [],
  392: 		%{$params},
  393: 		locations => {},
  394: 		log       => [],
  395: 	}, $class;
  396: }
  397: 
  398: # =============================================================================
  399: 
  400: =head2 push
  401: 
  402: Adds one geocoder to the end of the chain.  Geocoders are asked in the
  403: order in which they were added.
  404: 
  405: C<push> returns the object itself, so you can add several geocoders in
  406: one statement.
  407: 
  408: There are two ways to add a geocoder:
  409: 
  410: =over 4
  411: 
  412: =item * B<A geocoder object.>
  413: It is asked about every place.
  414: 
  415: =item * B<A hash reference>, with these keys:
  416: 
  417: =over 4
  418: 
  419: =item * C<geocoder> - Required.  The geocoder object.
  420: 
  421: =item * C<regex> - Optional.  A regular expression, made with C<qr//>.
  422: The geocoder is asked only about places whose names match it.
  423: 
  424: =item * C<limit> - Optional.  A whole number.  The geocoder answers at
  425: most this many questions.  Each question it is asked makes the number one
  426: smaller.  When the number reaches C<0>, the geocoder is skipped.  A place
  427: that does not match C<regex> does not use up the limit.
  428: 
  429: =back
  430: 
  431: =back
  432: 
  433:     my $list = Geo::Coder::List->new()
  434:         ->push({ regex => qr/USA$/, geocoder => Geo::Coder::US::Census->new(), limit => 100 })
  435:         ->push(Geo::Coder::OSM->new());
  436: 
  437: C<push> croaks if C<$geocoder> is missing or C<undef>.
  438: 
  439: =head3 API SPECIFICATION
  440: 
  441: =head4 INPUT
  442: 
  443:     {
  444:         geocoder => { type => 'object|hashref', optional => 0 },
  445:     }
  446: 
  447:     # A hashref geocoder holds the keys geocoder (an object, required),
  448:     # regex (a Regexp, optional) and limit (an integer, optional)
  449: 
  450: =head4 OUTPUT
  451: 
  452:     {
  453:         type => 'object',
  454:         isa  => 'Geo::Coder::List',
  455:     }
  456: 
  457: =cut
  458: 
  459: sub push
  460: {
  461: 	# Deliberately NOT using Params::Get here: passing the hashref through it
  462: 	# would stringify the compiled qr// object, destroying the regex.
  463: 	my ($self, $geocoder) = @_;
  464: 
  465: 	# A geocoder argument is mandatory
  466: 	croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless defined($geocoder);
  467: 
  468: 	# Append to the ordered chain and return $self for chaining
  469: 	CORE::push @{$self->{geocoders}}, $geocoder;
  470: 
  471: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  472: }
  473: 
  474: # The rule when it is installed, and the one thing that can be said without it.
  475: # A reference is not a location however it would print: when the rule is there it
  476: # says so, and when it is not this refuses it - the hole this module used to have
  477: # was testing the string a reference turns into.  Whether a string of digits is a
  478: # place is the rule's question, so without the rule it is not asked: the string
  479: # is looked up, as it was before the rule existed.
  480: sub _could_be_a_location {
●481 → 483 → 493  481: 	my $location = shift;
  482: 
  483: 	if(!defined($HAVE_RULE)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  484: 		$HAVE_RULE = eval {
  485: 			require Geo::Location::Predicate;
  486: 			Geo::Location::Predicate->can('_valid_location') ? 1 : 0;
  487: 		} ? 1 : 0;
  488: 	}
  489: 
  490: 	# When the rule is installed it decides everything, references included, so
  491: 	# that this module cannot be stricter or looser than the facade.  Without it
  492: 	# there are two answers this module can give on its own.
  493: 	return Geo::Location::Predicate::_valid_location($location) ? 1 : 0 if $HAVE_RULE;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  494: 
  495: 	return 0 if ref($location);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_495_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_495_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  496: 	return 0 unless defined($location) && length($location);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_496_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_496_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  497: 	return 1;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_497_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_497_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  498: }
  499: 
  500: # =============================================================================
  501: 
  502: =head2 geocode
  503: 
  504: Finds the position of a place from its name.
  505: 
  506:     my $result = $list->geocode(location => 'Paris, France');
  507:     my $result = $list->geocode('Paris, France');            # the same
  508:     my $result = $list->geocode({ location => 'Paris, France' });  # the same
  509: 
  510:     if($result) {
  511:         printf "lat=%.4f lng=%.4f from %s\n",
  512:             $result->{geometry}{location}{lat},
  513:             $result->{geometry}{location}{lng},
  514:             ref($result->{geocoder}) || $result->{geocoder};
  515:     }
  516: 
  517: These are the steps, in order:
  518: 
  519: =over 4
  520: 
  521: =item 1. If C<location> is missing, C<geocode> croaks.  If it is
  522: C<undef> or an empty string, C<geocode> warns and returns nothing.
  523: 
  524: =item 2. Runs of white space are made into one space, and HTML entities
  525: are decoded: C<'Caf&eacute;'> becomes C<'Caf'> followed by the single
  526: character e-acute.  A reference to a string is treated as the string.
  527: 
  528: =item 3. The text is checked.  A reference is never a place.  When
  529: L<Geo::Location::Predicate> is installed, it decides what else is not a
  530: place; for example, a string of only digits is not.  If the text is not a
  531: place, C<geocode> croaks.  The check is done after step 2, so
  532: C<'&#49;&#50;'> is refused as the digits C<'12'>.
  533: 
  534: =item 4. The cache is checked: first L1, then L2.  If the place is there,
  535: the cached answer is returned, with C<geocoder> set to C<'cache'>.  If L1
  536: remembers that the place was not found, nothing is returned and no
  537: geocoder is asked.
  538: 
  539: =item 5. Each geocoder in the chain is asked in turn.  A geocoder is
  540: skipped if the place does not match its C<regex>, or if its C<limit> is
  541: used up.  If a geocoder dies, the error is logged, a warning is given, and
  542: the next geocoder is asked.
  543: 
  544: =item 6. The first answer that has both a latitude and a longitude wins.
  545: It is changed into the common structure (see L</DESCRIPTION>), stored in
  546: the cache, and returned.
  547: 
  548: =item 7. If no geocoder gives a usable answer, the place is remembered as
  549: "not found" in L1, and nothing is returned.
  550: 
  551: =back
  552: 
  553: B<Scalar context> returns one hash reference, or C<undef>.
  554: 
  555: B<List context> returns every answer from the geocoder that won, or an
  556: empty list.  This is useful when a name, such as C<'Springfield'>, belongs
  557: to many places.  Answers that the geocoder returned inside an array are
  558: taken out of it, so the list never contains array references.  Answers
  559: without a position may be in the list too; check C<geometry> before you
  560: use each one.
  561: 
  562:     my @all = $list->geocode('Springfield, USA');
  563: 
  564: The C<geocoder> key of an answer holds the geocoder object that gave it.
  565: When the answer came from the cache, it holds the string C<'cache'>.
  566: 
  567: =head3 API SPECIFICATION
  568: 
  569: =head4 INPUT
  570: 
  571:     {
  572:         location => { type => 'string', optional => 0, min => 1 },
  573:     }
  574: 
  575: =head4 OUTPUT
  576: 
  577:     {
  578:         type => 'hashref',
  579:         optional => 1,
  580:     }
  581: 
  582:     # Return::Set schema, scalar context: a hashref, or undef when not found
  583:     #   {
  584:     #       geometry => { location => { lat => Num, lng => Num } },
  585:     #       lat      => Num,
  586:     #       lng      => Num,
  587:     #       lon      => Num,                   # the same as lng
  588:     #       geocoder => OBJECT | 'cache',
  589:     #       debug    => Int,                   # line that read the answer
  590:     #       ...                                # fields from the provider
  591:     #   }
  592:     #
  593:     # List context: a list of hashrefs as above, or an empty list
  594: 
  595: =cut
  596: 
  597: sub geocode {
●598 → 606 → 611  598: 	my $self = shift;
  599: 
  600: 	# The geocoders are called inside eval; the caller's $@ is not ours to change
  601: 	local $@;
  602: 
  603: 	# Params::Get enforces 'location'; calling geocode() with no args causes
  604: 	# get_params itself to croak with "Usage:" matching t/carp.t expectations
  605: 	my $params = Params::Get::get_params('location', @_);
  606: 	if(!defined($params)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  607: 		$self->_error(__PACKAGE__, ' usage: geocode(location => $location)');
  608: 		return;
  609: 	}
  610: 
●611 → 620 → 629  611: 	my $location = $params->{'location'};
  612: 
  613: 	# A scalar reference is one way of passing the string it points at, and
  614: 	# Params::Get dereferences it when it is the only argument.  Do it here as
  615: 	# well, in every calling form, so that it means the string however the
  616: 	# method is called.
  617: 	$location = ${$location} if ref($location) eq 'SCALAR';
  618: 
  619: 	# Reject empty or whitespace-only location strings
  620: 	if((!defined($location)) || (length($location) == 0)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  621: 		$self->_warn(__PACKAGE__, ' usage: geocode(location => $location)');
  622: 		return;
  623: 	}
  624: 
  625: 	# Collapse runs of whitespace and expand any HTML entities before the rule
  626: 	# is asked: '&#49;&#50;' is the string of digits '12' once decoded, and it
  627: 	# is the decoded string that is looked up.  A reference is left as it is
  628: 	# for the rule to refuse.
●629 → 629 → 638  629: 	if(!ref($location)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  630: 		$location =~ s/\s\s+/ /g;
  631: 		$location = decode_entities($location);
  632: 	}
  633: 
  634: 	# What counts as a location is Geo::Location::Predicate's answer, not a
  635: 	# second copy of it here: a reference is not a location however it would print,
  636: 	# and a string of digits is what a numeric column holds when the wrong one has
  637: 	# been read.
●638 → 638 → 645  638: 	if(!_could_be_a_location($location)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  639: 		$self->_error('Usage: ', __PACKAGE__, ': invalid input to geocode(), ',
  640: 			ref($location) ? 'a reference is not a location' : $location);
  641: 		return;
  642: 	}
  643: 
  644: 	# Propagate the cleaned-up string so geocoders also receive the decoded form
●645 → 661 → 665  645: 	$params->{'location'} = $location;
  646: 
  647: 	$self->_debug("location: $location\n");
  648: 
  649: 	# Capture the caller's line number once for all log entries in this call
  650: 	my @call_details = caller(0);
  651: 
  652: 	# ── L1 / L2 cache lookup ──────────────────────────────────────────────
  653: 
  654: 	# _cache() returns undef for both "not in cache" and "cached not-found";
  655: 	# the not-found sentinel is handled internally so callers see undef either way
  656: 	my $cached = $self->_cache($location);
  657: 
  658: 	# Only a reference is a geocode result.  A plain string in the cache under
  659: 	# this key - a reverse_geocode() address, or a corrupted store - is not,
  660: 	# and is looked up again rather than returned as if it were one.
  661: 	if(defined($cached) && !ref($cached)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  662: 		undef $cached;
  663: 	}
  664: 
●665 → 665 → 719  665: 	if(defined $cached) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  666: 		# A defined value means we have a genuine cached positive result
  667: 		my @rc = ref($cached) eq 'ARRAY' ? @{$cached} : ($cached);
  668: 
  669: 		# Mark every element as coming from cache.  Shallow-copy HASH results
  670: 		# first so that neither the L1 cache entry nor any caller-held reference
  671: 		# to the same hashref is mutated in place.
  672: 		for my $r (@rc) {
  673: 			next unless ref($r);
  674: 			$r = { %{$r} } if ref($r) eq 'HASH';
  675: 			$r->{'geocoder'} = $CACHE_SOURCE;
  676: 		}
  677: 
  678: 		# Scalar context: return the first (and usually only) element
  679: 		if(!wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  680: 			my $rc = $rc[0];
  681: 			CORE::push @{$self->{'log'}}, {
  682: 				line      => $call_details[2],
  683: 				location  => $location,
  684: 				timetaken => 0,
  685: 				geocoder  => $CACHE_SOURCE,
  686: 				wantarray => 0,
  687: 				result    => $rc,
  688: 			};
  689: 			$self->_debug(__PACKAGE__, ': ', __LINE__, ": cached\n");
  690: 			return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  691: 		}
  692: 
  693: 		# List context: return all cached candidates
  694: 		CORE::push @{$self->{'log'}}, {
  695: 			line      => $call_details[2],
  696: 			location  => $location,
  697: 			timetaken => 0,
  698: 			geocoder  => $CACHE_SOURCE,
  699: 			wantarray => 1,
  700: 			result    => \@rc,
  701: 		};
  702: 		$self->_debug(__PACKAGE__, ': ', __LINE__, ": cached\n");
  703: 
  704: 		# Determine if every element is empty; if so return nothing
  705: 		my $allempty = 1;
  706: 		for my $r (@rc) {
  707: 			if(ref($r) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  708: 				$allempty = 0 if defined $r->{geometry}{location}{lat};
  709: 			} elsif(ref($r) eq 'Geo::Location::Point') {
  710: 				$allempty = 0;
  711: 			}
  712: 		}
  713: 		return if $allempty;
  714: 		return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  715: 	}
  716: 
  717: 	# Also check if this location is cached as a definite not-found in L1,
  718: 	# without going through _cache() (which masks the sentinel as undef)
●719 → 719 → 729  719: 	if(exists $self->{'locations'}{$location}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  720: 		my $stored = $self->{'locations'}{$location};
  721: 		if(ref($stored) && ref($stored) eq _NOT_FOUND_CLASS) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  722: 			$self->_debug("No matches (cached)\n");
  723: 			return wantarray ? () : undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  724: 		}
  725: 	}
  726: 
  727: 	# ── Try each geocoder in turn ─────────────────────────────────────────
  728: 
●729 → 729 → 1074  729: 	ENCODER: foreach my $g (@{$self->{geocoders}}) {
  730: 		my $geocoder = $g;
  731: 
  732: 		# Unpack a hashref entry and apply regex / limit guards
  733: 		if(ref($geocoder) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  734: 			# Skip this entry if the location does not match its regex.  This
  735: 			# comes before the limit so that a location the geocoder is never
  736: 			# asked about does not spend one of its queries.
  737: 			if(my $regex = $geocoder->{'regex'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  738: 				$self->_debug('consider ', ref($geocoder->{geocoder}), ": $regex\n");
  739: 				if($location !~ $regex) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  740: 					next;
  741: 				}
  742: 			}
  743: 
  744: 			# Decrement and check the per-geocoder query limit
  745: 			if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  746: 				$self->_debug("limit: $limit\n");
  747: 				if($limit <= 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
  748: 					next;
  749: 				}
  750: 				$geocoder->{'limit'}--;
  751: 			}
  752: 
  753: 			# Unwrap the actual geocoder object from the hashref
  754: 			$geocoder = $g->{'geocoder'};
  755: 		}
  756: 
  757: 		# Start timing before the network call
  758: 		my @rc;
  759: 		my $timetaken = Time::HiRes::time();
  760: 
  761: 		eval {
  762: 			# Geo::GeoNames uses a positional argument, not a hash
  763: 			$self->_debug('trying ', ref($geocoder), "\n");
  764: 			if(ref($geocoder) eq 'Geo::GeoNames') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  765: 				$self->_debug('username => ', $geocoder->username(), "\n");
  766: 				die 'lost username' if(!defined($geocoder->username()));
  767: 				@rc = $geocoder->geocode($location);
  768: 			} else {
  769: 				@rc = $geocoder->geocode(%{$params});
  770: 			}
  771: 		};
  772: 
  773: 		if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  774: 			# Log the failure and move on; do not abort the whole chain
  775: 			my $log = {
  776: 				line      => $call_details[2],
  777: 				location  => $location,
  778: 				geocoder  => ref($geocoder),
  779: 				timetaken => Time::HiRes::time() - $timetaken,
  780: 				wantarray => wantarray,
  781: 				error     => $@,
  782: 			};
  783: 			CORE::push @{$self->{'log'}}, $log;
  784: 			$self->_warn(ref($geocoder), " '$location': $@");
  785: 			next ENCODER;
  786: 		}
  787: 
  788: 		$timetaken = Time::HiRes::time() - $timetaken;
  789: 
  790: 		# Geo::Coder::US::Census sometimes returns a truthy but empty result
  791: 		if((ref($geocoder) eq 'Geo::Coder::US::Census') &&
  Mutants (Total: 1, Killed: 1, Survived: 0)
  792: 		   !(defined($rc[0]->{result}{addressMatches}[0]->{coordinates}{y}))) {
  793: 			my $log = {
  794: 				line      => $call_details[2],
  795: 				location  => $location,
  796: 				timetaken => $timetaken,
  797: 				geocoder  => ref($geocoder),
  798: 				wantarray => wantarray,
  799: 				result    => $RESULT_NONE,
  800: 			};
  801: 			CORE::push @{$self->{'log'}}, $log;
  802: 			next ENCODER;
  803: 		}
  804: 
  805: 		# Geo::GeoNames wraps its results in arrays.  Every element of such an
  806: 		# array is a candidate, so they are unwrapped into one list here, and a
  807: 		# wrapped empty hash is then caught by the check below like any other
  808: 		@rc = map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @rc;
  809: 
  810: 		# Reject empty result sets and trivially empty hashes
  811: 		if((scalar(@rc) == 0) ||
  Mutants (Total: 2, Killed: 2, Survived: 0)
  812: 		   ((ref($rc[0]) eq 'HASH') && (scalar(keys %{$rc[0]}) == 0))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  813: 			my $log = {
  814: 				line      => $call_details[2],
  815: 				location  => $location,
  816: 				timetaken => $timetaken,
  817: 				geocoder  => ref($geocoder),
  818: 				wantarray => wantarray,
  819: 				result    => $RESULT_NONE,
  820: 			};
  821: 			CORE::push @{$self->{'log'}}, $log;
  822: 			next ENCODER;
  823: 		}
  824: 
  825: 		# ── Normalise each candidate result ──────────────────────────────
  826: 
  827: 		# Track which element was successfully normalised so we return it,
  828: 		# not blindly return $rc[0] when a later element was the good one
  829: 		my $good_result;
  830: 
  831: 		POSSIBLE_LOCATION: foreach my $l (@rc) {
  832: 			# Skip undefined or empty-string candidates
  833: 			if((!defined($l)) || ($l eq '')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  834: 				my $log = {
  835: 					line      => $call_details[2],
  836: 					location  => $location,
  837: 					timetaken => $timetaken,
  838: 					geocoder  => ref($geocoder),
  839: 					wantarray => wantarray,
  840: 					result    => $RESULT_NONE,
  841: 				};
  842: 				CORE::push @{$self->{'log'}}, $log;
  843: 				next ENCODER;
  844: 			}
  845: 
  846: 			# Skip bare scalars (e.g. integer 0, plain strings) that are
  847: 			# not references; they cannot be hash-dereferenced below
  848: 			next unless ref($l);
  849: 
  850: 			# Stamp the source geocoder on the result before normalisation
  851: 			$l->{'geocoder'} = ref($geocoder);
  852: 
  853: 			$self->_debug(ref($geocoder), ': ',
  854: 				Data::Dumper->new([\$l])->Dump()) if($self->{'debug'} >= 2);

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_854_59_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_854_59_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_854_59_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  855: 
  856: 			# Geo::Location::Point objects carry their own accessors;
  857: 			# upgrade the geocoder field and populate the canonical geometry
  858: 			# structure so callers can rely on geometry.location.{lat,lng}
  859: 			if(ref($l) eq 'Geo::Location::Point') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  860: 				$l->{'geocoder'} = $geocoder;
  861: 
  862: 				# Populate canonical geometry structure from the GLP's own fields
  863: 				if(!defined($l->{geometry}{location}{lat}) && defined($l->{lat})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  864: 					$l->{geometry}{location}{lat} = $l->{lat};
  865: 					$l->{geometry}{location}{lng} = $l->{lng} // $l->{lon};
  866: 				}
  867: 
  868: 				# Convenience aliases (idempotent if already set by GLP)
  869: 				$l->{'lat'} //= $l->{geometry}{location}{lat};
  870: 				$l->{'lng'} //= $l->{geometry}{location}{lng};
  871: 				$l->{'lon'} //= $l->{geometry}{location}{lng};
  872: 
  873: 				CORE::push @{$self->{'log'}}, {
  874: 					line      => $call_details[2],
  875: 					location  => $location,
  876: 					timetaken => $timetaken,
  877: 					geocoder  => ref($geocoder),
  878: 					wantarray => wantarray,
  879: 					result    => $l,
  880: 				};
  881: 				$good_result = $l;
  882: 				last POSSIBLE_LOCATION;
  883: 			}
  884: 
  885: 			# Only HASH results need normalisation
  886: 			next if(ref($l) ne 'HASH');
  887: 
  888: 			if($l->{'error'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  889: 				# A top-level 'error' key signals a provider-level failure
  890: 				my $log = {
  891: 					line      => $call_details[2],
  892: 					location  => $location,
  893: 					timetaken => $timetaken,
  894: 					geocoder  => ref($geocoder),
  895: 					wantarray => wantarray,
  896: 					error     => $l->{'error'},
  897: 				};
  898: 				CORE::push @{$self->{'log'}}, $log;
  899: 				next ENCODER;
  900: 			} else {
  901: 				# Map provider-specific fields to the canonical geometry structure
  902: 				if(!defined($l->{geometry}{location}{lat})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  903: 					my ($lat, $long);
  904: 
  905: 					if(defined($l->{lat}) && defined($l->{lon})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  906: 						# OSM / RandMcNally: top-level lat/lon fields
  907: 						$lat   = $l->{lat};
  908: 						$long  = $l->{lon};
  909: 						$l->{'debug'} = __LINE__;
  910: 					} elsif($l->{BestLocation}) {
  911: 						# Bing Maps: BestLocation.Coordinates.{Latitude,Longitude}
  912: 						$lat   = $l->{BestLocation}->{Coordinates}->{Latitude};
  913: 						$long  = $l->{BestLocation}->{Coordinates}->{Longitude};
  914: 						$l->{'debug'} = __LINE__;
  915: 					} elsif($l->{point}) {
  916: 						# Bing Maps alternative: point.coordinates[lat, lng]
  917: 						$lat   = $l->{point}->{coordinates}[0];
  918: 						$long  = $l->{point}->{coordinates}[1];
  919: 						$l->{'debug'} = __LINE__;
  920: 					} elsif(defined($l->{latt})) {
  921: 						# geocoder.ca: latt / longt fields
  922: 						$lat   = $l->{latt};
  923: 						$long  = $l->{longt};
  924: 						$l->{'debug'} = __LINE__;
  925: 					} elsif(defined($l->{latitude})) {
  926: 						# postcodes.io, Geo::Coder::Free: latitude / longitude
  927: 						$lat   = $l->{latitude};
  928: 						$long  = $l->{longitude};
  929: 						if(my $type = $l->{'local_type'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  930: 							# Carry the local_type hint forward as a normalised 'type'
  931: 							$l->{'type'} = lcfirst($type);
  932: 						}
  933: 						$l->{'debug'} = __LINE__;
  934: 					} elsif(defined($l->{'properties'}{'geoLatitude'})) {
  935: 						# HERE / Ovi: properties.geoLatitude / geoLongitude
  936: 						$lat   = $l->{properties}{geoLatitude};
  937: 						$long  = $l->{properties}{geoLongitude};
  938: 						$l->{'debug'} = __LINE__;
  939: 					} elsif($l->{'results'}[0]->{'geometry'}) {
  940: 						if($l->{'results'}[0]->{'geometry'}->{'location'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  941: 							# DataScienceToolkit mirrors the Google Maps shape
  942: 							$lat   = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'};
  943: 							$long  = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'};
  944: 							$l->{'debug'} = __LINE__;
  945: 						} else {
  946: 							# OpenCage places lat/lng directly under geometry
  947: 							$lat   = $l->{'results'}[0]->{'geometry'}->{'lat'};
  948: 							$long  = $l->{'results'}[0]->{'geometry'}->{'lng'};
  949: 							$l->{'debug'} = __LINE__;
  950: 						}
  951: 					} elsif($l->{'RESULTS'}) {
  952: 						# GeoCodeFarm: RESULTS[0].COORDINATES.{latitude,longitude}
  953: 						$lat   = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'};
  954: 						$long  = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'};
  955: 						$l->{'debug'} = __LINE__;
  956: 					} elsif(defined($l->{result}{addressMatches}[0]->{coordinates}{y})) {
  957: 						# US Census Bureau: result.addressMatches[0].coordinates.{y,x}
  958: 						$lat   = $l->{result}{addressMatches}[0]->{coordinates}{y};
  959: 						$long  = $l->{result}{addressMatches}[0]->{coordinates}{x};
  960: 						$l->{'debug'} = __LINE__;
  961: 					} elsif(defined($l->{lat})) {
  962: 						# Geo::GeoNames: lat / lng (reached only after lat+lon check fails)
  963: 						$lat   = $l->{lat};
  964: 						$long  = $l->{lng};
  965: 						$l->{'debug'} = __LINE__;
  966: 					} elsif($l->{features}) {
  967: 						if($l->{features}[0]->{center}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  968: 							# Geo::Coder::Mapbox: center is [lng, lat]
  969: 							$lat   = $l->{features}[0]->{center}[1];
  970: 							$long  = $l->{features}[0]->{center}[0];
  971: 							$l->{'debug'} = __LINE__;
  972: 						} elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) {
  973: 							# Geo::Coder::GeoApify: coordinates is [lng, lat]
  974: 							$lat   = $l->{'features'}[0]{'geometry'}{'coordinates'}[1];
  975: 							$long  = $l->{'features'}[0]{'geometry'}{'coordinates'}[0];
  976: 							$l->{'debug'} = __LINE__;
  977: 						} else {
  978: 							# GeoApify signals not-found via empty features, not an error
  979: 							next ENCODER;
  980: 						}
  981: 					} else {
  982: 						$l->{'debug'} = __LINE__;
  983: 					}
  984: 
  985: 					if(defined($lat) && defined($long)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  986: 						# Populate the canonical geometry structure
  987: 						$l->{geometry}{location}{lat} = $lat;
  988: 						$l->{geometry}{location}{lng} = $long;
  989: 						# Compatibility aliases expected by callers
  990: 						$l->{'lat'} = $lat;
  991: 						$l->{'lon'} = $long;
  992: 					} else {
  993: 						# No coordinates extracted; clean up any partial data
  994: 						delete $l->{'geometry'};
  995: 						delete $l->{'lat'};
  996: 						delete $l->{'lon'};
  997: 					}
  998: 
  999: 					# geocoder.xyz provides a country name under 'standard'
 1000: 					if($l->{'standard'}{'countryname'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1001: 						$l->{'address'}{'country'} = $l->{'standard'}{'countryname'};
 1002: 					}
 1003: 				}
 1004: 
 1005: 				# A result whose geometry has lat but no lng may still carry the
 1006: 				# longitude at the top level, some geocoders using the legacy
 1007: 				# 'long' key for it
 1008: 				if(defined($l->{geometry}{location}{lat})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1009: 					$l->{geometry}{location}{lng} //= $l->{'lng'} // $l->{'lon'} // $l->{'long'};
 1010: 				}
 1011: 
 1012: 				# Only a result with both coordinates is usable; anything less is
 1013: 				# passed over so that a later element, or the next geocoder, can
 1014: 				# answer instead
 1015: 				if(defined($l->{geometry}{location}{lat}) && defined($l->{geometry}{location}{lng})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1016: 					$self->_debug($l->{geometry}{location}{lat}, '/',
 1017: 						$l->{geometry}{location}{lng}, "\n");
 1018: 
 1019: 					# Store the geocoder object (not just its name) on the result
 1020: 					$l->{geocoder} = $geocoder;
 1021: 					$l->{'lat'} //= $l->{geometry}{location}{lat};
 1022: 					$l->{'lng'} //= $l->{geometry}{location}{lng};
 1023: 					$l->{'lon'} //= $l->{geometry}{location}{lng};
 1024: 
 1025: 					my $log = {
 1026: 						line      => $call_details[2],
 1027: 						location  => $location,
 1028: 						timetaken => $timetaken,
 1029: 						geocoder  => ref($geocoder),
 1030: 						wantarray => wantarray,
 1031: 						result    => $l,
 1032: 					};
 1033: 					CORE::push @{$self->{'log'}}, $log;
 1034: 
 1035: 					# Record which element succeeded, then exit the inner loop
 1036: 					$good_result = $l;
 1037: 					last POSSIBLE_LOCATION;
 1038: 				}
 1039: 			}
 1040: 		}
 1041: 
 1042: 		# Only attempt to return / cache if normalisation actually succeeded
 1043: 		next ENCODER unless defined $good_result;
 1044: 
 1045: 		$self->_debug('Number of matches from ', ref($geocoder), ': ',
 1046: 			scalar(@rc), "\n");
 1047: 
 1048: 		if($self->{'debug'} >= 2) {

					

					
Mutants (Total: 4, Killed: 1, Survived: 3)
					

				
NUM_BOUNDARY_1048_23_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1048_23_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1048_23_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1049: 			# Use 'local' to avoid permanently altering the global Maxdepth
 1050: 			local $Data::Dumper::Maxdepth = 10;
 1051: 			$self->_debug(Data::Dumper->new([\@rc])->Dump());
 1052: 		}
 1053: 
 1054: 		# Only a result with both coordinates is accepted above, so this can
 1055: 		# fail only if the normalisation itself is wrong
 1056: 		if((!defined($good_result->{lat})) || (!defined($good_result->{lng}))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1057: 			$self->_warn(Data::Dumper->new([\@rc])->Dump());
 1058: 			$self->_error("BUG: '$location': HASH exists but is not sensible");
 1059: 		}
 1060: 
 1061: 		if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1062: 			# A bare scalar the loop passed over is not a result
 1063: 			@rc = grep { ref } @rc;
 1064: 			$self->_cache($location, \@rc);
 1065: 			return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1066: 		}
 1067: 
 1068: 		$self->_cache($location, $good_result);
 1069: 		return $good_result;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1070: 	}
 1071: 
 1072: 	# ── No geocoder produced a usable result ──────────────────────────────
 1073: 
 1074: 	$self->_debug("No matches\n");
 1075: 
 1076: 	# Cache the not-found result so repeated calls do not hammer all backends
 1077: 	$self->_cache($location, undef);
 1078: 
 1079: 	return wantarray ? () : undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1080: }
 1081: 
 1082: # =============================================================================
 1083: 
 1084: =head2 ua
 1085: 
 1086: Gives a user agent (the object that makes the web requests) to every
 1087: geocoder in the chain.  Use it to set a proxy or a time-out for all of
 1088: them at once.
 1089: 
 1090:     use LWP::UserAgent;
 1091: 
 1092:     my $ua = LWP::UserAgent->new(timeout => 10);
 1093:     $ua->env_proxy(1);
 1094:     $list->ua($ua);
 1095: 
 1096: If C<$ua> has both C<clone()> and C<agent()> methods, as
 1097: L<LWP::UserAgent> does, each geocoder is given its own copy.  The
 1098: C<agent> string of each copy is set to the geocoder's class name and
 1099: version, such as C<'Geo::Coder::OSM/0.03'>, so each service can see which
 1100: module is calling it.  Otherwise every geocoder is given C<$ua> itself.
 1101: 
 1102: Add the geocoders before you call C<ua>: geocoders added later do not get
 1103: the user agent.
 1104: 
 1105: There is no way to read the user agent back, because each geocoder may
 1106: have a different one.
 1107: 
 1108: If C<$ua> is missing or false, nothing changes and nothing is returned.
 1109: C<ua> croaks with C<No geocoder found> if an entry in the chain has no
 1110: geocoder.
 1111: 
 1112: =head3 API SPECIFICATION
 1113: 
 1114: =head4 INPUT
 1115: 
 1116:     {
 1117:         ua => { type => 'object', optional => 1 },
 1118:     }
 1119: 
 1120: =head4 OUTPUT
 1121: 
 1122:     {
 1123:         type => 'object',
 1124:         optional => 1,
 1125:     }
 1126: 
 1127:     # The same $ua that was passed in, or nothing when $ua is false
 1128: 
 1129: =cut
 1130: 
 1131: sub ua
 1132: {
●1133 → 1139 → 1163 1133: 	my ($self, $ua) = @_;
 1134: 
 1135: 	# Nothing to propagate if no UA was supplied
 1136: 	return unless $ua;
 1137: 
 1138: 	# Push the UA into every geocoder in the chain
 1139: 	foreach my $g (@{$self->{geocoders}}) {
 1140: 		my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g;
 1141: 		# Guard against a misconfigured entry that has no geocoder object
 1142: 		Carp::croak('No geocoder found') unless defined $geocoder;
 1143: 
 1144: 		# When the incoming UA supports clone(), create a per-geocoder copy
 1145: 		# and set the geocoder's own agent string on that copy.
 1146: 		# Some APIs (e.g. OSM Nominatim) require a specific User-Agent and
 1147: 		# refuse requests that carry the generic libwww-perl default.
 1148: 		# The agent string is derived from the geocoder class name and version
 1149: 		# (e.g. 'Geo::Coder::OSM/0.03') without reading the geocoder's current
 1150: 		# UA, which would trigger any spy or hook installed on its ua() method.
 1151: 		if($ua->can('clone') && $ua->can('agent')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1152: 			my $per_ua  = $ua->clone();
 1153: 			my $class   = ref($geocoder);
 1154: 			my $version = eval { $geocoder->VERSION() } // '';
 1155: 			$per_ua->agent($version ? "$class/$version" : $class);
 1156: 			$geocoder->ua($per_ua);
 1157: 		} else {
 1158: 			$geocoder->ua($ua);
 1159: 		}
 1160: 	}
 1161: 
 1162: 	# Return the UA so callers can verify what was set (API contract)
 1163: 	return $ua;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1164: }
 1165: 
 1166: # =============================================================================
 1167: 
 1168: =head2 reverse_geocode
 1169: 
 1170: Finds the address of a position: the opposite of C<geocode>.
 1171: 
 1172:     my $address = $list->reverse_geocode(latlng => '51.5034,-0.1276');
 1173:     my $address = $list->reverse_geocode('51.5034,-0.1276');    # the same
 1174:     print "Address: $address\n" if defined($address);
 1175: 
 1176:     my @addresses = $list->reverse_geocode(latlng => '51.5034,-0.1276');
 1177: 
 1178: C<latlng> is the latitude, a comma, and the longitude, in that order.  It
 1179: must be two plain decimal numbers written with the digits C<0> to C<9>.
 1180: Spaces, tabs and a C<+> or C<-> sign are allowed.  Anything else, such as
 1181: C<'51.5;-0.1'>, C<'1e5,2'> or C<'51.5'>, makes C<reverse_geocode> croak
 1182: before any geocoder is asked.
 1183: 
 1184: The geocoders are asked in turn, as for C<geocode>.  C<limit> is honoured;
 1185: C<regex> is not.  If a geocoder complains that it does not know the
 1186: C<latlng> parameter, it is asked again with only C<lat> and C<lon>.  If a
 1187: geocoder dies for any other reason, a warning is given and the next
 1188: geocoder is asked.
 1189: 
 1190: B<Scalar context> returns one address string, or C<undef>.
 1191: 
 1192: B<List context> returns every address from the first geocoder that has
 1193: any, or an empty list.
 1194: 
 1195: An address is taken from the first of these that the answer has:
 1196: 
 1197: =over 4
 1198: 
 1199: =item * C<display_name> (OpenStreetMap, and others that copy it)
 1200: 
 1201: =item * the fields of geocoder.ca: C<stnumber>, C<staddress>, C<city> and
 1202: C<prov> for Canada, giving for example
 1203: C<'1 Sussex Dr, Ottawa, ON'>; or the C<usa> fields for the United States,
 1204: giving for example C<'1600 Pennsylvania Ave, Washington, DC, USA'>
 1205: 
 1206: =item * C<features[0].properties.formatted> (GeoApify); only the first
 1207: feature is used
 1208: 
 1209: =back
 1210: 
 1211: If a geocoder returns a plain string, the string is the address.
 1212: 
 1213: Addresses are cached under the C<latlng> string, so asking again for the
 1214: same position does not ask any geocoder.
 1215: 
 1216: =head3 API SPECIFICATION
 1217: 
 1218: =head4 INPUT
 1219: 
 1220:     {
 1221:         latlng => { type => 'string', optional => 0, matches => qr/^[ \t]*[-+]?(?:[0-9]*\.?[0-9]+|[0-9]+\.?[0-9]*)[ \t]*,[ \t]*[-+]?(?:[0-9]*\.?[0-9]+|[0-9]+\.?[0-9]*)[ \t]*$/ },
 1222:     }
 1223: 
 1224: =head4 OUTPUT
 1225: 
 1226:     {
 1227:         type => 'string',
 1228:         optional => 1,
 1229:     }
 1230: 
 1231:     # Scalar context: an address string, or undef when not found
 1232:     # List context: a list of address strings, or an empty list
 1233: 
 1234: =cut
 1235: 
 1236: sub reverse_geocode {
●1237 → 1259 → 1266 1237: 	my $self = shift;
 1238: 
 1239: 	# The geocoders are called inside eval; the caller's $@ is not ours to change
 1240: 	local $@;
 1241: 
 1242: 	my $params = Params::Get::get_params('latlng', \@_);
 1243: 
 1244: 	my $latlng = $params->{'latlng'} or Carp::croak('Usage: reverse_geocode(latlng => $location)');
 1245: 
 1246: 	# Only a numeric pair is a position; anything else would be split into
 1247: 	# nonsense coordinates and sent to every backend
 1248: 	Carp::croak('Usage: reverse_geocode(latlng => $location)')
 1249: 		if(ref($latlng) || ($latlng !~ $LATLNG_RE));
 1250: 
 1251: 	# Split into components; populate convenience keys for geocoders that want them
 1252: 	my ($latitude, $longitude) = split(/,/, $latlng);
 1253: 	$params->{'lat'} //= $latitude;
 1254: 	$params->{'lon'} //= $longitude;
 1255: 
 1256: 	# Check L1 / L2 cache before hitting any backend.  A list-context call
 1257: 	# caches every address as an arrayref and a scalar-context call caches
 1258: 	# one string, so the entry is unpacked for the context asking for it.
 1259: 	if(defined(my $rc = $self->_cache($latlng))) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1260: 		if(ref($rc) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1261: 			return wantarray ? @{$rc} : $rc->[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1262: 		}
 1263: 		return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1264: 	}
 1265: 
●1266 → 1268 → 1444 1266: 	my @call_details = caller(0);
 1267: 
 1268: 	foreach my $g (@{$self->{geocoders}}) {
 1269: 		my $geocoder = $g;
 1270: 
 1271: 		# Apply the per-geocoder limit guard for hashref entries
 1272: 		if(ref($geocoder) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1273: 			if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1274: 				$self->_debug("limit: $limit\n");
 1275: 				if($limit <= 0) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1276: 					next;
 1277: 				}
 1278: 				$geocoder->{'limit'}--;
 1279: 			}
 1280: 			$geocoder = $g->{'geocoder'};
 1281: 		}
 1282: 
 1283: 		$self->_debug('trying ', ref($geocoder), "\n");
 1284: 
 1285: 		if(wantarray) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1286: 			# ── List context: collect all address strings from this geocoder ───
 1287: 			my @rc;
 1288: 			my @locs;
 1289: 			eval { @locs = $geocoder->reverse_geocode(%{$params}) };
 1290: 
 1291: 			# Some geocoders (e.g. Geo::Coder::GeoApify) use strict parameter
 1292: 			# validation and reject the 'latlng' key as unknown.  Retry without
 1293: 			# it -- lat and lon are already in %params from the split above.
 1294: 			# Other geocoders (e.g. Geo::Coder::CA) require 'latlng', so the
 1295: 			# first attempt must include it.
 1296: 			if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1297: 				my %no_latlng = %{$params};
 1298: 				delete $no_latlng{'latlng'};
 1299: 				$@ = '';
 1300: 				eval { @locs = $geocoder->reverse_geocode(%no_latlng) };
 1301: 			}
 1302: 
 1303: 			if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1304: 				CORE::push @{$self->{'log'}}, {
 1305: 					line      => $call_details[2],
 1306: 					location  => $latlng,
 1307: 					geocoder  => ref($geocoder),
 1308: 					timetaken => 0,
 1309: 					wantarray => 1,
 1310: 					error     => $@,
 1311: 				};
 1312: 				$self->_warn(ref($geocoder), " '$latlng': $@");
 1313: 				next;
 1314: 			}
 1315: 
 1316: 			$self->_debug(Data::Dumper->new([\@locs])->Dump()) if($self->{'debug'} >= 2);

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1316_75_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1316_75_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1316_75_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1317: 
 1318: 			foreach my $loc (@locs) {
 1319: 				next unless(defined($loc));
 1320: 
 1321: 				# A plain string is the address itself, as it is in scalar
 1322: 				# context; anything else that is not a HASH has none to give
 1323: 				if(!ref($loc)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1324: 					CORE::push @rc, $loc if(length($loc));
 1325: 					next;
 1326: 				}
 1327: 				next unless(reftype($loc) eq 'HASH');
 1328: 
 1329: 				if(my $name = $loc->{'display_name'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1330: 					# OSM returns the full address in display_name
 1331: 					CORE::push @rc, $name;
 1332: 				} elsif($loc->{'city'}) {
 1333: 					# Geo::Coder::CA: build the address from individual fields
 1334: 					CORE::push @rc, _build_ca_address($loc);
 1335: 				} elsif($loc->{features}) {
 1336: 					# GeoApify: formatted string inside a features array
 1337: 					CORE::push @rc,
 1338: 						$loc->{features}[0]->{properties}{formatted};
 1339: 					last;	# only one result from this provider
 1340: 				}
 1341: 			}
 1342: 
 1343: 			CORE::push @{$self->{'log'}}, {
 1344: 				line      => $call_details[2],
 1345: 				location  => $latlng,
 1346: 				geocoder  => ref($geocoder),
 1347: 				timetaken => 0,
 1348: 				wantarray => 1,
 1349: 				result    => \@rc,
 1350: 			};
 1351: 
 1352: 			# A geocoder with no address for the position has not answered;
 1353: 			# the next one may
 1354: 			next unless(scalar(@rc));
 1355: 
 1356: 			$self->_cache($latlng, \@rc);
 1357: 			return @rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1358: 
 1359: 		} else {
 1360: 			# ── Scalar context: return the first address string ────────────────
 1361: 			my $rc = $self->_cache($latlng)
 1362: 				// eval { $geocoder->reverse_geocode(%{$params}) };
 1363: 
 1364: 			# Same strict-validation fallback as the list-context path above
 1365: 			if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1366: 				my %no_latlng = %{$params};
 1367: 				delete $no_latlng{'latlng'};
 1368: 				$@ = '';
 1369: 				$rc = eval { $geocoder->reverse_geocode(%no_latlng) };
 1370: 			}
 1371: 
 1372: 			if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1373: 				CORE::push @{$self->{'log'}}, {
 1374: 					line      => $call_details[2],
 1375: 					location  => $latlng,
 1376: 					geocoder  => ref($geocoder),
 1377: 					timetaken => 0,
 1378: 					wantarray => 0,
 1379: 					error     => $@,
 1380: 				};
 1381: 				$self->_warn(ref($geocoder), " '$latlng': $@");
 1382: 				next;
 1383: 			}
 1384: 
 1385: 			# A bare string needs no further processing
 1386: 			next unless defined $rc;
 1387: 			if(!ref($rc)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1388: 				CORE::push @{$self->{'log'}}, {
 1389: 					line      => $call_details[2],
 1390: 					location  => $latlng,
 1391: 					geocoder  => ref($geocoder),
 1392: 					timetaken => 0,
 1393: 					wantarray => 0,
 1394: 					result    => $rc,
 1395: 				};
 1396: 				return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1397: 			}
 1398: 
 1399: 			$self->_debug(Data::Dumper->new([$rc])->Dump()) if($self->{'debug'} >= 2);

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1399_72_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1399_72_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1399_72_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1400: 
 1401: 			if(my $name = $rc->{'display_name'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1402: 				# OSM
 1403: 				CORE::push @{$self->{'log'}}, {
 1404: 					line      => $call_details[2],
 1405: 					location  => $latlng,
 1406: 					geocoder  => ref($geocoder),
 1407: 					timetaken => 0,
 1408: 					wantarray => 0,
 1409: 					result    => $name,
 1410: 				};
 1411: 				return $self->_cache($latlng, $name);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1412: 			}
 1413: 
 1414: 			if($rc->{'city'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1415: 				# Geo::Coder::CA
 1416: 				my $name = _build_ca_address($rc);
 1417: 				CORE::push @{$self->{'log'}}, {
 1418: 					line      => $call_details[2],
 1419: 					location  => $latlng,
 1420: 					geocoder  => ref($geocoder),
 1421: 					timetaken => 0,
 1422: 					wantarray => 0,
 1423: 					result    => $name,
 1424: 				};
 1425: 				return $self->_cache($latlng, $name);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1426: 			}
 1427: 
 1428: 			if($rc->{features}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1429: 				# GeoApify
 1430: 				my $name = $rc->{features}[0]->{properties}{formatted};
 1431: 				CORE::push @{$self->{'log'}}, {
 1432: 					line      => $call_details[2],
 1433: 					location  => $latlng,
 1434: 					geocoder  => ref($geocoder),
 1435: 					timetaken => 0,
 1436: 					wantarray => 0,
 1437: 					result    => $name,
 1438: 				};
 1439: 				return $self->_cache($latlng, $name);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1440: 			}
 1441: 		}
 1442: 	}
 1443: 
 1444: 	return;
 1445: }
 1446: 
 1447: # =============================================================================
 1448: 
 1449: =head2 log
 1450: 
 1451: Returns the record of what has happened since the object was made, or
 1452: since the last C<flush()>.  There is one entry for each question asked of
 1453: a geocoder, and one for each answer that C<geocode()> serves from the
 1454: cache.  C<reverse_geocode()> adds no entry when it answers from the
 1455: cache.
 1456: 
 1457:     for my $entry (@{ $list->log() }) {
 1458:         printf "%s: %.3fs via %s\n",
 1459:             $entry->{location},
 1460:             $entry->{timetaken},
 1461:             $entry->{geocoder};
 1462:     }
 1463: 
 1464: Each entry is a hash reference with these keys:
 1465: 
 1466: =over 4
 1467: 
 1468: =item * C<location> - the place name or C<latlng> that was asked about
 1469: 
 1470: =item * C<geocoder> - the class name of the geocoder, or C<'cache'>
 1471: 
 1472: =item * C<timetaken> - how long the geocoder took, in seconds
 1473: 
 1474: =item * C<line> - the line of your program that made the call
 1475: 
 1476: =item * C<wantarray> - true if the call was made in list context
 1477: 
 1478: =item * C<result> - the answer, when there was one; the string
 1479: C<'not found'> when the geocoder had none
 1480: 
 1481: =item * C<error> - the error, when the geocoder died or returned an
 1482: error; this can be an exception object, not only a string
 1483: 
 1484: =back
 1485: 
 1486: The returned array reference is the object's own record, not a copy.
 1487: 
 1488: =head3 API SPECIFICATION
 1489: 
 1490: =head4 INPUT
 1491: 
 1492:     []
 1493: 
 1494: =head4 OUTPUT
 1495: 
 1496:     {
 1497:         type => 'arrayref',
 1498:     }
 1499: 
 1500:     # Each element:
 1501:     #   {
 1502:     #       line      => Int,
 1503:     #       location  => Str,
 1504:     #       timetaken => Num,
 1505:     #       geocoder  => Str,                     # class name, or 'cache'
 1506:     #       wantarray => Bool,
 1507:     #       result    => HASHREF | ARRAYREF | Str,  # on success
 1508:     #       error     => Str | OBJECT | HASHREF,    # on failure
 1509:     #   }
 1510: 
 1511: =cut
 1512: 
 1513: sub log {
 1514: 	my $self = shift;
 1515: 
 1516: 	# Guard against the state left by flush(); always return a valid arrayref
 1517: 	return $self->{'log'} // [];
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1518: }
 1519: 
 1520: # =============================================================================
 1521: 
 1522: =head2 flush
 1523: 
 1524: Empties the log and returns the object itself, so that it can be chained.
 1525: 
 1526:     $list->geocode('Paris, France');
 1527:     my $entries = $list->log();
 1528:     $list->flush()->geocode('London, UK');
 1529: 
 1530: C<flush> does B<not> empty the cache.
 1531: 
 1532: =head3 API SPECIFICATION
 1533: 
 1534: =head4 INPUT
 1535: 
 1536:     []
 1537: 
 1538: =head4 OUTPUT
 1539: 
 1540:     {
 1541:         type => 'object',
 1542:         isa  => 'Geo::Coder::List',
 1543:     }
 1544: 
 1545: =cut
 1546: 
 1547: sub flush {
 1548: 	my $self = shift;
 1549: 
 1550: 	# Reset to an empty arrayref so log() always returns a valid reference
 1551: 	$self->{'log'} = [];
 1552: 
 1553: 	return $self;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1554: }
 1555: 
 1556: # =============================================================================
 1557: # PRIVATE HELPERS
 1558: # =============================================================================
 1559: 
 1560: # _build_ca_address
 1561: #
 1562: # Purpose:    Assemble a printable address string from a Geo::Coder::CA
 1563: #             reverse-geocode response.  The CA response uses different keys
 1564: #             for US addresses (nested under 'usa') vs Canadian ones.
 1565: #
 1566: # Entry:      $loc - HASHREF from Geo::Coder::CA reverse_geocode()
 1567: #
 1568: # Exit:       Returns a plain string, or empty string if nothing was found.
 1569: #
 1570: # Notes:      Street number and name are joined with a space; other parts
 1571: #             (city, province/state, country) are joined with ', '.
 1572: 
 1573: sub _build_ca_address
 1574: {
●1575 → 1578 → 1597 1575: 	my $loc = $_[0];
 1576: 	my $name  = '';
 1577: 
 1578: 	if(my $usa = $loc->{'usa'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1579: 		# US address layout inside a CA result
 1580: 		$name  = $usa->{'usstnumber'} // '';
 1581: 		# Street name follows number with a space; if no number, no leading space
 1582: 		$name .= ($name ? ' ' : '') . $usa->{'usstaddress'} if $usa->{'usstaddress'};
 1583: 		# City, state, country each separated by ', '; skip separator if name empty
 1584: 		$name .= ($name ? ', ' : '') . $usa->{'uscity'}     if $usa->{'uscity'};
 1585: 		$name .= ($name ? ', ' : '') . $usa->{'state'}      if $usa->{'state'};
 1586: 		# Country is always appended for the US branch
 1587: 		$name .= ($name ? ', ' : '') . 'USA';
 1588: 	} else {
 1589: 		# Canadian address layout
 1590: 		$name  = $loc->{'stnumber'} // '';
 1591: 		# Street name follows number with a space; if no number, no leading space
 1592: 		$name .= ($name ? ' ' : '') . $loc->{'staddress'}   if $loc->{'staddress'};
 1593: 		$name .= ($name ? ', ' : '') . $loc->{'city'}        if $loc->{'city'};
 1594: 		$name .= ($name ? ', ' : '') . $loc->{'prov'}        if $loc->{'prov'};
 1595: 	}
 1596: 
 1597: 	return $name;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1598: }
 1599: 
 1600: # -----------------------------------------------------------------------------
 1601: 
 1602: # _cache
 1603: #
 1604: # Read from or write to the two-level cache.
 1605: #             L1 is an in-process HASH (always active).
 1606: #             L2 is an optional CHI-compatible object or a plain HASH ref.
 1607: #
 1608: # Entry (write): _cache($key, $value)
 1609: #             $value may be undef, which is stored as $NOT_FOUND_SENTINEL so
 1610: #             subsequent reads can distinguish "cached not-found" from "never
 1611: #             looked up".  Detect the write path by testing scalar(@_) before
 1612: #             shifting, not by truthiness of the value.
 1613: #
 1614: # Entry (read):  _cache($key)
 1615: #
 1616: # Exit (write):  Returns $value (undef if the location was not found).
 1617: # Exit (read):   Returns the cached value, or undef if not in cache.
 1618: #             $NOT_FOUND_SENTINEL is never surfaced to callers; undef is
 1619: #             returned in its place so callers handle both cases identically.
 1620: #
 1621: # Side effects: May update $self->{locations} (L1) and $self->{'cache'} (L2).
 1622: #
 1623: # Notes:      Cache TTLs are taken from $self->{cache_*_duration}, which are
 1624: #             initialised from %config and overridable via Object::Configure.
 1625: #             Not-found sentinels are stored only in L1 to avoid leaking
 1626: #             internal implementation details into an external L2 store.
 1627: 
 1628: sub _cache {
●1629 → 1636 → 1714 1629: 	my $self = shift;
 1630: 	my $key  = shift;
 1631: 
 1632: 	# ── Write path ────────────────────────────────────────────────────────
 1633: 	# Detect a write call by the presence of a third argument (even if undef).
 1634: 	# Testing truthiness of the value would silently swallow not-found results.
 1635: 
 1636: 	if(scalar(@_)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1637: 		my $value = shift;
 1638: 
 1639: 		# Store a sentinel for not-found so we can skip backends on repeat calls
 1640: 		my $stored = defined($value) ? $value : $NOT_FOUND_SENTINEL;
 1641: 		$self->{locations}->{$key} = $stored;
 1642: 
 1643: 		my $rc = $value;
 1644: 
 1645: 		if($self->{'cache'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1646: 			# L2 is written from copies: the caller is returned $value and L1
 1647: 			# holds it, so what is stripped for storage must not be stripped
 1648: 			# from what they see
 1649: 			my $l2value = $value;
 1650: 			my $duration;
 1651: 
 1652: 			if(ref($value) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1653: 				$l2value = [ map { _l2_copy($_, $self->{'debug'}) } @{$value} ];
 1654: 
 1655: 				foreach my $item (@{$l2value}) {
 1656: 					next unless ref($item) eq 'HASH';
 1657: 
 1658: 					unless(_has_lat($item)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1659: 						# Geometry without a lat may be a transient failure, so
 1660: 						# retry soon; no geometry at all is a miss
 1661: 						$duration //= defined($item->{geometry})
 1662: 							? $self->{'cache_part_duration'}
 1663: 							: $self->{'cache_miss_duration'};
 1664: 						$rc = undef;
 1665: 					}
 1666: 				}
 1667: 
 1668: 				# All items were clean: use the full hit duration
 1669: 				$duration //= $self->{'cache_hit_duration'};
 1670: 
 1671: 			} elsif(ref($value) eq 'HASH') {
 1672: 				$l2value = _l2_copy($value, $self->{'debug'});
 1673: 
 1674: 				if(_has_lat($l2value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1675: 					# Confirmed location: cache for a full month
 1676: 					$duration = $self->{'cache_hit_duration'};
 1677: 				} elsif(defined($l2value->{geometry})) {
 1678: 					# Partial geometry: may be a transient failure, retry soon
 1679: 					$duration = $self->{'cache_part_duration'};
 1680: 					$rc = undef;
 1681: 				} else {
 1682: 					# No geometry at all: place probably does not exist
 1683: 					$duration = $self->{'cache_miss_duration'};
 1684: 					$rc = undef;
 1685: 				}
 1686: 			} else {
 1687: 				# Scalar string or a blessed object (e.g. Geo::Location::Point)
 1688: 				$l2value = _l2_copy($value, 1);
 1689: 				$duration = $self->{'cache_hit_duration'};
 1690: 			}
 1691: 
 1692: 			$self->_debug(Data::Dumper->new([$l2value])->Dump()) if($self->{'debug'});
 1693: 
 1694: 			# Do not push the not-found sentinel into L2
 1695: 			if(!defined($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1696: 				# value is not-found; L1 sentinel is sufficient
 1697: 			} elsif(ref($self->{'cache'}) eq 'HASH') {
 1698: 				$self->{'cache'}->{$key} = $l2value;
 1699: 			} else {
 1700: 				# L2 is only an optimisation: a store that is down must not
 1701: 				# lose the caller the result that has already been found
 1702: 				local $@;
 1703: 				eval { $self->{'cache'}->set($key, $l2value, $duration); 1 }
 1704: 					or $self->_warn(__PACKAGE__, ": cache set failed for '$key': $@");
 1705: 			}
 1706: 		}
 1707: 
 1708: 		return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1709: 	}
 1710: 
 1711: 	# ── Read path ─────────────────────────────────────────────────────────
 1712: 
 1713: 	# Check L1 first (in-process, no serialisation cost)
●1714 → 1717 → 1729 1714: 	my $rc = $self->{'locations'}->{$key};
 1715: 
 1716: 	# Fall through to L2 only when L1 has no entry for this key
 1717: 	if((!defined($rc)) && $self->{'cache'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1718: 		if(ref($self->{'cache'}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1719: 			$rc = $self->{'cache'}->{$key};
 1720: 		} else {
 1721: 			# A store that cannot be read is treated as a miss, so the lookup
 1722: 			# goes to the geocoders rather than failing
 1723: 			local $@;
 1724: 			$rc = eval { $self->{'cache'}->get($key) };
 1725: 			$self->_warn(__PACKAGE__, ": cache get failed for '$key': $@") if($@);
 1726: 		}
 1727: 	}
 1728: 
●1729 → 1735 → 1742 1729: 	return unless defined $rc;
 1730: 
 1731: 	# Translate the not-found sentinel back to undef for the caller
 1732: 	return if ref($rc) && (ref($rc) eq _NOT_FOUND_CLASS);
 1733: 
 1734: 	# Restore the convenience aliases that were stripped before L2 storage
 1735: 	if(ref($rc) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1736: 		return unless defined($rc->{geometry}{location}{lat});
 1737: 		$rc->{'lat'} //= $rc->{geometry}{location}{lat};
 1738: 		$rc->{'lng'} //= $rc->{geometry}{location}{lng};
 1739: 		$rc->{'lon'} //= $rc->{geometry}{location}{lng};
 1740: 	}
 1741: 
 1742: 	return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1743: }
 1744: 
 1745: # A copy of one result fit for L2.  The geocoder object becomes its class name,
 1746: # since a handle it holds may not serialise, and unless $keep_all only geometry
 1747: # is kept, to keep the entry small.  Anything that is not a HASH-based
 1748: # reference is returned as it is.
 1749: sub _l2_copy {
●1750 → 1760 → 1764 1750: 	my ($item, $keep_all) = @_;
 1751: 
 1752: 	return $item unless ref($item) && (reftype($item) eq 'HASH');
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1753: 
 1754: 	my $copy = { %{$item} };
 1755: 	$copy = bless $copy, ref($item) if blessed($item);
 1756: 
 1757: 	$copy->{'geocoder'} = ref($copy->{'geocoder'}) if ref($copy->{'geocoder'});
 1758: 
 1759: 	# A blessed object keeps its fields: its accessors may rely on them
 1760: 	unless($keep_all || blessed($item)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1761: 		delete @{$copy}{grep { $_ ne 'geometry' } keys %{$copy}};
 1762: 	}
 1763: 
 1764: 	return $copy;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1765: }
 1766: 
 1767: # Whether a result carries a latitude, looked for without auto-vivifying the
 1768: # path to it in a structure that may be shared with the caller
 1769: sub _has_lat {
 1770: 	my $item = shift;
 1771: 
 1772: 	return 0 unless ref($item->{geometry}) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1773: 	return 0 unless ref($item->{geometry}{location}) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1774: 	return defined($item->{geometry}{location}{lat}) ? 1 : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1775: }
 1776: 
 1777: # Emit a debug message somewhere
 1778: sub _debug {
●1779 → 1786 → 1790 1779: 	my $self = shift;
 1780: 
 1781: 	# Callers may end the message with a newline or not; it is printed with
 1782: 	# exactly one, and given to the logger with none
 1783: 	my $message = join('', map { $_ // '' } @_);
 1784: 	$message .= "\n" unless($message =~ /\n\z/);
 1785: 
 1786: 	if(my $logger = $self->{logger}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1787: 		(my $line = $message) =~ s/\n\z//;
 1788: 		$logger->debug($line);
 1789: 	}
●1790 → 1790 → 0 1790: 	if($self->{debug}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1791: 		print $message;
 1792: 	}
 1793: }
 1794: 
 1795: # Emit a warning message somewhere
 1796: sub _warn {
●1797 → 1799 → 0 1797: 	my $self = shift;
 1798: 
 1799: 	if(my $logger = $self->{logger}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1800: 		$logger->warn(@_);
 1801: 	} else {
 1802: 		Carp::carp(@_);
 1803: 	}
 1804: }
 1805: 
 1806: # Emit an error message somewhere
 1807: sub _error {
●1808 → 1810 → 0 1808: 	my $self = shift;
 1809: 
 1810: 	if(my $logger = $self->{logger}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1811: 		$logger->error(@_);
 1812: 		die @_;
 1813: 	} else {
 1814: 		Carp::croak(@_);
 1815: 	}
 1816: }
 1817: 
 1818: # =============================================================================
 1819: # DOCUMENTATION
 1820: # =============================================================================
 1821: 
 1822: =head1 COMMON PITFALLS
 1823: 
 1824: =over 4
 1825: 
 1826: =item * B<Scalar context and list context give different answers.>
 1827: 
 1828: C<geocode()> and C<reverse_geocode()> return one answer in scalar
 1829: context and all answers in list context.  Perl decides the context from
 1830: the code around the call, and some places give list context when you may
 1831: not expect it:
 1832: 
 1833:     my %row = (name => $name, place => $list->geocode($name));  # list context!
 1834:     print 'Found: ', $list->geocode($name);                     # list context!
 1835:     return $list->geocode($name);                               # your caller decides
 1836: 
 1837: When nothing is found, list context returns an I<empty list>, so in the
 1838: first example the keys and values of C<%row> move out of step.  Use
 1839: C<scalar()> to be sure:
 1840: 
 1841:     my %row = (name => $name, place => scalar($list->geocode($name)));
 1842: 
 1843: =item * B<C<undef> means "not found" and also "bad empty input".>
 1844: 
 1845: C<geocode()> returns C<undef> both when no geocoder knows the place and
 1846: when C<location> is C<undef> or empty (it also warns in that case).  Other
 1847: bad input, such as a reference or a string of digits, does not return
 1848: C<undef>: it croaks.  Wrap the call in C<eval> when the text comes from
 1849: outside your program.
 1850: 
 1851: =item * B<"Not found" is remembered for the life of the object.>
 1852: 
 1853: When no geocoder finds a place, L1 remembers that, and later calls for
 1854: the same place return C<undef> at once without asking any geocoder, even
 1855: if a geocoder was only down for a moment.  C<flush()> does not forget it,
 1856: and nor does a clone, which shares L1.  Make a new object with
 1857: C<Geo::Coder::List-E<gt>new()> to ask again.  L2 never stores "not
 1858: found".
 1859: 
 1860: =item * B<An answer from L2 has only its position.>
 1861: 
 1862: To keep L2 small, only C<geometry> is stored there (unless C<debug> is
 1863: set).  An answer that comes from L2, for example in a new run of your
 1864: program, has C<geometry>, C<lat>, C<lng>, C<lon> and C<geocoder> (set to
 1865: C<'cache'>), but none of the provider's other fields, such as an address
 1866: or a place type.  Answers from L1 keep every field.
 1867: 
 1868: =item * B<The C<geocoder> key is not always an object.>
 1869: 
 1870: It is the geocoder object when a geocoder answered, and the string
 1871: C<'cache'> when the cache answered.  Do not call methods on it without
 1872: checking.  To get a printable name in both cases:
 1873: 
 1874:     my $source = ref($result->{geocoder}) || $result->{geocoder};
 1875: 
 1876: =item * B<Changing an answer changes the cache.>
 1877: 
 1878: The first answer for a place is the same hash that L1 stores.  If you
 1879: change it, later answers for that place, which are copies of the L1 entry,
 1880: include your change.  Copy the answer before you change it.
 1881: 
 1882: =item * B<The hash you give to C<push()> is changed.>
 1883: 
 1884: C<limit> counts down inside the hash reference that you pushed.  If you
 1885: push the same hash reference into two lists, they share one limit.  A
 1886: clone made with C<< $list->new() >> has its own copy.
 1887: 
 1888: =item * B<The cache key is the exact text.>
 1889: 
 1890: C<'Paris, France'>, C<'paris, france'> and C<'Paris,France'> are three
 1891: different keys, and each one asks the geocoders again.  Only runs of
 1892: white space are made into one space before the text is used as a key.
 1893: 
 1894: =item * B<HTML entities are always decoded.>
 1895: 
 1896: C<'AT&amp;T Park'> is looked up as C<'AT&T Park'>.  There is no way to
 1897: look up text that really contains C<&amp;>.
 1898: 
 1899: =item * B<Strings of digits depend on an optional module.>
 1900: 
 1901: When L<Geo::Location::Predicate> is installed, C<geocode('12345')> croaks.
 1902: When it is not installed, C<'12345'> is sent to the geocoders.  If you
 1903: handle postcodes or ZIP codes, add the country, such as
 1904: C<'12345, USA'>.
 1905: 
 1906: =item * B<C<reverse_geocode()> ignores C<regex>.>
 1907: 
 1908: A geocoder added with C<regex> is still asked to reverse geocode every
 1909: position.  Only C<limit> is honoured.
 1910: 
 1911: =item * B<The log grows until you empty it.>
 1912: 
 1913: Every call adds to the log.  In a long-running program, such as a web
 1914: server, call C<flush()> from time to time.
 1915: 
 1916: =item * B<Debug output goes to standard output.>
 1917: 
 1918: With C<debug> set, messages are printed to C<STDOUT>, not C<STDERR>, so
 1919: they mix with your program's own output.  The same messages are always
 1920: given to the configured C<logger> at debug level, whether C<debug> is set
 1921: or not, so a logger is the way to collect them somewhere else.
 1922: 
 1923: =back
 1924: 
 1925: =head1 ENCODING
 1926: 
 1927: =over 4
 1928: 
 1929: =item * B<Place names> (C<location> in C<geocode()>) may contain any
 1930: Unicode text, including accented letters, other alphabets and emoji.
 1931: Give them to C<geocode()> as Perl I<character> strings: if your text is
 1932: UTF-8 bytes from a file or a web form, decode it first, for example with
 1933: C<Encode::decode('UTF-8', $bytes)>.  HTML entities in the text are decoded
 1934: into characters, so text that mixes UTF-8 bytes that are not yet decoded
 1935: with entities becomes garbled.  The text is passed to each geocoder unchanged apart from
 1936: that; whether a geocoder understands emoji is up to the geocoder.
 1937: 
 1938: =item * B<White space.>  Runs of ASCII spaces, tabs and new lines are
 1939: always made into one space.  Unicode spaces, such as the no-break space,
 1940: may or may not be, depending on how Perl stores the string; do not rely on
 1941: it.
 1942: 
 1943: =item * B<Positions> (C<latlng> in C<reverse_geocode()>) must be ASCII.
 1944: Only the digits C<0> to C<9> are accepted.  Other Unicode digits, such as
 1945: Eastern Arabic or full-width digits, are refused.
 1946: 
 1947: =item * B<Cache keys> are the cleaned text, so they can contain any
 1948: character.  L1 and a plain-hash L2 accept them all.  An L2 object must
 1949: accept character-string keys; L<CHI> does.
 1950: 
 1951: =item * B<Answers> are returned as the geocoder gave them.  Most
 1952: geocoders return character strings.
 1953: 
 1954: =item * B<Debug output> prints place names to C<STDOUT>.  If they contain
 1955: characters above 255, Perl warns C<Wide character in print> unless
 1956: C<STDOUT> has an encoding layer, such as
 1957: C<binmode(STDOUT, ':encoding(UTF-8)')>.
 1958: 
 1959: =back
 1960: 
 1961: =head1 AUTHOR
 1962: 
 1963: Nigel Horne, C<< <njh at nigelhorne.com> >>
 1964: 
 1965: =head1 BUGS
 1966: 
 1967: Please report any bugs or feature requests to
 1968: C<bug-geo-coder-list at rt.cpan.org>, or through the web interface at
 1969: L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Geo-Coder-List>.
 1970: 
 1971: Known limitations:
 1972: 
 1973: =over 4
 1974: 
 1975: =item * C<reverse_geocode()> does not yet support L<Geo::Location::Point> objects.
 1976: 
 1977: =item * C<reverse_geocode()> does not honour C<regex>.
 1978: 
 1979: =back
 1980: 
 1981: =head1 SEE ALSO
 1982: 
 1983: =over 4
 1984: 
 1985: =item * L<Test Dashboard|https://nigelhorne.github.io/Geo-Coder-List/coverage/>
 1986: 
 1987: =item * L<CHI>
 1988: 
 1989: =item * L<Geo::Coder::All>
 1990: 
 1991: =item * L<Geo::Coder::GooglePlaces>
 1992: 
 1993: =item * L<Geo::Coder::Many>
 1994: 
 1995: =item * L<Geo::Location::Predicate>
 1996: 
 1997: =item * L<HTML::GoogleMaps::V3>
 1998: 
 1999: =item * L<HTML::OSM>
 2000: 
 2001: =item * L<Configure an Object at Runtime|Object::Configure>
 2002: 
 2003: =item * L<Readonly>
 2004: 
 2005: =back
 2006: 
 2007: =head1 SUPPORT
 2008: 
 2009: You can find documentation for this module with the perldoc command:
 2010: 
 2011:     perldoc Geo::Coder::List
 2012: 
 2013: =over 4
 2014: 
 2015: =item * RT: CPAN's request tracker
 2016: 
 2017: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Coder-List>
 2018: 
 2019: =item * MetaCPAN
 2020: 
 2021: L<https://metacpan.org/release/Geo-Coder-List>
 2022: 
 2023: =back
 2024: 
 2025: =encoding utf-8
 2026: 
 2027: =head1 FORMAL SPECIFICATION
 2028: 
 2029: The specifications below use the Z notation.  They describe what each
 2030: method does to the state of the object; they do not describe how.
 2031: 
 2032: =head2 State
 2033: 
 2034:     [Geocoder, Regex, Text, Result, LogEntry, Duration]
 2035: 
 2036:     Key         == Text
 2037:     NotFound    ::= notFound
 2038:     Entry       ::= plain⟨⟨Geocoder⟩⟩
 2039:                   | routed⟨⟨Geocoder × ℙ Text × (ℤ ∪ {∞})⟩⟩
 2040:                     -- the geocoder, the texts its regex matches, its limit
 2041: 
 2042:     ┌─ GeoCoderList ─────────────────────────────────────────────────
 2043:     │ geocoders : seq Entry
 2044:     │ L1        : Key ⇸ (Result ∪ NotFound)
 2045:     │ L2        : Key ⇸ Result
 2046:     │ log       : seq LogEntry
 2047:     │ debug     : 0 ‥ 2
 2048:     │ hit, part, miss : Duration
 2049:     ├────────────────────────────────────────────────────────────────
 2050:     │ notFound ∉ ran L2
 2051:     │ ∀ r : ran L2 • dom r ⊆ {geometry, geocoder}  ∨  debug > 0
 2052:     └────────────────────────────────────────────────────────────────
 2053: 
 2054:     usable : â„™ Result
 2055:     usable = { r : Result | r.geometry.location.lat ≠ ⊥
 2056:                           ∧ r.geometry.location.lng ≠ ⊥ }
 2057: 
 2058:     clean : Text → Text
 2059:     -- runs of white space become one space; HTML entities are decoded
 2060: 
 2061:     isPlace : (Text ∪ Reference) → 𝔹
 2062:     -- Geo::Location::Predicate::_valid_location when installed;
 2063:     -- otherwise true for every non-empty Text and false for a Reference
 2064: 
 2065: =head2 new
 2066: 
 2067:     ┌─ New ──────────────────────────────────────────────────────────
 2068:     │ GeoCoderList′
 2069:     │ args? : Key ⇸ Value
 2070:     ├────────────────────────────────────────────────────────────────
 2071:     │ geocoders′ = args?(geocoders) if geocoders ∈ dom args?, else ⟨⟩
 2072:     │ L1′  = ∅
 2073:     │ log′ = ⟨⟩
 2074:     │ L2′  = args?(cache) if cache ∈ dom args?, else ∅
 2075:     │ hit′ = 1 month ∧ part′ = 1 day ∧ miss′ = 1 week   -- unless given
 2076:     └────────────────────────────────────────────────────────────────
 2077: 
 2078:     ┌─ Clone ────────────────────────────────────────────────────────
 2079:     │ GeoCoderList ; GeoCoderList′
 2080:     │ args? : Key ⇸ Value
 2081:     ├────────────────────────────────────────────────────────────────
 2082:     │ geocoders′ = geocoders            -- equal values, distinct copies
 2083:     │ L1′ = L1 ∧ L2′ = L2               -- the same stores, shared
 2084:     │ log′ = ⟨⟩
 2085:     └────────────────────────────────────────────────────────────────
 2086: 
 2087: =head2 push
 2088: 
 2089:     ┌─ Push ─────────────────────────────────────────────────────────
 2090:     │ ΔGeoCoderList
 2091:     │ g? : Entry
 2092:     ├────────────────────────────────────────────────────────────────
 2093:     │ g? ≠ ⊥
 2094:     │ geocoders′ = geocoders ⁀ ⟨g?⟩
 2095:     │ L1′ = L1 ∧ L2′ = L2 ∧ log′ = log
 2096:     └────────────────────────────────────────────────────────────────
 2097: 
 2098:     PushUndef ≙ [ ΞGeoCoderList ; g? : Entry | g? = ⊥ ] ⇒ croak
 2099: 
 2100: =head2 geocode
 2101: 
 2102:     asks : Entry × Text ⇸ 𝔹
 2103:     asks(plain g, t)          = true
 2104:     asks(routed(g, M, n), t)  = t ∈ M ∧ n > 0
 2105: 
 2106:     spend : Entry × Text → Entry
 2107:     spend(routed(g, M, n), t) = routed(g, M, n − 1)   if t ∈ M ∧ n > 0
 2108:     spend(e, t)               = e                      otherwise
 2109: 
 2110:     ┌─ Geocode ──────────────────────────────────────────────────────
 2111:     │ ΔGeoCoderList
 2112:     │ loc?    : Text ∪ Reference
 2113:     │ result! : Result ∪ {⊥}
 2114:     ├────────────────────────────────────────────────────────────────
 2115:     │ let t == clean(loc?) •
 2116:     │   ¬ isPlace(t) ⇒ croak
 2117:     │
 2118:     │   t ∈ dom L1 ∧ L1(t) ∈ Result
 2119:     │     ⇒ result! = L1(t) ⊕ {geocoder ↦ cache}
 2120:     │        ∧ geocoders′ = geocoders ∧ L1′ = L1
 2121:     │
 2122:     │   t ∈ dom L1 ∧ L1(t) = notFound
 2123:     │     ⇒ result! = ⊥ ∧ geocoders′ = geocoders ∧ L1′ = L1
 2124:     │
 2125:     │   t ∉ dom L1
 2126:     │     ⇒ (∃ i : dom geocoders •
 2127:     │            asks(geocoders i, t)
 2128:     │          ∧ (∀ j : 1 ‥ i − 1 • ¬ asks(geocoders j, t)
 2129:     │                              ∨ answer(geocoders j, t) ∉ usable)
 2130:     │          ∧ answer(geocoders i, t) ∈ usable
 2131:     │          ∧ result! = answer(geocoders i, t)
 2132:     │          ∧ L1′ = L1 ⊕ {t ↦ result!}
 2133:     │          ∧ L2′ = L2 ⊕ {t ↦ result! ↾ {geometry, geocoder}})
 2134:     │      ∨ (result! = ⊥ ∧ L1′ = L1 ⊕ {t ↦ notFound} ∧ L2′ = L2)
 2135:     │
 2136:     │   geocoders′ = ⟨ e : geocoders • spend(e, t) ⟩   -- for those asked
 2137:     │   log′ = log ⁀ ⟨ one entry per geocoder asked, or one for the cache ⟩
 2138:     └────────────────────────────────────────────────────────────────
 2139: 
 2140: =head2 ua
 2141: 
 2142:     ┌─ UA ───────────────────────────────────────────────────────────
 2143:     │ ΞGeoCoderList
 2144:     │ ua? : UserAgent ∪ {⊥}
 2145:     │ ua! : UserAgent ∪ {⊥}
 2146:     ├────────────────────────────────────────────────────────────────
 2147:     │ ua? = ⊥ ⇒ ua! = ⊥
 2148:     │ ua? ≠ ⊥ ⇒ ua! = ua?
 2149:     │         ∧ (∀ e : ran geocoders • geocoderOf(e) ≠ ⊥ ∨ croak)
 2150:     │         ∧ (∀ e : ran geocoders •
 2151:     │              geocoderOf(e).ua′ = clone(ua?)   if ua? can clone and agent
 2152:     │              geocoderOf(e).ua′ = ua?          otherwise)
 2153:     └────────────────────────────────────────────────────────────────
 2154: 
 2155: =head2 reverse_geocode
 2156: 
 2157:     LatLng == { s : Text | s ∈ ⟦ ^W*[-+]?D W*,W*[-+]?D W*$ ⟧ }
 2158:     -- D is a decimal number written in the ASCII digits 0-9;
 2159:     -- W is a space or a tab
 2160: 
 2161:     ┌─ ReverseGeocode ───────────────────────────────────────────────
 2162:     │ ΔGeoCoderList
 2163:     │ latlng?  : Text
 2164:     │ address! : Text ∪ {⊥}
 2165:     ├────────────────────────────────────────────────────────────────
 2166:     │ latlng? ∉ LatLng ⇒ croak
 2167:     │
 2168:     │ latlng? ∈ dom L1 ⇒ address! = first(L1(latlng?)) ∧ L1′ = L1
 2169:     │
 2170:     │ latlng? ∉ dom L1
 2171:     │   ⇒ (∃ i : dom geocoders •
 2172:     │          limitOf(geocoders i) > 0
 2173:     │        ∧ addresses(geocoders i, latlng?) ≠ ⟨⟩
 2174:     │        ∧ address! = head addresses(geocoders i, latlng?)
 2175:     │        ∧ L1′ = L1 ⊕ {latlng? ↦ address!})
 2176:     │    ∨ (address! = ⊥ ∧ L1′ = L1)
 2177:     └────────────────────────────────────────────────────────────────
 2178: 
 2179: =head2 log
 2180: 
 2181:     ┌─ Log ──────────────────────────────────────────────────────────
 2182:     │ ΞGeoCoderList
 2183:     │ entries! : seq LogEntry
 2184:     ├────────────────────────────────────────────────────────────────
 2185:     │ entries! = log
 2186:     └────────────────────────────────────────────────────────────────
 2187: 
 2188: =head2 flush
 2189: 
 2190:     ┌─ Flush ────────────────────────────────────────────────────────
 2191:     │ ΔGeoCoderList
 2192:     │ self! : GeoCoderList
 2193:     ├────────────────────────────────────────────────────────────────
 2194:     │ log′ = ⟨⟩
 2195:     │ geocoders′ = geocoders ∧ L1′ = L1 ∧ L2′ = L2
 2196:     │ self! = θGeoCoderList′
 2197:     └────────────────────────────────────────────────────────────────
 2198: 
 2199: =head1 STATE DIAGRAM
 2200: 
 2201: An object has three parts that change over time: its chain of geocoders,
 2202: its cache (one state for each place name), and its log.  Each part is
 2203: shown on its own below.
 2204: 
 2205: =head2 The object and its chain
 2206: 
 2207:     +-------------+  push($g)        +--------------+  push($g)
 2208:     |   EMPTY     |----------------->|    READY     |<-----------+
 2209:     | no geocoder |  adds $g to the  | 1+ geocoders |------------+
 2210:     +-------------+  end of chain    +--------------+  adds $g to the end
 2211:           |                                 |
 2212:           | geocode($t)                     | new() on the object
 2213:           | reverse_geocode($p)             | clone: copies the chain and
 2214:           v                                 | limits, shares L1 and L2,
 2215:     returns undef / ()                      | empties the log
 2216:     nothing is asked, but a                 v
 2217:     geocode() miss is still          +--------------+
 2218:     remembered in L1                 | READY (clone)|
 2219:                                      +--------------+
 2220: 
 2221: =head2 The cache, for one place name $t
 2222: 
 2223:     +-----------+ geocode($t): a geocoder gives a usable answer
 2224:     |           |----------------------------------------------+
 2225:     |  UNKNOWN  |  - answer stored in L1                       |
 2226:     | not in L1 |  - copy with only geometry stored in L2,     |
 2227:     |           |    kept for cache_hit_duration (1 month)     |
 2228:     +-----------+  - log gets one entry per geocoder asked     |
 2229:        |  ^                                                    v
 2230:        |  |                                             +-----------+
 2231:        |  | L2 entry expires, and a new object          |  FOUND    |<--+
 2232:        |  | is used (L1 dies with its object)           |  L1 holds |   | geocode($t):
 2233:        |  +---------------------------------------------| an answer |---+ no geocoder
 2234:        |                                                +-----------+   asked; a copy
 2235:        | geocode($t): no geocoder gives a usable answer                 returned with
 2236:        |  - L1 stores "not found"; L2 is not written                    geocoder='cache';
 2237:        |  - log gets one entry per geocoder asked                       log gets one
 2238:        v                                                                cache entry
 2239:     +-----------+
 2240:     | NOT FOUND |<--+ geocode($t): nothing asked, undef / () returned,
 2241:     | in L1     |---+ nothing logged
 2242:     +-----------+
 2243:           |
 2244:           +-- leaves this state only when the object is destroyed;
 2245:               flush() and clones do not leave it
 2246: 
 2247:     Any state: geocode($t) with a reference, digits (when
 2248:     Geo::Location::Predicate is installed) or entity-encoded digits
 2249:     --> croaks; the state does not change.
 2250: 
 2251: =head2 The limit of one geocoder pushed with limit => N
 2252: 
 2253:     +--------------+ geocode($t), $t matches regex   +--------------+
 2254:     |  ACTIVE      |-------------------------------->|  ACTIVE      |
 2255:     |  limit = n   |  geocoder asked; limit = n - 1  |  limit = n-1 |
 2256:     +--------------+                                 +--------------+
 2257:        |      ^                                             |
 2258:        |      | geocode($t), $t does not match regex:       | ... when the
 2259:        |      | geocoder not asked, limit unchanged         | limit reaches 0
 2260:        +------+                                             v
 2261:                                                      +--------------+
 2262:                                                      |  EXHAUSTED   |<--+
 2263:                                                      |  limit <= 0  |---+
 2264:                                                      +--------------+ geocode() and
 2265:                                                                       reverse_geocode():
 2266:                                                                       skipped, never asked
 2267: 
 2268: =head2 The log
 2269: 
 2270:     +-----------+  geocode() or reverse_geocode()   +-------------+
 2271:     |  EMPTY    |---------------------------------->|  HAS        |<--+
 2272:     |  log = [] |  appends one entry per geocoder   |  ENTRIES    |---+ geocode() /
 2273:     +-----------+  asked, or one for a cache hit    +-------------+   reverse_geocode():
 2274:          ^                                                 |          appends entries
 2275:          |               flush(): log = [], returns $self  |
 2276:          +-------------------------------------------------+
 2277:          ^
 2278:          | new() and clone: start EMPTY
 2279: 
 2280: =head1 LICENSE AND COPYRIGHT
 2281: 
 2282: Copyright 2016-2026 Nigel Horne.
 2283: 
 2284: Usage is subject to the GPL2 licence terms.
 2285: If you use it,
 2286: please let me know.
 2287: 
 2288: =cut
 2289: 
 2290: 1;