Bug 17499: Add Koha-objects for messaging preferences

This patch adds Koha-objects for messaging preferences.

Adds simple validation for messaging preferences.

The validation includes
- throw exception if both borrowernumber or categorycode is given for a new pref
- throw exception if patron for the given borrowernumber is not found
- throw exception if category for the given categorycode is not found
- throw exception if days in advance cannot be configured but is given
- throw exception if days in advance configuration is invalid (value between 0-30)
- throw exception if digest is not available but attempted to set on
- throw exception if digest must be enabled but attempted to set off
- throw exception on duplicate messaging preference

Adds a method for getting available messaging options.

Adds a method for setting default messaging preferenes.
  $patron->set_default_messaging_preferences (where $patron is a Koha::Patron)
  ...or...
  Koha::Patron::Message::Preference->new_from_default({
    borrowernumber => 123,
    categorycode => "ABC",
    message_attribute_id => 1,
  });

Since messaging preference is a feature that has multiple related database tables,
usage via Koha-objects is sometimes frustrating. This patch adds easy access to
message transport types via
  $preference->message_transport_types                              (for getting)
  $preference->set({ message_transport_types => ['email', 'sms'] }) (for setting)
  (also supports other calling conventions, see documentation for more)

Adds optional parameter message_name for Koha::Patron::Message::Preferences->find
and ->search. Simplifies the Koha-object usage by allowing developer to skip joins
and / or querying the message name via attribute_id from message_attributes table.

Includes test coverage for basic usage.

To test:
1. prove t/db_dependent/Koha/Patron/Message/*

Following Bug 17499, check also Bug 18595 that replaces C4::Members::Messaging
with these new Koha-objects.

Signed-off-by: Dominic Pichette <dominic@inlibro.com>
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>

Signed-off-by: Michal Denar <black23@gmail.com>
Signed-off-by: Sam Lau <samalau@gmail.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
This commit is contained in:
Lari Taskula 2016-10-21 17:26:24 +03:00 committed by Tomas Cohen Arazi
parent 9da5895d79
commit b5b88b053d
No known key found for this signature in database
GPG Key ID: 0A272EA1B2F3C15F
17 changed files with 2270 additions and 0 deletions

View File

@ -50,6 +50,10 @@ use Exception::Class (
description => 'A required parameter is missing',
fields => ['parameter'],
},
'Koha::Exceptions::TooManyParameters' => {
isa => 'Koha::Exception',
description => 'Too many parameters given',
},
'Koha::Exceptions::ParameterTooHigh' => {
isa => 'Koha::Exception',
description => 'A passed parameter value is too high'

View File

@ -50,6 +50,7 @@ use Koha::Patron::HouseboundRole;
use Koha::Patron::Images;
use Koha::Patron::Messages;
use Koha::Patron::Modifications;
use Koha::Patron::Message::Preferences;
use Koha::Patron::Relationships;
use Koha::Patron::Restrictions;
use Koha::Patrons;
@ -2076,6 +2077,47 @@ sub get_extended_attribute {
return $attribute->next;
}
=head3 set_default_messaging_preferences
$patron->set_default_messaging_preferences
Sets default messaging preferences on patron.
See Koha::Patron::Message::Preference(s) for more documentation, especially on
thrown exceptions.
=cut
sub set_default_messaging_preferences {
my ($self, $categorycode) = @_;
my $options = Koha::Patron::Message::Preferences->get_options;
foreach my $option (@$options) {
# Check that this option has preference configuration for this category
unless (Koha::Patron::Message::Preferences->search({
message_attribute_id => $option->{message_attribute_id},
categorycode => $categorycode || $self->categorycode,
})->count) {
next;
}
# Delete current setting
Koha::Patron::Message::Preferences->search({
borrowernumber => $self->borrowernumber,
message_attribute_id => $option->{message_attribute_id},
})->delete;
Koha::Patron::Message::Preference->new_from_default({
borrowernumber => $self->borrowernumber,
categorycode => $categorycode || $self->categorycode,
message_attribute_id => $option->{message_attribute_id},
});
}
return $self;
}
=head3 to_api
my $json = $patron->to_api;

View File

@ -0,0 +1,50 @@
package Koha::Patron::Message::Attribute;
# Copyright Koha-Suomi Oy 2016
#
# 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.a
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use base qw(Koha::Object);
=head1 NAME
Koha::Patron::Message::Attribute - Koha Patron Message Attribute object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageAttribute';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,55 @@
package Koha::Patron::Message::Attributes;
# Copyright Koha-Suomi Oy 2016
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Patron::Message::Attribute;
use base qw(Koha::Objects);
=head1 NAME
Koha::Patron::Message::Attributes - Koha Patron Message Attributes object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageAttribute';
}
sub object_class {
return 'Koha::Patron::Message::Attribute';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,470 @@
package Koha::Patron::Message::Preference;
# Copyright Koha-Suomi Oy 2016
#
# 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.a
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Exceptions;
use Koha::Patron::Categories;
use Koha::Patron::Message::Attributes;
use Koha::Patron::Message::Preferences;
use Koha::Patron::Message::Transport::Preferences;
use Koha::Patron::Message::Transport::Types;
use Koha::Patron::Message::Transports;
use Koha::Patrons;
use base qw(Koha::Object);
=head1 NAME
Koha::Patron::Message::Preference - Koha Patron Message Preference object class
=head1 API
=head2 Class Methods
=cut
=head3 new
my $preference = Koha::Patron::Message::Preference->new({
borrowernumber => 123,
#categorycode => 'ABC',
message_attribute_id => 4,
message_transport_types => ['email', 'sms'], # see documentation below
wants_digest => 1,
days_in_advance => 7,
});
Takes either borrowernumber or categorycode, but not both.
days_in_advance may not be available. See message_attributes table for takes_days
configuration.
wants_digest may not be available. See message_transports table for is_digest
configuration.
You can instantiate a new object without custom validation errors, but when
storing, validation may throw exceptions. See C<validate()> for more
documentation.
C<message_transport_types> is a parameter that is not actually a column in this
Koha-object. Given this parameter, the message transport types will be added as
related transport types for this object. For get and set, you can access them via
subroutine C<message_transport_types()> in this class.
=cut
sub new {
my ($class, $params) = @_;
my $types = $params->{'message_transport_types'};
delete $params->{'message_transport_types'};
my $self = $class->SUPER::new($params);
$self->_set_message_transport_types($types);
return $self;
}
=head3 new_from_default
my $preference = Koha::Patron::Message::Preference->new_from_default({
borrowernumber => 123,
categorycode => 'ABC', # if not given, patron's categorycode will be used
message_attribute_id => 1,
});
NOTE: This subroutine initializes and STORES the object (in order to set
message transport types for the preference), so no need to call ->store when
preferences are initialized via this method.
Stores default messaging preference for C<categorycode> to patron for given
C<message_attribute_id>.
Throws Koha::Exceptions::MissingParameter if any of following is missing:
- borrowernumber
- message_attribute_id
Throws Koha::Exceptions::ObjectNotFound if default preferences are not found.
=cut
sub new_from_default {
my ($class, $params) = @_;
my @required = qw(borrowernumber message_attribute_id);
foreach my $p (@required) {
Koha::Exceptions::MissingParameter->throw(
error => "Missing required parameter '$p'.",
) unless exists $params->{$p};
}
unless ($params->{'categorycode'}) {
my $patron = Koha::Patrons->find($params->{borrowernumber});
$params->{'categorycode'} = $patron->categorycode;
}
my $default = Koha::Patron::Message::Preferences->find({
categorycode => $params->{'categorycode'},
message_attribute_id => $params->{'message_attribute_id'},
});
Koha::Exceptions::ObjectNotFound->throw(
error => 'Default messaging preference for given categorycode and'
.' message_attribute_id cannot be found.',
) unless $default;
$default = $default->unblessed;
# Add a new messaging preference for patron
my $self = $class->SUPER::new({
borrowernumber => $params->{'borrowernumber'},
message_attribute_id => $default->{'message_attribute_id'},
days_in_advance => $default->{'days_in_advance'},
wants_digest => $default->{'wants_digest'},
})->store;
# Set default messaging transport types
my $default_transport_types =
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id =>
$default->{'borrower_message_preference_id'}
});
while (my $transport = $default_transport_types->next) {
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $self->borrower_message_preference_id,
message_transport_type => $transport->message_transport_type,
})->store;
}
return $self;
}
=head3 message_name
$preference->message_name
Gets message_name for this messaging preference.
Setter not implemented.
=cut
sub message_name {
my ($self) = @_;
if ($self->{'_message_name'}) {
return $self->{'_message_name'};
}
$self->{'_message_name'} = Koha::Patron::Message::Attributes->find({
message_attribute_id => $self->message_attribute_id,
})->message_name;
return $self->{'_message_name'};
}
=head3 message_transport_types
$preference->message_transport_types
Returns a HASHREF of message transport types for this messaging preference, e.g.
if ($preference->message_transport_types->{'email'}) {
# email is one of the transport preferences
}
$preference->message_transport_types('email', 'sms');
Sets the given message transport types for this messaging preference
=cut
sub message_transport_types {
my $self = shift;
unless (@_) {
if ($self->{'_message_transport_types'}) {
return $self->{'_message_transport_types'};
}
map {
my $transport = Koha::Patron::Message::Transports->find({
message_attribute_id => $self->message_attribute_id,
message_transport_type => $_->message_transport_type,
is_digest => $self->wants_digest
});
unless ($transport) {
my $logger = Koha::Logger->get;
$logger->warn(
$self->message_name . ' has no transport with '.
$_->message_transport_type . ' (digest: '.
($self->wants_digest ? 'yes':'no').').'
);
}
$self->{'_message_transport_types'}->{$_->message_transport_type}
= $transport ? $transport->letter_code : ' ';
}
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $self->borrower_message_preference_id,
})->as_list;
return $self->{'_message_transport_types'} || {};
}
else {
$self->_set_message_transport_types(@_);
return $self;
}
}
=head3 set
$preference->set({
message_transport_types => ['sms', 'phone'],
wants_digest => 0,
})->store;
Sets preference object values and additionally message_transport_types if given.
=cut
sub set {
my ($self, $params) = @_;
my $mtt = $params->{'message_transport_types'};
delete $params->{'message_transport_types'};
$self->SUPER::set($params) if $params;
if ($mtt) {
$self->message_transport_types($mtt);
}
return $self;
}
=head3 store
Makes a validation before actual Koha::Object->store so that proper exceptions
can be thrown. See C<validate()> for documentation about exceptions.
=cut
sub store {
my $self = shift;
$self->validate->SUPER::store(@_);
# store message transport types
if (exists $self->{'_message_transport_types'}) {
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id =>
$self->borrower_message_preference_id,
})->delete;
foreach my $type (keys %{$self->{'_message_transport_types'}}) {
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id =>
$self->borrower_message_preference_id,
message_transport_type => $type,
})->store;
}
}
return $self;
}
=head3 validate
Makes a basic validation for object.
Throws following exceptions regarding parameters.
- Koha::Exceptions::MissingParameter
- Koha::Exceptions::TooManyParameters
- Koha::Exceptions::BadParameter
See $_->parameter to identify the parameter causing the exception.
Throws Koha::Exceptions::DuplicateObject if this preference already exists.
Returns Koha::Patron::Message::Preference object.
=cut
sub validate {
my ($self) = @_;
if ($self->borrowernumber && $self->categorycode) {
Koha::Exceptions::TooManyParameters->throw(
error => 'Both borrowernumber and category given, only one accepted',
);
}
if (!$self->borrowernumber && !$self->categorycode) {
Koha::Exceptions::MissingParameter->throw(
error => 'borrowernumber or category required, none given',
);
}
if ($self->borrowernumber) {
Koha::Exceptions::BadParameter->throw(
error => 'Patron not found.',
parameter => 'borrowernumber',
) unless Koha::Patrons->find($self->borrowernumber);
}
if ($self->categorycode) {
Koha::Exceptions::BadParameter->throw(
error => 'Category not found.',
parameter => 'categorycode',
) unless Koha::Patron::Categories->find($self->categorycode);
}
if (!$self->in_storage) {
my $previous = Koha::Patron::Message::Preferences->search({
borrowernumber => $self->borrowernumber,
categorycode => $self->categorycode,
message_attribute_id => $self->message_attribute_id,
});
if ($previous->count) {
Koha::Exceptions::DuplicateObject->throw(
error => 'A preference for this borrower/category and'
.' message_attribute_id already exists',
);
}
}
my $attr = Koha::Patron::Message::Attributes->find(
$self->message_attribute_id
);
unless ($attr) {
Koha::Exceptions::BadParameter->throw(
error => 'Message attribute with id '.$self->message_attribute_id
.' not found',
parameter => 'message_attribute_id'
);
}
if (defined $self->days_in_advance) {
if ($attr && $attr->takes_days == 0) {
Koha::Exceptions::BadParameter->throw(
error => 'days_in_advance cannot be defined for '.
$attr->message_name . '.',
parameter => 'days_in_advance',
);
}
elsif ($self->days_in_advance < 0 || $self->days_in_advance > 30) {
Koha::Exceptions::BadParameter->throw(
error => 'days_in_advance has to be a value between 0-30 for '.
$attr->message_name . '.',
parameter => 'days_in_advance',
);
}
}
if (defined $self->wants_digest) {
my $transports = Koha::Patron::Message::Transports->search({
message_attribute_id => $self->message_attribute_id,
is_digest => $self->wants_digest ? 1 : 0,
});
Koha::Exceptions::BadParameter->throw(
error => (!$self->wants_digest ? 'Digest must be selected'
: 'Digest cannot be selected')
. ' for '.$attr->message_name.'.',
parameter => 'wants_digest',
) if $transports->count == 0;
}
return $self;
}
sub _set_message_transport_types {
my $self = shift;
return unless $_[0];
$self->{'_message_transport_types'} = undef;
my $types = ref $_[0] eq "ARRAY" ? $_[0] : [@_];
return unless $types;
$self->_validate_message_transport_types({ message_transport_types => $types });
foreach my $type (@$types) {
unless (exists $self->{'_message_transport_types'}->{$type}) {
my $transport = Koha::Patron::Message::Transports->find({
message_attribute_id => $self->message_attribute_id,
message_transport_type => $type
});
unless ($transport) {
Koha::Exceptions::BadParameter->throw(
error => 'No transport configured for '.$self->message_name.
" transport type $type.",
parameter => 'message_transport_types'
);
}
if (defined $self->borrowernumber) {
my $patron = Koha::Patrons->find($self->borrowernumber);
if ($type eq 'email') {
if ( !$patron->email )
{
Koha::Exceptions::BadParameter->throw(
error => 'Patron has not set email address, '.
'cannot use email as message transport',
parameter => 'message_transport_types'
);
}
}
elsif ($type eq 'sms') {
if ( !$patron->smsalertnumber ){
Koha::Exceptions::BadParameter->throw(
error => 'Patron has not set sms number, '.
'cannot set sms as message transport',
parameter => 'message_transport_types'
);
}
}
}
$self->{'_message_transport_types'}->{$type}
= $transport->letter_code;
}
}
return $self;
}
sub _validate_message_transport_types {
my ($self, $params) = @_;
if (ref($params) eq 'HASH' && $params->{'message_transport_types'}) {
if (ref($params->{'message_transport_types'}) ne 'ARRAY') {
$params->{'message_transport_types'} = [$params->{'message_transport_types'}];
}
my $types = $params->{'message_transport_types'};
foreach my $type (@{$types}) {
unless (Koha::Patron::Message::Transport::Types->find({
message_transport_type => $type
})) {
Koha::Exceptions::BadParameter->throw(
error => "Message transport type '$type' does not exist",
parameter => 'message_transport_types',
);
}
}
return $types;
}
}
=head3 type
=cut
sub _type {
return 'BorrowerMessagePreference';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,146 @@
package Koha::Patron::Message::Preferences;
# Copyright Koha-Suomi Oy 2016
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Patron::Message::Attributes;
use Koha::Patron::Message::Preference;
use Koha::Patron::Message::Transports;
use base qw(Koha::Objects);
=head1 NAME
Koha::Patron::Message::Preferences - Koha Patron Message Preferences object class
=head1 API
=head2 Class Methods
=cut
=head3 find_with_message_name
Koha::Patron::Message::Preferences->find_with_message_name({
borrowernumber => 123,
message_name => 'Hold_Filled',
});
Converts C<message_name> into C<message_attribute_id> and continues find.
=cut
sub find_with_message_name {
my ($self, $id) = @_;
if (ref($id) eq "HASH" && $id->{'message_name'}) {
my $attr = Koha::Patron::Message::Attributes->find({
message_name => $id->{'message_name'},
});
$id->{'message_attribute_id'} = ($attr) ?
$attr->message_attribute_id : undef;
delete $id->{'message_name'};
}
return $self->SUPER::find($id);
}
=head3 get_options
my $messaging_options = Koha::Patron::Message::Preferences->get_options
Returns an ARRAYref of HASHrefs on available messaging options.
=cut
sub get_options {
my ($self) = @_;
my $transports = Koha::Patron::Message::Transports->search(undef,
{
join => ['message_attribute'],
'+select' => ['message_attribute.message_name', 'message_attribute.takes_days'],
'+as' => ['message_name', 'takes_days'],
});
my $choices;
while (my $transport = $transports->next) {
my $name = $transport->get_column('message_name');
$choices->{$name}->{'message_attribute_id'} = $transport->message_attribute_id;
$choices->{$name}->{'message_name'} = $name;
$choices->{$name}->{'takes_days'} = $transport->get_column('takes_days');
$choices->{$name}->{'has_digest'} ||= 1 if $transport->is_digest;
$choices->{$name}->{'has_digest_off'} ||= 1 if !$transport->is_digest;
$choices->{$name}->{'transport_'.$transport->get_column('message_transport_type')} = ' ';
}
my @return = values %$choices;
@return = sort { $a->{message_attribute_id} <=> $b->{message_attribute_id} } @return;
return \@return;
}
=head3 search_with_message_name
Koha::Patron::Message::Preferences->search_with_message_name({
borrowernumber => 123,
message_name => 'Hold_Filled',
});
Converts C<message_name> into C<message_attribute_id> and continues search. Use
Koha::Patron::Message::Preferences->search with a proper join for more complicated
searches.
=cut
sub search_with_message_name {
my ($self, $params, $attributes) = @_;
if (ref($params) eq "HASH" && $params->{'message_name'}) {
my $attr = Koha::Patron::Message::Attributes->find({
message_name => $params->{'message_name'},
});
$params->{'message_attribute_id'} = ($attr) ?
$attr->message_attribute_id : undef;
delete $params->{'message_name'};
}
return $self->SUPER::search($params, $attributes);
}
=head3 type
=cut
sub _type {
return 'BorrowerMessagePreference';
}
sub object_class {
return 'Koha::Patron::Message::Preference';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,50 @@
package Koha::Patron::Message::Transport;
# Copyright Koha-Suomi Oy 2016
#
# 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.a
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use base qw(Koha::Object);
=head1 NAME
Koha::Patron::Message::Transport - Koha Patron Message Transport object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageTransport';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,51 @@
package Koha::Patron::Message::Transport::Preference;
# Copyright Koha-Suomi Oy 2016
#
# 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.a
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use base qw(Koha::Object);
=head1 NAME
Koha::Patron::Message::Transport::Preference - Koha Patron Message Transport
Preference object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'BorrowerMessageTransportPreference';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,56 @@
package Koha::Patron::Message::Transport::Preferences;
# Copyright Koha-Suomi Oy 2016
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Patron::Message::Transport::Preference;
use base qw(Koha::Objects);
=head1 NAME
Koha::Patron::Message::Transport::Preferences - Koha Patron Message Transport
Preferences object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'BorrowerMessageTransportPreference';
}
sub object_class {
return 'Koha::Patron::Message::Transport::Preference';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,51 @@
package Koha::Patron::Message::Transport::Type;
# Copyright Koha-Suomi Oy 2016
#
# 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.a
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use base qw(Koha::Object);
=head1 NAME
Koha::Patron::Message::Transport::Type - Koha Patron Message Transport Type
object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageTransportType';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,56 @@
package Koha::Patron::Message::Transport::Types;
# Copyright Koha-Suomi Oy 2016
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Patron::Message::Transport::Type;
use base qw(Koha::Objects);
=head1 NAME
Koha::Patron::Message::Transport::Types - Koha Patron Message Transport Types
object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageTransportType';
}
sub object_class {
return 'Koha::Patron::Message::Transport::Type';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,55 @@
package Koha::Patron::Message::Transports;
# Copyright Koha-Suomi Oy 2016
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use Modern::Perl;
use Koha::Database;
use Koha::Patron::Message::Transport;
use base qw(Koha::Objects);
=head1 NAME
Koha::Patron::Message::Transports - Koha Patron Message Transports object class
=head1 API
=head2 Class Methods
=cut
=head3 type
=cut
sub _type {
return 'MessageTransport';
}
sub object_class {
return 'Koha::Patron::Message::Transport';
}
=head1 AUTHOR
Lari Taskula <lari.taskula@hypernova.fi>
=cut
1;

View File

@ -0,0 +1,74 @@
#!/usr/bin/perl
# Copyright 2017 Koha-Suomi Oy
#
# 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 Koha::Database;
my $schema = Koha::Database->new->schema;
subtest 'Test class imports' => sub {
plan tests => 2;
use_ok('Koha::Patron::Message::Attribute');
use_ok('Koha::Patron::Message::Attributes');
};
subtest 'Test Koha::Patron::Message::Attributes' => sub {
plan tests => 6;
$schema->storage->txn_begin;
Koha::Patron::Message::Attribute->new({
message_name => 'Test_Attribute'
})->store;
Koha::Patron::Message::Attribute->new({
message_name => 'Test_Attribute2',
takes_days => 1
})->store;
my $attribute = Koha::Patron::Message::Attributes->find({
message_name => 'Test_Attribute' });
my $attribute2 = Koha::Patron::Message::Attributes->find({
message_name => 'Test_Attribute2' });
is($attribute->message_name, 'Test_Attribute',
'Added a new messaging attribute.');
is($attribute->takes_days, 0,
'For that messaging attribute, takes_days is disabled by default.');
is($attribute2->message_name, 'Test_Attribute2',
'Added another messaging attribute.');
is($attribute2->takes_days, 1,
'takes_days is enabled for that message attribute (as expected).');
$attribute->delete;
$attribute2->delete;
is(Koha::Patron::Message::Attributes->find({
message_name => 'Test_Attribute' }), undef,
'Deleted the first message attribute.');
is(Koha::Patron::Message::Attributes->find({
message_name => 'Test_Attribute2' }), undef,
'Deleted the second message attribute.');
$schema->storage->txn_rollback;
};
1;

View File

@ -0,0 +1,758 @@
#!/usr/bin/perl
# Copyright 2017 Koha-Suomi Oy
#
# 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 => 7;
use t::lib::Mocks;
use t::lib::TestBuilder;
use C4::Context;
use Koha::Notice::Templates;
use Koha::Patron::Categories;
use Koha::Patron::Message::Attributes;
use Koha::Patron::Message::Transport::Types;
use Koha::Patron::Message::Transports;
use Koha::Patrons;
use File::Temp qw/tempfile/;
use Log::Log4perl;
my $schema = Koha::Database->new->schema;
my $builder = t::lib::TestBuilder->new;
subtest 'Test class imports' => sub {
plan tests => 2;
use_ok('Koha::Patron::Message::Preference');
use_ok('Koha::Patron::Message::Preferences');
};
subtest 'Test Koha::Patron::Message::Preferences' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $attribute = build_a_test_attribute();
my $letter = build_a_test_letter();
my $mtt = build_a_test_transport_type();
Koha::Patron::Message::Transport->new({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
subtest 'Test for a patron' => sub {
plan tests => 3;
my $patron = build_a_test_patron();
Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store;
my $preference = Koha::Patron::Message::Preferences->find({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id
});
ok($preference->borrower_message_preference_id > 0,
'Added a new messaging preference for patron.');
subtest 'Test set not throwing an exception on duplicate object' => sub {
plan tests => 1;
Koha::Patron::Message::Attributes->find({
message_attribute_id => $attribute->message_attribute_id
})->set({ takes_days => 1 })->store;
$preference->set({ days_in_advance => 1 })->store;
is(ref($preference), 'Koha::Patron::Message::Preference',
'Updating the preference does not cause duplicate object exception');
};
$preference->delete;
is(Koha::Patron::Message::Preferences->search({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id
})->count, 0, 'Deleted the messaging preference.');
};
subtest 'Test for a category' => sub {
my $category = build_a_test_category();
Koha::Patron::Message::Preference->new({
categorycode => $category->categorycode,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store;
my $preference = Koha::Patron::Message::Preferences->find({
categorycode => $category->categorycode,
message_attribute_id => $attribute->message_attribute_id
});
ok($preference->borrower_message_preference_id > 0,
'Added a new messaging preference for category.');
$preference->delete;
is(Koha::Patron::Message::Preferences->search({
categorycode => $category->categorycode,
message_attribute_id => $attribute->message_attribute_id
})->count, 0, 'Deleted the messaging preference.');
};
$schema->storage->txn_rollback;
};
subtest 'Test Koha::Patron::Message::Preferences->get_options' => sub {
plan tests => 2;
subtest 'Test method availability and return value' => sub {
plan tests => 3;
ok(Koha::Patron::Message::Preferences->can('get_options'),
'Method get_options is available.');
ok(my $options = Koha::Patron::Message::Preferences->get_options,
'Called get_options successfully.');
is(ref($options), 'ARRAY', 'get_options returns a ARRAYref');
};
subtest 'Make sure options are correct' => sub {
$schema->storage->txn_begin;
my $options = Koha::Patron::Message::Preferences->get_options;
foreach my $option (@$options) {
my $n = $option->{'message_name'};
my $attr = Koha::Patron::Message::Attributes->find($option->{'message_attribute_id'});
is($option->{'message_attribute_id'}, $attr->message_attribute_id,
'$n: message_attribute_id is set');
is($option->{'message_name'}, $attr->message_name, '$n: message_name is set');
is($option->{'takes_days'}, $attr->takes_days, '$n: takes_days is set');
my $transports = Koha::Patron::Message::Transports->search({
message_attribute_id => $option->{'message_attribute_id'},
is_digest => $option->{'has_digest'} || 0,
});
while (my $trnzport = $transports->next) {
is($option->{'has_digest'} || 0, $trnzport->is_digest, '$n: has_digest is set for '.$trnzport->message_transport_type);
is($option->{'transport_'.$trnzport->message_transport_type}, ' ', '$n: transport_'.$trnzport->message_transport_type.' is set');
}
}
$schema->storage->txn_rollback;
};
};
subtest 'Add preferences from defaults' => sub {
plan tests => 3;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
my ($default, $mtt1, $mtt2) = build_a_test_category_preference({
patron => $patron,
});
ok(Koha::Patron::Message::Preference->new_from_default({
borrowernumber => $patron->borrowernumber,
categorycode => $patron->categorycode,
message_attribute_id => $default->message_attribute_id,
})->store, 'Added a default preference to patron.');
ok(my $pref = Koha::Patron::Message::Preferences->find({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $default->message_attribute_id,
}), 'Found the default preference from patron.');
is(Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $pref->borrower_message_preference_id
})->count, 2, 'Found the two transport types that we set earlier');
$schema->storage->txn_rollback;
};
subtest 'Test Koha::Patron::Message::Preference->message_transport_types' => sub {
plan tests => 4;
ok(Koha::Patron::Message::Preference->can('message_transport_types'),
'Method message_transport_types available');
subtest 'get message_transport_types' => sub {
plan tests => 5;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
my ($preference, $mtt1, $mtt2) = build_a_test_complete_preference({
patron => $patron
});
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
})->delete;
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $preference->borrower_message_preference_id,
message_transport_type => $mtt1->message_transport_type,
})->store;
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $preference->borrower_message_preference_id,
message_transport_type => $mtt2->message_transport_type,
})->store;
my $stored_transports = Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
});
my $transport1 = Koha::Patron::Message::Transports->find({
message_attribute_id => $preference->message_attribute_id,
message_transport_type => $mtt1->message_transport_type,
});
my $transport2 = Koha::Patron::Message::Transports->find({
message_attribute_id => $preference->message_attribute_id,
message_transport_type => $mtt2->message_transport_type,
});
my $transports = $preference->message_transport_types;
is(keys %{$transports}, $stored_transports->count,
'->message_transport_types gets correct amount of transport types.');
is($transports->{$stored_transports->next->message_transport_type},
$transport1->letter_code, 'Found correct message transport type and letter code.');
is($transports->{$stored_transports->next->message_transport_type},
$transport2->letter_code, 'Found correct message transport type and letter code.');
ok(!$preference->message_transport_types->{'nonexistent'},
'Didn\'t find nonexistent transport type.');
subtest 'test logging of warnings by invalid message transport type' => sub {
plan tests => 2;
my $log = mytempfile();
my $conf = mytempfile( <<"HERE"
log4perl.logger.opac = WARN, OPAC
log4perl.appender.OPAC=Log::Log4perl::Appender::TestBuffer
log4perl.appender.OPAC.filename=$log
log4perl.appender.OPAC.mode=append
log4perl.appender.OPAC.layout=SimpleLayout
log4perl.logger.intranet = WARN, INTRANET
log4perl.appender.INTRANET=Log::Log4perl::Appender::TestBuffer
log4perl.appender.INTRANET.filename=$log
log4perl.appender.INTRANET.mode=append
log4perl.appender.INTRANET.layout=SimpleLayout
HERE
);
t::lib::Mocks::mock_config('log4perl_conf', $conf);
my $appenders = Log::Log4perl->appenders;
my $appender = Log::Log4perl->appenders->{OPAC};
my $pref = Koha::Patron::Message::Preferences->find(
$preference->borrower_message_preference_id
);
my $transports = $pref->message_transport_types;
is($appender, undef, 'Nothing in buffer yet');
my $mtt_new = build_a_test_transport_type();
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id =>
$pref->borrower_message_preference_id,
message_transport_type => $mtt_new->message_transport_type,
})->store;
$pref = Koha::Patron::Message::Preferences->find(
$pref->borrower_message_preference_id
);
$transports = $pref->message_transport_types;
$appender = Log::Log4perl->appenders->{OPAC};
my $name = $pref->message_name;
my $tt = $mtt_new->message_transport_type;
like($appender->buffer, qr/WARN - $name has no transport with $tt/,
'Logged invalid message transport type');
};
$schema->storage->txn_rollback;
};
subtest 'set message_transport_types' => sub {
plan tests => 12;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
my ($preference, $mtt1, $mtt2) = build_a_test_complete_preference({
patron => $patron
});
my $mtt1_str = $mtt1->message_transport_type;
my $mtt2_str = $mtt2->message_transport_type;
# 1/3, use message_transport_types(list)
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
})->delete;
ok($preference->message_transport_types($mtt1_str, $mtt2_str)->store,
'1/3 Set returned true.');
my $stored_transports = Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
'-or' => [
message_transport_type => $mtt1_str,
message_transport_type => $mtt2_str
]
});
is($stored_transports->count, 2, 'Two transports selected');
# 2/3, use message_transport_types(ARRAYREF)
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
})->delete;
ok($preference->message_transport_types([$mtt1_str, $mtt2_str])->store,
'2/3 Set returned true.');
$stored_transports = Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
'-or' => [
message_transport_type => $mtt1_str,
message_transport_type => $mtt2_str
]
});
is($stored_transports->count, 2, 'Two transports selected');
# 3/3, use set({ message_transport_types => ARRAYREF })
Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
})->delete;
ok($preference->set({
message_transport_types => [$mtt1_str, $mtt2_str]})->store,
'3/3 Set returned true.');
$stored_transports = Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
'-or' => [
message_transport_type => $mtt1_str,
message_transport_type => $mtt2_str
]
});
is($stored_transports->count, 2, 'Two transports selected');
# Test email and smsalertnumber validation
eval { Koha::Patron::Message::Transport::Types->new({
message_transport_type => 'email'
})->store };
eval { Koha::Patron::Message::Transport::Types->new({
message_transport_type => 'sms'
})->store };
Koha::Patron::Message::Transport->new({
message_attribute_id => $preference->message_attribute_id,
message_transport_type => 'email',
is_digest => 1
})->store;
Koha::Patron::Message::Transport->new({
message_attribute_id => $preference->message_attribute_id,
message_transport_type => 'sms',
is_digest => 1
})->store;
$patron->set({ email => '', smsalertnumber => '' })->store;
eval {
$preference->message_transport_types('email')->store;
};
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'message_transport_types', 'The previous exception '
.' tells us it was the message_transport_types');
like ($@->error, qr/^Patron has not set email address/, 'Exception '
.' is because of patron has not set email address.');
eval {
$preference->message_transport_types('sms')->store;
};
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'message_transport_types', 'The previous exception '
.' tells us it was the message_transport_types');
like ($@->error, qr/^Patron has not set sms number/, 'Exception '
.' is because of patron has not set sms number.');
$schema->storage->txn_rollback;
};
subtest 'new message_transport_types' => sub {
plan tests => 3;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
my $letter = build_a_test_letter();
my $attribute = build_a_test_attribute();
my $mtt = build_a_test_transport_type();
Koha::Patron::Message::Transport->new({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
ok(my $preference = Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
message_transport_types => $mtt->message_transport_type,
})->store, 'Added a new messaging preference and transport types to patron.');
ok($preference->message_transport_types->{$mtt->message_transport_type},
'The transport type is stored in the object.');
my $stored_transports = Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $preference->borrower_message_preference_id,
});
is($stored_transports->next->message_transport_type, $mtt->message_transport_type,
'The transport type is stored in the database.');
$schema->storage->txn_rollback;
};
};
subtest 'Test Koha::Patron::Message::Preference->message_name' => sub {
plan tests => 1;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
my $attribute = build_a_test_attribute();
my ($preference, $mtt1, $mtt2) = build_a_test_complete_preference({
patron => $patron,
attr => $attribute,
});
my $message_name_pref = Koha::Patron::Message::Preferences->search_with_message_name({
borrowernumber => $patron->{'borrowernumber'},
message_name => $attribute->message_name,
})->next;
is($message_name_pref->message_name, $attribute->message_name, "Found preference with message_name");
$schema->storage->txn_rollback;
};
subtest 'Test adding a new preference with invalid parameters' => sub {
plan tests => 4;
subtest 'Missing parameters' => sub {
plan tests => 1;
eval { Koha::Patron::Message::Preference->new->store };
is(ref $@, 'Koha::Exceptions::MissingParameter',
'Adding a message preference without parameters'
.' => Koha::Exceptions::MissingParameter');
};
subtest 'Too many parameters' => sub {
plan tests => 1;
$schema->storage->txn_begin;
my $patron = build_a_test_patron();
eval { Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
categorycode => $patron->categorycode,
})->store };
is(ref $@, 'Koha::Exceptions::TooManyParameters',
'Adding a message preference for both borrowernumber and categorycode'
.' => Koha::Exceptions::TooManyParameters');
$schema->storage->txn_rollback;
};
subtest 'Bad parameter' => sub {
plan tests => 22;
$schema->storage->txn_begin;
eval { Koha::Patron::Message::Preference->new({
borrowernumber => -999,
})->store };
is(ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid borrowernumber'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'borrowernumber', 'The previous exception tells us it'
.' was the borrowernumber.');
eval { Koha::Patron::Message::Preference->new({
categorycode => 'nonexistent',
})->store };
is(ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid categorycode'
.' => Koha::Exceptions::BadParameter');
is($@->parameter, 'categorycode', 'The previous exception tells us it'
.' was the categorycode.');
my $attribute = build_a_test_attribute({ takes_days => 0 });
my $patron = build_a_test_patron();
eval { Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
days_in_advance => 10,
})->store };
is(ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with days in advance option when not'
.' available => Koha::Exceptions::BadParameter');
is($@->parameter, 'days_in_advance', 'The previous exception tells us it'
.' was the days_in_advance.');
$attribute->set({ takes_days => 1 })->store;
eval { Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
days_in_advance => 31,
})->store };
is(ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with days in advance option too large'
.' => Koha::Exceptions::BadParameter');
is($@->parameter, 'days_in_advance', 'The previous exception tells us it'
.' was the days_in_advance.');
eval { Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_transport_types => ['nonexistent']
})->store };
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'message_transport_types', 'The previous exception '
.'tells us it was the message_transport_types.');
my $mtt_new = build_a_test_transport_type();
eval {
Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
message_transport_types => [$mtt_new->message_transport_type],
wants_digest => 1,
})->store };
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'message_transport_types', 'The previous exception '
.'tells us it was the message_transport_types.');
like ($@->error, qr/^No transport configured/, 'Exception is because of '
.'given message_transport_type is not a valid option.');
eval {
Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
message_transport_types => [],
wants_digest => 1,
})->store };
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'wants_digest', 'The previous exception tells us it'
.' was the wants_digest');
like ($@->error, qr/^Digest cannot be selected/, 'Exception s because of'
.' given digest is not available for this transport.');
eval {
Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
message_transport_types => [],
wants_digest => 0,
})->store };
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'wants_digest', 'The previous exception tells us it'
.' was the wants_digest');
like ($@->error, qr/^Digest must be selected/, 'Exception s because of'
.' digest has to be on for this transport.');
eval {
Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => -1,
message_transport_types => [],
})->store };
is (ref $@, 'Koha::Exceptions::BadParameter',
'Adding a message preference with invalid message_transport_type'
.' => Koha::Exceptions::BadParameter');
is ($@->parameter, 'message_attribute_id', 'The previous exception tells'
.' us it was the message_attribute_id');
like ($@->error, qr/^Message attribute with id -1 not found/, 'Exception '
.' is because of given message attribute id is not found.');
$schema->storage->txn_rollback;
};
subtest 'Duplicate object' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $attribute = build_a_test_attribute();
my $letter = build_a_test_letter();
my $mtt = build_a_test_transport_type();
Koha::Patron::Message::Transport->new({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
my $patron = build_a_test_patron();
my $preference = Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store;
ok($preference->borrower_message_preference_id,
'Added a new messaging preference for patron.');
eval { Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store };
is(ref $@, 'Koha::Exceptions::DuplicateObject',
'Adding a duplicate preference'
.' => Koha::Exceptions::DuplicateObject');
$schema->storage->txn_rollback;
};
};
sub build_a_test_attribute {
my ($params) = @_;
$params->{takes_days} = $params->{takes_days} && $params->{takes_days} > 0
? 1 : 0;
my $attribute = $builder->build({
source => 'MessageAttribute',
value => $params,
});
return Koha::Patron::Message::Attributes->find(
$attribute->{message_attribute_id}
);
}
sub build_a_test_category {
my $categorycode = $builder->build({
source => 'Category' })->{categorycode};
return Koha::Patron::Categories->find($categorycode);
}
sub build_a_test_letter {
my ($params) = @_;
my $mtt = $params->{mtt} ? $params->{mtt} : 'email';
my $branchcode = $builder->build({
source => 'Branch' })->{branchcode};
my $letter = $builder->build({
source => 'Letter',
value => {
branchcode => '',
is_html => 0,
message_transport_type => $mtt
}
});
return Koha::Notice::Templates->find({
module => $letter->{module},
code => $letter->{code},
branchcode => $letter->{branchcode},
});
}
sub build_a_test_patron {
my $categorycode = $builder->build({
source => 'Category' })->{categorycode};
my $branchcode = $builder->build({
source => 'Branch' })->{branchcode};
my $borrowernumber = $builder->build({
source => 'Borrower' })->{borrowernumber};
return Koha::Patrons->find($borrowernumber);
}
sub build_a_test_transport_type {
my $mtt = $builder->build({
source => 'MessageTransportType' });
return Koha::Patron::Message::Transport::Types->find(
$mtt->{message_transport_type}
);
}
sub build_a_test_category_preference {
my ($params) = @_;
my $patron = $params->{patron};
my $attr = $params->{attr}
? $params->{attr}
: build_a_test_attribute($params->{days_in_advance});
my $letter = $params->{letter} ? $params->{letter} : build_a_test_letter();
my $mtt1 = $params->{mtt1} ? $params->{mtt1} : build_a_test_transport_type();
my $mtt2 = $params->{mtt2} ? $params->{mtt2} : build_a_test_transport_type();
Koha::Patron::Message::Transport->new({
message_attribute_id => $attr->message_attribute_id,
message_transport_type => $mtt1->message_transport_type,
is_digest => $params->{digest} ? 1 : 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
Koha::Patron::Message::Transport->new({
message_attribute_id => $attr->message_attribute_id,
message_transport_type => $mtt2->message_transport_type,
is_digest => $params->{digest} ? 1 : 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
my $default = Koha::Patron::Message::Preference->new({
categorycode => $patron->categorycode,
message_attribute_id => $attr->message_attribute_id,
wants_digest => $params->{digest} ? 1 : 0,
days_in_advance => $params->{days_in_advance}
? $params->{days_in_advance} : undef,
})->store;
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $default->borrower_message_preference_id,
message_transport_type => $mtt1->message_transport_type,
})->store;
Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $default->borrower_message_preference_id,
message_transport_type => $mtt2->message_transport_type,
})->store;
return ($default, $mtt1, $mtt2);
}
sub build_a_test_complete_preference {
my ($params) = @_;
my ($default, $mtt1, $mtt2) = build_a_test_category_preference($params);
my $patron = $params->{patron};
$patron->set_default_messaging_preferences;
return (Koha::Patron::Message::Preferences->search({
borrowernumber => $patron->borrowernumber
})->next, $mtt1, $mtt2);
}
sub mytempfile {
my ( $fh, $fn ) = tempfile( SUFFIX => '.logger.test', UNLINK => 1 );
print $fh $_[0]//'';
close $fh;
return $fn;
}
1;

View File

@ -0,0 +1,179 @@
#!/usr/bin/perl
# Copyright 2017 Koha-Suomi Oy
#
# 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 t::lib::Mocks;
use t::lib::TestBuilder;
use Koha::Notice::Templates;
use Koha::Patron::Categories;
use Koha::Patron::Message::Attributes;
use Koha::Patron::Message::Preferences;
use Koha::Patron::Message::Transport::Types;
use Koha::Patron::Message::Transports;
use Koha::Patrons;
my $schema = Koha::Database->new->schema;
my $builder = t::lib::TestBuilder->new;
subtest 'Test class imports' => sub {
plan tests => 2;
use_ok('Koha::Patron::Message::Transport::Preference');
use_ok('Koha::Patron::Message::Transport::Preferences');
};
subtest 'Test Koha::Patron::Message::Transport::Preferences' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $attribute = build_a_test_attribute();
my $mtt = build_a_test_transport_type();
my $letter = build_a_test_letter({
mtt => $mtt->message_transport_type
});
Koha::Patron::Message::Transport->new({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
subtest 'For a patron' => sub {
my $patron = build_a_test_patron();
my $preference = Koha::Patron::Message::Preference->new({
borrowernumber => $patron->borrowernumber,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store;
my $pref_id = $preference->borrower_message_preference_id;
my $transport_pref = Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $pref_id,
message_transport_type => $mtt->message_transport_type,
})->store;
is(ref($transport_pref), 'Koha::Patron::Message::Transport::Preference',
'Added a new messaging transport preference for patron.');
$transport_pref->delete;
is(Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $pref_id,
message_transport_type => $mtt->message_transport_type,
})->count, 0, 'Deleted the messaging transport preference.');
};
subtest 'For a category' => sub {
my $category = build_a_test_category();
my $preference = Koha::Patron::Message::Preference->new({
categorycode => $category->categorycode,
message_attribute_id => $attribute->message_attribute_id,
wants_digest => 0,
days_in_advance => undef,
})->store;
my $pref_id = $preference->borrower_message_preference_id;
my $transport_pref = Koha::Patron::Message::Transport::Preference->new({
borrower_message_preference_id => $pref_id,
message_transport_type => $mtt->message_transport_type,
})->store;
is(ref($transport_pref), 'Koha::Patron::Message::Transport::Preference',
'Added a new messaging transport preference for category.');
$transport_pref->delete;
is(Koha::Patron::Message::Transport::Preferences->search({
borrower_message_preference_id => $pref_id,
message_transport_type => $mtt->message_transport_type,
})->count, 0, 'Deleted the messaging transport preference.');
};
$schema->storage->txn_rollback;
};
sub build_a_test_attribute {
my ($params) = @_;
$params->{takes_days} = $params->{takes_days} && $params->{takes_days} > 0
? 1 : 0;
my $attribute = $builder->build({
source => 'MessageAttribute',
value => $params,
});
return Koha::Patron::Message::Attributes->find(
$attribute->{message_attribute_id}
);
}
sub build_a_test_category {
my $categorycode = $builder->build({
source => 'Category' })->{categorycode};
return Koha::Patron::Categories->find($categorycode);
}
sub build_a_test_letter {
my ($params) = @_;
my $mtt = $params->{mtt} ? $params->{mtt} : 'email';
my $branchcode = $builder->build({
source => 'Branch' })->{branchcode};
my $letter = $builder->build({
source => 'Letter',
value => {
branchcode => '',
is_html => 0,
message_transport_type => $mtt
}
});
return Koha::Notice::Templates->find({
module => $letter->{module},
code => $letter->{code},
branchcode => $letter->{branchcode},
});
}
sub build_a_test_patron {
my $categorycode = $builder->build({
source => 'Category' })->{categorycode};
my $branchcode = $builder->build({
source => 'Branch' })->{branchcode};
my $borrowernumber = $builder->build({
source => 'Borrower' })->{borrowernumber};
return Koha::Patrons->find($borrowernumber);
}
sub build_a_test_transport_type {
my $mtt = $builder->build({
source => 'MessageTransportType' });
return Koha::Patron::Message::Transport::Types->find(
$mtt->{message_transport_type}
);
}
1;

View File

@ -0,0 +1,54 @@
#!/usr/bin/perl
# Copyright 2017 Koha-Suomi Oy
#
# 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 Koha::Database;
my $schema = Koha::Database->new->schema;
subtest 'Test class imports' => sub {
plan tests => 2;
use_ok('Koha::Patron::Message::Transport::Type');
use_ok('Koha::Patron::Message::Transport::Types');
};
subtest 'Test Koha::Patron::Message::Transport::Types' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $transport_type = Koha::Patron::Message::Transport::Type->new({
message_transport_type => 'test'
})->store;
is($transport_type->message_transport_type, 'test',
'Added a new message transport type.');
$transport_type->delete;
is(Koha::Patron::Message::Transport::Types->find('test'), undef,
'Deleted the message transport type.');
$schema->storage->txn_rollback;
};
1;

View File

@ -0,0 +1,119 @@
#!/usr/bin/perl
# Copyright 2017 Koha-Suomi Oy
#
# 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 t::lib::TestBuilder;
use Koha::Notice::Templates;
use Koha::Patron::Message::Attributes;
use Koha::Patron::Message::Transport::Types;
my $schema = Koha::Database->new->schema;
my $builder = t::lib::TestBuilder->new;
subtest 'Test class imports' => sub {
plan tests => 2;
use_ok('Koha::Patron::Message::Transport');
use_ok('Koha::Patron::Message::Transports');
};
subtest 'Test Koha::Patron::Message::Transports' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $attribute = build_a_test_attribute();
my $mtt = build_a_test_transport_type();
my $letter = build_a_test_letter({
mtt => $mtt->message_transport_type
});
my $transport = Koha::Patron::Message::Transport->new({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0,
letter_module => $letter->module,
letter_code => $letter->code,
})->store;
is($transport->message_attribute_id, $attribute->message_attribute_id,
'Added a new messaging transport.');
$transport->delete;
is(Koha::Patron::Message::Transports->search({
message_attribute_id => $attribute->message_attribute_id,
message_transport_type => $mtt->message_transport_type,
is_digest => 0
})->count, 0, 'Deleted the messaging transport.');
$schema->storage->txn_rollback;
};
sub build_a_test_attribute {
my ($params) = @_;
$params->{takes_days} = $params->{takes_days} && $params->{takes_days} > 0
? 1 : 0;
my $attribute = $builder->build({
source => 'MessageAttribute',
value => $params,
});
return Koha::Patron::Message::Attributes->find(
$attribute->{message_attribute_id}
);
}
sub build_a_test_letter {
my ($params) = @_;
my $mtt = $params->{mtt} ? $params->{mtt} : 'email';
my $branchcode = $builder->build({
source => 'Branch' })->{branchcode};
my $letter = $builder->build({
source => 'Letter',
value => {
branchcode => '',
is_html => 0,
message_transport_type => $mtt
}
});
return Koha::Notice::Templates->find({
module => $letter->{module},
code => $letter->{code},
branchcode => $letter->{branchcode},
});
}
sub build_a_test_transport_type {
my $mtt = $builder->build({
source => 'MessageTransportType' });
return Koha::Patron::Message::Transport::Types->find(
$mtt->{message_transport_type}
);
}
1;