Email-Abuse-Investigator
view release on metacpan or search on metacpan
t/integration.t view on Meta::CPAN
ok !scalar(grep { $_->{domain} eq 'known-abuse.example' } @unresolved),
'known-abuse.example does NOT appear in unresolved_contacts()';
# All returned entries conform to the documented type values
for my $u (@unresolved) {
ok $u->{type} =~ /^(?:url_host|domain)$/,
"type '$u->{type}' is a documented value";
}
restore_stubs();
};
# ---------------------------------------------------------------------------
# Scenario 42 â all_domains() union is stable across repeated calls
#
# all_domains() must return the same set on repeated calls (idempotent) and
# contain no duplicates even when the same domain appears as both a URL host
# and a mailto domain.
# ---------------------------------------------------------------------------
subtest 'Scenario 42: all_domains() is idempotent and deduplicates URL+mailto overlap' => sub {
restore_stubs();
install_stubs(
rdns => 'mail.overlap.example',
resolve => { 'overlap.example' => '91.198.174.20' },
whois_ip => { org => 'Overlap ISP', abuse => 'abuse@overlap.example' },
domain_whois => undef,
);
my $a = Email::Abuse::Investigator->new();
$a->parse_email(make_raw_email(
received => 'from ov (ov [91.198.174.20]) by mx.test',
from => 'Sender <sender@overlap.example>',
body => 'Click https://overlap.example/offer and reply to info@overlap.example',
));
my @first = $a->all_domains();
my @second = $a->all_domains();
# Results are stable
is scalar @second, scalar @first, 'all_domains() returns same count on second call';
is_deeply \@first, \@second, 'all_domains() returns identical results on second call';
# overlap.example appears in both URL hosts and mailto domains but should be listed once
my @occurrences = grep { $_ eq 'overlap.example' } @first;
is scalar @occurrences, 1,
'overlap.example (URL host AND mailto domain) appears exactly once in all_domains()';
restore_stubs();
};
# ===========================================================================
# Optional dependency graceful-degradation scenarios
#
# Each subtest uses without_optionals() to reload Email::Abuse::Investigator
# with specific $HAS_* flags cleared, then verifies the module's observable
# fallback behaviour through the public API only.
#
# Optional dependencies identified in the module:
# Net::DNS â MX / NS record lookups for domains
# LWP::UserAgent â RDAP enrichment + redirect-chain following
# LWP::ConnCache â LWP connection keep-alive (auxiliary to LWP::UserAgent)
# HTML::LinkExtor â Structural HTML link extraction (href/src/action attrs)
# CHI â Cross-message in-process WHOIS/RDAP cache
# IO::Socket::IP â IPv6-capable WHOIS socket (falls back to IO::Socket::INET)
# Domain::PublicSuffix â PSL-based eTLD+1 normalisation
# AnyEvent::DNS â Parallel async DNS resolution
# ===========================================================================
# ---------------------------------------------------------------------------
# OD-1: Without Net::DNS
#
# Net::DNS provides MX and NS lookups inside _analyse_domain(). Without it
# the $HAS_NET_DNS guard prevents those lookups; the returned hashrefs must
# have no mx_* or ns_* keys. All other domain fields (web_ip, registrar,
# etc.) still come from stubs and must remain present.
# ---------------------------------------------------------------------------
subtest 'OD-1: Without Net::DNS â mailto_domains() omits MX/NS keys, other fields intact' => sub {
without_optionals(['Net::DNS'], sub {
install_stubs(
rdns => 'mx.test.example',
resolve => { 'spammer.example' => '91.198.174.50' },
whois_ip => { org => 'Bad ISP', abuse => 'abuse@badisp.example', country => 'XX' },
domain_whois => sub {
my (undef, $dom) = @_;
return undef unless $dom eq 'spammer.example';
return "Registrar: EvilReg Inc\n"
. "Registrar Abuse Contact Email: reg\@evilreg.example\n";
},
);
my $a = Email::Abuse::Investigator->new();
$a->parse_email(make_raw_email(
received => 'from bad (bad [91.198.174.50]) by mx.test',
from => 'Phisher <crook@spammer.example>',
body => 'Send money.',
));
my @doms = $a->mailto_domains();
ok scalar(@doms), 'mailto_domains() returns results without Net::DNS';
my ($d) = grep { $_->{domain} eq 'spammer.example' } @doms;
ok defined $d, 'spammer.example present in mailto_domains()';
diag('Domain hashref keys: ' . join(', ', sort keys %$d)) if $ENV{TEST_VERBOSE};
# MX keys must be absent â the $HAS_NET_DNS guard skips those lookups
ok !exists $d->{mx_host}, 'no mx_host key without Net::DNS';
ok !exists $d->{mx_ip}, 'no mx_ip key without Net::DNS';
ok !exists $d->{mx_org}, 'no mx_org key without Net::DNS';
ok !exists $d->{mx_abuse}, 'no mx_abuse key without Net::DNS';
# NS keys must also be absent
ok !exists $d->{ns_host}, 'no ns_host key without Net::DNS';
ok !exists $d->{ns_ip}, 'no ns_ip key without Net::DNS';
ok !exists $d->{ns_org}, 'no ns_org key without Net::DNS';
ok !exists $d->{ns_abuse}, 'no ns_abuse key without Net::DNS';
# Non-DNS fields still populated from stubs
is $d->{domain}, 'spammer.example', 'domain field present';
is $d->{web_ip}, '91.198.174.50', 'web_ip from _resolve_host stub';
is $d->{registrar_abuse}, 'reg@evilreg.example', 'registrar_abuse from domain_whois stub';
( run in 2.022 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )