169 lines
4 KiB
Perl
169 lines
4 KiB
Perl
package WebGUI::Mailing;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use WebGUI::Newsletter::Admin;
|
|
|
|
use base 'WebGUI::Crud';
|
|
|
|
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',
|
|
},
|
|
sendDate => {
|
|
fieldType => 'dateTime',
|
|
},
|
|
active => {
|
|
fieldType => 'yesNo',
|
|
defaultValue => 0,
|
|
},
|
|
);
|
|
|
|
$definition->{ properties } = {
|
|
%{ $definition->{ properties } || {} },
|
|
%properties,
|
|
};
|
|
|
|
return $definition;
|
|
}
|
|
|
|
sub getAsset {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
|
|
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
|
|
#### TODO: error checking
|
|
return $asset;
|
|
}
|
|
|
|
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 www_sendTestEmails {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
|
|
my $asset = WebGUI::Asset->newByDynamicClass( $session, $self->get('assetId') );
|
|
croak "Cannot instaciate 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 => 'Send emails to test address',
|
|
);
|
|
$f->selectList(
|
|
name => 'userIds',
|
|
label => 'Generate test emails for user(s)',
|
|
size => 10,
|
|
multiple=> 1,
|
|
options => \%options,
|
|
);
|
|
$f->submit( 'Send' );
|
|
|
|
return $f->print;
|
|
}
|
|
|
|
sub www_sendTestEmailsConfirm {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
my $form = $session->form;
|
|
|
|
my $to = $form->email( 'to' );
|
|
my @userIds = $form->selectList( 'userIds' );
|
|
|
|
$self->queueTestEmails( $to, \@userIds );
|
|
|
|
return WebGUI::Newsletter::Admin->new( $session )->www_view;
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|