UnitedKnowledge/webgui_newsletter
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: UnitedKnowledge:master
Branches Tags
UnitedKnowledge:master
UnitedKnowledge:bounce_score
UnitedKnowledge:mailcommand
UnitedKnowledge:registration_plugin
UnitedKnowledge:nice_html_to_text
..
compare: UnitedKnowledge:registration_plugin
Branches Tags
UnitedKnowledge:master
UnitedKnowledge:bounce_score
UnitedKnowledge:mailcommand
UnitedKnowledge:registration_plugin
UnitedKnowledge:nice_html_to_text

No commits in common. "master" and "registration_plugin" have entirely different histories.
master ... registrati

28 changed files with 268 additions and 1085 deletions
Download patch file Download diff file Expand all files Collapse all files

101
docs/mail_commands_setup.pod
View file

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

17
docs/postfix_configuration Normal file
View file

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

4
docs/required_modules
View file

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

38
lib/WebGUI/Asset/Wobject/NewsletterCollection.pm
View file

@ -34,13 +34,6 @@ sub definition {
tab => 'display', tab => 'display',
defaultValue => 1, defaultValue => 1,
}, },
useHoneypot => {
fieldType => 'yesNo',
label => $i18n->get('useHoneypot label'),
hoverHelp => $i18n->get('useHoneypot description'),
tab => 'security',
defaultValue => 1,
},
); );
push @{ $definition }, { push @{ $definition }, {
@ -59,16 +52,12 @@ sub definition {
sub getIssues { sub getIssues {
my $self = shift; my $self = shift;
# Caching of instanciated assets is not for speed, but is requied since prepareView is called on them, and we my $issues = $self->getLineage( [ 'children' ], {
# need them again in that state in getViewVars. returnObjects => 1,
unless ( $self->{ _issues } ) { orderByClause => 'lineage desc',
$self->{ _issues } = $self->getLineage( [ 'children' ], { } );
returnObjects => 1,
orderByClause => 'lineage desc',
} );
}
return $self->{ _issues }; return $issues;
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -99,8 +88,7 @@ sub getAssetContent {
my $self = shift; my $self = shift;
my $asset = shift; my $asset = shift;
# Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being $asset->prepareView;
# written to body.
my $content = $asset->view; my $content = $asset->view;
return $content; return $content;
@ -118,11 +106,6 @@ sub prepareView {
$self->{ _viewTemplate } = $template; $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; return;
} }
@ -144,10 +127,10 @@ sub getViewVars {
my $issueVar = $issue->get; my $issueVar = $issue->get;
$issueVar->{ url } = $issue->getUrl; $issueVar->{ url } = $issue->getUrl;
my $isRecent = defined $displayIssueId my $isRecent =
? $issue->getId eq $displayIssueId ( !$displayIssueId && $recentCount < $maxRecent )
: $recentCount < $maxRecent || ( $issue->getId eq $displayIssueId )
; ;
if ( $isRecent ) { if ( $isRecent ) {
$issueVar->{ content } = $self->getAssetContent( $issue ); $issueVar->{ content } = $self->getAssetContent( $issue );
@ -182,3 +165,4 @@ sub view {
} }
1; 1;

5
lib/WebGUI/AssetAspect/Mailable.pm
View file

@ -120,8 +120,6 @@ sub processContentAsUser {
|| $self->get('mailStyleTemplateId') || $self->get('mailStyleTemplateId')
|| $self->get('styleTemplateId'); || $self->get('styleTemplateId');
$session->stow->set( 'mailing_rendering' => 1 );
# Generate email body for this user # Generate email body for this user
my $content = $session->style->process( my $content = $session->style->process(
$self->generateEmailContent( $issueId, $configuration ), $self->generateEmailContent( $issueId, $configuration ),
@ -131,13 +129,10 @@ sub processContentAsUser {
# Process macros # Process macros
WebGUI::Macro::process( $session, \$content ); WebGUI::Macro::process( $session, \$content );
$session->stow->delete( 'mailing_rendering' );
# Become ourselves again. # Become ourselves again.
$session->user( { userId => $currentUser->getId } ); $session->user( { userId => $currentUser->getId } );
$var->switchAdminOn if $adminOn; $var->switchAdminOn if $adminOn;
return $content; return $content;
} }

258
lib/WebGUI/AssetAspect/Subscriber.pm
View file

@ -2,19 +2,11 @@ package WebGUI::AssetAspect::Subscriber;
use strict; use strict;
use warnings; use warnings;
use 5.010;
use Class::C3; use Class::C3;
use Carp; use Carp;
use WebGUI::Asset::Template; use WebGUI::Asset::Template;
use WebGUI::Macro; use WebGUI::Macro;
use WebGUI::Mail::Send;
use WebGUI::Group;
use WebGUI::Asset;
use WebGUI::Form;
use WebGUI::Form::Honeypot;
use WebGUI::User::SpecialState;
use WebGUI::International;
use Tie::IxHash; use Tie::IxHash;
use URI; use URI;
@ -26,11 +18,6 @@ sub definition {
my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' ); my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' );
tie my %properties, 'Tie::IxHash', ( tie my %properties, 'Tie::IxHash', (
listName => {
fieldType => 'text',
label => $i18n->echo("List name"),
tab => 'subscription',
},
subscriptionGroupId => { subscriptionGroupId => {
fieldType => 'subscriptionGroup', fieldType => 'subscriptionGroup',
label => $i18n->get( 'Subscription group' ), label => $i18n->get( 'Subscription group' ),
@ -88,13 +75,6 @@ sub definition {
namespace => 'Subscriber/NoMutationEmail', namespace => 'Subscriber/NoMutationEmail',
tab => 'subscription', tab => 'subscription',
}, },
confirmMutationTemplateId => {
fieldType => 'template',
defaultValue => 'WUk-wEhGiF8dcEogrJfrfg',
label => $i18n->get( 'confirm mutation template' ),
namespace => 'Subscriber/MutationConfirmation',
tab => 'subscription',
}
); );
push( @{ $definition }, { push( @{ $definition }, {
@ -193,44 +173,6 @@ 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 { sub appendSubscriptionFormVars {
my $self = shift; my $self = shift;
my $var = shift || {}; my $var = shift || {};
@ -242,37 +184,12 @@ sub appendSubscriptionFormVars {
WebGUI::Form::formHeader( $session, { action => $self->getUrl } ) WebGUI::Form::formHeader( $session, { action => $self->getUrl } )
. WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } ) . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } )
; ;
my $formFooter = WebGUI::Form::formFooter( $session );
my $subscribeButton = my $subscribeButton =
$formHeader sprintf '<button type="submit" name="action" value="subscribe">%s</button>', $i18n->get('subscribe');
. WebGUI::Form::hidden( $session, { name => 'action', value => 'subscribe' } )
. WebGUI::Form::submit( $session, { value => $i18n->get('subscribe') } )
. $formFooter
;
my $unsubscribeButton = my $unsubscribeButton =
$formHeader sprintf '<button type="submit" name="action" value="unsubscribe">%s</button>', $i18n->get('unsubscribe');
. WebGUI::Form::hidden( $session, { name => 'action', value => 'unsubscribe' } ) my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } );
. WebGUI::Form::submit( $session, { value => $i18n->get('unsubscribe') } ) my $formFooter = WebGUI::Form::formFooter( $session );
. $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 # Compose default subscription form for current user
my $form = ''; my $form = '';
@ -281,21 +198,19 @@ sub appendSubscriptionFormVars {
$form .= $unsubscribeButton if $self->canUnsubscribe; $form .= $unsubscribeButton if $self->canUnsubscribe;
} }
elsif ( $self->get('allowAnonymousSubscription') ) { elsif ( $self->get('allowAnonymousSubscription') ) {
$form = $emailBox; $form = $emailBox . $subscribeButton . $unsubscribeButton;
} }
# Setup tmpl_vars # Setup tmpl_vars
$var->{ subscriptionForm_form } = $form if $form; $var->{ subscriptionForm_form } = "$formHeader $form $formFooter" if $form;
$var->{ subscriptionForm_header } = $formHeader; $var->{ subscriptionForm_header } = $formHeader;
$var->{ subscriptionForm_footer } = $formFooter; $var->{ subscriptionForm_footer } = $formFooter;
$var->{ subscriptionForm_subscribeButton } = $subscribeButton; $var->{ subscriptionForm_subscribeButton } = $subscribeButton;
$var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton; $var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton;
$var->{ subscriptionForm_emailBox } = $emailBox; $var->{ subscrittionForm_emailBox } = $emailBox;
$var->{ user_canSubscribe } = $self->canSubscribe; $var->{ user_canSubscribe } = $self->canSubscribe;
$var->{ user_canUnsubscribe } = $self->canUnsubscribe; $var->{ user_canUnsubscribe } = $self->canUnsubscribe;
$var->{ user_isRegistered } = $session->user->isRegistered; $var->{ user_isRegistered } = $session->user->isRegistered;
$var->{ form_honeypot } = $honeypot->toHtml;
$var->{ form_honeypot_id } = $honeypot->get('id');
return $var; return $var;
} }
@ -348,45 +263,6 @@ sub getEmailVars {
return $var; return $var;
} }
#----------------------------------------------------------------------------
sub getAssetByListName {
my $class = shift;
my $session = shift;
my $listName = shift || return;
my $db = $session->db;
my $assetId = $db->quickScalar( 'select assetId from assetAspectSubscriber where listName=? limit 1', [
$listName
] );
return unless $assetId;
my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
return $asset;
}
#----------------------------------------------------------------------------
sub processPropertiesFromFormPost {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my $listName = $form->get('listName');
my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
my $errors = $self->next::method;
if ( $asset && $asset->getId ne $self->getId ) {
return [
@{ $errors || [] },
"List name $listName is already taken."
];
}
return $errors;
}
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
sub sendSubscriptionConfirmation { sub sendSubscriptionConfirmation {
my $self = shift; my $self = shift;
@ -395,13 +271,7 @@ sub sendSubscriptionConfirmation {
my $action = shift || 'subscribe'; my $action = shift || 'subscribe';
my $session = $self->session; my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); 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 $var = $self->getEmailVars( $user );
my $url = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" ); my $url = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" );
@ -410,18 +280,14 @@ sub sendSubscriptionConfirmation {
$var->{ actionIsSubscribe } = $action eq 'subscribe'; $var->{ actionIsSubscribe } = $action eq 'subscribe';
my $mail = WebGUI::Mail::Send->create( $self->session, { my $mail = WebGUI::Mail::Send->create( $self->session, {
to => $user->get('email'), to => $user->get('email'),
subject => $self->get('confirmationEmailSubject'), subject => $self->get('confirmationEmailSubject'),
contentType => 'multipart/alternative',
} ); } );
my $templateId = $self->get('confirmationEmailTemplateId'); my $templateId = $self->get('confirmationEmailTemplateId');
my $template = WebGUI::Asset::Template->new( $session, $templateId ); my $template = WebGUI::Asset::Template->new( $session, $templateId );
if ( $template ) { if ( $template ) {
my $content = $template->process( $var ); $mail->addHtml( $template->process( $var ) );
$mail->addHtml( $content );
$mail->addText( $self->transformToText( $content ) );
} }
else { else {
$session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" ); $session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" );
@ -440,29 +306,19 @@ sub sendNoMutationEmail {
my $action = shift || 'subscribe'; my $action = shift || 'subscribe';
my $session = $self->session; my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); 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 $var = $self->getEmailVars( $user );
$var->{ actionIsSubscribe } = $action eq 'subscribe'; $var->{ actionIsSubscribe } = $action eq 'subscribe';
my $mail = WebGUI::Mail::Send->create( $self->session, { my $mail = WebGUI::Mail::Send->create( $self->session, {
to => $user->get('email'), to => $user->get('email'),
subject => $self->get('noMutationEmailSubject'), subject => $self->get('noMutationEmailSubject'),
contentType => 'multipart/alternative',
} ); } );
my $templateId = $self->get('noMutationEmailTemplateId'); my $templateId = $self->get('noMutationEmailTemplateId');
my $template = WebGUI::Asset::Template->new( $session, $templateId ); my $template = WebGUI::Asset::Template->new( $session, $templateId );
if ( $template ) { if ( $template ) {
my $content = $template->process( $var ); $mail->addHtml( $template->process( $var ) );
$mail->addHtml( $content );
$mail->addText( $self->transformToText( $content ) );
} }
else { else {
$session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" ); $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" );
@ -476,18 +332,6 @@ sub sendNoMutationEmail {
return; return;
} }
sub transformToText {
my $self = shift;
my $html = shift;
my $text = $html;
#HTML::Entities::decode($text);
$text =~ s/<a.*?href=["'](.*?)['"].*?>(.+?)<\/a>/$2 ($1)/g;
$text = WebGUI::HTML::html2text($text);
return $text;
}
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
sub logConfirmation { sub logConfirmation {
my $self = shift; my $self = shift;
@ -545,7 +389,6 @@ sub subscribe {
my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $requireConfirm = shift // $self->get('alwaysConfirmSubscription');
my $session = $self->session; my $session = $self->session;
if ( $requireConfirm ) { if ( $requireConfirm ) {
if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) { if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) {
$self->sendNoMutationEmail( $user, 'subscribe' ); $self->sendNoMutationEmail( $user, 'subscribe' );
@ -612,64 +455,21 @@ sub www_confirmMutation {
] ]
); );
my $var = {
message => $i18n->get( 'wrong code' ),
returnUrl => $self->getUrl,
isSuccess => 0,
"is$type" => 1,
};
if ( $userId ) { if ( $userId ) {
$self->logConfirmation( $code ); $self->logConfirmation( $code );
if ( $type eq 'subscribe' ) { if ( $type eq 'subscribe' ) {
$self->getSubscriptionGroup->addUsers( [ $userId ] ); $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' ) { elsif ( $type eq 'unsubscribe' ) {
$self->getSubscriptionGroup->deleteUsers( [ $userId ] ); $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( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) ); return $self->processStyle( $i18n->get( 'wrong code' ) );
}
#----------------------------------------------------------------------------
sub subscribeAnonymous {
my $self = shift;
my $email = shift; # TODO || return ?
my $session = $self->session;
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
# If email address doesn't have an account, create one.
if ( !defined $emailUser ) {
$emailUser = WebGUI::User::SpecialState->create( $session );
$emailUser->update( { email => $email } );
}
$emailUser->addSpecialState( 'Subscriber', $self->getId );
$self->subscribe( $emailUser, 1 );
return;
}
#----------------------------------------------------------------------------
sub unsubscribeAnonymous {
my $self = shift;
my $email = shift;
my $session = $self->session;
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
if ( defined $emailUser ) {
$self->unsubscribe( $emailUser, 1 );
}
return;
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -682,12 +482,6 @@ sub www_processSubscription {
my $action = $form->get( 'action' ); my $action = $form->get( 'action' );
return unless $action eq 'subscribe' || $action eq 'unsubscribe'; 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 ( $session->user->isRegistered ) {
if ( $action eq 'subscribe' && $self->canSubscribe ) { if ( $action eq 'subscribe' && $self->canSubscribe ) {
$self->subscribe; $self->subscribe;
@ -702,9 +496,18 @@ sub www_processSubscription {
my $email = $form->email( 'email' ); my $email = $form->email( 'email' );
return 'Error: no email address passed' unless $email; return 'Error: no email address passed' unless $email;
given ( $action ) { my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); } if ( $action eq 'unsubscribe' && defined $emailUser ) {
when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); } $self->unsubscribe( $emailUser, 1 );
}
if ( $action eq 'subscribe' ) {
if ( !defined $emailUser ) {
$emailUser = WebGUI::User::SpecialState->create( $session );
$emailUser->update( { email => $email } );
}
$emailUser->addSpecialState( 'Subscriber', $self->getId );
$self->subscribe( $emailUser, 1 );
} }
} }
else { else {
@ -742,3 +545,4 @@ sub www_unsubscribe {
} }
1; 1;

56
lib/WebGUI/MailCommand.pm
View file

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

40
lib/WebGUI/MailCommand/Bounce.pm
View file

@ -1,40 +0,0 @@
package WebGUI::MailCommand::Bounce;
use strict;
use warnings;
use WebGUI::Mailing::Email;
use Mail::DeliveryStatus::BounceParser;
use base 'WebGUI::MailCommand';
#-----------------------------------------------------------------------------
sub process {
my $self = shift;
my $hexId = shift;
my $session = $self->session;
my $log = $session->log;
my $id = $session->id->fromHex( $hexId );
my $email = WebGUI::Mailing::Email->new( $session, $id );
if ($email) {
my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
my $report = ( $dsr->reports )[0];
my $reason = $report->get( 'std_reason' );
my $message = $report->get( 'reason' );
$message =~ s{\s+}{ }g;
$log->warn( "Registering email [$id] as bounced." );
$email->registerBounced( $reason, $message );
}
else {
$log->error( "Cannot process bounced email [$id] because it cannot be located in the db." );
}
return;
}
1;

28
lib/WebGUI/MailCommand/Subscribe.pm
View file

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

27
lib/WebGUI/MailCommand/Unsubscribe.pm
View file

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

20
lib/WebGUI/Mailing.pm
View file

@ -415,13 +415,13 @@ sub www_delete {
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
sub www_edit { 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; return $session->privilege->insufficient unless $self->admin->canManage;
my $f = $self->getEditForm; my $f = WebGUI::HTMLForm->new( $session );
$f->hidden( $f->hidden(
name => 'newsletter', name => 'newsletter',
value => 'mailing', value => 'mailing',
@ -435,16 +435,6 @@ sub www_edit {
value => $self->getId, 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 %fields = %{ $self->getAsset->getMailingProperties( $self ) };
my $configuration = $self->get('configuration') || {}; my $configuration = $self->get('configuration') || {};
while ( my( $name, $properties ) = each %fields ) { while ( my( $name, $properties ) = each %fields ) {
@ -473,7 +463,7 @@ sub getEditForm {
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"}, extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
); );
return $f; return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------

60
lib/WebGUI/Mailing/Admin.pm
View file

@ -96,7 +96,6 @@ sub www_createMailing {
my $self = shift; my $self = shift;
my $session = $self->session; my $session = $self->session;
my $form = $session->form; my $form = $session->form;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->canManage; return $session->privilege->insufficient unless $self->canManage;
@ -124,64 +123,7 @@ sub www_createMailing {
state => 'idle', state => 'idle',
} ); } );
my $f = $mailing->getEditForm; return $mailing->www_edit;
$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;
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------

100
lib/WebGUI/Mailing/Bounce.pm
View file

@ -57,106 +57,18 @@ sub session {
sub www_bounceReport { sub www_bounceReport {
my $self = shift; my $self = shift;
my $session = $self->session; my $session = $self->session;
my $db = $session->db;
my $i18n = WebGUI::International->new( $session, 'MailingManager' ); my $i18n = WebGUI::International->new( $session, 'MailingManager' );
my $sth = $session->db->read( 'select distinct sentTo from Mailing_email where sentTo is not null' );
my $windowSize = 10; my $output = '<table><tr><th>'.$i18n->get('email').'</th><th>'.$i18n->get('bounce score').'</th></tr>';
while ( my ($email) = $sth->array ) {
my $sql = <<EOSQL; my $score = $self->getBounceScore( $email );
select $output .= "<tr><td>$email</td><td>$score</td></tr>";
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 .= '</tbody></table></div></div>'; $output .= '</table>';
$self->addBounceScoreTableJS;
return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, $i18n->get( 'bounce scores' ) ); 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; 1;

3
lib/WebGUI/Mailing/Email.pm
View file

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

62
lib/WebGUI/Registration/Step/MailingSubscribe.pm
View file

@ -15,15 +15,12 @@ sub getAvailableMailings {
my $self = shift; my $self = shift;
my $session = $self->session; my $session = $self->session;
my $mailingIds = $self->get( 'includeMailings' ); my $availableMailings = WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
returnObjects => 1,
isa => 'WebGUI::Asset::Wobject::NewsletterCollection',
} );
my @mailings = return $availableMailings;
grep { defined $_ }
map { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds
;
return \@mailings;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -52,32 +49,22 @@ sub apply {
return; 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, 'RegistrationStep_MailingSubscribe' ); # my $i18n = WebGUI::International->new( $session, 'Registration_Step_Homepage' );
#
tie my %mailings, 'Tie::IxHash', ( #
map { $_->getId => $_->getTitle } # $definition->{ dynamic }->{ urlStorageField } = {
@{ # fieldType => 'selectBox',
WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], { # label => 'Store homepage url in field',
returnObjects => 1, # options => \%profileFields,
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 { sub getSummaryTemplateVars {
@ -132,7 +119,7 @@ sub getViewVars {
} }
else { else {
# The step hasn't been done yet. # The step hasn't been done yet.
@subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings }; @subscribeMailings = grep { $_->isSubscribed( $user ) } @{ $availableMailings };
} }
# Create lookup table # Create lookup table
@ -184,7 +171,10 @@ sub updateFromFormPost {
my $self = shift; my $self = shift;
my $session = $self->session; my $session = $self->session;
return $self->SUPER::updateFromFormPost; $self->SUPER::updateFromFormPost;
# $self->update( {
# } );
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------

7
lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm
View file

@ -54,17 +54,14 @@ our $I18N = {
}, },
'subscription successful' => { 'subscription successful' => {
message => 'Uw inschrijving is geslaagd.', message => 'Uw inschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
}, },
'unsubscription successful' => { 'unsubscription successful' => {
message => 'Uw uitschrijving is geslaagd.', message => 'Uw uitschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
}, },
'wrong code' => { '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.', 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; 1;

18
lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm
View file

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

8
lib/WebGUI/i18n/Dutch/MailingManager.pm
View file

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

7
lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm
View file

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

8
lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm
View file

@ -34,6 +34,7 @@ our $I18N = {
message => 'Subscription', message => 'Subscription',
}, },
'subscribe' => { 'subscribe' => {
message => 'Subscribe', message => 'Subscribe',
}, },
@ -53,18 +54,15 @@ our $I18N = {
}, },
'subscription successful' => { 'subscription successful' => {
message => 'You are succesfully subscribed.', message => 'You are succesfully subscribed. <a href="%s">Back to site</a>',
}, },
'unsubscription successful' => { 'unsubscription successful' => {
message => 'You are succesfully unsubscribed.', message => 'You are succesfully unsubscribed. <a href="%s">Back to site</a>',
}, },
'wrong code' => { '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.', 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; 1;

9
lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm
View file

@ -18,14 +18,7 @@ our $I18N = {
'number of recent issues' => { 'number of recent issues' => {
message => '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; 1;

8
lib/WebGUI/i18n/English/MailingManager.pm
View file

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

3
lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm
View file

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

46
sbin/importSpecialState.pl
View file

@ -1,7 +1,7 @@
#!/usr/bin/env perl #!/usr/bin/env perl
$|++; # disable output buffering $|++; # disable output buffering
our ($webguiRoot, $configFile, $state, $emailFile, $groupId, $existingUsersGroupId ); our ($webguiRoot, $configFile, $state, $emailFile, $groupId );
BEGIN { BEGIN {
$webguiRoot = ".."; $webguiRoot = "..";
@ -15,16 +15,12 @@ use WebGUI::Session;
use WebGUI::User; use WebGUI::User;
use WebGUI::User::SpecialState; use WebGUI::User::SpecialState;
# Set default value
$existingUsersGroupId = '';
# Get parameters here, including $help # Get parameters here, including $help
GetOptions( GetOptions(
'configFile=s' => \$configFile, 'configFile=s' => \$configFile,
'groupId=s' => \$groupId, 'groupId=s' => \$groupId,
'existingUsersGroupId=s' => \$existingUsersGroupId, 'state=s' => \$state,
'state=s' => \$state, 'emailFile=s' => \$emailFile,
'emailFile=s' => \$emailFile,
); );
my $session = start( $webguiRoot, $configFile ); my $session = start( $webguiRoot, $configFile );
@ -44,24 +40,18 @@ while ( my $email = <$fh> ) {
my $user = WebGUI::User->newByEmail( $session, $email ); my $user = WebGUI::User->newByEmail( $session, $email );
if ( $user ) { if ( $user ) {
print "\tEmail already has account. Skipping.\n"; 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 { else {
print "\tEmail has no account, creating special state $state.\n"; print "\tEmail has no account, creating special state $state.\n";
$user = WebGUI::User::SpecialState->create( $session ); $user = WebGUI::User::SpecialState->create( $session );
$user->update( { email => $email } ); $user->update( { email => $email } );
$user->addSpecialState( $state ); $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"; print "Done\n\n";
@ -130,22 +120,6 @@ 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. since it will be looked up inside WebGUI's configuration directory.
This parameter is required. 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> =item B<--help>
Shows a short summary and usage Shows a short summary and usage
@ -158,7 +132,7 @@ Shows this document
=head1 AUTHOR =head1 AUTHOR
Copyright 2010-2011 United Knowledge B.V. Copyright 2001-2009 Plain Black Corporation.
=cut =cut

108
sbin/install_newsletter.pl
View file

@ -12,7 +12,7 @@ use strict;
use Pod::Usage; use Pod::Usage;
use Getopt::Long; use Getopt::Long;
use WebGUI::Session; use WebGUI::Session;
use List::MoreUtils qw{ insert_after_string none }; use List::MoreUtils qw{ insert_after_string };
# Get parameters here, including $help # Get parameters here, including $help
GetOptions( GetOptions(
@ -32,75 +32,10 @@ addTemplateColumnToNewsletterCollection( $session );
addRecentColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session );
renamespaceTemplates( $session ); renamespaceTemplates( $session );
addSpecialStateTable( $session ); addSpecialStateTable( $session );
addListNameColumn( $session );
addRegistrationSteps( $session ); addRegistrationSteps( $session );
addConfirmationTemplateColumn( $session );
addSentToIndex( $session );
addUseHoneypotColumn( $session );
finish($session); finish($session);
#-------------------------------------------------------------------------------
sub addConfirmationTemplateColumn {
my $session = shift;
my $db = $session->db;
print "\tAdding column for mutation confirmation template...";
my $hasColumn = $db->quickScalar( 'show columns from assetAspectSubscriber where Field = ?', [
'confirmMutationTemplateId',
] );
unless ( $hasColumn ) {
$db->write(
'alter table assetAspectSubscriber add column confirmMutationTemplateId char(22) binary not null default ?',
[
'WUk-wEhGiF8dcEogrJfrfg',
]
);
$db->write(
'update assetAspectSubscriber set confirmMutationTemplateId=? where confirmMutationTemplateId is null',
[
'WUk-wEhGiF8dcEogrJfrfg',
]
);
}
print "Done.\n";
}
#----------------------------------------------------------------------------
sub addSentToIndex {
my $session = shift;
my $db = $session->db;
print "\tAdding index to column Mailing_email.sentTo...";
my @indexes = $db->buildArray('show indexes from Mailing_email where Column_name=?',['sentTo']);
if ( @indexes == 0 ) {
$db->write('alter table Mailing_email add index(sentTo)');
}
print "Done.\n";
}
#----------------------------------------------------------------------------
sub addListNameColumn {
my $session = shift;
my $db = $session->db;
print "\tAdding list name column for subscribers...";
my @columns = $db->buildArray( 'desc assetAspectSubscriber' );
if ( none { $_ eq 'listName' } @columns ) {
$db->write( 'alter table assetAspectSubscriber add column listName varchar(255)' );
}
print "Done.\n";
}
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
sub installMailableAspectTable { sub installMailableAspectTable {
my $session = shift; my $session = shift;
@ -125,17 +60,17 @@ sub installSubscriberAspectTable {
$session->db->write(<<EOSQL); $session->db->write(<<EOSQL);
create table if not exists assetAspectSubscriber ( 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, 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 ) primary key( assetId, revisionDate )
); );
EOSQL EOSQL
@ -168,7 +103,6 @@ sub installNewsletterCollection {
create table if not exists NewsletterCollection ( create table if not exists NewsletterCollection (
assetId char(22) binary not null, assetId char(22) binary not null,
revisionDate bigint(20) not null, revisionDate bigint(20) not null,
useHoneypot tinyint(1) default 0,
primary key( assetId, revisionDate ) primary key( assetId, revisionDate )
); );
EOSQL EOSQL
@ -354,27 +288,7 @@ sub addRegistrationSteps {
print "Done.\n"; 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 { sub start {
my $webguiRoot = shift; my $webguiRoot = shift;

112
sbin/newsletter-transport.pl
View file

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

BIN
sbin/packages/root_import_personalnewsletter.wgpkg Normal file
View file

Binary file not shown.

BIN
sbin/packages/root_import_webgui_newsletter.wgpkg
View file

Binary file not shown.