Bug 25067: Fix perlcritic errors
[koha.git] / Koha / Email.pm
blobe91a49e402194dfbd084715f69eb7772011f74ad
1 package Koha::Email;
3 # Copyright 2014 Catalyst
4 # 2020 Theke Solutions
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>.
21 use Modern::Perl;
23 use Email::Valid;
24 use Email::MessageID;
25 use Koha::Exceptions;
27 use C4::Context;
29 use base qw( Email::Stuffer );
31 =head1 NAME
33 Koha::Email - A wrapper around Email::Stuffer
35 =head1 API
37 =head2 Class methods
39 =head3 create
41 my $email = Koha::Email->create(
43 [ text_body => $text_message,
44 html_body => $html_message,
45 body_params => $body_params ]
46 from => $from,
47 to => $to,
48 cc => $cc,
49 bcc => $bcc,
50 reply_to => $reply_to,
51 sender => $sender,
52 subject => $subject,
56 This method creates a new Email::Stuffer object taking Koha specific configurations
57 into account.
59 The encoding defaults to utf-8. It can be set as part of the body_params hashref. See
60 I<Email::Stuffer> and I<Email::MIME> for more details on the available options.
62 Parameters:
63 - I<from> defaults to the value of the I<KohaAdminEmailAddress> system preference
64 - The I<SendAllEmailsTo> system preference overloads the I<to>, I<cc> and I<bcc> parameters
65 - I<reply_to> defaults to the value of the I<ReplytoDefault> system preference
66 - I<sender> defaults to the value of the I<ReturnpathDefault> system preference
68 Both I<text_body> and I<html_body> can be set later. I<body_params> will be passed if present
69 to the constructor.
71 =cut
73 sub create {
74 my ( $self, $params ) = @_;
76 my $args = {};
77 $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
78 Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
79 unless Email::Valid->address($args->{from}); # from is mandatory
81 $args->{subject} = $params->{subject} // '';
83 if ( C4::Context->preference('SendAllEmailsTo') ) {
84 $args->{to} = C4::Context->preference('SendAllEmailsTo');
86 else {
87 $args->{to} = $params->{to};
90 Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
91 unless Email::Valid->address($args->{to}); # to is mandatory
93 my $addresses = {};
94 $addresses->{reply_to} = $params->{reply_to};
95 $addresses->{reply_to} ||= C4::Context->preference('ReplytoDefault')
96 if C4::Context->preference('ReplytoDefault');
98 $addresses->{sender} = $params->{sender};
99 $addresses->{sender} ||= C4::Context->preference('ReturnpathDefault')
100 if C4::Context->preference('ReturnpathDefault');
102 unless ( C4::Context->preference('SendAllEmailsTo') ) {
103 $addresses->{cc} = $params->{cc}
104 if exists $params->{cc};
105 $addresses->{bcc} = $params->{bcc}
106 if exists $params->{bcc};
109 foreach my $address ( keys %{ $addresses } ) {
110 Koha::Exceptions::BadParameter->throw("Invalid '$address' parameter: ".$addresses->{$address})
111 if $addresses->{$address} and !Email::Valid->address($addresses->{$address});
114 $args->{cc} = $addresses->{cc}
115 if $addresses->{cc};
116 $args->{bcc} = $addresses->{bcc}
117 if $addresses->{bcc};
119 my $email = $self->SUPER::new( $args );
121 $email->header( 'ReplyTo', $addresses->{reply_to} )
122 if $addresses->{reply_to};
124 $email->header( 'Sender' => $addresses->{sender} ) if $addresses->{sender};
125 $email->header( 'Content-Type' => $params->{contenttype} ) if $params->{contenttype};
126 $email->header( 'X-Mailer' => "Koha" );
127 $email->header( 'Message-ID' => Email::MessageID->new->in_brackets );
129 if ( $params->{text_body} ) {
130 $email->text_body( $params->{text_body}, %{ $params->{body_params} } );
132 elsif ( $params->{html_body} ) {
133 $email->html_body( $params->{html_body}, %{ $params->{body_params} } );
136 return $email;