Bug 22343: Add classes for handling SMTP servers
This patch introduces classes to handle SMTP servers. It is done in a way that a default server can be set, and then per-library ones can be set. All should be done with Koha::SMTP::Servers methods, that take care of overwriting library-specific configs, and handle the defaults retrieval and setting correctly. To test: 1. Apply this patches 2. Run: $ kshell $ perl installer/data/mysql/updatedatabase.pl => SUCCESS: Atomic update is ok, smtp_servers table created 3. Run: k$ prove t/db_dependent/Koha/SMTP/ => SUCCESS: Tests pass! 4. Sign off :-D Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
This commit is contained in:
parent
44b3e64431
commit
dfe216bd19
4 changed files with 345 additions and 0 deletions
126
Koha/SMTP/Server.pm
Normal file
126
Koha/SMTP/Server.pm
Normal file
|
@ -0,0 +1,126 @@
|
||||||
|
package Koha::SMTP::Server;
|
||||||
|
|
||||||
|
# This file is part of Koha.
|
||||||
|
#
|
||||||
|
# Koha is free software; you can redistribute it and/or modify it
|
||||||
|
# under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# Koha is distributed in the hope that it will be useful, but
|
||||||
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||||
|
|
||||||
|
use Modern::Perl;
|
||||||
|
|
||||||
|
use Koha::Database;
|
||||||
|
use Koha::Exceptions::Object;
|
||||||
|
use Koha::SMTP::Servers;
|
||||||
|
|
||||||
|
use Email::Sender::Transport::SMTP;
|
||||||
|
|
||||||
|
use base qw(Koha::Object);
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Koha::SMTP::Server - Koha SMTP Server Object class
|
||||||
|
|
||||||
|
=head1 API
|
||||||
|
|
||||||
|
=head2 Class methods
|
||||||
|
|
||||||
|
=head3 transport
|
||||||
|
|
||||||
|
my $transport = $smtp_server->transport;
|
||||||
|
sendmail( $message, { transport => $transport } );
|
||||||
|
|
||||||
|
Returns an I<Email::Sender::Transport::SMTP> object that can be used directly
|
||||||
|
with Email::Sender.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub transport {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
my $params = {
|
||||||
|
host => $self->host,
|
||||||
|
port => $self->port,
|
||||||
|
};
|
||||||
|
|
||||||
|
$params->{ssl} = $self->ssl_mode
|
||||||
|
unless $self->ssl_mode eq 'disabled';
|
||||||
|
|
||||||
|
$params->{timeout} = $self->timeout
|
||||||
|
if $self->timeout;
|
||||||
|
|
||||||
|
$params->{sasl_username} = $self->user_name
|
||||||
|
if $self->user_name;
|
||||||
|
|
||||||
|
$params->{sasl_password} = $self->password
|
||||||
|
if $self->password;
|
||||||
|
|
||||||
|
|
||||||
|
my $transport = Email::Sender::Transport::SMTP->new( $params );
|
||||||
|
|
||||||
|
return $transport;
|
||||||
|
}
|
||||||
|
|
||||||
|
=head3 libraries
|
||||||
|
|
||||||
|
my $libraries = $smtp_server->libraries
|
||||||
|
|
||||||
|
Accessor to get the list of libraries that are linked to this SMTP server
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub libraries {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
my @library_ids = $self->_result->library_smtp_servers->get_column('library_id')->all;
|
||||||
|
return Koha::Libraries->search( { branchcode => { -in => \@library_ids } } );
|
||||||
|
}
|
||||||
|
|
||||||
|
=head3 is_system_default
|
||||||
|
|
||||||
|
if ( $smtp_server->is_system_default ) { ... }
|
||||||
|
|
||||||
|
Method that tells if a Koha::SMTP::Server is the hardcoded one.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub is_system_default {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
return $self->{_is_system_default};
|
||||||
|
}
|
||||||
|
|
||||||
|
=head3 to_api_mapping
|
||||||
|
|
||||||
|
This method returns the mapping for representing a Koha::SMTP::Server object
|
||||||
|
on the API.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub to_api_mapping {
|
||||||
|
return {
|
||||||
|
id => 'smtp_server_id'
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
=head2 Internal methods
|
||||||
|
|
||||||
|
=head3 _type
|
||||||
|
|
||||||
|
Return type of Object relating to Schema ResultSet
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub _type {
|
||||||
|
return 'SmtpServer';
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
95
Koha/SMTP/Servers.pm
Normal file
95
Koha/SMTP/Servers.pm
Normal file
|
@ -0,0 +1,95 @@
|
||||||
|
package Koha::SMTP::Servers;
|
||||||
|
|
||||||
|
# This file is part of Koha.
|
||||||
|
#
|
||||||
|
# Koha is free software; you can redistribute it and/or modify it
|
||||||
|
# under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# Koha is distributed in the hope that it will be useful, but
|
||||||
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||||
|
|
||||||
|
use Modern::Perl;
|
||||||
|
|
||||||
|
use Koha::Database;
|
||||||
|
use Koha::Exceptions;
|
||||||
|
|
||||||
|
use Koha::SMTP::Server;
|
||||||
|
|
||||||
|
use base qw(Koha::Objects);
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Koha::SMTP::Servers - Koha SMTP Server Object set class
|
||||||
|
|
||||||
|
=head1 API
|
||||||
|
|
||||||
|
=head2 Class methods
|
||||||
|
|
||||||
|
=head3 get_default
|
||||||
|
|
||||||
|
my $server = Koha::SMTP::Servers->new->get_default;
|
||||||
|
|
||||||
|
Returns the default I<Koha::SMTP::Server> object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub get_default {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
my $default = Koha::SMTP::Server->new( $self->default_setting );
|
||||||
|
$default->{_is_system_default} = 1;
|
||||||
|
return $default;
|
||||||
|
}
|
||||||
|
|
||||||
|
=head2 Internal methods
|
||||||
|
|
||||||
|
=head3 _type
|
||||||
|
|
||||||
|
Return type of object, relating to Schema ResultSet
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub _type {
|
||||||
|
return 'SmtpServer';
|
||||||
|
}
|
||||||
|
|
||||||
|
=head3 default_setting
|
||||||
|
|
||||||
|
my $hash = Koha::SMTP::Servers::default_setting;
|
||||||
|
|
||||||
|
Returns the default setting that is to be used when no user-defined default
|
||||||
|
SMTP server is provided
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub default_setting {
|
||||||
|
return {
|
||||||
|
name => 'localhost',
|
||||||
|
host => 'localhost',
|
||||||
|
port => 25,
|
||||||
|
timeout => 120,
|
||||||
|
ssl_mode => 'disabled',
|
||||||
|
user_name => undef,
|
||||||
|
password => undef,
|
||||||
|
debug => 0
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
=head3 object_class
|
||||||
|
|
||||||
|
Return object class
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub object_class {
|
||||||
|
return 'Koha::SMTP::Server';
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
72
t/db_dependent/Koha/SMTP/Server.t
Normal file
72
t/db_dependent/Koha/SMTP/Server.t
Normal file
|
@ -0,0 +1,72 @@
|
||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
# This file is part of Koha.
|
||||||
|
#
|
||||||
|
# Koha is free software; you can redistribute it and/or modify it
|
||||||
|
# under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# Koha is distributed in the hope that it will be useful, but
|
||||||
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||||
|
|
||||||
|
use Modern::Perl;
|
||||||
|
|
||||||
|
use Test::More tests => 2;
|
||||||
|
use Test::Exception;
|
||||||
|
use Test::Warn;
|
||||||
|
|
||||||
|
use Koha::SMTP::Servers;
|
||||||
|
|
||||||
|
use t::lib::TestBuilder;
|
||||||
|
use t::lib::Mocks;
|
||||||
|
|
||||||
|
my $schema = Koha::Database->new->schema;
|
||||||
|
my $builder = t::lib::TestBuilder->new;
|
||||||
|
|
||||||
|
subtest 'transport() tests' => sub {
|
||||||
|
|
||||||
|
plan tests => 4;
|
||||||
|
|
||||||
|
$schema->storage->txn_begin;
|
||||||
|
|
||||||
|
my $server = $builder->build_object(
|
||||||
|
{
|
||||||
|
class => 'Koha::SMTP::Servers',
|
||||||
|
value => { ssl_mode => 'disabled' }
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
my $transport = $server->transport;
|
||||||
|
|
||||||
|
is( ref($transport), 'Email::Sender::Transport::SMTP', 'Type is correct' );
|
||||||
|
is( $transport->ssl, 0, 'SSL is not set' );
|
||||||
|
|
||||||
|
$server->set({ ssl_mode => 'ssl' })->store;
|
||||||
|
$transport = $server->transport;
|
||||||
|
|
||||||
|
is( ref($transport), 'Email::Sender::Transport::SMTP', 'Type is correct' );
|
||||||
|
is( $transport->ssl, 'ssl', 'SSL is set' );
|
||||||
|
|
||||||
|
$schema->storage->txn_rollback;
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest 'is_system_default() tests' => sub {
|
||||||
|
|
||||||
|
plan tests => 2;
|
||||||
|
|
||||||
|
$schema->storage->txn_begin;
|
||||||
|
|
||||||
|
my $smtp_server = $builder->build_object({ class => 'Koha::SMTP::Servers' });
|
||||||
|
ok( !$smtp_server->is_system_default, 'A generated server is not the system default' );
|
||||||
|
|
||||||
|
my $system_default_server = Koha::SMTP::Servers->get_default;
|
||||||
|
ok( $system_default_server->is_system_default, 'The server returned by get_default is the system default' );
|
||||||
|
|
||||||
|
$schema->storage->txn_rollback;
|
||||||
|
};
|
52
t/db_dependent/Koha/SMTP/Servers.t
Normal file
52
t/db_dependent/Koha/SMTP/Servers.t
Normal file
|
@ -0,0 +1,52 @@
|
||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
# This file is part of Koha.
|
||||||
|
#
|
||||||
|
# Koha is free software; you can redistribute it and/or modify it
|
||||||
|
# under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# Koha is distributed in the hope that it will be useful, but
|
||||||
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||||
|
|
||||||
|
use Modern::Perl;
|
||||||
|
|
||||||
|
use Test::More tests => 1;
|
||||||
|
|
||||||
|
use Koha::SMTP::Servers;
|
||||||
|
|
||||||
|
use t::lib::TestBuilder;
|
||||||
|
use t::lib::Mocks;
|
||||||
|
|
||||||
|
my $schema = Koha::Database->new->schema;
|
||||||
|
my $builder = t::lib::TestBuilder->new;
|
||||||
|
|
||||||
|
subtest 'get_default() tests' => sub {
|
||||||
|
|
||||||
|
plan tests => 3;
|
||||||
|
|
||||||
|
$schema->storage->txn_begin;
|
||||||
|
|
||||||
|
my $server = Koha::SMTP::Servers->get_default;
|
||||||
|
is( ref($server), 'Koha::SMTP::Server',
|
||||||
|
'An object of the right type is returned' );
|
||||||
|
|
||||||
|
ok( !$server->in_storage,
|
||||||
|
'The default server is correctly retrieved' );
|
||||||
|
|
||||||
|
my $unblessed_server = $server->unblessed;
|
||||||
|
delete $unblessed_server->{id};
|
||||||
|
is_deeply(
|
||||||
|
$unblessed_server,
|
||||||
|
Koha::SMTP::Servers::default_setting,
|
||||||
|
'The default setting is returned if no user-defined default'
|
||||||
|
);
|
||||||
|
|
||||||
|
$schema->storage->txn_rollback;
|
||||||
|
};
|
Loading…
Reference in a new issue