From be2da83913b6e7897a4fcb5dfdecb1648373c854 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. --- C4/Circulation.pm | 25 ++++++++ C4/Members.pm | 23 ++++++++ Koha/Borrower.pm | 7 +++ circ/circulation.pl | 15 +++++ installer/data/mysql/atomicupdate/bug_14577.sql | 2 + installer/data/mysql/sysprefs.sql | 1 + .../en/modules/admin/preferences/circulation.pref | 5 ++ .../prog/en/modules/circ/circulation.tt | 44 +++++++++----- t/db_dependent/Borrower.t | 19 +++++- .../Circulation/NoIssuesChargeGuarantees.t | 67 ++++++++++++++++++++++ 10 files changed, 193 insertions(+), 15 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 2d2720a..5c12260 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -54,6 +54,7 @@ use Koha::Database; use Koha::Libraries; 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 $b = Koha::Borrowers->find( $borrower->{borrowernumber} ); + my @guarantees = $b->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 98e9fc5..0cf9641 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; @@ -337,6 +338,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 $b = Koha::Borrowers->find( $patroninformation->{borrowernumber} ); + my @guarantees = $b->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/Borrower.pm b/Koha/Borrower.pm index d058301..84da3e5 100644 --- a/Koha/Borrower.pm +++ b/Koha/Borrower.pm @@ -22,6 +22,7 @@ use Modern::Perl; use Carp; use Koha::Database; +use Koha::Borrowers; use base qw(Koha::Object); @@ -47,6 +48,12 @@ sub guarantor { return Koha::Borrowers->find( $self->guarantorid() ); } +sub guarantees { + my ( $self ) = @_; + + return Koha::Borrowers->search( { guarantorid => $self->id } ); +} + =head3 type =cut diff --git a/circ/circulation.pl b/circ/circulation.pl index ea07e29..7d2c16c 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -491,6 +491,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', @@ -507,6 +515,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 0000000..ab62900 --- /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 72138f7..80bcba0 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -232,6 +232,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 3bfc8ab..f7f2c0f 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 @@ -304,6 +304,11 @@ Circulation: 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: yes: Include 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 36c44f5..a9bb3cb 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt @@ -229,6 +229,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 %] @@ -787,21 +792,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/Borrower.t b/t/db_dependent/Borrower.t index c619754..36e1e90 100755 --- a/t/db_dependent/Borrower.t +++ b/t/db_dependent/Borrower.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::Borrower->new( + { + categorycode => $categorycode, + branchcode => $branchcode, + guarantorid => $object->id + } +)->store(); +my $guarantee2 = Koha::Borrower->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; diff --git a/t/db_dependent/Circulation/NoIssuesChargeGuarantees.t b/t/db_dependent/Circulation/NoIssuesChargeGuarantees.t new file mode 100644 index 0000000..614c513 --- /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; -- 2.1.4