LP#1955079: Use Email::MIME for emailing records in the OPAC

Email::Simple was mangling the headers.  Let's use Email::MIME instead.

Signed-off-by: Jane Sandberg <sandbergja@gmail.com>
Signed-off-by: Garry Collum <gcollum@gmail.com>
Signed-off-by: Michele Morgan <mmorgan@noblenet.org>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm
index bb6618a..9a27159 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm
@@ -11,7 +11,7 @@ use OpenILS::Utils::CStoreEditor q/:funcs/;
 use OpenSRF::Utils::Cache;
 use Encode;
 use Email::Send;
-use Email::Simple;
+use Email::MIME;
 
 use OpenSRF::Utils::Logger qw/:logger/;
 
@@ -1942,16 +1942,7 @@ sub send_event_email_output {
     my $stat;
     my $err;
 
-    my $email = Email::Simple->new($event->template_output->data);
-
-    for my $hfield (qw/From To Subject Bcc Cc Reply-To Sender/) {
-        my @headers = $email->header($hfield);
-        $email->header_set($hfield => map { encode("MIME-Header", $_) } @headers) if ($headers[0]);
-    }
-
-    $email->header_set('MIME-Version' => '1.0');
-    $email->header_set('Content-Type' => "text/plain; charset=UTF-8");
-    $email->header_set('Content-Transfer-Encoding' => '8bit');
+    my $email = _create_mime_email($event->template_output->data);
 
     try {
         $stat = $sender->send($email);
@@ -1969,6 +1960,23 @@ sub send_event_email_output {
     }
 }
 
+sub _create_mime_email {
+    my $template_output = shift;
+    my $email = Email::MIME->new($template_output);
+    for my $hfield (qw/From To Bcc Cc Reply-To Sender/) {
+        my @headers = $email->header($hfield);
+        $email->header_str_set($hfield => join(',', @headers)) if ($headers[0]);
+    }
+
+    my @headers = $email->header('Subject');
+    $email->header_str_set('Subject' => $headers[0]) if ($headers[0]);
+
+    $email->header_set('MIME-Version' => '1.0');
+    $email->header_set('Content-Type' => "text/plain; charset=UTF-8");
+    $email->header_set('Content-Transfer-Encoding' => '8bit');
+    return $email;
+}
+
 __PACKAGE__->register_method(
     method    => "format_biblio_record_entry",
     api_name  => "open-ils.search.biblio.record.print.preview",

diff --git a/Open-ILS/src/perlmods/live_t/35-lp1955079-send-record-email.t b/Open-ILS/src/perlmods/live_t/35-lp1955079-send-record-email.t
new file mode 100644 (file)
index 0000000..8a908b6
--- /dev/null
+++ b/Open-ILS/src/perlmods/live_t/35-lp1955079-send-record-email.t
@@ -0,0 +1,64 @@
+#!perl
+
+use strict; use warnings;
+use Test::More tests => 6;
+use Test::MockModule;
+use OpenILS::Utils::TestUtils;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use Apache2::Const -compile => qw(OK);
+use CGI;
+
+use_ok('OpenILS::WWW::EGCatLoader');
+can_ok( 'OpenILS::WWW::EGCatLoader', 'load_print_or_email_preview' );
+can_ok( 'OpenILS::WWW::EGCatLoader', 'load_email_record' );
+
+use constant ATEV_ID => '123456789';
+use constant PATRON_USERNAME  => '99999359616';
+use constant PATRON_PASSWORD  => 'andreac1234';
+
+my $script = OpenILS::Utils::TestUtils->new();
+$script->bootstrap;
+$script->authenticate({
+        username => PATRON_USERNAME,
+        password => PATRON_PASSWORD,
+        type => 'opac'
+    });
+ok($script->authtoken, 'Have an authtoken');
+my $authtoken = $script->authtoken;
+
+my $loader_mock = Test::MockModule->new('OpenILS::WWW::EGCatLoader');
+$loader_mock->mock(
+  cgi => sub {
+    my $cgi = CGI->new();
+    $cgi->param('context_org', 1);
+    $cgi->param('redirect_to', '/');
+    return $cgi;},
+);
+
+my $email_mock = Test::MockModule->new('Email::Send');
+$email_mock->mock(
+  send => sub {}
+);
+
+my $ctx = {
+  'authtoken' => $authtoken,
+  'page_args' => [254],
+  'get_aou' => sub {
+    my $ou = Fieldmapper::actor::org_unit->new;
+    $ou->id(1);
+    return $ou;}
+};
+
+my $loader = new OpenILS::WWW::EGCatLoader(1, $ctx);
+
+my $preview_response = $loader->load_print_or_email_preview('email');
+is $preview_response, Apache2::Const::OK, 'Email preview delivers a good response';
+
+my $event_id = $loader->ctx->{preview_record}->id();
+
+unshift @{$loader->ctx->{page_args}}, $event_id;
+
+my $response = $loader->load_email_record();
+is $response, Apache2::Const::OK, 'Email record from OPAC delivers a good response';
+
+1;
\ No newline at end of file

diff --git a/Open-ILS/src/perlmods/t/25-lp1955079-opac-mime-email.t b/Open-ILS/src/perlmods/t/25-lp1955079-opac-mime-email.t
new file mode 100644 (file)
index 0000000..f86f6b5
--- /dev/null
+++ b/Open-ILS/src/perlmods/t/25-lp1955079-opac-mime-email.t
@@ -0,0 +1,38 @@
+#!perl -T
+
+use strict; use warnings;
+use Test::More tests => 4;
+
+BEGIN {
+  use_ok( 'OpenILS::Application::Search' );
+}
+
+use_ok( 'OpenILS::Application::Search::Biblio' );
+can_ok( 'OpenILS::Application::Search::Biblio', '_create_mime_email' );
+
+my $raw_email = <<'END_EMAIL';
+To: test@example.com
+From: no-reply@localhost.com
+Date: Thu, 05 May 2022 18:21:48 -0000
+Subject: Bibliographic Records
+Auto-Submitted: auto-generated
+END_EMAIL
+
+my @expected_headers = [
+  'To' => 'test@example.com',
+  'From' => 'no-reply@localhost.com',
+  'Date' => 'Thu, 05 May 2022 18:21:48 -0000',
+  'Subject' => 'Bibliographic Records',
+  'Auto-Submitted' => 'auto-generated',
+  'MIME-Version' => '1.0',
+  'Content-Type' => 'text/plain; charset=UTF-8',
+  'Content-Transfer-Encoding' => '8bit'
+];
+
+my $mime_email = OpenILS::Application::Search::Biblio::_create_mime_email($raw_email);
+my @actual_headers = $mime_email->header_str_pairs;
+
+is_deeply(\@actual_headers, @expected_headers, 'Headers do not get mangled in the process');
+
+1;
+