From 15724968589f1f7922a27437911fb794d26eb772 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Tue, 29 Jan 2013 09:34:13 -0500 Subject: [PATCH] Bug 2720 - Overdues which debar automatically should undebar automatically when returned This patch adds a more extensible and flexible debarments system to Koha. The fields borrowers.debarred and borrowers.debarredcomment are retained for compatibility and speed. This system supports having debarments for multiple reasons. There are currently three types of debarments: OVERDUES - Generated by overdue_notices.pl if the notice should debar a patron SUSPENSION - A punative debarment generated on checkin via an issuing rule MANUAL - A debarment created manually by a librarian OVERDUE debarments are cleared automatically when all overdue items have been returned. Whenever a borrowers debarments are modified, the system updates the borrowers debarment fields with the highest expiration from all the borrowers debarments, and concatenates the comments from the debarments together. Test plan: 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 10) Verify the borrower is now debarred indefinitely 11) Delete the indefinite debarment 12) Verify the debarment message lists an expiration date dagain 13) Set an overdue notice to debar after 1 day of being overdue 14) Check out an item to a patron and backdate the due date to yesterday 15) Run overdue_notices.pl 16) Verify the OVERDUES debarment was created 17) Return the item 18) Verify the OVERDUES debarment was removed 19) Add issuing rules so that an overdue item causes a temporary debarment 20) Check out an item to a patron and backdate the due date by a year 21) Return the item 22) Verify the SUSPENSION debarment was added to the patron --- C4/Circulation.pm | 39 ++- C4/Members.pm | 42 +-- C4/Overdues.pm | 33 -- Koha/Borrower/Debarments.pm | 329 ++++++++++++++++++++ circ/circulation.pl | 18 +- installer/data/mysql/updatedatabase.pl | 25 ++ .../prog/en/includes/borrower_debarments.inc | 54 ++++ .../prog/en/modules/circ/circulation.tt | 14 +- .../prog/en/modules/members/memberentrygen.tt | 31 -- .../prog/en/modules/members/moremember.tt | 8 +- .../prog/en/modules/tools/modborrowers.tt | 6 - members/memberentry.pl | 14 +- members/mod_debarment.pl | 63 ++++ members/moremember.pl | 6 +- members/setdebar.pl | 53 ---- misc/cronjobs/overdue_notices.pl | 6 +- opac/opac-reserve.pl | 2 +- opac/opac-user.pl | 3 +- t/db_dependent/Borrower_Debarments.t | 102 ++++++ t/db_dependent/lib/KohaTest/Members/DebarMember.pm | 44 --- t/db_dependent/lib/KohaTest/Overdues.pm | 1 - tools/modborrowers.pl | 18 +- 22 files changed, 648 insertions(+), 263 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 delete mode 100644 t/db_dependent/lib/KohaTest/Members/DebarMember.pm diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 063a409..7e90a7c 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -43,6 +43,7 @@ use Algorithm::CheckDigits; use Data::Dumper; use Koha::DateUtils; use Koha::Calendar; +use Koha::Borrower::Debarments; use Carp; use Date::Calc qw( Today @@ -1876,9 +1877,19 @@ sub AddReturn { }); } - logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'}) + logaction("CIRCULATION", "RETURN", $ + borrowernumber, $item->{'biblionumber'}) if C4::Context->preference("ReturnLog"); + # Remove any OVERDUES related debarment if the borrower has no overdues + if ( $borrowernumber + && $borrower->{'debarred'} + && !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 . @@ -2011,19 +2022,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(); } } @@ -2606,6 +2611,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; diff --git a/C4/Members.pm b/C4/Members.pm index f1136c2..6f9dba7 100644 --- a/C4/Members.pm +++ b/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); @@ -102,6 +103,8 @@ BEGIN { &IssueSlip GetBorrowersWithEmail + + HasOverdues ); #Modify data @@ -637,7 +640,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; @@ -2161,32 +2164,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 @@ -2456,6 +2433,17 @@ sub AddMember_Opac { return ( $borrowernumber, $password ); } +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; diff --git a/C4/Overdues.pm b/C4/Overdues.pm index ac66c36..7b327f9 100644 --- a/C4/Overdues.pm +++ b/C4/Overdues.pm @@ -76,10 +76,6 @@ BEGIN { # &GetIssuingRules - delete. # use C4::Circulation::GetIssuingRule instead. - # subs to move to Members.pm - push @EXPORT, qw( - &CheckBorrowerDebarred - ); # subs to move to Biblio.pm push @EXPORT, qw( &GetItems @@ -1096,35 +1092,6 @@ sub GetOverduerules { } -=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 CheckExistantNotifyid ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id); diff --git a/Koha/Borrower/Debarments.pm b/Koha/Borrower/Debarments.pm new file mode 100644 index 0000000..307a5d1 --- /dev/null +++ b/Koha/Borrower/Debarments.pm @@ -0,0 +1,329 @@ +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'} < $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 diff --git a/circ/circulation.pl b/circ/circulation.pl index 3d24a4a..b6e0b38 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -31,13 +31,13 @@ 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::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( @@ -263,13 +263,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} ) ); } } @@ -729,10 +728,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; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index ed922b8..46a28b0 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -6399,6 +6399,31 @@ if ( CheckVersion($DBversion) ) { SetVersion($DBversion); } +$DBversion ="3.11.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 + }); + + print "Upgrade to $DBversion done (Bug 2720 - Overdues which debar automatically should undebar automatically when returned)\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc new file mode 100644 index 0000000..126a52b --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc @@ -0,0 +1,54 @@ +
+ [% 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 debarment + +
MANUAL + + Clear Date + + +
+
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 9af072f..0fbbd30 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt @@ -655,14 +655,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 %] @@ -762,6 +758,7 @@ No patron matched [% message %] [% ELSE %] 0 Holds [% END %] +
  • [% debarments.size %] Restrictions
  • @@ -1044,6 +1041,7 @@ No patron matched [% message %] [% END %] +[% INCLUDE borrower_debarments.inc %]
    [% IF ( reservloop ) %] 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 f23b6bc..764f9ee 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt @@ -1271,7 +1271,6 @@ [% FOREACH flagloo IN flagloop %]
  • @@ -1289,36 +1288,6 @@
  • [% END %] -
  • - - [% IF ( debarred ) %] - - - - - [% ELSE %] - - - - - [% END %] - - - [% IF opduplicate %] - - [% ELSE %] - - [% END %] - (optional) -
  • -
  • - - [% IF ( opduplicate ) %] - - [% ELSE %] - - [% END %] -
  • diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt index 39f3e55..bf08631 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt @@ -174,10 +174,7 @@ function validate1(date) {
      [% IF ( userdebarred ) %]
    • Patron is restricted[% IF ( userdebarreddate ) %] until [% userdebarreddate%] [% IF (debarredcomment ) %]([% debarredcomment %])[% END %][% END %] -
      - - -
      + View restrictions
    • [% END %] [% IF ( gonenoaddress ) %]
    • Patron's address is in doubt.
    • [% END %] @@ -418,6 +415,7 @@ function validate1(date) { [% countreserv %] Hold(s) [% ELSE %] 0 Holds [% END %] +
    • [% debarments.size %] Restrictions
    @@ -593,6 +591,8 @@ function validate1(date) { [% END %]
    +[% INCLUDE borrower_debarments.inc %] +
    [% IF ( reservloop ) %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt index 3a04aa2..7d652a8 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt +++ b/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 %] diff --git a/members/memberentry.pl b/members/memberentry.pl index f6d3e5e..4b2e47b 100755 --- a/members/memberentry.pl +++ b/members/memberentry.pl @@ -142,16 +142,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'); # @@ -671,9 +661,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{$_}); } diff --git a/members/mod_debarment.pl b/members/mod_debarment.pl new file mode 100755 index 0000000..1e245e6 --- /dev/null +++ b/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"); +} + +=head2 author + +Kyle M Hall + +=cut diff --git a/members/moremember.pl b/members/moremember.pl index 4ccba00..7045cc6 100755 --- a/members/moremember.pl +++ b/members/moremember.pl @@ -49,11 +49,10 @@ use C4::Letters; use C4::Biblio; use C4::Reserves; 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; @@ -154,7 +153,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" ) { @@ -431,6 +430,7 @@ $template->param( activeBorrowerRelationship => (C4::Context->preference('borrowerRelationship') ne ''), AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'), SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'), + debarments => GetDebarments({ borrowernumber => $borrowernumber }), ); $template->param( $error => 1 ) if $error; diff --git a/members/setdebar.pl b/members/setdebar.pl deleted file mode 100755 index bc0bafb..0000000 --- a/members/setdebar.pl +++ /dev/null @@ -1,53 +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; - -my $flagsrequired; -$flagsrequired->{borrowers} = 1; -my ( $loggedinuser, $cookie, $sessionID ) = - checkauth( $input, 0, $flagsrequired ); - -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"); diff --git a/misc/cronjobs/overdue_notices.pl b/misc/cronjobs/overdue_notices.pl index ba58e95..9dbe97f 100755 --- a/misc/cronjobs/overdue_notices.pl +++ b/misc/cronjobs/overdue_notices.pl @@ -40,6 +40,7 @@ use C4::Dates qw/format_date/; use C4::Debug; use C4::Letters; use C4::Overdues qw(GetFine); +use Koha::Borrower::Debarments qw(AddUniqueDebarment); =head1 NAME @@ -512,7 +513,10 @@ END_SQL if ( $overdue_rules->{"debarred$i"} ) { #action taken is debarring - C4::Members::DebarMember($borrowernumber, '9999-12-31'); + AddUniqueDebarment({ + borrowernumber => $borrowernumber, + type => 'OVERDUES', + }); $verbose and warn "debarring $borrowernumber $firstname $lastname\n"; } my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); diff --git a/opac/opac-reserve.pl b/opac/opac-reserve.pl index 07b4f76..69aced2 100755 --- a/opac/opac-reserve.pl +++ b/opac/opac-reserve.pl @@ -308,7 +308,7 @@ if ( $borr->{lost} && ($borr->{lost} == 1) ) { lost => 1 ); } -if ( CheckBorrowerDebarred($borrowernumber) ) { +if ( $borr->{'debarred'} ) { $noreserves = 1; $template->param( message => 1, diff --git a/opac/opac-user.pl b/opac/opac-user.pl index 2b8563c..f33c4fd 100755 --- a/opac/opac-user.pl +++ b/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) { diff --git a/t/db_dependent/Borrower_Debarments.t b/t/db_dependent/Borrower_Debarments.t new file mode 100755 index 0000000..1ee1ebe --- /dev/null +++ b/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" ) \ No newline at end of file diff --git a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm b/t/db_dependent/lib/KohaTest/Members/DebarMember.pm deleted file mode 100644 index bf61b8a..0000000 --- a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm +++ /dev/null @@ -1,44 +0,0 @@ -package KohaTest::Members::DebarMember; -use base qw( KohaTest::Members ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; -sub testing_class { 'C4::Members' }; - - -sub simple_usage : Test( 6 ) { - my $self = shift; - - ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); - - my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( exists $details->{'flags'}, 'member details has a "flags" attribute'); - isa_ok( $details->{'flags'}, 'HASH', 'the "flags" attribute is a hashref'); - ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT debarred' ); - - # Now, let's debar this member and see what happens - my $success = C4::Members::DebarMember( $self->{'memberid'}, '2099-12-31' ); - - ok( $success, 'we were able to debar the member' ); - - $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred now' ) - or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) ); -} - -sub incorrect_usage : Test( 2 ) { - my $self = shift; - - my $result = C4::Members::DebarMember(); - ok( ! defined $result, 'DebarMember returns undef when passed no parameters' ); - - $result = C4::Members::DebarMember( 'this is not a borrowernumber' ); - ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' ); - -} - -1; diff --git a/t/db_dependent/lib/KohaTest/Overdues.pm b/t/db_dependent/lib/KohaTest/Overdues.pm index 13eb1f2..2c33460 100644 --- a/t/db_dependent/lib/KohaTest/Overdues.pm +++ b/t/db_dependent/lib/KohaTest/Overdues.pm @@ -33,7 +33,6 @@ sub methods : Test( 1 ) { GetOverdueDelays CheckAccountLineLevelInfo GetOverduerules - CheckBorrowerDebarred CheckExistantNotifyid CheckAccountLineItemInfo CheckItemNotify diff --git a/tools/modborrowers.pl b/tools/modborrowers.pl index 1bba4a0..6a2f5c8 100755 --- a/tools/modborrowers.pl +++ b/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->{$_} = ''; -- 1.7.2.5