From c741692e14ea7453f6257e22aaee8ae377b59ebf Mon Sep 17 00:00:00 2001 From: Tomas Cohen Arazi Date: Fri, 5 Nov 2021 15:22:25 -0300 Subject: [PATCH] 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 Signed-off-by: David Nind Signed-off-by: Victor Grousset/tuxayo Signed-off-by: Martin Renvoize Signed-off-by: Marcel de Rooy Signed-off-by: Jonathan Druart --- Koha/Email.pm | 44 +++++++++++++++++++++++++++++++++++++++++++- t/Koha/Email.t | 27 ++++++++++++++++++++++++++- 2 files changed, 69 insertions(+), 2 deletions(-) diff --git a/Koha/Email.pm b/Koha/Email.pm index a5303c3c0b..090f475938 100644 --- a/Koha/Email.pm +++ b/Koha/Email.pm @@ -22,7 +22,9 @@ use Modern::Perl; use Email::Address; use Email::MessageID; +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. + +Note: I<$email_string> can be the produced by the I method from +B or B. + +=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( @@ -126,7 +153,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}; diff --git a/t/Koha/Email.t b/t/Koha/Email.t index 0d12016725..e89e807186 100755 --- a/t/Koha/Email.t +++ b/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 = '

Title

Message

'; + my $email_1 = Koha::Email->create( + { + from => 'Fróm ', + to => 'Tö ', + 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' ); +}; -- 2.39.5