view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	$l->{_ipcountry}      = bless {}, 'IP::Country::Fast';
	$l->{_have_geoip}     = 0;
	$l->{_have_geoipfree} = 0;
	$l->country();
	is($cache->get('CGI::Lingua:country:' . $IP{PUBLIC}), $CC{GB},
		'Country stored in cache under documented key pattern');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'country: HK remapped to CN (legacy Whois behaviour)' => sub {
	# Legacy mapping documented in code: HK is no longer separate in Whois
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { 'HK' });
	my $l = _obj([$LANG{EN}]);
	$l->{_have_ipcountry} = 1;
	$l->{_ipcountry}      = bless {}, 'IP::Country::Fast';
	$l->{_have_geoip}     = 0;
	$l->{_have_geoipfree} = 0;
	is($l->country(), $CC{CN}, 'HK remapped to CN');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'country: cached value returned on second call without re-lookup' => sub {
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
	my $call_count = 0;
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc',
		sub { $call_count++; 'US' });
	my $l = _obj([$LANG{EN}]);
	$l->{_have_ipcountry} = 1;
	$l->{_ipcountry}      = bless {}, 'IP::Country::Fast';
	$l->{_have_geoip}     = 0;
	$l->{_have_geoipfree} = 0;
	$l->country();    # first call
	my $c1 = $call_count;
	$l->country();    # second call — must use object-level cache
	is($call_count, $c1, 'inet_atocc not called again on second country() call');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'country: HTTP_CF_IPCOUNTRY invalid format warns and falls through' => sub {
	# POD message: "HTTP_CF_IPCOUNTRY contains an invalid country code; ignoring"
	local %ENV = (HTTP_CF_IPCOUNTRY => 'INVALID', REMOTE_ADDR => $IP{LOOPBACK});
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	$l->country();
	ok((grep { ref($_) ? $_->{warning} =~ /invalid/ : /invalid/ } @warnings),
		'_warn called for invalid HTTP_CF_IPCOUNTRY');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

# ── locale() ─────────────────────────────────────────────────────────────────
# POD: Returns a Locale::Object::Country object, or undef.

subtest 'locale: returns Locale::Object::Country for well-known country code' => sub {
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { 'GB' });
	my $l = _obj([$LANG{EN}]);
	$l->{_have_ipcountry} = 1;
	$l->{_ipcountry}      = bless {}, 'IP::Country::Fast';
	$l->{_have_geoip}     = 0;
	$l->{_have_geoipfree} = 0;
	my $locale = $l->locale();
	if(defined $locale) {
		isa_ok($locale, 'Locale::Object::Country',
			'locale() returns Locale::Object::Country');
	} else {
		# Locale::Object::Country DB may not be installed; skip gracefully
		pass('locale() returned undef (Locale::Object may not be installed)');
	}
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'locale: returns undef when no country can be determined' => sub {
	local %ENV = (REMOTE_ADDR => $IP{LOOPBACK});
	my $l = _obj([$LANG{EN}]);
	my $result = $l->locale();
	ok(!defined $result, 'locale() returns undef when country unresolvable');
};

subtest 'locale: GEOIP_COUNTRY_CODE valid code used as fallback' => sub {
	# POD describes GEOIP_COUNTRY_CODE as a fallback source for locale()
	local %ENV = (GEOIP_COUNTRY_CODE => 'GB', REMOTE_ADDR => $IP{LOOPBACK});
	my $l = _obj([$LANG{EN}]);
	my $result = $l->locale();
	if(defined $result) {
		isa_ok($result, 'Locale::Object::Country',
			'locale() used GEOIP_COUNTRY_CODE fallback');
	} else {
		pass('locale() gracefully undef (Locale::Object DB may be absent)');
	}
};

subtest 'locale: GEOIP_COUNTRY_CODE invalid code not used' => sub {
	# Same ISO 3166-1 validation as country() — invalid codes must be skipped.
	local %ENV = (GEOIP_COUNTRY_CODE => 'NOT_A_CC');
	my $called = 0;
	Test::Mockingbird::mock('CGI::Lingua', '_code2country',
		sub { $called++; undef });
	my $l = _obj([$LANG{EN}]);
	$l->locale();
	is($called, 0, 'Invalid GEOIP_COUNTRY_CODE not passed to _code2country');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'locale: cached _locale returned immediately on second call' => sub {
	# locale() must not re-run detection once it has a result.
	local %ENV = ();
	my $sentinel = bless {}, 'Locale::Object::Country';
	my $l = _obj([$LANG{EN}]);
	$l->{_locale} = $sentinel;
	is($l->locale(), $sentinel, 'Cached _locale returned without re-computation');
};

# ── time_zone() ───────────────────────────────────────────────────────────────
# POD: Returns IANA timezone name string, or undef.

subtest 'time_zone: cached value returned immediately on second call' => sub {
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
	my $l = _obj([$LANG{EN}]);
	$l->{_timezone} = 'America/New_York';
	is($l->time_zone(), 'America/New_York', 'Cached _timezone returned');
};

subtest 'time_zone: malformed REMOTE_ADDR warns and returns undef' => sub {
	# The untaint check in time_zone() mirrors country() — bad IP must warn.
	local %ENV = (REMOTE_ADDR => 'bad-addr');
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	my $result = $l->time_zone();
	ok(!defined $result, 'Malformed REMOTE_ADDR causes undef return from time_zone');
	ok((grep { ref($_) ? $_->{warning} =~ /valid IP/ : /valid IP/ } @warnings),
		'_warn called for bad REMOTE_ADDR in time_zone()');
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

subtest 'time_zone: ip-api JSON response parsed into timezone string' => sub {
	# POD: "otherwise it will use ip-api.com"
	# Pre-require the module so it is fully initialised before we install the
	# mock; otherwise the module's BEGIN block clobbers the mock on first load.
	eval { require LWP::Simple::WithCache; require JSON::Parse };
	if($@) {
		pass('LWP::Simple::WithCache or JSON::Parse not installed; skipping');
		return;
	}
	local %ENV = (REMOTE_ADDR => $IP{PUBLIC});
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get',
		sub { '{"timezone":"Europe/London"}' });
	my $l = _obj([$LANG{EN}]);
	$l->{_have_geoip} = 0;    # GEO_ABSENT — force the ip-api.com branch
	my $tz = $l->time_zone();
	if(defined $tz) {
		returns_ok($tz, { type => 'string' }, 'time_zone() returns a string');
		is($tz, 'Europe/London', 'Timezone parsed from ip-api.com JSON');
	} else {
		pass('time_zone() returned undef (unexpected, but not fatal in offline mode)');
	}
	Test::Mockingbird::restore_all();
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef });
};

# ── Cross-method integration ──────────────────────────────────────────────────
# These subtests exercise the documented relationship between methods (e.g.
# language() + sublanguage() should give a coherent picture) without diving
# into implementation specifics.

subtest 'integration: language + sublanguage coherent for en-gb' => sub {