From 41a70298a4dceedfee846451b5f4be4af2fd7102 Mon Sep 17 00:00:00 2001 From: Tomas Cohen Arazi Date: Thu, 6 Aug 2020 12:38:45 -0300 Subject: [PATCH] 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: Tomas Cohen Arazi --- Koha/Email.pm | 116 +++++++++++++++++++++++++++++++++---------------- cpanfile | 1 + t/Koha/Email.t | 86 ++++++++++++++++++++++++++++++++++++ t/Koha_Email.t | 16 ------- 4 files changed, 166 insertions(+), 53 deletions(-) create mode 100644 t/Koha/Email.t delete mode 100755 t/Koha_Email.t diff --git a/Koha/Email.pm b/Koha/Email.pm index f1e825e526..e899b903d2 100644 --- a/Koha/Email.pm +++ b/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,103 @@ # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -package Koha::Email; - use Modern::Perl; + use Email::Valid; use Email::MessageID; -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, ] + from => $from, + to => $to, + cc => $cc, + bcc => $bcc, + replyto => $replyto, + sender => $sender, + subject => $subject, + charset => $charset, + } + ); + +This method creates a new Email::Simple object taking Koha specific configurations +into account. + +Parameters: + - I defaults to the value of the I system preference + - I defaults to B + - The I system preference overloads the I, I and I parameters + - I defaults to the value of the I system preference + - I defaults to the value of the I system preference =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 $from = $params->{from} // C4::Context->preference('KohaAdminEmailAddress'); + my $charset = $params->{charset} // 'utf8'; + my $subject = $params->{subject} // ''; + + my $args = { + from => $from, + subject => $subject, + }; + + $params->{replyto} ||= C4::Context->preference('ReplytoDefault') + if C4::Context->preference('ReplytoDefault'); + + $params->{sender} ||= C4::Context->preference('ReturnpathDefault') + if C4::Context->preference('ReturnpathDefault') ; + + + if ( C4::Context->preference('SendAllEmailsTo') + && Email::Valid->address( 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}; + $args->{cc} = $params->{cc} + if exists $params->{cc}; + $args->{bcc} = $params->{bcc} + if exists $params->{bcc}; } - if ( C4::Context->preference('ReplytoDefault') ) { - $params->{replyto} ||= C4::Context->preference('ReplytoDefault'); + my $email = $self->SUPER::new( $args ); + + $email->header( 'ReplyTo', $params->{replyto} ) + if $params->{replyto}; + + $email->header( 'charset' => $charset ); + $email->header( 'Sender' => $params->{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} ); } - if ( C4::Context->preference('ReturnpathDefault') ) { - $params->{sender} ||= C4::Context->preference('ReturnpathDefault'); + elsif ( $params->{html_body} ) { + $email->html_body( $params->{html_body} ); } - $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; + + return $email; } + 1; diff --git a/cpanfile b/cpanfile index 05ae2aa495..d5958efa33 100644 --- a/cpanfile +++ b/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'; diff --git a/t/Koha/Email.t b/t/Koha/Email.t new file mode 100644 index 0000000000..b76959d99e --- /dev/null +++ b/t/Koha/Email.t @@ -0,0 +1,86 @@ +#!/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 . + +use Modern::Perl; + +use Test::More tests => 2; + +use t::lib::Mocks; + +use_ok('Koha::Email'); + +subtest 'create() tests' => sub { + + plan tests => 21; + + t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef ); + + my $html_body = '

Title

Message

'; + my $text_body = "#Title: Message"; + + my $email = Koha::Email->create( + { + from => 'from@example.com', + charset => 'iso-8859-1', + to => 'to@example.com', + cc => 'cc@example.com', + bcc => 'bcc@example.com', + replyto => 'replyto@example.com', + sender => 'sender@example.com', + subject => 'Some subject', + html_body => $html_body, + } + ); + + is( $email->email->header('From'), 'from@example.com', 'Value set correctly' ); + is( $email->email->header('charset'), 'iso-8859-1', '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'), 'replyto@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" ); + is( $email->email->content_type, 'text/html; charset="utf-8"', "Content type 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('charset'), 'utf8', 'utf8 is the default' ); + 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->body, $text_body, "Body set correctly" ); + is( $email->email->content_type, 'text/plain; charset="utf-8"; format="flowed"', "Content type set correctly"); +}; + diff --git a/t/Koha_Email.t b/t/Koha_Email.t deleted file mode 100755 index 93dd55bd6d..0000000000 --- a/t/Koha_Email.t +++ /dev/null @@ -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'); -- 2.28.0