# $Id: score.t,v 1.3 2005/03/22 16:07:31 lem Exp $ # Check the basic scoring of the reports use IO::File; use Test::More; use File::Path; use Date::Parse; use NetAddr::IP; use Mail::Abuse::Reader; use Mail::Abuse::Report; use Mail::Abuse::Incident; @incidents = ( ['172.16.64.25/32', 'Tue Jul 30 14:48:42 1996', 'test/foobar'], ['172.16.64.25/32', 'Tue Jul 30 14:48:42 1996', 'test/foobaz'], ['172.16.64.25/32', 'Tue Jul 30 14:48:42 1996', 'test/bazbar'], ); my @cases = ( [ '1 All\syour\sbase', undef, [1] ], [ '7 All\syour\sbase', undef, [7] ], [ '1 all\syour\sbase', undef, [0] ], [ undef, '1 ^test/', [3] ], [ undef, '7 baz', [14] ], [ undef, '7 baz 5 foo', [24] ], [ '7 All\syour\sbase', '7 baz', [21] ], [ '5 All\syour\sbase', '7 baz 5 foo', [29] ], [ undef, undef, [0] ], [ '11000 All\syour\sbase', undef, [10000] ], [ '-11000 All\syour\sbas', undef, [-10000] ], ); # Some funny helper classes package myReader; use base 'Mail::Abuse::Reader'; sub read { my $text = "All your base are belong to us!"; $_[1]->text(\$text); return 1 } package myIncident; use base 'Mail::Abuse::Incident'; sub new { bless {}, ref $_[0] || $_[0] }; package myParser; use base 'Mail::Abuse::Incident'; sub parse { my @incidents = (); for my $i (@main::incidents) { my $I = new myIncident; $I->ip (new NetAddr::IP $i->[0]); $I->time ($i->[1]); $I->type ($i->[2]); push @incidents, $I; } return @incidents; }; package main; my $config = "config$$"; # Fake config sub write_config ($$) # Produce a suitable config file for testing { my $r_re = shift; my $i_re = shift; my $fh = new IO::File; $fh->open($config, "w") or diag "Failed to create test config file: $!"; print $fh "score report text: $r_re\n" if $r_re; print $fh "score incident type: $i_re\n" if $i_re; print $fh "score maximum value: 10000\n"; print $fh "score minimum value: -10000\n"; print $fh "# debug score: 1\n"; $fh->close; } END { unlink $config }; plan tests => 1 + 3 * @cases; use_ok('Mail::Abuse::Processor::Score'); my $rep; for my $c (@cases) { write_config($c->[0], $c->[1]); $rep = new Mail::Abuse::Report { config => $config, reader => new myReader, parsers => [ new myParser ], processors => [ new Mail::Abuse::Processor::Score ], }; isa_ok($rep, 'Mail::Abuse::Report'); $rep->next; ok(defined $rep->score, "Score is defined"); unless (is($rep->score, $c->[2]->[0], "Score matches expected value")) { diag "Incident text: '" . ${$rep->text} . "'"; diag "Report config: '" . $c->[0] . "'"; diag "Incident config: '" . $c->[1] . "'"; } }