From caa753388ade8515a05ea4b70cf9c58dd14a51a7 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Thu, 11 Feb 2016 01:23:09 +0000 Subject: [PATCH] Bug 14577 - Allow restriction of checkouts based on fines of guarantor's guarantees This enhancment allows a library to prevent patrons from checking out items if his or her guarantees own too much. Test Plan: 1) Apply this patch 2) Find or create a patron with a guarantor 3) Add a fine to the patron's account 4) Set the new system preference NoIssuesChargeGuarantees to be less than the amount owed by the patron 4) Attempt to check out an item to the guarantor, you will either be warned or prevented from checking out based on your system settings. Signed-off-by: Cathi Wiggin Signed-off-by: Jonathan Druart Signed-off-by: Kyle M Hall --- C4/Circulation.pm | 25 +++++++ C4/Members.pm | 23 +++++++ Koha/Patron.pm | 3 +- circ/circulation.pl | 15 +++++ .../data/mysql/atomicupdate/bug_14577.sql | 2 + installer/data/mysql/sysprefs.sql | 1 + .../admin/preferences/circulation.pref | 5 ++ .../prog/en/modules/circ/circulation.tt | 44 ++++++++---- .../Circulation/NoIssuesChargeGuarantees.t | 67 +++++++++++++++++++ t/db_dependent/Patron.t | 19 +++++- 10 files changed, 188 insertions(+), 16 deletions(-) create mode 100644 installer/data/mysql/atomicupdate/bug_14577.sql create mode 100644 t/db_dependent/Circulation/NoIssuesChargeGuarantees.t diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 650dc129bd..811cc98a99 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -55,6 +55,7 @@ use Koha::Libraries; use Koha::Holds; use Carp; use List::MoreUtils qw( uniq ); +use Scalar::Util qw( looks_like_number ); use Date::Calc qw( Today Today_and_Now @@ -844,9 +845,32 @@ sub CanBookBeIssued { # DEBTS my ($balance, $non_issue_charges, $other_charges) = C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} ); + my $amountlimit = C4::Context->preference("noissuescharge"); my $allowfineoverride = C4::Context->preference("AllowFineOverride"); my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride"); + + # Check the debt of this patrons guarantees + my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees"); + $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees ); + if ( defined $no_issues_charge_guarantees ) { + my $p = Koha::Patrons->find( $borrower->{borrowernumber} ); + my @guarantees = $p->guarantees(); + my $guarantees_non_issues_charges; + foreach my $g ( @guarantees ) { + my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id ); + $guarantees_non_issues_charges += $n; + } + + if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) { + $issuingimpossible{DEBT_GUARANTEES} = sprintf( "%.2f", $guarantees_non_issues_charges ); + } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) { + $needsconfirmation{DEBT_GUARANTEES} = sprintf( "%.2f", $guarantees_non_issues_charges ); + } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) { + $needsconfirmation{DEBT_GUARANTEES} = sprintf( "%.2f", $guarantees_non_issues_charges ); + } + } + if ( C4::Context->preference("IssuingInProcess") ) { if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) { $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges ); @@ -865,6 +889,7 @@ sub CanBookBeIssued { $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges ); } } + if ($balance > 0 && $other_charges > 0) { $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges ); } diff --git a/C4/Members.pm b/C4/Members.pm index ed82f86ca5..a3e1377014 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -24,6 +24,7 @@ use strict; #use warnings; FIXME - Bug 2505 use C4::Context; use String::Random qw( random_string ); +use Scalar::Util qw( looks_like_number ); use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/; use C4::Log; # logaction use C4::Overdues; @@ -326,6 +327,28 @@ sub patronflags { $flaginfo{'amount'} = sprintf "%.02f", $balance; $flags{'CREDITS'} = \%flaginfo; } + + # Check the debt of the guarntees of this patron + my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees"); + $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees ); + if ( defined $no_issues_charge_guarantees ) { + my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} ); + my @guarantees = $p->guarantees(); + my $guarantees_non_issues_charges; + foreach my $g ( @guarantees ) { + my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id ); + $guarantees_non_issues_charges += $n; + } + + if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) { + my %flaginfo; + $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges; + $flaginfo{'amount'} = sprintf "%.02f", $guarantees_non_issues_charges; + $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride"); + $flags{'CHARGES_GUARANTEES'} = \%flaginfo; + } + } + if ( $patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1 ) { diff --git a/Koha/Patron.pm b/Koha/Patron.pm index 68cb822232..ac62594fce 100644 --- a/Koha/Patron.pm +++ b/Koha/Patron.pm @@ -22,6 +22,7 @@ use Modern::Perl; use Carp; use Koha::Database; +use Koha::Patrons; use Koha::Patron::Images; use base qw(Koha::Object); @@ -65,7 +66,7 @@ Returns the guarantees (list of Koha::Patron) of this patron sub guarantees { my ( $self ) = @_; - return Koha::Patrons->search({ guarantorid => $self->borrowernumber }); + return Koha::Patrons->search( { guarantorid => $self->borrowernumber } ); } =head3 siblings diff --git a/circ/circulation.pl b/circ/circulation.pl index d128321840..981bef708a 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -499,6 +499,14 @@ foreach my $flag ( sort keys %$flags ) { charges_is_blocker => 1 ); } + elsif ( $flag eq 'CHARGES_GUARANTEES' ) { + $template->param( + charges_guarantees => 'true', + chargesmsg_guarantees => $flags->{'CHARGES_GUARANTEES'}->{'message'}, + chargesamount_guarantees => $flags->{'CHARGES_GUARANTEES'}->{'amount'}, + charges_guarantees_is_blocker => 1 + ); + } elsif ( $flag eq 'CREDITS' ) { $template->param( credits => 'true', @@ -515,6 +523,13 @@ foreach my $flag ( sort keys %$flags ) { chargesamount => $flags->{'CHARGES'}->{'amount'}, ); } + elsif ( $flag eq 'CHARGES_GUARANTEES' ) { + $template->param( + charges_guarantees => 'true', + chargesmsg_guarantees => $flags->{'CHARGES_GUARANTEES'}->{'message'}, + chargesamount_guarantees => $flags->{'CHARGES_GUARANTEES'}->{'amount'}, + ); + } elsif ( $flag eq 'CREDITS' ) { $template->param( credits => 'true', diff --git a/installer/data/mysql/atomicupdate/bug_14577.sql b/installer/data/mysql/atomicupdate/bug_14577.sql new file mode 100644 index 0000000000..ab62900056 --- /dev/null +++ b/installer/data/mysql/atomicupdate/bug_14577.sql @@ -0,0 +1,2 @@ +INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, `type` ) VALUES +('NoIssuesChargeGuarantees','','','Define maximum amount withstanding before check outs are blocked','Integer'); diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql index fed0ed9819..22d04f0b86 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -243,6 +243,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('NewItemsDefaultLocation','','','If set, all new items will have a location of the given Location Code ( Authorized Value type LOC )',''), ('NewsAuthorDisplay','none','none|opac|staff|both','Display the author name for news items.','Choice'), ('noissuescharge','5','','Define maximum amount withstanding before check outs are blocked','Integer'), +('NoIssuesChargeGuarantees','','','Define maximum amount withstanding before check outs are blocked','Integer'), ('noItemTypeImages','0',NULL,'If ON, disables item-type images','YesNo'), ('NoLoginInstructions', '', '60|10', 'Instructions to display on the OPAC login form when a patron is not logged in', 'Textarea'), ('NorwegianPatronDBEnable','0',NULL,'Enable communication with the Norwegian national patron database.', 'YesNo'), diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref index 37b8d57fe5..9a3760843b 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref @@ -303,6 +303,11 @@ Circulation: - pref: noissuescharge class: integer - '[% local_currency %] in fines.' + - + - Prevent a patron from checking out if the patron has guarantees owing in total more than + - pref: NoIssuesChargeGuarantees + class: integer + - '[% local_currency %] in fines.' - - pref: RentalsInNoissuesCharge choices: diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt index 616a2b234b..bfedf5c8a9 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt @@ -234,6 +234,11 @@ $(document).ready(function() { [% IF ( DEBT ) %]
  • The patron has a debt of [% DEBT %].
  • [% END %] + +[% IF ( DEBT_GUARANTEES ) %] +
  • The patron's guarantees collectively have a debt of [% DEBT_GUARANTEES %].
  • +[% END %] + [% IF ( RENTALCHARGE && RENTALCHARGE > 0 ) %]
  • Rental charge for this item: [% RENTALCHARGE %]
  • [% END %] @@ -791,21 +796,32 @@ No patron matched [% message %] [% IF ( odues ) %]
  • [% IF ( nonreturns ) %]Overdues: Patron has ITEMS OVERDUE. See highlighted items below[% END %]
  • [% END %] - [% IF ( charges ) %] -
  • - Fees & Charges: Patron has Outstanding fees & charges[% IF ( chargesamount ) %] of [% chargesamount %][% END %]. - [% IF ( charges_is_blocker ) %] - Checkouts are BLOCKED because fine balance is OVER THE LIMIT. - [% END %] - Make payment or - Pay all fines
  • - [% END %] + [% IF ( charges ) %] +
  • + Fees & Charges: Patron has Outstanding fees & charges[% IF ( chargesamount ) %] of [% chargesamount %][% END %]. + [% IF ( charges_is_blocker ) %] + Checkouts are BLOCKED because fine balance is OVER THE LIMIT. + [% END %] + Make payment or + Pay all fines +
  • + [% END %] - [% IF ( credits ) %] -
  • - Credits: Patron has a credit[% IF ( creditsamount ) %] of [% creditsamount %][% END %] -
  • - [% END %] + [% IF ( charges_guarantees ) %] +
  • + Fees & Charges: Patron's guarantees collectively owe [% chargesamount_guarantees %]. + [% IF ( charges_guarantees_is_blocker ) %] + Checkouts are BLOCKED because fine balance is OVER THE LIMIT. + [% END %] +
  • + [% END %] + + + [% IF ( credits ) %] +
  • + Credits: Patron has a credit[% IF ( creditsamount ) %] of [% creditsamount %][% END %] +
  • + [% END %] diff --git a/t/db_dependent/Circulation/NoIssuesChargeGuarantees.t b/t/db_dependent/Circulation/NoIssuesChargeGuarantees.t new file mode 100644 index 0000000000..614c51308e --- /dev/null +++ b/t/db_dependent/Circulation/NoIssuesChargeGuarantees.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use Test::More tests => 2; + +use t::lib::TestBuilder; + +use C4::Accounts qw( manualinvoice ); +use C4::Circulation qw( CanBookBeIssued ); + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; + +my $builder = t::lib::TestBuilder->new(); + +my $item = $builder->build( + { + source => 'Item', + value => { + notforloan => 0, + withdrawn => 0 + } + } +); + +my $patron = $builder->build( + { + source => 'Borrower', + } +); +my $guarantee = $builder->build( + { + source => 'Borrower', + value => { + guarantorid => $patron->{borrowernumber}, + } + } +); + +C4::Context->set_preference( 'NoIssuesChargeGuarantees', '5.00' ); + +my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $patron, $item->{barcode} ); +is( $issuingimpossible->{DEBT_GUARANTEES}, undef, "Patron can check out item" ); + +manualinvoice( $guarantee->{borrowernumber}, undef, undef, 'L', 10.00 ); +( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $patron, $item->{barcode} ); +is( $issuingimpossible->{DEBT_GUARANTEES}, '10.00', "Patron cannot check out item due to debt for guarantee" ); + +$schema->storage->txn_rollback; + +1; diff --git a/t/db_dependent/Patron.t b/t/db_dependent/Patron.t index 11c57fed13..01400131cc 100755 --- a/t/db_dependent/Patron.t +++ b/t/db_dependent/Patron.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 13; +use Test::More tests => 15; use Test::Warn; use C4::Context; @@ -44,6 +44,23 @@ $object->surname("Test Surname"); $object->store(); is( $object->in_storage, 1, "Object is now stored" ); +my $guarantee1 = Koha::Patron->new( + { + categorycode => $categorycode, + branchcode => $branchcode, + guarantorid => $object->id + } +)->store(); +my $guarantee2 = Koha::Patron->new( + { + categorycode => $categorycode, + branchcode => $branchcode, + guarantorid => $object->id + } +)->store(); +my @guarantees = $object->guarantees(); +is( $guarantees[0]->id, $guarantee1->id, "First guarantee matchs" ); +is( $guarantees[1]->id, $guarantee2->id, "Second guarantee matchs" ); my $borrowernumber = $object->borrowernumber; -- 2.39.5