lib/Geo/Coder/List.pm

Index
Structural Coverage (Approximate)

TER1 (Statement): 98.23%
TER2 (Branch): 90.56%
TER3 (LCSAJ): 89.7% (35/39)
Approximate LCSAJ segments: 287

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows: 

        start → end → jump

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    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: use autodie qw(:all);
   10: 
   11: use Carp;
   12: use Data::Dumper;
   13: use HTML::Entities;
   14: use Object::Configure 0.13;
   15: use Params::Get 0.04;
   16: use Readonly;
   17: use Scalar::Util qw(blessed);
   18: use Time::HiRes;
   19: 
   20: =head1 NAME
   21: 
   22: Geo::Coder::List - Call many Geo-Coders
   23: 
   24: =head1 VERSION
   25: 
   26: Version 0.37
   27: 
   28: =cut
   29: 
   30: our $VERSION = '0.37';
   31: 
   32: # ── Module-level constants (not user-configurable) ────────────────────────────
   33: 
   34: # Default verbosity: 0 = silent, 1 = basic trace, 2 = full Data::Dumper dumps
   35: use constant DEBUG_DEFAULT => 0;
   36: 
   37: # Internal sentinel class: a cached not-found result stored in L1.
   38: # Using a blessed ref lets _cache() distinguish "never looked up" from
   39: # "looked up and found nothing" without requiring a special undef convention.
   40: use constant _NOT_FOUND_CLASS => __PACKAGE__ . '::_NotFound';
   41: 
   42: # The singleton value stored in L1 when a location is confirmed missing
   43: my $NOT_FOUND_SENTINEL = bless {}, _NOT_FOUND_CLASS;
   44: 
   45: # String placed in the 'geocoder' field of a result served from cache
   46: Readonly::Scalar my $CACHE_SOURCE => 'cache';
   47: 
   48: # String used as the 'result' value in log entries for a geocoder miss
   49: Readonly::Scalar my $RESULT_NONE => 'not found';
   50: 
   51: # ── Configurable defaults ─────────────────────────────────────────────────────
   52: #
   53: # Any key here can be overridden at run time via an environment variable named
   54: # GEO__CODER__LIST__<key>, which Object::Configure reads automatically in new().
   55: # Example:
   56: #   export GEO__CODER__LIST__cache_hit_duration='7 days'
   57: 
   58: my %config = (
   59: 	debug               => DEBUG_DEFAULT,
   60: 	# How long a confirmed location stays in the L2 cache
   61: 	cache_hit_duration  => '1 month',
   62: 	# How long a transient/partial failure is cached (retry tomorrow)
   63: 	cache_part_duration => '1 day',
   64: 	# How long a definite not-found is cached (place probably does not exist)
   65: 	cache_miss_duration => '1 week',
   66: );
   67: 
   68: # =============================================================================
   69: # PUBLIC API
   70: # =============================================================================
   71: 
   72: =head1 SYNOPSIS
   73: 
   74: L<Geo::Coder::All> and L<Geo::Coder::Many> are great modules but neither
   75: quite does what I want.
   76: 
   77: C<Geo::Coder::List> aggregates multiple geocoding services into a single,
   78: unified interface.  It chains and prioritizes backends based on regex routing
   79: and per-geocoder query limits, caches results at two levels (L1 in-memory
   80: always; optional L2 via CHI or a plain HASH), and normalizes every provider's
   81: idiosyncratic response into the common structure expected by
   82: L<HTML::GoogleMaps::V3> and L<HTML::OSM>:
   83: 
   84:     $result->{geometry}{location}{lat}   # canonical latitude
   85:     $result->{geometry}{location}{lng}   # canonical longitude
   86:     $result->{geocoder}                  # source object (or 'cache')
   87: 
   88:     use Geo::Coder::List;
   89:     use Geo::Coder::OSM;
   90:     use Geo::Coder::CA;
   91: 
   92:     my $list = Geo::Coder::List->new()
   93:         ->push({ regex => qr/(Canada|USA)$/, geocoder => Geo::Coder::CA->new() })
   94:         ->push(Geo::Coder::OSM->new());
   95: 
   96:     my $loc = $list->geocode('10 Downing St, London, UK');
   97:     printf "lat=%.4f lng=%.4f\n",
   98:         $loc->{geometry}{location}{lat},
   99:         $loc->{geometry}{location}{lng};
  100: 
  101: =head1 SUBROUTINES/METHODS
  102: 
  103: =head2 new
  104: 
  105: Creates a new C<Geo::Coder::List> object.  When called on an existing object
  106: it returns a clone of that object merged with the supplied arguments.
  107: 
  108: The constructor reads configuration from environment variables via
  109: L<Object::Configure>; for example, setting
  110: C<GEO__CODER__LIST__carp_on_warn=1> causes warnings to use L<Carp>.
  111: 
  112:     use Geo::Coder::List;
  113:     use CHI;
  114: 
  115:     # With an optional L2 cache (any CHI driver works)
  116:     my $geocoder = Geo::Coder::List->new(
  117:         cache => CHI->new(driver => 'Memory', global => 1),
  118:         debug => 0,
  119:     );
  120: 
  121:     # Clone an existing object with a higher debug level
  122:     my $verbose = $geocoder->new(debug => 2);
  123: 
  124: =head3 API SPECIFICATION
  125: 
  126: =head4 INPUT
  127: 
  128:     # Params::Validate::Strict schema
  129:     {
  130:         cache => {
  131:             type     => [ 'hashref', 'object' ],	# OBJECT must implement get($key) and set($key, $value, $ttl)
  132:             optional => 1,
  133:         },
  134:         debug => {
  135:             type     => 'boolean',
  136:             optional => 1,
  137:             default  => 0,
  138:         },
  139:         # Any additional key is forwarded to Object::Configure
  140:     }
  141: 
  142: =head4 OUTPUT
  143: 
  144:     # Return::Set schema
  145:     OBJECT blessed into Geo::Coder::List
  146: 
  147: =cut
  148: 
  149: sub new
  150: {
●151 → 155 → 170●151 → 155 → 0  151: 	my $class = shift;
  152: 	my $params = Params::Get::get_params(undef, \@_) || {};
  153: 
  154: 	# Handle the rare Geo::Coder::List::new() (function-style) invocation
  155: 	if(!defined($class)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  156: 		if(scalar keys %{$params} > 0) {

					

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

  157: 			# Using ::new() with arguments is not supported
  158: 			carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
  159: 			return;
  160: 		}
  161: 		# FIXME: cloning does not work when called as ::new() with arguments
  162: 		$class = __PACKAGE__;
  163: 	} elsif(blessed($class)) {
  164: 		# Shallow clone merged with new params; log is always fresh so the
  165: 		# clone starts with an empty event history independent of the original
  166: 		return bless { %{$class}, %{$params}, log => [] }, ref($class);
  167: 	}
  168: 
  169: 	# Let Object::Configure overlay defaults from environment / config files
●170 → 173 → 179●170 → 173 → 0  170: 	$params = Object::Configure::configure($class, $params);
  171: 
  172: 	# Fill in any %config defaults the caller did not explicitly supply
  173: 	for my $key (keys %config) {
  174: 		$params->{$key} //= $config{$key};
  175: 	}
  176: 
  177: 	# Bless and return; params override scalar defaults but locations/log
  178: 	# are always initialised fresh so callers cannot inject stale state
●[NOT COVERED] 179 → 179 → 0  179: 	return bless {
  180: 		debug     => DEBUG_DEFAULT,
  181: 		geocoders => [],
  182: 		%{$params},
  183: 		locations => {},
  184: 		log       => [],
  185: 	}, $class;
  186: }
  187: 
  188: # =============================================================================
  189: 
  190: =head2 push
  191: 
  192: Appends a geocoder to the chain.  Geocoders are tried in the order they
  193: were pushed.  Returns C<$self> so calls can be chained.
  194: 
  195: A plain geocoder object is tried for every location.  A hashref with
  196: C<regex>, C<geocoder>, and optional C<limit> keys restricts the geocoder to
  197: locations matching the regex and caps total queries at C<limit>.
  198: 
  199:     my $list = Geo::Coder::List->new()
  200:         ->push({ regex => qr/USA$/, geocoder => Geo::Coder::CA->new(), limit => 100 })
  201:         ->push(Geo::Coder::OSM->new());
  202: 
  203: =head3 API SPECIFICATION
  204: 
  205: =head4 INPUT
  206: 
  207:     # Params::Validate::Strict schema
  208:     {
  209:         geocoder => {
  210:             type     => OBJECT | HASHREF,
  211:             required => 1,
  212:             # HASHREF must contain:  geocoder => OBJECT
  213:             # HASHREF may contain:   regex    => Regexp
  214:             #                        limit    => SCALAR (positive integer)
  215:         },
  216:     }
  217: 
  218: =head4 OUTPUT
  219: 
  220:     # Return::Set schema
  221:     OBJECT blessed into Geo::Coder::List   # $self, for chaining
  222: 
  223: =cut
  224: 
  225: sub push
  226: {
  227: 	# Deliberately NOT using Params::Get here: passing the hashref through it
  228: 	# would stringify the compiled qr// object, destroying the regex.
  229: 	my ($self, $geocoder) = @_;
  230: 
  231: 	# A geocoder argument is mandatory
  232: 	croak(__PACKAGE__, '::push: Usage: ($geocoder)') unless defined($geocoder);
  233: 
  234: 	# Append to the ordered chain and return $self for chaining
  235: 	CORE::push @{$self->{geocoders}}, $geocoder;
  236: 
  237: 	return $self;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  238: }
  239: 
  240: # =============================================================================
  241: 
  242: =head2 geocode
  243: 
  244: Resolves a location string to geographic coordinates by trying each geocoder
  245: in turn.  The first successful result is returned and cached.
  246: 
  247: In scalar context returns a single hashref (or C<undef> on failure).
  248: In list context returns all results from the winning geocoder.
  249: 
  250: The C<geocoder> field of the returned hashref holds the geocoder object that
  251: supplied the result; it is set to the string C<'cache'> when the result was
  252: served from cache.
  253: 
  254: See L<Geo::Coder::GooglePlaces::V3> for the canonical result structure.
  255: 
  256:     my $result = $list->geocode(location => 'Paris, France');
  257:     if($result) {
  258:         printf "lat=%.4f lng=%.4f via %s\n",
  259:             $result->{geometry}{location}{lat},
  260:             $result->{geometry}{location}{lng},
  261:             ref($result->{geocoder}) || $result->{geocoder};
  262:     }
  263: 
  264:     # List context returns all candidates from the winning geocoder
  265:     my @results = $list->geocode('London, UK');
  266: 
  267: =head3 API SPECIFICATION
  268: 
  269: =head4 INPUT
  270: 
  271:     # Params::Validate::Strict schema
  272:     {
  273:         location => {
  274:             type     => SCALAR,
  275:             required => 1,
  276:             # Must contain at least one non-digit character
  277:         },
  278:     }
  279: 
  280: =head4 OUTPUT
  281: 
  282:     # Return::Set schema (scalar context)
  283:     HASHREF | undef
  284:     {
  285:         geometry => { location => { lat => Num, lng => Num } },
  286:         geocoder => OBJECT | 'cache',
  287:         lat      => Num,   # convenience alias
  288:         lng      => Num,   # convenience alias
  289:         lon      => Num,   # compatibility alias for lng
  290:         debug    => Int,   # source line of the normalisation branch taken
  291:         # ... provider-specific keys are preserved
  292:     }
  293: 
  294:     # Return::Set schema (list context)
  295:     ARRAY of the above HASHREFs
  296: 
  297: =cut
  298: 
  299: sub geocode {
●300 → 309 → 315●300 → 309 → 0  300: 	my $self = shift;
  301: 
  302: 	# Params::Get enforces 'location'; calling geocode() with no args causes
  303: 	# get_params itself to croak with "Usage:" matching t/carp.t expectations
  304: 	my $params = Params::Get::get_params('location', @_);
  305: 
  306: 	my $location = $params->{'location'};
  307: 
  308: 	# Reject empty or whitespace-only location strings
  309: 	if((!defined($location)) || (length($location) == 0)) {

  Mutants (Total: 2, Killed: 2, Survived: 0)
  310: 		$self->_warn(__PACKAGE__, ' usage: geocode(location => $location)');
  311: 		return;
  312: 	}
  313: 
  314: 	# A purely numeric string is almost certainly an error (e.g. a bare postcode)
●315 → 315 → 320●315 → 315 → 0  315: 	if($params->{'location'} !~ /\D/) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  316: 		$self->_error('Usage: ', __PACKAGE__, ': invalid input to geocode(), ', $params->{location});
  317: 	}
  318: 
  319: 	# Collapse runs of whitespace and expand any HTML entities
●320 → 336 → 390●320 → 336 → 0  320: 	$location =~ s/\s\s+/ /g;
  321: 	$location = decode_entities($location);
  322: 	# Propagate the cleaned-up string so geocoders also receive the decoded form
  323: 	$params->{'location'} = $location;
  324: 
  325: 	print "location: $location\n" if($self->{'debug'});
  326: 
  327: 	# Capture the caller's line number once for all log entries in this call
  328: 	my @call_details = caller(0);
  329: 
  330: 	# ── L1 / L2 cache lookup ──────────────────────────────────────────────
  331: 
  332: 	# _cache() returns undef for both "not in cache" and "cached not-found";
  333: 	# the not-found sentinel is handled internally so callers see undef either way
  334: 	my $cached = $self->_cache($location);
  335: 
  336: 	if(defined $cached) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  337: 		# A defined value means we have a genuine cached positive result
  338: 		my @rc = ref($cached) eq 'ARRAY' ? @{$cached} : ($cached);
  339: 
  340: 		# Mark every element as coming from cache.  Shallow-copy HASH results
  341: 		# first so that neither the L1 cache entry nor any caller-held reference
  342: 		# to the same hashref is mutated in place.
  343: 		for my $r (@rc) {
  344: 			next unless ref($r);
  345: 			$r = { %{$r} } if ref($r) eq 'HASH';
  346: 			$r->{'geocoder'} = $CACHE_SOURCE;
  347: 		}
  348: 
  349: 		# Scalar context: return the first (and usually only) element
  350: 		if(!wantarray) {

					

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

  351: 			my $rc = $rc[0];
  352: 			CORE::push @{$self->{'log'}}, {
  353: 				line      => $call_details[2],
  354: 				location  => $location,
  355: 				timetaken => 0,
  356: 				geocoder  => $CACHE_SOURCE,
  357: 				wantarray => 0,
  358: 				result    => $rc,
  359: 			};
  360: 			print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'});
  361: 			return $rc;

					

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

  362: 		}
  363: 
  364: 		# List context: return all cached candidates
  365: 		CORE::push @{$self->{'log'}}, {
  366: 			line      => $call_details[2],
  367: 			location  => $location,
  368: 			timetaken => 0,
  369: 			geocoder  => $CACHE_SOURCE,
  370: 			wantarray => 1,
  371: 			result    => \@rc,
  372: 		};
  373: 		print __PACKAGE__, ': ', __LINE__, ": cached\n" if($self->{'debug'});
  374: 
  375: 		# Determine if every element is empty; if so return nothing
  376: 		my $allempty = 1;
  377: 		for my $r (@rc) {
  378: 			if(ref($r) eq 'HASH') {

					

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

  379: 				$allempty = 0 if defined $r->{geometry}{location}{lat};
  380: 			} elsif(ref($r) eq 'Geo::Location::Point') {
  381: 				$allempty = 0;
  382: 			}
  383: 		}
  384: 		return if $allempty;
  385: 		return @rc;

					

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

  386: 	}
  387: 
  388: 	# Also check if this location is cached as a definite not-found in L1,
  389: 	# without going through _cache() (which masks the sentinel as undef)
●390 → 390 → 400●390 → 390 → 0  390: 	if(exists $self->{'locations'}{$location}) {

					

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

  391: 		my $stored = $self->{'locations'}{$location};
  392: 		if(ref($stored) && ref($stored) eq _NOT_FOUND_CLASS) {

					

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

  393: 			print "No matches (cached)\n" if($self->{'debug'});
  394: 			return wantarray ? () : undef;

					

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

  395: 		}
  396: 	}
  397: 
  398: 	# ── Try each geocoder in turn ─────────────────────────────────────────
  399: 
●400 → 400 → 756●400 → 400 → 0  400: 	ENCODER: foreach my $g (@{$self->{geocoders}}) {
  401: 		my $geocoder = $g;
  402: 
  403: 		# Unpack a hashref entry and apply regex / limit guards
  404: 		if(ref($geocoder) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  405: 			# Decrement and check the per-geocoder query limit
  406: 			if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {

					

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

  407: 				print "limit: $limit\n" if($self->{'debug'});
  408: 				if($limit <= 0) {

					

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

  409: 					next;
  410: 				}
  411: 				$geocoder->{'limit'}--;
  412: 			}
  413: 
  414: 			# Skip this entry if the location does not match its regex
  415: 			if(my $regex = $geocoder->{'regex'}) {

					

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

  416: 				print 'consider ', ref($geocoder->{geocoder}), ": $regex\n"
  417: 					if($self->{'debug'});
  418: 				if($location !~ $regex) {

					

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

  419: 					next;
  420: 				}
  421: 			}
  422: 
  423: 			# Unwrap the actual geocoder object from the hashref
  424: 			$geocoder = $g->{'geocoder'};
  425: 		}
  426: 
  427: 		# Start timing before the network call
  428: 		my @rc;
  429: 		my $timetaken = Time::HiRes::time();
  430: 
  431: 		eval {
  432: 			# Geo::GeoNames uses a positional argument, not a hash
  433: 			print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
  434: 			if(ref($geocoder) eq 'Geo::GeoNames') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  435: 				print 'username => ', $geocoder->username(), "\n"
  436: 					if($self->{'debug'});
  437: 				die 'lost username' if(!defined($geocoder->username()));
  438: 				@rc = $geocoder->geocode($location);
  439: 			} else {
  440: 				@rc = $geocoder->geocode(%{$params});
  441: 			}
  442: 		};
  443: 
  444: 		if($@) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  445: 			# Log the failure and move on; do not abort the whole chain
  446: 			my $log = {
  447: 				line      => $call_details[2],
  448: 				location  => $location,
  449: 				geocoder  => ref($geocoder),
  450: 				timetaken => Time::HiRes::time() - $timetaken,
  451: 				wantarray => wantarray,
  452: 				error     => $@,
  453: 			};
  454: 			CORE::push @{$self->{'log'}}, $log;
  455: 			$self->_warn(ref($geocoder), " '$location': $@");
  456: 			next ENCODER;
  457: 		}
  458: 
  459: 		$timetaken = Time::HiRes::time() - $timetaken;
  460: 
  461: 		# Geo::Coder::US::Census sometimes returns a truthy but empty result
  462: 		if((ref($geocoder) eq 'Geo::Coder::US::Census') &&

  Mutants (Total: 1, Killed: 1, Survived: 0)
  463: 		   !(defined($rc[0]->{result}{addressMatches}[0]->{coordinates}{y}))) {
  464: 			my $log = {
  465: 				line      => $call_details[2],
  466: 				location  => $location,
  467: 				timetaken => $timetaken,
  468: 				geocoder  => ref($geocoder),
  469: 				wantarray => wantarray,
  470: 				result    => $RESULT_NONE,
  471: 			};
  472: 			CORE::push @{$self->{'log'}}, $log;
  473: 			next ENCODER;
  474: 		}
  475: 
  476: 		# Reject empty result sets and trivially empty hashes / arrays
  477: 		if((scalar(@rc) == 0) ||

  Mutants (Total: 2, Killed: 2, Survived: 0)
  478: 		   ((ref($rc[0]) eq 'HASH')  && (scalar(keys %{$rc[0]}) == 0)) ||

  Mutants (Total: 1, Killed: 1, Survived: 0)
  479: 		   # UNREACHABLE: if $rc[0] is an ARRAY ref, $rc[0][0] may be undef,
  480: 		   # which causes keys(%{undef}) to die under strict refs.  No known
  481: 		   # geocoder returns an ARRAY-of-ARRAYs with an empty-hash sub-element.
  482: 		   # A safe rewrite would guard with: ref($rc[0][0]) eq 'HASH' first.
  483: 		   # ((ref($rc[0]) eq 'ARRAY') && (scalar(keys %{$rc[0][0]}) == 0)) ||
  484: 		   0) {
  485: 			my $log = {
  486: 				line      => $call_details[2],
  487: 				location  => $location,
  488: 				timetaken => $timetaken,
  489: 				geocoder  => ref($geocoder),
  490: 				wantarray => wantarray,
  491: 				result    => $RESULT_NONE,
  492: 			};
  493: 			CORE::push @{$self->{'log'}}, $log;
  494: 			next ENCODER;
  495: 		}
  496: 
  497: 		# ── Normalise each candidate result ──────────────────────────────
  498: 
  499: 		# Track which element was successfully normalised so we return it,
  500: 		# not blindly return $rc[0] when a later element was the good one
  501: 		my $good_result;
  502: 
  503: 		POSSIBLE_LOCATION: foreach my $l (@rc) {
  504: 			# Geo::GeoNames wraps each result in a one-element array
  505: 			if(ref($l) eq 'ARRAY') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  506: 				# FIXME: only the first element of the sub-array is considered
  507: 				$l = $l->[0];
  508: 			}
  509: 
  510: 			# Skip undefined or empty-string candidates
  511: 			if((!defined($l)) || ($l eq '')) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  512: 				my $log = {
  513: 					line      => $call_details[2],
  514: 					location  => $location,
  515: 					timetaken => $timetaken,
  516: 					geocoder  => ref($geocoder),
  517: 					wantarray => wantarray,
  518: 					result    => $RESULT_NONE,
  519: 				};
  520: 				CORE::push @{$self->{'log'}}, $log;
  521: 				next ENCODER;
  522: 			}
  523: 
  524: 			# Skip bare scalars (e.g. integer 0, plain strings) that are
  525: 			# not references; they cannot be hash-dereferenced below
  526: 			next unless ref($l);
  527: 
  528: 			# Stamp the source geocoder on the result before normalisation
  529: 			$l->{'geocoder'} = ref($geocoder);
  530: 
  531: 			print ref($geocoder), ': ',
  532: 				Data::Dumper->new([\$l])->Dump() if($self->{'debug'} >= 2);

					

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

  533: 
  534: 			# Geo::Location::Point objects carry their own accessors;
  535: 			# upgrade the geocoder field and populate the canonical geometry
  536: 			# structure so callers can rely on geometry.location.{lat,lng}
  537: 			if(ref($l) eq 'Geo::Location::Point') {

					

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

  538: 				$l->{'geocoder'} = $geocoder;
  539: 
  540: 				# Populate canonical geometry structure from the GLP's own fields
  541: 				if(!defined($l->{geometry}{location}{lat}) && defined($l->{lat})) {

					

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

  542: 					$l->{geometry}{location}{lat} = $l->{lat};
  543: 					$l->{geometry}{location}{lng} = $l->{lng} // $l->{lon};
  544: 				}
  545: 
  546: 				# Convenience aliases (idempotent if already set by GLP)
  547: 				$l->{'lat'} //= $l->{geometry}{location}{lat};
  548: 				$l->{'lng'} //= $l->{geometry}{location}{lng};
  549: 				$l->{'lon'} //= $l->{geometry}{location}{lng};
  550: 
  551: 				CORE::push @{$self->{'log'}}, {
  552: 					line      => $call_details[2],
  553: 					location  => $location,
  554: 					timetaken => $timetaken,
  555: 					geocoder  => ref($geocoder),
  556: 					wantarray => wantarray,
  557: 					result    => $l,
  558: 				};
  559: 				$good_result = $l;
  560: 				last POSSIBLE_LOCATION;
  561: 			}
  562: 
  563: 			# Only HASH results need normalisation
  564: 			next if(ref($l) ne 'HASH');
  565: 
  566: 			if($l->{'error'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  567: 				# A top-level 'error' key signals a provider-level failure
  568: 				my $log = {
  569: 					line      => $call_details[2],
  570: 					location  => $location,
  571: 					timetaken => $timetaken,
  572: 					geocoder  => ref($geocoder),
  573: 					wantarray => wantarray,
  574: 					error     => $l->{'error'},
  575: 				};
  576: 				CORE::push @{$self->{'log'}}, $log;
  577: 				next ENCODER;
  578: 			} else {
  579: 				# Map provider-specific fields to the canonical geometry structure
  580: 				if(!defined($l->{geometry}{location}{lat})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  581: 					my ($lat, $long);
  582: 
  583: 					if(defined($l->{lat}) && defined($l->{lon})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  584: 						# OSM / RandMcNally: top-level lat/lon fields
  585: 						$lat   = $l->{lat};
  586: 						$long  = $l->{lon};
  587: 						$l->{'debug'} = __LINE__;
  588: 					} elsif($l->{BestLocation}) {
  589: 						# Bing Maps: BestLocation.Coordinates.{Latitude,Longitude}
  590: 						$lat   = $l->{BestLocation}->{Coordinates}->{Latitude};
  591: 						$long  = $l->{BestLocation}->{Coordinates}->{Longitude};
  592: 						$l->{'debug'} = __LINE__;
  593: 					} elsif($l->{point}) {
  594: 						# Bing Maps alternative: point.coordinates[lat, lng]
  595: 						$lat   = $l->{point}->{coordinates}[0];
  596: 						$long  = $l->{point}->{coordinates}[1];
  597: 						$l->{'debug'} = __LINE__;
  598: 					} elsif(defined($l->{latt})) {
  599: 						# geocoder.ca: latt / longt fields
  600: 						$lat   = $l->{latt};
  601: 						$long  = $l->{longt};
  602: 						$l->{'debug'} = __LINE__;
  603: 					} elsif(defined($l->{latitude})) {
  604: 						# postcodes.io, Geo::Coder::Free: latitude / longitude
  605: 						$lat   = $l->{latitude};
  606: 						$long  = $l->{longitude};
  607: 						if(my $type = $l->{'local_type'}) {

					

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

  608: 							# Carry the local_type hint forward as a normalised 'type'
  609: 							$l->{'type'} = lcfirst($type);
  610: 						}
  611: 						$l->{'debug'} = __LINE__;
  612: 					} elsif(defined($l->{'properties'}{'geoLatitude'})) {
  613: 						# HERE / Ovi: properties.geoLatitude / geoLongitude
  614: 						$lat   = $l->{properties}{geoLatitude};
  615: 						$long  = $l->{properties}{geoLongitude};
  616: 						$l->{'debug'} = __LINE__;
  617: 					} elsif($l->{'results'}[0]->{'geometry'}) {
  618: 						if($l->{'results'}[0]->{'geometry'}->{'location'}) {

					

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

  619: 							# DataScienceToolkit mirrors the Google Maps shape
  620: 							$lat   = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lat'};
  621: 							$long  = $l->{'results'}[0]->{'geometry'}->{'location'}->{'lng'};
  622: 							$l->{'debug'} = __LINE__;
  623: 						} else {
  624: 							# OpenCage places lat/lng directly under geometry
  625: 							$lat   = $l->{'results'}[0]->{'geometry'}->{'lat'};
  626: 							$long  = $l->{'results'}[0]->{'geometry'}->{'lng'};
  627: 							$l->{'debug'} = __LINE__;
  628: 						}
  629: 					} elsif($l->{'RESULTS'}) {
  630: 						# GeoCodeFarm: RESULTS[0].COORDINATES.{latitude,longitude}
  631: 						$lat   = $l->{'RESULTS'}[0]{'COORDINATES'}{'latitude'};
  632: 						$long  = $l->{'RESULTS'}[0]{'COORDINATES'}{'longitude'};
  633: 						$l->{'debug'} = __LINE__;
  634: 					} elsif(defined($l->{result}{addressMatches}[0]->{coordinates}{y})) {
  635: 						# US Census Bureau: result.addressMatches[0].coordinates.{y,x}
  636: 						$lat   = $l->{result}{addressMatches}[0]->{coordinates}{y};
  637: 						$long  = $l->{result}{addressMatches}[0]->{coordinates}{x};
  638: 						$l->{'debug'} = __LINE__;
  639: 					} elsif(defined($l->{lat})) {
  640: 						# Geo::GeoNames: lat / lng (reached only after lat+lon check fails)
  641: 						$lat   = $l->{lat};
  642: 						$long  = $l->{lng};
  643: 						$l->{'debug'} = __LINE__;
  644: 					} elsif($l->{features}) {
  645: 						if($l->{features}[0]->{center}) {

					

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

  646: 							# Geo::Coder::Mapbox: center is [lng, lat]
  647: 							$lat   = $l->{features}[0]->{center}[1];
  648: 							$long  = $l->{features}[0]->{center}[0];
  649: 							$l->{'debug'} = __LINE__;
  650: 						} elsif($l->{'features'}[0]{'geometry'}{'coordinates'}) {
  651: 							# Geo::Coder::GeoApify: coordinates is [lng, lat]
  652: 							$lat   = $l->{'features'}[0]{'geometry'}{'coordinates'}[1];
  653: 							$long  = $l->{'features'}[0]{'geometry'}{'coordinates'}[0];
  654: 							$l->{'debug'} = __LINE__;
  655: 						} else {
  656: 							# GeoApify signals not-found via empty features, not an error
  657: 							next ENCODER;
  658: 						}
  659: 					} else {
  660: 						$l->{'debug'} = __LINE__;
  661: 					}
  662: 
  663: 					if(defined($lat) && defined($long)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  664: 						# Populate the canonical geometry structure
  665: 						$l->{geometry}{location}{lat} = $lat;
  666: 						$l->{geometry}{location}{lng} = $long;
  667: 						# Compatibility aliases expected by callers
  668: 						$l->{'lat'} = $lat;
  669: 						$l->{'lon'} = $long;
  670: 					} else {
  671: 						# No coordinates extracted; clean up any partial data
  672: 						delete $l->{'geometry'};
  673: 						delete $l->{'lat'};
  674: 						delete $l->{'lon'};
  675: 					}
  676: 
  677: 					# geocoder.xyz provides a country name under 'standard'
  678: 					if($l->{'standard'}{'countryname'}) {

					

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

  679: 						$l->{'address'}{'country'} = $l->{'standard'}{'countryname'};
  680: 					}
  681: 				}
  682: 
  683: 				if(defined($l->{geometry}{location}{lat})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  684: 					print $l->{geometry}{location}{lat}, '/',
  685: 						$l->{geometry}{location}{lng}, "\n"
  686: 						if($self->{'debug'});
  687: 
  688: 					# Store the geocoder object (not just its name) on the result
  689: 					$l->{geocoder} = $geocoder;
  690: 					$l->{'lat'} //= $l->{geometry}{location}{lat};
  691: 					$l->{'lng'} //= $l->{geometry}{location}{lng};
  692: 					$l->{'lon'} //= $l->{geometry}{location}{lng};
  693: 
  694: 					my $log = {
  695: 						line      => $call_details[2],
  696: 						location  => $location,
  697: 						timetaken => $timetaken,
  698: 						geocoder  => ref($geocoder),
  699: 						wantarray => wantarray,
  700: 						result    => $l,
  701: 					};
  702: 					CORE::push @{$self->{'log'}}, $log;
  703: 
  704: 					# Record which element succeeded, then exit the inner loop
  705: 					$good_result = $l;
  706: 					last POSSIBLE_LOCATION;
  707: 				}
  708: 			}
  709: 		}
  710: 
  711: 		# Only attempt to return / cache if normalisation actually succeeded
  712: 		next ENCODER unless defined $good_result;
  713: 
  714: 		print 'Number of matches from ', ref($geocoder), ': ',
  715: 			scalar(@rc), "\n" if($self->{'debug'});
  716: 
  717: 		if($self->{'debug'} >= 2) {

					

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

  718: 			# Use 'local' to avoid permanently altering the global Maxdepth
  719: 			local $Data::Dumper::Maxdepth = 10;
  720: 			print Data::Dumper->new([\@rc])->Dump();
  721: 		}
  722: 
  723: 		# NOTE (latent unreachable path): if a geocoder returned a list whose
  724: 		# first element is undef (e.g. (undef, {lat=>1,lon=>2})), $good_result
  725: 		# would be set from a later element but defined($rc[0]) is false, so
  726: 		# the block below is skipped and the valid result is silently discarded.
  727: 		# No known geocoder produces a leading undef, making this scenario
  728: 		# unreachable in practice.  A safer guard would be defined($good_result).
  729: 		if(defined($rc[0])) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  730: 			# Normalise the legacy 'long' key some geocoders emit
  731: 			if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lng'})) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  732: 				$rc[0]->{'lng'} = $rc[0]->{'long'};
  733: 			}
  734: 			if(defined($rc[0]->{'long'}) && !defined($rc[0]->{'lon'})) {

					

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

  735: 				$rc[0]->{'lon'} = $rc[0]->{'long'};
  736: 			}
  737: 
  738: 			# Sanity check: the good result must have lat and lng
  739: 			if((!defined($good_result->{lat})) || (!defined($good_result->{lng}))) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  740: 				$self->_warn(Data::Dumper->new([\@rc])->Dump());
  741: 				$self->_error("BUG: '$location': HASH exists but is not sensible");
  742: 			}
  743: 
  744: 			if(wantarray) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  745: 				$self->_cache($location, \@rc);
  746: 				return @rc;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  747: 			}
  748: 
  749: 			$self->_cache($location, $good_result);
  750: 			return $good_result;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  751: 		}
  752: 	}
  753: 
  754: 	# ── No geocoder produced a usable result ──────────────────────────────
  755: 
●756 → 761 → 0  756: 	print "No matches\n" if($self->{'debug'});
  757: 
  758: 	# Cache the not-found result so repeated calls do not hammer all backends
  759: 	$self->_cache($location, undef);
  760: 
  761: 	return wantarray ? () : undef;

					

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

  762: }
  763: 
  764: # =============================================================================
  765: 
  766: =head2 ua
  767: 
  768: Sets the L<LWP::UserAgent> (or compatible) object on every geocoder in the
  769: chain.  Useful when you need proxy support or custom timeouts across all
  770: backends at once.
  771: 
  772: There is intentionally no read accessor since that would be meaningless
  773: (each geocoder could have a different UA).
  774: 
  775:     use LWP::UserAgent;
  776:     my $ua = LWP::UserAgent->new();
  777:     $ua->env_proxy(1);
  778:     $list->ua($ua);
  779: 
  780: =head3 API SPECIFICATION
  781: 
  782: =head4 INPUT
  783: 
  784:     # Params::Validate::Strict schema
  785:     {
  786:         ua => {
  787:             type     => OBJECT,
  788:             optional => 1,
  789:         },
  790:     }
  791: 
  792: =head4 OUTPUT
  793: 
  794:     # Return::Set schema
  795:     OBJECT   # the same $ua that was passed in
  796: 
  797: =cut
  798: 
  799: sub ua
  800: {
●801 → 807 → 831●801 → 807 → 0  801: 	my ($self, $ua) = @_;
  802: 
  803: 	# Nothing to propagate if no UA was supplied
  804: 	return unless $ua;
  805: 
  806: 	# Push the UA into every geocoder in the chain
  807: 	foreach my $g (@{$self->{geocoders}}) {
  808: 		my $geocoder = (ref($g) eq 'HASH') ? $g->{geocoder} : $g;
  809: 		# Guard against a misconfigured entry that has no geocoder object
  810: 		Carp::croak('No geocoder found') unless defined $geocoder;
  811: 
  812: 		# When the incoming UA supports clone(), create a per-geocoder copy
  813: 		# and set the geocoder's own agent string on that copy.
  814: 		# Some APIs (e.g. OSM Nominatim) require a specific User-Agent and
  815: 		# refuse requests that carry the generic libwww-perl default.
  816: 		# The agent string is derived from the geocoder class name and version
  817: 		# (e.g. 'Geo::Coder::OSM/0.03') without reading the geocoder's current
  818: 		# UA, which would trigger any spy or hook installed on its ua() method.
  819: 		if($ua->can('clone') && $ua->can('agent')) {

					

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

  820: 			my $per_ua  = $ua->clone();
  821: 			my $class   = ref($geocoder);
  822: 			my $version = eval { $geocoder->VERSION() } // '';
  823: 			$per_ua->agent($version ? "$class/$version" : $class);
  824: 			$geocoder->ua($per_ua);
  825: 		} else {
  826: 			$geocoder->ua($ua);
  827: 		}
  828: 	}
  829: 
  830: 	# Return the UA so callers can verify what was set (API contract)
●831 → 831 → 0  831: 	return $ua;

					

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

  832: }
  833: 
  834: # =============================================================================
  835: 
  836: =head2 reverse_geocode
  837: 
  838: Converts a latitude/longitude pair into a human-readable address string.
  839: 
  840: In scalar context returns a single address string (or C<undef>).
  841: In list context returns all address strings from the winning geocoder.
  842: 
  843:     my $address = $list->reverse_geocode(latlng => '51.5074,-0.1278');
  844:     print "Address: $address\n" if $address;
  845: 
  846:     my @addresses = $list->reverse_geocode(latlng => '51.5074,-0.1278');
  847: 
  848: =head3 API SPECIFICATION
  849: 
  850: =head4 INPUT
  851: 
  852:     # Params::Validate::Strict schema
  853:     {
  854:         latlng => {
  855:             type    => SCALAR,
  856:             required => 1,
  857:             regex   => qr/^\s*[-+]?(?:\d*\.?\d+|\d+\.?\d*)
  858:                               \s*,\s*
  859:                           [-+]?(?:\d*\.?\d+|\d+\.?\d*)\s*$/x,
  860:         },
  861:     }
  862: 
  863: =head4 OUTPUT
  864: 
  865:     # Return::Set schema (scalar context)
  866:     SCALAR (address string) | undef
  867: 
  868:     # Return::Set schema (list context)
  869:     ARRAY of SCALAR
  870: 
  871: =cut
  872: 
  873: sub reverse_geocode {
●874 → 885 → 889●874 → 885 → 0  874: 	my $self = shift;
  875: 	my $params = Params::Get::get_params('latlng', \@_);
  876: 
  877: 	my $latlng = $params->{'latlng'} or Carp::croak('Usage: reverse_geocode(latlng => $location)');
  878: 
  879: 	# Split into components; populate convenience keys for geocoders that want them
  880: 	my ($latitude, $longitude) = split(/,/, $latlng);
  881: 	$params->{'lat'} //= $latitude;
  882: 	$params->{'lon'} //= $longitude;
  883: 
  884: 	# Check L1 / L2 cache before hitting any backend
  885: 	if(my $rc = $self->_cache($latlng)) {

					

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

  886: 		return $rc;

					

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

  887: 	}
  888: 
●889 → 891 → 1053●889 → 891 → 0  889: 	my @call_details = caller(0);
  890: 
  891: 	foreach my $g (@{$self->{geocoders}}) {
  892: 		my $geocoder = $g;
  893: 
  894: 		# Apply the per-geocoder limit guard for hashref entries
  895: 		if(ref($geocoder) eq 'HASH') {

					

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

  896: 			if(exists($geocoder->{'limit'}) && defined(my $limit = $geocoder->{'limit'})) {

					

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

  897: 				print "limit: $limit\n" if($self->{'debug'});
  898: 				if($limit <= 0) {

					

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

  899: 					next;
  900: 				}
  901: 				$geocoder->{'limit'}--;
  902: 			}
  903: 			$geocoder = $g->{'geocoder'};
  904: 		}
  905: 
  906: 		print 'trying ', ref($geocoder), "\n" if($self->{'debug'});
  907: 
  908: 		if(wantarray) {

					

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

  909: 			# ── List context: collect all address strings from this geocoder ───
  910: 			my @rc;
  911: 			my @locs;
  912: 			eval { @locs = $geocoder->reverse_geocode(%{$params}) };
  913: 
  914: 			# Some geocoders (e.g. Geo::Coder::GeoApify) use strict parameter
  915: 			# validation and reject the 'latlng' key as unknown.  Retry without
  916: 			# it -- lat and lon are already in %params from the split above.
  917: 			# Other geocoders (e.g. Geo::Coder::CA) require 'latlng', so the
  918: 			# first attempt must include it.
  919: 			if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) {

					

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

  920: 				my %no_latlng = %{$params};
  921: 				delete $no_latlng{'latlng'};
  922: 				$@ = '';
  923: 				eval { @locs = $geocoder->reverse_geocode(%no_latlng) };
  924: 			}
  925: 
  926: 			if($@) {

					

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

  927: 				CORE::push @{$self->{'log'}}, {
  928: 					line      => $call_details[2],
  929: 					location  => $latlng,
  930: 					geocoder  => ref($geocoder),
  931: 					timetaken => 0,
  932: 					wantarray => 1,
  933: 					error     => $@,
  934: 				};
  935: 				$self->_warn(ref($geocoder), " '$latlng': $@");
  936: 				next;
  937: 			}
  938: 
  939: 			print Data::Dumper->new([\@locs])->Dump() if($self->{'debug'} >= 2);

					

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

  940: 
  941: 			foreach my $loc (@locs) {
  942: 				if(my $name = $loc->{'display_name'}) {

					

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

  943: 					# OSM returns the full address in display_name
  944: 					CORE::push @rc, $name;
  945: 				} elsif($loc->{'city'}) {
  946: 					# Geo::Coder::CA: build the address from individual fields
  947: 					CORE::push @rc, _build_ca_address($loc);
  948: 				} elsif($loc->{features}) {
  949: 					# GeoApify: formatted string inside a features array
  950: 					CORE::push @rc,
  951: 						$loc->{features}[0]->{properties}{formatted};
  952: 					last;	# only one result from this provider
  953: 				}
  954: 			}
  955: 
  956: 			CORE::push @{$self->{'log'}}, {
  957: 				line      => $call_details[2],
  958: 				location  => $latlng,
  959: 				geocoder  => ref($geocoder),
  960: 				timetaken => 0,
  961: 				wantarray => 1,
  962: 				result    => \@rc,
  963: 			};
  964: 
  965: 			$self->_cache($latlng, \@rc);
  966: 			return @rc;

					

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

  967: 
  968: 		} else {
  969: 			# ── Scalar context: return the first address string ────────────────
  970: 			my $rc = $self->_cache($latlng)
  971: 				// eval { $geocoder->reverse_geocode(%{$params}) };
  972: 
  973: 			# Same strict-validation fallback as the list-context path above
  974: 			if($@ =~ /Unknown parameter.*latlng|latlng.*[Uu]nknown/s) {

					

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

  975: 				my %no_latlng = %{$params};
  976: 				delete $no_latlng{'latlng'};
  977: 				$@ = '';
  978: 				$rc = eval { $geocoder->reverse_geocode(%no_latlng) };
  979: 			}
  980: 
  981: 			if($@) {

					

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

  982: 				CORE::push @{$self->{'log'}}, {
  983: 					line      => $call_details[2],
  984: 					location  => $latlng,
  985: 					geocoder  => ref($geocoder),
  986: 					timetaken => 0,
  987: 					wantarray => 0,
  988: 					error     => $@,
  989: 				};
  990: 				$self->_warn(ref($geocoder), " '$latlng': $@");
  991: 				next;
  992: 			}
  993: 
  994: 			# A bare string needs no further processing
  995: 			next unless defined $rc;
  996: 			if(!ref($rc)) {

					

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

  997: 				CORE::push @{$self->{'log'}}, {
  998: 					line      => $call_details[2],
  999: 					location  => $latlng,
 1000: 					geocoder  => ref($geocoder),
 1001: 					timetaken => 0,
 1002: 					wantarray => 0,
 1003: 					result    => $rc,
 1004: 				};
 1005: 				return $rc;

					

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

 1006: 			}
 1007: 
 1008: 			print Data::Dumper->new([$rc])->Dump() if($self->{'debug'} >= 2);

					

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

 1009: 
 1010: 			if(my $name = $rc->{'display_name'}) {

					

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

 1011: 				# OSM
 1012: 				CORE::push @{$self->{'log'}}, {
 1013: 					line      => $call_details[2],
 1014: 					location  => $latlng,
 1015: 					geocoder  => ref($geocoder),
 1016: 					timetaken => 0,
 1017: 					wantarray => 0,
 1018: 					result    => $name,
 1019: 				};
 1020: 				return $self->_cache($latlng, $name);

					

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

 1021: 			}
 1022: 
 1023: 			if($rc->{'city'}) {

					

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

 1024: 				# Geo::Coder::CA
 1025: 				my $name = _build_ca_address($rc);
 1026: 				CORE::push @{$self->{'log'}}, {
 1027: 					line      => $call_details[2],
 1028: 					location  => $latlng,
 1029: 					geocoder  => ref($geocoder),
 1030: 					timetaken => 0,
 1031: 					wantarray => 0,
 1032: 					result    => $name,
 1033: 				};
 1034: 				return $self->_cache($latlng, $name);

					

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

 1035: 			}
 1036: 
 1037: 			if($rc->{features}) {

					

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

 1038: 				# GeoApify
 1039: 				my $name = $rc->{features}[0]->{properties}{formatted};
 1040: 				CORE::push @{$self->{'log'}}, {
 1041: 					line      => $call_details[2],
 1042: 					location  => $latlng,
 1043: 					geocoder  => ref($geocoder),
 1044: 					timetaken => 0,
 1045: 					wantarray => 0,
 1046: 					result    => $name,
 1047: 				};
 1048: 				return $self->_cache($latlng, $name);

					

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

 1049: 			}
 1050: 		}
 1051: 	}
 1052: 
●1053 → 1053 → 0 1053: 	return;
 1054: }
 1055: 
 1056: # =============================================================================
 1057: 
 1058: =head2 log
 1059: 
 1060: Returns an arrayref of log entries accumulated since the last C<flush()>.
 1061: Each entry is a hashref with the keys: C<line>, C<location>, C<timetaken>,
 1062: C<geocoder>, C<wantarray>, and either C<result> or C<error>.
 1063: 
 1064:     foreach my $entry (@{ $list->log() }) {
 1065:         printf "%s: %.3fs via %s\n",
 1066:             $entry->{location},
 1067:             $entry->{timetaken},
 1068:             $entry->{geocoder};
 1069:     }
 1070: 
 1071: =head3 API SPECIFICATION
 1072: 
 1073: =head4 INPUT
 1074: 
 1075:     # No parameters accepted
 1076: 
 1077: =head4 OUTPUT
 1078: 
 1079:     # Return::Set schema
 1080:     ARRAYREF of HASHREF
 1081:     [
 1082:         {
 1083:             line      => Int,
 1084:             location  => Str,
 1085:             timetaken => Num,
 1086:             geocoder  => Str | 'cache',
 1087:             wantarray => Bool,
 1088:             result    => HASHREF | ARRAYREF | Str,   # on success
 1089:             error     => Str,                        # on failure
 1090:         },
 1091:         ...
 1092:     ]
 1093: 
 1094: =cut
 1095: 
 1096: sub log {
 1097: 	my $self = shift;
 1098: 
 1099: 	# Guard against the state left by flush(); always return a valid arrayref
 1100: 	return $self->{'log'} // [];

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1101: }
 1102: 
 1103: # =============================================================================
 1104: 
 1105: =head2 flush
 1106: 
 1107: Clears all accumulated log entries and returns C<$self> to allow chaining.
 1108: 
 1109:     $list->geocode('Paris, France');
 1110:     my $entries = $list->log();
 1111:     $list->flush()->geocode('London, UK');   # chained
 1112: 
 1113: =head3 API SPECIFICATION
 1114: 
 1115: =head4 INPUT
 1116: 
 1117:     # No parameters accepted
 1118: 
 1119: =head4 OUTPUT
 1120: 
 1121:     # Return::Set schema
 1122:     OBJECT blessed into Geo::Coder::List   # $self, for chaining
 1123: 
 1124: =cut
 1125: 
 1126: sub flush {
 1127: 	my $self = shift;
 1128: 
 1129: 	# Reset to an empty arrayref so log() always returns a valid reference
 1130: 	$self->{'log'} = [];
 1131: 
 1132: 	return $self;

					

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

 1133: }
 1134: 
 1135: # =============================================================================
 1136: # PRIVATE HELPERS
 1137: # =============================================================================
 1138: 
 1139: # _build_ca_address
 1140: #
 1141: # Purpose:    Assemble a printable address string from a Geo::Coder::CA
 1142: #             reverse-geocode response.  The CA response uses different keys
 1143: #             for US addresses (nested under 'usa') vs Canadian ones.
 1144: #
 1145: # Entry:      $loc - HASHREF from Geo::Coder::CA reverse_geocode()
 1146: #
 1147: # Exit:       Returns a plain string, or empty string if nothing was found.
 1148: #
 1149: # Notes:      Street number and name are joined with a space; other parts
 1150: #             (city, province/state, country) are joined with ', '.
 1151: 
 1152: sub _build_ca_address
 1153: {
●1154 → 1157 → 1176●1154 → 1157 → 0 1154: 	my $loc = $_[0];
 1155: 	my $name  = '';
 1156: 
 1157: 	if(my $usa = $loc->{'usa'}) {

					

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

 1158: 		# US address layout inside a CA result
 1159: 		$name  = $usa->{'usstnumber'} // '';
 1160: 		# Street name follows number with a space; if no number, no leading space
 1161: 		$name .= ($name ? ' ' : '') . $usa->{'usstaddress'} if $usa->{'usstaddress'};
 1162: 		# City, state, country each separated by ', '; skip separator if name empty
 1163: 		$name .= ($name ? ', ' : '') . $usa->{'uscity'}     if $usa->{'uscity'};
 1164: 		$name .= ($name ? ', ' : '') . $usa->{'state'}      if $usa->{'state'};
 1165: 		# Country is always appended for the US branch
 1166: 		$name .= ($name ? ', ' : '') . 'USA';
 1167: 	} else {
 1168: 		# Canadian address layout
 1169: 		$name  = $loc->{'stnumber'} // '';
 1170: 		# Street name follows number with a space; if no number, no leading space
 1171: 		$name .= ($name ? ' ' : '') . $loc->{'staddress'}   if $loc->{'staddress'};
 1172: 		$name .= ($name ? ', ' : '') . $loc->{'city'}        if $loc->{'city'};
 1173: 		$name .= ($name ? ', ' : '') . $loc->{'prov'}        if $loc->{'prov'};
 1174: 	}
 1175: 
●1176 → 1176 → 0 1176: 	return $name;

					

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

 1177: }
 1178: 
 1179: # -----------------------------------------------------------------------------
 1180: 
 1181: # _cache
 1182: #
 1183: # Read from or write to the two-level cache.
 1184: #             L1 is an in-process HASH (always active).
 1185: #             L2 is an optional CHI-compatible object or a plain HASH ref.
 1186: #
 1187: # Entry (write): _cache($key, $value)
 1188: #             $value may be undef, which is stored as $NOT_FOUND_SENTINEL so
 1189: #             subsequent reads can distinguish "cached not-found" from "never
 1190: #             looked up".  Detect the write path by testing scalar(@_) before
 1191: #             shifting, not by truthiness of the value.
 1192: #
 1193: # Entry (read):  _cache($key)
 1194: #
 1195: # Exit (write):  Returns $value (undef if the location was not found).
 1196: # Exit (read):   Returns the cached value, or undef if not in cache.
 1197: #             $NOT_FOUND_SENTINEL is never surfaced to callers; undef is
 1198: #             returned in its place so callers handle both cases identically.
 1199: #
 1200: # Side effects: May update $self->{locations} (L1) and $self->{'cache'} (L2).
 1201: #
 1202: # Notes:      Cache TTLs are taken from $self->{cache_*_duration}, which are
 1203: #             initialised from %config and overridable via Object::Configure.
 1204: #             Not-found sentinels are stored only in L1 to avoid leaking
 1205: #             internal implementation details into an external L2 store.
 1206: 
 1207: sub _cache {
●1208 → 1215 → 1318●1208 → 1215 → 0 1208: 	my $self = shift;
 1209: 	my $key  = shift;
 1210: 
 1211: 	# ── Write path ────────────────────────────────────────────────────────
 1212: 	# Detect a write call by the presence of a third argument (even if undef).
 1213: 	# Testing truthiness of the value would silently swallow not-found results.
 1214: 
 1215: 	if(scalar(@_)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1216: 		my $value = shift;
 1217: 
 1218: 		# Store a sentinel for not-found so we can skip backends on repeat calls
 1219: 		my $stored = defined($value) ? $value : $NOT_FOUND_SENTINEL;
 1220: 		$self->{locations}->{$key} = $stored;
 1221: 
 1222: 		my $rc = $value;
 1223: 
 1224: 		if($self->{'cache'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1225: 			my $duration;
 1226: 
 1227: 			if(ref($value) eq 'ARRAY') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1228: 				foreach my $item (@{$value}) {
 1229: 					# Blessed objects (e.g. Geo::Location::Point) may hold
 1230: 					# unserializable handles; stringify their geocoder field too
 1231: 					if(blessed($item) && ref($item->{'geocoder'})) {

					

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

 1232: 						$item->{'geocoder'} = ref($item->{'geocoder'});
 1233: 					}
 1234: 
 1235: 					next unless ref($item) eq 'HASH';
 1236: 
 1237: 					# Serialise the geocoder object to its class name for storage
 1238: 					$item->{'geocoder'} = ref($item->{'geocoder'});
 1239: 
 1240: 					# Strip everything except geometry to keep the L2 entry small
 1241: 					unless($self->{'debug'}) {

					

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

 1242: 						while(my ($k, $v) = each %{$item}) {
 1243: 							delete $item->{$k} unless($k eq 'geometry');
 1244: 						}
 1245: 					}
 1246: 
 1247: 					unless(defined($item->{geometry}{location}{lat})) {

					

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

 1248: 						# Partial or temporary failure: use the shorter TTL.
 1249: 						# UNREACHABLE ARM: the access above auto-vivifies
 1250: 						# $item->{geometry} as {}, so defined($item->{geometry})
 1251: 						# is always true here; the false arm never executes.
 1252: 						# Original ternary preserved for documentation:
 1253: 						# $duration //= defined($item->{geometry})
 1254: 						#     ? $self->{'cache_part_duration'}
 1255: 						#     : $self->{'cache_miss_duration'};
 1256: 						$duration //= $self->{'cache_part_duration'};
 1257: 						$rc = undef;
 1258: 					}
 1259: 				}
 1260: 
 1261: 				# All items were clean: use the full hit duration
 1262: 				$duration //= $self->{'cache_hit_duration'};
 1263: 
 1264: 			} elsif(ref($value) eq 'HASH') {
 1265: 				$value->{'geocoder'} = ref($value->{'geocoder'});
 1266: 
 1267: 				unless($self->{'debug'}) {

					

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

 1268: 					while(my ($k, $v) = each %{$value}) {
 1269: 						delete $value->{$k} unless($k eq 'geometry');
 1270: 					}
 1271: 				}
 1272: 
 1273: 				if(defined($value->{geometry}{location}{lat})) {

					

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

 1274: 					# Confirmed location: cache for a full month
 1275: 					$duration = $self->{'cache_hit_duration'};
 1276: 				} elsif(defined($value->{geometry})) {
 1277: 					# Partial geometry: may be a transient failure, retry soon
 1278: 					$duration = $self->{'cache_part_duration'};
 1279: 					$rc = undef;
 1280: 				}
 1281: 				# UNREACHABLE: the else branch below is dead.  The access
 1282: 				# defined($value->{geometry}{location}{lat}) above auto-vivifies
 1283: 				# $value->{geometry} as {}, so the elsif is always taken when
 1284: 				# the if fails.  Original else preserved for documentation:
 1285: 				# } else {
 1286: 				#     # No geometry at all: place probably does not exist
 1287: 				#     $duration = $self->{'cache_miss_duration'};
 1288: 				#     $rc = undef;
 1289: 				# }
 1290: 			} else {
 1291: 				# Scalar string or a blessed object (e.g. Geo::Location::Point).
 1292: 				# Blessed objects may hold unserializable handles; stringify the
 1293: 				# geocoder field so CHI (Storable) can freeze the value safely.
 1294: 				if(ref($value) && ref($value->{'geocoder'})) {

					

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

 1295: 					$value->{'geocoder'} = ref($value->{'geocoder'});
 1296: 				}
 1297: 				$duration = $self->{'cache_hit_duration'};
 1298: 			}
 1299: 
 1300: 			print Data::Dumper->new([$value])->Dump() if($self->{'debug'});
 1301: 
 1302: 			# Do not push the not-found sentinel into L2
 1303: 			if(!defined($value)) {

					

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

 1304: 				# value is not-found; L1 sentinel is sufficient
 1305: 			} elsif(ref($self->{'cache'}) eq 'HASH') {
 1306: 				$self->{'cache'}->{$key} = $value;
 1307: 			} else {
 1308: 				$self->{'cache'}->set($key, $value, $duration);
 1309: 			}
 1310: 		}
 1311: 
 1312: 		return $rc;

					

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

 1313: 	}
 1314: 
 1315: 	# ── Read path ─────────────────────────────────────────────────────────
 1316: 
 1317: 	# Check L1 first (in-process, no serialisation cost)
●1318 → 1321 → 1329●1318 → 1321 → 0 1318: 	my $rc = $self->{'locations'}->{$key};
 1319: 
 1320: 	# Fall through to L2 only when L1 has no entry for this key
 1321: 	if((!defined($rc)) && $self->{'cache'}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1322: 		if(ref($self->{'cache'}) eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1323: 			$rc = $self->{'cache'}->{$key};
 1324: 		} else {
 1325: 			$rc = $self->{'cache'}->get($key);
 1326: 		}
 1327: 	}
 1328: 
●1329 → 1335 → 1342●1329 → 1335 → 0 1329: 	return unless defined $rc;
 1330: 
 1331: 	# Translate the not-found sentinel back to undef for the caller
 1332: 	return if ref($rc) && (ref($rc) eq _NOT_FOUND_CLASS);
 1333: 
 1334: 	# Restore the convenience aliases that were stripped before L2 storage
 1335: 	if(ref($rc) eq 'HASH') {

					

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

 1336: 		return unless defined($rc->{geometry}{location}{lat});
 1337: 		$rc->{'lat'} //= $rc->{geometry}{location}{lat};
 1338: 		$rc->{'lng'} //= $rc->{geometry}{location}{lng};
 1339: 		$rc->{'lon'} //= $rc->{geometry}{location}{lng};
 1340: 	}
 1341: 
●1342 → 1342 → 0 1342: 	return $rc;

					

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

 1343: }
 1344: 
 1345: # Emit a debug message somewhere
 1346: sub _debug {
●[NOT COVERED] 1347 → 1349 → 1352●[NOT COVERED] 1347 → 1349 → 0 1347: 	my $self = shift;
 1348: 
 1349: 	if(my $logger = $self->{logger}) {

					

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

 1350: 		$logger->debug(@_);
 1351: 	}
●[NOT COVERED] 1352 → 1352 → 0 1352: 	if($self->{debug}) {

					

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

 1353: 		print @_, "\n";
 1354: 	}
 1355: }
 1356: 
 1357: # Emit a warning message somewhere
 1358: sub _warn {
●1359 → 1361 → 0 1359: 	my $self = shift;
 1360: 
 1361: 	if(my $logger = $self->{logger}) {

					

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

 1362: 		$logger->warn(@_);
 1363: 	} else {
 1364: 		Carp::carp(@_);
 1365: 	}
 1366: }
 1367: 
 1368: # Emit an error message somewhere
 1369: sub _error {
●1370 → 1372 → 0 1370: 	my $self = shift;
 1371: 
 1372: 	if(my $logger = $self->{logger}) {

					

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

 1373: 		$logger->error(@_);
 1374: 		die @_;
 1375: 	} else {
 1376: 		Carp::croak(@_);
 1377: 	}
 1378: }
 1379: 
 1380: # =============================================================================
 1381: # DOCUMENTATION
 1382: # =============================================================================
 1383: 
 1384: =head1 AUTHOR
 1385: 
 1386: Nigel Horne, C<< <njh at nigelhorne.com> >>
 1387: 
 1388: =head1 BUGS
 1389: 
 1390: Please report any bugs or feature requests to
 1391: C<bug-geo-coder-list at rt.cpan.org>, or through the web interface at
 1392: L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Geo-Coder-List>.
 1393: 
 1394: Known limitations:
 1395: 
 1396: =over 4
 1397: 
 1398: =item * C<reverse_geocode()> does not yet support L<Geo::Location::Point> objects.
 1399: 
 1400: =item * When C<Geo::GeoNames> returns multiple candidates, only the first
 1401: element of each sub-array is considered.
 1402: 
 1403: =back
 1404: 
 1405: =head1 SEE ALSO
 1406: 
 1407: =over 4
 1408: 
 1409: =item * L<Test Dashboard|https://nigelhorne.github.io/Geo-Coder-List/coverage/>
 1410: 
 1411: =item * L<Geo::Coder::All>
 1412: 
 1413: =item * L<Geo::Coder::GooglePlaces>
 1414: 
 1415: =item * L<Geo::Coder::Many>
 1416: 
 1417: =item * L<Configure an Object at Runtime|Object::Configure>
 1418: 
 1419: =item * L<Readonly>
 1420: 
 1421: =back
 1422: 
 1423: =head1 SUPPORT
 1424: 
 1425: You can find documentation for this module with the perldoc command:
 1426: 
 1427:     perldoc Geo::Coder::List
 1428: 
 1429: =over 4
 1430: 
 1431: =item * RT: CPAN's request tracker
 1432: 
 1433: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Coder-List>
 1434: 
 1435: =item * MetaCPAN
 1436: 
 1437: L<https://metacpan.org/release/Geo-Coder-List>
 1438: 
 1439: =back
 1440: 
 1441: =encoding utf-8
 1442: 
 1443: =head2 FORMAL SPECIFICATION
 1444: 
 1445: =head3 new
 1446: 
 1447:     List_State
 1448:     ──────────────────────────────────────────────────────
 1449:     geocoders : seq (Geocoder | RegexGeocoder)
 1450:     L1        : LocationStr ↛ (GeoResult | NotFound)
 1451:     log       : seq LogEntry
 1452:     debug     : â„•
 1453:     cache?    : L2Cache
 1454: 
 1455:     new
 1456:     ──────────────────────────────────────────────────────
 1457:     List_State
 1458:     params? : ℙ(Key × Value)
 1459:     ──────────────────────────────────────────────────────
 1460:     geocoders = ⟨⟩
 1461:     L1        = ∅
 1462:     log       = ⟨⟩
 1463:     debug     = params?.debug ∣ DEBUG_DEFAULT
 1464:     cache     = params?.cache ∣ ⊥
 1465: 
 1466: =head3 push
 1467: 
 1468:     push
 1469:     ──────────────────────────────────────────────────────
 1470:     ΔList_State
 1471:     g? : Geocoder | RegexGeocoder
 1472:     ──────────────────────────────────────────────────────
 1473:     geocoders' = geocoders ⌢ ⟨g?⟩
 1474:     L1'        = L1
 1475:     log'       = log
 1476:     ──────────────────────────────────────────────────────
 1477:     where RegexGeocoder ::= { regex    : Regex
 1478:                              ; geocoder : Geocoder
 1479:                              ; limit?  : â„• }
 1480: 
 1481: =head3 geocode
 1482: 
 1483:     LocationStr ::= { s : seq Char | s ≠ ⟨⟩ ∧ ∃ c : s • c ∉ Digit }
 1484:     GeoResult   ::= HASHREF with geometry.location.{lat,lng} : ℝ
 1485: 
 1486:     geocode
 1487:     ──────────────────────────────────────────────────────────────────────
 1488:     ΔList_State
 1489:     loc?    : LocationStr
 1490:     result! : GeoResult | ⊥
 1491:     ──────────────────────────────────────────────────────────────────────
 1492:     loc? ∈ dom L1
 1493:       ⟹ result! = L1(loc?)
 1494:          ∧ log' = log ⌢ ⟨{geocoder ↦ cache; timetaken ↦ 0}⟩
 1495: 
 1496:     loc? ∉ dom L1
 1497:       ⟹ (∃ i : 1..#geocoders •
 1498:             applies(geocoders i, loc?)
 1499:             ∧ result! = Normalize(geocoders i . geocode(loc?))
 1500:             ∧ L1' = L1 ⊕ {loc? ↦ result!}
 1501:             ∧ log' = log ⌢ ⟨{geocoder ↦ class(geocoders i)}⟩)
 1502:          ∨ (result! = ⊥ ∧ L1' = L1 ⊕ {loc? ↦ ⊥})
 1503: 
 1504:     applies(g, loc) ≙
 1505:         (g isa Geocoder)
 1506:       ∨ (g isa RegexGeocoder ∧ loc ∈ matches(g.regex) ∧ g.limit > 0)
 1507: 
 1508: =head3 ua SPECIFICATION
 1509: 
 1510:     ua
 1511:     ──────────────────────────────────────────────────────
 1512:     ΞList_State
 1513:     ua?  : UserAgent
 1514:     ua!  : UserAgent
 1515:     ──────────────────────────────────────────────────────
 1516:     ∀ g : ran geocoders • g.ua = ua?
 1517:     ua!  = ua?
 1518: 
 1519: =head3 reverse_geocode
 1520: 
 1521:     LatLngStr ::= { s : seq Char
 1522:                   | s matches /^[-+]?\d+\.?\d*,[-+]?\d+\.?\d*$/ }
 1523: 
 1524:     reverse_geocode
 1525:     ──────────────────────────────────────────────────────────────────────
 1526:     ΔList_State
 1527:     latlng? : LatLngStr
 1528:     result! : seq Char | ⊥
 1529:     ──────────────────────────────────────────────────────────────────────
 1530:     latlng? ∈ dom L1
 1531:       ⟹ result! = L1(latlng?)
 1532: 
 1533:     latlng? ∉ dom L1
 1534:       ⟹ (∃ i : 1..#geocoders •
 1535:             applies(geocoders i, latlng?)
 1536:             ∧ result! = geocoders i . reverse_geocode(latlng?)
 1537:             ∧ L1' = L1 ⊕ {latlng? ↦ result!})
 1538:          ∨ result! = ⊥
 1539: 
 1540: =head3 log
 1541: 
 1542:     log
 1543:     ──────────────────────────────────────────────────────
 1544:     ΞList_State
 1545:     result! : seq LogEntry
 1546:     ──────────────────────────────────────────────────────
 1547:     result! = log
 1548: 
 1549: =head3 flush
 1550: 
 1551:     flush
 1552:     ──────────────────────────────────────────────────────
 1553:     ΔList_State
 1554:     ──────────────────────────────────────────────────────
 1555:     log'       = ⟨⟩
 1556:     geocoders' = geocoders
 1557:     L1'        = L1
 1558: 
 1559: =head1 LICENSE AND COPYRIGHT
 1560: 
 1561: Copyright 2016-2026 Nigel Horne.
 1562: 
 1563: Usage is subject to the GPL2 licence terms.
 1564: If you use it,
 1565: please let me know.
 1566: 
 1567: =cut
 1568: 
 1569: 1;