view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	$a->{_urls}		= [];
	$a->{_mailto_domains} = [];
	my @contacts = $a->abuse_contacts();
	ok !scalar(grep { $_->{address} eq '(unknown)' } @contacts),
	  '(unknown) abuse address is never added to contacts';

	restore_net();
};

subtest 'abuse_contacts() — returns empty list when no contacts determinable' => sub {
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email(
		from	 => 'x@noprovider.example',
		received => 'from localhost [127.0.0.1] by mx',
	));
	$a->{_origin}		= undef;
	$a->{_urls}		= [];
	$a->{_mailto_domains} = [];

	my @contacts = $a->abuse_contacts();
	is scalar @contacts, 0,
	  'empty list returned when origin is undef and no domains/URLs';
};

# =============================================================================
# report()
# =============================================================================
subtest 'report() — returns a non-empty plain string' => sub {
	stub_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email());
	my $r = $a->report();
	ok defined $r,	  'returns a defined value';
	ok !ref($r),		'returns a plain string';
	ok length($r) > 0,  'report is non-empty';
	restore_net();
};

subtest 'report() — contains all expected section headings' => sub {
	stub_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email(
		body => 'https://spamsite.example/buy and info@spamsite.example',
		from => 'Bad <bad@gmail.com>',
	));
	{
		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 $r = $a->report();
		like $r, qr/Email::Abuse::Investigator Report/, 'report title present';
		like $r, qr/RISK ASSESSMENT/,			 'RISK ASSESSMENT present';
		like $r, qr/ORIGINATING HOST/,			'ORIGINATING HOST present';
		like $r, qr/EMBEDDED HTTP\/HTTPS URLs/,	'EMBEDDED HTTP/HTTPS URLs present';
		like $r, qr/CONTACT \/ REPLY-TO DOMAINS/, 'CONTACT/REPLY-TO DOMAINS present';
		like $r, qr/WHERE TO SEND ABUSE REPORTS/, 'WHERE TO SEND ABUSE REPORTS present';
	}
	restore_net();
};

subtest 'report() — idempotent on same object' => sub {
	stub_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email());
	my $r1 = $a->report();
	my $r2 = $a->report();
	is $r2, $r1, 'report() returns same string on second call';
	restore_net();
};

subtest 'report() — envelope headers are decoded and displayed' => sub {
	stub_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	local *Email::Abuse::Investigator::_resolve_host = sub { undef };

	# Use a base64-encoded From: display name (as in the firmluminary spam)
	my $enc_from = '=?UTF-8?B?' . encode_base64('eharmony Partner', '') . '?=';
	my $enc_subj = '=?UTF-8?B?' . encode_base64('Ready to Find Love', '') . '?=';

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email(
		from	=> qq{"$enc_from" <peacelight\@firmluminary.com>},
		subject => $enc_subj,
	));
	my $r = $a->report();

	like $r, qr/eharmony Partner/, 'encoded From: display name decoded in report';
	like $r, qr/Ready to Find Love/, 'encoded Subject decoded in report';

	restore_net();
 };

# =============================================================================
# Cross-method: lazy evaluation and re-parse
# =============================================================================
subtest 'parse_email() re-invocation clears all public-method caches' => sub {
	stub_net(resolve => '1.2.3.4');
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_email(
		body	 => 'https://first.example/page',
		from	 => 'x@first.example',
		received => 'from first (first [91.198.174.1]) by mx',
	));
	my @urls1  = $a->embedded_urls();
	my $orig1  = $a->originating_ip();
	my $risk1  = $a->risk_assessment();
	ok @urls1  > 0,		'first parse: URLs populated';
	ok defined $orig1,	'first parse: origin populated';