view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

	returns_ok($l->language(),             { type => 'string' }, 'language() returns a string');
	returns_ok($l->requested_language(),   { type => 'string' }, 'requested_language() returns a string');
	returns_ok($l->language_code_alpha2(), { type => 'string' }, 'language_code_alpha2() returns a string');
};

subtest 'pipeline coherence: en-us produces consistent results across all accessors' => sub {
	local %ENV = (HTTP_ACCEPT_LANGUAGE => $LANG{EN_US});

	my $l = _obj([$LANG{EN_US}]);

	is($l->language(),               'English',        'language()');
	is($l->sublanguage(),            'United States',  'sublanguage()');
	is($l->language_code_alpha2(),   $LANG{EN},        'language_code_alpha2()');
	is($l->sublanguage_code_alpha2(), 'us',            'sublanguage_code_alpha2()');
	like($l->requested_language(),   qr/United States/, 'requested_language() contains United States');
};

subtest 'pipeline coherence: fr produces consistent results across all accessors' => sub {
	local %ENV = (HTTP_ACCEPT_LANGUAGE => $LANG{FR});

	my $l = _obj([$LANG{EN}, $LANG{FR}]);

	is($l->language(),               'French',  'language()');
	is($l->preferred_language(),     'French',  'preferred_language()');
	is($l->name(),                   'French',  'name()');
	ok(!defined $l->sublanguage(),              'sublanguage() undef for plain language');
	is($l->language_code_alpha2(),   $LANG{FR}, 'language_code_alpha2()');
	is($l->code_alpha2(),            $LANG{FR}, 'code_alpha2()');
	ok(!defined $l->sublanguage_code_alpha2(),  'sublanguage_code_alpha2() undef');
	is($l->requested_language(),     'French',  'requested_language() has no parens');
};

subtest 'pipeline coherence: Unknown language has undef codes and undef sublanguage' => sub {
	# When no supported language matches and IP fallback is unavailable,
	# all accessors must return a consistent "nothing matched" picture.
	local %ENV = (HTTP_ACCEPT_LANGUAGE => 'xx', REMOTE_ADDR => $IP{LOOPBACK});

	my $l = _obj([$LANG{EN}]);

	is($l->language(),    'Unknown', 'language() Unknown');
	is($l->requested_language(), 'Unknown', 'requested_language() Unknown');
	ok(!defined $l->language_code_alpha2(),   'language_code_alpha2() undef');
	ok(!defined $l->sublanguage(),            'sublanguage() undef');
	ok(!defined $l->sublanguage_code_alpha2(), 'sublanguage_code_alpha2() undef');
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 2: Multi-language header priority negotiation
#
# Strategy: feed real-world Accept-Language headers containing multiple candidates
# with quality weights.  Vary the supported-languages list to exercise both
# "first match wins" and "sublanguage fallback" paths within a single request.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'priority: de-DE,de;q=0.9,en-US;q=0.8,en;q=0.7 → German when de supported' => sub {
	local %ENV = (
		HTTP_ACCEPT_LANGUAGE => 'de-DE,de;q=0.9,en-US;q=0.8,en;q=0.7',
		# No REMOTE_ADDR — prevent IP-based fallback from interfering
	);
	# Remove locale env vars that I18N::LangTags::Detect might consume
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};

	my $l = _obj([$LANG{DE}, $LANG{EN}]);
	is($l->language(), 'German', 'German selected as highest-priority supported language');
};

subtest 'priority: de-DE,de;q=0.9,en-US;q=0.8,en;q=0.7 → English (United States) when de not supported' => sub {
	local %ENV = (
		HTTP_ACCEPT_LANGUAGE => 'de-DE,de;q=0.9,en-US;q=0.8,en;q=0.7',
	);
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};
	delete local $ENV{REMOTE_ADDR};

	# en-us is supported but not de — module must fall through to en-us
	my $l = _obj([$LANG{EN_US}, $LANG{FR}]);
	is($l->language(),    'English',       'Fell through de to en-us');
	is($l->sublanguage(), 'United States', 'sublanguage() is United States');
};

subtest 'priority: zh-CN,zh;q=0.9,en-US;q=0.8,en;q=0.7 → English (United States) when zh not supported' => sub {
	local %ENV = (
		HTTP_ACCEPT_LANGUAGE => 'zh-CN,zh;q=0.9,en-US;q=0.8,en;q=0.7',
	);
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};
	delete local $ENV{REMOTE_ADDR};

	# Only English variants supported — must fall through zh to en-us
	my $l = _obj([$LANG{EN_US}, $LANG{EN_GB}]);
	is($l->language(),    'English',       'Fell through zh to en-us');
	is($l->sublanguage(), 'United States', 'sublanguage() is United States');
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 3: Stateful method-ordering independence
#
# Strategy: the lazily-populated fields must produce the same result regardless
# of which method is called first.  Call methods in reverse order to prove that
# each accessor's lazy guard is effective and idempotent.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'method ordering: sublanguage() called before language() still resolves' => sub {
	local %ENV = (HTTP_ACCEPT_LANGUAGE => $LANG{EN_GB});

	my $l = _obj([$LANG{EN_GB}]);

	# sublanguage() triggers _find_language() internally before language() is called
	my $sub = $l->sublanguage();
	my $lang = $l->language();

	is($sub,  'United Kingdom', 'sublanguage() correct when called first');
	is($lang, 'English',        'language() correct after sublanguage()');

t/integration.t  view on Meta::CPAN

		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();
};

subtest 'optional: Geo::IPfree resolves country when Geo::IP also absent' => sub {
	# Strategy: inject Geo::IPfree with Geo::IP explicitly absent.
	# Verifies the Geo::IP → Geo::IPfree fallback step.
	local %ENV = (REMOTE_ADDR => $IP{GB});

	my $l = _obj([$LANG{EN}]);
	_inject_geoipfree($l, 'GB');

	is($l->country(), 'gb', 'country() returns gb via Geo::IPfree when Geo::IP absent');

	{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
	_block_network();
};

subtest 'optional: IP::Country absent + geoplugin fails — Whois is attempted' => sub {
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});

	my $l = _obj([$LANG{EN}]);
	$l->{_have_ipcountry} = 0;    # GEO_ABSENT
	$l->{_have_geoip}     = 0;    # GEO_ABSENT
	$l->{_have_geoipfree} = 0;    # GEO_ABSENT

	# Whois call is globally mocked to a no-op; spy on it to verify it fires.
	my $whois_spy = Test::Mockingbird::spy('CGI::Lingua', '_resolve_country_via_whois');

	# LWP returns undef (global mock) — geoplugin fails, so Whois must be tried.
	$l->country();

	my @calls = $whois_spy->();
	ok(scalar @calls > 0,
		'_resolve_country_via_whois attempted when IP::Country and geoplugin both fail');

	{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
	_block_network();
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 10: GEOIP_COUNTRY_CODE coherence across country() and locale()
#
# Strategy: when the mod_geoip environment variable is set, country() and
# locale() must both derive from the same underlying code.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'GEOIP_COUNTRY_CODE: country() and locale() agree on the same country' => sub {
	local %ENV = (GEOIP_COUNTRY_CODE => 'GB');

	my $l = _obj([$LANG{EN}]);

	my $cc = $l->country();
	is($cc, 'gb', 'country() returns gb from GEOIP_COUNTRY_CODE');

	my $loc = $l->locale();
	if(defined $loc) {
		isa_ok($loc, 'Locale::Object::Country',
			'locale() returns Locale::Object::Country');
	} else {
		pass('locale() returned undef (Locale::Object DB may be absent on this system)');
	}
};

subtest 'HTTP_CF_IPCOUNTRY: country() and locale() agree when Cloudflare header set' => sub {
	local %ENV = (HTTP_CF_IPCOUNTRY => 'FR');

	my $l = _obj([$LANG{FR}, $LANG{EN}]);

	is($l->country(), 'fr',
		'country() returns fr from HTTP_CF_IPCOUNTRY');

	my $loc = $l->locale();
	if(defined $loc) {
		isa_ok($loc, 'Locale::Object::Country',
			'locale() returns Locale::Object::Country for FR');
	} else {
		pass('locale() returned undef (Locale::Object DB may be absent)');
	}
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 11: End-to-end session workflow
#
# Strategy: simulate a complete web request lifecycle where language, country,
# locale, and time_zone are all queried in sequence for the same object.
# Verify that each method returns a coherent result and that the object's
# internal state remains consistent after each call.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'full session workflow: language + country + locale coherent with GEOIP_COUNTRY_CODE' => sub {
	local %ENV = (
		GEOIP_COUNTRY_CODE   => 'GB',
		HTTP_ACCEPT_LANGUAGE => $LANG{EN_GB},
	);

	my $l = _obj([$LANG{EN_GB}]);

	my $lang = $l->language();
	my $cc   = $l->country();
	my $loc  = $l->locale();

	is($lang, 'English', 'language() returns English');
	is($cc,   'gb',      'country() returns gb');

	if(defined $loc) {
		isa_ok($loc, 'Locale::Object::Country',
			'locale() returns Locale::Object::Country');
	} else {
		pass('locale() undef (Locale::Object DB absent — acceptable in CI)');
	}

	# Internal state: language and country must both be populated without
	# interfering with each other — they populate different keys.
	is($l->{_slanguage}, 'English', '_slanguage populated');
	is($l->{_country},   'gb',      '_country populated');
};

subtest 'full session workflow: time_zone with cached _timezone skips all network I/O' => sub {
	# If _timezone is already set (from a prior call or thawed cache), the method
	# must return it immediately without any network round-trip.
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});

	my $l = _obj([$LANG{EN}]);
	$l->{_timezone} = 'Europe/London';    # simulate a pre-populated cache entry

	# Spy on LWP to verify it is NOT called
	my $lwp_spy;
	if ($HAS_LWP) {
		local $SIG{__WARN__} = sub {};
		$lwp_spy = Test::Mockingbird::spy('LWP::Simple::WithCache', 'get');
	}

	my $tz = $l->time_zone();

	is($tz, 'Europe/London', 'time_zone() returns cached timezone');

	if($lwp_spy) {
		my @calls = $lwp_spy->();
		is(scalar @calls, 0,
			'LWP not called when timezone already cached');
	} else {
		pass('LWP not installed — skipping spy check');
	}

	{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
	_block_network();
};

subtest 'full session workflow: deprecated en-uk header normalised to en-gb throughout pipeline' => sub {
	# RFC note: some browsers still emit 'en-uk' rather than 'en-gb'.
	# The module normalises this to 'en-gb' and all accessors must reflect that.
	local %ENV = (HTTP_ACCEPT_LANGUAGE => 'en-uk');

	my $l = _obj([$LANG{EN_GB}]);

	is($l->language(),     'English',       'language() normalises en-uk to English');
	# sublanguage may or may not be populated depending on whether _code2countryname
	# resolves 'gb' — just verify no crash occurs.
	my $sub = $l->sublanguage();
	ok(!$@ || 1, 'sublanguage() does not die for en-uk input');

	diag("sublanguage: " . ($sub // 'undef')) if $ENV{TEST_VERBOSE};
};

done_testing();