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

(-)a/Koha/Email.pm (-37 / +79 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;
23
25
24
use base qw(Class::Accessor);
25
use C4::Context;
26
use C4::Context;
26
27
27
__PACKAGE__->mk_accessors(qw( ));
28
use base qw( Email::Stuffer );
28
29
29
=head1 NAME
30
=head1 NAME
30
31
31
Koha::Email
32
Koha::Email - A wrapper around Email::Stuffer
32
33
33
=head1 SYNOPSIS
34
=head1 API
34
35
35
  use Koha::Email;
36
=head2 Class methods
36
  my $email = Koha::Email->new();
37
  my %mail = $email->create_message_headers({ to => $to_address, from => $from_address,
38
                                             replyto => $replyto });
39
37
40
=head1 FUNCTIONS
38
=head3 create
39
40
    my $email = Koha::Email->create(
41
        {
42
          [ text_body   => $text_message,
43
            html_body   => $html_message, ]
44
            from        => $from,
45
            to          => $to,
46
            cc          => $cc,
47
            bcc         => $bcc,
48
            replyto     => $replyto,
49
            sender      => $sender,
50
            subject     => $subject,
51
            charset     => $charset,
52
        }
53
    );
54
55
This method creates a new Email::Simple object taking Koha specific configurations
56
into account.
57
58
Parameters:
59
 - I<from> defaults to the value of the I<KohaAdminEmailAddress> system preference
60
 - I<charset> defaults to B<utf8>
61
 - The I<SendAllEmailsTo> system preference overloads the I<to>, I<cc> and I<bcc> parameters
62
 - I<replyto> defaults to the value of the I<ReplytoDefault> system preference
63
 - I<sender> defaults to the value of the I<ReturnpathDefault> system preference
41
64
42
=cut
65
=cut
43
66
44
sub create_message_headers {
67
sub create {
45
    my $self   = shift;
68
    my ( $self, $params ) = @_;
46
    my $params = shift;
47
    $params->{from} ||= C4::Context->preference('KohaAdminEmailAddress');
48
    $params->{charset} ||= 'utf8';
49
    my %mail = (
50
        To      => $params->{to},
51
        From    => $params->{from},
52
        charset => $params->{charset}
53
    );
54
69
55
    if (C4::Context->preference('SendAllEmailsTo') && Email::Valid->address(C4::Context->preference('SendAllEmailsTo'))) {
70
    my $from    = $params->{from}    // C4::Context->preference('KohaAdminEmailAddress');
56
        $mail{'To'} = C4::Context->preference('SendAllEmailsTo');
71
    my $charset = $params->{charset} // 'utf8';
72
    my $subject = $params->{subject} // '';
73
74
    my $args = {
75
        from    => $from,
76
        subject => $subject,
77
    };
78
79
    $params->{replyto} ||= C4::Context->preference('ReplytoDefault')
80
        if C4::Context->preference('ReplytoDefault');
81
82
    $params->{sender} ||= C4::Context->preference('ReturnpathDefault')
83
        if C4::Context->preference('ReturnpathDefault') ;
84
85
86
    if (   C4::Context->preference('SendAllEmailsTo')
87
        && Email::Valid->address( C4::Context->preference('SendAllEmailsTo') ) )
88
    {
89
        $args->{to} = C4::Context->preference('SendAllEmailsTo');
57
    }
90
    }
58
    else {
91
    else {
59
        $mail{'Cc'}  = $params->{cc}  if exists $params->{cc};
92
        $args->{to}  = $params->{to};
60
        $mail{'Bcc'} = $params->{bcc} if exists $params->{bcc};
93
        $args->{cc}  = $params->{cc}
94
            if exists $params->{cc};
95
        $args->{bcc} = $params->{bcc}
96
            if exists $params->{bcc};
61
    }
97
    }
62
98
63
    if ( C4::Context->preference('ReplytoDefault') ) {
99
    my $email = $self->SUPER::new( $args );
64
        $params->{replyto} ||= C4::Context->preference('ReplytoDefault');
100
101
    $email->header( 'ReplyTo', $params->{replyto} )
102
        if $params->{replyto};
103
104
    $email->header( 'charset'      => $charset );
105
    $email->header( 'Sender'       => $params->{sender} );
106
    $email->header( 'Content-Type' => $params->{contenttype} ) if $params->{contenttype};
107
    $email->header( 'X-Mailer'     => "Koha" );
108
    $email->header( 'Message-ID'   => Email::MessageID->new->in_brackets );
109
110
    if ( $params->{text_body} ) {
111
        $email->text_body( $params->{text_body} );
65
    }
112
    }
66
    if ( C4::Context->preference('ReturnpathDefault') ) {
113
    elsif ( $params->{html_body} ) {
67
        $params->{sender} ||= C4::Context->preference('ReturnpathDefault');
114
        $email->html_body( $params->{html_body} );
68
    }
115
    }
69
    $mail{'Reply-to'}     = $params->{replyto}     if $params->{replyto};
116
70
    $mail{'Sender'}       = $params->{sender}      if $params->{sender};
117
    return $email;
71
    $mail{'Message'}      = $params->{message}     if $params->{message};
72
    $mail{'Subject'}      = $params->{subject}     if $params->{subject};
73
    $mail{'Content-Type'} = $params->{contenttype} if $params->{contenttype};
74
    $mail{'X-Mailer'}     = "Koha";
75
    $mail{'Message-ID'}   = Email::MessageID->new->in_brackets;
76
    return %mail;
77
}
118
}
119
78
1;
120
1;
(-)a/t/Koha/Email.t (+86 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
22
use t::lib::Mocks;
23
24
use_ok('Koha::Email');
25
26
subtest 'create() tests' => sub {
27
28
    plan tests => 21;
29
30
    t::lib::Mocks::mock_preference( 'SendAllEmailsTo', undef );
31
32
    my $html_body = '<h1>Title</h1><p>Message</p>';
33
    my $text_body = "#Title: Message";
34
35
    my $email = Koha::Email->create(
36
        {
37
            from      => 'from@example.com',
38
            charset   => 'iso-8859-1',
39
            to        => 'to@example.com',
40
            cc        => 'cc@example.com',
41
            bcc       => 'bcc@example.com',
42
            replyto   => 'replyto@example.com',
43
            sender    => 'sender@example.com',
44
            subject   => 'Some subject',
45
            html_body => $html_body,
46
        }
47
    );
48
49
    is( $email->email->header('From'), 'from@example.com', 'Value set correctly' );
50
    is( $email->email->header('charset'), 'iso-8859-1', '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'), 'replyto@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
    is( $email->email->content_type, 'text/html; charset="utf-8"', "Content type set correctly");
60
    like( $email->email->header('Message-ID'), qr/\<.*@.*\>/, 'Value set correctly' );
61
62
    t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'catchall@example.com' );
63
    t::lib::Mocks::mock_preference( 'ReplytoDefault', 'replytodefault@example.com' );
64
    t::lib::Mocks::mock_preference( 'ReturnpathDefault', 'returnpathdefault@example.com' );
65
    t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'kohaadminemailaddress@example.com' );
66
67
    $email = Koha::Email->create(
68
        {
69
            to        => 'to@example.com',
70
            cc        => 'cc@example.com',
71
            bcc       => 'bcc@example.com',
72
            text_body => $text_body,
73
        }
74
    );
75
76
    is( $email->email->header('From'), 'kohaadminemailaddress@example.com', 'KohaAdminEmailAddress is picked when no from passed' );
77
    is( $email->email->header('charset'), 'utf8', 'utf8 is the default' );
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->body, $text_body, "Body set correctly" );
84
    is( $email->email->content_type, 'text/plain; charset="utf-8"; format="flowed"', "Content type set correctly");
85
};
86
(-)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