@@ -, +, @@
---
Koha/Exceptions.pm | 4 +
.../Restriction/Type.pm} | 49 +++----
.../Restriction/Types.pm} | 8 +-
Koha/Schema/Result/RestrictionType.pm | 4 +-
admin/restrictions.pl | 38 ++++--
circ/circulation.pl | 4 +-
.../prog/en/modules/admin/restrictions.tt | 10 ++
members/memberentry.pl | 4 +-
members/moremember.pl | 4 +-
t/db_dependent/Koha/Patron/Restriction/Type.t | 124 ++++++++++++++++++
.../Patron/Restriction/Types.t} | 13 +-
t/db_dependent/RestrictionTypes.t | 120 -----------------
12 files changed, 209 insertions(+), 173 deletions(-)
rename Koha/{RestrictionType.pm => Patron/Restriction/Type.pm} (56%)
rename Koha/{RestrictionTypes.pm => Patron/Restriction/Types.pm} (85%)
create mode 100755 t/db_dependent/Koha/Patron/Restriction/Type.t
rename t/db_dependent/{RestrictionType.t => Koha/Patron/Restriction/Types.t} (80%)
delete mode 100755 t/db_dependent/RestrictionTypes.t
--- a/Koha/Exceptions.pm
+++ a/Koha/Exceptions.pm
@@ -32,6 +32,10 @@ use Exception::Class (
isa => 'Koha::Exception',
description => 'The default value cannot be deleted'
},
+ 'Koha::Exceptions::CannotDeleteSystem' => {
+ isa => 'Koha::Exception',
+ description => 'The system value cannot be deleted'
+ },
'Koha::Exceptions::MissingParameter' => {
isa => 'Koha::Exception',
description => 'A required parameter is missing'
--- a/Koha/RestrictionType.pm
+++ a/Koha/RestrictionType.pm
@@ -1,4 +1,4 @@
-package Koha::RestrictionType;
+package Koha::Patron::Restriction::Type;
# This file is part of Koha.
#
@@ -19,12 +19,14 @@ use Modern::Perl;
use base qw(Koha::Object);
-use Koha::RestrictionTypes;
+use Koha::Exceptions;
+
+use Koha::Patron::Restriction::Types;
use C4::Context;
=head1 NAME
-Koha::RestrictionType - Koha RestrictionType Object class
+Koha::Patron::Restriction::Type - Koha RestrictionType Object class
=head1 API
@@ -39,28 +41,29 @@ Overloaded delete method that does extra clean up:
=cut
sub delete {
- my ( $self ) = @_;
+ my ($self) = @_;
- # Find out what the default is
- my $default = Koha::RestrictionTypes->find({ is_default => 1 })->code;
- # Ensure we're not trying to delete a is_system type (this includes
- # the default type)
- return 0 if $self->is_system == 1;
- # We can't use Koha objects here because Koha::Patron::Debarments
- # is not a Koha object. So we'll do it old skool
- my $rows = C4::Context->dbh->do(
- "UPDATE borrower_debarments SET type = ? WHERE type = ?",
- undef,
- ($default, $self->code)
- );
+ # Ensure we can't delete the current default
+ Koha::Exceptions::CannotDeleteDefault->throw if $self->is_default;
+
+ # Ensure we can't delete system values
+ Koha::Exceptions::CannotDeleteSystem->throw if $self->is_system;
- # Now do the delete if the update was successful
- if ($rows) {
- my $deleted = $self->SUPER::delete($self);
- return $deleted
- }
+ return $self->_result->result_source->schema->txn_do(
+ sub {
+ # Update all linked restrictions to the default
+ my $default =
+ Koha::Patron::Restriction::Types->find( { is_default => 1 } )->code;
+
+ # We can't use Koha objects here because Koha::Patron::Debarments
+ # is not a Koha object. So we'll do it old skool
+ my $rows = C4::Context->dbh->do(
+ "UPDATE borrower_debarments SET type = ? WHERE type = ?",
+ undef, ( $default, $self->code ) );
- return 0;
+ return $self->SUPER::delete;
+ }
+ );
}
=head3 make_default
@@ -75,7 +78,7 @@ sub make_default {
$self->_result->result_source->schema->txn_do(
sub {
my $types =
- Koha::RestrictionTypes->search( { code => { '!=' => $self->code } } );
+ Koha::Patron::Restriction::Types->search( { code => { '!=' => $self->code } } );
$types->update( { is_default => 0 } );
$self->set( { is_default => 1 } );
$self->SUPER::store;
--- a/Koha/RestrictionTypes.pm
+++ a/Koha/RestrictionTypes.pm
@@ -1,4 +1,4 @@
-package Koha::RestrictionTypes;
+package Koha::Patron::Restriction::Types;
# This file is part of Koha.
#
@@ -18,13 +18,13 @@ package Koha::RestrictionTypes;
use Modern::Perl;
use Koha::Database;
-use Koha::RestrictionType;
+use Koha::Patron::Restriction::Type;
use base qw(Koha::Objects);
=head1 NAME
-Koha::RestrictionTypes - Koha Restriction Types Object set class
+Koha::Patron::Restriction::Types - Koha Restriction Types Object set class
=head1 API
@@ -63,7 +63,7 @@ sub _type {
=cut
sub object_class {
- return 'Koha::RestrictionType';
+ return 'Koha::Patron::Restriction::Type';
}
1;
--- a/Koha/Schema/Result/RestrictionType.pm
+++ a/Koha/Schema/Result/RestrictionType.pm
@@ -98,10 +98,10 @@ __PACKAGE__->add_columns(
);
sub koha_object_class {
- 'Koha::RestrictionType';
+ 'Koha::Patron::Restriction::Type';
}
sub koha_objects_class {
- 'Koha::RestrictionTypes';
+ 'Koha::Patron::Restriction::Types';
}
1;
--- a/admin/restrictions.pl
+++ a/admin/restrictions.pl
@@ -20,16 +20,17 @@
use Modern::Perl;
use CGI qw ( -utf8 );
+use Try::Tiny qw( try catch );
+
use C4::Auth qw( get_template_and_user );
use C4::Output qw( output_html_with_http_headers );
-use Koha::RestrictionTypes;
+use Koha::Patron::Restriction::Types;
my $input = CGI->new;
my $op = $input->param('op') // 'list';
my $code = uc $input->param('code');
my @messages = ();
-
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "admin/restrictions.tt",
@@ -43,11 +44,11 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
if ( $op eq 'add_form') {
# Get all existing restrictions, so we can do client-side validation
$template->param(
- existing => scalar Koha::RestrictionTypes->search()
+ existing => scalar Koha::Patron::Restriction::Types->search()
);
if ($code) {
$template->param(
- restriction => scalar Koha::RestrictionTypes->find($code)
+ restriction => scalar Koha::Patron::Restriction::Types->find($code)
);
}
} elsif ( $op eq 'add_validate' ) {
@@ -57,7 +58,7 @@ if ( $op eq 'add_form') {
if ($is_a_modif) {
# Check whether another restriction already has this display text
- my $dupe = Koha::RestrictionTypes->find({
+ my $dupe = Koha::Patron::Restriction::Types->find({
display_text => $display_text
});
if ($dupe) {
@@ -65,13 +66,14 @@ if ( $op eq 'add_form') {
type => 'error', code => 'duplicate_display_text'
};
} else {
- my $restriction = Koha::RestrictionTypes->find($code);
+ my $restriction = Koha::Patron::Restriction::Types->find($code);
$restriction->display_text($display_text);
$restriction->store;
+ push @messages, { type => 'message', code => 'update_success' };
}
} else {
# Check whether another restriction already has this code
- my $dupe = Koha::RestrictionTypes->find($code);
+ my $dupe = Koha::Patron::Restriction::Types->find($code);
if ($dupe) {
push @messages, {
type => 'error', code => 'duplicate_code'
@@ -82,19 +84,33 @@ if ( $op eq 'add_form') {
display_text => $display_text
});
$restriction->store;
+ push @messages, { type => 'message', code => 'add_success' };
}
}
$op = 'list';
} elsif ( $op eq 'make_default' ) {
- my $restriction = Koha::RestrictionTypes->find($code);
+ my $restriction = Koha::Patron::Restriction::Types->find($code);
$restriction->make_default;
$op = 'list';
} elsif ( $op eq 'delete_confirm' ) {
$template->param(
- restriction => scalar Koha::RestrictionTypes->find($code)
+ restriction => scalar Koha::Patron::Restriction::Types->find($code)
);
} elsif ( $op eq 'delete_confirmed' ) {
- Koha::RestrictionTypes->find($code)->delete;
+ try {
+ Koha::Patron::Restriction::Types->find($code)->delete;
+ push @messages, { type => 'message', code => 'delete_success' };
+ }
+ catch {
+ if ( blessed $_ ) {
+ if ( $_->isa('Koha::Exceptions::CannotDeleteDefault') ) {
+ push @messages, { type => 'error', code => 'delete_default' };
+ }
+ elsif ( $_->isa('Koha::Exceptions::CannotDeleteSystem') ) {
+ push @messages, { type => 'error', code => 'delete_system' };
+ }
+ }
+ }
$op = 'list';
}
@@ -104,7 +120,7 @@ $template->param(
);
if ( $op eq 'list' ) {
- my $restrictions = Koha::RestrictionTypes->search();
+ my $restrictions = Koha::Patron::Restriction::Types->search();
$template->param(
restrictions => $restrictions,
)
--- a/circ/circulation.pl
+++ a/circ/circulation.pl
@@ -46,7 +46,7 @@ use Koha::CsvProfiles;
use Koha::Patrons;
use Koha::Patron::Debarments qw( GetDebarments );
use Koha::DateUtils qw( dt_from_string );
-use Koha::RestrictionTypes;
+use Koha::Patron::Restriction::Types;
use Koha::Plugins;
use Koha::Database;
use Koha::BiblioFrameworks;
@@ -628,7 +628,7 @@ $template->param(
PatronAutoComplete => C4::Context->preference("PatronAutoComplete"),
debarments => scalar GetDebarments({ borrowernumber => $borrowernumber }),
todaysdate => dt_from_string()->set(hour => 23)->set(minute => 59),
- restriction_types => scalar Koha::RestrictionTypes->keyed_on_code(),
+ restriction_types => scalar Koha::Patron::Restriction::Types->keyed_on_code(),
has_modifications => $has_modifications,
override_high_holds => $override_high_holds,
nopermission => scalar $query->param('nopermission'),
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/restrictions.tt
+++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/restrictions.tt
@@ -71,10 +71,20 @@
[% FOR m IN messages %]
[% SWITCH m.code %]
+ [% CASE 'add_success' %]
+ Type added
+ [% CASE 'update_success' %]
+ Type updated
[% CASE 'duplicate_display_text' %]
Another restriction already has this label
[% CASE 'duplicate_code' %]
Another restriction already has this code
+ [% CASE 'delete_success' %]
+ Type deleted
+ [% CASE 'delete_default' %]
+ Cannot delete the default type
+ [% CASE 'delete_system' %]
+ Cannot delete a system type
[% CASE %]
[% m.code | html %]
[% END %]
--- a/members/memberentry.pl
+++ a/members/memberentry.pl
@@ -36,7 +36,7 @@ use Koha::AuthUtils;
use Koha::AuthorisedValues;
use Koha::Email;
use Koha::Patron::Debarments qw( AddDebarment DelDebarment GetDebarments );
-use Koha::RestrictionTypes;
+use Koha::Patron::Restriction::Types;
use Koha::Cities;
use Koha::DateUtils qw( dt_from_string );
use Koha::Libraries;
@@ -119,7 +119,7 @@ foreach my $id ( @delete_guarantor ) {
## Deal with debarments
$template->param(
debarments => scalar GetDebarments( { borrowernumber => $borrowernumber } ),
- restriction_types => scalar Koha::RestrictionTypes->keyed_on_code()
+ restriction_types => scalar Koha::Patron::Restriction::Types->keyed_on_code()
);
my @debarments_to_remove = $input->multi_param('remove_debarment');
foreach my $d ( @debarments_to_remove ) {
--- a/members/moremember.pl
+++ a/members/moremember.pl
@@ -37,7 +37,7 @@ use List::MoreUtils qw( uniq );
use Scalar::Util qw( looks_like_number );
use Koha::Patron::Attribute::Types;
use Koha::Patron::Debarments qw( GetDebarments );
-use Koha::RestrictionTypes;
+use Koha::Patron::Restriction::Types;
use Koha::Patron::Messages;
use Koha::CsvProfiles;
use Koha::Holds;
@@ -81,7 +81,7 @@ for (qw(gonenoaddress lost borrowernotes is_debarred)) {
}
$template->param(
- restriction_types => scalar Koha::RestrictionTypes->keyed_on_code()
+ restriction_types => scalar Koha::Patron::Restriction::Types->keyed_on_code()
);
if ( $patron->is_debarred ) {
--- a/t/db_dependent/Koha/Patron/Restriction/Type.t
+++ a/t/db_dependent/Koha/Patron/Restriction/Type.t
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+
+# Copyright 2022 Koha Development team
+#
+# 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
+
+use Modern::Perl;
+
+use Test::More tests => 3;
+use Test::Exception;
+
+use Koha::Database;
+
+use t::lib::TestBuilder;
+
+my $schema = Koha::Database->new->schema;
+my $builder = t::lib::TestBuilder->new;
+
+use_ok('Koha::Patron::Restriction::Type');
+
+subtest 'delete() tests' => sub {
+
+ plan tests => 4;
+
+ $schema->storage->txn_begin;
+
+ # Default restriction type
+ my $default_restriction_type = Koha::Patron::Restriction::Types->find({ is_default => 1 });
+ throws_ok { $default_restriction_type->delete }
+ 'Koha::Exceptions::CannotDeleteDefault',
+ 'Delete exception thrown on current default';
+
+ # System restriction type
+ my $system_restriction_type = $builder->build_object(
+ {
+ class => 'Koha::Patron::Restriction::Types',
+ value => {
+ is_system => 1,
+ is_default => 0,
+ }
+ }
+ )->store;
+ throws_ok { $system_restriction_type->delete }
+ 'Koha::Exceptions::CannotDeleteSystem',
+ 'Delete exception thrown on system type';
+
+ # Used restriction type
+ my $used_restriction_type = $builder->build_object(
+ {
+ class => 'Koha::Patron::Restriction::Types',
+ value => {
+ is_system => 0,
+ is_default => 0,
+ }
+ }
+ )->store;
+ my $patron = $builder->build_object(
+ {
+ class => 'Koha::Patrons',
+ }
+ )->store;
+ Koha::Patron::Debarments::AddDebarment(
+ {
+ borrowernumber => $patron->borrowernumber,
+ expiration => '9999-06-10',
+ type => $used_restriction_type->code,
+ comment => 'Test 1',
+ }
+ );
+ ok( $used_restriction_type->delete, 'Used restriction type deleted' );
+ my $debarments = Koha::Patron::Debarments::GetDebarments(
+ {
+ borrowernumber => $patron->borrowernumber
+ }
+ );
+ is(
+ $debarments->[0]->{type},
+ $default_restriction_type->code,
+ 'Used restriction updated to default'
+ );
+
+ $schema->storage->txn_rollback;
+};
+
+subtest 'make_default() tests' => sub {
+
+ plan tests => 2;
+
+ $schema->storage->txn_begin;
+
+ # Get current default restriction type
+ my $current_default = Koha::Patron::Restriction::Types->find({ is_default => 1 });
+
+ # New non-default restriction type
+ my $new_default = $builder->build_object(
+ {
+ class => 'Koha::Patron::Restriction::Types',
+ value => { is_system => 0, is_default => 0 }
+ }
+ );
+
+ $new_default->make_default;
+
+ $current_default->discard_changes;
+ is($current_default->is_default, 0, 'is_default set to false on prior default');
+ is($new_default->is_default, 1, 'is_default set true on new default');
+
+ $schema->storage->txn_rollback;
+};
+
+1;
--- a/t/db_dependent/RestrictionType.t
+++ a/t/db_dependent/RestrictionType.t
@@ -6,22 +6,21 @@ use C4::Context;
use Koha::Database;
use t::lib::TestBuilder;
-use Test::More tests => 3;
+use Test::More tests => 2;
my $schema = Koha::Database->new->schema;
$schema->storage->txn_begin;
my $dbh = C4::Context->dbh;
my $builder = t::lib::TestBuilder->new;
-use_ok('Koha::RestrictionType');
-use_ok('Koha::RestrictionTypes');
+use_ok('Koha::Patron::Restriction::Types');
$dbh->do(q|DELETE FROM borrower_debarments|);
-$dbh->do(q|DELETE FROM debarment_types|);
+$dbh->do(q|DELETE FROM restriction_types|);
$builder->build(
{
- source => 'DebarmentType',
+ source => 'RestrictionType',
value => {
code => 'ONE',
display_text => 'One',
@@ -32,7 +31,7 @@ $builder->build(
);
$builder->build(
{
- source => 'DebarmentType',
+ source => 'RestrictionType',
value => {
code => 'TWO',
display_text => 'Two',
@@ -43,7 +42,7 @@ $builder->build(
);
# keyed_on_code
-my $keyed = Koha::RestrictionTypes->keyed_on_code;
+my $keyed = Koha::Patron::Restriction::Types->keyed_on_code;
my $expecting = {
ONE => {
code => 'ONE',
--- a/t/db_dependent/RestrictionTypes.t
+++ a/t/db_dependent/RestrictionTypes.t
@@ -1,120 +0,0 @@
-#!/usr/bin/perl
-
-use Modern::Perl;
-
-use C4::Context;
-use Koha::Database;
-use t::lib::TestBuilder;
-
-use Test::More tests => 6;
-
-my $schema = Koha::Database->new->schema;
-$schema->storage->txn_begin;
-my $dbh = C4::Context->dbh;
-my $builder = t::lib::TestBuilder->new;
-
-use_ok('Koha::RestrictionType');
-use_ok('Koha::RestrictionTypes');
-
-$dbh->do(q|DELETE FROM borrower_debarments|);
-$dbh->do(q|DELETE FROM debarment_types|);
-
-$builder->build(
- {
- source => 'DebarmentType',
- value => {
- code => 'ONE',
- display_text => 'One',
- is_system => 1,
- is_default => 0,
- }
- }
-);
-$builder->build(
- {
- source => 'DebarmentType',
- value => {
- code => 'TWO',
- display_text => 'Two',
- is_system => 1,
- is_default => 1,
- }
- }
-);
-$builder->build(
- {
- source => 'DebarmentType',
- value => {
- code => 'THREE',
- display_text => 'Three',
- is_system => 1,
- is_default => 0,
- }
- }
-);
-$builder->build(
- {
- source => 'DebarmentType',
- value => {
- code => 'FOUR',
- display_text => 'Four',
- is_system => 0,
- is_default => 0,
- }
- }
-);
-$builder->build(
- {
- source => 'DebarmentType',
- value => {
- code => 'FIVE',
- display_text => 'Five',
- is_system => 0,
- is_default => 0,
- }
- }
-);
-
-# Can we create RestrictionTypes
-my $created = Koha::RestrictionTypes->find( { code => 'ONE' } );
-ok( $created->display_text eq 'One', 'Restrictions created' );
-
-# Can we delete RestrictionTypes, when appropriate
-my $deleted = Koha::RestrictionTypes->find( { code => 'FOUR' } )->delete;
-ok( $deleted, 'Restriction deleted' );
-my $not_deleted = Koha::RestrictionTypes->find( { code => 'TWO' } )->delete;
-ok( !$not_deleted, 'Read only restriction not deleted' );
-
-# Add a patron with a debarment
-my $library = $builder->build( { source => 'Branch' } );
-
-my $patron_category = $builder->build( { source => 'Category' } );
-my $borrowernumber = Koha::Patron->new(
- {
- firstname => 'my firstname',
- surname => 'my surname',
- categorycode => $patron_category->{categorycode},
- branchcode => $library->{branchcode},
- }
-)->store->borrowernumber;
-
-Koha::Patron::Debarments::AddDebarment(
- {
- borrowernumber => $borrowernumber,
- expiration => '9999-06-10',
- type => 'FIVE',
- comment => 'Test 1',
- }
-);
-
-# Now delete a code and check debarments using that code switch to
-# using the default
-my $to_delete = Koha::RestrictionTypes->find( { code => 'FIVE' } )->delete;
-my $debarments = Koha::Patron::Debarments::GetDebarments(
- {
- borrowernumber => $borrowernumber
- }
-);
-is( $debarments->[0]->{type}, 'TWO', 'Debarments update with restrictions' );
-
-$schema->storage->txn_rollback;
--