@@ -, +, @@ 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 | 36 ++- 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, 646 insertions(+), 262 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 --- a/C4/Circulation.pm +++ a/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 @@ -1879,6 +1880,15 @@ sub AddReturn { 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 +2021,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 +2610,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); @@ -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; --- a/C4/Overdues.pm +++ a/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); --- a/Koha/Borrower/Debarments.pm +++ a/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 --- a/circ/circulation.pl +++ a/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; --- a/installer/data/mysql/updatedatabase.pl +++ a/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 --- 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,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 + + +
+
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt +++ a/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 ) %] --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt +++ a/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 %] -
  • --- a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt @@ -174,10 +174,7 @@ function validate1(date) {
    @@ -593,6 +591,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 @@ -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{$_}); } --- 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"); +} + +=head2 author + +Kyle M Hall + +=cut --- a/members/moremember.pl +++ a/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; --- a/members/setdebar.pl +++ a/members/setdebar.pl @@ -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"); --- a/misc/cronjobs/overdue_notices.pl +++ a/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 )); --- a/opac/opac-reserve.pl +++ a/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, --- 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/t/db_dependent/lib/KohaTest/Members/DebarMember.pm +++ a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm @@ -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; --- a/t/db_dependent/lib/KohaTest/Overdues.pm +++ a/t/db_dependent/lib/KohaTest/Overdues.pm @@ -33,7 +33,6 @@ sub methods : Test( 1 ) { GetOverdueDelays CheckAccountLineLevelInfo GetOverduerules - CheckBorrowerDebarred CheckExistantNotifyid CheckAccountLineItemInfo CheckItemNotify --- 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->{$_} = ''; --