view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	));
	$a->{_origin} = {
		ip => '91.198.174.42', rdns => 'dial.residential.isp.example',
		org => 'Bad ISP', abuse => 'abuse@bad-isp.example',
		confidence => 'high', note => 'First hop', country => 'NG',
	};
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_resolve_host = sub { '1.2.3.4' };
	local *Email::Abuse::Investigator::_whois_ip	 = sub { { org=>'Spam Host', abuse=>'abuse@spam.example' } };
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };

	my $text = $a->abuse_report_text();
	like $text, qr/automated abuse report/i,		  'report intro present';
	like $text, qr/RISK LEVEL/,					   'RISK LEVEL present';
	like $text, qr/ORIGINATING IP.*91\.198\.174\.42/s,'originating IP present';
	like $text, qr/ORIGINAL MESSAGE HEADERS/,		 'headers section present';
	like $text, qr/from:/i,						   'from header included';

	# No contacts branch (all unknown)
	my $b = Email::Abuse::Investigator->new();
	$b->parse_email(make_email());
	$b->{_origin}		 = { ip=>'1.2.3.4', rdns=>'mail.ok',
							  confidence=>'high', org=>'X', abuse=>'(unknown)',
							  note=>'', country=>undef };
	$b->{_urls}		   = [];
	$b->{_mailto_domains} = [];
	my $text2 = $b->abuse_report_text();
	like $text2, qr/RISK LEVEL/, 'report generated even without contacts';
}

# ===========================================================================
# 27. report() — all sections and branches
# ===========================================================================
note '=== 27. report() ===';
{
	# Full report with encoded headers, shortener, multiple URLs
	my $enc_subj = '=?UTF-8?B?' . encode_base64('Ready to Find Love', '') . '?=';
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email(
		from	 => 'Spammer <spammer@gmail.com>',
		subject  => $enc_subj,
		body	 => 'https://bit.ly/spam and http://spamsite.example/buy',
		received => 'from spammer (spammer [120.88.161.249]) by mx',
		auth	 => 'mx; spf=fail; dkim=fail',
	));
	$a->{_origin} = {
		ip => '120.88.161.249', rdns => '120-88-161-249.tpgi.com.au',
		org => 'TPG Internet', abuse => 'abuse@tpg.com.au',
		confidence => 'medium', note => 'First hop', country => 'AU',
	};
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_resolve_host = sub { '1.2.3.4' };
	local *Email::Abuse::Investigator::_whois_ip	 = sub { { org=>'Test Org', abuse=>'abuse@testorg.example', country=>'US' } };
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };

	my $report = $a->report();
	like $report, qr/Email::Abuse::Investigator Report/,  'report title';
	like $report, qr/RISK ASSESSMENT/,			  'risk section';
	like $report, qr/ORIGINATING HOST/,			 'originating host section';
	like $report, qr/120\.88\.161\.249/,			'originating IP';
	like $report, qr/EMBEDDED HTTP\/HTTPS URLs/,	'url section';
	like $report, qr/URL SHORTENER/,			   'shortener warning';
	like $report, qr/CONTACT \/ REPLY-TO DOMAINS/, 'domains section';
	like $report, qr/WHERE TO SEND ABUSE REPORTS/, 'contacts section';
	like $report, qr/Ready to Find Love/,		   'encoded subject decoded';

	# No-origin path
	my $b = Email::Abuse::Investigator->new();
	$b->parse_email("From: x\@y.com\nSubject: s\n\nbody");
	$b->{_origin}		 = undef;
	$b->{_urls}		   = [];
	$b->{_mailto_domains} = [];
	my $r2 = $b->report();
	like $r2, qr/could not determine originating IP/, 'no-origin message';
	like $r2, qr/none found/,						 'no-urls message';

	# Multiple URLs same host -> grouped
	my $c = Email::Abuse::Investigator->new();
	$c->parse_email(make_email(body => 'https://multi.example/a and https://multi.example/b'));
	$c->{_origin} = { ip=>'1.2.3.4', rdns=>'mail.ok',
					  confidence=>'high', org=>'X', abuse=>'a@b',
					  note=>'', country=>undef };
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_resolve_host = sub { '1.2.3.4' };
	local *Email::Abuse::Investigator::_whois_ip	 = sub { { org=>'T', abuse=>'a@b' } };
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $r3 = $c->report();
	like $r3, qr/URLs \(2\)/, 'multiple URLs grouped under host';

	# Contact domain with all sub-sections present
	my $d = Email::Abuse::Investigator->new();
	$d->parse_email(make_email(from => 'x@example-domain.tld'));
	$d->{_origin} = { ip=>'1.2.3.4', rdns=>'mail.ok',
					  confidence=>'high', org=>'X', abuse=>'a@b',
					  note=>'', country=>undef };
	$d->{_urls}		   = [];
	$d->{_mailto_domains} = [{
		domain			  => 'example-domain.tld',
		source			  => 'From: header',
		recently_registered => 1,
		registered		  => '2025-12-01',
		expires			 => '2026-12-01',
		registrar		   => 'NameCheap',
		registrar_abuse	 => 'abuse@namecheap.com',
		web_ip			  => '5.5.5.5',
		web_org			 => 'Host Co',
		web_abuse		   => 'abuse@hostco.example',
		mx_host			 => 'mail.example-domain.tld',
		mx_ip			   => '6.6.6.6',
		mx_org			  => 'Mail Co',
		mx_abuse			=> 'abuse@mailco.example',
		ns_host			 => 'ns1.example-domain.tld',
		ns_ip			   => '7.7.7.7',
		ns_org			  => 'NS Co',
		ns_abuse			=> 'abuse@nsco.example',
	}];
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_resolve_host = sub { undef };
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $r4 = $d->report();
	like $r4, qr/RECENTLY REGISTERED/,	  'recently_registered warning present';