3 # Copyright 2014 Catalyst
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
26 use List::Util qw( pairs );
27 use Scalar::Util qw( blessed );
33 use base qw( Email::Stuffer );
37 Koha::Email - A wrapper around Email::Stuffer
43 =head3 new_from_string
45 my $email = Koha::Email->new_from_string( $email_string );
47 Constructor for the Koha::Email class. The I<$email_string> (mandatory)
48 parameter will be parsed with I<Email::MIME>.
50 Note: I<$email_string> can be the produced by the I<as_string> method from
51 B<Koha::Email> or B<Email::MIME>.
56 my ( $class, $email_string ) = @_;
58 Koha::Exceptions::MissingParameter->throw("Mandatory string parameter missing.")
61 my $self = $class->SUPER::new();
62 my $mime = Email::MIME->new( $email_string );
63 $self->{email} = $mime;
70 my $email = Koha::Email->create(
72 [ text_body => $text_message,
73 html_body => $html_message,
74 body_params => $body_params ]
79 reply_to => $reply_to,
85 This method creates a new Email::Stuffer object taking Koha specific configurations
88 The encoding defaults to utf-8. It can be set as part of the body_params hashref. See
89 I<Email::Stuffer> and I<Email::MIME> for more details on the available options.
92 - I<from> defaults to the value of the I<KohaAdminEmailAddress> system preference
93 - The I<SendAllEmailsTo> system preference overloads the I<to>, I<cc> and I<bcc> parameters
94 - I<reply_to> defaults to the value of the I<ReplytoDefault> system preference
95 - I<sender> defaults to the value of the I<ReturnpathDefault> system preference
97 Both I<text_body> and I<html_body> can be set later. I<body_params> will be passed if present
103 my ( $self, $params ) = @_;
106 $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
107 Koha::Exceptions::BadParameter->throw(
108 error => "Invalid 'from' parameter: " . $args->{from},
110 ) unless Koha::Email->is_valid( $args->{from} ); # from is mandatory
112 $args->{subject} = $params->{subject} // '';
114 if ( C4::Context->preference('SendAllEmailsTo') ) {
115 $args->{to} = C4::Context->preference('SendAllEmailsTo');
118 $args->{to} = $params->{to};
121 Koha::Exceptions::BadParameter->throw(
122 error => "Invalid 'to' parameter: " . $args->{to},
124 ) unless Koha::Email->is_valid( $args->{to} );
127 $addresses->{reply_to} = $params->{reply_to};
128 $addresses->{reply_to} ||= C4::Context->preference('ReplytoDefault')
129 if C4::Context->preference('ReplytoDefault');
131 $addresses->{sender} = $params->{sender};
132 $addresses->{sender} ||= C4::Context->preference('ReturnpathDefault')
133 if C4::Context->preference('ReturnpathDefault');
135 unless ( C4::Context->preference('SendAllEmailsTo') ) {
136 $addresses->{cc} = $params->{cc}
137 if exists $params->{cc};
138 $addresses->{bcc} = $params->{bcc}
139 if exists $params->{bcc};
142 foreach my $address ( keys %{$addresses} ) {
143 Koha::Exceptions::BadParameter->throw(
144 error => "Invalid '$address' parameter: " . $addresses->{$address},
145 parameter => $address
147 if $addresses->{$address}
148 and !Koha::Email->is_valid( $addresses->{$address} );
151 $args->{cc} = $addresses->{cc}
153 $args->{bcc} = $addresses->{bcc}
154 if $addresses->{bcc};
157 # FIXME: This is ugly, but aids backportability
158 # TODO: Remove this and move address and default headers handling
159 # to separate subs to be (re)used
160 if ( blessed($self) ) {
162 $email->to( $args->{to} ) if $args->{to};
163 $email->from( $args->{from} ) if $args->{from};
164 $email->cc( $args->{cc} ) if $args->{cc};
165 $email->bcc( $args->{bcc} ) if $args->{bcc};
166 $email->reply_to( $args->{reply_to} ) if $args->{reply_to};
167 $email->subject( $args->{subject} ) if $args->{subject};
170 $email = $self->SUPER::new( $args );
173 $email->header( 'Reply-To', $addresses->{reply_to} )
174 if $addresses->{reply_to};
176 $email->header( 'Sender' => $addresses->{sender} ) if $addresses->{sender};
177 $email->header( 'Content-Type' => $params->{contenttype} ) if $params->{contenttype};
178 $email->header( 'X-Mailer' => "Koha" );
179 $email->header( 'Message-ID' => Email::MessageID->new->in_brackets );
181 if ( $params->{text_body} ) {
182 $email->text_body( $params->{text_body}, %{ $params->{body_params} } );
184 elsif ( $params->{html_body} ) {
185 $email->html_body( $params->{html_body}, %{ $params->{body_params} } );
193 $email->send_or_die({ transport => $transport [, $args] });
195 Overloaded Email::Stuffer I<send_or_die> method, that takes care of Bcc and Return-path
198 Bcc is removed from the message headers, and included in the recipients list to be
199 passed to I<send_or_die>.
201 Return-path, 'MAIL FROM', is set to the 'Sender' email header unless an explicit 'from'
202 parameter is passed to send_or_die. 'Return-path' headers are actually set by the MTA,
203 usually using the 'MAIL FROM' information set at mail server connection time.
208 my ( $self, $args ) = @_;
210 unless ( $args->{to} ) { # don't do it if passed an explicit 'to' param
214 my @headers = $self->email->header_str_pairs;
215 foreach my $pair ( pairs @headers ) {
216 my ( $header, $value ) = @$pair;
217 push @recipients, split (', ', $value)
218 if grep { $_ eq $header } ('To', 'Cc', 'Bcc');
221 # Remove the Bcc header
222 $self->email->header_str_set('Bcc');
225 $args->{to} = \@recipients;
228 unless ( $args->{from} ) { # don't do it if passed an explicit 'from' param
229 $args->{from} = $self->email->header_str('Sender');
230 $self->email->header_str_set('Sender'); # remove Sender header
233 $self->SUPER::send_or_die($args);
238 my $is_valid = Koha::Email->is_valid($email_address);
240 Return true is the email address passed in parameter is valid following RFC 2822.
245 my ( $class, $email ) = @_;
246 my @addrs = Email::Address->parse($email);
247 return @addrs ? 1 : 0;