Bug 23681: Move to ::Patron::Restriction::Type(s)

This patch moves the new classes under ::Patron::Restriction:: and
enhances the Unit tests for those classes.

NOTE: We should drop keyed_on_code as part of bug 31095
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

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'

Koha/Patron/Restriction/Type.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;
+
+    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 $self->SUPER::delete;
+        }
     );
-
-    # Now do the delete if the update was successful
-    if ($rows) {
-        my $deleted = $self->SUPER::delete($self);
-        return $deleted
-    }
-
-    return 0;
 }
 
 =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;

Koha/Patron/Restriction/Types.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;

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;

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,36 +66,51 @@ 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'
             };
         } else {
-            my $restriction = Koha::RestrictionType->new({
+            my $restriction = Koha::Patron::Restriction::Type->new({
                 code => $code,
                 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,
     )

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'),

koha-tmpl/intranet-tmpl/prog/en/modules/admin/restrictions.tt

@@ -71,10 +71,20 @@
 [% FOR m IN messages %]
     <div class="dialog [% m.type | html %]">
         [% 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 %]

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 ) {

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 ) {

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 <http://www.gnu.org/licenses>
+
+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;

t/db_dependent/Koha/Patron/Restriction/Types.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',

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;