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 parent qw( Exporter );
38 =head1 Koha::Patron::Debarments
40 Koha::Patron::Debarments - Module for managing patron debarments
46 my $arrayref = GetDebarments({ borrowernumber => $borrowernumber [, key => $value ] );
53 return unless ( $params->{'borrowernumber'} );
55 my @keys = keys %$params;
56 my @values = values %$params;
58 my $where = join( ' AND ', map { "$_ = ?" } @keys );
59 my $sql = "SELECT * FROM borrower_debarments WHERE $where";
60 my $sth = C4::Context->dbh->prepare($sql);
61 $sth->execute(@values);
63 return $sth->fetchall_arrayref( {} );
68 my $success = AddDebarment({
69 borrowernumber => $borrowernumber,
70 expiration => $expiration,
71 type => $type, ## enum('FINES','OVERDUES','MANUAL')
75 Creates a new debarment.
77 Required keys: borrowernumber, type
84 my $borrowernumber = $params->{'borrowernumber'};
85 my $expiration = $params->{'expiration'} || undef;
86 my $type = $params->{'type'} || 'MANUAL';
87 my $comment = $params->{'comment'} || undef;
89 return unless ( $borrowernumber && $type );
92 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
95 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
96 VALUES ( ?, ?, ?, ?, ?, NOW() )
99 my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
101 UpdateBorrowerDebarmentFlags($borrowernumber);
108 my $success = DelDebarment( $borrower_debarment_id );
117 my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
119 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
121 my $r = C4::Context->dbh->do( $sql, {}, ($id) );
123 UpdateBorrowerDebarmentFlags($borrowernumber);
130 my $success = ModDebarment({
131 borrower_debarment_id => $borrower_debarment_id,
132 expiration => $expiration,
133 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
137 Updates an existing debarment.
139 Required keys: borrower_debarment_id
146 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
148 return unless ($borrower_debarment_id);
150 delete( $params->{'borrower_debarment_id'} );
152 delete( $params->{'created'} );
153 delete( $params->{'updated'} );
155 $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
157 my @keys = keys %$params;
158 my @values = values %$params;
160 my $sql = join( ',', map { "$_ = ?" } @keys );
162 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
164 my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
166 UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
171 =head2 AddUniqueDebarment
173 my $success = AddUniqueDebarment({
174 borrowernumber => $borrowernumber,
176 expiration => $expiration,
180 Creates a new debarment of the type defined by the key type.
181 If a unique debarment already exists of the given type, it is updated instead.
182 The current unique debarment types are OVERDUES, and SUSPENSION
184 Required keys: borrowernumber, type
188 sub AddUniqueDebarment {
191 my $borrowernumber = $params->{'borrowernumber'};
192 my $type = $params->{'type'};
194 return unless ( $borrowernumber && $type );
196 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
201 # 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
202 $params->{'expiration'} = $debarment->{'expiration'}
203 if ( $debarment->{'expiration'}
204 && $debarment->{'expiration'} gt $params->{'expiration'} );
206 $params->{'borrower_debarment_id'} =
207 $debarment->{'borrower_debarment_id'};
208 $r = ModDebarment($params);
211 $r = AddDebarment($params);
214 UpdateBorrowerDebarmentFlags($borrowernumber);
219 =head2 DelUniqueDebarment
221 my $success = _DelUniqueDebarment({
222 borrowernumber => $borrowernumber,
226 Deletes a unique debarment of the type defined by the key type.
227 The current unique debarment types are OVERDUES, and SUSPENSION
229 Required keys: borrowernumber, type
233 sub DelUniqueDebarment {
236 my $borrowernumber = $params->{'borrowernumber'};
237 my $type = $params->{'type'};
239 return unless ( $borrowernumber && $type );
241 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
243 return unless ( $debarment );
245 return DelDebarment( $debarment->{'borrower_debarment_id'} );
248 =head2 UpdateBorrowerDebarmentFlags
250 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
252 So as not to create additional latency, the fields borrowers.debarred
253 and borrowers.debarredcomment remain in the borrowers table. Whenever
254 the a borrowers debarrments are modified, this subroutine is run to
255 decide if the borrower is currently debarred and update the 'quick flags'
256 in the borrowers table accordingly.
260 sub UpdateBorrowerDebarmentFlags {
261 my ($borrowernumber) = @_;
263 return unless ($borrowernumber);
265 my $dbh = C4::Context->dbh;
268 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
269 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
271 my $sth = $dbh->prepare($sql);
272 $sth->execute($borrowernumber);
273 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
276 $expiration = "9999-12-31" if ($indefinite_expiration);
282 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
285 =head2 _GetBorrowernumberByDebarmentId
287 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
291 sub _GetBorrowernumberByDebarmentId {
292 my ($borrower_debarment_id) = @_;
294 return unless ($borrower_debarment_id);
296 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
297 my $sth = C4::Context->dbh->prepare($sql);
298 $sth->execute($borrower_debarment_id);
299 my ($borrowernumber) = $sth->fetchrow_array();
301 return $borrowernumber;
308 Kyle M Hall <kyle@bywatersoltuions.com>