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
+Mail::DeliveryStatus::BounceParser (v 1.525)
-Class::InsideOut
+Class::InsideOut (v 1.10)
 

lib/WebGUI/Asset/Wobject/NewsletterCollection.pm

@@ -34,6 +34,13 @@ 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 }, {
@@ -52,12 +59,16 @@ sub definition {
 sub getIssues {
     my $self    = shift;
 
-    my $issues  = $self->getLineage( [ 'children' ], {
+    # Caching of instanciated assets is not for speed, but is requied since prepareView is called on them, and we
-        returnObjects   => 1,
+    # need them again in that state in getViewVars.
-        orderByClause   => 'lineage desc',
+    unless ( $self->{ _issues } ) {
-    } );
+        $self->{ _issues } = $self->getLineage( [ 'children' ], {
+            returnObjects   => 1,
+            orderByClause   => 'lineage desc',
+        } );
+    }
 
-    return $issues;
+    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;
 }
 
@@ -127,10 +144,10 @@ sub getViewVars {
         my $issueVar = $issue->get;
         $issueVar->{ url } = $issue->getUrl;
 
-        my $isRecent =
+        my $isRecent = defined $displayIssueId
-               ( !$displayIssueId && $recentCount < $maxRecent  )
+                     ? $issue->getId eq $displayIssueId
-            || ( $issue->getId eq $displayIssueId               )
+                     : $recentCount < $maxRecent
-            ;
+                     ;
 
         if ( $isRecent ) {
             $issueVar->{ content    } = $self->getAssetContent( $issue );
@@ -165,4 +182,3 @@ sub view {
 }
 
 1;
-

lib/WebGUI/AssetAspect/Mailable.pm

@@ -120,6 +120,8 @@ sub processContentAsUser {
         || $self->get('mailStyleTemplateId')
         || $self->get('styleTemplateId');
 
+    $session->stow->set( 'mailing_rendering' => 1 );
+
     # Generate email body for this user
     my $content = $session->style->process(
         $self->generateEmailContent( $issueId, $configuration ),
@@ -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

@@ -415,13 +415,13 @@ sub www_delete {
 
 #----------------------------------------------------------------------------
 sub www_edit {
-    my $self    = shift;
+    my $self        = shift;
-    my $session = $self->session;
+    my $session     = $self->session;
-    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+    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 ) {
@@ -463,7 +473,7 @@ sub www_edit {
         extras  => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
     );
 
-    return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
+    return $f;
 }
 
 #----------------------------------------------------------------------------

lib/WebGUI/Mailing/Admin.pm

@@ -96,6 +96,7 @@ 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;
 
@@ -123,7 +124,64 @@ sub www_createMailing {
         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;
 }
 
 #----------------------------------------------------------------------------

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>';
+    my $windowSize = 10;
-    while ( my ($email) = $sth->array ) {
+
-        my $score = $self->getBounceScore( $email );
+    my $sql = <<EOSQL;
-        $output .= "<tr><td>$email</td><td>$score</td></tr>";
+    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

@@ -130,8 +130,7 @@ sub absolutifyURIs {
 
     foreach my $link ( @{ $root->extract_links } ) {
         my ($uri, $element, $attr, $tag) = @{ $link };
-        
+        if ( $uri !~ m{ ^ (?: [a-z]+:// | \# | mailto: ) }xmsi ) {
-        if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
             my $new =
                     ( $uri =~ m{ ^ / }xmsi )        # Is url absolute?
                     ? $siteUrl . $uri

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'], {
+    my $mailingIds = $self->get( 'includeMailings' );
-        returnObjects   => 1,
-        isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
-    } );
 
-    return $availableMailings;
+    my @mailings =
+        grep    { defined $_ }
+        map     { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
+                ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds
+        ;
+
+    return \@mailings;
 }
 
 #-------------------------------------------------------------------
@@ -49,22 +52,32 @@ sub apply {
     return;
 }
 
-##-------------------------------------------------------------------
+#-------------------------------------------------------------------
-#sub crud_definition {
+sub crud_definition {
-#    my $class       = shift;
+    my $class       = shift;
-#    my $session     = shift;
+    my $session     = shift;
-#    my $definition  = $class->SUPER::crud_definition( $session );
+    my $definition  = $class->SUPER::crud_definition( $session );
-#    my $i18n        = WebGUI::International->new( $session, 'Registration_Step_Homepage' );
+    my $i18n        = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' );
-#
+
-#
+    tie my %mailings, 'Tie::IxHash', (
-#    $definition->{ dynamic }->{ urlStorageField     } = {
+        map { $_->getId => $_->getTitle }
-#        fieldType       => 'selectBox',
+            @{
-#        label           => 'Store homepage url in field',
+                WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
-#        options         => \%profileFields,
+                    returnObjects   => 1,
-#    };
+                    isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
-#
+                } )
-#    return $definition;
+            }
-#}
+    );
+
+    $definition->{ dynamic }->{ includeMailings } = {
+        fieldType       => 'checkList',
+        label           => $i18n->get('Include newsletters'),
+        options         => \%mailings,
+        vertical        => 1,
+    };
+
+    return $definition;
+}
 
 #-------------------------------------------------------------------
 sub getSummaryTemplateVars {
@@ -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;
+    return $self->SUPER::updateFromFormPost;
-
-#    $self->update( {
-#    } );
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm

@@ -54,14 +54,17 @@ our $I18N = {
     },
 
     '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

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

@@ -34,7 +34,6 @@ our $I18N = {
         message => 'Subscription',
     },
 
-
     'subscribe' => {
         message => 'Subscribe',
     },
@@ -54,15 +53,18 @@ our $I18N = {
     },
 
     '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

@@ -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,
+    'configFile=s'  		=> \$configFile,
-    'groupId=s'     => \$groupId,
+    'groupId=s'     		=> \$groupId,
-    'state=s'       => \$state,
+    'existingUsersGroupId=s'	=> \$existingUsersGroupId,
-    'emailFile=s'   => \$emailFile,
+    '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,17 +125,17 @@ sub installSubscriberAspectTable {
 
     $session->db->write(<<EOSQL);
         create table if not exists assetAspectSubscriber (
-            assetId                     char(22)    binary  not null,
+            assetId                        char(22)    binary  not null,
-            revisionDate                bigint(20)          not null,
+            revisionDate                   bigint(20)          not null,
-            subscriptionGroupId         char(22)    binary,
+            subscriptionGroupId            char(22)    binary,
-            subscriptionEnabled         tinyint(1)          not null default 0,
+            subscriptionEnabled            tinyint(1)          not null default 0,
-            alwaysConfirmSubscription   tinyint(1)          not null default 0,
+            alwaysConfirmSubscription      tinyint(1)          not null default 0,
-            allowAnonymousSubscription  tinyint(1)          not null default 0,
+            allowAnonymousSubscription     tinyint(1)          not null default 0,
             confirmationRequiredTemplateId char(22)    binary,
-            confirmationEmailTemplateId char(22)    binary,
+            confirmationEmailTemplateId    char(22)    binary,
-            confirmationEmailSubject    varchar(255),
+            confirmationEmailSubject       varchar(255),
-            noMutationEmailTemplateId   char(22)    binary,
+            noMutationEmailTemplateId      char(22)    binary,
-            noMutationEmailSubject      varchar(255),
+            noMutationEmailSubject         varchar(255),
             primary key( assetId, revisionDate )
         );
 EOSQL
@@ -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
@@ -305,7 +354,27 @@ sub addRegistrationSteps {
     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;

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
     );
 }
 
@@ -34,11 +35,9 @@ 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 );
@@ -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;
 }
-