From d12e20a1b2cec0d67c8733c792fc31596e6febaf Mon Sep 17 00:00:00 2001
From: Emmi Takkinen <emmi.takkinen@koha-suomi.fi>
Date: Fri, 17 Feb 2023 13:15:17 +0200
Subject: [PATCH] Bug 12133: Add requirements for guarantor and guarantee

Add two requirements when registering a new patron:

- A child patron must have a guarantor. This is controlled by
  a new syspref ChildNeedsGuarantor.
- A guarantor cannot be a guarantee.

Test plan:
1. Add a child patron without guarantor or child patron with guarantee
as guarantor succesfully.
2. Apply this patch.
3. Add a child patron as a guarantor.
=> Error is raised.
4. Turn syspref "ChildNeedsGuarantor" ON.
5. Add a child patron without a guarantor and error "Child needs a
guarantor" is raised.
6. Add guarantor. Guarantor can either be existing patron or added with
"Contact" section.
=> Save without errors.

Also prove t/db_dependent/Koha/Patron.t

Sponsored-by: Koha-Suomi Oy
---
 Koha/Exceptions/Patron/Relationship.pm        | 11 ++-
 Koha/Patron.pm                                | 38 +++++++-
 .../data/mysql/atomicupdate/bug_12133.pl      | 17 ++++
 installer/data/mysql/mandatory/sysprefs.sql   |  1 +
 .../en/modules/admin/preferences/patrons.pref |  7 ++
 .../prog/en/modules/members/memberentrygen.tt |  9 ++
 members/memberentry.pl                        | 48 ++++++++--
 t/db_dependent/Koha/Patron.t                  | 92 ++++++++++++++++++-
 8 files changed, 212 insertions(+), 11 deletions(-)
 create mode 100755 installer/data/mysql/atomicupdate/bug_12133.pl

diff --git a/Koha/Exceptions/Patron/Relationship.pm b/Koha/Exceptions/Patron/Relationship.pm
index 616ad830c7..6a0cc5dd76 100644
--- a/Koha/Exceptions/Patron/Relationship.pm
+++ b/Koha/Exceptions/Patron/Relationship.pm
@@ -32,8 +32,12 @@ use Exception::Class (
     'Koha::Exceptions::Patron::Relationship::InvalidRelationship' => {
         isa         => 'Koha::Exceptions::Patron::Relationship',
         description => 'The specified relationship is invalid',
-        fields      =>  ['relationship','no_relationship']
-    }
+        fields => [ 'relationship', 'no_relationship', 'invalid_guarantor' ]
+    },
+    'Koha::Exceptions::Patron::Relationship::NoGuarantor' => {
+        isa         => 'Koha::Exceptions::Patron::Relationship',
+        description => 'Child patron needs a guarantor',
+    },
 );
 
 sub full_message {
@@ -46,6 +50,9 @@ sub full_message {
             if ( $self->no_relationship ) {
                 $msg = sprintf( "No relationship passed." );
             }
+            elsif ( $self->invalid_guarantor ) {
+                $msg = sprintf("Child patron cannot be a guarantor.");
+            }
             else {
                 $msg = sprintf("Invalid relationship passed, '%s' is not defined.", $self->relationship );
             }
diff --git a/Koha/Patron.pm b/Koha/Patron.pm
index 2a8eecf9f6..bf0040917c 100644
--- a/Koha/Patron.pm
+++ b/Koha/Patron.pm
@@ -185,7 +185,10 @@ to db
 =cut
 
 sub store {
-    my ($self) = @_;
+    my $self = shift;
+    my $params = @_ ? shift : {};
+
+    my $guarantors = $params->{guarantors} // [];
 
     $self->_result->result_source->schema->txn_do(
         sub {
@@ -282,6 +285,21 @@ sub store {
 
                 $self->borrowernumber(undef);
 
+                if ( C4::Context->preference('ChildNeedsGuarantor')
+                    and ( $self->is_child or $self->category->can_be_guarantee )
+                    and $self->contactname eq ""
+                    and !@$guarantors )
+                {
+                    Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
+                }
+
+                foreach my $guarantor (@$guarantors) {
+                    if ( $guarantor->is_child or $guarantor->category->can_be_guarantee) {
+                        Koha::Exceptions::Patron::Relationship::InvalidRelationship
+                        ->throw( invalid_guarantor => 1 );
+                    }
+                }
+
                 $self = $self->SUPER::store;
 
                 $self->add_enrolment_fee_if_needed(0);
@@ -327,6 +345,24 @@ sub store {
 
                 }
 
+                my @existing_guarantors = $self->guarantor_relationships()->guarantors->as_list;
+                push @$guarantors, @existing_guarantors;
+
+                if ( C4::Context->preference('ChildNeedsGuarantor')
+                    and ( $self->is_child or $self->category->can_be_guarantee )
+                    and $self->contactname eq ""
+                    and !@$guarantors )
+                {
+                    Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
+                }
+
+                foreach my $guarantor (@$guarantors) {
+                    if ( $guarantor->is_child or $guarantor->category->can_be_guarantee) {
+                        Koha::Exceptions::Patron::Relationship::InvalidRelationship
+                        ->throw( invalid_guarantor => 1 );
+                    }
+                }
+
                 # Actionlogs
                 if ( C4::Context->preference("BorrowersLog") ) {
                     my $info;
diff --git a/installer/data/mysql/atomicupdate/bug_12133.pl b/installer/data/mysql/atomicupdate/bug_12133.pl
new file mode 100755
index 0000000000..e426f787eb
--- /dev/null
+++ b/installer/data/mysql/atomicupdate/bug_12133.pl
@@ -0,0 +1,17 @@
+use Modern::Perl;
+
+return {
+    bug_number => "12133",
+    description => "Add system preference ChildNeedsGuarantor",
+    up => sub {
+        my ($args) = @_;
+        my ($dbh, $out) = @$args{qw(dbh out)};
+
+        $dbh->do( q{
+            INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type)
+            VALUES('ChildNeedsGuarantor', 0, 'If ON, a child patron must have a guarantor when adding the patron.', '', 'YesNo');
+        } );
+
+        say $out "Added new system preference 'ChildNeedsGuarantor')\n";
+    },
+};
diff --git a/installer/data/mysql/mandatory/sysprefs.sql b/installer/data/mysql/mandatory/sysprefs.sql
index 38a756f817..95ba240127 100644
--- a/installer/data/mysql/mandatory/sysprefs.sql
+++ b/installer/data/mysql/mandatory/sysprefs.sql
@@ -138,6 +138,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, `
 ('ChargeFinesOnClosedDays','0',NULL,'Charge fines on days the library is closed.','YesNo'),
 ('CheckPrevCheckout','hardno','hardyes|softyes|softno|hardno','By default, for every item checked out, should we warn if the patron has borrowed that item in the past?','Choice'),
 ('CheckPrevCheckoutDelay','0', NULL,'Maximum number of days that will trigger a warning if the patron has borrowed that item in the past when CheckPrevCheckout is enabled.','free'),
+('ChildNeedsGuarantor', 0, 'If ON, a child patron must have a guarantor when adding the patron.', '', 'YesNo'),
 ('CircAutoPrintQuickSlip','qslip',NULL,'Choose what should happen when an empty barcode field is submitted in circulation: Display a print quick slip window, Display a print slip window or Clear the screen.','Choice'),
 ('CircConfirmItemParts', '0', NULL, 'Require staff to confirm that all parts of an item are present at checkin/checkout.', 'Yes/No'),
 ('CircControl','ItemHomeLibrary','PickupLibrary|PatronLibrary|ItemHomeLibrary','Specify the agency that controls the circulation and fines policy','Choice'),
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
index 32cd34f706..1242ed333d 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
@@ -363,6 +363,13 @@ Patrons:
                1: Allow
                0: "Don't allow"
          - staff to set the ability for a patron's charges to be viewed by linked patrons in the OPAC.
+     -
+         - "A child patron"
+         - pref: "ChildNeedsGuarantor"
+           choices:
+               1: "must have"
+               0: "doesn't need"
+         - a guarantor when adding the patron.
 
     Privacy:
      -
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt
index 253bc72d72..16616ce0a5 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt
@@ -181,6 +181,15 @@ legend:hover {
                                     [% IF ERROR_bad_email_alternative %]
                                         <li id="ERROR_bad_email_alternative">The alternative email is invalid.</li>
                                     [% END %]
+                                    [% IF ( ERROR_child_no_guarantor ) %]
+                                        <li id="ERROR_child_no_guarantor">A child patron needs a guarantor.</li>
+                                    [% END %]
+                                    [% IF ( ERROR_guarantor_is_guarantee ) %]
+                                        <li id="ERROR_guarantor_is_guarantee">A guarantor cannot be a guarantee.</li>
+                                    [% END %]
+                                    [% IF ( ERROR_cannot_delete_guarantor ) %]
+                                        <li id="ERROR_cannot_delete_guarantor">Cannot delete guarantor(s). A child patron needs a guarantor.</li>
+                                    [% END %]
                                 </ul>
                             </div>
                         [% END %]
diff --git a/members/memberentry.pl b/members/memberentry.pl
index 64d9aa2aa7..174e964f59 100755
--- a/members/memberentry.pl
+++ b/members/memberentry.pl
@@ -111,12 +111,18 @@ my $guarantor = undef;
 $guarantor = Koha::Patrons->find( $guarantor_id ) if $guarantor_id;
 $template->param( guarantor => $guarantor );
 
-my @delete_guarantor = $input->multi_param('delete_guarantor');
-foreach my $id ( @delete_guarantor ) {
-    my $r = Koha::Patron::Relationships->find( $id );
-    $r->delete() if $r;
+#Search existing guarantor id(s) and new ones from params
+my @guarantors;
+my @new_guarantor_ids = grep { $_ ne '' } $input->multi_param('new_guarantor_id');
+
+foreach my $new_guarantor_id (@new_guarantor_ids) {
+    my $new_guarantor = Koha::Patrons->find( { borrowernumber => $new_guarantor_id } );
+    push @guarantors, $new_guarantor;
 }
 
+my @existing_guarantors = $patron->guarantor_relationships()->guarantors->as_list unless !$patron;
+push @guarantors, @existing_guarantors;
+
 ## Deal with debarments
 $template->param(
     restriction_types => scalar Koha::Patron::Restriction::Types->search()
@@ -266,6 +272,36 @@ if ( ( $op eq 'insert' ) and !$nodouble ) {
     }
 }
 
+#Attempt to delete guarantors
+my @delete_guarantor = $input->multi_param('delete_guarantor');
+if(@delete_guarantor){
+    if ( C4::Context->preference('ChildNeedsGuarantor')
+        && scalar @guarantors - scalar @delete_guarantor == 0 ) {
+        push @errors, 'ERROR_cannot_delete_guarantor';
+    } else {
+        foreach my $id ( @delete_guarantor ) {
+            my $r = Koha::Patron::Relationships->find( $id );
+            $r->delete() if $r;
+        }
+    }
+}
+
+#Check if guarantor requirements are met
+my $valid_guarantor = @guarantors ? @guarantors : $newdata{'contactname'};
+if ( ( $op eq 'save' || $op eq 'insert' )
+    && C4::Context->preference('ChildNeedsGuarantor')
+    && ( $category->category_type eq 'C' || $category->can_be_guarantee )
+    && !$valid_guarantor )
+{
+    push @errors, 'ERROR_child_no_guarantor';
+}
+
+foreach my $guarantor (@guarantors) {
+    if ( ( $op eq 'save' || $op eq 'insert' ) && $guarantor->is_child || $guarantor->category->can_be_guarantee ) {
+        push @errors, 'ERROR_guarantor_is_guarantee';
+    }
+}
+
 ###############test to take the right zipcode, country and city name ##############
 # set only if parameter was passed from the form
 $newdata{'city'}    = $input->param('city')    if defined($input->param('city'));
@@ -400,7 +436,7 @@ if ((!$nok) and $nodouble and ($op eq 'insert' or $op eq 'save')){
         delete $newdata{password2};
         $success = 1;
         $patron = try {
-            Koha::Patron->new(\%newdata)->store;
+            Koha::Patron->new(\%newdata)->store({ guarantors => \@guarantors });
         } catch {
             $success = 0;
             $nok = 1;
@@ -494,7 +530,7 @@ if ((!$nok) and $nodouble and ($op eq 'insert' or $op eq 'save')){
         delete $newdata{password2};
 
         try {
-            $patron->set(\%newdata)->store if scalar(keys %newdata) > 1;
+            $patron->set(\%newdata)->store({ guarantors => \@guarantors }) if scalar(keys %newdata) > 1;
                 # bug 4508 - avoid crash if we're not updating any columns in the borrowers table (editing patron attrs or msg prefs)
             $success = 1;
         } catch {
diff --git a/t/db_dependent/Koha/Patron.t b/t/db_dependent/Koha/Patron.t
index 5d05a16efd..9c44d9c813 100755
--- a/t/db_dependent/Koha/Patron.t
+++ b/t/db_dependent/Koha/Patron.t
@@ -19,7 +19,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 24;
+use Test::More tests => 25;
 use Test::Exception;
 use Test::Warn;
 
@@ -1115,7 +1115,7 @@ subtest 'safe_to_delete() tests' => sub {
     is( $message->type, 'error', 'Type is error' );
     is( $message->message, 'has_debt', 'Cannot delete, has debt' );
     # cleanup
-    $patron->account->pay({ amount => 10, debits => [ $debit ] });
+    #$patron->account->pay({ amount => 10, debits => [ $debit ] });
 
     ## Happy case :-D
     ok( $patron->safe_to_delete, 'Can delete, all conditions met' );
@@ -1498,3 +1498,91 @@ subtest 'update privacy tests' => sub {
     is( $old_checkout->borrowernumber, $anon_patron->id, "Checkout is successfully anonymized");
     is( $patron->privacy(), 2, "Patron privacy is successfully updated");
 };
+
+subtest 'guarantor requirements tests' => sub {
+
+    plan tests => 6;
+
+    $schema->storage->txn_begin;
+
+    my $branchcode = $builder->build( { source => 'Branch' } )->{branchcode};
+    my $child_category = $builder->build(
+        { source => 'Category', value => { category_type => 'C', can_be_guarantee => 1 } } )
+      ->{categorycode};
+    my $patron_category = $builder->build(
+        { source => 'Category', value => { category_type => 'A', can_be_guarantee => 0 } } )
+      ->{categorycode};
+
+    t::lib::Mocks::mock_preference( 'ChildNeedsGuarantor', 0 );
+
+    my $child = Koha::Patron->new(
+        {
+            branchcode   => $branchcode,
+            categorycode => $child_category,
+            contactname  => ''
+        }
+    );
+    $child->store();
+
+    ok(
+        Koha::Patrons->find( $child->id ),
+        'Child patron can be stored without guarantor when ChildNeedsGuarantor is off.'
+    );
+
+    t::lib::Mocks::mock_preference( 'ChildNeedsGuarantor', 1 );
+
+    my $child2 = Koha::Patron->new(
+        {
+            branchcode   => $branchcode,
+            categorycode => $child_category,
+            contactname  => ''
+        }
+    );
+    my $child3 = $builder->build_object(
+        {
+            class => 'Koha::Patrons',
+            value => { categorycode => $child_category }
+        }
+    );
+    my $patron = $builder->build_object(
+        {
+            class => 'Koha::Patrons',
+            value => { categorycode => $patron_category }
+        }
+    );
+
+    throws_ok { $child2->store(); }
+    'Koha::Exceptions::Patron::Relationship::NoGuarantor',
+      'Exception thrown when guarantor is required but not provided.';
+
+    my @guarantors = ( $patron, $child3 );
+    throws_ok { $child2->store( { guarantors => \@guarantors } ); }
+    'Koha::Exceptions::Patron::Relationship::InvalidRelationship',
+      'Exception thrown when child patron is added as guarantor.';
+
+    #test ModMember
+    @guarantors = ( $patron );
+    $child2->store( { guarantors => \@guarantors } )->discard_changes();
+
+    t::lib::Mocks::mock_preference( 'borrowerRelationship', '' );
+
+    my $relationship = Koha::Patron::Relationship->new(
+        {   guarantor_id => $patron->borrowernumber,
+            guarantee_id => $child2->borrowernumber,
+            relationship => ''
+        }
+    );
+    $relationship->store();
+
+    ok( $child2->store(), 'Child patron can be modified and stored when guarantor is stored');
+
+    @guarantors = ( $child3 );
+    throws_ok { $child2->store( { guarantors => \@guarantors } ); }
+    'Koha::Exceptions::Patron::Relationship::InvalidRelationship',
+      'Exception thrown when child patron is modified and child patron is added as guarantor.';
+
+    $relationship->delete;
+    throws_ok { $child2->store(); }
+    'Koha::Exceptions::Patron::Relationship::NoGuarantor',
+      'Exception thrown when guarantor is deleted.';
+};
-- 
2.34.1