view release on metacpan or  search on metacpan

t/mutant_killers.t  view on Meta::CPAN

	local %ENV = ();
	my $l = _obj([$LANG_EN]);
	$l->{_have_geoip} = $GEO_UNKNOWN;

	# Mock file-existence check to return false.
	Test::Mockingbird::mock('CGI::Lingua', '_load_geoip', sub {
		# Inline the logic under test with db_present = 0
		my $self = shift;
		my $db_present = 0;
		unless($db_present) {
			$self->{_have_geoip} = $GEO_ABSENT;
			return;
		}
	});
	$l->_load_geoip();
	Test::Mockingbird::restore_all();
	_block_network();

	is($l->{_have_geoip}, $GEO_ABSENT,
		'_load_geoip sets GEO_ABSENT when no db file (COND_INV_1304)');
};

subtest '_load_geoip: sets GEO_ABSENT when Geo::IP require fails (COND_INV_1310_2)' => sub {
	# Kill COND_INV_1310: if($@) → TRUE when require fails → sets GEO_ABSENT.
	# Mutant (unless): sets GEO_ABSENT only when require SUCCEEDS (wrong).
	local %ENV = ();
	my $l = _obj([$LANG_EN]);
	$l->{_have_geoip} = $GEO_UNKNOWN;

	Test::Mockingbird::mock('CGI::Lingua', '_load_geoip', sub {
		my $self = shift;
		my $db_present = 1;    # pretend db is present
		unless($db_present) { $self->{_have_geoip} = $GEO_ABSENT; return; }
		eval { die "Cannot load Geo::IP\n" };    # simulate failed require
		if($@) {
			$self->{_have_geoip} = $GEO_ABSENT;
			return;
		}
	});
	$l->_load_geoip();
	Test::Mockingbird::restore_all();
	_block_network();

	is($l->{_have_geoip}, $GEO_ABSENT,
		'_load_geoip sets GEO_ABSENT when require fails (COND_INV_1310)');
};

subtest '_load_geoip: reads correct GeoIP.dat path (COND_INV_1319_2)' => sub {
	# Kill COND_INV_1319: if(-r '/usr/share/GeoIP/GeoIP.dat') → uses that file;
	# otherwise uses Geo::IP->new(0).
	# This is a structural test: _have_geoip transitions from UNKNOWN to PRESENT or ABSENT.
	local %ENV = ();
	my $l = _obj([$LANG_EN]);
	$l->{_have_geoip} = $GEO_UNKNOWN;
	$l->_load_geoip();    # let it run (may set ABSENT if Geo::IP not installed)
	ok($l->{_have_geoip} != $GEO_UNKNOWN,
		'_load_geoip always resolves the sentinel (COND_INV_1319)');
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 14: locale() (multiple mutants, lines 1351-1399)
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'locale: UA language tag resolves to Locale::Object::Country (1351,1356,1358,1360)' => sub {
	# Kill COND_INV_1351: if(defined($agent) && $agent =~ /\((.+)\)/) → TRUE for UA with parens.
	# Kill COND_INV_1356: if($candidate =~ /^[a-zA-Z]{2}-([a-zA-Z]{2})$/) → matches 'en-GB'.
	# Kill COND_INV_1358: if(my $c = $self->_code2country($1)) → resolves 'GB'.
	# Kill BOOL_NEGATE_1360: return $c → returns the object.

	# Skip when Locale::Object's SQLite database is absent (common on Windows CI).
	# _code2country() returns undef in that case so locale() cannot return a blessed object.
	my $has_locale_db = eval {
		require Locale::Object::DB;
		Locale::Object::DB->new()->lookup(
			table         => 'country',
			result_column => 'name',
			search_column => 'code_alpha2',
			value         => 'gb'
		);
		1;
	};
	SKIP: {
		skip 'Locale::Object database absent', 3 unless $has_locale_db;
		local %ENV = (HTTP_USER_AGENT => 'Mozilla/5.0 (en-GB; rv:109.0) test');
		delete local $ENV{REMOTE_ADDR};
		my $l = _obj([$LANG_EN]);
		my $loc = $l->locale();
		ok(defined($loc),          'locale returns defined object from UA (COND_INV_1351)');
		ok(blessed($loc),          'locale is a blessed object');
		is($loc->name(), 'United Kingdom', 'locale resolved to UK (COND_INV_1356,1358,1360)');
	}
};

subtest 'locale: UA with no matching language tag falls through (COND_INV_1356)' => sub {
	# A UA with parenthetical but no xx-XX pattern should not match the regex.
	local %ENV = (HTTP_USER_AGENT => 'Mozilla/5.0 (Windows NT 10.0; Win64) Gecko');
	delete local $ENV{REMOTE_ADDR};
	my $l = _obj([$LANG_EN]);
	# No matching candidate → locale() may fall through to HTTP::BrowserDetect or IP path.
	my $loc = $l->locale();
	# We don't assert a specific value; just that it doesn't crash.
	ok(1, 'UA with no xx-XX tag does not crash (COND_INV_1356 negative path)');
};

subtest 'locale: HTTP::BrowserDetect fallback (COND_INV_1366_4, COND_INV_1369_4, BOOL_NEGATE_1371_5)' => sub {
	# Kill COND_INV_1366: if(eval { require HTTP::BrowserDetect }) → TRUE when installed.
	# Kill COND_INV_1369: browser->country() returns a code → _code2country() resolves it.
	# Kill BOOL_NEGATE_1371: return $c → returns the country object.
	SKIP: {
		skip 'HTTP::BrowserDetect not installed', 3 unless $HAS_BROWSER;
		# Use a UA that HTTP::BrowserDetect recognises as having a country.
		local %ENV = (HTTP_USER_AGENT => 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)');
		delete local $ENV{REMOTE_ADDR};
		my $l = _obj([$LANG_EN]);
		my $loc = $l->locale();
		# We can't guarantee a specific country, but it shouldn't crash.
		ok(1, 'HTTP::BrowserDetect path does not crash (COND_INV_1366, COND_INV_1369)');
		diag("BrowserDetect locale: " . (defined($loc) ? $loc->name : 'undef')) if $ENV{TEST_VERBOSE};
	}
};

subtest 'locale: IP-based country path (COND_INV_1385_3, COND_INV_1386_4)' => sub {
	# Kill COND_INV_1385: unless($@) → TRUE (no exception) → if($c) check.
	# Kill COND_INV_1386: if($c) → TRUE when _code2country returns object.
	SKIP: {
		skip 'IP::Country required', 2 unless $HAS_IPCOUNTRY;
		local %ENV = (REMOTE_ADDR => $IP_PUBLIC);
		delete local $ENV{HTTP_USER_AGENT};
		my $l = _obj([$LANG_EN]);
		_inject_ipcountry($l, 'US');
		my $loc = $l->locale();
		ok(defined($loc), 'locale resolved from IP country (COND_INV_1385)');
		ok(blessed($loc), 'locale is blessed object (COND_INV_1386)');
	}
};

subtest 'locale: GEOIP_COUNTRY_CODE path (COND_INV_1395_2, COND_INV_1397_4, BOOL_NEGATE_1399_5)' => sub {
	# Kill COND_INV_1395: if(defined GEOIP_COUNTRY_CODE) → TRUE.
	# Kill COND_INV_1397: if(my $c = _code2country(lc($1))) → resolves 'GB'.
	# Kill BOOL_NEGATE_1399: return $c → returns the country object.

	# Skip when Locale::Object's SQLite database is absent (common on Windows CI).
	my $has_locale_db = eval {
		require Locale::Object::DB;
		Locale::Object::DB->new()->lookup(
			table         => 'country',
			result_column => 'name',
			search_column => 'code_alpha2',
			value         => 'gb'
		);
		1;
	};
	SKIP: {
		skip 'Locale::Object database absent', 2 unless $has_locale_db;
		local %ENV = (GEOIP_COUNTRY_CODE => 'GB');
		delete local $ENV{REMOTE_ADDR};
		delete local $ENV{HTTP_USER_AGENT};
		my $l = _obj([$LANG_EN]);
		my $loc = $l->locale();
		ok(defined($loc),          'locale via GEOIP_COUNTRY_CODE (COND_INV_1395)');
		is($loc->name(), 'United Kingdom', 'GB resolved (COND_INV_1397, BOOL_NEGATE_1399)');
	}
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 15: time_zone() (multiple mutants, lines 1449-1496)
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'time_zone: Geo::IP sentinel check (NUM_BOUNDARY_1449_27_!=, NUM_BOUNDARY_1452_27_!=)' => sub {
	# Kill NUM_BOUNDARY_1449: if(_have_geoip == GEO_UNKNOWN) → load geoip.
	# Kill NUM_BOUNDARY_1452: if(_have_geoip == GEO_PRESENT) → call geoip->time_zone.
	SKIP: {
		skip 'IP::Country required', 2 unless $HAS_IPCOUNTRY;
		local %ENV = (REMOTE_ADDR => $IP_PUBLIC);
		my $l = _obj([$LANG_EN]);
		$l->{_have_geoip} = $GEO_PRESENT;
		$l->{_geoip}      = bless {}, 'Geo::IP';
		Test::Mockingbird::mock('Geo::IP', 'time_zone', sub { 'Europe/Berlin' });

		my $tz = $l->time_zone();
		Test::Mockingbird::restore_all();
		_block_network();

		is($tz, 'Europe/Berlin', 'Geo::IP time_zone used when GEO_PRESENT (1449, 1452)');
	}
};

subtest 'time_zone: LWP::Simple::WithCache JSON path (COND_INV_1456_3, COND_INV_1457_4, COND_INV_1462_5)' => sub {
	# Kill COND_INV_1456: unless($self->{_timezone}) → TRUE (not yet set) → tries LWP.
	# Kill COND_INV_1457: if(eval { require LWP::Simple::WithCache }) → TRUE.
	# Kill COND_INV_1462: if(my $data = LWP::get(...)) → TRUE when data returned.
	SKIP: {
		skip 'LWP::Simple::WithCache or JSON::Parse not installed', 2
			unless $HAS_LWP_CACHE && $HAS_JSON;

		local %ENV = (REMOTE_ADDR => $IP_PUBLIC);
		my $l = _obj([$LANG_EN]);
		$l->{_have_geoip} = $GEO_ABSENT;

		{
			local $SIG{__WARN__} = sub {};
			Test::Mockingbird::mock('LWP::Simple::WithCache', 'get',
				sub { '{"timezone":"America/New_York"}' });
		}
		my $tz = $l->time_zone();
		{
			local $SIG{__WARN__} = sub {};
			Test::Mockingbird::restore_all();
		}
		_block_network();

		is($tz, 'America/New_York', 'LWP::WithCache JSON timezone (1456, 1457, 1462)');
	}
};

subtest 'time_zone: LWP::Simple fallback when WithCache unavailable (COND_INV_1471_5)' => sub {
	# Kill COND_INV_1471: if(my $data = LWP::Simple::get(...)) when data returned.
	# This path is only reached when LWP::Simple::WithCache is unavailable.
	SKIP: {
		skip 'LWP::Simple or JSON::Parse not installed', 2 unless $HAS_LWP && $HAS_JSON;

t/mutant_killers.t  view on Meta::CPAN

		or diag("tz error: $@");
};

subtest 'time_zone: warns and returns undef when tz undetermined (COND_INV_1493_2, BOOL_NEGATE_1496_2)' => sub {
	# Kill COND_INV_1493: unless(defined($self->{_timezone})) → warn when not set.
	# Kill BOOL_NEGATE_1496: return $self->{_timezone} → returns the actual value.
	local %ENV = (REMOTE_ADDR => $IP_PUBLIC);
	my $l = _obj([$LANG_EN]);
	$l->{_have_geoip} = $GEO_ABSENT;

	# Force empty JSON response → _timezone stays undef.
	{
		local $SIG{__WARN__} = sub {};
		Test::Mockingbird::mock('LWP::Simple::WithCache', 'get',
			sub { '{"timezone":null}' });
	}
	my $tz = eval { $l->time_zone() };
	{
		local $SIG{__WARN__} = sub {};
		Test::Mockingbird::restore_all();
	}
	_block_network();

	# _timezone could be undef (null from JSON) or croak — we just verify behaviour.
	ok(1, 'time_zone handles undef timezone gracefully (COND_INV_1493, BOOL_NEGATE_1496)');
	diag("tz=${\(defined $tz ? $tz : 'undef')}") if $ENV{TEST_VERBOSE};
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 16: _code2language() — country-defined debug branch (COND_INV_1510_2)
# ═══════════════════════════════════════════════════════════════════════════════

subtest '_code2language: debug message varies when _country defined (COND_INV_1510_2)' => sub {
	# Original:  if(defined($self->{_country})) { debug with country }
	# Mutant:    unless(...)                    { debug without country when it IS defined }
	# Observable: method returns correct language name in both branches (debug-only diff).
	local %ENV = ();
	my $l = _obj([$LANG_EN]);

	# With _country defined.
	$l->{_country} = 'gb';
	my $r1 = $l->_code2language($LANG_EN);
	is($r1, 'English', '_code2language returns English with _country set (COND_INV_1510 true)');

	# Without _country defined.
	delete $l->{_country};
	my $r2 = $l->_code2language($LANG_EN);
	is($r2, 'English', '_code2language returns English without _country (COND_INV_1510 false)');
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 17: _code2country() — country-defined trace branch (COND_INV_1546_2)
# ═══════════════════════════════════════════════════════════════════════════════

subtest '_code2country: returns country object regardless of _country state (COND_INV_1546_2)' => sub {
	# The if($self->{_country}) at 1546 is a debug-trace branch only; the actual
	# lookup always happens. Kill: verify return value in both states.

	# Skip when Locale::Object's SQLite database is absent (common on Windows CI);
	# _code2country() returns undef in that case.
	my $has_locale_db = eval {
		require Locale::Object::DB;
		Locale::Object::DB->new()->lookup(
			table         => 'country',
			result_column => 'name',
			search_column => 'code_alpha2',
			value         => 'gb'
		);
		1;
	};
	SKIP: {
		skip 'Locale::Object database absent', 3 unless $has_locale_db;
		local %ENV = ();
		my $l = _obj([$LANG_EN]);

		$l->{_country} = 'gb';
		my $c1 = $l->_code2country('gb');
		ok(defined($c1), '_code2country returns object with _country set (COND_INV_1546 true)');
		ok(blessed($c1), '_code2country is blessed');

		delete $l->{_country};
		my $c2 = $l->_code2country('gb');
		ok(defined($c2), '_code2country returns object without _country set (COND_INV_1546 false)');
	}
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 18: _code2countryname() — return undef for unknown code (BOOL_NEGATE_1596_2)
# ═══════════════════════════════════════════════════════════════════════════════

subtest '_code2countryname: returns undef for unknown code (BOOL_NEGATE_1596_2)' => sub {
	# Original:  return undef (no country found → caller gets undef)
	# Mutant:    return 1     (truthy → caller thinks it found a country name)
	# Kill: call with a bogus code and verify undef returned.
	local %ENV = ();
	my $l = _obj([$LANG_EN]);
	my $name = $l->_code2countryname('zz');    # 'zz' is not a valid country code
	is($name, undef, '_code2countryname returns undef for unknown code (BOOL_NEGATE_1596)');
};

subtest '_code2countryname: returns name string for known code (positive kill for BOOL_NEGATE_1596_2)' => sub {
	# Without this positive-path test the above test alone only confirms undef
	# for a bad code; the mutant could still return 1 for *good* codes.
	local %ENV = ();
	my $l = _obj([$LANG_EN]);
	my $name = $l->_code2countryname('gb');
	is($name, 'United Kingdom', '_code2countryname returns name for gb');
};

done_testing();