Compare commits

...
Sign in to create a new pull request.

31 commits

Author SHA1 Message Date
arjan
abaa483aa3 moved honeypot check to www_processSubscription 2018-10-23 11:52:45 +02:00
Arjan Widlak
5a2e9e9e4f corrected ING in webgui-transport.pl 2018-10-23 03:35:59 +02:00
arjan
c029637c1a Added /data/custom/customlib_honeypot to newsletter-transport.pl 2018-10-23 03:25:44 +02:00
root
dd9150a1a8 Added form plugin honeypot to webgui_newsletter. It can be used with:
<tmpl_var subscriptionForm_form>
<tmpl_var form_honeypot>
<tmpl_var form_honeypot_id>

It's used by default now.
2018-10-23 03:07:37 +02:00
arjan
4379770f2d changed shebang, perl not part of wre 2015-02-08 17:32:04 +01:00
Arjan Widlak
768339e36e i18n tekst verbetert 2012-06-12 17:15:06 +02:00
root
9a4322432d Made the templates more recognizable by name by adding prefix webgui_newsletter 2011-11-15 11:36:27 +01:00
Martin Kamerbeek
5a64397083 Merge branch 'master' of git.st.unitedknowledge.org:webgui_newsletter 2011-06-15 04:57:28 +02:00
Martin Kamerbeek
87139a7498 Fixed bug where generate mailing would generate two mailings before even saving the form. 2011-06-15 04:56:23 +02:00
Arjan Widlak
2a6e8f6193 Added option to add existing users to another group than new users.
Added documentation.
2011-01-19 12:38:19 +01:00
Martin Kamerbeek
ed0398a2c0 Merge branch 'master' of git.st.unitedknowledge.org:webgui_newsletter 2011-01-14 16:31:52 +01:00
Martin Kamerbeek
95d0f9fedb Set a flag when rendering mailings 2011-01-14 14:32:15 +01:00
Arjan Widlak
b5348ea49e Changed some i18n text 2011-01-12 15:10:04 +01:00
Martin Kamerbeek
cc02178bb7 Now prevent warning even morerest. 2010-12-22 15:24:14 +01:00
Martin Kamerbeek
e209e0104a Fix missing i18n messages. 2010-12-22 10:40:53 +01:00
Martin Kamerbeek
1d35a471e8 Prevent warning. 2010-12-22 10:30:53 +01:00
Martin Kamerbeek
c6d7fe913d Fix invalid label. 2010-12-16 16:50:19 +01:00
Martin Kamerbeek
98c3c69959 Fix typo. 2010-12-16 13:42:35 +01:00
Martin Kamerbeek
efb7a004ac Make subscribe buttons ie proof. 2010-12-16 13:39:15 +01:00
Martin Kamerbeek
3ffb43bd68 Make newsletter settable 2010-12-15 17:19:42 +01:00
Martin Kamerbeek
0d1b0fe7ac Add sortable YUI data table to bounce score overview. 2010-12-09 14:10:19 +01:00
Martin Kamerbeek
595e340515 Fix syntax error resulting from merge. 2010-11-24 15:01:21 +01:00
Martin Kamerbeek
fffdb9d1a0 Call prepareView on child assets in the prepareView phase to prevent their head tags showing up in our body. 2010-11-24 13:23:26 +01:00
Martin Kamerbeek
d325e7a301 Unslow bounce report generation and add some extra info as a bonus! 2010-11-24 12:51:06 +01:00
Martin Kamerbeek
0843bec5e0 www_confirmMutaton dd not process style template. 2010-11-24 10:37:42 +01:00
Martin Kamerbeek
80e1f1e0ea Don't absolutify # and mailto hrefs 2010-11-24 10:32:00 +01:00
Martin Kamerbeek
4fdc8b1798 Allow empty senderIp and default to 127.0.0.1. 2010-11-19 13:11:42 +01:00
Martin Kamerbeek
745addd5d1 Template confirm mutation screen. 2010-11-18 15:21:44 +01:00
Arjan Widlak
b9aaf63ec2 Merge branch 'mailcommand' 2010-11-15 12:19:26 +01:00
Martin Kamerbeek
2284a98f89 Merge branch 'master' of git.st.unitedknowledge.org:webgui_newsletter 2010-11-09 16:37:19 +01:00
Arjan Widlak
d08136669d updated required_modules 2010-11-03 18:16:20 +01:00
22 changed files with 618 additions and 194 deletions

View file

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

View file

@ -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
# need them again in that state in getViewVars.
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,9 +144,9 @@ sub getViewVars {
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 ) {
@ -165,4 +182,3 @@ sub view {
}
1;

View file

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

View file

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

View file

@ -421,7 +421,7 @@ sub www_edit {
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;
}
#----------------------------------------------------------------------------

View file

@ -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;
}
#----------------------------------------------------------------------------

View file

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

View file

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

View file

@ -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;
}
#-------------------------------------------------------------------
@ -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 {
@ -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;
}
#-------------------------------------------------------------------

View file

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

View file

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

View file

@ -100,6 +100,14 @@ our $I18N = {
'generate mailing' => {
message => 'Genereer mailing',
},
'bounce reason' => {
message => 'Laatste bounce oorzaak',
},
'bounce message' => {
message => 'Laatste bounce omschrijving',
},
};
1;

View file

@ -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',
},
};

View file

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

View file

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

View file

@ -100,6 +100,14 @@ our $I18N = {
'generate mailing' => {
message => 'Generate mailing',
},
'bounce reason' => {
message => 'Latest bounce reason',
},
'bounce message' => {
message => 'Latest bounce message',
},
};
1;

View file

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

View file

@ -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,10 +15,14 @@ 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,
'existingUsersGroupId=s' => \$existingUsersGroupId,
'state=s' => \$state,
'emailFile=s' => \$emailFile,
);
@ -40,17 +44,23 @@ 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 "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

View file

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

View file

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

Binary file not shown.