Mail::Abuse::Processor::ArchiveDBI - Assign a score to an abuse report

  use Mail::Abuse::Processor::ArchiveDBI;

  use Mail::Abuse::Report;
  my $p = new Mail::Abuse::Processor::ArchiveDBI;
  my $report = new Mail::Abuse::Report (processors => [ $p ]);

  # ... other pieces of code that configure the report ...

package Mail::Abuse::Processor::ArchiveDBI;

require 5.005_62;

use DBI;
use strict;
use warnings;

use base 'Mail::Abuse::Processor';

				# The code below should be in a single line

our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf " %d."."%03d" x $#r, @r };

use constant REPORT_DSN		=> 'archive dsn';
use constant REPORT_USER	=> 'archive user';
use constant REPORT_PASSWORD	=> 'archive password';
use constant REPORT_COLS	=> 'archive reports columns';
use constant INCIDENT_COLS	=> 'archive incident columns';
use constant INCIDENT_FK	=> 'archive incident foreign key';
use constant DEBUG		=> 'debug archive';

my $sql_ireport = ';';		# Report insertion SQL
my $sql_iincident = ';';	# Incident insertion SQL

my $dbh;			# Our database handler
my $sth_ireport;		# Report insertion statement
my $sth_iincident;		# Incident insertion statement

my $rep_cols;
my $inc_cols;
my $inc_fks;

my @cols_rep = ();
my @cols_inc = ();

sub DESTROY { $dbh and $dbh->disconnect(); }

sub _decode_columns ($$)
{
    my $rep = shift;
    my $key = shift;

    my %cols = ();

    for my $spec (split(/[,\s]+/, $rep->config->{$key}))
    {
	my ($col, $element) = split(/:/, $spec, 2);
	my $r_l = $cols{$col} || [];
	push @$r_l, $element unless grep { $_ eq $element } @$r_l;
	$cols{$col} = $r_l;
    }

    return \%cols;
}

# Obtain a value from a report or incident, in short circuit
# (ie, the first element to match, wins)
sub _value ($$$)
{
    my $obj		= shift;
    my $r_spec		= shift;
    my $r_dollars	= shift;

#    warn "# _value from $obj with ", join(', ', @$r_spec), "\n";

    my $ret	= undef;
    for my $spec (@$r_spec)
    {
	if ($spec =~ /^\$(\w+)$/)
	{
	    return $r_dollars->{$1} if exists $r_dollars->{$1};
	}
	elsif ($spec =~ m/^\$ENV{([^}]+)}$/)
	{
	    return $ENV{$1};
	}

	my @things = split /\./, $spec;
 
	my $r = $obj;
	my @own = @things;

	while (defined $r and my $c = shift @own)
	{
	    if ($c =~ /^\d+$/)
	    {
		unless (ref $r eq 'ARRAY')
		{
		    warn "ArchiveDBI: Invalid type for $spec\n";
		    undef $r;
		    last;
		}
		$r = $r->[$c];
	    }
	    elsif ($c)
	    {
		if (ref $r eq 'HASH')
		{
		    $r = $r->{$c};
		}
		elsif (eval { defined $r->$c })
		{
		    no strict "refs";
		    $r = $r->$c;
		}
		else
		{
#		    warn "ArchiveDBI: Invalid type for $spec\n";
		    undef $r;
		    last;
		}
	    }
	}
	return $r if defined $r;
    }
    return;
}

sub process
{
    my $self	= shift;
    my $rep	= shift;

    # Init the database connection if not already done
    unless ($dbh)
    {
	my $DSN			= $rep->config->{&REPORT_DSN};
	my $LOGIN		= $rep->config->{&REPORT_USER};
	my $PASSWORD		= $rep->config->{&REPORT_PASSWORD};

	# Database connection using the configured parameters
	$dbh = DBI->connect($DSN, $LOGIN, $PASSWORD,
			    { 
				AutoCommit => 1,
				RaiseError => 0,
				PrintError => 1,
			    },
			    );
	
	# Obtain the columns and elements we will be storing into the
	# database for each report.

	$rep_cols	= _decode_columns $rep, REPORT_COLS;
	$inc_cols	= _decode_columns $rep, INCIDENT_COLS;
	$inc_fks	= [ split(/[,\s]+/, $rep->config->{&INCIDENT_FK}) ];

	if ($rep->config->{&DEBUG})
	{
	    warn "# Report columns:\n";
	    while (my ($c, $r_e) = each %$rep_cols)
	    {
		warn "#   $c -> [ ", join(',', @$r_e), " ]\n";
	    }
	    warn "# Incident FKs:\n";
	    warn "#   ", join(', ', @$inc_fks), "\n";
	    warn "# Incident columns:\n";
	    while (my ($c, $r_e) = each %$inc_cols)
	    {
		warn "#   $c -> [ ", join(',', @$r_e), " ]\n";
	    }
	}

	# Create the SQL statements that reflect this configuration.

	@cols_inc = (@$inc_fks, sort keys %$inc_cols);
	@cols_rep = (sort keys %$rep_cols);
	
	if (@cols_inc)
	{
	    $sql_iincident = 'INSERT INTO Incidents (';
	    $sql_iincident .= join(', ', @cols_inc);
	    $sql_iincident .= ') VALUES (';
	    $sql_iincident .= join ', ', split //, 
	    '?' x @cols_inc;
	    $sql_iincident .= ')';
	}
	
	if (@cols_rep)
	{
	    $sql_ireport = 'INSERT INTO Reports (';
	    $sql_ireport .= join(', ', @cols_rep);
	    $sql_ireport .= ') VALUES (';
	    $sql_ireport .= join ', ', split //, 
	    '?' x @cols_rep;
	    $sql_ireport .= ')';
	}

	if ($rep->config->{&DEBUG})
	{
	    warn "# Report SQL statement:\n";
	    warn "#   I: $sql_ireport\n";
	    warn "# Incident SQL statement:\n";
	    warn "#   I: $sql_iincident\n";
	}	

	# Prepare the SQL statements that insert the requested
	# information into the database

	$sth_ireport	= $dbh->prepare($sql_ireport);
	$sth_iincident	= $dbh->prepare($sql_iincident);
    }

    # Find out the information about this report that we will send to the
    # database

    my %rep_values = ();	# Hash where the values for each key 
    				# will be stored...

    $rep_values{$_} = _value $rep, 
			     $rep_cols->{$_}, 
			     { time => time, 
			       num => scalar @{$rep->incidents}} for @cols_rep;

    if ($rep->config->{&DEBUG})
    {
	warn "# Values for this report:\n";
	warn "#   $_ = " . 
	    (defined($rep_values{$_}) ? $rep_values{$_} : 'UNDEF') . "\n" 
	    for @cols_rep;
    }    

    # Perform the insertion of the report information to the database

    $sth_ireport->execute(map { $rep_values{$_} } @cols_rep);

    # Iterate over the incidents to process each one in turn
    my $num = 0;

    for my $i (@{$rep->incidents})
    {
	# Insert the incident information in the database
	my %inc_values = ();

	$inc_values{$_} = $rep_values{$_} for @$inc_fks;
	$inc_values{$_} = _value $i, $inc_cols->{$_}, 
	{ time => time, num => $num } for keys %$inc_cols;

	if ($rep->config->{&DEBUG})
	{
	    warn "# Values for incident $num:\n";
	    warn "#   $_ = " . 
		(defined($inc_values{$_}) ? $inc_values{$_} : 'UNDEF') . "\n" 
		for @cols_inc;
	}    

	$sth_iincident->execute(map { $inc_values{$_} } @cols_inc);
	$num ++;
    }

}

"All your base are belong to us";

__END__