lib/Geo/Coder/Free/Utils.pm

        start → end → jump
        

    1: package Geo::Coder::Free::Utils;
    2: 
    3: # VWF is licensed under GPL2.0 for personal use only
    4: # njh@nigelhorne.com
    5: 
    6: =encoding utf-8
    7: 
    8: =head1 NAME
    9: 
   10: Geo::Coder::Free::Utils - Random subroutines for Geo::Coder::Free
   11: 
   12: =head1 DESCRIPTION
   13: 
   14: Utility module for cache management, geospatial calculations, and shared
   15: address-normalization helpers used by multiple backends.
   16: 
   17: =head1 VERSION
   18: 
   19: Version 0.51
   20: 
   21: =cut
   22: 
   23: our $VERSION = '0.51';
   24: 
   25: use v5.20;
   26: use strict;
   27: use warnings;
   28: use feature qw(signatures);
   29: no warnings qw(experimental::signatures);
   30: 
   31: use Exporter qw(import);
   32: our @EXPORT = qw(create_disc_cache create_memory_cache distance _abbreviate _normalize);
   33: our @EXPORT_OK = qw(_abbreviate _normalize);
   34: 
   35: use CHI;
   36: use Geo::Coder::Abbreviations;
   37: use DBI;
   38: use Error::Simple;
   39: use Module::Runtime qw(require_module);	# Safe dynamic loading; avoids string eval
   40: use Params::Get 0.13;
   41: use Try::Tiny;
   42: use Carp qw(croak carp);
   43: use Scalar::Util qw(looks_like_number);
   44: use Math::Trig qw(deg2rad rad2deg asin great_circle_distance);
   45: 
   46: # Constants for distance calculations
   47: use constant {
   48: 	EARTH_RADIUS_MILES => 3959,
   49: 	EARTH_RADIUS_KM => 6371,
   50: 	EARTH_RADIUS_NM => 3440,
   51: 	KM_PER_MILE => 1.609344,
   52: 	NM_PER_MILE => 0.8684
   53: };
   54: 
   55: =head1 SUBROUTINES/METHODS
   56: 
   57: =head2 FORMAL SPECIFICATION
   58: 
   59: 	[STRING, HASH, LOGGER, CHI_CACHE, COORDINATE]
   60: 
   61: 	CacheConfig ::= ⟨⟨ driver : STRING;
   62: 					 servers : seq STRING;
   63: 					 root_dir : STRING;
   64: 					 connect : STRING ⟩⟩
   65: 
   66: 	CacheArgs ::= ⟨⟨ config : HASH;
   67: 					logger : LOGGER;
   68: 					namespace : STRING;
   69: 					root_dir : STRING ⟩⟩
   70: 
   71: 	Point ::= ⟨⟨ latitude : COORDINATE;
   72: 				longitude : COORDINATE ⟩⟩
   73: 	where
   74: 	  latitude ∈ {x : ℝ | -90 ≤ x ≤ 90} ∧
   75: 	  longitude ∈ {x : ℝ | -180 ≤ x ≤ 180}
   76: 
   77: 	Unit ::= K | N | M
   78: 
   79: 	CreateCache : CacheArgs → CHI_CACHE
   80: 
   81: 	∀ args : CacheArgs •
   82: 	  let driver == args.config.driver ∨ default_driver •
   83: 	  validate_driver_config(driver, args.config) ∧
   84: 	  ∃ cache : CHI_CACHE • cache = CHI.new(build_chi_args(driver, args))
   85: 
   86: 	Distance : Point × Point × Unit → ℝ₊
   87: 
   88: 	∀ p1, p2 : Point; u : Unit •
   89: 	  let d == great_circle_distance(p1, p2) •
   90: 	  d ≥ 0 ∧
   91: 	  (u = K ⟹ result = d × 1.609344) ∧
   92: 	  (u = N ⟹ result = d × 0.8684) ∧
   93: 	  (u = M ⟹ result = d)
   94: 
   95: =head2 create_disc_cache
   96: 
   97: Initialize a disc-based cache using the CHI module.
   98: Supports multiple cache drivers, including BerkeleyDB, DBI, and Redis.
   99: 
  100: Parameters:
  101: - config: Configuration hash reference (required)
  102: - logger: Logger object (optional)
  103: - namespace: Cache namespace (optional)
  104: - root_dir: Root directory override (optional)
  105: 
  106: Returns: CHI cache object
  107: 
  108: =cut
  109: 
  110: sub create_disc_cache {
  111: 	my $args = Params::Get::get_params(undef, @_);
  112: 	return _create_cache('disc_cache', $args);
  113: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  114: 
  115: =head2 create_memory_cache
  116: 
  117: Initialize a memory-based cache using the CHI module.
  118: Supports multiple cache drivers, including SharedMem, Memory, and Redis.
  119: 
  120: Parameters:
  121: - config: Configuration hash reference (required)
  122: - logger: Logger object (optional)
  123: - namespace: Cache namespace (optional)
  124: - root_dir: Root directory override (optional)
  125: 
  126: Returns: CHI cache object
  127: 
  128: =cut
  129: 
  130: sub create_memory_cache {
  131: 	my $args = Params::Get::get_params(undef, @_);
  132: 	return _create_cache('memory_cache', $args);
  133: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  134: 
  135: # Private helper functions
  136: 
  137: sub _create_cache($cache_type, $args) {
●138 → 148 → 156  138: 	my $config = $args->{'config'};
  139: 	throw Error::Simple('config is not optional') unless($config);
  140: 
  141: 	_validate_cache_config($config, $cache_type);
  142: 
  143: 	my $logger = $args->{'logger'};
  144: 	my $cache_config = $config->{$cache_type} || {};
  145: 	my $driver = $cache_config->{driver};
  146: 
  147: 	# Set default driver with fallback strategy
  148: 	unless (defined $driver) {
  149: 		$driver = _get_default_driver($cache_type, $logger);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  150: 		if ($logger) {
  151: 			$logger->info("No driver specified for $cache_type, using $driver");

					

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

				
COND_INV_151_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  152: 		}
  153: 	}
  154: 
  155: 	# Validate driver is available
●156 → 156 → 165  156: 	unless (_is_driver_available($driver)) {
  157: 		my $fallback = _get_fallback_driver($cache_type);

					

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

				
COND_INV_157_2: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  158: 		if ($logger) {
  159: 			$logger->warn("Driver $driver not available, falling back to $fallback");
  Mutants (Total: 1, Killed: 1, Survived: 0)
  160: 		}
  161: 		$driver = $fallback;
  162: 	}
  163: 
  164: 	# Build CHI arguments
  165: 	my %chi_args = _build_chi_args($driver, $cache_config, $args, $logger, $cache_type);
  166: 
  167: 	# Create cache with error handling
  168: 	my $cache;
  169: 	try {
  170: 		$cache = CHI->new(%chi_args);
  171: 	} catch {
  172: 		my $error = "Failed to create $cache_type cache with driver $driver: $_";
  173: 		$logger->error($error) if $logger;
  174: 		throw Error::Simple($error);
  175: 	};
  176: 
  177: 	return $cache;
  178: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  179: 
  180: sub _validate_cache_config($config, $cache_type) {
●181 → 188 → 196  181: 	return unless exists $config->{$cache_type};
  182: 
  183: 	my $cache_config = $config->{$cache_type};
  184: 	croak('Cache configuration must be a hash reference')
  185: 		unless ref($cache_config) eq 'HASH';
  186: 
  187: 	# Validate driver if specified
  188: 	if (exists $cache_config->{driver}) {
  189: 		my $driver = $cache_config->{driver};
  Mutants (Total: 1, Killed: 1, Survived: 0)
  190: 		my @valid_drivers = qw(Memory BerkeleyDB DBI Redis Memcached SharedMem File Null);
  191: 		croak "Invalid driver '$driver'. Valid drivers: " . join(', ', @valid_drivers)
  192: 			unless grep { $_ eq $driver } @valid_drivers;
  193: 	}
  194: 
  195: 	# Validate numeric parameters
●196 → 196 → 204  196: 	for my $param (qw(port shm_size max_size)) {
  197: 		next unless exists $cache_config->{$param};
  198: 		my $value = $cache_config->{$param};
  199: 		croak "$param must be a positive integer"
  200: 			unless defined $value && $value =~ /^\d+$/ && $value > 0;
  201: 	}
  Mutants (Total: 3, Killed: 3, Survived: 0)
  202: 
  203: 	# Validate port range
●204 → 204 → 211  204: 	if (exists $cache_config->{port}) {
  205: 		my $port = $cache_config->{port};
  Mutants (Total: 1, Killed: 1, Survived: 0)
  206: 		croak('Port must be between 1 and 65535')
  207: 			unless $port >= 1 && $port <= 65535;
  208: 	}

					

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

				
NUM_BOUNDARY_208_31_<: 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_208_31_>: 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_208_31_>=: 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_208_17_>: 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_208_17_<: 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_208_17_<=: 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' );

								
							
  209: 
  210: 	# Validate memory parameters
●211 → 211 → 0  211: 	if(exists($cache_config->{'datastore'}) && exists($cache_config->{'global'}) && (my $driver = $cache_config->{'driver'})) {
  212: 		# CHI catches this as well, but putting it here helps to track the error
  Mutants (Total: 1, Killed: 1, Survived: 0)
  213: 		croak('Memory cache cannot have both global and datastore');
  214: 	}
  215: }
  216: 
  217: sub _get_default_driver($cache_type, $logger) {
  218: 	# Allow override for testing
  219: 	my $env_var = 'TEST_' . uc($cache_type) . '_DRIVER';
  220: 	return $ENV{$env_var} if $ENV{$env_var};
  221: 

					

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

				
BOOL_NEGATE_221_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_221_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' );

								
							
  222: 	# Production defaults
  223: 	return $cache_type eq 'disc_cache' ? 'BerkeleyDB' : 'Memory';
  224: }

					

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

				
BOOL_NEGATE_224_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_224_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' );

								
							
  225: 
  226: sub _get_fallback_driver($cache_type) {
  227: 	return $cache_type eq 'disc_cache' ? 'File' : 'Memory';
  228: }

					

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

				
BOOL_NEGATE_228_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_228_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' );

								
							
  229: 
  230: sub _is_driver_available($driver) {
●231 → 244 → 252  231: 	return 1 if $driver =~ /^(Memory|Null)$/;
  232: 

					

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

				
BOOL_NEGATE_232_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_232_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' );

								
							
  233: 	my %driver_modules = (
  234: 		'DBI' => 'CHI::Driver::DBI',
  235: 		'BerkeleyDB' => 'CHI::Driver::BerkeleyDB',
  236: 		'File' => 'CHI::Driver::File',
  237: 		'Memcached' => 'CHI::Driver::Memcached',
  238: 		'SharedMem' => 'CHI::Driver::SharedMem',
  239: 		'Redis' => 'CHI::Driver::Redis'
  240: 	);
  241: 
  242: 	return 1 unless exists $driver_modules{$driver};
  243: 

					

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

				
BOOL_NEGATE_243_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_243_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' );

								
							
  244: 	if($driver_modules{$driver}->can('new')) {
  245: 		return 1;

					

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

				
COND_INV_245_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  246: 	}

					

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

				
BOOL_NEGATE_246_3: 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_246_3: 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' );

								
							
  247: 	# SECURITY - string-eval elimination:
  248: 	#   eval "require $module_name" is a string eval; if $driver ever escaped
  249: 	#   the hash-key whitelist (e.g. through a future regression in the caller),
  250: 	#   it could execute arbitrary code.  A block eval with require_module() is
  251: 	#   semantically identical but has no string-eval surface.
●252 → 253 → 256  252: 	eval { require_module($driver_modules{$driver}) };
  253: 	if($@) {
  254: 		return 0;

					

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

				
COND_INV_254_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  255: 	}

					

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

				
BOOL_NEGATE_255_3: 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_255_3: 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' );

								
							
  256: 	$driver_modules{$driver}->import();
  257: 	return 1;
  258: }

					

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

				
BOOL_NEGATE_258_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_258_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' );

								
							
  259: 
  260: sub _build_chi_args($driver, $cache_config, $args, $logger, $cache_type) {
●261 → 267 → 276  261: 	my %chi_args = (
  262: 		driver => $driver,
  263: 		namespace => $args->{'namespace'} || 'default'
  264: 	);
  265: 
  266: 	# Configure error handling
  267: 	if ($logger && $logger->can('error')) {
  268: 		$chi_args{on_get_error} = sub { $logger->warn("Cache get error: $_[0]") };

					

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

				
COND_INV_268_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  269: 		$chi_args{on_set_error} = sub { $logger->error("Cache set error: $_[0]") };
  270: 	} else {
  271: 		$chi_args{on_get_error} = 'warn';
  272: 		$chi_args{on_set_error} = 'die';
  273: 	}
  274: 
  275: 	# Driver-specific configuration
●276 → 276 → 290  276: 	if ($driver eq 'Redis') {
  277: 		_configure_redis(\%chi_args, $cache_config, $args, $logger);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  278: 	} elsif ($driver eq 'DBI') {
  279: 		_configure_dbi(\%chi_args, $cache_config, $args, $logger);
  280: 	} elsif ($driver eq 'SharedMem') {
  281: 		_configure_shared_memory(\%chi_args, $cache_config, $args);
  282: 	} elsif ($driver eq 'Memory') {
  283: 		_configure_memory(\%chi_args, $cache_config);
  284: 	} elsif ($driver eq 'Memcached') {
  285: 		_configure_memcached(\%chi_args, $cache_config, $args, $logger);
  286: 	} elsif ($driver !~ /^(Null)$/) {
  287: 		_configure_file_based(\%chi_args, $cache_config, $args);
  288: 	}
  289: 
  290: 	return %chi_args;
  291: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  292: 
  293: sub _configure_redis($chi_args, $config, $args, $logger) {
  294: 	# Parse server configuration
●[NOT COVERED] 295 → 296 → 302  295: 	my @servers = _parse_server_config($config, $logger);
  296: 	if (@servers) {
  297: 		$chi_args->{servers} = \@servers;

					

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

				
COND_INV_297_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  298: 		$chi_args->{server} = $servers[0];	# Primary server
  299: 	}
  300: 
  301: 	# Redis-specific options with sensible defaults
  302: 	$chi_args->{redis_options} = {
  303: 		reconnect => $config->{reconnect} || 60,
  304: 		every => $config->{every} || 1_000_000,
  305: 		encoding => $config->{encoding} || 'utf8',
  306: 		%{$config->{redis_options} || {}}
  307: 	};
  308: }
  309: 
  310: sub _configure_dbi($chi_args, $config, $args, $logger) {
  311: 	my $connect_string = $config->{connect};
  312: 	croak "DBI driver requires 'connect' parameter" unless $connect_string;
  313: 
  314: 	my $dbh;
  315: 	try {
  316: 		$dbh = DBI->connect($connect_string, '', '', {
  317: 			RaiseError => 1,
  318: 			PrintError => 0,
  319: 			AutoCommit => 1
  320: 		});
  321: 	} catch {
  322: 		my $error = "Failed to connect to database: $_";
  323: 		$logger->error($error) if $logger;
  324: 		croak $error;
  325: 	};
  326: 
  327: 	$chi_args->{dbh} = $dbh;
  328: 	$chi_args->{create_table} = $config->{create_table} // 1;
  329: }
  330: 
  331: sub _configure_shared_memory($chi_args, $config, $args) {
  332: 	$chi_args->{shm_key} = $args->{'shm_key'} || $config->{shm_key}
  333: 		|| croak "SharedMem driver requires 'shm_key' parameter";
  334: 
  335: 	$chi_args->{shm_size} = $args->{'shm_size'} || $config->{shm_size} || 16 * 1024;
  336: 	$chi_args->{max_size} = $args->{'max_size'} || $config->{max_size} || 1024;
  337: }
  338: 
  339: sub _configure_memory($chi_args, $config)
  340: {
●341 → 341 → 0  341: 	if(exists $config->{'global'}) {
  342: 		$chi_args->{'global'} = $config->{'global'};

					

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

				
COND_INV_342_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  343: 	} else {
  344: 		$chi_args->{'datastore'} = {};
  345: 	}
  346: }
  347: 
  348: sub _configure_memcached($chi_args, $config, $args, $logger) {
●[NOT COVERED] 349 → 350 → 0  349: 	my @servers = _parse_server_config($config, $logger);
  350: 	if (@servers) {
  351: 		$chi_args->{servers} = \@servers;

					

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

				
COND_INV_351_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  352: 	} else {
  353: 		# Default to localhost
  354: 		$chi_args->{servers} = ['127.0.0.1:11211'];
  355: 		$logger->debug('Using default Memcached server: 127.0.0.1:11211') if $logger;
  356: 	}
  357: }
  358: 
  359: sub _configure_file_based($chi_args, $config, $args) {
  360: 	my $root_dir = $ENV{'root_dir'} || $args->{'root_dir'} || $config->{root_dir} || $args->{'config'}->{root_dir};
  361: 
  362: 	croak "File-based cache drivers require 'root_dir' parameter" unless $root_dir;
  363: 	croak "Root directory '$root_dir' does not exist or is not writable"
  364: 		unless -d $root_dir && -w $root_dir;
  365: 
  366: 	$chi_args->{root_dir} = $root_dir;
  367: }
  368: 
  369: sub _parse_server_config($config, $logger) {
  370: 	# Handle host/server naming inconsistency
●[NOT COVERED] 371 → 375 → 395  371: 	my $server_config = $config->{server} || $config->{host};
  372: 	return () unless $server_config;
  373: 
  374: 	my @servers;
  375: 	for my $server_entry (split /,/, $server_config) {
  376: 		$server_entry =~ s/^\s+|\s+$//g;	# trim whitespace
  377: 
  378: 		# If no port specified, add default port
  379: 		unless ($server_entry =~ /:/) {
  380: 			my $port = $config->{port} || croak "Port not specified for server '$server_entry'";

					

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

				
COND_INV_380_3: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  381: 			$server_entry .= ":$port";
  382: 		}
  383: 
  384: 		# Validate server format
  385: 		if ($server_entry =~ /^([a-zA-Z0-9.-]+):(\d+)$/) {
  386: 			my ($host, $port) = ($1, $2);

					

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

				
COND_INV_386_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  387: 			croak "Invalid port number: $port" unless $port > 0 && $port <= 65535;
  388: 			push @servers, $server_entry;

					

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

				
NUM_BOUNDARY_388_52_<: 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_388_52_>=: 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_388_52_<=: 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_388_65_<: 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_388_65_>: 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_388_65_>=: 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' );

								
							
  389: 			$logger->debug("Added server: $server_entry") if $logger;
  390: 		} else {
  391: 			croak "Invalid server format: '$server_entry' (expected host:port)";
  392: 		}
  393: 	}
  394: 
  395: 	return @servers;
  396: }

					

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

				
BOOL_NEGATE_396_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_396_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' );

								
							
  397: 
  398: =head2 distance
  399: 
  400: Calculate the great circle distance between two points on Earth using the Haversine formula.
  401: More accurate than the original implementation, especially for short distances.
  402: 
  403: Parameters:
  404: - lat1, lon1: Latitude and longitude of first point (decimal degrees)
  405: - lat2, lon2: Latitude and longitude of second point (decimal degrees)
  406: - unit: 'K' for kilometers, 'N' for nautical miles, 'M' or undef for statute miles
  407: 
  408: Returns: Distance in specified units
  409: 
  410: Throws: Error on invalid input parameters
  411: 
  412: =cut
  413: 
  414: sub distance($lat1, $lon1, $lat2, $lon2, $unit = 'M') {
  415: 	# Input validation
●416 → 416 → 423  416: 	for my $coord_ref ([\$lat1, 'lat1'], [\$lon1, 'lon1'], [\$lat2, 'lat2'], [\$lon2, 'lon2']) {
  417: 		my ($coord, $name) = @$coord_ref;
  418: 		croak "$name must be defined" unless defined $$coord;
  419: 		croak "$name must be numeric" unless looks_like_number($$coord);
  420: 	}
  421: 
  422: 	# Range validation
  423: 	croak('Latitude must be between -90 and 90 degrees')
  424: 		if abs($lat1) > 90 || abs($lat2) > 90;
  425: 	croak('Longitude must be between -180 and 180 degrees')
  Mutants (Total: 3, Killed: 3, Survived: 0)
  426: 		if abs($lon1) > 180 || abs($lon2) > 180;
  427: 
  Mutants (Total: 3, Killed: 3, Survived: 0)
  428: 	# Handle identical points
  429: 	return 0 if $lat1 == $lat2 && $lon1 == $lon2;
  430: 
  Mutants (Total: 3, Killed: 3, Survived: 0)
  431: 	# Validate unit
  432: 	$unit = uc($unit || 'M');
  433: 	croak "Unknown unit '$unit'. Use 'K', 'N', or 'M'"
  434: 		unless $unit =~ /^[KNM]$/;
  435: 
  436: 	# Use optimized calculation with appropriate radius
  437: 	my $radius = $unit eq 'K' ? EARTH_RADIUS_KM :
  438: 				 $unit eq 'N' ? EARTH_RADIUS_NM :
  439: 				 EARTH_RADIUS_MILES;
  440: 
  441: 	# Haversine formula
  442: 	my $dlat = deg2rad($lat2 - $lat1);
  443: 	my $dlon = deg2rad($lon2 - $lon1);
  444: 	my $a = sin($dlat/2)**2 + cos(deg2rad($lat1)) * cos(deg2rad($lat2)) * sin($dlon/2)**2;
  445: 	my $c = 2 * asin(sqrt($a));
  446: 
  447: 	return $radius * $c;
  448: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  449: 
  450: # Singleton shared across all callers; lazy-initialised on first use.
  451: my $abbreviations;
  452: 
  453: =head2 _normalize
  454: 
  455: Normalise a street name to its abbreviated canonical form.  Uppercases the
  456: input, then abbreviates the second-to-last or last word (whichever is a
  457: recognised street type) using C<Geo::Coder::Abbreviations>.  Leading zeros
  458: are also stripped (C<"04th St"> -> C<"4th St">).
  459: 
  460: Exported so that C<Local.pm> and C<OpenAddresses.pm> can call it without
  461: importing C<Geo::Coder::Free>.
  462: 
  463: =cut
  464: 
  465: sub _normalize {
●466 → 470 → 483  466: 	my $street = uc(shift);
  467: 	$abbreviations ||= Geo::Coder::Abbreviations->new();
  468: 
  469: 	my @words = split /\s+/, $street;
  470: 	if (@words >= 3) {
  471: 		my $a;
  Mutants (Total: 4, Killed: 4, Survived: 0)
  472: 		if (lc($words[-2]) ne 'cross' && ($a = $abbreviations->abbreviate($words[-2]))) {
  473: 			$words[-2] = $a;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  474: 		} elsif ($a = $abbreviations->abbreviate($words[-1])) {
  475: 			$words[-1] = $a;
  476: 		}
  477: 		$street = join ' ', @words;
  478: 	} elsif (@words == 2) {
  479: 		if (my $a = $abbreviations->abbreviate($words[-1])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  480: 			$street = "$words[0] $a";
  Mutants (Total: 1, Killed: 1, Survived: 0)
  481: 		}
  482: 	}
  483: 	$street =~ s/^0+//;
  484: 	return $street;
  485: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  486: 
  487: =head2 _abbreviate
  488: 
  489: Abbreviate a single street-type word (e.g. C<"Street"> -> C<"ST">).  Returns
  490: the original word uppercased if no abbreviation is found.
  491: 
  492: Exported so that C<Local.pm> and C<OpenAddresses.pm> can call it without
  493: importing C<Geo::Coder::Free>.
  494: 
  495: =cut
  496: 
  497: sub _abbreviate {
  498: 	my $type = uc(shift);
  499: 	$abbreviations ||= Geo::Coder::Abbreviations->new();
  500: 	return $abbreviations->abbreviate($type) || $type;
  501: }
  Mutants (Total: 2, Killed: 2, Survived: 0)
  502: 
  503: 
  504: 1;
  505: 
  506: __END__
  507: 
  508: =head1 AUTHOR
  509: 
  510: Nigel Horne, C<< <njh at nigelhorne.com> >>
  511: 
  512: =head1 BUGS
  513: 
  514: Please report any bugs or feature requests to the author.
  515: 
  516: =head1 SUPPORT
  517: 
  518: You can find documentation for this module with the perldoc command.
  519: 
  520:     perldoc Geo::Coder::Free::Utils
  521: 
  522: =head1 LICENSE AND COPYRIGHT
  523: 
  524: Geo::Coder::Free is licensed under GPL2.0 for personal use only.
  525: Commercial users must apply in writing for a licence.
  526: 
  527: =head1 SEE ALSO
  528: 
  529: L<CHI>, L<Math::Trig>, L<DBI>
  530: 
  531: =cut