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

(-)a/Koha/SMTP/Server.pm (+126 lines)
Line 0 Link Here
1
package Koha::SMTP::Server;
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 Koha::Database;
21
use Koha::Exceptions::Object;
22
use Koha::SMTP::Servers;
23
24
use Email::Sender::Transport::SMTP;
25
26
use base qw(Koha::Object);
27
28
=head1 NAME
29
30
Koha::SMTP::Server - Koha SMTP Server Object class
31
32
=head1 API
33
34
=head2 Class methods
35
36
=head3 transport
37
38
    my $transport = $smtp_server->transport;
39
    sendmail( $message, { transport => $transport } );
40
41
Returns an I<Email::Sender::Transport::SMTP> object that can be used directly
42
with Email::Sender.
43
44
=cut
45
46
sub transport {
47
    my ($self) = @_;
48
49
    my $params = {
50
        host => $self->host,
51
        port => $self->port,
52
    };
53
54
    $params->{ssl} = $self->ssl_mode
55
        unless $self->ssl_mode eq 'disabled';
56
57
    $params->{timeout} = $self->timeout
58
        if $self->timeout;
59
60
    $params->{sasl_username} = $self->user_name
61
        if $self->user_name;
62
63
    $params->{sasl_password} = $self->password
64
        if $self->password;
65
66
67
    my $transport = Email::Sender::Transport::SMTP->new( $params );
68
69
    return $transport;
70
}
71
72
=head3 libraries
73
74
    my $libraries = $smtp_server->libraries
75
76
Accessor to get the list of libraries that are linked to this SMTP server
77
78
=cut
79
80
sub libraries {
81
    my ($self) = @_;
82
83
    my @library_ids = $self->_result->library_smtp_servers->get_column('library_id')->all;
84
    return Koha::Libraries->search( { branchcode => { -in => \@library_ids } } );
85
}
86
87
=head3 is_system_default
88
89
    if ( $smtp_server->is_system_default ) { ... }
90
91
Method that tells if a Koha::SMTP::Server is the hardcoded one.
92
93
=cut
94
95
sub is_system_default {
96
    my ($self) = @_;
97
98
    return $self->{_is_system_default};
99
}
100
101
=head3 to_api_mapping
102
103
This method returns the mapping for representing a Koha::SMTP::Server object
104
on the API.
105
106
=cut
107
108
sub to_api_mapping {
109
    return {
110
        id => 'smtp_server_id'
111
    };
112
}
113
114
=head2 Internal methods
115
116
=head3 _type
117
118
Return type of Object relating to Schema ResultSet
119
120
=cut
121
122
sub _type {
123
    return 'SmtpServer';
124
}
125
126
1;
(-)a/Koha/SMTP/Servers.pm (+95 lines)
Line 0 Link Here
1
package Koha::SMTP::Servers;
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 Koha::Database;
21
use Koha::Exceptions;
22
23
use Koha::SMTP::Server;
24
25
use base qw(Koha::Objects);
26
27
=head1 NAME
28
29
Koha::SMTP::Servers - Koha SMTP Server Object set class
30
31
=head1 API
32
33
=head2 Class methods
34
35
=head3 get_default
36
37
    my $server = Koha::SMTP::Servers->new->get_default;
38
39
Returns the default I<Koha::SMTP::Server> object.
40
41
=cut
42
43
sub get_default {
44
    my ($self) = @_;
45
46
    my $default = Koha::SMTP::Server->new( $self->default_setting );
47
    $default->{_is_system_default} = 1;
48
    return $default;
49
}
50
51
=head2 Internal methods
52
53
=head3 _type
54
55
Return type of object, relating to Schema ResultSet
56
57
=cut
58
59
sub _type {
60
    return 'SmtpServer';
61
}
62
63
=head3 default_setting
64
65
    my $hash = Koha::SMTP::Servers::default_setting;
66
67
Returns the default setting that is to be used when no user-defined default
68
SMTP server is provided
69
70
=cut
71
72
sub default_setting {
73
    return {
74
        name       => 'localhost',
75
        host       => 'localhost',
76
        port       => 25,
77
        timeout    => 120,
78
        ssl_mode  => 'disabled',
79
        user_name  => undef,
80
        password   => undef,
81
        debug      => 0
82
    };
83
}
84
85
=head3 object_class
86
87
Return object class
88
89
=cut
90
91
sub object_class {
92
    return 'Koha::SMTP::Server';
93
}
94
95
1;
(-)a/t/db_dependent/Koha/SMTP/Server.t (+72 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
use Test::Warn;
23
24
use Koha::SMTP::Servers;
25
26
use t::lib::TestBuilder;
27
use t::lib::Mocks;
28
29
my $schema  = Koha::Database->new->schema;
30
my $builder = t::lib::TestBuilder->new;
31
32
subtest 'transport() tests' => sub {
33
34
    plan tests => 4;
35
36
    $schema->storage->txn_begin;
37
38
    my $server = $builder->build_object(
39
        {
40
            class => 'Koha::SMTP::Servers',
41
            value => { ssl_mode => 'disabled' }
42
        }
43
    );
44
45
    my $transport = $server->transport;
46
47
    is( ref($transport), 'Email::Sender::Transport::SMTP', 'Type is correct' );
48
    is( $transport->ssl, 0, 'SSL is not set' );
49
50
    $server->set({ ssl_mode => 'ssl' })->store;
51
    $transport = $server->transport;
52
53
    is( ref($transport), 'Email::Sender::Transport::SMTP', 'Type is correct' );
54
    is( $transport->ssl, 'ssl', 'SSL is set' );
55
56
    $schema->storage->txn_rollback;
57
};
58
59
subtest 'is_system_default() tests' => sub {
60
61
    plan tests => 2;
62
63
    $schema->storage->txn_begin;
64
65
    my $smtp_server = $builder->build_object({ class => 'Koha::SMTP::Servers' });
66
    ok( !$smtp_server->is_system_default, 'A generated server is not the system default' );
67
68
    my $system_default_server = Koha::SMTP::Servers->get_default;
69
    ok( $system_default_server->is_system_default, 'The server returned by get_default is the system default' );
70
71
    $schema->storage->txn_rollback;
72
};
(-)a/t/db_dependent/Koha/SMTP/Servers.t (-1 / +52 lines)
Line 0 Link Here
0
- 
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 => 1;
21
22
use Koha::SMTP::Servers;
23
24
use t::lib::TestBuilder;
25
use t::lib::Mocks;
26
27
my $schema  = Koha::Database->new->schema;
28
my $builder = t::lib::TestBuilder->new;
29
30
subtest 'get_default() tests' => sub {
31
32
    plan tests => 3;
33
34
    $schema->storage->txn_begin;
35
36
    my $server  = Koha::SMTP::Servers->get_default;
37
    is( ref($server), 'Koha::SMTP::Server',
38
        'An object of the right type is returned' );
39
40
    ok( !$server->in_storage,
41
        'The default server is correctly retrieved' );
42
43
    my $unblessed_server = $server->unblessed;
44
    delete $unblessed_server->{id};
45
    is_deeply(
46
        $unblessed_server,
47
        Koha::SMTP::Servers::default_setting,
48
        'The default setting is returned if no user-defined default'
49
    );
50
51
    $schema->storage->txn_rollback;
52
};

Return to bug 22343