From 1167a11ba776f5a25d520957f510092395213684 Mon Sep 17 00:00:00 2001
From: Martin Kamerbeek <martin@martintwee.oqapi.nl>
Date: Thu, 20 May 2010 17:57:36 +0200
Subject: [PATCH] Skip addresses that exceed bounce score threshold.

---
 lib/WebGUI/Mailing/Admin.pm  |  6 ++++++
 lib/WebGUI/Mailing/Bounce.pm | 11 +++++++++++
 lib/WebGUI/Mailing/Email.pm  | 12 ++++++++++++
 sbin/install_newsletter.pl   |  3 ++-
 4 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/lib/WebGUI/Mailing/Admin.pm b/lib/WebGUI/Mailing/Admin.pm
index 1740047..f0cd513 100644
--- a/lib/WebGUI/Mailing/Admin.pm
+++ b/lib/WebGUI/Mailing/Admin.pm
@@ -85,6 +85,11 @@ sub www_settings {
         value   => $setting->get( 'newsletterReturnDomain' ),
         label   => 'Newsletter domain name',
     );
+    $f->integer(
+        name    => 'newsletterBounceScoreThreshold',
+        value   => $setting->get( 'newsletterBounceScoreThreshold' ),
+        label   => 'Bounce score threshold',
+    );
     $f->submit;
 
     return $self->getAdminConsole->render($f->print, 'Newsletter settings')
@@ -98,6 +103,7 @@ sub www_settingsSave {
     my ($setting, $form) = $session->quick( 'setting', 'form' );
 
     $setting->set( 'newsletterReturnDomain', $form->get('newsletterReturnDomain') );
+    $setting->set( 'newsletterBounceScoreThreshold', $form->integer('newsletterBounceScoreThreshold') );
 
     return $self->www_settings;
 }
diff --git a/lib/WebGUI/Mailing/Bounce.pm b/lib/WebGUI/Mailing/Bounce.pm
index f753afe..82a5c28 100644
--- a/lib/WebGUI/Mailing/Bounce.pm
+++ b/lib/WebGUI/Mailing/Bounce.pm
@@ -5,6 +5,17 @@ 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;
diff --git a/lib/WebGUI/Mailing/Email.pm b/lib/WebGUI/Mailing/Email.pm
index c5239ad..1b73a74 100644
--- a/lib/WebGUI/Mailing/Email.pm
+++ b/lib/WebGUI/Mailing/Email.pm
@@ -163,6 +163,18 @@ sub send {
         return;
     }
 
+    # Check bounce score
+    my $bounceScoreOk = WebGUI::Mailing::Bounce->new( $session )->bounceScoreOk( $to );
+    if ( !$self->get( 'isTest' ) && !$bounceScoreOk ) {
+        $self->update( { 
+            status          => 'skipped',
+            sendDate        => time,
+            errorMessage    => "Bounce score for $to too high",
+        } );
+
+        return;
+    }
+
     # Fetch subject
     my $subject   = $asset->getSubject( $configuration );
 
diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl
index 4a4cded..798cf7c 100644
--- a/sbin/install_newsletter.pl
+++ b/sbin/install_newsletter.pl
@@ -111,7 +111,8 @@ sub installNewsletterSettings {
     
     print "\tInstalling newsletter setting slots...";
 
-    $setting->add( 'newsletterReturnDomain', undef ) unless $setting->has( 'newsletterReturnDomain' );
+    $setting->add( 'newsletterReturnDomain', undef  ) unless $setting->has( 'newsletterReturnDomain'      );
+    $setting->add( 'newsletterBounceScoreThreshold', 0    ) unless $setting->has( 'newsletterBounceScoreThreshold'    );
 
     print "Done.\n";
 }