diff --git a/docs/required_modules b/docs/required_modules index f1d1dac..b8200dc 100644 --- a/docs/required_modules +++ b/docs/required_modules @@ -1,3 +1,3 @@ -Mail::DeliveryStatus::BounceParser -Class::InsideOut +Mail::DeliveryStatus::BounceParser (v 1.525) +Class::InsideOut (v 1.10) diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index d35d745..d0a234a 100644 --- a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm +++ b/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; - diff --git a/lib/WebGUI/AssetAspect/Mailable.pm b/lib/WebGUI/AssetAspect/Mailable.pm index 90bc717..5efa6c7 100644 --- a/lib/WebGUI/AssetAspect/Mailable.pm +++ b/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; } diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 204ffbd..fed9da6 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/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: + +
+ + +
+ + + +You can easily make the honeypot input field invisible with some css for +class honeypot. + +=head4 form_honeypot +Renders these fields: + + + +=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 '', $i18n->get('subscribe'); - my $unsubscribeButton = - sprintf '', $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; - diff --git a/lib/WebGUI/Mailing.pm b/lib/WebGUI/Mailing.pm index 31ced29..93d8124 100644 --- a/lib/WebGUI/Mailing.pm +++ b/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{

Terug naar de mailing manager.

@@ -516,11 +526,11 @@ sub www_previewEmail { } - - - - - + + + + + +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; diff --git a/lib/WebGUI/Mailing/Email.pm b/lib/WebGUI/Mailing/Email.pm index 7598656..9445285 100644 --- a/lib/WebGUI/Mailing/Email.pm +++ b/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, diff --git a/lib/WebGUI/Registration/Step/MailingSubscribe.pm b/lib/WebGUI/Registration/Step/MailingSubscribe.pm index deff855..997d8b8 100644 --- a/lib/WebGUI/Registration/Step/MailingSubscribe.pm +++ b/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; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm index ee759a2..e6e8995 100644 --- a/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm +++ b/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. Terug naar de site', + message => 'Uw inschrijving is geslaagd.', }, 'unsubscription successful' => { - message => 'Uw uitschrijving is geslaagd. Terug naar de site', + 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; diff --git a/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm b/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm index 3fd5aa0..e4b8137 100644 --- a/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm +++ b/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; - diff --git a/lib/WebGUI/i18n/Dutch/MailingManager.pm b/lib/WebGUI/i18n/Dutch/MailingManager.pm index 4dc165b..31892b7 100644 --- a/lib/WebGUI/i18n/Dutch/MailingManager.pm +++ b/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; diff --git a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm index 957d7f1..05a0d19 100644 --- a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm +++ b/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', }, }; diff --git a/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm index f330260..cc5b9e5 100644 --- a/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm +++ b/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. Back to site', + message => 'You are succesfully subscribed.', }, 'unsubscription successful' => { - message => 'You are succesfully unsubscribed. Back to site', + 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; diff --git a/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm b/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm index 45d9bcb..ad946b2 100644 --- a/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm +++ b/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; diff --git a/lib/WebGUI/i18n/English/MailingManager.pm b/lib/WebGUI/i18n/English/MailingManager.pm index 51798f1..e8aebca 100644 --- a/lib/WebGUI/i18n/English/MailingManager.pm +++ b/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; diff --git a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm index 9b6df53..71534e4 100644 --- a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm +++ b/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; diff --git a/sbin/importSpecialState.pl b/sbin/importSpecialState.pl index 91a0158..ff20fb1 100644 --- a/sbin/importSpecialState.pl +++ b/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 diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 2d07aea..0d782bb 100644 --- a/sbin/install_newsletter.pl +++ b/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(<db->write(<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; } diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index beedd33..cc1fac9 100755 --- a/sbin/newsletter-transport.pl +++ b/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; } - diff --git a/sbin/packages/root_import_personalnewsletter.wgpkg b/sbin/packages/root_import_personalnewsletter.wgpkg deleted file mode 100644 index a96e715..0000000 Binary files a/sbin/packages/root_import_personalnewsletter.wgpkg and /dev/null differ diff --git a/sbin/packages/root_import_webgui_newsletter.wgpkg b/sbin/packages/root_import_webgui_newsletter.wgpkg new file mode 100644 index 0000000..f9b6678 Binary files /dev/null and b/sbin/packages/root_import_webgui_newsletter.wgpkg differ