# $Id: tabledbi.t,v 1.1 2005/06/09 16:03:46 lem Exp $ # Check the DBI table lookup use DBI; use Test::More; use NetAddr::IP; use Mail::Abuse::Reader; use Mail::Abuse::Report; use Mail::Abuse::Incident; use Data::Dumper; my $dsn = 'dbi:CSV:f_dir=.'; our @incidents = ( ['127.0.0.1/32', 1000], ['127.0.0.1/32', 1001], ['10.0.0.1/32', 1000], ); # Some funny helper classes package myReader; our $index = 0; 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(NetAddr::IP->new($i->[0])); $I->time($i->[1]); push @incidents, $I; } return @incidents; }; package main; my $config = "config$$"; # Fake config sub _create { my $dbh = DBI->connect($dsn, '', '', { RaiseError => 1}); my $ip = new NetAddr::IP '127.0.0.1/32'; $dbh->do(q{CREATE TABLE StaticData (CIDR_Start INTEGER, CIDR_End INTEGER, TIME_Start INTEGER, TIME_End INTEGER, Info CHAR(64))}); $dbh->do(q{INSERT INTO StaticData (CIDR_Start, CIDR_End, TIME_Start, TIME_End, Info) VALUES (} . scalar($ip->network->numeric) . ',' . scalar($ip->broadcast->numeric) . ',' . 1000 . ',' . 1000 . q{, 'Test ok')}); $dbh->disconnect; # diag `cat StaticData`; } sub _drop { my $dbh = DBI->connect($dsn, '', '', { PrintError => 0, RaiseError => 0}); $dbh->do('DROP TABLE StaticData'); $dbh->disconnect; } sub write_config # Produce a suitable config file for testing { _create; my $fh = new IO::File; $fh->open($config, "w") or diag "Failed to create test config file: $!"; print $fh "dbi table dsn: $dsn\n"; print $fh "dbi table name: StaticData\n"; print $fh "# debug dbi table: 1\n"; $fh->close; } END { unlink $config; _drop }; plan tests => 7; diag "Failed to use Mail::Abuse::Processor::ArchiveDBI\n", "The rest of the tests in this suite will fail" unless use_ok('Mail::Abuse::Processor::TableDBI'); my $rep; # Start with a clean state and config _drop; write_config; $rep = new Mail::Abuse::Report { config => $config, reader => new myReader, parsers => [ new myParser ], processors => [ new Mail::Abuse::Processor::TableDBI ], }; isa_ok($rep, 'Mail::Abuse::Report'); $rep->next; # Now we must verify that our incidents are properly matched is(scalar @{$rep->{incidents}}, scalar @incidents, 'Correct number of incidents'); # First incident must be a match ok($rep->incidents->[0]->tabledbi, "First incident seems to match as expected"); is($rep->incidents->[0]->tabledbi->{Info}, 'Test ok', "Correct information returned"); # Second incident must not match diag "Incident 2 matched incorrectly: ", $rep->incidents->[1] unless ok(! defined $rep->incidents->[1]->tabledbi, "2nd incident must not have matched"); # Third incident must not match diag "Incident 3 matched incorrectly: ", $rep->incidents->[2] unless ok(! defined $rep->incidents->[2]->tabledbi, "3rd incident must not have matched");