571 lines
16 KiB
Perl
571 lines
16 KiB
Perl
package WebGUI::Mailing;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use WebGUI::Mailing::Admin;
|
|
|
|
use base 'WebGUI::Crud';
|
|
|
|
#----------------------------------------------------------------------------
|
|
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 } = 'WGMailing';
|
|
$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;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub getAsset {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
|
|
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
|
|
#### TODO: error checking
|
|
return $asset;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub getQueuedEmailIterator {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
|
|
return WebGUI::Mailing::Email->getQueued( $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 WGMailing_queue 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 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 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 $admin = WebGUI::Mailing::Admin->new( $session );
|
|
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
|
|
|
|
return $admin->adminConsole->render(
|
|
sprintf( $i18n->get( 'cannot cancel mailing' ), $self->getId ),
|
|
$i18n->get( 'error' )
|
|
) unless $self->canCancel;
|
|
|
|
$self->cancel;
|
|
|
|
return WebGUI::Mailing::Admin->new($session)->www_view;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_delete {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
|
|
$self->delete;
|
|
|
|
return WebGUI::Mailing::Admin->new($session)->www_view;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_edit {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
|
|
|
|
my $f = WebGUI::HTMLForm->new( $session );
|
|
$f->hidden(
|
|
name => 'newsletter',
|
|
value => 'mailing',
|
|
);
|
|
$f->hidden(
|
|
name => 'func',
|
|
value => 'editSave',
|
|
);
|
|
$f->hidden(
|
|
name => 'id',
|
|
value => $self->getId,
|
|
);
|
|
|
|
my %fields = %{ $self->getAsset->getMailingProperties };
|
|
my $configuration = $self->get('configuration') || {};
|
|
while ( my( $name, $properties ) = each %fields ) {
|
|
$f->dynamicField(
|
|
name => $name,
|
|
%{ $properties },
|
|
value => $configuration->{ $name },
|
|
);
|
|
}
|
|
|
|
$f->submit;
|
|
|
|
return WebGUI::Mailing::Admin->new($session)->getAdminConsole->render( $f->print, $i18n->get('configure mailing') );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_previewContent {
|
|
my $self = shift;
|
|
my $form = $self->session->form;
|
|
|
|
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' );
|
|
|
|
my $asset = $self->getAsset;
|
|
my %recipients =
|
|
map { $_->getId => $_->username }
|
|
map { WebGUI::User->new( $session, $_ ) }
|
|
@{ $asset->getRecipients };
|
|
|
|
my $userId = $form->get('userId') || ( %recipients )[0];
|
|
|
|
my $manageUrl = $url->page('newsletter=manage');
|
|
my $contentUrl = $url->page( "newsletter=mailing;func=previewContent;userId=$userId;id=".$self->getId );
|
|
my $subject = $asset->getSubject( $self->get('configuration') );
|
|
|
|
my $userSelection =
|
|
WebGUI::Form::formHeader( $session )
|
|
. WebGUI::Form::hidden( $session, { name => 'newsletter', value => 'mailing' } )
|
|
. WebGUI::Form::hidden( $session, { name => 'func', value => 'previewEmail' } )
|
|
. WebGUI::Form::hidden( $session, { name => 'id', value => $self->getId } )
|
|
. WebGUI::Form::selectBox( $session, {
|
|
name => 'userId',
|
|
options => \%recipients,
|
|
value => $userId,
|
|
} )
|
|
. WebGUI::Form::submit( $session, { value => $i18n->get( 'switch user') } )
|
|
. " <a href=\"$manageUrl\">" . $i18n->get( 'return to manager' ) . "</a>"
|
|
. WebGUI::Form::formFooter( $session );
|
|
|
|
return <<EOHTML;
|
|
<html>
|
|
<head>
|
|
</head>
|
|
<body>
|
|
$userSelection
|
|
<b>Subject :</b>$subject
|
|
<iframe src="$contentUrl" id="previewFrame" style="width: 100%; height: 90%">
|
|
</iframe>
|
|
</body>
|
|
</html>
|
|
EOHTML
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_editSave {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $form = $session->form;
|
|
|
|
my %fields = %{ $self->getAsset->getMailingProperties };
|
|
my $configuration = {};
|
|
while ( my( $name, $properties ) = each %fields ) {
|
|
my $value = $form->process( $name, $properties->{ fieldType }, $properties->{ defaultValue } );
|
|
|
|
$configuration->{ $name } = $value;
|
|
}
|
|
|
|
#### TODO: Add error checking and required fields?
|
|
$self->update( { configuration => $configuration } );
|
|
|
|
return WebGUI::Mailing::Admin->new( $session )->www_view;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_sendBatch {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
|
|
|
|
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;
|
|
|
|
return WebGUI::Mailing::Admin->new($session)->getAdminConsole->render( $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 $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 WebGUI::Mailing::Admin->new( $session )->www_view;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_sendTestEmails {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $i18n = WebGUI::International->new( $session, 'MailingManager' );
|
|
|
|
|
|
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( $i18n->get('send test mails') );
|
|
|
|
return $f->print;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
sub www_sendTestEmailsConfirm {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $form = $session->form;
|
|
|
|
my $to = $form->get( 'to' );
|
|
my @userIds = $form->selectList( 'userIds' );
|
|
|
|
$self->queueTestEmails( $to, \@userIds );
|
|
|
|
return WebGUI::Mailing::Admin->new( $session )->www_view;
|
|
}
|
|
|
|
1;
|
|
|