From c0290b4a3e37470f4348e7b0646e913ee8607023 Mon Sep 17 00:00:00 2001
From: Tomas Cohen Arazi <tomascohen@theke.io>
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
---
 Koha/Email.pm  | 135 ++++++++++++++++++++++++++-----------
 cpanfile       |   1 +
 t/Koha/Email.t | 177 +++++++++++++++++++++++++++++++++++++++++++++++++
 t/Koha_Email.t |  16 -----
 4 files changed, 276 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..e91a49e402 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,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 API
+
+=head2 Class methods
 
-=head1 SYNOPSIS
+=head3 create
 
-  use Koha::Email;
-  my $email = Koha::Email->new();
-  my %mail = $email->create_message_headers({ to => $to_address, from => $from_address,
-                                             replyto => $replyto });
+    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
 
-=head1 FUNCTIONS
+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 ) = @_;
+
+    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') && Email::Valid->address(C4::Context->preference('SendAllEmailsTo'))) {
-        $mail{'To'} = C4::Context->preference('SendAllEmailsTo');
+    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;
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..1c46fcc284
--- /dev/null
+++ b/t/Koha/Email.t
@@ -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' );
+    };
+};
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