1 package Koha::Patron::Debarments;
3 # This file is part of Koha.
5 # Copyright 2013 ByWater Solutions
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use Koha::Patron::Restriction::Types;
26 our ( @ISA, @EXPORT_OK );
42 =head1 Koha::Patron::Debarments
44 Koha::Patron::Debarments - Module for managing patron debarments
50 my $success = AddDebarment({
51 borrowernumber => $borrowernumber,
52 expiration => $expiration,
53 type => $type, ## enum('FINES','OVERDUES','MANUAL')
57 Creates a new debarment.
59 Required keys: borrowernumber, type
66 my $borrowernumber = $params->{'borrowernumber'};
67 my $expiration = $params->{'expiration'} || undef;
68 my $type = $params->{'type'} || 'MANUAL';
69 my $comment = $params->{'comment'} || undef;
71 return unless ( $borrowernumber && $type );
74 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
77 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
78 VALUES ( ?, ?, ?, ?, ?, NOW() )
81 my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
83 UpdateBorrowerDebarmentFlags($borrowernumber);
90 my $success = DelDebarment( $borrower_debarment_id );
99 my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
101 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
103 my $r = C4::Context->dbh->do( $sql, {}, ($id) );
105 UpdateBorrowerDebarmentFlags($borrowernumber);
112 my $success = ModDebarment({
113 borrower_debarment_id => $borrower_debarment_id,
114 expiration => $expiration,
115 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
119 Updates an existing debarment.
121 Required keys: borrower_debarment_id
128 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
130 return unless ($borrower_debarment_id);
132 delete( $params->{'borrower_debarment_id'} );
134 delete( $params->{'created'} );
135 delete( $params->{'updated'} );
137 $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
139 my @keys = keys %$params;
140 my @values = values %$params;
142 my $sql = join( ',', map { "$_ = ?" } @keys );
144 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
146 my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
148 UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
153 =head2 AddUniqueDebarment
155 my $success = AddUniqueDebarment({
156 borrowernumber => $borrowernumber,
158 expiration => $expiration,
162 Creates a new debarment of the type defined by the key type.
163 If a unique debarment already exists of the given type, it is updated instead.
164 The current unique debarment types are OVERDUES, and SUSPENSION
166 Required keys: borrowernumber, type
170 sub AddUniqueDebarment {
173 my $borrowernumber = $params->{'borrowernumber'};
174 my $type = $params->{'type'};
176 return unless ( $borrowernumber && $type );
178 my $patron = Koha::Patrons->find($borrowernumber);
179 return unless $patron;
182 $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
187 # 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
188 $params->{'expiration'} = $debarment->expiration
189 if ( $debarment->expiration
190 && $debarment->expiration gt $params->{'expiration'} );
192 $params->{'borrower_debarment_id'} =
193 $debarment->borrower_debarment_id;
194 $r = ModDebarment($params);
197 $r = AddDebarment($params);
200 UpdateBorrowerDebarmentFlags($borrowernumber);
205 =head2 DelUniqueDebarment
207 my $success = _DelUniqueDebarment({
208 borrowernumber => $borrowernumber,
212 Deletes a unique debarment of the type defined by the key type.
213 The current unique debarment types are OVERDUES, and SUSPENSION
215 Required keys: borrowernumber, type
219 sub DelUniqueDebarment {
222 my $borrowernumber = $params->{'borrowernumber'};
223 my $type = $params->{'type'};
225 return unless ( $borrowernumber && $type );
227 my $patron = Koha::Patrons->find($borrowernumber);
228 return unless $patron;
231 $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
233 return unless ( $debarment );
235 return DelDebarment( $debarment->borrower_debarment_id );
238 =head2 UpdateBorrowerDebarmentFlags
240 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
242 So as not to create additional latency, the fields borrowers.debarred
243 and borrowers.debarredcomment remain in the borrowers table. Whenever
244 the a borrowers debarrments are modified, this subroutine is run to
245 decide if the borrower is currently debarred and update the 'quick flags'
246 in the borrowers table accordingly.
250 sub UpdateBorrowerDebarmentFlags {
251 my ($borrowernumber) = @_;
253 return unless ($borrowernumber);
255 my $dbh = C4::Context->dbh;
258 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
259 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
261 my $sth = $dbh->prepare($sql);
262 $sth->execute($borrowernumber);
263 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
266 $expiration = "9999-12-31" if ($indefinite_expiration);
272 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
275 =head2 del_restrictions_after_payment
277 my $success = del_restrictions_after_payment({
278 borrowernumber => $borrowernumber,
281 Deletes any restrictions from patron by following the rules
282 defined in "Patron restrictions".
286 sub del_restrictions_after_payment {
289 my $borrowernumber = $params->{'borrowernumber'};
290 return unless ($borrowernumber);
292 my $patron = Koha::Patrons->find($borrowernumber);
293 return unless ($patron);
295 my $restrictions = $patron->restrictions;
296 return unless ( $restrictions->count );
299 Koha::Account::Lines->search( { borrowernumber => $borrowernumber } );
300 my $total_due = $lines->total_outstanding;
302 while ( my $restriction = $restrictions->next ) {
303 if ( $restriction->type->lift_after_payment
304 && $total_due <= $restriction->type->fee_limit )
306 DelDebarment( $restriction->borrower_debarment_id );
311 =head2 _GetBorrowernumberByDebarmentId
313 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
317 sub _GetBorrowernumberByDebarmentId {
318 my ($borrower_debarment_id) = @_;
320 return unless ($borrower_debarment_id);
322 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
323 my $sth = C4::Context->dbh->prepare($sql);
324 $sth->execute($borrower_debarment_id);
325 my ($borrowernumber) = $sth->fetchrow_array();
327 return $borrowernumber;
334 Kyle M Hall <kyle@bywatersoltuions.com>