69 lines
1.6 KiB
Perl
69 lines
1.6 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 $sth = $session->db->read( 'select distinct sentTo from WGMailing_queue where sentTo is not null' );
|
|
|
|
my $output = '<table><tr><th>Email</th><th>Bounce score</th></tr>';
|
|
while ( my ($email) = $sth->array ) {
|
|
my $score = $self->getBounceScore( $email );
|
|
$output .= "<tr><td>$email</td><td>$score</td></tr>";
|
|
}
|
|
$output .= '</table>';
|
|
|
|
return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, 'Bounce score overview' );
|
|
}
|
|
|
|
1;
|
|
|