Mail::Abuse::Processor::Mailer - Handle the email response to a Mail::Abuse::Report

  use Mail::Abuse::Processor::Mailer;

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

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

package Mail::Abuse::Processor::Mailer;

require 5.005_62;

use Carp;
use strict;
use warnings;
use IO::File;
use Mail::Mailer;

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

use constant ANTILOOP	=> 'X-Mail-Abuse-Loop';

				# The code below should be in a single line

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

use constant DEBUG	=> 'debug mailer';

use constant TYPE	=> 'mailer type';

use constant SMTP	=> 'mailer smtp server';

use constant FROM	=> 'mailer from';

use constant REPLYTO	=> 'mailer reply to';

use constant ERRORSTO	=> 'mailer errors to';

use constant FORCED	=> 'mailer forced to';

use constant SUBJECT	=> 'mailer subject';

use constant PRECEDENCE	=> 'mailer precedence';

use constant FAIL	=> 'mailer fail message';

use constant SUCCESS	=> 'mailer success message';

use constant CHARSET	=> 'mailer charset';

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

    unless ($rep->config or ref $rep->config ne 'HASH')
    {
	warn "Invalid or no config";
	return;
    }

    my $fail	= $rep->config->{&FAIL};
    my $from	= $rep->config->{&FROM};
    my $smtp	= $rep->config->{&SMTP};
    my $debug	= $rep->config->{&DEBUG};
    my $forced	= $rep->config->{&FORCED};
    my $success	= $rep->config->{&SUCCESS};
    my $replyto	= $rep->config->{&REPLYTO};
    my $subject	= $rep->config->{&SUBJECT};
    my $errors	= $rep->config->{&ERRORSTO};
    my $preced	= $rep->config->{&PRECEDENCE} || 'bulk';
    my $type	= $rep->config->{&TYPE} || 'mail';
    my $charset = $rep->config->{&CHARSET} || 'US-ASCII';

    unless ($fail and $success and -f $fail and -f $success)
    {
	warn "M::A::P::Mailer: Failure and success templates must be defined\n";
	return;
    }

    unless ($from)
    {
	warn "M::A::P::Mailer: No ", &FROM, " entry found in the config file";
	return;
    }

    if (($rep->normalized && $rep->header->get(&ANTILOOP)) 
	or (!$rep->normalized && $rep->text =~ m/^\s*&{ANTILOOP}:\s/m))
    {
	warn "M::A::P::Mailer: Loop detected and avoided\n" if $debug;
	return;
    }
				# Detect and avoid loops

    my $mailer;

    if (defined $smtp)
    {
	$mailer = new Mail::Mailer $type, Server => $smtp;
    }
    else
    {
	$mailer = new Mail::Mailer $type;
    }

    my %Headers	= (
	'X-Mailer'			=> __PACKAGE__ . " v$VERSION",
	&ANTILOOP			=> scalar localtime,
	'MIME-Version'			=> '1.0',
	'Content-Type'			=> qq{text/plain; charset="$charset"},
	'Content-Transfer-Encoding'	=> '8bit',
	'From'				=> $from,
    );

    $Headers{'Reply-To'}	= $replyto if $replyto;
    $Headers{'Errors-To'}	= $errors if $errors;
    $Headers{'Subject'}		= $subject if $subject;
    $Headers{'Precedence'}	= $preced;

    if ($rep->normalized)
    {
	$Headers{To} = $rep->header->get('Reply-To') 
	    || $rep->header->get('From');
    }
    else
    {
	if ($ {$rep->text} =~ m/Reply-To: (.*)$/m)
	{
	    $Headers{To} = $1;
	}
	elsif ($ {$rep->text} =~ m/From: (.*)$/m)
	{
	    $Headers{To} = $1;
	}
    }

    unless ($Headers{To})
    {
	warn "M::A::P::Mailer: Cannot determine destination address\n";
	return;
    }

    chomp $Headers{To};

    if ($forced)
    {
	warn "M::A::P::Mailer: Changing recipient from $Headers{To} ",
	"to $forced\n";
	$Headers{'X-Mail-Abuse-Original-To'} = $Headers{To};
	$Headers{To} = $forced;
    }
    
    my $fh = new IO::File;

    if ($rep->incidents and @ {$rep->incidents} > 0)
    {
				# Found an incident, so 
				# declare it a success
	unless ($fh->open($success, "r"))
	{
	    warn "M::A::P::Mailer: Cannot open success template $success\n";
	    return;
	}
    }
    else
    {
				# No incidents are applicable
	unless ($fh->open($fail, "r"))
	{
	    warn "M::A::P::Mailer: Cannot open fail template $fail\n";
	    return;
	}
    }

    $mailer->open(\%Headers);
    {
	local $/ = undef;
	print $mailer (<$fh>);
    };
    $fh->close;
    return $mailer->close;
}

__END__