webgui_newsletter/lib/WebGUI/Mailing.pm

799 lines
23 KiB
Perl

package WebGUI::Mailing;
use strict;
use warnings;
use Carp;
use WebGUI::Mailing::Admin;
use WebGUI::Mailing::Email;
use JSON qw{ to_json };
use base 'WebGUI::Crud';
#----------------------------------------------------------------------------
sub admin {
my $self = shift;
return WebGUI::Mailing::Admin->new( $self->session );
}
#----------------------------------------------------------------------------
sub canCancel {
my $self = shift;
return 1 if $self->get('state') eq 'scheduled';
return 0;
}
#----------------------------------------------------------------------------
sub cancel {
my $self = shift;
my $state = $self->get('state');
# Better bail out hard, then send wrong emails!
if ( $state ne 'scheduled' && $state ne 'queued' ) {
confess sprintf(
"Only scheduled and queued mailings can be cancelled, but mailing %s has state %s",
$self->getId,
$state,
);
};
$self->update( {
state => 'idle',
sendDate => undef,
} );
$self->deleteQueuedEmails;
return;
}
#----------------------------------------------------------------------------
sub crud_definition {
my $class = shift;
my $session = shift;
my $definition = $class->SUPER::crud_definition( $session );
$definition->{ tableName } = 'Mailing';
$definition->{ tableKey } = 'mailingId';
$definition->{ sequenceKey } = 'issueId';
my %properties = (
assetId => {
fieldType => 'guid',
},
issueId => {
fieldType => 'guid',
},
configuration => {
fieldType => 'textarea',
serialize => 1,
defaultValue => {},
},
sendDate => {
fieldType => 'dateTime',
},
state => {
fieldType => 'text',
defaultValue => 'idle',
},
);
$definition->{ properties } = {
%{ $definition->{ properties } || {} },
%properties,
};
return $definition;
}
#----------------------------------------------------------------------------
sub delete {
my $self = shift;
$self->deleteQueuedEmails;
return $self->SUPER::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;
}
#----------------------------------------------------------------------------
sub getAsset {
my $self = shift;
my $session = $self->session;
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
unless ( $asset ) {
$session->log->error( sprintf 'Mailing %s has corrupt assetId %s', $self->getId, $self->get('assetId') );
}
return $asset;
}
#----------------------------------------------------------------------------
sub getIssue {
my $self = shift;
my $session = $self->session;
my $issue = WebGUI::Asset->newByDynamicClass( $session, $self->get('issueId') );
unless ( $issue ) {
$session->log->error( sprintf 'Mailing %s has corrupt issueId %s', $self->getId, $self->get('issueId') );
}
return $issue;
}
#----------------------------------------------------------------------------
sub getQueuedEmailIterator {
my $self = shift;
my $session = $self->session;
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;
my $session = shift;
my $it = $class->getAllIterator( $session, {
constraints => [
{ 'state=? or state=?' => [ 'sending', 'queued' ] },
],
orderBy => "state = 'sending' desc, sendDate asc",
limit => 1,
} );
return $it->();
}
#----------------------------------------------------------------------------
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',
[
$self->getId,
],
);
my $status = {};
while ( my $row = $sth->hashRef ) {
$status->{ $row->{status} }->{ $row->{ isTest } ? 'test' : 'regular' } = $row->{ cnt };
};
my $output;
foreach ( qw{ queued sent error } ) {
$output .= sprintf '%s ( %i + %i (test) ) | ',
$_,
$status->{$_}->{regular} || 0,
$status->{$_}->{test} || 0,
;
}
return $output;
}
#----------------------------------------------------------------------------
sub getViewVars {
my $self = shift;
my $url = $self->session->url;
my $state = $self->get('state');
my $baseParams = sprintf 'newsletter=mailing;id=%s', $self->getId;
return {
%{ $self->get },
status => $self->getStatusLine,
"is$state" => 1,
sendTestUrl => $url->page("$baseParams;func=sendTestEmails" ),
sendUrl => $url->page("$baseParams;func=sendBatch" ),
editUrl => $url->page("$baseParams;func=edit" ),
deleteUrl => $url->page("$baseParams;func=delete" ),
previewUrl => $url->page("$baseParams;func=previewEmail" ),
cancelUrl => $url->page("$baseParams;func=cancel" ),
};
}
#----------------------------------------------------------------------------
sub queueTestEmails {
my $self = shift;
my $to = shift;
my $userIds = shift;
my $session = $self->session;
croak "No or invalid to address: [$to]" unless ( $to && !ref $to );
croak "User ids must be an array ref" unless ( ref $userIds eq 'ARRAY' );
foreach my $userId ( @{ $userIds } ) {
WebGUI::Mailing::Email->create( $session, {
mailingId => $self->getId,
userId => $userId,
recipientEmail => $to,
isTest => 1,
} );
}
return;
}
#----------------------------------------------------------------------------
sub queue {
my $self = shift;
my $state = $self->get('state');
# Better bail out hard, then send wrong emails!
if ( $state ne 'scheduled' ) {
confess sprintf(
"Only schduled mailings can be queued, but mailing %s has state %s",
$self->getId,
$state,
);
};
$self->queueEmails( $self->getAsset->getRecipients );
$self->update( {
state => 'queued',
} );
return;
}
#----------------------------------------------------------------------------
sub queueEmails {
my $self = shift;
my $userIds = shift;
my $session = $self->session;
croak "User ids must be an array ref" unless ( ref $userIds eq 'ARRAY' );
foreach my $userId ( @{ $userIds } ) {
WebGUI::Mailing::Email->create( $session, {
mailingId => $self->getId,
userId => $userId,
recipientEmail => undef,
isTest => 0,
} );
}
return;
}
#----------------------------------------------------------------------------
sub queueScheduled {
my $class = shift;
my $session = shift;
my $it = $class->getAllIterator( $session, {
constraints => [
{ 'state=?' => [ 'scheduled' ] },
{ 'sendDate <= ?' => [ time() ] },
],
limit => 1,
} );
while ( my $mailing = $it->() ) {
$mailing->queue;
}
return;
}
#----------------------------------------------------------------------------
sub renderInConsole {
my $self = shift;
my $content = shift;
my $title = shift;
return WebGUI::Mailing::Admin->new($self->session)->getAdminConsole->render( $content, $title );
}
#----------------------------------------------------------------------------
sub send {
my $self = shift;
my $timeLimit = shift;
my $state = $self->get('state');
# Better bail out hard, then send wrong emails!
if ( $state ne 'queued' && $state ne 'sending' ) {
confess sprintf(
"Only queued and sending mailings can be sent, but mailing %s has state %s",
$self->getId,
$state,
);
};
$self->update( { state => 'sending' } );
my $complete = $self->sendQueuedEmails( $timeLimit );
if ( $complete ) {
$self->update( { state => 'sent' } );
return 1;
}
return;
}
#----------------------------------------------------------------------------
sub sendQueuedEmails {
my $self = shift;
my $timeLimit = shift;
my $session = $self->session;
return unless $self->get('state') eq 'sending';
my $it = $self->getQueuedEmailIterator;
while ( my $email = $it->() ) {
return if $timeLimit && time >= $timeLimit;
$email->send;
}
return 1;
}
#----------------------------------------------------------------------------
sub www_cancel {
my $self = shift;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->admin->canManage;
if ( $self->canCancel ) {
$self->cancel;
return $self->renderInConsole(
$i18n->get('cancel mailing success'),
$i18n->get('cancel mailing'),
);
}
else {
return $self->renderInConsole(
$i18n->get('cancel mailing failure'),
$i18n->get('cancel mailing'),
);
}
return;
}
#----------------------------------------------------------------------------
sub redirectToManager {
my $self = shift;
my ( $http, $url ) = $self->session->quick( qw{http url} );
$http->setRedirect( $url->page('newsletter=manage') );
return 'redirect';
}
#----------------------------------------------------------------------------
sub www_delete {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $self->admin->canManage;
$self->delete;
return $self->redirectToManager;
}
#----------------------------------------------------------------------------
sub www_edit {
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;
$f->hidden(
name => 'newsletter',
value => 'mailing',
);
$f->hidden(
name => 'func',
value => 'editSave',
);
$f->hidden(
name => 'id',
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 };
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
;
$f->readOnly(
label => $properties->{ label },
value => $html,
);
}
$f->submit( value => $i18n->get( 'generate mailing' ) );
my $cancelUrl = $session->url->page( 'newsletter=manage' );
$f->button(
value => $i18n->get( 'cancel' ),
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
);
return $f;
}
#----------------------------------------------------------------------------
sub www_previewContent {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
return $session->privilege->insufficient unless $self->admin->canManage;
my $issueId = $self->get('issueId');
my $userId = $form->get('userId');
return $self->getAsset->processContentAsUser( $issueId, $userId, $self->get('configuration') );
}
#----------------------------------------------------------------------------
sub www_previewEmail {
my $self = shift;
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;
my $manageUrl = $url->page('newsletter=manage');
my $subject = $asset->getSubject( $self->get('configuration') );
my $userSelection =
qq{
<p><a href="$manageUrl">Terug naar de mailing manager.</a></p>
<label for="acElem">Kies een gebruiker:</label>
<div id="ac">
<input id="acElem" type="text" />
<div id="acCont"></div>
</div>
};
my $js = $self->getAutoCompleteJS;
return <<EOHTML;
<html>
<head>
<style type="text/css">
#ac {
width:25em; /* set width here or else widget will expand to fit its container */
padding-bottom:2em;
}
</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>
<script type="text/javascript" src="/extras/yui/build/autocomplete/autocomplete-min.js"></script>
<script type="text/javascript">
$js
</script>
</head>
<body class="yui-skin-sam">
$userSelection
<b>Subject :</b>$subject
<iframe id="previewFrame" style="width: 100%; height: 90%">
</iframe>
</body>
</html>
EOHTML
}
sub getAutoCompleteJS {
my $self = shift;
my $session = $self->session;
my $url = $self->session->url;
my $jsonUrl = $url->page( 'newsletter=mailing;func=getRecipientsList;id='.$self->getId .';');
my $contentBase = $url->page( "newsletter=mailing;func=previewContent;id=".$self->getId );
my $data = to_json( [
map { {
id => $_->getId,
name => $_->username . " (" . $_->get('email') . ")",
} }
grep { defined $_ }
map { WebGUI::User->new( $session, $_ ) }
@{ $self->getAsset->getRecipients }
] );
return <<EOJS;
YAHOO.util.Event.onDOMReady( function() {
var data = $data;
var jsonUrl = '$jsonUrl';
var contentBase = '$contentBase';
var contentFrame = YAHOO.util.Dom.get('previewFrame');
var dataSource = new YAHOO.util.LocalDataSource( data );
dataSource.responseSchema = {
fields : [ 'name', 'id' ]
};
// Instantiate the AutoComplete
var autoComplete = new YAHOO.widget.AutoComplete("acElem", "acCont", dataSource);
autoComplete.resultTypeList = false;
autoComplete.queryMatchContains = true;
var updateFrameSrc = function(type, args) {
contentFrame.src = contentBase + ';userId=' + args[2].id;
};
autoComplete.itemSelectEvent.subscribe(updateFrameSrc);
YAHOO.util.Event.addListener( 'acElem', 'focus', function ( e ) {
this.focus();
this.select();
} );
} );
EOJS
}
#----------------------------------------------------------------------------
sub www_editSave {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
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 } );
$configuration->{ $name } = $value;
}
else {
$configuration->{ $name } = $properties->{ defaultValue } || $properties->{ value };
}
}
#### TODO: Add error checking and required fields?
$self->update( { configuration => $configuration } );
my $url = $session->url;
return $self->redirectToManager;
}
#----------------------------------------------------------------------------
sub www_sendBatch {
my $self = shift;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->admin->canManage;
my $f = WebGUI::HTMLForm->new( $session );
$f->hidden(
name => 'newsletter',
value => 'mailing',
);
$f->hidden(
name => 'func',
value => 'sendBatchConfirm',
);
$f->hidden(
name => 'id',
value => $self->getId,
);
$f->dateTime(
name => 'sendDate',
label => $i18n->get( 'send mailing at' ),
);
$f->submit(
value => $i18n->get( 'schedule' ),
extras => qq{class="forwardButton"},
);
my $cancelUrl = $session->url->page( 'newsletter=manage' );
$f->button(
value => $i18n->get( 'cancel' ),
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
);
return $self->renderInConsole( $f->print, $i18n->get('schedule mailing') );
}
#----------------------------------------------------------------------------
sub schedule {
my $self = shift;
my $date = shift || croak 'schedule requires a sendDate';
my $state = $self->get('state');
# Better bail out hard, then send wrong emails!
if ( $state ne 'idle' ) {
confess sprintf(
"Only idle mailings can be scheduled, but mailing %s has state %s",
$self->getId,
$state,
);
};
$self->update( {
sendDate => $date,
state => 'scheduled',
} );
return;
}
#----------------------------------------------------------------------------
sub www_sendBatchConfirm {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->admin->canManage;
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(
sprintf( $i18n->get('schedule mailing success'),
$session->datetime->epochToHuman( $scheduled ),
$session->url->page('newsletter=manage'),
),
$i18n->get( 'schedule mailing' )
);
}
#----------------------------------------------------------------------------
sub www_sendTestEmails {
my $self = shift;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->admin->canManage;
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
croak "Cannot instanciate asset " . $self->get('assetId') unless $asset;
my $userIds = $asset->getRecipients;
tie my %options, 'Tie::IxHash', (
map { $_->getId => $_->username . "(" . $_->get('email') . ")" }
sort { $a->username cmp $b->username }
grep { defined $_ }
map { WebGUI::User->new( $session, $_ ) }
@{ $userIds }
);
my $f = WebGUI::HTMLForm->new( $session );
$f->hidden(
name => 'newsletter',
value => 'mailing',
);
$f->hidden(
name => 'func',
value => 'sendTestEmailsConfirm',
);
$f->hidden(
name => 'id',
value => $self->getId,
);
$f->email(
name => 'to',
label => $i18n->get( 'test recipient' ),
);
$f->selectList(
name => 'userIds',
label => $i18n->get( 'test users' ),
size => 10,
multiple=> 1,
options => \%options,
);
$f->submit(
value => $i18n->get('send test mails'),
extras => qq{class="forwardButton"},
);
my $cancelUrl = $session->url->page( 'newsletter=manage' );
$f->button(
value => $i18n->get( 'cancel' ),
extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
);
return $self->renderInConsole( $f->print, $i18n->get('send test mails') );
}
#----------------------------------------------------------------------------
sub www_sendTestEmailsConfirm {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
return $session->privilege->insufficient unless $self->admin->canManage;
my $to = $form->get( 'to' );
my @userIds = $form->selectList( 'userIds' );
$self->queueTestEmails( $to, \@userIds );
return $self->renderInConsole(
sprintf( $i18n->get('send test mail success'),
scalar( @userIds ),
$to,
$session->url->page('newsletter=manage'),
),
$i18n->get( 'send test mails' )
);
}
1;