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:nice_html_to_text
Branches Tags
UnitedKnowledge:master
UnitedKnowledge:bounce_score
UnitedKnowledge:mailcommand
UnitedKnowledge:registration_plugin
UnitedKnowledge:nice_html_to_text

1 commit
master ... nice_html_

Author SHA1 Message Date
Martin Kamerbeek
c11eea1a0c Use HTML::FormatText::WithLinks::AndTables instead of webgui's built in html2text. 2010-07-07 13:14:53 +02:00
34 changed files with 251 additions and 1400 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)
Class::InsideOut (v 1.10)
Mail::DeliveryStatus::BounceParser
Class::InsideOut

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

@ -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,18 +34,11 @@ 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',
icon => 'newWobject.gif',
autoGenerateForms => 1,
tableName => 'NewsletterCollection',
className => 'WebGUI::Asset::Wobject::NewsletterCollection',
@ -59,16 +52,12 @@ sub definition {
sub getIssues {
my $self = shift;
# 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 };
my $issues = $self->getLineage( [ 'children' ], {
returnObjects => 1,
orderByClause => 'lineage desc',
} );
return $issues;
}
#----------------------------------------------------------------------------
@ -99,8 +88,7 @@ sub getAssetContent {
my $self = shift;
my $asset = shift;
# Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being
# written to body.
$asset->prepareView;
my $content = $asset->view;
return $content;
@ -118,11 +106,6 @@ 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;
}
@ -143,11 +126,11 @@ sub getViewVars {
foreach my $issue ( @{ $issues } ) {
my $issueVar = $issue->get;
$issueVar->{ url } = $issue->getUrl;
my $isRecent = defined $displayIssueId
? $issue->getId eq $displayIssueId
: $recentCount < $maxRecent
;
my $isRecent =
( !$displayIssueId && $recentCount < $maxRecent )
|| ( $issue->getId eq $displayIssueId )
;
if ( $isRecent ) {
$issueVar->{ content } = $self->getAssetContent( $issue );
@ -174,7 +157,7 @@ sub view {
my $self = shift;
my $form = $self->session->form;
my $var = $self->getViewVars( {
my $var = $self->getViewVars( {
displayIssue => $form->guid('displayIssue'),
} );
@ -182,3 +165,4 @@ sub view {
}
1;

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

@ -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,15 +115,13 @@ 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,
);
@ -131,13 +129,10 @@ 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;
}

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

@ -2,19 +2,11 @@ package WebGUI::AssetAspect::Subscriber;
use strict;
use warnings;
use 5.010;
use Class::C3;
use Class::C3;
use Carp;
use WebGUI::Asset::Template;
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 URI;
@ -26,11 +18,6 @@ sub definition {
my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' );
tie my %properties, 'Tie::IxHash', (
listName => {
fieldType => 'text',
label => $i18n->echo("List name"),
tab => 'subscription',
},
subscriptionGroupId => {
fieldType => 'subscriptionGroup',
label => $i18n->get( 'Subscription group' ),
@ -46,7 +33,7 @@ sub definition {
alwaysConfirmSubscription => {
fieldType => 'yesNo',
defaultValue => 0,
label => $i18n->get( 'require confirmation' ),
label => $i18n->get( 'require confirmation' ),
tab => 'subscription',
},
allowAnonymousSubscription => {
@ -88,13 +75,6 @@ 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 }, {
@ -136,7 +116,7 @@ sub getListHeaders {
my $site = $self->session->url->getSiteURL;
my $headers = {
'List-Unsubscribe' =>
'List-Unsubscribe' =>
'<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>',
'List-Subscribe' =>
'<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>',
@ -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 {
my $self = shift;
my $var = shift || {};
@ -238,41 +180,16 @@ sub appendSubscriptionFormVars {
my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
# Setup form controls
my $formHeader =
my $formHeader =
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 = '';
@ -281,21 +198,19 @@ sub appendSubscriptionFormVars {
$form .= $unsubscribeButton if $self->canUnsubscribe;
}
elsif ( $self->get('allowAnonymousSubscription') ) {
$form = $emailBox;
$form = $emailBox . $subscribeButton . $unsubscribeButton;
}
# Setup tmpl_vars
$var->{ subscriptionForm_form } = $form if $form;
$var->{ subscriptionForm_form } = "$formHeader $form $formFooter" if $form;
$var->{ subscriptionForm_header } = $formHeader;
$var->{ subscriptionForm_footer } = $formFooter;
$var->{ subscriptionForm_subscribeButton } = $subscribeButton;
$var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton;
$var->{ subscriptionForm_emailBox } = $emailBox;
$var->{ subscrittionForm_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;
}
@ -304,8 +219,8 @@ sub appendSubscriptionFormVars {
sub getSubscriptionGroup {
my $self = shift;
my $groupId = $self->get( "subscriptionGroupId" );
my $group = $groupId
? WebGUI::Group->new( $self->session, $groupId )
my $group = $groupId
? WebGUI::Group->new( $self->session, $groupId )
: $self->createSubscriptionGroup
;
@ -316,7 +231,7 @@ sub getSubscriptionGroup {
sub getReturnUrl {
my $self = shift;
my $referer = $self->session->env->get('HTTP_REFERER');
return unless $referer;
# Get path and strip leading and trailing slash if it exists.
@ -348,45 +263,6 @@ sub getEmailVars {
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 {
my $self = shift;
@ -395,13 +271,7 @@ 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" );
@ -410,18 +280,14 @@ sub sendSubscriptionConfirmation {
$var->{ actionIsSubscribe } = $action eq 'subscribe';
my $mail = WebGUI::Mail::Send->create( $self->session, {
to => $user->get('email'),
subject => $self->get('confirmationEmailSubject'),
contentType => 'multipart/alternative',
to => $user->get('email'),
subject => $self->get('confirmationEmailSubject'),
} );
my $templateId = $self->get('confirmationEmailTemplateId');
my $template = WebGUI::Asset::Template->new( $session, $templateId );
if ( $template ) {
my $content = $template->process( $var );
$mail->addHtml( $content );
$mail->addText( $self->transformToText( $content ) );
$mail->addHtml( $template->process( $var ) );
}
else {
$session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" );
@ -440,29 +306,19 @@ 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';
my $mail = WebGUI::Mail::Send->create( $self->session, {
to => $user->get('email'),
subject => $self->get('noMutationEmailSubject'),
contentType => 'multipart/alternative',
to => $user->get('email'),
subject => $self->get('noMutationEmailSubject'),
} );
my $templateId = $self->get('noMutationEmailTemplateId');
my $template = WebGUI::Asset::Template->new( $session, $templateId );
if ( $template ) {
my $content = $template->process( $var );
$mail->addHtml( $content );
$mail->addText( $self->transformToText( $content ) );
$mail->addHtml( $template->process( $var ) );
}
else {
$session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" );
@ -476,18 +332,6 @@ sub sendNoMutationEmail {
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 {
my $self = shift;
@ -495,7 +339,7 @@ sub logConfirmation {
my $session = $self->session;
my $db = $session->db;
$db->write(
$db->write(
' update assetAspectSubscriber_log set '
.' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?',
[
@ -519,7 +363,7 @@ sub logRequest {
my $session = $self->session;
my $db = $session->db;
$db->write(
$db->write(
' insert into assetAspectSubscriber_log set '
.' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?',
[
@ -545,7 +389,6 @@ sub subscribe {
my $requireConfirm = shift // $self->get('alwaysConfirmSubscription');
my $session = $self->session;
if ( $requireConfirm ) {
if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) {
$self->sendNoMutationEmail( $user, 'subscribe' );
@ -571,7 +414,7 @@ sub unsubscribe {
my $self = shift;
my $user = shift || $self->session->user;
my $requireConfirm = shift // $self->get('alwaysConfirmSubscription');
my $session = $self->session;
if ( $requireConfirm ) {
@ -604,72 +447,29 @@ sub www_confirmMutation {
my $code = $form->get('code');
return unless $code;
my ($userId, $type) = $db->quickArray(
'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?',
my ($userId, $type) = $db->quickArray(
'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?',
[
0,
$code,
]
);
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 ] );
$var->{ message } = sprintf $i18n->get( 'subscription successful'), $self->getUrl;
$var->{ isSuccess } = 1;
return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl );
}
elsif ( $type eq 'unsubscribe' ) {
$self->getSubscriptionGroup->deleteUsers( [ $userId ] );
$var->{ message } = sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl;
$var->{ isSuccess } = 1;
return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl );
}
}
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' );
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;
@ -702,9 +496,18 @@ sub www_processSubscription {
my $email = $form->email( 'email' );
return 'Error: no email address passed' unless $email;
given ( $action ) {
when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); }
when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); }
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
if ( $action eq 'unsubscribe' && defined $emailUser ) {
$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 {
@ -742,3 +545,4 @@ sub www_unsubscribe {
}
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;

122
lib/WebGUI/Mailing.pm
View file

@ -5,8 +5,6 @@ use warnings;
use Carp;
use WebGUI::Mailing::Admin;
use WebGUI::Mailing::Email;
use JSON qw{ to_json };
use base 'WebGUI::Crud';
@ -40,7 +38,7 @@ sub cancel {
);
};
$self->update( {
$self->update( {
state => 'idle',
sendDate => undef,
} );
@ -65,7 +63,7 @@ sub crud_definition {
assetId => {
fieldType => 'guid',
},
issueId => {
fieldType => 'guid',
},
@ -83,7 +81,7 @@ sub crud_definition {
},
);
$definition->{ properties } = {
$definition->{ properties } = {
%{ $definition->{ properties } || {} },
%properties,
};
@ -94,7 +92,7 @@ sub crud_definition {
#----------------------------------------------------------------------------
sub delete {
my $self = shift;
$self->deleteQueuedEmails;
return $self->SUPER::delete;
@ -103,17 +101,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;
}
return;
}
@ -151,14 +144,6 @@ sub getQueuedEmailIterator {
return WebGUI::Mailing::Email->getQueued( $session, $self->getId );
}
#----------------------------------------------------------------------------
sub getQueuedTestEmailIterator {
my $self = shift;
my $session = $self->session;
return WebGUI::Mailing::Email->getQueuedTestEmails( $session, $self->getId );
}
#----------------------------------------------------------------------------
sub getNextInSendQueue {
my $class = shift;
@ -180,8 +165,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 +245,7 @@ sub queue {
$state,
);
};
$self->queueEmails( $self->getAsset->getRecipients );
$self->update( {
@ -285,7 +270,7 @@ sub queueEmails {
recipientEmail => undef,
isTest => 0,
} );
}
return;
@ -334,7 +319,7 @@ sub send {
$state,
);
};
$self->update( { state => 'sending' } );
my $complete = $self->sendQueuedEmails( $timeLimit );
@ -361,7 +346,7 @@ sub sendQueuedEmails {
$email->send;
}
return 1;
}
@ -380,7 +365,7 @@ sub www_cancel {
$i18n->get('cancel mailing success'),
$i18n->get('cancel mailing'),
);
}
}
else {
return $self->renderInConsole(
$i18n->get('cancel mailing failure'),
@ -415,13 +400,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 = $self->getEditForm;
my $f = WebGUI::HTMLForm->new( $session );
$f->hidden(
name => 'newsletter',
value => 'mailing',
@ -435,29 +420,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 ) {
$properties->{ name } = $name;
$properties->{ value } = $configuration->{ $name } if exists $configuration->{ $name };
$properties->{ value } = $configuration->{ $name } if exists $properties->{ value };
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
my $html = $self->admin->canOverride
? $formField->toHtml
: $formField->getValueAsHtml
;
$f->readOnly(
@ -468,12 +440,12 @@ sub getEditForm {
$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 $f;
return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
}
#----------------------------------------------------------------------------
@ -496,7 +468,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;
@ -504,7 +476,7 @@ sub www_previewEmail {
my $manageUrl = $url->page('newsletter=manage');
my $subject = $asset->getSubject( $self->get('configuration') );
my $userSelection =
my $userSelection =
qq{
<p><a href="$manageUrl">Terug naar de mailing manager.</a></p>
<label for="acElem">Kies een gebruiker:</label>
@ -526,11 +498,11 @@ sub www_previewEmail {
}
</style>
<!-- Individual YUI CSS files -->
<link rel="stylesheet" type="text/css" href="/extras/yui/build/autocomplete/assets/skins/sam/autocomplete.css">
<!-- Individual YUI JS files -->
<script type="text/javascript" src="/extras/yui/build/yahoo-dom-event/yahoo-dom-event.js"></script>
<script type="text/javascript" src="/extras/yui/build/datasource/datasource-min.js"></script>
<!-- Individual YUI CSS files -->
<link rel="stylesheet" type="text/css" href="/extras/yui/build/autocomplete/assets/skins/sam/autocomplete.css">
<!-- Individual YUI JS files -->
<script type="text/javascript" src="/extras/yui/build/yahoo-dom-event/yahoo-dom-event.js"></script>
<script type="text/javascript" src="/extras/yui/build/datasource/datasource-min.js"></script>
<script type="text/javascript" src="/extras/yui/build/autocomplete/autocomplete-min.js"></script>
<script type="text/javascript">
$js
@ -554,8 +526,8 @@ sub getAutoCompleteJS {
my $contentBase = $url->page( "newsletter=mailing;func=previewContent;id=".$self->getId );
my $data = to_json( [
map { {
id => $_->getId,
map { {
id => $_->getId,
name => $_->username . " (" . $_->get('email') . ")",
} }
grep { defined $_ }
@ -604,18 +576,18 @@ sub www_editSave {
return $session->privilege->insufficient unless $self->admin->canManage;
my %fields = %{ $self->getAsset->getMailingProperties( $self ) };
my $configuration = {};
while ( my( $name, $properties ) = each %fields ) {
if ( $self->admin->canOverride || $properties->{ managerCanEdit } ) {
my $value = $form->process( $name, $properties->{ fieldType }, $properties->{ defaultValue } );
my $configuration = {};
if ( $self->admin->canOverride ) {
while ( my( $name, $properties ) = each %fields ) {
my $value = $form->process( $name, $properties->{ fieldType }, $properties->{ defaultValue } );
$configuration->{ $name } = $value;
}
else {
$configuration->{ $name } = $properties->{ defaultValue } || $properties->{ value };
}
$configuration->{ $name } = $value;
}
}
else {
$configuration = \%fields;
}
#### TODO: Add error checking and required fields?
$self->update( { configuration => $configuration } );
@ -654,7 +626,7 @@ sub www_sendBatch {
extras => qq{class="forwardButton"},
);
my $cancelUrl = $session->url->page( 'newsletter=manage' );
$f->button(
$f->button(
value => $i18n->get( 'cancel' ),
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
);
@ -697,13 +669,13 @@ sub www_sendBatchConfirm {
my $scheduled = $form->dateTime( 'sendDate' );
return $self->www_sendBatch unless $scheduled;
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
croak "Cannot instaciate asset " . $self->get('assetId') unless $asset;
$self->schedule( $scheduled );
return $self->renderInConsole(
return $self->renderInConsole(
sprintf( $i18n->get('schedule mailing success'),
$session->datetime->epochToHuman( $scheduled ),
$session->url->page('newsletter=manage'),
@ -757,12 +729,12 @@ sub www_sendTestEmails {
multiple=> 1,
options => \%options,
);
$f->submit(
$f->submit(
value => $i18n->get('send test mails'),
extras => qq{class="forwardButton"},
);
my $cancelUrl = $session->url->page( 'newsletter=manage' );
$f->button(
$f->button(
value => $i18n->get( 'cancel' ),
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
);
@ -784,7 +756,7 @@ sub www_sendTestEmailsConfirm {
$self->queueTestEmails( $to, \@userIds );
return $self->renderInConsole(
return $self->renderInConsole(
sprintf( $i18n->get('send test mail success'),
scalar( @userIds ),
$to,

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

@ -7,9 +7,6 @@ use Carp 'confess';
use WebGUI::Asset;
use WebGUI::AdminConsole;
# prevent sub redef warnings
#require WebGUI::Mailing;
#----------------------------------------------------------------------------
sub canManage {
my $self = shift;
@ -96,10 +93,9 @@ sub www_createMailing {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->canManage;
my $assetId = $form->guid( 'assetId' );
my $issueId = $form->guid( 'issueId' );
@ -117,71 +113,13 @@ sub www_createMailing {
|| 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,
my $mailing = WebGUI::Mailing->create( $session, {
assetId => $assetId,
issueId => $issueId,
state => 'idle',
} );
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;
return $mailing->www_edit;
}
#----------------------------------------------------------------------------
@ -251,7 +189,7 @@ sub www_settingsSave {
my $session = $self->session;
return $session->privilege->insufficient unless $self->isAdmin;
my ($setting, $form) = $session->quick( 'setting', 'form' );
$setting->set( 'newsletterReturnDomain', $form->get('newsletterReturnDomain') );
@ -273,7 +211,7 @@ sub www_view {
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->canManage;
return $self->www_settings unless $self->configurationComplete;
my $mailableAssets = $self->getMailables;
@ -287,20 +225,19 @@ sub www_view {
my $issueId = $issue->getId;
my @mailings;
require WebGUI::Mailing;
my $it = WebGUI::Mailing->getAllIterator( $session, { sequenceKeyValue => $issueId } );
while ( my $mailing = $it->() ) {
push @mailings, $mailing->getViewVars;
};
push @issues, {
push @issues, {
%{ $issue->get },
url => $issue->getUrl,
createMailingUrl => $url->page("newsletter=manage;func=createMailing;assetId=$assetId;issueId=$issueId"),
editUrl => $issue->getUrl( 'func=edit' ),
mailing_loop => \@mailings,
};
}
}
push @newsletterLoop, {
%{ $asset->get },

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

@ -57,106 +57,18 @@ sub session {
sub www_bounceReport {
my $self = shift;
my $session = $self->session;
my $db = $session->db;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
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>';
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>";
}
$output .= '</tbody></table></div></div>';
$self->addBounceScoreTableJS;
$output .= '</table>';
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;

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

@ -5,7 +5,6 @@ use warnings;
use HTML::TreeBuilder;
use WebGUI::HTML;
use WebGUI::Mailing::Bounce;
use base 'WebGUI::Crud';
@ -54,7 +53,7 @@ sub crud_definition {
},
);
$definition->{ properties } = {
$definition->{ properties } = {
%{ $definition->{ properties } || {} },
%properties,
};
@ -67,7 +66,6 @@ sub getMailing {
my $self = shift;
my $session = $self->session;
require WebGUI::Mailing;
my $mailing = WebGUI::Mailing->new( $session, $self->get('mailingId') );
#### TODO: error checking;
return $mailing;
@ -128,19 +126,20 @@ 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]+:// | \# | mailto: ) }xmsi ) {
my $new =
if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
my $new =
( $uri =~ m{ ^ / }xmsi ) # Is url absolute?
? $siteUrl . $uri
: $siteUrl . $pageUrl . '/' . $uri
;
# replace attribute
$element->attr( $attr, $new );
}
}
}
return $tb->as_HTML;
}
@ -149,11 +148,13 @@ 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);
# my $text = $html;
# #HTML::Entities::decode($text);
# $text =~ s/<a.*?href=["'](.*?)['"].*?>(.+?)<\/a>/$2 ($1)/g;
# $text = WebGUI::HTML::html2text($text);
use HTML::FormatText::WithLinks::AndTables;
my $text = HTML::FormatText::WithLinks::AndTables->convert( $html );
return $text;
}
@ -166,7 +167,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;
}
@ -192,7 +193,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",
@ -227,14 +228,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,

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

@ -1,201 +0,0 @@
package WebGUI::Registration::Step::MailingSubscribe;
use strict;
use warnings;
use Tie::IxHash;
use List::MoreUtils qw{ uniq };
use WebGUI::Form::Checkbox;
use base qw{ WebGUI::Registration::Step };
#-------------------------------------------------------------------
sub getAvailableMailings {
my $self = shift;
my $session = $self->session;
my $mailingIds = $self->get( 'includeMailings' );
my @mailings =
grep { defined $_ }
map { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds
;
return \@mailings;
}
#-------------------------------------------------------------------
sub apply {
my $self = shift;
my $user = $self->registration->instance->user;
my $subscribeTo = {
map { $_ => 1 } @{ $self->getConfigurationData->{ subscribeMailings } || [] }
};
my $availableMailings = $self->getAvailableMailings;
my $sendNotification = 0;
foreach my $mailing ( @{ $availableMailings } ) {
next unless $mailing->isa( 'WebGUI::AssetAspect::Subscriber' );
if ( $subscribeTo->{ $mailing->getId } ) {
$mailing->subscribe( $user, $sendNotification ) unless $mailing->isSubscribed( $user );
}
else {
$mailing->unsubscribe( $user, $sendNotification ) if $mailing->isSubscribed( $user );
}
}
return;
}
#-------------------------------------------------------------------
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 {
my $self = shift;
my $includeAdminControls = shift;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' );
my @fields;
# Fetch preferred homepage url
my $mailings = $self->getConfigurationData->{ subscribeMailings };
my @assets =
grep { defined $_ }
map { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
@{ $mailings };
push @fields, {
field_label => $i18n->get( 'Subscribe to mailings' ),
field_value => join( ', ', map { $_->getTitle } @assets ),
};
# Setup tmpl_var
my $var = {
field_loop => \@fields,
category_label => $self->get('title'),
category_edit_url => $self->changeStepDataUrl,
};
return ( $var );
}
#-------------------------------------------------------------------
sub getViewVars {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my $user = $self->registration->instance->user;
my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' );
my $availableMailings = $self->getAvailableMailings;
# Figure out what mailings to check in the form
my @subscribeMailings;
if ( $form->checkList( 'subscribeMailings' ) ) {
# The user just posted but made an error
@subscribeMailings = $form->checkList( 'subscribeMailings' );
}
elsif ( exists $self->getConfigurationData->{'subscribeMailings'} ) {
# The step is being changed
@subscribeMailings = @{ $self->getConfigurationData->{'subscribeMailings'} || [] };
}
else {
# The step hasn't been done yet.
@subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings };
}
# Create lookup table
my %isSubscribed = map { $_ => 1 } @subscribeMailings;
my $var = $self->SUPER::getViewVars;
# Add form elems in alphabetic order.
foreach my $mailing ( sort { $a->getTitle cmp $b->getTitle } @{ $availableMailings } ) {
my $id = $mailing->getId;
push @{ $var->{ field_loop } }, (
{
field_label => $mailing->getTitle,
field_formElement =>
WebGUI::Form::checkbox( $session, {
name => 'subscribeMailings',
value => $id,
checked => $isSubscribed{ $id },
label => $i18n->get( 'Subscribe to this mailing' ),
}),
}
);
}
return $var;
}
#-------------------------------------------------------------------
sub isComplete {
my $self = shift;
return defined $self->getConfigurationData->{subscribeMailings};
}
#-------------------------------------------------------------------
sub onDeleteAccount {
my $self = shift;
my $doit = shift;
my $session = $self->session;
$self->SUPER::onDeleteAccount( $doit );
return;
}
#-------------------------------------------------------------------
sub updateFromFormPost {
my $self = shift;
my $session = $self->session;
return $self->SUPER::updateFromFormPost;
}
#-------------------------------------------------------------------
sub processStepFormData {
my $self = shift;
my $session = $self->session;
my @subscribeMailings = $session->form->checkList( 'subscribeMailings' );
$self->setConfigurationData( subscribeMailings => \@subscribeMailings );
return [];
}
1;

3
lib/WebGUI/Workflow/Activity/SendQueuedMailings.pm
View file

@ -1,8 +1,5 @@
package WebGUI::Workflow::Activity::SendQueuedMailings;
use WebGUI::Mailing;
use WebGUI::Mailing::Email;
use base 'WebGUI::Workflow::Activity';
#-------------------------------------------------------------------

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

@ -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,19 +52,16 @@ 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.',
message => 'Uw inschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
},
'unsubscription successful' => {
message => 'Uw uitschrijving is geslaagd.',
message => 'Uw uitschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
},
'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;

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

@ -6,26 +6,14 @@ our $I18N = {
assetName => {
message => 'Nieuwsbrief collectie',
},
'subscribe' => {
message => 'inschrijven',
},
'unsubscribe' => {
message => 'uitschrijven',
},
'template' => {
message => 'Sjabloon',
},
'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;

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

@ -26,7 +26,7 @@ our $I18N = {
'bounce score' => {
message => 'Bounce score',
},
'cannot cancel' => {
message => 'Mailing \'%s\' kan niet worden afgebroken.',
},
@ -100,14 +100,6 @@ our $I18N = {
'generate mailing' => {
message => 'Genereer mailing',
},
'bounce reason' => {
message => 'Laatste bounce oorzaak',
},
'bounce message' => {
message => 'Laatste bounce omschrijving',
},
};
1;

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

@ -1,18 +0,0 @@
package WebGUI::i18n::Dutch::RegistrationStep_MailingSubscribe;
use strict;
our $I18N = {
'Subscribe to mailings' => {
message => 'Ontvang deze nieuwsbrief',
},
'Subscribe to this mailing' => {
message => 'Ontvang deze nieuwsbrief',
},
'Include newsletters' => {
message => 'Selecteerbare nieuwsbrieven',
},
};
1;

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

@ -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,6 +34,7 @@ our $I18N = {
message => 'Subscription',
},
'subscribe' => {
message => 'Subscribe',
},
@ -51,20 +52,17 @@ our $I18N = {
'anonnymous not allowed' => {
message => 'Anonymous subscription is not allowed. Please log in to (un)subscribe',
},
'subscription successful' => {
message => 'You are succesfully subscribed.',
message => 'You are succesfully subscribed. <a href="%s">Back to site</a>',
},
'unsubscription successful' => {
message => 'You are succesfully unsubscribed.',
message => 'You are succesfully unsubscribed. <a href="%s">Back to site</a>',
},
'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;

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

@ -18,14 +18,7 @@ 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;

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

@ -26,7 +26,7 @@ our $I18N = {
'bounce score' => {
message => 'Bounce score',
},
'error' => {
message => 'An error occurred',
},
@ -100,14 +100,6 @@ our $I18N = {
'generate mailing' => {
message => 'Generate mailing',
},
'bounce reason' => {
message => 'Latest bounce reason',
},
'bounce message' => {
message => 'Latest bounce message',
},
};
1;

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

@ -1,18 +0,0 @@
package WebGUI::i18n::English::RegistrationStep_MailingSubscribe;
use strict;
our $I18N = {
'Subscribe to mailings' => {
message => 'Subscribe to mailings',
},
'Subscribe to this mailing' => {
message => 'Subscribe to this mailing',
},
'Include newsletters' => {
message => 'Include newsletters',
},
};
1;

46
sbin/importSpecialState.pl
View file

@ -1,7 +1,7 @@
#!/usr/bin/env perl
$|++; # disable output buffering
our ($webguiRoot, $configFile, $state, $emailFile, $groupId, $existingUsersGroupId );
our ($webguiRoot, $configFile, $state, $emailFile, $groupId );
BEGIN {
$webguiRoot = "..";
@ -15,16 +15,12 @@ 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,
'configFile=s' => \$configFile,
'groupId=s' => \$groupId,
'state=s' => \$state,
'emailFile=s' => \$emailFile,
);
my $session = start( $webguiRoot, $configFile );
@ -44,24 +40,18 @@ 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";
@ -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.
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
@ -158,7 +132,7 @@ Shows this document
=head1 AUTHOR
Copyright 2010-2011 United Knowledge B.V.
Copyright 2001-2009 Plain Black Corporation.
=cut

69
sbin/install_icons.pl
View file

@ -1,69 +0,0 @@
use strict;
use warnings;
use 5.010;
use Getopt::Long;
my ( $customRoot, $webguiRoot );
GetOptions(
'customRoot=s' => \$customRoot,
'webguiRoot=s' => \$webguiRoot,
);
die 'No custom root, use --customRoot' unless $customRoot;
$webguiRoot ||= '/data/WebGUI';
for ( qw{ assets adminConsole } ) {
my $largeDest = "$webguiRoot/www/extras/$_";
my $smallDest = "$webguiRoot/www/extras/$_/small";
my $largeOrig = "$customRoot/www/extras/$_";
my $smallOrig = "$customRoot/www/extras/$_/small";
say "Proccesing $_ icons...";
die "Cannot find large icon directory $largeDest" unless -d $largeDest;
die "Cannot find small icon directory $smallDest" unless -d $smallDest;
next unless -d $largeOrig && -d $smallOrig;
my ( %large, %small );
opendir my $largeDir, "$largeOrig";
while ( my $file = readdir $largeDir ) {
next unless $file =~ m{ \.gif $ }xmsi;
say "\tFound large icon $file.";
$large{ $file } = 1;
};
closedir $largeDir;
opendir my $smallDir, "$smallOrig" || next;
while ( my $file = readdir $smallDir ) {
next unless $file =~ m{ \.gif $ }xmsi;
say "\tFound small icon $file.";
$small{ $file } = 1;
};
closedir $smallDir;
foreach my $file ( keys %large ) {
if ( !exists $small{ $file } ) {
say "\tLarge icon $file has no small equivalent. Skipping.";
next;
}
print "\tInstalling large icon $file...";
symlink "$largeOrig/$file", "$largeDest/$file";
say -l "$largeDest/$file" ? "Ok" : "Failed";
print "\tInstalling small icon $file...";
symlink "$smallOrig/$file", "$smallDest/$file";
say -l "$smallDest/$file" ? "Ok" : "Failed";
}
}
say "Done.";

146
sbin/install_newsletter.pl
View file

@ -12,7 +12,7 @@ use strict;
use Pod::Usage;
use Getopt::Long;
use WebGUI::Session;
use List::MoreUtils qw{ insert_after_string none };
use List::MoreUtils qw{ insert_after_string };
# Get parameters here, including $help
GetOptions(
@ -32,75 +32,9 @@ addTemplateColumnToNewsletterCollection( $session );
addRecentColumnToNewsletterCollection( $session );
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 {
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 {
my $session = shift;
@ -125,21 +59,21 @@ sub installSubscriberAspectTable {
$session->db->write(<<EOSQL);
create table if not exists assetAspectSubscriber (
assetId char(22) binary not null,
revisionDate bigint(20) not null,
subscriptionGroupId char(22) binary,
subscriptionEnabled tinyint(1) not null default 0,
alwaysConfirmSubscription tinyint(1) not null default 0,
allowAnonymousSubscription tinyint(1) not null default 0,
assetId char(22) binary not null,
revisionDate bigint(20) not null,
subscriptionGroupId char(22) binary,
subscriptionEnabled tinyint(1) not null default 0,
alwaysConfirmSubscription tinyint(1) not null default 0,
allowAnonymousSubscription tinyint(1) not null default 0,
confirmationRequiredTemplateId char(22) binary,
confirmationEmailTemplateId char(22) binary,
confirmationEmailSubject varchar(255),
noMutationEmailTemplateId char(22) binary,
noMutationEmailSubject varchar(255),
confirmationEmailTemplateId char(22) binary,
confirmationEmailSubject varchar(255),
noMutationEmailTemplateId char(22) binary,
noMutationEmailSubject varchar(255),
primary key( assetId, revisionDate )
);
EOSQL
$session->db->write(<<EOSQL2);
create table if not exists assetAspectSubscriber_log (
assetId char(22) binary not null,
@ -168,7 +102,6 @@ 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
@ -183,7 +116,7 @@ sub addTemplateColumnToNewsletterCollection {
print "\tAdding view template column to NewletterCollection...";
my $hasColumn = $db->quickScalar( 'show columns from NewsletterCollection where Field=?', [ 'viewTemplateId' ] );
unless ( $hasColumn ) {
$db->write( 'alter table NewsletterCollection add column viewTemplateId char(22) binary not null default ?', [
'aYVYFpofaYvmRYoHwl3x4w'
@ -203,7 +136,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,
@ -262,7 +195,7 @@ sub installNewsletterInAdminConsole {
sub installNewsletterSettings {
my $session = shift;
my $setting = $session->setting;
print "\tInstalling newsletter setting slots...";
my %settings = (
@ -287,11 +220,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;
@ -303,7 +236,7 @@ sub addPluginsToConfigFile {
push @workflows, 'WebGUI::Workflow::Activity::SendQueuedMailings';
$session->config->set( 'workflowActivities/None', \@workflows );
}
print "Done.\n";
}
@ -340,68 +273,33 @@ EOSQL
print "Done.\n";
}
#----------------------------------------------------------------------------
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;
}

118
sbin/newsletter-transport.pl
View file

@ -1,102 +1,60 @@
#!/usr/bin/perl
#!/data/wre/prereqs/bin/perl
BEGIN {
unshift @INC, qw(
/data/custom/webgui_newsletter/lib
/data/WebGUI/lib
/data/custom/customlib_honeypot/lib
);
}
use strict;
use warnings;
use 5.010;
use WebGUI::MailCommand;
use Mail::DeliveryStatus::BounceParser;
use WebGUI::Mailing::Email;
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 %configs = (
'lom.lom.st.unitedknowledge.org' => 'www.lomcongres.nl.conf',
);
#---------------------------------------------------------------
# Startup
{
my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials();
my ( $domain, $user ) = @ARGV;
my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
my $session = openSession( $webguiRoot, $configFile );
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].";
}
my $configFile = $configs{ $domain };
my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
unless ( $configFile && $validCommand ) {
# system "/usr/sbin/sendmail -G -i $user\@$domain";
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) {
$session->log->warn( 'found 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;
#-----------------------------------------------------------------------------
sub getCredentials {
my ( $domain, $user, $sender, $senderIp );
GetOptions(
'domain=s' => \$domain,
'user=s' => \$user,
'sender=s' => \$sender,
'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' )
|| warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR );
my $configFile = $dispatch->get( $domain )
|| warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST );
# 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->log->warn( 'about to register as bounced' );
$email->registerBounced( $reason, $message );
}
else {
$session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
}
$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.

BIN
www/extras/adminConsole/newsletter.gif
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 456 B

BIN
www/extras/adminConsole/small/newsletter.gif
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 218 B

BIN
www/extras/assets/newsletter_collection.gif
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 456 B

BIN
www/extras/assets/small/newsletter_collection.gif
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 218 B