@@ -, +, @@ automatically when returned 1) Apply patch 2) Run updatedatabase.pl 3) Verify the borrower_debarments table has been created and populated with the pre-existing debarments 4) Run t/db_dependent/Borrower_Debarments.t 5) Manually debar a patron, with an expiration date 6) Verify the patron cannot be issued to 7) Add another manual debarment with a different expiration date 8) Verify the 'restricted' message lists the date farthest into the future 9) Add another manual debarment with no expiration date --- C4/Circulation.pm | 37 ++- C4/Members.pm | 42 +-- C4/Overdues.pm | 37 +-- Koha/Borrower/Debarments.pm | 333 ++++++++++++++++++++ circ/circulation.pl | 18 +- installer/data/mysql/sysprefs.sql | 3 +- installer/data/mysql/updatedatabase.pl | 30 ++ .../prog/en/includes/borrower_debarments.inc | 64 ++++ .../en/modules/admin/preferences/circulation.pref | 6 + .../prog/en/modules/circ/circulation.tt | 14 +- .../prog/en/modules/members/memberentrygen.tt | 68 ++-- .../prog/en/modules/members/moremember.tt | 8 +- .../prog/en/modules/tools/modborrowers.tt | 6 - members/memberentry.pl | 40 ++- members/mod_debarment.pl | 63 ++++ members/moremember.pl | 6 +- members/setdebar.pl | 50 --- misc/cronjobs/overdue_notices.pl | 12 +- opac/opac-reserve.pl | 2 +- opac/opac-user.pl | 3 +- t/db_dependent/Borrower_Debarments.t | 102 ++++++ tools/modborrowers.pl | 18 +- 22 files changed, 755 insertions(+), 207 deletions(-) create mode 100644 Koha/Borrower/Debarments.pm create mode 100644 koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc create mode 100755 members/mod_debarment.pl delete mode 100755 members/setdebar.pl create mode 100755 t/db_dependent/Borrower_Debarments.t --- a/C4/Circulation.pm +++ a/C4/Circulation.pm @@ -47,6 +47,7 @@ use Algorithm::CheckDigits; use Data::Dumper; use Koha::DateUtils; use Koha::Calendar; +use Koha::Borrower::Debarments; use Carp; use Date::Calc qw( Today @@ -1920,6 +1921,16 @@ sub AddReturn { logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'}) if C4::Context->preference("ReturnLog"); + # Remove any OVERDUES related debarment if the borrower has no overdues + if ( $borrowernumber + && $borrower->{'debarred'} + && C4::Context->preference('AutoRemoveOverduesRestrictions') + && !HasOverdues( $borrowernumber ) + && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) } + ) { + DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' }); + } + # FIXME: make this comment intelligible. #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch . @@ -2053,19 +2064,13 @@ sub _debar_user_on_return { my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays ); - if ( $borrower->{debarred} ) { - my $borrower_debar_dt = dt_from_string( $borrower->{debarred} ); - # Update patron only if new date > old - if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) != - -1 ) - { - return; - } + Koha::Borrower::Debarments::AddUniqueDebarment({ + borrowernumber => $borrower->{borrowernumber}, + expiration => $new_debar_dt->ymd(), + type => 'SUSPENSION', + }); - } - C4::Members::DebarMember( $borrower->{borrowernumber}, - $new_debar_dt->ymd() ); return $new_debar_dt->ymd(); } } @@ -2611,6 +2616,16 @@ sub AddRenewal { } } + # Remove any OVERDUES related debarment if the borrower has no overdues + my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ); + if ( $borrowernumber + && $borrower->{'debarred'} + && !HasOverdues( $borrowernumber ) + && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) } + ) { + DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' }); + } + # Log the renewal UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'}); return $datedue; --- a/C4/Members.pm +++ a/C4/Members.pm @@ -39,6 +39,7 @@ use C4::NewsChannels; #get slip news use DateTime; use DateTime::Format::DateParse; use Koha::DateUtils; +use Koha::Borrower::Debarments qw(IsDebarred); use Text::Unaccent qw( unac_string ); our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug); @@ -103,6 +104,8 @@ BEGIN { &IssueSlip GetBorrowersWithEmail + + HasOverdues ); #Modify data @@ -636,7 +639,7 @@ sub IsMemberBlocked { my $borrowernumber = shift; my $dbh = C4::Context->dbh; - my $blockeddate = CheckBorrowerDebarred($borrowernumber); + my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber); return ( 1, $blockeddate ) if $blockeddate; @@ -2236,32 +2239,6 @@ sub GetBorrowersNamesAndLatestIssue { return $results; } -=head2 DebarMember - -my $success = DebarMember( $borrowernumber, $todate ); - -marks a Member as debarred, and therefore unable to checkout any more -items. - -return : -true on success, false on failure - -=cut - -sub DebarMember { - my $borrowernumber = shift; - my $todate = shift; - - return unless defined $borrowernumber; - return unless $borrowernumber =~ /^\d+$/; - - return ModMember( - borrowernumber => $borrowernumber, - debarred => $todate - ); - -} - =head2 ModPrivacy =over 4 @@ -2560,6 +2537,17 @@ sub AddEnrolmentFeeIfNeeded { } } +sub HasOverdues { + my ( $borrowernumber ) = @_; + + my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?"; + my $sth = C4::Context->dbh->prepare( $sql ); + $sth->execute( $borrowernumber ); + my ( $count ) = $sth->fetchrow_array(); + + return $count; +} + END { } # module clean-up code here (global destructor) 1; --- a/C4/Overdues.pm +++ a/C4/Overdues.pm @@ -62,10 +62,10 @@ BEGIN { push @EXPORT, qw( &GetIssuesIteminfo ); - # subs to move to Members.pm - push @EXPORT, qw( - &CheckBorrowerDebarred - ); + + # &GetIssuingRules - delete. + # use C4::Circulation::GetIssuingRule instead. + # subs to move to Biblio.pm push @EXPORT, qw( &GetItems @@ -759,35 +759,6 @@ sub GetBranchcodesWithOverdueRules { return @branches; } -=head2 CheckBorrowerDebarred - - ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber); - -Check if the borrowers is already debarred - -C<$debarredstatus> return 0 for not debarred and return 1 for debarred - -C<$borrowernumber> contains the borrower number - -=cut - -# FIXME: Shouldn't this be in C4::Members? -sub CheckBorrowerDebarred { - my ($borrowernumber) = @_; - my $dbh = C4::Context->dbh; - my $query = qq| - SELECT debarred - FROM borrowers - WHERE borrowernumber=? - AND debarred > NOW() - |; - my $sth = $dbh->prepare($query); - $sth->execute($borrowernumber); - my $debarredstatus = $sth->fetchrow; - return $debarredstatus; -} - - =head2 CheckItemNotify Sql request to check if the document has alreday been notified --- a/Koha/Borrower/Debarments.pm +++ a/Koha/Borrower/Debarments.pm @@ -0,0 +1,333 @@ +package Koha::Borrower::Debarments; + +# Copyright 2013 ByWater Solutions +# +# 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use Modern::Perl; + +use C4::Context; + +use parent qw( Exporter ); + +our @EXPORT = qw( + GetDebarments + + AddDebarment + DelDebarment + ModDebarment + + AddUniqueDebarment + DelUniqueDebarment + + IsDebarred +); + +=head1 Koha::Borrower::Debarments + +Koha::Borrower::Debarments - Module for managing borrower debarments + +=cut + +=head2 GetDebarments + +my $arrayref = GetDebarments( $borrowernumber, { key => $value } ); + +=cut + +sub GetDebarments { + my ($params) = @_; + + return unless ( $params->{'borrowernumber'} ); + + my @keys = keys %$params; + my @values = values %$params; + + my $where = join( ' AND ', map { "$_ = ?" } @keys ); + my $sql = "SELECT * FROM borrower_debarments WHERE $where"; + my $sth = C4::Context->dbh->prepare($sql); + $sth->execute(@values); + + return $sth->fetchall_arrayref( {} ); +} + +=head2 AddDebarment + +my $success = AddDebarment({ + borrowernumber => $borrowernumber, + expiration => $expiration, + type => $type, ## enum('FINES','OVERDUES','MANUAL') + comment => $comment, +}); + +Creates a new debarment. + +Required keys: borrowernumber, type + +=cut + +sub AddDebarment { + my ($params) = @_; + + my $borrowernumber = $params->{'borrowernumber'}; + my $expiration = $params->{'expiration'} || undef; + my $type = $params->{'type'} || 'MANUAL'; + my $comment = $params->{'comment'} || undef; + + return unless ( $borrowernumber && $type ); + + my $manager_id; + $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; + + my $sql = " + INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created ) + VALUES ( ?, ?, ?, ?, ?, NOW() ) + "; + + my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) ); + + _UpdateBorrowerDebarmentFlags($borrowernumber); + + return $r; +} + +=head2 DelDebarment + +my $success = DelDebarment( $borrower_debarment_id ); + +Deletes a debarment. + +=cut + +sub DelDebarment { + my ($id) = @_; + + my $borrowernumber = _GetBorrowernumberByDebarmentId($id); + + my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?"; + + my $r = C4::Context->dbh->do( $sql, {}, ($id) ); + + _UpdateBorrowerDebarmentFlags($borrowernumber); + + return $r; +} + +=head2 ModDebarment + +my $success = ModDebarment({ + borrower_debarment_id => $borrower_debarment_id, + expiration => $expiration, + type => $type, ## enum('FINES','OVERDUES','MANUAL') + comment => $comment, +}); + +Updates an existing debarment. + +Required keys: borrower_debarment_id + +=cut + +sub ModDebarment { + my ($params) = @_; + + my $borrower_debarment_id = $params->{'borrower_debarment_id'}; + + return unless ($borrower_debarment_id); + + delete( $params->{'borrower_debarment_id'} ); + + delete( $params->{'created'} ); + delete( $params->{'updated'} ); + + $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv; + + my @keys = keys %$params; + my @values = values %$params; + + my $sql = join( ',', map { "$_ = ?" } @keys ); + + $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?"; + + my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) ); + + _UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) ); + + return $r; +} + +=head2 IsDebarred + +my $debarment_expiration = IsDebarred( $borrowernumber ); + +Returns the date a borrowers debarment will expire, or +undef if the borrower is not debarred + +=cut + +sub IsDebarred { + my ($borrowernumber) = @_; + + return unless ($borrowernumber); + + my $sql = "SELECT debarred FROM borrowers WHERE borrowernumber = ?"; + my $sth = C4::Context->dbh->prepare($sql); + $sth->execute($borrowernumber); + my ($debarred) = $sth->fetchrow_array(); + + return $debarred; +} + +=head2 AddUniqueDebarment + +my $success = AddUniqueDebarment({ + borrowernumber => $borrowernumber, + type => $type, + expiration => $expiration, + comment => $comment, +}); + +Creates a new debarment of the type defined by the key type. +If a unique debarment already exists of the given type, it is updated instead. +The current unique debarment types are OVERDUES, and SUSPENSION + +Required keys: borrowernumber, type + +=cut + +sub AddUniqueDebarment { + my ($params) = @_; + + my $borrowernumber = $params->{'borrowernumber'}; + my $type = $params->{'type'}; + + return unless ( $borrowernumber && $type ); + + my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0]; + + my $r; + if ($debarment) { + + # We don't want to shorten a unique debarment's period, so if this 'update' would do so, just keep the current expiration date instead + $params->{'expiration'} = $debarment->{'expiration'} + if ( $debarment->{'expiration'} + && $debarment->{'expiration'} gt $params->{'expiration'} ); + + $params->{'borrower_debarment_id'} = + $debarment->{'borrower_debarment_id'}; + $r = ModDebarment($params); + } else { + + $r = AddDebarment($params); + } + + _UpdateBorrowerDebarmentFlags($borrowernumber); + + return $r; +} + +=head2 DelUniqueDebarment + +my $success = _DelUniqueDebarment({ + borrowernumber => $borrowernumber, + type => $type, +}); + +Deletes a unique debarment of the type defined by the key type. +The current unique debarment types are OVERDUES, and SUSPENSION + +Required keys: borrowernumber, type + +=cut + +sub DelUniqueDebarment { + my ($params) = @_; + + my $borrowernumber = $params->{'borrowernumber'}; + my $type = $params->{'type'}; + + return unless ( $borrowernumber && $type ); + + my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0]; + + return unless ( $debarment ); + + return DelDebarment( $debarment->{'borrower_debarment_id'} ); +} + +=head2 _UpdateBorrowerDebarmentFlags + +my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber ); + +So as not to create additional latency, the fields borrowers.debarred +and borrowers.debarredcomment remain in the borrowers table. Whenever +the a borrowers debarrments are modified, this subroutine is run to +decide if the borrower is currently debarred and update the 'quick flags' +in the borrowers table accordingly. + +=cut + +sub _UpdateBorrowerDebarmentFlags { + my ($borrowernumber) = @_; + + return unless ($borrowernumber); + + my $dbh = C4::Context->dbh; + + my $sql = q{ + SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments + WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ? + }; + my $sth = $dbh->prepare($sql); + $sth->execute($borrowernumber); + my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array(); + + if ($count) { + $expiration = "9999-12-31" if ($indefinite_expiration); + } else { + $expiration = undef; + $comment = undef; + } + + return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) ); +} + +=head2 _GetBorrowernumberByDebarmentId + +my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id ); + +=cut + +sub _GetBorrowernumberByDebarmentId { + my ($borrower_debarment_id) = @_; + + return unless ($borrower_debarment_id); + + my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?"; + my $sth = C4::Context->dbh->prepare($sql); + $sth->execute($borrower_debarment_id); + my ($borrowernumber) = $sth->fetchrow_array(); + + return $borrowernumber; +} + +1; + +=head2 AUTHOR + +Kyle M Hall + +=cut --- a/circ/circulation.pl +++ a/circ/circulation.pl @@ -32,7 +32,6 @@ use C4::Dates qw/format_date/; use C4::Branch; # GetBranches use C4::Koha; # GetPrinter use C4::Circulation; -use C4::Overdues qw/CheckBorrowerDebarred/; use C4::Members; use C4::Biblio; use C4::Search; @@ -41,6 +40,7 @@ use C4::Reserves; use C4::Context; use CGI::Session; use C4::Members::Attributes qw(GetBorrowerAttributes); +use Koha::Borrower::Debarments qw(GetDebarments); use Koha::DateUtils; use Date::Calc qw( @@ -266,13 +266,12 @@ if ($borrowernumber) { finetotal => $fines ); - my $debar = CheckBorrowerDebarred($borrowernumber); - if ($debar) { - $template->param( 'userdebarred' => 1 ); - $template->param( 'debarredcomment' => $borrower->{debarredcomment} ); - if ( $debar ne "9999-12-31" ) { - $template->param( 'userdebarreddate' => C4::Dates::format_date($debar) ); - } + $template->param( + 'userdebarred' => $borrower->{debarred}, + 'debarredcomment' => $borrower->{debarredcomment}, + ); + if ( $borrower->{debarred} ne "9999-12-31" ) { + $template->param( 'userdebarreddate' => C4::Dates::format_date( $borrower->{debarred} ) ); } } @@ -776,10 +775,11 @@ $template->param( debt_confirmed => $debt_confirmed, SpecifyDueDate => $duedatespec_allow, CircAutocompl => C4::Context->preference("CircAutocompl"), - AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"), + AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"), export_remove_fields => C4::Context->preference("ExportRemoveFields"), export_with_csv_profile => C4::Context->preference("ExportWithCsvProfile"), canned_bor_notes_loop => $canned_notes, + debarments => GetDebarments({ borrowernumber => $borrowernumber }), ); output_html_with_http_headers $query, $cookie, $template->output; --- a/installer/data/mysql/sysprefs.sql +++ a/installer/data/mysql/sysprefs.sql @@ -43,7 +43,8 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('AutomaticItemReturn','1',NULL,'If ON, Koha will automatically set up a transfer of this item to its homebranch','YesNo'), ('autoMemberNum','1','','If ON, patron number is auto-calculated','YesNo'), ('AutoResumeSuspendedHolds','1',NULL,'Allow suspended holds to be automatically resumed by a set date.','YesNo'), -('AutoSelfCheckAllowed','0','','For corporate and special libraries which want web-based self-check available from any PC without the need for a manual staff login. Most libraries will want to leave this turned off. If on, requires self-check ID and password to be entered in AutoSelfCheckID and AutoSelfCheckPass sysprefs.','YesNo'), +('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo'), +('AutoSelfCheckAllowed','0','For corporate and special libraries which want web-based self-check available from any PC without the need for a manual staff login. Most libraries will want to leave this turned off. If on, requires self-check ID and password to be entered in AutoSelfCheckID and AutoSelfCheckPass sysprefs.','YesNo'), ('AutoSelfCheckID','','','Staff ID with circulation rights to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'), ('AutoSelfCheckPass','','','Password to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'), ('Babeltheque','0','','Turn ON Babeltheque content - See babeltheque.com to subscribe to this service','YesNo'), --- a/installer/data/mysql/updatedatabase.pl +++ a/installer/data/mysql/updatedatabase.pl @@ -7139,6 +7139,36 @@ if ( CheckVersion($DBversion) ) { SetVersion ($DBversion); } +$DBversion ="3.13.00.XXX"; +if ( CheckVersion($DBversion) ) { + $dbh->do(q{ +CREATE TABLE borrower_debarments ( + borrower_debarment_id int(11) NOT NULL AUTO_INCREMENT, + borrowernumber int(11) NOT NULL, + expiration date DEFAULT NULL, + `type` enum('SUSPENSION','OVERDUES','MANUAL') NOT NULL DEFAULT 'MANUAL', + `comment` text, + manager_id int(11) DEFAULT NULL, + created timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP, + updated timestamp NULL DEFAULT NULL, + PRIMARY KEY (borrower_debarment_id), + KEY borrowernumber (borrowernumber) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + }); + + $dbh->do(q{ +INSERT INTO borrower_debarments ( borrowernumber, expiration, comment ) SELECT borrowernumber, debarred, debarredcomment FROM borrowers WHERE debarred IS NOT NULL + }); + + $dbh->do(q{ +INSERT IGNORE INTO systempreferences (variable,value,explanation,type) VALUES +('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo') + }); + + print "Upgrade to $DBversion done (Bug 2720 - Overdues which debar automatically should undebar automatically when returned)\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS =head2 TableExists($table) --- a/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc +++ a/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc @@ -0,0 +1,64 @@ + + +
+ [% UNLESS debarments %]

Patron is currently unrestricted.

[% END %] + + + + + + + + [% IF ( CAN_user_borrowers ) %] + + [% END %] + + + + + [% FOREACH d IN debarments %] + + + + + [% IF ( CAN_user_borrowers )%] + + [% END %] + + [% END %] + + + [% IF ( CAN_user_borrowers )%] + + + + + + + + + + + + + + [% END %] +
TypeCommentExpiration 
[% d.type %][% d.comment %][% IF d.expiration %] [% d.expiration | $KohaDates %] [% ELSE %] Indefinite [% END %] + + Remove + +
MANUAL + + Clear Date + + +
+
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref @@ -138,6 +138,12 @@ Circulation: no: "Don't allow" - staff to override and check out items when the patron has reached the maximum number of allowed checkouts. - + - pref: AutoRemoveOverduesRestrictions + choices: + yes: "Do" + no: "Do not" + - allow OVERDUES restrictions triggered by sent notices to be cleared automatically when all overdue items are returned by a patron. + - - pref: AllowNotForLoanOverride choices: yes: Allow --- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt @@ -557,14 +557,10 @@ No patron matched [% message %] [% IF ( userdebarred ) %]
  • - Restricted: Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %] -
    - - - - -
    -
  • [% END %] + Restricted: Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %] + View restrictions + + [% END %] [% IF ( odues ) %]
  • [% IF ( nonreturns ) %]Overdues: Patron has ITEMS OVERDUE. See highlighted items below[% END %]
  • [% END %] @@ -664,6 +660,7 @@ No patron matched [% message %] [% ELSE %] 0 Holds [% END %] +
  • [% debarments.size %] Restrictions
  • @@ -979,6 +976,7 @@ No patron matched [% message %] [% END %] +[% INCLUDE borrower_debarments.inc %]
    [% IF ( reservloop ) %] --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt @@ -1,4 +1,5 @@ [% IF ( opduplicate ) %][% SET focusAction = "clearDupe" %][% END %] +[% USE KohaDates %] [% INCLUDE 'doc-head-open.inc' %] Koha › Patrons › [% IF ( opadd ) %]Add[% ELSIF ( opduplicate ) %]Duplicate[% ELSE %] Modify[% END %] [% IF ( categoryname ) %] [% categoryname %] patron[% ELSE %][% IF ( I ) %] Organization patron[% END %][% IF ( A ) %] Adult patron[% END %][% IF ( C ) %] Child patron[% END %][% IF ( P ) %] Professional patron[% END %][% IF ( S ) %] Staff patron[% END %][% END %][% UNLESS ( opadd ) %] [% surname %], [% firstname %][% END %] @@ -1142,7 +1143,6 @@ [% FOREACH flagloo IN flagloop %]
  • @@ -1160,32 +1160,54 @@
  • [% END %] -
  • - - [% IF ( debarred ) %] - - - - - [% ELSE %] - - - - - [% END %] - - - - (optional) -
  • -
  • - - -
  • +
    + Patron restrictions + + [% UNLESS debarments %]

    Patron is currently unrestricted.

    [% END %] + + + + + + + + + + + + + [% FOREACH d IN debarments %] + + + + + + + [% END %] + + + + + + + + + + +
    TypeCommentExpirationRemove?
    [% d.type %][% d.comment %][% IF d.expiration %] [% d.expiration | $KohaDates %] [% ELSE %] Indefinite [% END %] + +
    + Add new + + + + Clear date + Clear new restriction
    +
    [% END %] [% END %] --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt @@ -194,10 +194,7 @@ function validate1(date) {
    @@ -614,6 +612,8 @@ function validate1(date) { [% END %]
    +[% INCLUDE borrower_debarments.inc %] +
    [% IF ( reservloop ) %] --- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt @@ -210,7 +210,6 @@ Category Registration date Expiry date - Restricted [% FOREACH attrh IN attributes_header %] [% attrh.attribute %] [% END %] @@ -229,7 +228,6 @@ [% borrower.categorycode %] [% borrower.dateenrolled | $KohaDates %] [% borrower.dateexpiry | $KohaDates %] - [% borrower.debarred | $KohaDates %] [% FOREACH pa IN borrower.patron_attributes %] [% IF ( pa.code ) %] [% pa.code %]=[% pa.value %] @@ -274,10 +272,6 @@ Registration date: [% CASE 'dateexpiry' %] Expiry date: - [% CASE 'debarred' %] - Restricted: - [% CASE 'debarredcomment' %] - Restriction comment: [% CASE 'borrowernotes' %] Circulation note: [% END %] --- a/members/memberentry.pl +++ a/members/memberentry.pl @@ -41,6 +41,8 @@ use C4::Log; use C4::Letters; use C4::Branch; # GetBranches use C4::Form::MessagingPreferences; +use Koha::Borrower::Debarments; +use Koha::DateUtils; use vars qw($debug); @@ -62,6 +64,7 @@ my ($template, $loggedinuser, $cookie) flagsrequired => {borrowers => 1}, debug => ($debug) ? 1 : 0, }); + my $guarantorid = $input->param('guarantorid'); my $borrowernumber = $input->param('borrowernumber'); my $actionType = $input->param('actionType') || ''; @@ -90,6 +93,29 @@ my $borrower_data; my $NoUpdateLogin; my $userenv = C4::Context->userenv; + +## Deal with debarments +$template->param( + debarments => GetDebarments( { borrowernumber => $borrowernumber } ) ); +my @debarments_to_remove = $input->param('remove_debarment'); +foreach my $d ( @debarments_to_remove ) { + DelDebarment( $d ); +} +if ( $input->param('add_debarment') ) { + + my $expiration = $input->param('debarred_expiration'); + $expiration = $expiration ? output_pref( dt_from_string($expiration), 'iso' ) : undef; + + AddUniqueDebarment( + { + borrowernumber => $borrowernumber, + type => 'MANUAL', + comment => $input->param('debarred_comment'), + expiration => $expiration, + } + ); +} + $template->param("uppercasesurnames" => C4::Context->preference('uppercasesurnames')); my $minpw = C4::Context->preference('minPasswordLength'); @@ -142,16 +168,6 @@ if ( $op eq 'insert' || $op eq 'modify' || $op eq 'save' || $op eq 'duplicate' ) } } - ## Manipulate debarred - if ( $newdata{debarred} ) { - $newdata{debarred} = $newdata{datedebarred} ? $newdata{datedebarred} : "9999-12-31"; - } elsif ( exists( $newdata{debarred} ) && !( $newdata{debarred} ) ) { - undef( $newdata{debarred} ); - undef( $newdata{debarredcomment} ); - } elsif ( exists( $newdata{debarredcomment} ) && $newdata{debarredcomment} eq "" ) { - undef( $newdata{debarredcomment} ); - } - my $dateobject = C4::Dates->new(); my $syspref = $dateobject->regexp(); # same syspref format for all 3 dates my $iso = $dateobject->regexp('iso'); # @@ -661,9 +677,7 @@ if (C4::Context->preference('uppercasesurnames')) { $data{'contactname'} &&= uc( $data{'contactname'} ); } -$data{debarred} = C4::Overdues::CheckBorrowerDebarred($borrowernumber); -$data{datedebarred} = $data{debarred} if ( $data{debarred} && $data{debarred} ne "9999-12-31" ); -foreach (qw(dateenrolled dateexpiry dateofbirth datedebarred)) { +foreach (qw(dateenrolled dateexpiry dateofbirth)) { $data{$_} = format_date($data{$_}); # back to syspref for display $template->param( $_ => $data{$_}); } --- a/members/mod_debarment.pl +++ a/members/mod_debarment.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +# Copyright 2013 ByWater Solutions +# +# 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use CGI; + +use C4::Auth; +use Koha::DateUtils; +use Koha::Borrower::Debarments; + +my $cgi = new CGI; + +my ( $loggedinuser, $cookie, $sessionID ) = checkauth( $cgi, 0, { borrowers => 1 } ); + +my $borrowernumber = $cgi->param('borrowernumber'); +my $action = $cgi->param('action'); + +if ( $action eq 'del' ) { + DelDebarment( $cgi->param('borrower_debarment_id') ); +} elsif ( $action eq 'add' ) { + my $expiration = $cgi->param('expiration'); + if ($expiration) { + $expiration = dt_from_string($expiration); + $expiration = $expiration->ymd(); + } + + AddDebarment( + { borrowernumber => $borrowernumber, + type => 'MANUAL', + comment => $cgi->param('comment'), + expiration => $expiration, + } + ); +} + +if ( $ENV{HTTP_REFERER} =~ /moremember/ ) { + print $cgi->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber"); +} else { + print $cgi->redirect("/cgi-bin/koha/circ/circulation.pl?borrowernumber=$borrowernumber"); +} + +=head1 author + +Kyle M Hall + +=cut --- a/members/moremember.pl +++ a/members/moremember.pl @@ -48,11 +48,10 @@ use C4::Koha; use C4::Letters; use C4::Biblio; use C4::Branch; # GetBranchName -use C4::Overdues qw/CheckBorrowerDebarred/; use C4::Form::MessagingPreferences; use List::MoreUtils qw/uniq/; use C4::Members::Attributes qw(GetBorrowerAttributes); - +use Koha::Borrower::Debarments qw(GetDebarments); #use Smart::Comments; #use Data::Dumper; use DateTime; @@ -147,7 +146,7 @@ for (qw(gonenoaddress lost borrowernotes)) { $data->{$_} and $template->param(flagged => 1) and last; } -my $debar = CheckBorrowerDebarred($borrowernumber); +my $debar = $data->{'debarred'}; if ($debar) { $template->param( 'userdebarred' => 1, 'flagged' => 1 ); if ( $debar ne "9999-12-31" ) { @@ -430,6 +429,7 @@ $template->param( AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'), SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'), RoutingSerials => C4::Context->preference('RoutingSerials'), + debarments => GetDebarments({ borrowernumber => $borrowernumber }), ); $template->param( $error => 1 ) if $error; --- a/members/setdebar.pl +++ a/members/setdebar.pl @@ -1,50 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2000-2002 Katipo Communications -# Parts copyright 2011 BibLibre -# -# 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 2 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, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - - -=head1 setdebar.pl - -script to set or lift debarred status -written 2/8/04 -by oleonard@athenscounty.lib.oh.us - -=cut - -use strict; -use warnings; - -use CGI; -use C4::Context; -use C4::Auth; - -my $input = new CGI; - -checkauth( $input, 0, { borrowers => 1 }, 'intranet' ); - -my $borrowernumber = $input->param('borrowernumber'); - -my $dbh = C4::Context->dbh; -my $sth = - $dbh->prepare("Update borrowers set debarred = NULL where borrowernumber = ?"); -$sth->execute( $borrowernumber ); -$sth->finish; - -print $input->redirect( - "/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber"); --- a/misc/cronjobs/overdue_notices.pl +++ a/misc/cronjobs/overdue_notices.pl @@ -42,6 +42,9 @@ use C4::Letters; use C4::Overdues qw(GetFine); use C4::Budgets qw(GetCurrency); +use Koha::Borrower::Debarments qw(AddUniqueDebarment); +use Koha::DateUtils; + =head1 NAME overdue_notices.pl - prepare messages to be sent to patrons for overdue items @@ -517,7 +520,14 @@ END_SQL if ( $overdue_rules->{"debarred$i"} ) { #action taken is debarring - C4::Members::DebarMember($borrowernumber, '9999-12-31'); + AddUniqueDebarment( + { + borrowernumber => $borrowernumber, + type => 'OVERDUES', + comment => "Restriction added by overdues process " + . output_pref( dt_from_string() ), + } + ); $verbose and warn "debarring $borr\n"; } my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); --- a/opac/opac-reserve.pl +++ a/opac/opac-reserve.pl @@ -307,7 +307,7 @@ if ( $borr->{lost} && ($borr->{lost} == 1) ) { lost => 1 ); } -if ( CheckBorrowerDebarred($borrowernumber) ) { +if ( $borr->{'debarred'} ) { $noreserves = 1; $template->param( message => 1, --- a/opac/opac-user.pl +++ a/opac/opac-user.pl @@ -30,7 +30,6 @@ use C4::Members; use C4::Members::AttributeTypes; use C4::Members::Attributes qw/GetBorrowerAttributeValue/; use C4::Output; -use C4::Overdues qw/CheckBorrowerDebarred/; use C4::Biblio; use C4::Items; use C4::Letters; @@ -80,7 +79,7 @@ my ($warning_year, $warning_month, $warning_day) = split /-/, $borr->{'dateexpir $borr->{'ethnicity'} = fixEthnicity( $borr->{'ethnicity'} ); -my $debar = CheckBorrowerDebarred($borrowernumber); +my $debar = $borr->{'debarred'}; my $userdebarred; if ($debar) { --- a/t/db_dependent/Borrower_Debarments.t +++ a/t/db_dependent/Borrower_Debarments.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use C4::Context; +use C4::Members; + +use Test::More tests => 18; + +BEGIN { + use FindBin; + use lib $FindBin::Bin; + use_ok('Koha::Borrower::Debarments'); +} + +# Get a borrower with no current debarments +my $dbh = C4::Context->dbh; +my $query = " + SELECT b.borrowernumber FROM borrowers b + LEFT JOIN borrower_debarments bd ON ( b.borrowernumber = bd.borrowernumber ) + WHERE b.debarred IS NULL AND b.debarredcomment IS NULL AND bd.borrowernumber IS NULL + LIMIT 1 +"; +my $sth = $dbh->prepare($query); +$sth->execute; +my ($borrowernumber) = $sth->fetchrow_array(); +diag("Using borrowernumber: $borrowernumber"); + + +my $success = AddDebarment({ + borrowernumber => $borrowernumber, + expiration => '9999-06-10', + type => 'MANUAL', + comment => 'Test 1', +}); +ok( $success, "AddDebarment returned true" ); + + +my $debarments = GetDebarments({ borrowernumber => $borrowernumber }); +ok( @$debarments == 1, "GetDebarments returns 1 debarment" ); +ok( $debarments->[0]->{'type'} eq 'MANUAL', "Correctly stored 'type'" ); +ok( $debarments->[0]->{'expiration'} eq '9999-06-10', "Correctly stored 'expiration'" ); +ok( $debarments->[0]->{'comment'} eq 'Test 1', "Correctly stored 'comment'" ); + + +$success = AddDebarment({ + borrowernumber => $borrowernumber, + comment => 'Test 2', +}); + +$debarments = GetDebarments({ borrowernumber => $borrowernumber }); +ok( @$debarments == 2, "GetDebarments returns 2 debarments" ); +ok( $debarments->[1]->{'type'} eq 'MANUAL', "Correctly stored 'type'" ); +ok( !$debarments->[1]->{'expiration'}, "Correctly stored debarrment with no expiration" ); +ok( $debarments->[1]->{'comment'} eq 'Test 2', "Correctly stored 'comment'" ); + + +ModDebarment({ + borrower_debarment_id => $debarments->[1]->{'borrower_debarment_id'}, + comment => 'Test 3', + expiration => '9998-06-10', +}); +$debarments = GetDebarments({ borrowernumber => $borrowernumber }); +ok( $debarments->[1]->{'comment'} eq 'Test 3', "ModDebarment functions correctly" ); + + +my $borrower = GetMember( borrowernumber => $borrowernumber ); +ok( $borrower->{'debarred'} eq '9999-06-10', "Field borrowers.debarred set correctly" ); +ok( $borrower->{'debarredcomment'} eq "Test 1\nTest 3", "Field borrowers.debarredcomment set correctly" ); + + +AddUniqueDebarment({ + borrowernumber => $borrowernumber, + type => 'OVERDUES' +}); +$debarments = GetDebarments({ + borrowernumber => $borrowernumber, + type => 'OVERDUES', +}); +ok( @$debarments == 1, "GetDebarments returns 1 OVERDUES debarment" ); +ok( $debarments->[0]->{'type'} eq 'OVERDUES', "AddOverduesDebarment created new debarment correctly" ); + +AddUniqueDebarment({ + borrowernumber => $borrowernumber, + expiration => '9999-11-09', + type => 'OVERDUES' +}); +$debarments = GetDebarments({ + borrowernumber => $borrowernumber, + type => 'OVERDUES', +}); +ok( @$debarments == 1, "GetDebarments returns 1 OVERDUES debarment after running AddOverduesDebarment twice" ); +ok( $debarments->[0]->{'expiration'} eq '9999-11-09', "AddOverduesDebarment updated OVERDUES debarment correctly" ); + + +$debarments = GetDebarments({ borrowernumber => $borrowernumber }); +foreach my $d ( @$debarments ) { + DelDebarment( $d->{'borrower_debarment_id'} ); +} +$debarments = GetDebarments({ borrowernumber => $borrowernumber }); +ok( @$debarments == 0, "DelDebarment functions correctly" ) --- a/tools/modborrowers.pl +++ a/tools/modborrowers.pl @@ -21,7 +21,7 @@ # # Batch Edit Patrons # Modification for patron's fields: -# surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry debarred debarredcomment borrowernotes +# surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes # And for patron attributes. use Modern::Perl; @@ -206,18 +206,6 @@ if ( $op eq 'show' ) { } , { - name => "debarred", - type => "date", - mandatory => ( grep /debarred/, @mandatoryFields ) ? 1 : 0, - } - , - { - name => "debarredcomment", - type => "text", - mandatory => ( grep /debarredcomment/, @mandatoryFields ) ? 1 : 0, - } - , - { name => "borrowernotes", type => "text", mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0, @@ -235,7 +223,7 @@ if ( $op eq 'do' ) { my @disabled = $input->param('disable_input'); my $infos; - for my $field ( qw/surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry debarred debarredcomment borrowernotes/ ) { + for my $field ( qw/surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes/ ) { my $value = $input->param($field); $infos->{$field} = $value if $value; $infos->{$field} = "" if grep { /^$field$/ } @disabled; @@ -327,7 +315,7 @@ sub GetBorrowerInfos { my $borrower = GetMember( %info ); if ( $borrower ) { $borrower->{branchname} = GetBranchName( $borrower->{branchcode} ); - for ( qw(dateenrolled dateexpiry debarred) ) { + for ( qw(dateenrolled dateexpiry) ) { my $userdate = $borrower->{$_}; unless ($userdate && $userdate ne "0000-00-00" and $userdate ne "9999-12-31") { $borrower->{$_} = ''; --