The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

# $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");