Bug 29330: Add Koha::Email->new_from_string

This patch introduces a new method to Koha::Email. This method allows us
to parse a MIME email to initialize the Koha::Email object. This is
particularly important when we are restoring emails from the DB. i.e.
from the *message_queue* table.

To test:
1. Apply this patch
2. Run:
   $ kshell
  k$ prove t/Koha/Email.t
=> SUCCESS: Tests pass! Koha::Email->new_from_string is the correct
counterpart for Koha::Email->as_string!
3. Sign off :-D

Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Victor Grousset/tuxayo <victor@tuxayo.net>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
(cherry picked from commit 2d6a189e89)
Signed-off-by: Victor Grousset/tuxayo <victor@tuxayo.net>

Koha/Email.pm

@@ -22,7 +22,9 @@ use Modern::Perl;
 
 use Email::Address;
 use Email::MessageID;
-use List::Util qw(pairs);
+use Email::MIME;
+use List::Util qw( pairs );
+use Scalar::Util qw( blessed );
 
 use Koha::Exceptions;
 
@@ -38,6 +40,31 @@ Koha::Email - A wrapper around Email::Stuffer
 
 =head2 Class methods
 
+=head3 new_from_string
+
+    my $email = Koha::Email->new_from_string( $email_string );
+
+Constructor for the Koha::Email class. The I<$email_string> (mandatory)
+parameter will be parsed with I<Email::MIME>.
+
+Note: I<$email_string> can be the produced by the I<as_string> method from
+B<Koha::Email> or B<Email::MIME>.
+
+=cut
+
+sub new_from_string {
+    my ( $class, $email_string ) = @_;
+
+    Koha::Exceptions::MissingParameter->throw("Mandatory string parameter missing.")
+        unless $email_string;
+
+    my $self = $class->SUPER::new();
+    my $mime = Email::MIME->new( $email_string );
+    $self->{email} = $mime;
+
+    return $self;
+}
+
 =head3 create
 
     my $email = Koha::Email->create(
@@ -120,7 +147,22 @@ sub create {
     $args->{bcc} = $addresses->{bcc}
         if $addresses->{bcc};
 
-    my $email = $self->SUPER::new( $args );
+    my $email;
+    # FIXME: This is ugly, but aids backportability
+    # TODO: Remove this and move address and default headers handling
+    #       to separate subs to be (re)used
+    if ( blessed($self) ) {
+        $email = $self;
+        $email->to( $args->{to} )             if $args->{to};
+        $email->from( $args->{from} )         if $args->{from};
+        $email->cc( $args->{cc} )             if $args->{cc};
+        $email->bcc( $args->{bcc} )           if $args->{bcc};
+        $email->reply_to( $args->{reply_to} ) if $args->{reply_to};
+        $email->subject( $args->{subject} )   if $args->{subject};
+    }
+    else {
+        $email = $self->SUPER::new( $args );
+    }
 
     $email->header( 'Reply-To', $addresses->{reply_to} )
         if $addresses->{reply_to};

t/Koha/Email.t

@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 4;
+use Test::More tests => 5;
 
 use Test::MockModule;
 use Test::Exception;
@@ -266,3 +266,28 @@ subtest 'is_valid' => sub {
     isnt(Koha::Email->is_valid('example.com'), 1);
     isnt(Koha::Email->is_valid('from'), 1);
 };
+
+subtest 'new_from_string() tests' => sub {
+
+    plan tests => 1;
+
+    my $html_body = '<h1>Title</h1><p>Message</p>';
+    my $email_1 = Koha::Email->create(
+        {
+            from        => 'Fróm <from@example.com>',
+            to          => 'Tö <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' },
+        }
+    );
+
+    my $string = $email_1->as_string;
+    my $email_2 = Koha::Email->new_from_string( $string );
+
+    is( $email_1->as_string, $email_2->as_string, 'Emails match' );
+};