view release on metacpan or  search on metacpan

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).

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);
use Test::Without::Module qw(IP::Country);

use lib 't/lib';

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

# Pre-require lazy-loaded network modules before mocking them.
# A module's BEGIN block runs on first require and would clobber any mock
# installed before that point.  We load both unconditionally so the symbol
# table entries are stable before any mocks are installed.
my $HAS_LWP  = eval { require LWP::Simple::WithCache; 1 } ? 1 : 0;
my $HAS_JSON = eval { require JSON::Parse;             1 } ? 1 : 0;

# ── Shared constants ──────────────────────────────────────────────────────────

Readonly my %LANG => (
	EN    => 'en',
	EN_GB => 'en-gb',
	EN_US => 'en-us',
	FR    => 'fr',
	DE    => 'de',
	ZH    => 'zh',
);

Readonly my %IP => (
	PUBLIC   => '8.8.8.8',
	PRIVATE  => '192.168.1.1',
	LOOPBACK => '127.0.0.1',
	GB       => '1.2.3.4',
	FR       => '90.0.0.1',
	US       => '4.4.4.4',
);

# Canned JSON bodies returned by mocked geoplugin / ip-api calls.
Readonly my $GEO_JSON_US  => '{"geoplugin_countryCode":"US"}';
Readonly my $GEO_JSON_GB  => '{"geoplugin_countryCode":"GB"}';
Readonly my $TZ_JSON_GB   => '{"timezone":"Europe/London"}';
Readonly my $TZ_JSON_US   => '{"timezone":"America/New_York"}';

# ── Global network block ──────────────────────────────────────────────────────
# Installed once at the start; reinstalled after any restore_all() call.
# This ensures no test ever makes a real network round-trip.
_block_network();

# ── Shared helpers ────────────────────────────────────────────────────────────

sub _block_network {
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef })
		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
}

# Simulate "Geo::IP present" — bypasses the lazy-require + db-file guard in
# _load_geoip() by injecting sentinels directly after construction.
sub _inject_geoip {
	my ($l, $cc) = @_;
	eval { require Geo::IP };      # pre-require so mock is not overwritten on first load
	Test::Mockingbird::mock('Geo::IP', 'country_code_by_addr', sub { $cc });
	$l->{_have_ipcountry} = 0;     # GEO_ABSENT
	$l->{_have_geoip}     = 1;     # GEO_PRESENT
	$l->{_geoip}          = bless {}, 'Geo::IP';
	$l->{_have_geoipfree} = 0;     # GEO_ABSENT
}

# Simulate "Geo::IPfree present" — bypasses the lazy-require guard.
sub _inject_geoipfree {
	my ($l, $cc) = @_;
	eval { require Geo::IPfree };  # pre-require so mock is not overwritten on first load
	# LookUp returns a list; the module takes element [0] as the country code.
	Test::Mockingbird::mock('Geo::IPfree', 'LookUp', sub { return ($cc) });
	$l->{_have_ipcountry} = 0;     # GEO_ABSENT
	$l->{_have_geoip}     = 0;     # GEO_ABSENT
	$l->{_have_geoipfree} = 1;     # GEO_PRESENT
	$l->{_geoipfree}      = bless {}, 'Geo::IPfree';
}

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 1: Full detection-pipeline coherence
#
# Strategy: verify that all language-related accessors return a mutually
# consistent picture when constructed from a single Accept-Language header.
# Each subtest creates one object and checks every public method, exercising
# the entire pipeline from header → I18N::AcceptLanguage → language/sub-lang.
# ═══════════════════════════════════════════════════════════════════════════════

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

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

	is($l->language(),              'English',                  'language()');
	is($l->preferred_language(),    'English',                  'preferred_language()');
	is($l->name(),                  'English',                  'name()');
	is($l->sublanguage(),           'United Kingdom',           'sublanguage()');
	is($l->language_code_alpha2(),  $LANG{EN},                  'language_code_alpha2()');
	is($l->code_alpha2(),           $LANG{EN},                  'code_alpha2()');
	is($l->sublanguage_code_alpha2(), 'gb',                     'sublanguage_code_alpha2()');
	like($l->requested_language(),  qr/^English\s+\(United Kingdom\)$/,
		'requested_language() matches "Language (Sublanguage)" format');

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

t/integration.t  view on Meta::CPAN

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 7: Clone workflow
#
# Strategy: verify that cloning (calling new() on an existing object) produces
# an independent object that respects the new supported-languages parameter.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'clone: new supported list is respected and state is independent' => sub {
	local %ENV = (HTTP_ACCEPT_LANGUAGE => $LANG{FR});

	my $orig  = _obj([$LANG{EN}, $LANG{FR}]);
	my $clone = $orig->new(supported => [$LANG{DE}]);

	isa_ok($clone, 'CGI::Lingua', 'Clone is a CGI::Lingua object');
	isnt($orig, $clone, 'Clone is a distinct reference');

	# Clone's supported list is de-only — fr header should yield Unknown
	is($clone->language(), 'Unknown',
		'Clone with de-only supported returns Unknown for fr header');

	# Populating the clone must not affect the original
	is($orig->language(), 'French',
		'Original object unaffected by clone language computation');
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 8: Network call verification via spies
#
# Strategy: use Test::Mockingbird::spy() to intercept calls to external
# resolution routines and verify they are (or are not) invoked depending
# on which faster lookup path succeeds first.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'spy: _resolve_country_via_whois NOT called when IP::Country is present' => sub {
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC}, HTTP_ACCEPT_LANGUAGE => $LANG{EN});

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

	# Spy wraps the existing no-op mock and records every call.
	my $whois_spy = Test::Mockingbird::spy('CGI::Lingua', '_resolve_country_via_whois');

	$l->country();

	my @calls = $whois_spy->();
	is(scalar @calls, 0,
		'_resolve_country_via_whois never called when IP::Country returns a result');

	{ local $SIG{__WARN__} = sub {}; Test::Mockingbird::restore_all() }
	_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.
		my $lwp_spy;
		{ local $SIG{__WARN__} = sub {};
		  $lwp_spy = Test::Mockingbird::spy('LWP::Simple::WithCache', 'get') }

		$l->country();

		my @calls = $lwp_spy->();
		ok(scalar @calls > 0,
			'LWP::Simple::WithCache::get called at least once for geoplugin fallback');

		diag('LWP call args: ' . join(', ', map { $_->[1] // '(undef)' } @calls))
			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();
};

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