Bug 22343: Revamped Koha::Email class
This patch completely rewrites the Koha::Email class, inheriting from Email::Stuffer. The latter suits well the use by Email::Sender, which is to replace Mail::Sendmail on this patchset. To test: 1. Apply this patch 2. Run: $ kshell k$ prove t/Koha/Email.t => SUCCESS: Tests pass! 3. Verify all conditional codepaths are covered 4. Sign off :-D Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
This commit is contained in:
parent
0de6a7edff
commit
178592887b
135
Koha/Email.pm
135
Koha/Email.pm
|
|
@ -1,4 +1,7 @@
|
|||
package Koha::Email;
|
||||
|
||||
# Copyright 2014 Catalyst
|
||||
# 2020 Theke Solutions
|
||||
#
|
||||
# This file is part of Koha.
|
||||
#
|
||||
|
|
@ -15,64 +18,122 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||
|
||||
package Koha::Email;
|
||||
|
||||
use Modern::Perl;
|
||||
|
||||
use Email::Valid;
|
||||
use Email::MessageID;
|
||||
use Koha::Exceptions;
|
||||
|
||||
use base qw(Class::Accessor);
|
||||
use C4::Context;
|
||||
|
||||
__PACKAGE__->mk_accessors(qw( ));
|
||||
use base qw( Email::Stuffer );
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Koha::Email
|
||||
Koha::Email - A wrapper around Email::Stuffer
|
||||
|
||||
=head1 SYNOPSIS
|
||||
=head1 API
|
||||
|
||||
use Koha::Email;
|
||||
my $email = Koha::Email->new();
|
||||
my %mail = $email->create_message_headers({ to => $to_address, from => $from_address,
|
||||
replyto => $replyto });
|
||||
=head2 Class methods
|
||||
|
||||
=head1 FUNCTIONS
|
||||
=head3 create
|
||||
|
||||
my $email = Koha::Email->create(
|
||||
{
|
||||
[ text_body => $text_message,
|
||||
html_body => $html_message,
|
||||
body_params => $body_params ]
|
||||
from => $from,
|
||||
to => $to,
|
||||
cc => $cc,
|
||||
bcc => $bcc,
|
||||
reply_to => $reply_to,
|
||||
sender => $sender,
|
||||
subject => $subject,
|
||||
}
|
||||
);
|
||||
|
||||
This method creates a new Email::Stuffer object taking Koha specific configurations
|
||||
into account.
|
||||
|
||||
The encoding defaults to utf-8. It can be set as part of the body_params hashref. See
|
||||
I<Email::Stuffer> and I<Email::MIME> for more details on the available options.
|
||||
|
||||
Parameters:
|
||||
- I<from> defaults to the value of the I<KohaAdminEmailAddress> system preference
|
||||
- The I<SendAllEmailsTo> system preference overloads the I<to>, I<cc> and I<bcc> parameters
|
||||
- I<reply_to> defaults to the value of the I<ReplytoDefault> system preference
|
||||
- I<sender> defaults to the value of the I<ReturnpathDefault> system preference
|
||||
|
||||
Both I<text_body> and I<html_body> can be set later. I<body_params> will be passed if present
|
||||
to the constructor.
|
||||
|
||||
=cut
|
||||
|
||||
sub create_message_headers {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$params->{from} ||= C4::Context->preference('KohaAdminEmailAddress');
|
||||
$params->{charset} ||= 'utf8';
|
||||
my %mail = (
|
||||
To => $params->{to},
|
||||
From => $params->{from},
|
||||
charset => $params->{charset}
|
||||
);
|
||||
sub create {
|
||||
my ( $self, $params ) = @_;
|
||||
|
||||
if (C4::Context->preference('SendAllEmailsTo') && Email::Valid->address(C4::Context->preference('SendAllEmailsTo'))) {
|
||||
$mail{'To'} = C4::Context->preference('SendAllEmailsTo');
|
||||
my $args = {};
|
||||
$args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
|
||||
Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
|
||||
unless Email::Valid->address($args->{from}); # from is mandatory
|
||||
|
||||
$args->{subject} = $params->{subject} // '';
|
||||
|
||||
if ( C4::Context->preference('SendAllEmailsTo') ) {
|
||||
$args->{to} = C4::Context->preference('SendAllEmailsTo');
|
||||
}
|
||||
else {
|
||||
$mail{'Cc'} = $params->{cc} if exists $params->{cc};
|
||||
$mail{'Bcc'} = $params->{bcc} if exists $params->{bcc};
|
||||
$args->{to} = $params->{to};
|
||||
}
|
||||
|
||||
if ( C4::Context->preference('ReplytoDefault') ) {
|
||||
$params->{replyto} ||= C4::Context->preference('ReplytoDefault');
|
||||
Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
|
||||
unless Email::Valid->address($args->{to}); # to is mandatory
|
||||
|
||||
my $addresses = {};
|
||||
$addresses->{reply_to} = $params->{reply_to};
|
||||
$addresses->{reply_to} ||= C4::Context->preference('ReplytoDefault')
|
||||
if C4::Context->preference('ReplytoDefault');
|
||||
|
||||
$addresses->{sender} = $params->{sender};
|
||||
$addresses->{sender} ||= C4::Context->preference('ReturnpathDefault')
|
||||
if C4::Context->preference('ReturnpathDefault');
|
||||
|
||||
unless ( C4::Context->preference('SendAllEmailsTo') ) {
|
||||
$addresses->{cc} = $params->{cc}
|
||||
if exists $params->{cc};
|
||||
$addresses->{bcc} = $params->{bcc}
|
||||
if exists $params->{bcc};
|
||||
}
|
||||
if ( C4::Context->preference('ReturnpathDefault') ) {
|
||||
$params->{sender} ||= C4::Context->preference('ReturnpathDefault');
|
||||
|
||||
foreach my $address ( keys %{ $addresses } ) {
|
||||
Koha::Exceptions::BadParameter->throw("Invalid '$address' parameter: ".$addresses->{$address})
|
||||
if $addresses->{$address} and !Email::Valid->address($addresses->{$address});
|
||||
}
|
||||
$mail{'Reply-to'} = $params->{replyto} if $params->{replyto};
|
||||
$mail{'Sender'} = $params->{sender} if $params->{sender};
|
||||
$mail{'Message'} = $params->{message} if $params->{message};
|
||||
$mail{'Subject'} = $params->{subject} if $params->{subject};
|
||||
$mail{'Content-Type'} = $params->{contenttype} if $params->{contenttype};
|
||||
$mail{'X-Mailer'} = "Koha";
|
||||
$mail{'Message-ID'} = Email::MessageID->new->in_brackets;
|
||||
return %mail;
|
||||
|
||||
$args->{cc} = $addresses->{cc}
|
||||
if $addresses->{cc};
|
||||
$args->{bcc} = $addresses->{bcc}
|
||||
if $addresses->{bcc};
|
||||
|
||||
my $email = $self->SUPER::new( $args );
|
||||
|
||||
$email->header( 'ReplyTo', $addresses->{reply_to} )
|
||||
if $addresses->{reply_to};
|
||||
|
||||
$email->header( 'Sender' => $addresses->{sender} ) if $addresses->{sender};
|
||||
$email->header( 'Content-Type' => $params->{contenttype} ) if $params->{contenttype};
|
||||
$email->header( 'X-Mailer' => "Koha" );
|
||||
$email->header( 'Message-ID' => Email::MessageID->new->in_brackets );
|
||||
|
||||
if ( $params->{text_body} ) {
|
||||
$email->text_body( $params->{text_body}, %{ $params->{body_params} } );
|
||||
}
|
||||
elsif ( $params->{html_body} ) {
|
||||
$email->html_body( $params->{html_body}, %{ $params->{body_params} } );
|
||||
}
|
||||
|
||||
return $email;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
1
cpanfile
1
cpanfile
|
|
@ -37,6 +37,7 @@ requires 'Digest::SHA', '5.43';
|
|||
requires 'Email::Date', '1.103';
|
||||
requires 'Email::MessageID', '1.406';
|
||||
requires 'Email::Sender', '1.300030';
|
||||
requires 'Email::Stuffer', '0.014';
|
||||
requires 'Email::Valid', '0.190';
|
||||
requires 'Exception::Class', '1.38';
|
||||
requires 'File::Slurp', '9999.13';
|
||||
|
|
|
|||
|
|
@ -0,0 +1,177 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# This file is part of Koha.
|
||||
#
|
||||
# Koha is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# Koha is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||
|
||||
use Modern::Perl;
|
||||
|
||||
use Test::More tests => 2;
|
||||
use Test::Exception;
|
||||
|
||||
use t::lib::Mocks;
|
||||
|
||||
use_ok('Koha::Email');
|
||||
|
||||
subtest 'create() tests' => sub {
|
||||
|
||||
plan tests => 23;
|
||||
|
||||
t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
|
||||
|
||||
my $html_body = '<h1>Title</h1><p>Message</p>';
|
||||
my $text_body = "#Title: Message";
|
||||
|
||||
my $email = Koha::Email->create(
|
||||
{
|
||||
from => 'from@example.com',
|
||||
to => 'to@example.com',
|
||||
cc => 'cc@example.com',
|
||||
bcc => 'bcc@example.com',
|
||||
reply_to => 'reply_to@example.com',
|
||||
sender => 'sender@example.com',
|
||||
subject => 'Some subject',
|
||||
html_body => $html_body,
|
||||
body_params => { charset => 'iso-8859-1' },
|
||||
}
|
||||
);
|
||||
|
||||
is( $email->email->header('From'), 'from@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('To'), 'to@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('Cc'), 'cc@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('Bcc'), 'bcc@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('ReplyTo'), 'reply_to@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('Sender'), 'sender@example.com', 'Value set correctly' );
|
||||
is( $email->email->header('Subject'), 'Some subject', 'Value set correctly' );
|
||||
is( $email->email->header('X-Mailer'), 'Koha', 'Value set correctly' );
|
||||
is( $email->email->body, $html_body, "Body set correctly" );
|
||||
like( $email->email->content_type, qr|text/html|, "Content type set correctly");
|
||||
like( $email->email->content_type, qr|charset="?iso-8859-1"?|, "Charset set correctly");
|
||||
like( $email->email->header('Message-ID'), qr/\<.*@.*\>/, 'Value set correctly' );
|
||||
|
||||
t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'catchall@example.com' );
|
||||
t::lib::Mocks::mock_preference( 'ReplytoDefault', 'replytodefault@example.com' );
|
||||
t::lib::Mocks::mock_preference( 'ReturnpathDefault', 'returnpathdefault@example.com' );
|
||||
t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'kohaadminemailaddress@example.com' );
|
||||
|
||||
$email = Koha::Email->create(
|
||||
{
|
||||
to => 'to@example.com',
|
||||
cc => 'cc@example.com',
|
||||
bcc => 'bcc@example.com',
|
||||
text_body => $text_body,
|
||||
}
|
||||
);
|
||||
|
||||
is( $email->email->header('From'), 'kohaadminemailaddress@example.com', 'KohaAdminEmailAddress is picked when no from passed' );
|
||||
is( $email->email->header('To'), 'catchall@example.com', 'SendAllEmailsTo overloads any address' );
|
||||
is( $email->email->header('Cc'), undef, 'SendAllEmailsTo overloads any address' );
|
||||
is( $email->email->header('Bcc'), undef, 'SendAllEmailsTo overloads any address' );
|
||||
is( $email->email->header('ReplyTo'), 'replytodefault@example.com', 'ReplytoDefault picked when replyto not passed' );
|
||||
is( $email->email->header('Sender'), 'returnpathdefault@example.com', 'ReturnpathDefault picked when sender not passed' );
|
||||
is( $email->email->header('Subject'), '', 'No subject passed, empty string' );
|
||||
is( $email->email->body, $text_body, "Body set correctly" );
|
||||
like( $email->email->content_type, qr|text/plain|, "Content type set correctly");
|
||||
like( $email->email->content_type, qr|charset="?utf-8"?|, "Charset set correctly");
|
||||
|
||||
subtest 'exception cases' => sub {
|
||||
|
||||
plan tests => 16;
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create({ from => 'not_an_email' }); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'from' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'not_an_email' );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create({ }); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'from' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'tomasito@mail.com' );
|
||||
t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create({ to => 'not_an_email' }); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'to' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'not_an_email' );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create({ }); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'to' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create(
|
||||
{
|
||||
to => 'tomasito@mail.com',
|
||||
reply_to => 'not_an_email'
|
||||
}
|
||||
); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'reply_to' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create(
|
||||
{
|
||||
to => 'tomasito@mail.com',
|
||||
sender => 'not_an_email'
|
||||
}
|
||||
); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'sender' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create(
|
||||
{
|
||||
to => 'tomasito@mail.com',
|
||||
cc => 'not_an_email'
|
||||
}
|
||||
); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'cc' parameter: not_an_email}, 'Exception message correct' );
|
||||
|
||||
throws_ok
|
||||
{ Koha::Email->create(
|
||||
{
|
||||
to => 'tomasito@mail.com',
|
||||
bcc => 'not_an_email'
|
||||
}
|
||||
); }
|
||||
'Koha::Exceptions::BadParameter',
|
||||
'Exception thrown correctly';
|
||||
|
||||
is( "$@", q{Invalid 'bcc' parameter: not_an_email}, 'Exception message correct' );
|
||||
};
|
||||
};
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
use Modern::Perl;
|
||||
|
||||
use t::lib::Mocks;
|
||||
use Test::More tests => 4; # last test to print
|
||||
|
||||
use_ok('Koha::Email');
|
||||
|
||||
my $from = 'chrisc@catalyst.net.nz';
|
||||
t::lib::Mocks::mock_preference('ReplytoDefault', $from);
|
||||
t::lib::Mocks::mock_preference('ReturnpathDefault', $from);
|
||||
|
||||
|
||||
|
||||
ok( my $email = Koha::Email->new(), 'Create a Koha::Email Object');
|
||||
ok( my %mail = $email->create_message_headers({from => $from}),'Set headers');
|
||||
is ($mail{'From'}, $from, 'Set correctly');
|
||||
Loading…
Reference in New Issue