Koha/Email.pm

   1 package Koha::Email;
   2
   3 # Copyright 2014 Catalyst
   4 #           2020 Theke Solutions
   5 #
   6 # This file is part of Koha.
   7 #
   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.
  12 #
  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.
  17 #
  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>.
  20
  21 use Modern::Perl;
  22
  23 use Email::Valid;
  24 use Email::MessageID;
  25 use Koha::Exceptions;
  26
  27 use C4::Context;
  28
  29 use base qw( Email::Stuffer );
  30
  31 =head1 NAME
  32
  33 Koha::Email - A wrapper around Email::Stuffer
  34
  35 =head1 API
  36
  37 =head2 Class methods
  38
  39 =head3 create
  40
  41     my $email = Koha::Email->create(
  42         {
  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,
  53         }
  54     );
  55
  56 This method creates a new Email::Stuffer object taking Koha specific configurations
  57 into account.
  58
  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.
  61
  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
  67
  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.
  70
  71 =cut
  72
  73 sub create {
  74     my ( $self, $params ) = @_;
  75
  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
  80
  81     $args->{subject} = $params->{subject} // '';
  82
  83     if ( C4::Context->preference('SendAllEmailsTo') ) {
  84         $args->{to} = C4::Context->preference('SendAllEmailsTo');
  85     }
  86     else {
  87         $args->{to} = $params->{to};
  88     }
  89
  90     Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
  91         unless Email::Valid->address($args->{to}); # to is mandatory
  92
  93     my $addresses = {};
  94     $addresses->{reply_to} = $params->{reply_to};
  95     $addresses->{reply_to} ||= C4::Context->preference('ReplytoDefault')
  96         if C4::Context->preference('ReplytoDefault');
  97
  98     $addresses->{sender} = $params->{sender};
  99     $addresses->{sender} ||= C4::Context->preference('ReturnpathDefault')
 100         if C4::Context->preference('ReturnpathDefault');
 101
 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};
 107     }
 108
 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});
 112     }
 113
 114     $args->{cc} = $addresses->{cc}
 115         if $addresses->{cc};
 116     $args->{bcc} = $addresses->{bcc}
 117         if $addresses->{bcc};
 118
 119     my $email = $self->SUPER::new( $args );
 120
 121     $email->header( 'ReplyTo', $addresses->{reply_to} )
 122         if $addresses->{reply_to};
 123
 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 );
 128
 129     if ( $params->{text_body} ) {
 130         $email->text_body( $params->{text_body}, %{ $params->{body_params} } );
 131     }
 132     elsif ( $params->{html_body} ) {
 133         $email->html_body( $params->{html_body}, %{ $params->{body_params} } );
 134     }
 135
 136     return $email;
 137 }
 138
 139 1;