view release on metacpan or  search on metacpan

t/mutant_killers.t  view on Meta::CPAN

#!/usr/bin/env perl

# t/mutant_killers.t -- Tests designed to kill mutants from xt/mutant_20260612_175829.t.
#
# Strategy: each subtest names the mutant(s) it kills in brackets and asserts the
# observable behavioural difference between the original code and the mutation.
# All network I/O is blocked globally; narrow mocks are installed per subtest.

use strict;
use warnings;

use CHI;
use Readonly;
use Scalar::Util qw(blessed);
use Test::Most;
use Test::Mockingbird;

use lib 't/lib';

BEGIN { use_ok('CGI::Lingua') }

# Pre-require every lazily-loaded module so mocks installed before their
# first use are not clobbered by a subsequent BEGIN block on require.
my $HAS_LWP_CACHE = eval { require LWP::Simple::WithCache; 1 } ? 1 : 0;
my $HAS_LWP       = eval { require LWP::Simple;             1 } ? 1 : 0;
my $HAS_JSON      = eval { require JSON::Parse;             1 } ? 1 : 0;
my $HAS_WHOIS_IP  = eval { require Net::Whois::IP;          1 } ? 1 : 0;
my $HAS_WHOIS_IANA= eval { require Net::Whois::IANA;        1 } ? 1 : 0;
my $HAS_IPCOUNTRY = eval { require IP::Country;             1 } ? 1 : 0;
my $HAS_GEOIP     = eval { require Geo::IP;                 1 } ? 1 : 0;
my $HAS_BROWSER   = eval { require HTTP::BrowserDetect;     1 } ? 1 : 0;

# ── Constants ──────────────────────────────────────────────────────────────────

Readonly my $IP_PUBLIC   => '8.8.8.8';
Readonly my $IP_PRIVATE  => '192.168.1.1';
Readonly my $IP_LOOPBACK => '127.0.0.1';
Readonly my $IP_V6_LOOP  => '::1';
Readonly my $IP_BAIDU    => '185.10.104.1';

Readonly my $CACHE_NS  => 'CGI::Lingua:';
Readonly my $GEO_UNKNOWN => -1;
Readonly my $GEO_ABSENT  =>  0;
Readonly my $GEO_PRESENT =>  1;

Readonly my $LANG_EN    => 'en';
Readonly my $LANG_EN_GB => 'en-gb';
Readonly my $LANG_EN_US => 'en-us';
Readonly my $LANG_FR    => 'fr';
Readonly my $LANG_DE    => 'de';

# ── Helpers ───────────────────────────────────────────────────────────────────

sub _block_network {
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	if($HAS_LWP_CACHE) {
		local $SIG{__WARN__} = sub {};
		Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
	}
}

sub _obj {
	my ($supported, %extra) = @_;
	CGI::Lingua->new(supported => $supported, %extra);
}

sub _fresh_cache { CHI->new(driver => 'Memory', global => 0) }