view release on metacpan or  search on metacpan

t/locales.t  view on Meta::CPAN

		BAIL_OUT('IP::Country::Fast mock is not functioning — GeoIP tests cannot run');
	}
	Test::Mockingbird::restore_all();
	pass('GeoIP mock is operational');
};

# ── Geographic subtests ───────────────────────────────────────────────────

# Country-to-language table used by the geographic tests.
# Each entry: [ ip, mock_cc, accept_lang, supported, expected_language, expected_country ]
my @GEO_CASES = (
	[ '1.2.3.4',   'GB', 'en-gb',  ['en', 'en-gb'], 'English',  'gb' ],
	[ '8.8.8.8',   'US', 'en-us',  ['en', 'en-us'], 'English',  'us' ],
	[ '90.0.0.1',  'FR', 'fr',     ['fr', 'en'],    'French',   'fr' ],
	[ '80.0.0.1',  'DE', 'de',     ['de', 'en'],    'German',   'de' ],
	[ '1.180.0.1', 'CN', 'zh-cn',  ['zh', 'en'],    'Chinese',  'cn' ],
);

my $cache = CHI->new(driver => 'Memory', global => 0);

for my $case (@GEO_CASES) {
	my ($ip, $cc, $lang, $supported, $expected_lang, $expected_country) = @{$case};

	subtest "GeoIP: $cc ($expected_lang)" => sub {
		Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { $cc });

		# Clear LANG so _what_language() doesn't fall through to the system locale
		# path and produce a different language than the HTTP header specifies.
		local %ENV = (
			REMOTE_ADDR          => $ip,
			HTTP_ACCEPT_LANGUAGE => $lang,
		);
		delete $ENV{LANG};

		my $l = CGI::Lingua->new(supported => $supported, cache => $cache);
		is($l->country(), $expected_country, "country() returns '$expected_country' for $cc");
		is($l->language(), $expected_lang,   "language() returns '$expected_lang' for $cc");

		Test::Mockingbird::restore_all();
	};
}

# Case-insensitivity: uppercase Accept-Language should match the same way
subtest 'Case insensitivity — EN-GB' => sub {
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { 'GB' });

	local %ENV = (
		REMOTE_ADDR          => '1.2.3.4',
		HTTP_ACCEPT_LANGUAGE => 'EN-GB',    # uppercase
	);
	delete $ENV{LANG};

	my $l = CGI::Lingua->new(supported => ['en-gb']);
	is($l->sublanguage_code_alpha2(), 'gb', 'Uppercase Accept-Language handled correctly');
	Test::Mockingbird::restore_all();
};

# Concurrent instances must not share state through the cache or globals.
# country() reads $ENV{REMOTE_ADDR} lazily at call time, so we must keep the
# correct REMOTE_ADDR in scope when calling country() on each object.  Both
# objects are kept alive simultaneously (declared in the outer scope) to verify
# true concurrent isolation — neither touches the other's _country field.
subtest 'Concurrent instances do not share state' => sub {
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub {
		my ($self_mock, $ip) = @_;
		return $ip =~ /^8\.8/ ? 'US' : 'FR';
	});

	local %ENV = (HTTP_ACCEPT_LANGUAGE => 'en');

	# Create and immediately resolve each object while its REMOTE_ADDR is live.
	# $us and $fr are declared in the outer scope so both remain alive together.
	my ($us, $us_cc);
	{ local $ENV{REMOTE_ADDR} = '8.8.8.8';
	  $us    = CGI::Lingua->new(supported => ['en', 'fr']);
	  $us_cc = $us->country(); }

	my ($fr, $fr_cc);
	{ local $ENV{REMOTE_ADDR} = '90.0.0.1';
	  $fr    = CGI::Lingua->new(supported => ['en', 'fr']);
	  $fr_cc = $fr->country(); }

	# Both objects are live here — verify they hold independent state.
	is($us_cc,  'us', 'US IP resolves to us');
	is($fr_cc,  'fr', 'FR IP resolves to fr');
	isnt($us_cc, $fr_cc, 'Different IPs resolve to different countries');
	Test::Mockingbird::restore_all();
};

# Cache: a second lookup for the same IP should hit the cache
subtest 'Country result is cached between instances' => sub {
	my $call_count = 0;
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub {
		$call_count++;
		return 'US';
	});

	my $shared_cache = CHI->new(driver => 'Memory', global => 0);

	local %ENV = (
		REMOTE_ADDR          => '4.4.4.4',
		HTTP_ACCEPT_LANGUAGE => 'en',
	);

	my $first  = CGI::Lingua->new(supported => ['en'], cache => $shared_cache);
	$first->country();
	my $first_calls = $call_count;

	# Second instance with the same IP and cache — should not call inet_atocc again
	my $second = CGI::Lingua->new(supported => ['en'], cache => $shared_cache);
	$second->country();

	is($call_count, $first_calls, 'inet_atocc not called again for cached IP');
	Test::Mockingbird::restore_all();
};

# ── POSIX system locale subtests ──────────────────────────────────────────
# Test that CGI::Lingua returns consistent results regardless of LC_ALL.
# We deliberately do NOT use POSIX::strerror() — we source error strings
# directly from Perl's errno layer to avoid C-library divergence.

my @POSIX_LOCALES = (
	'en_US.UTF-8',
	'de_DE.UTF-8',
	'ja_JP.UTF-8',
);

subtest 'POSIX locale independence' => sub {
	for my $locale (@POSIX_LOCALES) {
		subtest "Locale $locale" => sub {
			local $ENV{LC_ALL}   = $locale;
			local $ENV{LANG}     = $locale;