moved honeypot check to www_processSubscription

<tmpl_var subscriptionForm_form>
<tmpl_var form_honeypot>
<tmpl_var form_honeypot_id>

It's used by default now.

docs/mail_commands_setup.pod

@@ -0,0 +1,101 @@
+=head1 Configuring WebGUI mail commands
+
+This document discusses the steps required to tie WebGUI mal command into
+postfix.
+
+=head2 Setting up WebGUI
+
+The mappings between To adress in the incoming emails and WebGUI instances is
+defined in /data/WebGUI/etc/mailing_dispatch.config. This is a JSON file
+containing a hash with domain to instance config file mappings:
+
+    {
+        "mailing.domain1.com" : "www_domain1_com.conf",
+        "newsletter.foo.com"  : "www_foo_com.conf"
+    }
+
+Note that any domain can be tied to any config file: domains don't have to
+match. The only requirement is that the server can receive mail on the given
+domain. Eg. the following is a valid mapping
+
+    {
+        "newsletter.bar.com"  : "www_xyzzy_com.conf"
+    }
+
+It is also possible to map multiple domains to a single config file, eg.
+
+    {
+        "mailing.example.com" : "example_com.conf",
+        "mailing.foobar.org"  : "example_com.conf"
+    }
+
+However it is not allowed to map a single domain to multiple config files. If
+you do the instance that is used, is not defined. Eg. the following is NOT
+allowed.
+
+    {
+        "mailing.example.com" : "example_com.conf",
+        "mailing.example.com" : "foobar_org.conf"
+    }
+
+
+=head2 Setting up Postfix
+
+The newsletter-transport.pl script in the webgui_newsletter sbin directory
+acts as a bridge between postfix and WebGUI. It is intended to be invoked
+by postfix's pipe command.
+
+=head3 Configuring master.cf
+
+We need a  queue that processes mail intended for WebGUI. To do so add the
+following to /etc/postfix/master.cf:
+
+    wgml      unix  -       n       n       -       -       pipe
+        flags=FR user=webgui argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl \
+        --domain=${domain} --user=${user} --sender=${sender} --senderIp=${client_address}
+
+This creates a queue called wgml that pipes all mail in it through the
+newsletter-transport.pl script. Make sure that the user parameter is set correctly and argv
+contains the full path to the newsletter-transport.pl script.
+
+
+=head3 Setup a transport map
+
+In order to determine which emails should go to the wgml queue, create a
+mapping in /etc/postfix/wg_mailer_transport. There are more ways to do this.
+
+If you use a dedicated maildomain used solely for receiving WebGUI mail
+commands add a line like the following for each mail domain in your
+/date/WebGUI/etc/mailing_dispatch.config:
+
+    /@mailing.foo.com$/             wgml:
+    /@newsletter.example.com$/      wgml:
+
+If you use a domain that is not solely dedicated to receiving WebGUI mail
+commands, you can match on individual commands:
+
+    /^[a-zA-Z0-9_-]+-bounce@/         wgml:
+    /^[a-zA-Z0-9_-]+-subscribe@/      wgml:
+
+
+Afterwards complile the mapping into a postfix lookup table
+
+    postmap /etc/postfix/wg_mailer_transport
+
+You have to do this everytime you change the mapping.
+
+=head3 Configuring main.cf
+
+Now we need to tell postfix to use the mapping, and how to use the wgml
+queue. To do this add the following to /etc/postfix/main.cf: 
+
+    smtpd_reject_unlisted_recipient = no
+    transport_maps = regexp:/etc/postfix/wg_mailer_transport
+    wgml_destination_recipient_limit = 1
+
+Make sure you add the domains in your mailing_dispatch.config to the
+mydestination directlive in main.cf:
+
+    mydestination = mailing.foo.com, newsletter.example.org, some.other.domain
+
+Finally restart postfix.

docs/postfix_configuration

@@ -1,17 +0,0 @@
-Add to /etc/postfix/main.cf:
-    smtpd_reject_unlisted_recipient = no
-    transport_maps = regexp:/etc/postfix/wg_mailer_transport
-    wgml_destination_recipient_limit = 1
-
-Add to /etc/postfix/master.cf:
-    wgml      unix  -       n       n       -       -       pipe
-        flags=FR user=martin argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl ${domain} ${user}
-
-
-Create /etc/postfix/wg_mailer_transport:
-    /^[a-zA-Z0-9]+-bounce@/         wgml:
-
-And run:
-    postmap /etc/postfix/wg_mailer_transport
-
-Finally restart postfix.

docs/required_modules

@@ -1,3 +1,3 @@
-Mail::DeliveryStatus::BounceParser
-Class::InsideOut
+Mail::DeliveryStatus::BounceParser (v 1.525)
+Class::InsideOut (v 1.10)
 

lib/WebGUI/Asset/Wobject/NewsletterCollection.pm

@@ -8,7 +8,7 @@ use Class::C3;
 use WebGUI::User::SpecialState;
 
 use base qw{
-    WebGUI::AssetAspect::Mailable 
+    WebGUI::AssetAspect::Mailable
     WebGUI::AssetAspect::Subscriber
     WebGUI::Asset::Wobject
 };
@@ -34,8 +34,15 @@ sub definition {
             tab             => 'display',
             defaultValue    => 1,
         },
+        useHoneypot => {
+            fieldType       => 'yesNo',
+            label           => $i18n->get('useHoneypot label'),
+            hoverHelp       => $i18n->get('useHoneypot description'),
+            tab             => 'security',
+            defaultValue    => 1,
+        },
     );
-    
+
     push @{ $definition }, {
         assetName         => $i18n->get('assetName'),
         icon              => 'newsletter_collection.gif',
@@ -52,12 +59,16 @@ sub definition {
 sub getIssues {
     my $self    = shift;
 
-    my $issues  = $self->getLineage( [ 'children' ], {
-        returnObjects   => 1,
-        orderByClause   => 'lineage desc',
-    } );
-    
-    return $issues;
+    # Caching of instanciated assets is not for speed, but is requied since prepareView is called on them, and we
+    # need them again in that state in getViewVars.
+    unless ( $self->{ _issues } ) {
+        $self->{ _issues } = $self->getLineage( [ 'children' ], {
+            returnObjects   => 1,
+            orderByClause   => 'lineage desc',
+        } );
+    }
+
+    return $self->{ _issues };
 }
 
 #----------------------------------------------------------------------------
@@ -88,7 +99,8 @@ sub getAssetContent {
     my $self    = shift;
     my $asset   = shift;
 
-    $asset->prepareView;
+    # Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being
+    # written to body.
     my $content = $asset->view;
 
     return $content;
@@ -106,6 +118,11 @@ sub prepareView {
 
     $self->{ _viewTemplate } = $template;
 
+    # Call prepareview on issues here, to prevent head tags ending up in the body.
+    foreach my $issue ( @{ $self->getIssues } ) {
+        $issue->prepareView;
+    }
+
     return;
 }
 
@@ -126,11 +143,11 @@ sub getViewVars {
     foreach my $issue ( @{ $issues } ) {
         my $issueVar = $issue->get;
         $issueVar->{ url } = $issue->getUrl;
-        
-        my $isRecent =
-               ( !$displayIssueId && $recentCount < $maxRecent  )
-            || ( $issue->getId eq $displayIssueId               )
-            ;
+
+        my $isRecent = defined $displayIssueId
+                     ? $issue->getId eq $displayIssueId
+                     : $recentCount < $maxRecent
+                     ;
 
         if ( $isRecent ) {
             $issueVar->{ content    } = $self->getAssetContent( $issue );
@@ -157,7 +174,7 @@ sub view {
     my $self    = shift;
     my $form    = $self->session->form;
 
-    my $var     = $self->getViewVars( { 
+    my $var     = $self->getViewVars( {
         displayIssue => $form->guid('displayIssue'),
     } );
 
@@ -165,4 +182,3 @@ sub view {
 }
 
 1;
-

lib/WebGUI/AssetAspect/Mailable.pm

@@ -2,7 +2,7 @@ package WebGUI::AssetAspect::Mailable;
 
 use strict;
 use warnings;
-use Class::C3; 
+use Class::C3;
 
 use WebGUI::Macro;
 use Tie::IxHash;
@@ -115,13 +115,15 @@ sub processContentAsUser {
     $session->user( { userId => $userId } );
     $session->log->preventDebugOutput;
 
-    my $styleTemplateId = 
-           $configuration->{ styleTemplateId } 
-        || $self->get('mailStyleTemplateId') 
+    my $styleTemplateId =
+           $configuration->{ styleTemplateId }
+        || $self->get('mailStyleTemplateId')
         || $self->get('styleTemplateId');
 
+    $session->stow->set( 'mailing_rendering' => 1 );
+
     # Generate email body for this user
-    my $content = $session->style->process(   
+    my $content = $session->style->process(
         $self->generateEmailContent( $issueId, $configuration ),
         $styleTemplateId,
     );
@@ -129,10 +131,13 @@ sub processContentAsUser {
     # Process macros
     WebGUI::Macro::process( $session, \$content );
 
+    $session->stow->delete( 'mailing_rendering' );
+
     # Become ourselves again.
     $session->user( { userId => $currentUser->getId } );
     $var->switchAdminOn if $adminOn;
 
+
     return $content;
 }
 

lib/WebGUI/AssetAspect/Subscriber.pm

@@ -2,11 +2,19 @@ package WebGUI::AssetAspect::Subscriber;
 
 use strict;
 use warnings;
-use Class::C3; 
+use 5.010;
+use Class::C3;
 use Carp;
 
 use WebGUI::Asset::Template;
 use WebGUI::Macro;
+use WebGUI::Mail::Send;
+use WebGUI::Group;
+use WebGUI::Asset;
+use WebGUI::Form;
+use WebGUI::Form::Honeypot;
+use WebGUI::User::SpecialState;
+use WebGUI::International;
 use Tie::IxHash;
 use URI;
 
@@ -18,6 +26,11 @@ sub definition {
 	my $i18n        = WebGUI::International->new( $session,'AssetAspect_Subscriber' );
 
 	tie my %properties, 'Tie::IxHash', (
+        listName                    => {
+            fieldType       => 'text',
+            label           => $i18n->echo("List name"),
+            tab             => 'subscription',
+        },
         subscriptionGroupId         => {
             fieldType       => 'subscriptionGroup',
             label           => $i18n->get( 'Subscription group' ),
@@ -33,7 +46,7 @@ sub definition {
         alwaysConfirmSubscription   => {
             fieldType       => 'yesNo',
             defaultValue    => 0,
-            label           => $i18n->get( 'require confirmation' ), 
+            label           => $i18n->get( 'require confirmation' ),
             tab             => 'subscription',
         },
         allowAnonymousSubscription  => {
@@ -75,6 +88,13 @@ sub definition {
             namespace       => 'Subscriber/NoMutationEmail',
             tab             => 'subscription',
         },
+        confirmMutationTemplateId   => {
+            fieldType       => 'template',
+            defaultValue    => 'WUk-wEhGiF8dcEogrJfrfg',
+            label           => $i18n->get( 'confirm mutation template' ),
+            namespace       => 'Subscriber/MutationConfirmation',
+            tab             => 'subscription',
+        }
 	);
 
 	push( @{ $definition }, {
@@ -116,7 +136,7 @@ sub getListHeaders {
     my $site    = $self->session->url->getSiteURL;
 
     my $headers = {
-        'List-Unsubscribe'  => 
+        'List-Unsubscribe'  =>
             '<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>',
         'List-Subscribe'    =>
             '<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>',
@@ -173,6 +193,44 @@ sub isSubscribed {
 }
 
 #----------------------------------------------------------------------------
+=head2 appendSubscriptionFormVars
+
+=head3 honeyPot
+Part of the form vars are the honeyPot variables. This is a form plugin that
+is used in NewsletterCollection.pm to activate the use of a honeypot or not,
+in this module, AssetAspect/Subscriber.pm, to check the honeypot and to
+display the form values and in i18n.
+
+There are the following form vars:
+
+=head4 subscriptionForm_emailBox
+This renders both the emailbox, subscribe/unsubscribe radio buttons and the
+honeypot form inputs:
+    <input id="email_formId" name="email" value="" size="30" maxlength="255" type="text">
+    <fieldset style="border:none;margin:0;padding:0">
+        <label>
+            <input name="action" value="subscribe" id="action1" type="radio">Inschrijven
+        </label>
+        <label>
+            <input name="action" value="unsubscribe" id="action2" type="radio">Uitschrijven
+        </label>
+    </fieldset>
+    <input name="hp_timestamp" value="1540249684" type="hidden">
+    <input id="d28a72b5e1a47804be42367afaf56b4d_hp" class="honeypot" name="hp_surname" value="" size="30" maxlength="255" type="text">
+
+You can easily make the honeypot input field invisible with some css for
+class honeypot.
+
+=head4 form_honeypot
+Renders these fields:
+    <input name="hp_timestamp" value="1540249684" type="hidden">
+    <input id="d28a72b5e1a47804be42367afaf56b4d_hp" class="honeypot" name="hp_surname" value="" size="30" maxlength="255" type="text">
+
+=head4 form_honeypot_id
+Gives you the id for the honeypot input. This makes it easy to create a label:
+
+
+=cut
 sub appendSubscriptionFormVars {
     my $self    = shift;
     my $var     = shift || {};
@@ -180,16 +238,41 @@ sub appendSubscriptionFormVars {
     my $i18n    = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
 
     # Setup form controls
-    my $formHeader = 
+    my $formHeader =
         WebGUI::Form::formHeader( $session, { action => $self->getUrl } )
         . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } )
         ;
-    my $subscribeButton = 
-        sprintf '<button type="submit" name="action" value="subscribe">%s</button>', $i18n->get('subscribe');
-    my $unsubscribeButton = 
-        sprintf '<button type="submit" name="action" value="unsubscribe">%s</button>', $i18n->get('unsubscribe');
-    my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } );
     my $formFooter = WebGUI::Form::formFooter( $session );
+    my $subscribeButton =
+        $formHeader
+        . WebGUI::Form::hidden( $session, { name => 'action', value => 'subscribe' } )
+        . WebGUI::Form::submit( $session, { value => $i18n->get('subscribe') } )
+        . $formFooter
+        ;
+    my $unsubscribeButton =
+        $formHeader
+        . WebGUI::Form::hidden( $session, { name => 'action', value => 'unsubscribe' } )
+        . WebGUI::Form::submit( $session, { value => $i18n->get('unsubscribe') } )
+        . $formFooter
+        ;
+    # honeypot is connected to the emailbox, that is displayed on anonymous subscription
+    # and only if set to useHoneyPot in definition/display
+    my $honeypot = WebGUI::Form::Honeypot->new( $self->session, { name => 'hp' } );
+    my $honeypot_form = $self->get('useHoneypot') ? $honeypot->toHtml : '';
+    my $emailBox =
+        $formHeader
+        . WebGUI::Form::email( $session, { name => 'email', value => '' } )
+        . WebGUI::Form::radioList( $session, {
+            name    => 'action',
+            options => {
+                subscribe   => $i18n->get('subscribe'),
+                unsubscribe => $i18n->get('unsubscribe'),
+            }
+        } )
+        . $honeypot_form
+        . WebGUI::Form::submit( $session )
+        . $formFooter
+        ;
 
     # Compose default subscription form for current user
     my $form = '';
@@ -198,19 +281,21 @@ sub appendSubscriptionFormVars {
         $form .= $unsubscribeButton   if $self->canUnsubscribe;
     }
     elsif ( $self->get('allowAnonymousSubscription') ) {
-        $form = $emailBox . $subscribeButton . $unsubscribeButton;
+        $form = $emailBox;
     }
 
     # Setup tmpl_vars
-    $var->{ subscriptionForm_form               } = "$formHeader $form $formFooter" if $form;
+    $var->{ subscriptionForm_form               } = $form if $form;
     $var->{ subscriptionForm_header             } = $formHeader;
     $var->{ subscriptionForm_footer             } = $formFooter;
     $var->{ subscriptionForm_subscribeButton    } = $subscribeButton;
     $var->{ subscriptionForm_unsubscribeButton  } = $unsubscribeButton;
-    $var->{ subscrittionForm_emailBox           } = $emailBox;
+    $var->{ subscriptionForm_emailBox           } = $emailBox;
     $var->{ user_canSubscribe                   } = $self->canSubscribe;
     $var->{ user_canUnsubscribe                 } = $self->canUnsubscribe;
     $var->{ user_isRegistered                   } = $session->user->isRegistered;
+    $var->{ form_honeypot                       } = $honeypot->toHtml;
+    $var->{ form_honeypot_id                    } = $honeypot->get('id');
 
     return $var;
 }
@@ -219,8 +304,8 @@ sub appendSubscriptionFormVars {
 sub getSubscriptionGroup {
     my $self    = shift;
     my $groupId = $self->get( "subscriptionGroupId" );
-    my $group   = $groupId 
-                ? WebGUI::Group->new( $self->session, $groupId ) 
+    my $group   = $groupId
+                ? WebGUI::Group->new( $self->session, $groupId )
                 : $self->createSubscriptionGroup
                 ;
 
@@ -231,7 +316,7 @@ sub getSubscriptionGroup {
 sub getReturnUrl {
     my $self    = shift;
     my $referer = $self->session->env->get('HTTP_REFERER');
-    
+
     return unless $referer;
 
     # Get path and strip leading and trailing slash if it exists.
@@ -263,6 +348,45 @@ sub getEmailVars {
     return $var;
 }
 
+#----------------------------------------------------------------------------
+sub getAssetByListName {
+    my $class       = shift;
+    my $session     = shift;
+    my $listName    = shift || return;
+    my $db          = $session->db;
+
+    my $assetId = $db->quickScalar( 'select assetId from assetAspectSubscriber where listName=? limit 1', [
+        $listName
+    ] );
+
+    return unless $assetId;
+
+    my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
+
+    return $asset;
+}
+
+#----------------------------------------------------------------------------
+sub processPropertiesFromFormPost {
+    my $self    = shift;
+    my $session = $self->session;
+    my $form    = $session->form;
+
+    my $listName    = $form->get('listName');
+    my $asset       = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
+
+    my $errors      = $self->next::method;
+
+    if ( $asset && $asset->getId ne $self->getId ) {
+        return [
+            @{ $errors || [] },
+            "List name $listName is already taken."
+        ];
+    }
+
+    return $errors;
+}
+
 #----------------------------------------------------------------------------
 sub sendSubscriptionConfirmation {
     my $self    = shift;
@@ -271,7 +395,13 @@ sub sendSubscriptionConfirmation {
     my $action  = shift || 'subscribe';
     my $session = $self->session;
     my $i18n    = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
-
+=pod
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+=cut
     my $var     = $self->getEmailVars( $user );
     my $url     = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" );
 
@@ -280,14 +410,18 @@ sub sendSubscriptionConfirmation {
     $var->{ actionIsSubscribe   } = $action eq 'subscribe';
 
     my $mail = WebGUI::Mail::Send->create( $self->session, {
-        to      => $user->get('email'),
-        subject => $self->get('confirmationEmailSubject'),
+        to          => $user->get('email'),
+        subject     => $self->get('confirmationEmailSubject'),
+        contentType => 'multipart/alternative',
     } );
 
     my $templateId  = $self->get('confirmationEmailTemplateId');
     my $template    = WebGUI::Asset::Template->new( $session, $templateId );
     if ( $template ) {
-        $mail->addHtml( $template->process( $var ) );
+        my $content = $template->process( $var );
+
+        $mail->addHtml( $content );
+        $mail->addText( $self->transformToText( $content ) );
     }
     else {
         $session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" );
@@ -306,19 +440,29 @@ sub sendNoMutationEmail {
     my $action  = shift || 'subscribe';
     my $session = $self->session;
     my $i18n    = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
-
+=pod
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+=cut
     my $var     = $self->getEmailVars( $user );
     $var->{ actionIsSubscribe   } = $action eq 'subscribe';
 
     my $mail = WebGUI::Mail::Send->create( $self->session, {
-        to      => $user->get('email'),
-        subject => $self->get('noMutationEmailSubject'),
+        to          => $user->get('email'),
+        subject     => $self->get('noMutationEmailSubject'),
+        contentType => 'multipart/alternative',
     } );
 
     my $templateId  = $self->get('noMutationEmailTemplateId');
     my $template    = WebGUI::Asset::Template->new( $session, $templateId );
     if ( $template ) {
-        $mail->addHtml( $template->process( $var ) );
+        my $content = $template->process( $var );
+
+        $mail->addHtml( $content );
+        $mail->addText( $self->transformToText( $content ) );
     }
     else {
         $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" );
@@ -332,6 +476,18 @@ sub sendNoMutationEmail {
     return;
 }
 
+sub transformToText {
+    my $self    = shift;
+    my $html    = shift;
+
+    my $text = $html;
+    #HTML::Entities::decode($text);
+    $text =~ s/<a.*?href=["'](.*?)['"].*?>(.+?)<\/a>/$2 ($1)/g;
+    $text = WebGUI::HTML::html2text($text);
+
+    return $text;
+}
+
 #----------------------------------------------------------------------------
 sub logConfirmation {
     my $self    = shift;
@@ -339,7 +495,7 @@ sub logConfirmation {
     my $session = $self->session;
     my $db      = $session->db;
 
-    $db->write( 
+    $db->write(
          ' update assetAspectSubscriber_log set '
         .' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?',
         [
@@ -363,7 +519,7 @@ sub logRequest {
     my $session = $self->session;
     my $db      = $session->db;
 
-    $db->write( 
+    $db->write(
             ' insert into assetAspectSubscriber_log set '
         .' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?',
         [
@@ -389,6 +545,7 @@ sub subscribe {
     my $requireConfirm  = shift // $self->get('alwaysConfirmSubscription');
     my $session         = $self->session;
 
+
     if ( $requireConfirm ) {
         if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) {
             $self->sendNoMutationEmail( $user, 'subscribe' );
@@ -414,7 +571,7 @@ sub unsubscribe {
     my $self    = shift;
     my $user    = shift || $self->session->user;
     my $requireConfirm  = shift // $self->get('alwaysConfirmSubscription');
-    
+
     my $session         = $self->session;
 
     if ( $requireConfirm ) {
@@ -447,29 +604,72 @@ sub www_confirmMutation {
     my $code    = $form->get('code');
     return unless $code;
 
-    my ($userId, $type) = $db->quickArray( 
-        'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', 
+    my ($userId, $type) = $db->quickArray(
+        'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?',
         [
             0,
             $code,
         ]
     );
 
+    my $var = {
+        message     => $i18n->get( 'wrong code' ),
+        returnUrl   => $self->getUrl,
+        isSuccess   => 0,
+        "is$type"   => 1,
+    };
     if ( $userId ) {
         $self->logConfirmation( $code );
 
         if ( $type eq 'subscribe' ) {
             $self->getSubscriptionGroup->addUsers( [ $userId ] );
-            return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl );
+
+            $var->{ message     } = sprintf $i18n->get( 'subscription successful'), $self->getUrl;
+            $var->{ isSuccess   } = 1;
         }
         elsif ( $type eq 'unsubscribe' ) {
             $self->getSubscriptionGroup->deleteUsers( [ $userId ] );
-            return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl );
+
+            $var->{ message     } = sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl;
+            $var->{ isSuccess   } = 1;
         }
     }
 
-    return $self->processStyle( $i18n->get( 'wrong code' ) );
+    return $self->processStyle( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) );
+}
 
+#----------------------------------------------------------------------------
+sub subscribeAnonymous {
+    my $self    = shift;
+    my $email   = shift; # TODO || return ?
+    my $session = $self->session;
+
+    my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
+
+    # If email address doesn't have an account, create one.
+    if ( !defined $emailUser ) {
+        $emailUser = WebGUI::User::SpecialState->create( $session );
+        $emailUser->update( { email => $email } );
+    }
+    $emailUser->addSpecialState( 'Subscriber', $self->getId );
+
+    $self->subscribe( $emailUser, 1 );
+
+    return;
+}
+
+#----------------------------------------------------------------------------
+sub unsubscribeAnonymous {
+    my $self    = shift;
+    my $email   = shift;
+    my $session = $self->session;
+
+    my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
+    if ( defined $emailUser ) {
+        $self->unsubscribe( $emailUser, 1 );
+    }
+
+    return;
 }
 
 #----------------------------------------------------------------------------
@@ -482,6 +682,12 @@ sub www_processSubscription {
     my $action  = $form->get( 'action' );
     return unless $action eq 'subscribe' || $action eq 'unsubscribe';
 
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+
     if ( $session->user->isRegistered ) {
         if ( $action eq 'subscribe' && $self->canSubscribe ) {
             $self->subscribe;
@@ -496,18 +702,9 @@ sub www_processSubscription {
         my $email     = $form->email( 'email' );
         return 'Error: no email address passed' unless $email;
 
-        my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
-        if ( $action eq 'unsubscribe' && defined $emailUser ) {
-            $self->unsubscribe( $emailUser, 1 );
-        }
-        if ( $action eq 'subscribe' ) {
-            if ( !defined $emailUser ) {
-                $emailUser = WebGUI::User::SpecialState->create( $session );
-                $emailUser->update( { email => $email } );
-            }
-            $emailUser->addSpecialState( 'Subscriber', $self->getId );
-
-            $self->subscribe( $emailUser, 1 );
+        given ( $action ) {
+            when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); }
+            when ( 'subscribe'   ) { $self->subscribeAnonymous( $email );   }
         }
     }
     else {
@@ -545,4 +742,3 @@ sub www_unsubscribe {
 }
 
 1;
-

lib/WebGUI/MailCommand.pm

@@ -0,0 +1,56 @@
+package WebGUI::MailCommand;
+
+use strict;
+use warnings;
+
+sub isValidCommand {
+    my $command = shift;
+
+    return defined resolveCommandClass( $command );
+}
+
+sub new {
+    my $class = shift;
+    my $session = shift || die "Need a session";
+
+    bless { _session => $session }, $class;
+}
+
+sub process {
+    WebGUI::Error::OverrideMe->throw;
+}
+
+sub processCommand {
+    my $session     = shift;
+    my $command     = shift;
+    my $parameter   = shift;
+    my $sender      = shift;
+
+    my $commandClass = resolveCommandClass( $command )
+        || return;
+
+    my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] );
+
+    return $commandObject->process( $parameter, $sender );
+}
+
+sub session {
+    return (shift)->{ _session };
+}
+
+sub resolveCommandClass {
+    my $command = shift;
+
+    # TODO: Do not hard code.
+    my %commands = (
+        unsubscribe => 'WebGUI::MailCommand::Unsubscribe',
+        subscribe   => 'WebGUI::MailCommand::Subscribe',
+        bounce      => 'WebGUI::MailCommand::Bounce',
+    );
+
+    return $commands{ $command } if exists $commands{ $command };
+    return;
+}
+
+1;
+

lib/WebGUI/MailCommand/Bounce.pm

@@ -0,0 +1,40 @@
+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;
+

lib/WebGUI/MailCommand/Subscribe.pm

@@ -0,0 +1,28 @@
+package WebGUI::MailCommand::Subscribe;
+
+use strict;
+use warnings;
+
+use WebGUI::AssetAspect::Subscriber;
+
+use base 'WebGUI::MailCommand';
+
+#-----------------------------------------------------------------------------
+sub process {
+    my $self        = shift;
+    my $listName    = shift;
+    my $fromAddress = shift;
+    my $session     = $self->session;
+    my $log         = $session->log;
+
+    my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
+
+    die "Invalid list name [$listName]" unless $asset;
+
+    $asset->subscribeAnonymous( $fromAddress );
+
+    return;
+}
+
+1;
+

lib/WebGUI/MailCommand/Unsubscribe.pm

@@ -0,0 +1,27 @@
+package WebGUI::MailCommand::Unsubscribe;
+
+use strict;
+use warnings;
+
+use WebGUI::AssetAspect::Subscriber;
+
+use base 'WebGUI::MailCommand';
+
+#-----------------------------------------------------------------------------
+sub process {
+    my $self        = shift;
+    my $listName    = shift;
+    my $fromAddress = shift;
+    my $session     = $self->session;
+
+    my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
+
+    die "Invalid list name [$listName]" unless $asset;
+
+    $asset->unsubscribeAnonymous( $fromAddress );
+
+    return;
+}
+
+1;
+

lib/WebGUI/Mailing.pm

@@ -40,7 +40,7 @@ sub cancel {
         );
     };
 
-    $self->update( { 
+    $self->update( {
         state       => 'idle',
         sendDate    => undef,
     } );
@@ -65,7 +65,7 @@ sub crud_definition {
         assetId         => {
             fieldType       => 'guid',
         },
-        
+
         issueId         => {
             fieldType       => 'guid',
         },
@@ -83,7 +83,7 @@ sub crud_definition {
         },
     );
 
-    $definition->{ properties } = { 
+    $definition->{ properties } = {
         %{ $definition->{ properties } || {} },
         %properties,
     };
@@ -94,7 +94,7 @@ sub crud_definition {
 #----------------------------------------------------------------------------
 sub delete {
     my $self = shift;
-    
+
     $self->deleteQueuedEmails;
 
     return $self->SUPER::delete;
@@ -103,12 +103,12 @@ sub delete {
 #----------------------------------------------------------------------------
 sub deleteQueuedEmails {
     my $self = shift;
-    
+
     my $it = $self->getQueuedEmailIterator;
     while ( my $email = $it->() ) {
         $email->delete;
     }
-    
+
     $it = $self->getQueuedTestEmailIterator;
     while ( my $email = $it->() ) {
         $email->delete;
@@ -180,8 +180,8 @@ sub getStatusLine {
     my $self    = shift;
     my $db      = $self->session->db;
 
-    my $sth = $db->read( 
-        'select status, isTest, count( status ) as cnt from Mailing_email where mailingId=? group by status,isTest', 
+    my $sth = $db->read(
+        'select status, isTest, count( status ) as cnt from Mailing_email where mailingId=? group by status,isTest',
         [
             $self->getId,
         ],
@@ -260,7 +260,7 @@ sub queue {
             $state,
         );
     };
-    
+
     $self->queueEmails( $self->getAsset->getRecipients );
 
     $self->update( {
@@ -285,7 +285,7 @@ sub queueEmails {
             recipientEmail  => undef,
             isTest          => 0,
         } );
-    
+
     }
 
     return;
@@ -334,7 +334,7 @@ sub send {
             $state,
         );
     };
-    
+
     $self->update( { state => 'sending' } );
     my $complete = $self->sendQueuedEmails( $timeLimit );
 
@@ -361,7 +361,7 @@ sub sendQueuedEmails {
 
         $email->send;
     }
-        
+
     return 1;
 }
 
@@ -380,7 +380,7 @@ sub www_cancel {
             $i18n->get('cancel mailing success'),
             $i18n->get('cancel mailing'),
         );
-    } 
+    }
     else {
         return $self->renderInConsole(
             $i18n->get('cancel mailing failure'),
@@ -415,13 +415,13 @@ sub www_delete {
 
 #----------------------------------------------------------------------------
 sub www_edit {
-    my $self    = shift;
-    my $session = $self->session;
-    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+    my $self        = shift;
+    my $session     = $self->session;
+    my $i18n        = WebGUI::International->new( $session, 'MailingManager' );
 
     return $session->privilege->insufficient unless $self->admin->canManage;
 
-    my $f = WebGUI::HTMLForm->new( $session );
+    my $f = $self->getEditForm;
     $f->hidden(
         name    => 'newsletter',
         value   => 'mailing',
@@ -435,6 +435,16 @@ sub www_edit {
         value   => $self->getId,
     );
 
+    return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
+}
+
+#----------------------------------------------------------------------------
+sub getEditForm {
+    my $self    = shift;
+    my $session = $self->session;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+    my $f       = WebGUI::HTMLForm->new( $session );
+
     my %fields          = %{ $self->getAsset->getMailingProperties( $self ) };
     my $configuration   = $self->get('configuration') || {};
     while ( my( $name, $properties ) = each %fields ) {
@@ -444,7 +454,7 @@ sub www_edit {
         my $formField   = WebGUI::Form::DynamicField->new( $session, %{ $properties } );
 	    my $element	    = $formField->toHtml;		# Works around a bug in WG::Form::Template in < 7.9.8
     	my $readonly	= $formField->getValueAsHtml;	# where getValueAsHtml wouldn't set the correct options hashref
-        
+
         my $html        = $self->admin->canOverride || $properties->{ managerCanEdit }
                         ? $element
                         : $readonly
@@ -458,12 +468,12 @@ sub www_edit {
 
     $f->submit( value => $i18n->get( 'generate mailing' ) );
     my $cancelUrl = $session->url->page( 'newsletter=manage' );
-    $f->button( 
+    $f->button(
         value   => $i18n->get( 'cancel' ),
         extras  => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
     );
 
-    return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
+    return $f;
 }
 
 #----------------------------------------------------------------------------
@@ -486,7 +496,7 @@ sub www_previewEmail {
     my $session         = $self->session;
     my ( $form, $url )  = $session->quick( 'form', 'url' );
     my $i18n            = WebGUI::International->new( $session, 'MailingManager' );
- 
+
     return $session->privilege->insufficient unless $self->admin->canManage;
 
     my $asset       = $self->getAsset;
@@ -494,7 +504,7 @@ sub www_previewEmail {
     my $manageUrl   = $url->page('newsletter=manage');
     my $subject     = $asset->getSubject( $self->get('configuration') );
 
-    my $userSelection   = 
+    my $userSelection   =
         qq{
         <p><a href="$manageUrl">Terug naar de mailing manager.</a></p>
         <label for="acElem">Kies een gebruiker:</label>
@@ -516,11 +526,11 @@ sub www_previewEmail {
         }
     </style>
 
-    <!-- Individual YUI CSS files --> 
-    <link rel="stylesheet" type="text/css" href="/extras/yui/build/autocomplete/assets/skins/sam/autocomplete.css"> 
-    <!-- Individual YUI JS files --> 
-    <script type="text/javascript" src="/extras/yui/build/yahoo-dom-event/yahoo-dom-event.js"></script> 
-    <script type="text/javascript" src="/extras/yui/build/datasource/datasource-min.js"></script> 
+    <!-- Individual YUI CSS files -->
+    <link rel="stylesheet" type="text/css" href="/extras/yui/build/autocomplete/assets/skins/sam/autocomplete.css">
+    <!-- Individual YUI JS files -->
+    <script type="text/javascript" src="/extras/yui/build/yahoo-dom-event/yahoo-dom-event.js"></script>
+    <script type="text/javascript" src="/extras/yui/build/datasource/datasource-min.js"></script>
     <script type="text/javascript" src="/extras/yui/build/autocomplete/autocomplete-min.js"></script>
     <script type="text/javascript">
         $js
@@ -544,8 +554,8 @@ sub getAutoCompleteJS {
     my $contentBase = $url->page( "newsletter=mailing;func=previewContent;id=".$self->getId );
 
     my $data = to_json( [
-        map     { { 
-                    id      => $_->getId, 
+        map     { {
+                    id      => $_->getId,
                     name    => $_->username . " (" . $_->get('email') . ")",
                 } }
         grep    { defined $_ }
@@ -594,7 +604,7 @@ sub www_editSave {
     return $session->privilege->insufficient unless $self->admin->canManage;
 
     my %fields          = %{ $self->getAsset->getMailingProperties( $self ) };
-    my $configuration   = {}; 
+    my $configuration   = {};
     while ( my( $name, $properties ) = each %fields ) {
         if ( $self->admin->canOverride || $properties->{ managerCanEdit } ) {
             my $value = $form->process( $name, $properties->{ fieldType }, $properties->{ defaultValue } );
@@ -605,7 +615,7 @@ sub www_editSave {
             $configuration->{ $name } = $properties->{ defaultValue } || $properties->{ value };
         }
     }
-    
+
     #### TODO: Add error checking and required fields?
     $self->update( { configuration => $configuration } );
 
@@ -644,7 +654,7 @@ sub www_sendBatch {
         extras  => qq{class="forwardButton"},
     );
     my $cancelUrl = $session->url->page( 'newsletter=manage' );
-    $f->button( 
+    $f->button(
         value   => $i18n->get( 'cancel' ),
         extras  => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
     );
@@ -687,13 +697,13 @@ sub www_sendBatchConfirm {
     my $scheduled = $form->dateTime( 'sendDate' );
 
     return $self->www_sendBatch unless $scheduled;
-    
+
     my $asset   = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
     croak "Cannot instaciate asset " . $self->get('assetId') unless $asset;
 
     $self->schedule( $scheduled );
 
-    return $self->renderInConsole( 
+    return $self->renderInConsole(
         sprintf( $i18n->get('schedule mailing success'),
             $session->datetime->epochToHuman( $scheduled ),
             $session->url->page('newsletter=manage'),
@@ -747,12 +757,12 @@ sub www_sendTestEmails {
         multiple=> 1,
         options => \%options,
     );
-    $f->submit( 
+    $f->submit(
         value   => $i18n->get('send test mails'),
         extras  => qq{class="forwardButton"},
     );
     my $cancelUrl = $session->url->page( 'newsletter=manage' );
-    $f->button( 
+    $f->button(
         value   => $i18n->get( 'cancel' ),
         extras  => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
     );
@@ -774,7 +784,7 @@ sub www_sendTestEmailsConfirm {
 
     $self->queueTestEmails( $to, \@userIds );
 
-    return $self->renderInConsole( 
+    return $self->renderInConsole(
         sprintf( $i18n->get('send test mail success'),
             scalar( @userIds ),
             $to,

lib/WebGUI/Mailing/Admin.pm

@@ -96,9 +96,10 @@ sub www_createMailing {
     my $self    = shift;
     my $session = $self->session;
     my $form    = $session->form;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
 
     return $session->privilege->insufficient unless $self->canManage;
-    
+
     my $assetId = $form->guid( 'assetId' );
     my $issueId = $form->guid( 'issueId' );
 
@@ -117,13 +118,70 @@ sub www_createMailing {
 
     # All ok, create mailing.
     require WebGUI::Mailing;
-    my $mailing = WebGUI::Mailing->create( $session, { 
-        assetId => $assetId, 
+    my $mailing = WebGUI::Mailing->create( $session, {
+        assetId => $assetId,
         issueId => $issueId,
         state   => 'idle',
     } );
 
-    return $mailing->www_edit;
+    my $f = $mailing->getEditForm;
+    $f->hidden(
+        name    => 'newsletter',
+        value   => 'manage',
+    );
+    $f->hidden(
+        name    => 'func',
+        value   => 'createMailingSave',
+    );
+    $f->hidden(
+        name    => 'assetId',
+        value   => $assetId,
+    );
+    $f->hidden(
+        name    => 'issueId',
+        value   => $issueId,
+    );
+
+    my $output = $mailing->renderInConsole( $f->print, $i18n->get('configure mailing') );
+    $mailing->delete;
+
+    return $output;
+}
+
+#----------------------------------------------------------------------------
+sub www_createMailingSave {
+    my $self    = shift;
+    my $session = $self->session;
+    my $form    = $session->form;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+
+    return $session->privilege->insufficient unless $self->canManage;
+
+    my $assetId = $form->guid( 'assetId' );
+    my $issueId = $form->guid( 'issueId' );
+
+    # Sanity check: does assetId exist?
+    my $asset   = WebGUI::Asset->newByDynamicClass( $session, $assetId )
+        || return "Error: Asset [$assetId] could not be instanciated";
+
+    # Sanity check: is asset mailable?
+    unless ( $asset->isa( 'WebGUI::AssetAspect::Mailable' ) ) {
+        return "Error: Asset [$assetId] is not Mailable";
+    }
+
+    # Sanity check: does issue exist?
+    my $issue   = WebGUI::Asset->newByDynamicClass( $session, $issueId )
+        || return "Error: issue [$issueId] for asset [$assetId] could not be instanciated.";
+
+    # All ok, create mailing.
+    require WebGUI::Mailing;
+    my $mailing = WebGUI::Mailing->create( $session, {
+        assetId => $assetId,
+        issueId => $issueId,
+        state   => 'idle',
+    } );
+
+    return $mailing->www_editSave;
 }
 
 #----------------------------------------------------------------------------
@@ -193,7 +251,7 @@ sub www_settingsSave {
     my $session = $self->session;
 
     return $session->privilege->insufficient unless $self->isAdmin;
-     
+
     my ($setting, $form) = $session->quick( 'setting', 'form' );
 
     $setting->set( 'newsletterReturnDomain',            $form->get('newsletterReturnDomain')                );
@@ -215,7 +273,7 @@ sub www_view {
     my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
 
     return $session->privilege->insufficient unless $self->canManage;
-    
+
     return $self->www_settings unless $self->configurationComplete;
 
     my $mailableAssets = $self->getMailables;
@@ -235,14 +293,14 @@ sub www_view {
                 push @mailings, $mailing->getViewVars;
             };
 
-            push @issues, { 
+            push @issues, {
                 %{ $issue->get },
                 url                 => $issue->getUrl,
                 createMailingUrl    => $url->page("newsletter=manage;func=createMailing;assetId=$assetId;issueId=$issueId"),
                 editUrl             => $issue->getUrl( 'func=edit' ),
                 mailing_loop        => \@mailings,
             };
-        } 
+        }
 
         push @newsletterLoop, {
             %{ $asset->get },

lib/WebGUI/Mailing/Bounce.pm

@@ -57,18 +57,106 @@ sub session {
 sub www_bounceReport {
     my $self    = shift;
     my $session = $self->session;
+    my $db      = $session->db;
     my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
-    my $sth = $session->db->read( 'select distinct sentTo from Mailing_email where sentTo is not null' );
-    
-    my $output = '<table><tr><th>'.$i18n->get('email').'</th><th>'.$i18n->get('bounce score').'</th></tr>';
-    while ( my ($email) = $sth->array ) {
-        my $score = $self->getBounceScore( $email );
-        $output .= "<tr><td>$email</td><td>$score</td></tr>";
+
+    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 = '<div class="yui-skin-sam"><div id="tableWrapper"><table id="bounceScoreTable"><thead><tr><th>'
+        . join( '</th><th>',
+            $i18n->get('email'),
+            $i18n->get('bounce score'),
+            $i18n->get('bounce reason'),
+            $i18n->get('bounce message')
+        )
+        . '</th></tr></thead><tbody>';
+    while ( my $values = $sth->arrayRef ) {
+        $output .= '<tr><td>'. join( '</td><td>', @$values ) . '</td></tr>';
     }
-    $output .= '</table>';
+    $output .= '</tbody></table></div></div>';
+
+    $self->addBounceScoreTableJS;
 
     return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, $i18n->get( 'bounce scores' ) );
 }
 
+sub addBounceScoreTableJS {
+    my $self    = shift;
+    my ($style, $url) = $self->session->quick( qw{ style url } );
+    my $i18n    = WebGUI::International->new( $self->session, 'MailingManager' );
+
+    my $emailLabel  = $i18n->get('email');
+    my $scoreLabel  = $i18n->get('bounce score');
+    my $reasonLabel = $i18n->get('bounce reason');
+    my $messageLabel= $i18n->get('bounce message');
+
+    my $js = <<EOJS;
+    <script type="text/javascript">
+    //<!--
+        YAHOO.util.Event.onDOMReady( function () {
+            var columnDefs = [
+                { key : "email",            label : "$emailLabel",      sortable : true },
+                { key : "bounceScore",      label : "$scoreLabel",      sortable : true },
+                { key : "bounceReason",     label : "$reasonLabel",     sortable : true },
+                { key : "bounceMessage",    label : "$messageLabel",    sortable : true }
+            ];
+
+            var ds              = new YAHOO.util.DataSource( YAHOO.util.Dom.get('bounceScoreTable') );
+            ds.responseType     = YAHOO.util.DataSource.TYPE_HTMLTABLE;
+            ds.responseSchema   = {
+                fields: [
+                    { key : 'email'                             },
+                    { key : 'bounceScore',  parser : 'number'   },
+                    { key : 'bounceReason'                      },
+                    { key : 'bounceMessage'                     }
+                ]
+            };
+
+            var dt = new YAHOO.widget.DataTable( 'tableWrapper', columnDefs, ds, {
+                sortedBy    : {
+                    key : 'bounceScore',
+                    dir : 'desc'
+                }
+            } );
+        } );
+    //-->
+    </script>
+EOJS
+
+    $style->setLink(   $url->extras('yui/build/datatable/assets/skins/sam/datatable.css'),  { type => 'text/css', rel => 'stylesheet' } );
+    $style->setScript( $url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'),        { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/element/element-min.js'),                    { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/datasource/datasource-min.js'),              { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/datatable/datatable-min.js'),                { type => 'text/javascript' } );
+    $style->setRawHeadTags( $js );
+
+    return;
+}
+
+
 1;
 

lib/WebGUI/Mailing/Email.pm

@@ -54,7 +54,7 @@ sub crud_definition {
         },
     );
 
-    $definition->{ properties } = { 
+    $definition->{ properties } = {
         %{ $definition->{ properties } || {} },
         %properties,
     };
@@ -128,20 +128,19 @@ sub absolutifyURIs {
     my $tb      = HTML::TreeBuilder->new;
     my $root    = $tb->parse( $content );
 
-    foreach my $link ( @{ $root->extract_links } ) { 
+    foreach my $link ( @{ $root->extract_links } ) {
         my ($uri, $element, $attr, $tag) = @{ $link };
-        
-        if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
-            my $new = 
+        if ( $uri !~ m{ ^ (?: [a-z]+:// | \# | mailto: ) }xmsi ) {
+            my $new =
                     ( $uri =~ m{ ^ / }xmsi )        # Is url absolute?
                     ? $siteUrl . $uri
                     : $siteUrl . $pageUrl . '/' . $uri
                     ;
-            
+
             # replace attribute
             $element->attr( $attr, $new );
         }
-    } 
+    }
 
     return $tb->as_HTML;
 }
@@ -167,7 +166,7 @@ sub send {
     #### TODO: Error checking
     my $mailing = $self->getMailing;
     unless ( $mailing ) {
-        $session->log->error( 'Cannot send because getMailing doesn\'t return one.' ); 
+        $session->log->error( 'Cannot send because getMailing doesn\'t return one.' );
         return;
     }
 
@@ -193,7 +192,7 @@ sub send {
     # Check bounce score
     my $bounceScoreOk = WebGUI::Mailing::Bounce->new( $session )->bounceScoreOk( $to );
     if ( !$self->get( 'isTest' ) && !$bounceScoreOk ) {
-        $self->update( { 
+        $self->update( {
             status          => 'skipped',
             sendDate        => time,
             errorMessage    => "Bounce score for $to too high",
@@ -228,14 +227,14 @@ sub send {
         }
     }
 
-    # And send it.  
+    # And send it.
     my $success = $mail->send;
 
     if ( $success ne '1' ) {
         $self->error( "Mail couldn't be sent by WebGUI::Mail::Send" );
     }
     else {
-        $self->update( { 
+        $self->update( {
             status      => 'sent',
             sendDate    => time,
             sentTo      => $to,

lib/WebGUI/Registration/Step/MailingSubscribe.pm

@@ -15,12 +15,15 @@ sub getAvailableMailings {
     my $self    = shift;
     my $session = $self->session;
 
-    my $availableMailings = WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
-        returnObjects   => 1,
-        isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
-    } );
+    my $mailingIds = $self->get( 'includeMailings' );
 
-    return $availableMailings;
+    my @mailings =
+        grep    { defined $_ }
+        map     { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
+                ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds
+        ;
+
+    return \@mailings;
 }
 
 #-------------------------------------------------------------------
@@ -31,7 +34,7 @@ sub apply {
     my $subscribeTo = {
         map { $_ => 1 } @{ $self->getConfigurationData->{ subscribeMailings } || [] }
     };
-    
+
     my $availableMailings = $self->getAvailableMailings;
 
     my $sendNotification = 0;
@@ -49,22 +52,32 @@ sub apply {
     return;
 }
 
-##-------------------------------------------------------------------
-#sub crud_definition {
-#    my $class       = shift;
-#    my $session     = shift;
-#    my $definition  = $class->SUPER::crud_definition( $session );
-#    my $i18n        = WebGUI::International->new( $session, 'Registration_Step_Homepage' );
-#
-#
-#    $definition->{ dynamic }->{ urlStorageField     } = {
-#        fieldType       => 'selectBox',
-#        label           => 'Store homepage url in field',
-#        options         => \%profileFields,
-#    };
-#
-#    return $definition;
-#}
+#-------------------------------------------------------------------
+sub crud_definition {
+    my $class       = shift;
+    my $session     = shift;
+    my $definition  = $class->SUPER::crud_definition( $session );
+    my $i18n        = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' );
+
+    tie my %mailings, 'Tie::IxHash', (
+        map { $_->getId => $_->getTitle }
+            @{
+                WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
+                    returnObjects   => 1,
+                    isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
+                } )
+            }
+    );
+
+    $definition->{ dynamic }->{ includeMailings } = {
+        fieldType       => 'checkList',
+        label           => $i18n->get('Include newsletters'),
+        options         => \%mailings,
+        vertical        => 1,
+    };
+
+    return $definition;
+}
 
 #-------------------------------------------------------------------
 sub getSummaryTemplateVars {
@@ -77,7 +90,7 @@ sub getSummaryTemplateVars {
     # Fetch preferred homepage url
     my $mailings = $self->getConfigurationData->{ subscribeMailings };
 
-    my @assets = 
+    my @assets =
         grep    { defined $_ }
         map     { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
                 @{ $mailings };
@@ -89,12 +102,12 @@ sub getSummaryTemplateVars {
 
     # Setup tmpl_var
     my $var = {
-        field_loop          => \@fields, 
+        field_loop          => \@fields,
         category_label      => $self->get('title'),
         category_edit_url   => $self->changeStepDataUrl,
     };
 
-    return ( $var );    
+    return ( $var );
 }
 
 #-------------------------------------------------------------------
@@ -119,7 +132,7 @@ sub getViewVars {
     }
     else {
         # The step hasn't been done yet.
-        @subscribeMailings = grep { $_->isSubscribed( $user ) } @{ $availableMailings };
+        @subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings };
     }
 
     # Create lookup table
@@ -171,10 +184,7 @@ sub updateFromFormPost {
     my $self    = shift;
     my $session = $self->session;
 
-    $self->SUPER::updateFromFormPost;
-
-#    $self->update( {
-#    } );
+    return $self->SUPER::updateFromFormPost;
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm

@@ -3,7 +3,7 @@ package WebGUI::i18n::Dutch::AssetAspect_Subscriber;
 use strict;
 
 our $I18N = {
-    'Subscription group' => { 
+    'Subscription group' => {
         message => 'Abonnee groep',
     },
     'Enable subscription' => {
@@ -24,7 +24,7 @@ our $I18N = {
     'confirmation email template' => {
         message => 'Verificatie email: sjabloon',
     },
-    'no mutation subject' => { 
+    'no mutation subject' => {
         message => 'Geen wijziging email: onderwerp',
     },
     'no mutation template' => {
@@ -52,16 +52,19 @@ our $I18N = {
     'anonnymous not allowed' => {
         message => 'Anonieme inschrijvingen zijn niet toegestaan. Log in om in- of uit te schrijven.',
     },
-    
+
     'subscription successful' => {
-        message => 'Uw inschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
+        message => 'Uw inschrijving is geslaagd.',
     },
     'unsubscription successful' => {
-        message => 'Uw uitschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
+        message => 'Uw uitschrijving is geslaagd.',
     },
     'wrong code' => {
         message => 'De verificatiecode in de link is onbekend, al gebruikt of verlopen. Als u zich wilt in- of uitschrijven probeer dit dan opnieuw of neem contact op met de websitebeheerders.',
     },
+    'confirm mutation template' => {
+        message => 'Mutatie bevestigings template',
+    },
 };
 
 1;

lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm

@@ -6,14 +6,26 @@ our $I18N = {
     assetName => {
         message => 'Nieuwsbrief collectie',
     },
+    'subscribe' => {
+        message => 'inschrijven',
+    },
+    'unsubscribe' => {
+        message => 'uitschrijven',
+    },
     'template' => {
         message => 'Sjabloon',
     },
     'number of recent issues' => {
-        message => 'Aantal recente uitgaven',
+        message => 'Aantal recente nieuwsbrieven',
     },
-    
+    'useHoneypot label' => {
+        message => q|Gebruik honeypot|,
+        lastUpdated => 0,
+    },
+    'useHoneypot description' => {
+        message => q|Gebruik honeypot om spam te voorkomen.|,
+        lastUpdated => 0,
+    },    
 };
 
 1;
-

lib/WebGUI/i18n/Dutch/MailingManager.pm

@@ -26,7 +26,7 @@ our $I18N = {
     'bounce score' => {
         message => 'Bounce score',
     },
-    
+
     'cannot cancel' => {
         message => 'Mailing \'%s\' kan niet worden afgebroken.',
     },
@@ -100,6 +100,14 @@ our $I18N = {
     'generate mailing' => {
         message => 'Genereer mailing',
     },
+
+    'bounce reason' => {
+        message => 'Laatste bounce oorzaak',
+    },
+
+    'bounce message' => {
+        message => 'Laatste bounce omschrijving',
+    },
 };
 
 1;

lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm

@@ -4,10 +4,13 @@ use strict;
 
 our $I18N = {
     'Subscribe to mailings' => {
-        message => 'Abonneren op nieuwsbrieven',
+        message => 'Ontvang deze nieuwsbrief',
     },
     'Subscribe to this mailing' => {
-        message => 'Abonneer op deze nieuwsbrief',
+        message => 'Ontvang deze nieuwsbrief',
+    },
+    'Include newsletters' => {
+        message => 'Selecteerbare nieuwsbrieven',
     },
 };
 

lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm

@@ -3,7 +3,7 @@ package WebGUI::i18n::English::AssetAspect_Subscriber;
 use strict;
 
 our $I18N = {
-    'Subscription group' => { 
+    'Subscription group' => {
         message => 'Subscription group',
     },
     'Enable subscription' => {
@@ -24,7 +24,7 @@ our $I18N = {
     'confirmation email template' => {
         message => 'Confirmation email template',
     },
-    'no mutation subject' => { 
+    'no mutation subject' => {
         message => 'No mutation email subject',
     },
     'no mutation template' => {
@@ -34,7 +34,6 @@ our $I18N = {
         message => 'Subscription',
     },
 
-
     'subscribe' => {
         message => 'Subscribe',
     },
@@ -52,17 +51,20 @@ our $I18N = {
     'anonnymous not allowed' => {
         message => 'Anonymous subscription is not allowed. Please log in to (un)subscribe',
     },
- 
+
     'subscription successful' => {
-        message => 'You are succesfully subscribed. <a href="%s">Back to site</a>',
+        message => 'You are succesfully subscribed.',
     },
     'unsubscription successful' => {
-        message => 'You are succesfully unsubscribed. <a href="%s">Back to site</a>',
+        message => 'You are succesfully unsubscribed.',
     },
     'wrong code' => {
         message => 'The verification code you supplied is either unknown, already used or expired. Please try again to (un)subscribe or contact the site administrators.',
     },
 
+    'confirm mutation template' => {
+        message => 'Mutation confirmation template',
+    },
 };
 
 1;

lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm

@@ -18,7 +18,14 @@ our $I18N = {
     'number of recent issues' => {
         message => 'Number of recent issues',
     },
-    
+    'useHoneypot label' => {
+        message => q|Use honeypot|,
+        lastUpdated => 0,
+    },
+    'useHoneypot description' => {
+        message => q|Use honeypot to verify humanity.|,
+        lastUpdated => 0,
+    },    
 };
 
 1;

lib/WebGUI/i18n/English/MailingManager.pm

@@ -26,7 +26,7 @@ our $I18N = {
     'bounce score' => {
         message => 'Bounce score',
     },
-    
+
     'error' => {
         message => 'An error occurred',
     },
@@ -100,6 +100,14 @@ our $I18N = {
     'generate mailing' => {
         message => 'Generate mailing',
     },
+
+    'bounce reason' => {
+        message => 'Latest bounce reason',
+    },
+
+    'bounce message' => {
+        message => 'Latest bounce message',
+    },
 };
 
 1;

lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm

@@ -9,6 +9,9 @@ our $I18N = {
     'Subscribe to this mailing' => {
         message => 'Subscribe to this mailing',
     },
+    'Include newsletters' => {
+        message => 'Include newsletters',
+    },
 };
 
 1;

sbin/importSpecialState.pl

@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 
 $|++; # disable output buffering
-our ($webguiRoot, $configFile, $state, $emailFile, $groupId );
+our ($webguiRoot, $configFile, $state, $emailFile, $groupId, $existingUsersGroupId );
 
 BEGIN {
     $webguiRoot = "..";
@@ -15,12 +15,16 @@ use WebGUI::Session;
 use WebGUI::User;
 use WebGUI::User::SpecialState;
 
+# Set default value
+$existingUsersGroupId = '';
+
 # Get parameters here, including $help
 GetOptions(
-    'configFile=s'  => \$configFile,
-    'groupId=s'     => \$groupId,
-    'state=s'       => \$state,
-    'emailFile=s'   => \$emailFile,
+    'configFile=s'  		=> \$configFile,
+    'groupId=s'     		=> \$groupId,
+    'existingUsersGroupId=s'	=> \$existingUsersGroupId,
+    'state=s'       		=> \$state,
+    'emailFile=s'   		=> \$emailFile,
 );
 
 my $session = start( $webguiRoot, $configFile );
@@ -40,18 +44,24 @@ while ( my $email = <$fh> ) {
     my $user = WebGUI::User->newByEmail( $session, $email );
     if ( $user ) {
         print "\tEmail already has account. Skipping.\n";
+	if ( $existingUsersGroupId ) {
+	    print "\tAdding user to group $existingUsersGroupId\n";
+	    $user->addToGroups( [ $existingUsersGroupId ] );
+	}
+	else {
+	    print "\tAdding user to group $groupId\n";
+	    $user->addToGroups( [ $groupId ] );
+	}
     }
     else {
         print "\tEmail has no account, creating special state $state.\n";
         $user = WebGUI::User::SpecialState->create( $session );
         $user->update( { email => $email } );
         $user->addSpecialState( $state );
+	print "\tAdding user to group $groupId\n";
+	$user->addToGroups( [ $groupId ] );
     }
 
-    print "\tAdding user to group $groupId\n";
-
-    $user->addToGroups( [ $groupId ] );
-
 }
 print "Done\n\n";
 
@@ -120,6 +130,22 @@ The WebGUI config file to use. Only the file name needs to be specified,
 since it will be looked up inside WebGUI's configuration directory.
 This parameter is required.
 
+=item B<--groupId>
+
+Add users to this group. If no existingUsersGroupId is given, all users, both new and existing users, are added to this group. If the --existingUsersGroupId is given, new users are added to this group, existing users are added to the existingUsersGroupId.
+
+=item B<--existingUsersGroupId>
+
+Add existing users to this group.
+
+=item B<--state>
+
+Set the so called specialState for this user. For all users disabeled accounts are created. SpecialState accounts can be transformed into regular accounts using the webgui_registration content handler. The special states are crm or Subscriber, for a user added via the crm or a newsletter subscription respectively. 
+
+=item B<--emailFile>
+
+A text file with an emailadress on every line. 
+
 =item B<--help>
 
 Shows a short summary and usage
@@ -132,7 +158,7 @@ Shows this document
 
 =head1 AUTHOR
 
-Copyright 2001-2009 Plain Black Corporation.
+Copyright 2010-2011 United Knowledge B.V.
 
 =cut
 

sbin/install_newsletter.pl

@@ -12,7 +12,7 @@ use strict;
 use Pod::Usage;
 use Getopt::Long;
 use WebGUI::Session;
-use List::MoreUtils qw{ insert_after_string };
+use List::MoreUtils qw{ insert_after_string none };
 
 # Get parameters here, including $help
 GetOptions(
@@ -32,10 +32,75 @@ addTemplateColumnToNewsletterCollection( $session );
 addRecentColumnToNewsletterCollection( $session );
 renamespaceTemplates( $session );
 addSpecialStateTable( $session );
+addListNameColumn( $session );
 addRegistrationSteps( $session );
+addConfirmationTemplateColumn( $session );
+addSentToIndex( $session );
+addUseHoneypotColumn( $session );
 
 finish($session);
 
+#-------------------------------------------------------------------------------
+sub addConfirmationTemplateColumn {
+    my $session = shift;
+    my $db      = $session->db;
+
+    print "\tAdding column for mutation confirmation template...";
+
+    my $hasColumn = $db->quickScalar( 'show columns from assetAspectSubscriber where Field = ?', [
+        'confirmMutationTemplateId',
+    ] );
+
+    unless ( $hasColumn ) {
+        $db->write(
+            'alter table assetAspectSubscriber add column confirmMutationTemplateId char(22) binary not null default ?',
+            [
+                'WUk-wEhGiF8dcEogrJfrfg',
+            ]
+        );
+
+        $db->write(
+            'update assetAspectSubscriber set confirmMutationTemplateId=? where confirmMutationTemplateId is null',
+            [
+                'WUk-wEhGiF8dcEogrJfrfg',
+            ]
+        );
+    }
+
+    print "Done.\n";
+}
+
+#----------------------------------------------------------------------------
+sub addSentToIndex {
+    my $session = shift;
+    my $db      = $session->db;
+
+    print "\tAdding index to column Mailing_email.sentTo...";
+
+    my @indexes = $db->buildArray('show indexes from Mailing_email where Column_name=?',['sentTo']);
+
+    if ( @indexes == 0 ) {
+        $db->write('alter table Mailing_email add index(sentTo)');
+    }
+
+    print "Done.\n";
+}
+
+#----------------------------------------------------------------------------
+sub addListNameColumn {
+    my $session = shift;
+    my $db      = $session->db;
+    print "\tAdding list name column for subscribers...";
+
+    my @columns = $db->buildArray( 'desc assetAspectSubscriber' );
+
+    if ( none { $_ eq 'listName' } @columns ) {
+        $db->write( 'alter table assetAspectSubscriber add column listName varchar(255)' );
+    }
+
+    print "Done.\n";
+}
+
 #----------------------------------------------------------------------------
 sub installMailableAspectTable {
     my $session = shift;
@@ -60,21 +125,21 @@ sub installSubscriberAspectTable {
 
     $session->db->write(<<EOSQL);
         create table if not exists assetAspectSubscriber (
-            assetId                     char(22)    binary  not null,
-            revisionDate                bigint(20)          not null,
-            subscriptionGroupId         char(22)    binary,
-            subscriptionEnabled         tinyint(1)          not null default 0,
-            alwaysConfirmSubscription   tinyint(1)          not null default 0,
-            allowAnonymousSubscription  tinyint(1)          not null default 0,
+            assetId                        char(22)    binary  not null,
+            revisionDate                   bigint(20)          not null,
+            subscriptionGroupId            char(22)    binary,
+            subscriptionEnabled            tinyint(1)          not null default 0,
+            alwaysConfirmSubscription      tinyint(1)          not null default 0,
+            allowAnonymousSubscription     tinyint(1)          not null default 0,
             confirmationRequiredTemplateId char(22)    binary,
-            confirmationEmailTemplateId char(22)    binary,
-            confirmationEmailSubject    varchar(255),
-            noMutationEmailTemplateId   char(22)    binary,
-            noMutationEmailSubject      varchar(255),
+            confirmationEmailTemplateId    char(22)    binary,
+            confirmationEmailSubject       varchar(255),
+            noMutationEmailTemplateId      char(22)    binary,
+            noMutationEmailSubject         varchar(255),
             primary key( assetId, revisionDate )
         );
 EOSQL
-    
+
     $session->db->write(<<EOSQL2);
         create table if not exists assetAspectSubscriber_log (
             assetId             char(22)        binary not null,
@@ -103,6 +168,7 @@ sub installNewsletterCollection {
         create table if not exists NewsletterCollection (
             assetId                     char(22)    binary  not null,
             revisionDate                bigint(20)          not null,
+            useHoneypot                 tinyint(1)          default 0,
             primary key( assetId, revisionDate )
         );
 EOSQL
@@ -117,7 +183,7 @@ sub addTemplateColumnToNewsletterCollection {
     print "\tAdding view template column to NewletterCollection...";
 
     my $hasColumn = $db->quickScalar( 'show columns from NewsletterCollection where Field=?', [ 'viewTemplateId' ] );
-    
+
     unless ( $hasColumn ) {
         $db->write( 'alter table NewsletterCollection add column viewTemplateId char(22) binary not null default ?', [
             'aYVYFpofaYvmRYoHwl3x4w'
@@ -137,7 +203,7 @@ sub addRecentColumnToNewsletterCollection {
     print "\tAdding recent issues column to NewletterCollection...";
 
     my $hasColumn = $db->quickScalar( 'show columns from NewsletterCollection where Field=?', [ 'recentIssueCount' ] );
-    
+
     unless ( $hasColumn ) {
         $db->write( 'alter table NewsletterCollection add column recentIssueCount int(3) not null default ?', [
             1,
@@ -196,7 +262,7 @@ sub installNewsletterInAdminConsole {
 sub installNewsletterSettings {
     my $session = shift;
     my $setting = $session->setting;
-    
+
     print "\tInstalling newsletter setting slots...";
 
     my %settings = (
@@ -221,11 +287,11 @@ sub addPluginsToConfigFile {
     my $config  = $session->config;
 
     print "\tAdding plugins to config file...";
-   
+
     $config->set( 'assets/WebGUI::Asset::Wobject::NewsletterCollection', {
         category    => 'basic',
     } );
-    
+
     my @handlers = @{ $session->config->get('contentHandlers') };
     if ( !scalar grep { $_ eq 'WebGUI::Content::NewsletterManager' } @handlers ) {
         insert_after_string 'WebGUI::Content::Shop', 'WebGUI::Content::NewsletterManager', @handlers;
@@ -237,7 +303,7 @@ sub addPluginsToConfigFile {
         push @workflows, 'WebGUI::Workflow::Activity::SendQueuedMailings';
         $session->config->set( 'workflowActivities/None', \@workflows );
     }
-    
+
 
     print "Done.\n";
 }
@@ -279,43 +345,63 @@ sub addRegistrationSteps {
     my $session = shift;
 
     print "\tAdding MailingSubscribe Registration Step to config...";
-    
+
     my %steps = map { $_ => 1 } @{ $session->config->get( 'registrationSteps' ) || [] };
     $steps{ 'WebGUI::Registration::Step::MailingSubscribe' } = 1;
 
     $session->config->set( 'registrationSteps', [ keys %steps ] );
 
     print "Done.\n";
-        
-}
 
+}
+#----------------------------------------------------------------------------
+sub addUseHoneypotColumn {
+    my $session = shift;
+
+    my $db      = $session->db;
+
+    print "\tAdding useHoneypot column...";
+
+    my @columns = $db->buildArray( 'show columns from NewsletterCollection' );
+
+   if ( ! grep { $_ eq 'useHoneypot' } @columns ) {
+       $db->write( 'alter table NewsletterCollection add column useHoneypot tinyint(1) default 0' );
+       $db->write( 'update NewsletterCollection set useHoneypot = 0 where useHoneypot is null' );
+
+       print "Done\n";
+
+   }
+   else {
+       print "Skipping\n";
+   }
+}
 #----------------------------------------------------------------------------
 sub start {
     my $webguiRoot  = shift;
     my $configFile  = shift;
     my $session = WebGUI::Session->open($webguiRoot,$configFile);
     $session->user({userId=>3});
-    
+
     ## If your script is adding or changing content you need these lines, otherwise leave them commented
     #
     # my $versionTag = WebGUI::VersionTag->getWorking($session);
     # $versionTag->set({name => 'Name Your Tag'});
     #
     ##
-    
+
     return $session;
 }
 
 #----------------------------------------------------------------------------
 sub finish {
     my $session = shift;
-    
+
     ## If your script is adding or changing content you need these lines, otherwise leave them commented
     #
     # my $versionTag = WebGUI::VersionTag->getWorking($session);
     # $versionTag->commit;
     ##
-    
+
     $session->var->end;
     $session->close;
 }

sbin/newsletter-transport.pl

@@ -1,60 +1,102 @@
-#!/data/wre/prereqs/bin/perl
+#!/usr/bin/perl
 
 BEGIN {
     unshift @INC, qw(
         /data/custom/webgui_newsletter/lib
         /data/WebGUI/lib
+        /data/custom/customlib_honeypot/lib
     );
 }
 
 use strict;
+use warnings;
+use 5.010;
 
-use Mail::DeliveryStatus::BounceParser;
-use WebGUI::Mailing::Email;
+use WebGUI::MailCommand;
 use List::MoreUtils qw{ any };
+use WebGUI::Config;
+use Getopt::Long;
+use Readonly;
+
+Readonly my $WRONG_USAGE    => 64;
+Readonly my $DATA_ERROR     => 65;
+Readonly my $NO_SUCH_USER   => 67;
+Readonly my $UNKNOWN_HOST   => 68;
+Readonly my $CONFIG_ERROR   => 78;
 
-my $NO_SUCH_USER    = 67;
 my $webguiRoot      = '/data/WebGUI';
-my %configs         = (
-    'lom.lom.st.unitedknowledge.org'   => 'www.lomcongres.nl.conf',
-);
-
 
 #---------------------------------------------------------------
-my ( $domain, $user )       = @ARGV;
-my ( $mailId, $command )    = $user =~ m{^(.+)-([^-]+)$}i;
+# Startup
+{
+    my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials();
 
-my $configFile      = $configs{ $domain };
-my $validCommand    = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
+    if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
+        my $session = openSession( $webguiRoot, $configFile );
+        no warnings 'once';
+        *{ WebGUI::Session::Env::getIp } = sub {
+            return $senderIp || '127.0.0.1';
+        };
 
-unless ( $configFile && $validCommand ) {
-#    system "/usr/sbin/sendmail -G -i $user\@$domain";
-    exit(0);
-}
-else {
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->log->warn( 'valid bounce address' );
-    my $email   = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) );
-    
-    if ($email) {
-        $session->log->warn( 'found 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; 
+        WebGUI::MailCommand::processCommand( $session, $command, $id, $sender );
 
-        $session->log->warn( 'about to register as bounced' );
-        $email->registerBounced( $reason, $message );
+        closeSession( $session );
     }
     else {
-        $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
+        warn "Not a valid command [$command].";
+        exit( $NO_SUCH_USER );
+        #die "Not a valid command [$command].";
     }
 
+    exit(0);
+}
+
+#-----------------------------------------------------------------------------
+sub getCredentials {
+    my ( $domain, $user, $sender, $senderIp );
+
+    GetOptions(
+        'domain=s'  => \$domain,
+        'user=s'    => \$user,
+        'sender=s'  => \$sender,
+        'senderIp=s'=> \$senderIp,
+    );
+    warn "--domain parameter is required"   && exit( $WRONG_USAGE ) unless $domain;
+    warn "--user parameter is required"     && exit( $WRONG_USAGE ) unless $user;
+    warn "--sender parameter is required"   && exit( $WRONG_USAGE ) unless $sender;
+    #warn "--senderIp parameter is required" && exit( $WRONG_USAGE ) unless $senderIp;
+
+    my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' )
+        ||  warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR );
+
+    my $configFile = $dispatch->get( $domain )
+        ||  warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST );
+
+    # Format is mailId-command
+    my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix;
+
+    print "Received mail addressed to [$user\@$domain] which contains no id"      && exit( $NO_SUCH_USER ) unless $id;
+    print "Received mail addressed to [$user\@$domain] which contains no command" && exit( $NO_SUCH_USER ) unless $command;
+
+    return ( $configFile, $command, $id, $sender, $senderIp );
+}
+
+#-----------------------------------------------------------------------------
+sub openSession {
+    my $webguiRoot  = shift;
+    my $configFile  = shift;
+
+    # Require WebGUI:Session rather than use it to save compilation of it when invalid commands are passed.
+    require WebGUI::Session;
+
+    my $session = WebGUI::Session->open( $webguiRoot, $configFile );
+
+    return $session;
+}
+
+#-----------------------------------------------------------------------------
+sub closeSession {
+    my $session = shift;
+
     $session->close;
-    exit (0);
-}    
-
-exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };
-
+}