view release on metacpan or  search on metacpan

t/mutation_survivors.t  view on Meta::CPAN

	is $r_str, 'hello', '_sanitise_output("hello") returns "hello" exactly';
	isnt $r_str, '', '_sanitise_output("hello") does not return empty string (negation)';

	# C0-stripped string: must return the stripped string (not its negation)
	my $r_ctrl = $fn->("\x01hello\x02");
	is $r_ctrl, 'hello', '_sanitise_output strips controls and returns stripped string';
	isnt $r_ctrl, '', 'stripped result is not empty string (negation)';
};

# =============================================================================
# 38. _decode_body() return value  [BOOL_NEGATE_2883_2]
# =============================================================================
subtest 'BOOL_NEGATE_2883_2 -- _decode_body() returns correct string' => sub {
	my $a = Email::Abuse::Investigator->new();

	# 7bit: returns body unchanged
	my $r = $a->_decode_body('hello world', '7bit');
	is $r, 'hello world', '_decode_body 7bit returns body string exactly';
	isnt $r, '', '_decode_body 7bit does not return empty string';

	# undef body: returns '' (not !'')
	my $r_undef = $a->_decode_body(undef, '7bit');
	is $r_undef, '', '_decode_body undef body returns empty string';
};

# =============================================================================
# 39. _header_value() return values  [BOOL_NEGATE_4069_3, BOOL_NEGATE_4071_2]
# =============================================================================
subtest 'BOOL_NEGATE_4069/4071 -- _header_value() exact return values' => sub {
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email("From: sender\@example.com\nSubject: Test Subject\n\nbody");

	# Found header: returns the value string exactly
	my $from = $a->_header_value('from');
	is $from, 'sender@example.com',
		'_header_value returns the exact header value string';
	isnt $from, '', 'found header does not return empty string (negation)';

	# Not found: returns undef exactly (not !undef = 1)
	my $missing = $a->_header_value('x-no-such-header');
	is $missing, undef,
		'_header_value returns undef for missing header';
	isnt $missing, 1, 'missing header does not return 1 (negation of undef)';
};

# =============================================================================
# 40. _decode_mime_words() return values  [BOOL_NEGATE_4114_2, BOOL_NEGATE_4117_2]
# =============================================================================
subtest 'BOOL_NEGATE_4114/4117 -- _decode_mime_words() exact return values' => sub {
	my $a = Email::Abuse::Investigator->new();

	# undef: returns '' exactly
	my $r_undef = $a->_decode_mime_words(undef);
	is $r_undef, '', '_decode_mime_words(undef) returns empty string exactly';
	isnt $r_undef, 1, 'not 1 (negation of empty string)';

	# plain string: returned unchanged
	my $r_plain = $a->_decode_mime_words('plain text');
	is $r_plain, 'plain text', '_decode_mime_words returns plain string unchanged';

	# encoded word: returns decoded string
	my $enc = '=?UTF-8?B?' . encode_base64('decoded', '') . '?=';
	my $r_enc = $a->_decode_mime_words($enc);
	is $r_enc, 'decoded', '_decode_mime_words returns decoded string exactly';
	isnt $r_enc, '', 'decoded string is not empty (negation)';
};

# =============================================================================
# 41. unresolved_contacts() conditions  [COND_INV_1176_3, BOOL_NEGATE_1217_2]
# =============================================================================
subtest 'COND_INV_1176_3 + BOOL_NEGATE_1217_2 -- unresolved_contacts() branches' => sub {
	null_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	local *Email::Abuse::Investigator::_resolve_host = sub { undef };
	local *Email::Abuse::Investigator::_whois_ip	 = sub { {} };  # no abuse

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email("From: x\@y.com\n\nhttps://mystery.example/page and info\@mystery.example");

	my @unresolved = $a->unresolved_contacts();

	# Return value is a list (BOOL_NEGATE: not !list)
	ok scalar @unresolved >= 0, 'unresolved_contacts() returns a list (not negation)';

	# mystery.example has no abuse contact so should appear
	ok scalar(grep { $_->{domain} eq 'mystery.example' } @unresolved),
		'mystery.example (no abuse contact) appears in unresolved_contacts()';

	# Each entry has the required keys (COND_INV_1176_3: dom extraction)
	for my $u (@unresolved) {
		ok defined $u->{domain}, "entry has domain (got '$u->{domain}')";
		ok defined $u->{type},   "entry has type";
		ok defined $u->{source}, "entry has source";
	}

	restore_net();
};

done_testing();