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/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

@@ -12,6 +12,7 @@ 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;
@@ -87,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 }, {
@@ -185,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 || {};
@@ -196,12 +242,37 @@ sub appendSubscriptionFormVars {
         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 = '';
@@ -210,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;
 }
@@ -322,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" );
 
@@ -361,7 +440,13 @@ 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';
 
@@ -527,21 +612,30 @@ sub www_confirmMutation {
         ]
     );
 
+    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') ) );
 }
 
 #----------------------------------------------------------------------------
@@ -588,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;
@@ -642,4 +742,3 @@ sub www_unsubscribe {
 }
 
 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

@@ -34,9 +34,57 @@ 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 {
@@ -77,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,
@@ -120,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
@@ -134,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'
@@ -154,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,
@@ -213,7 +262,7 @@ sub installNewsletterInAdminConsole {
 sub installNewsletterSettings {
     my $session = shift;
     my $setting = $session->setting;
-    
+
     print "\tInstalling newsletter setting slots...";
 
     my %settings = (
@@ -238,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;
@@ -254,7 +303,7 @@ sub addPluginsToConfigFile {
         push @workflows, 'WebGUI::Workflow::Activity::SendQueuedMailings';
         $session->config->set( 'workflowActivities/None', \@workflows );
     }
-    
+
 
     print "Done.\n";
 }
@@ -296,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,9 +1,10 @@
-#!/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
     );
 }
 
@@ -17,9 +18,9 @@ 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 $WRONG_USAGE    => 64;
+Readonly my $DATA_ERROR     => 65;
+Readonly my $NO_SUCH_USER   => 67;
 Readonly my $UNKNOWN_HOST   => 68;
 Readonly my $CONFIG_ERROR   => 78;
 
@@ -34,17 +35,15 @@ my $webguiRoot      = '/data/WebGUI';
         my $session = openSession( $webguiRoot, $configFile );
         no warnings 'once';
         *{ WebGUI::Session::Env::getIp } = sub {
-            return $senderIp;
+            return $senderIp || '127.0.0.1';
         };
 
-        $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]");
-
         WebGUI::MailCommand::processCommand( $session, $command, $id, $sender );
 
         closeSession( $session );
     }
     else {
-        warn "Not a valid command [$command]."; 
+        warn "Not a valid command [$command].";
         exit( $NO_SUCH_USER );
         #die "Not a valid command [$command].";
     }
@@ -65,7 +64,7 @@ sub getCredentials {
     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;
+    #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 );
@@ -101,4 +100,3 @@ sub closeSession {
 
     $session->close;
 }
-