CGI-Lingua
view release on metacpan or search on metacpan
t/data-flow.t view on Meta::CPAN
#!/usr/bin/env perl
# t/data-flow.t -- CGI::Lingua data-flow tests.
#
# Validates Define-Use (DU) chains, resource lifecycles, and global-variable
# non-pollution throughout the module. Each section identifies which variable
# or resource is under test, the DU anomaly class being hunted (D~, DD, ~U,
# O~) and the specific invariant being asserted.
#
# Network I/O is blocked globally; individual subtests install narrow mocks
# as needed and call _block_network() immediately after restore_all().
use strict;
use warnings;
use CHI;
use JSON::PP ();
use Readonly;
use Scalar::Util qw(blessed);
use Test::Most;
t/edge_cases.t view on Meta::CPAN
# âââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
# SECTION 3: REMOTE_ADDR injection and boundary conditions
#
# Strategy: probe the IP-validation regex
# IPv4: /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/a
# IPv6: /^([0-9a-fA-F:]{2,39})$/a
# and the subsequent Data::Validate::IP checks.
# âââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
subtest 'REMOTE_ADDR: command injection rejected before any geo lookup' => sub {
# The semicolon is not in either IP regex, so this is blocked at the
# untaint step â no geo module or shell is ever called.
local %ENV = (REMOTE_ADDR => '8.8.8.8;rm -rf /');
my @warnings;
Test::Mockingbird::mock('CGI::Lingua', '_warn',
sub { push @warnings, $_[1] });
my $l = _obj([$LANG{EN}]);
my $cc = $l->country();
ok(!defined $cc, 'Command-injection REMOTE_ADDR returns undef');
ok((grep { ref($_) ? $_->{warning} =~ /valid IP/i : /valid IP/i } @warnings),
'_warn fired for injection attempt in REMOTE_ADDR');
t/edge_cases.t view on Meta::CPAN
};
subtest 'geo: IP::Country returns "eu" â deleted, falls through' => sub {
# The module discards "eu" because it is not a real country code.
local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
my $l = _obj([$LANG{EN}]);
_inject_ipcountry($l, 'EU');
my $cc = $l->country();
# After EU is discarded, fallbacks are all blocked â undef expected.
ok(!defined $cc || ($cc ne 'eu'),
'"eu" from IP::Country is not returned as a country code');
{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
_block_network();
};
subtest 'geo: IP::Country returns "HK" â remapped to "cn"' => sub {
# POD/code comment: "HK is no longer a separate country in Whois"
local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
t/extended_tests.t view on Meta::CPAN
#!/usr/bin/env perl
# t/extended_tests.t â Coverage-gap tests for CGI::Lingua.
#
# Target: execution paths not reached by function.t, unit.t, integration.t,
# or edge_cases.t. Each section names the sub being probed and the specific
# branch being exercised.
#
# Network I/O is blocked globally; individual subtests install narrow mocks.
use strict;
use warnings;
use CHI;
use Readonly;
use Scalar::Util qw(blessed);
use Test::Most;
use Test::Mockingbird;
use Test::Returns qw(returns_ok);
t/integration.t view on Meta::CPAN
#!/usr/bin/env perl
# t/integration.t -- CGI::Lingua end-to-end integration tests.
#
# These subtests focus on stateful workflows and cross-method coherence rather
# than testing individual methods in isolation (which t/unit.t covers).
#
# Network I/O (Whois, geoplugin, ip-api.com) is blocked globally; individual
# subtests install narrowly-scoped mocks for specific responses as needed.
#
# IP::Country is excluded via Test::Without::Module so CGI::Lingua's lazy-
# require guard naturally sets _have_ipcountry = GEO_ABSENT throughout this
# file. Subtests that exercise the "IP::Country present" code path inject the
# sentinel and mock directly after construction, bypassing the guard.
# Geo::IP and Geo::IPfree are NOT globally excluded â Section 9 tests both the
# "present" path (via _inject_geoip / _inject_geoipfree) and the "absent" path
# (by setting the sentinels to GEO_ABSENT explicitly on the object).
t/integration.t view on Meta::CPAN
if $HAS_LWP;
}
sub _obj {
my ($supported, %extra) = @_;
CGI::Lingua->new(supported => $supported, %extra);
}
# Simulate "IP::Country present" for an already-constructed object by injecting
# the sentinel flags and a mock that returns the given country code.
# Because IP::Country is blocked by Test::Without::Module, the lazy-require
# guard always sets _have_ipcountry = GEO_ABSENT; this helper overrides that.
sub _inject_ipcountry {
my ($l, $cc) = @_;
Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { $cc });
$l->{_have_ipcountry} = 1; # GEO_PRESENT
$l->{_ipcountry} = bless {}, 'IP::Country::Fast';
$l->{_have_geoip} = 0; # GEO_ABSENT
$l->{_have_geoipfree} = 0; # GEO_ABSENT
}
t/integration.t view on Meta::CPAN
_block_network();
};
subtest 'spy: LWP::Simple::WithCache::get called when IP::Country is absent (geoplugin fallback)' => sub {
SKIP: {
skip 'LWP::Simple::WithCache or JSON::Parse not installed', 1
unless $HAS_LWP && $HAS_JSON;
local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
# IP::Country is blocked by Test::Without::Module â the sentinel will be
# set to GEO_ABSENT by CGI::Lingua's eval{require} guard.
# Inject GEO_ABSENT explicitly in case an earlier test left the sentinel set.
my $l = _obj([$LANG{EN}]);
$l->{_have_ipcountry} = 0; # GEO_ABSENT
$l->{_have_geoip} = 0; # GEO_ABSENT
$l->{_have_geoipfree} = 0; # GEO_ABSENT
# Spy on the mocked LWP::Simple::WithCache::get (which currently returns undef).
# Suppress the prototype mismatch warning that fires because WithCache
# declares get($) but the spy installs a prototype-free wrapper.
t/integration.t view on Meta::CPAN
if $ENV{TEST_VERBOSE};
{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
_block_network();
}
};
# âââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
# SECTION 9: Optional dependency degradation
#
# IP::Country is blocked file-wide via Test::Without::Module. For Geo::IP and
# Geo::IPfree the sentinel-injection helpers (_inject_geoip, _inject_geoipfree)
# cover the "present" path; explicit GEO_ABSENT injection covers the "absent"
# path. Together these four subtests walk the full fallback chain:
# IP::Country â Geo::IP â Geo::IPfree â geoplugin â Whois
# âââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââââ
subtest 'optional: IP::Country absent â country() falls through to geoplugin JSON' => sub {
SKIP: {
skip 'LWP::Simple::WithCache or JSON::Parse not installed', 1
unless $HAS_LWP && $HAS_JSON;
local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
my $l = _obj([$LANG{EN}]);
$l->{_have_ipcountry} = 0; # GEO_ABSENT (confirmed by blocked module)
$l->{_have_geoip} = 0; # GEO_ABSENT
$l->{_have_geoipfree} = 0; # GEO_ABSENT
# Override the global no-op LWP mock to return a real-looking JSON body.
Test::Mockingbird::mock('LWP::Simple::WithCache', 'get',
sub { $GEO_JSON_US });
my $cc = $l->country();
is($cc, 'us',
'country() returns US from geoplugin JSON when IP::Country is absent');
{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
_block_network();
}
};
subtest 'optional: Geo::IP resolves country when IP::Country absent' => sub {
# Strategy: inject Geo::IP as the active resolver (IP::Country is blocked
# file-wide). Verifies the IP::Country â Geo::IP fallback step.
local %ENV = (REMOTE_ADDR => $IP{US});
my $l = _obj([$LANG{EN}]);
_inject_geoip($l, 'US');
is($l->country(), 'us', 'country() returns us via Geo::IP when IP::Country absent');
{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
_block_network();
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;
( run in 0.643 second using v1.01-cache-2.11-cpan-800906f7e73 )