40 lines
1 KiB
Perl
40 lines
1 KiB
Perl
package WebGUI::MailCommand::Bounce;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use WebGUI::Mailing::Email;
|
|
use Mail::DeliveryStatus::BounceParser;
|
|
|
|
use base 'WebGUI::MailCommand';
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub process {
|
|
my $self = shift;
|
|
my $hexId = shift;
|
|
my $session = $self->session;
|
|
my $log = $session->log;
|
|
my $id = $session->id->fromHex( $hexId );
|
|
|
|
my $email = WebGUI::Mailing::Email->new( $session, $id );
|
|
|
|
if ($email) {
|
|
my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
|
|
|
|
my $report = ( $dsr->reports )[0];
|
|
my $reason = $report->get( 'std_reason' );
|
|
my $message = $report->get( 'reason' );
|
|
$message =~ s{\s+}{ }g;
|
|
|
|
$log->warn( "Registering email [$id] as bounced." );
|
|
$email->registerBounced( $reason, $message );
|
|
}
|
|
else {
|
|
$log->error( "Cannot process bounced email [$id] because it cannot be located in the db." );
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
1;
|
|
|