106 lines
2.7 KiB
Perl
106 lines
2.7 KiB
Perl
package WebGUI::Mailing::Bounce;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use WebGUI::Mailing::Admin;
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub bounceScoreOk {
|
|
my $self = shift;
|
|
my $address = shift;
|
|
my $setting = $self->session->setting;
|
|
|
|
my $threshold = $setting->get('newsletterBounceScoreThreshold');
|
|
return 1 unless $threshold;
|
|
|
|
return $self->getBounceScore( $address ) < $threshold;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub getBounceScore {
|
|
my $self = shift;
|
|
my $address = shift;
|
|
my $session = $self->session;
|
|
|
|
my $it = WebGUI::Mailing::Email->getAllIterator( $session, {
|
|
constraints => [
|
|
{ 'sentTo=?' => [ $address ] },
|
|
{ 'status<>?' => [ 'queued' ] },
|
|
],
|
|
orderBy => 'sendDate desc',
|
|
limit => 10,
|
|
} );
|
|
|
|
my $score = 0;
|
|
while ( my $email = $it->() ) {
|
|
$score += 1 if $email->get('status') eq 'bounced';
|
|
}
|
|
|
|
return $score;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub new {
|
|
my $class = shift;
|
|
my $session = shift;
|
|
|
|
bless { _session => $session }, $class;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub session {
|
|
return (shift)->{ _session };
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_bounceReport {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $db = $session->db;
|
|
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
|
|
|
|
my $windowSize = 10;
|
|
|
|
my $sql = <<EOSQL;
|
|
select
|
|
sentTo,
|
|
count(status),
|
|
bounceReason,
|
|
errorMessage
|
|
from
|
|
Mailing_email as t1
|
|
where
|
|
status='bounced'
|
|
and
|
|
(
|
|
(select count(*) from Mailing_email as t2 where t1.sentTo=t2.sentTo) < ?
|
|
or
|
|
(select lastUpdated from Mailing_email as t2 where t1.sentTo=t2.sentTo order by lastUpdated desc limit ?,1 )
|
|
)
|
|
group by
|
|
sentTo
|
|
order by
|
|
sentTo, lastUpdated
|
|
EOSQL
|
|
|
|
my $sth = $db->read( $sql, [ $windowSize, $windowSize - 1 ] );
|
|
|
|
my $output = '<table><tr><th>'
|
|
. join( '</th><th>',
|
|
$i18n->get('email'),
|
|
$i18n->get('bounce score'),
|
|
$i18n->get('bounce reason'),
|
|
$i18n->get('bounce message')
|
|
)
|
|
. '</th></tr>';
|
|
while ( my $values = $sth->arrayRef ) {
|
|
$output .= '<tr><td>'. join( '</td><td>', @$values ) . '</td></tr>';
|
|
}
|
|
$output .= '</table>';
|
|
|
|
return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, $i18n->get( 'bounce scores' ) );
|
|
}
|
|
|
|
1;
|
|
|