View | Details | Raw Unified | Return to bug 22343
Collapse All | Expand All

(-)a/Koha/Email.pm (-37 / +98 lines)
Lines 1-4 Link Here
1
package Koha::Email;
2
1
# Copyright 2014 Catalyst
3
# Copyright 2014 Catalyst
4
#           2020 Theke Solutions
2
#
5
#
3
# This file is part of Koha.
6
# This file is part of Koha.
4
#
7
#
Lines 15-78 Link Here
15
# You should have received a copy of the GNU General Public License
18
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
20
18
package Koha::Email;
19
20
use Modern::Perl;
21
use Modern::Perl;
22
21
use Email::Valid;
23
use Email::Valid;
22
use Email::MessageID;
24
use Email::MessageID;
25
use Koha::Exceptions;
23
26
24
use base qw(Class::Accessor);
25
use C4::Context;
27
use C4::Context;
26
28
27
__PACKAGE__->mk_accessors(qw( ));
29
use base qw( Email::Stuffer );
28
30
29
=head1 NAME
31
=head1 NAME
30
32
31
Koha::Email
33
Koha::Email - A wrapper around Email::Stuffer
34
35
=head1 API
36
37
=head2 Class methods
32
38
33
=head1 SYNOPSIS
39
=head3 create
34
40
35
  use Koha::Email;
41
    my $email = Koha::Email->create(
36
  my $email = Koha::Email->new();
42
        {
37
  my %mail = $email->create_message_headers({ to => $to_address, from => $from_address,
43
          [ text_body   => $text_message,
38
                                             replyto => $replyto });
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
39
67
40
=head1 FUNCTIONS
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.
41
70
42
=cut
71
=cut
43
72
44
sub create_message_headers {
73
sub create {
45
    my $self   = shift;
74
    my ( $self, $params ) = @_;
46
    my $params = shift;
75
47
    $params->{from} ||= C4::Context->preference('KohaAdminEmailAddress');
76
    my $args = {};
48
    $params->{charset} ||= 'utf8';
77
    $args->{from} = $params->{from} || C4::Context->preference('KohaAdminEmailAddress');
49
    my %mail = (
78
    Koha::Exceptions::BadParameter->throw("Invalid 'from' parameter: ".$args->{from})
50
        To      => $params->{to},
79
        unless Email::Valid->address($args->{from}); # from is mandatory
51
        From    => $params->{from},
80
52
        charset => $params->{charset}
81
    $args->{subject} = $params->{subject} // '';
53
    );
54
82
55
    if (C4::Context->preference('SendAllEmailsTo') && Email::Valid->address(C4::Context->preference('SendAllEmailsTo'))) {
83
    if ( C4::Context->preference('SendAllEmailsTo') ) {
56
        $mail{'To'} = C4::Context->preference('SendAllEmailsTo');
84
        $args->{to} = C4::Context->preference('SendAllEmailsTo');
57
    }
85
    }
58
    else {
86
    else {
59
        $mail{'Cc'}  = $params->{cc}  if exists $params->{cc};
87
        $args->{to} = $params->{to};
60
        $mail{'Bcc'} = $params->{bcc} if exists $params->{bcc};
61
    }
88
    }
62
89
63
    if ( C4::Context->preference('ReplytoDefault') ) {
90
    Koha::Exceptions::BadParameter->throw("Invalid 'to' parameter: ".$args->{to})
64
        $params->{replyto} ||= C4::Context->preference('ReplytoDefault');
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};
65
    }
107
    }
66
    if ( C4::Context->preference('ReturnpathDefault') ) {
108
67
        $params->{sender} ||= C4::Context->preference('ReturnpathDefault');
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});
68
    }
112
    }
69
    $mail{'Reply-to'}     = $params->{replyto}     if $params->{replyto};
113
70
    $mail{'Sender'}       = $params->{sender}      if $params->{sender};
114
    $args->{cc} = $addresses->{cc}
71
    $mail{'Message'}      = $params->{message}     if $params->{message};
115
        if $addresses->{cc};
72
    $mail{'Subject'}      = $params->{subject}     if $params->{subject};
116
    $args->{bcc} = $addresses->{bcc}
73
    $mail{'Content-Type'} = $params->{contenttype} if $params->{contenttype};
117
        if $addresses->{bcc};
74
    $mail{'X-Mailer'}     = "Koha";
118
75
    $mail{'Message-ID'}   = Email::MessageID->new->in_brackets;
119
    my $email = $self->SUPER::new( $args );
76
    return %mail;
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;
77
}
137
}
138
78
1;
139
1;
(-)a/cpanfile (+1 lines)
Lines 37-42 requires 'Digest::SHA', '5.43'; Link Here
37
requires 'Email::Date', '1.103';
37
requires 'Email::Date', '1.103';
38
requires 'Email::MessageID', '1.406';
38
requires 'Email::MessageID', '1.406';
39
requires 'Email::Sender', '1.300030';
39
requires 'Email::Sender', '1.300030';
40
requires 'Email::Stuffer', '0.014';
40
requires 'Email::Valid', '0.190';
41
requires 'Email::Valid', '0.190';
41
requires 'Exception::Class', '1.38';
42
requires 'Exception::Class', '1.38';
42
requires 'File::Slurp', '9999.13';
43
requires 'File::Slurp', '9999.13';
(-)a/t/Koha/Email.t (+177 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use Test::More tests => 2;
21
use Test::Exception;
22
23
use t::lib::Mocks;
24
25
use_ok('Koha::Email');
26
27
subtest 'create() tests' => sub {
28
29
    plan tests => 23;
30
31
    t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
32
33
    my $html_body = '<h1>Title</h1><p>Message</p>';
34
    my $text_body = "#Title: Message";
35
36
    my $email = Koha::Email->create(
37
        {
38
            from        => 'from@example.com',
39
            to          => 'to@example.com',
40
            cc          => 'cc@example.com',
41
            bcc         => 'bcc@example.com',
42
            reply_to    => 'reply_to@example.com',
43
            sender      => 'sender@example.com',
44
            subject     => 'Some subject',
45
            html_body   => $html_body,
46
            body_params => { charset => 'iso-8859-1' },
47
        }
48
    );
49
50
    is( $email->email->header('From'), 'from@example.com', 'Value set correctly' );
51
    is( $email->email->header('To'), 'to@example.com', 'Value set correctly' );
52
    is( $email->email->header('Cc'), 'cc@example.com', 'Value set correctly' );
53
    is( $email->email->header('Bcc'), 'bcc@example.com', 'Value set correctly' );
54
    is( $email->email->header('ReplyTo'), 'reply_to@example.com', 'Value set correctly' );
55
    is( $email->email->header('Sender'), 'sender@example.com', 'Value set correctly' );
56
    is( $email->email->header('Subject'), 'Some subject', 'Value set correctly' );
57
    is( $email->email->header('X-Mailer'), 'Koha', 'Value set correctly' );
58
    is( $email->email->body, $html_body, "Body set correctly" );
59
    like( $email->email->content_type, qr|text/html|, "Content type set correctly");
60
    like( $email->email->content_type, qr|charset="?iso-8859-1"?|, "Charset set correctly");
61
    like( $email->email->header('Message-ID'), qr/\<.*@.*\>/, 'Value set correctly' );
62
63
    t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'catchall@example.com' );
64
    t::lib::Mocks::mock_preference( 'ReplytoDefault', 'replytodefault@example.com' );
65
    t::lib::Mocks::mock_preference( 'ReturnpathDefault', 'returnpathdefault@example.com' );
66
    t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'kohaadminemailaddress@example.com' );
67
68
    $email = Koha::Email->create(
69
        {
70
            to        => 'to@example.com',
71
            cc        => 'cc@example.com',
72
            bcc       => 'bcc@example.com',
73
            text_body => $text_body,
74
        }
75
    );
76
77
    is( $email->email->header('From'), 'kohaadminemailaddress@example.com', 'KohaAdminEmailAddress is picked when no from passed' );
78
    is( $email->email->header('To'), 'catchall@example.com', 'SendAllEmailsTo overloads any address' );
79
    is( $email->email->header('Cc'), undef, 'SendAllEmailsTo overloads any address' );
80
    is( $email->email->header('Bcc'), undef, 'SendAllEmailsTo overloads any address' );
81
    is( $email->email->header('ReplyTo'), 'replytodefault@example.com', 'ReplytoDefault picked when replyto not passed' );
82
    is( $email->email->header('Sender'), 'returnpathdefault@example.com', 'ReturnpathDefault picked when sender not passed' );
83
    is( $email->email->header('Subject'), '', 'No subject passed, empty string' );
84
    is( $email->email->body, $text_body, "Body set correctly" );
85
    like( $email->email->content_type, qr|text/plain|, "Content type set correctly");
86
    like( $email->email->content_type, qr|charset="?utf-8"?|, "Charset set correctly");
87
88
    subtest 'exception cases' => sub {
89
90
        plan tests => 16;
91
92
        throws_ok
93
            { Koha::Email->create({ from => 'not_an_email' }); }
94
            'Koha::Exceptions::BadParameter',
95
            'Exception thrown correctly';
96
97
        is( "$@", q{Invalid 'from' parameter: not_an_email}, 'Exception message correct' );
98
99
        t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'not_an_email' );
100
101
        throws_ok
102
            { Koha::Email->create({  }); }
103
            'Koha::Exceptions::BadParameter',
104
            'Exception thrown correctly';
105
106
        is( "$@", q{Invalid 'from' parameter: not_an_email}, 'Exception message correct' );
107
108
        t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'tomasito@mail.com' );
109
        t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
110
111
        throws_ok
112
            { Koha::Email->create({ to => 'not_an_email' }); }
113
            'Koha::Exceptions::BadParameter',
114
            'Exception thrown correctly';
115
116
        is( "$@", q{Invalid 'to' parameter: not_an_email}, 'Exception message correct' );
117
118
        t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'not_an_email' );
119
120
        throws_ok
121
            { Koha::Email->create({  }); }
122
            'Koha::Exceptions::BadParameter',
123
            'Exception thrown correctly';
124
125
        is( "$@", q{Invalid 'to' parameter: not_an_email}, 'Exception message correct' );
126
127
        t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
128
129
        throws_ok
130
            { Koha::Email->create(
131
                {
132
                    to       => 'tomasito@mail.com',
133
                    reply_to => 'not_an_email'
134
                }
135
              ); }
136
            'Koha::Exceptions::BadParameter',
137
            'Exception thrown correctly';
138
139
        is( "$@", q{Invalid 'reply_to' parameter: not_an_email}, 'Exception message correct' );
140
141
        throws_ok
142
            { Koha::Email->create(
143
                {
144
                    to     => 'tomasito@mail.com',
145
                    sender => 'not_an_email'
146
                }
147
              ); }
148
            'Koha::Exceptions::BadParameter',
149
            'Exception thrown correctly';
150
151
        is( "$@", q{Invalid 'sender' parameter: not_an_email}, 'Exception message correct' );
152
153
        throws_ok
154
            { Koha::Email->create(
155
                {
156
                    to => 'tomasito@mail.com',
157
                    cc => 'not_an_email'
158
                }
159
              ); }
160
            'Koha::Exceptions::BadParameter',
161
            'Exception thrown correctly';
162
163
        is( "$@", q{Invalid 'cc' parameter: not_an_email}, 'Exception message correct' );
164
165
        throws_ok
166
            { Koha::Email->create(
167
                {
168
                    to  => 'tomasito@mail.com',
169
                    bcc => 'not_an_email'
170
                }
171
              ); }
172
            'Koha::Exceptions::BadParameter',
173
            'Exception thrown correctly';
174
175
        is( "$@", q{Invalid 'bcc' parameter: not_an_email}, 'Exception message correct' );
176
    };
177
};
(-)a/t/Koha_Email.t (-17 lines)
Lines 1-16 Link Here
1
use Modern::Perl;
2
3
use t::lib::Mocks;
4
use Test::More tests => 4;                      # last test to print
5
6
use_ok('Koha::Email');
7
8
my $from = 'chrisc@catalyst.net.nz';
9
t::lib::Mocks::mock_preference('ReplytoDefault', $from);
10
t::lib::Mocks::mock_preference('ReturnpathDefault', $from);
11
12
13
14
ok( my $email = Koha::Email->new(), 'Create a Koha::Email Object');
15
ok( my %mail = $email->create_message_headers({from => $from}),'Set headers');
16
is ($mail{'From'}, $from, 'Set correctly');
17
- 

Return to bug 22343