1 package Koha
::Borrower
::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 );
39 =head1 Koha::Borrower::Debarments
41 Koha::Borrower::Debarments - Module for managing borrower debarments
47 my $arrayref = GetDebarments({ borrowernumber => $borrowernumber [, key => $value ] );
54 return unless ( $params->{'borrowernumber'} );
56 my @keys = keys %$params;
57 my @values = values %$params;
59 my $where = join( ' AND ', map { "$_ = ?" } @keys );
60 my $sql = "SELECT * FROM borrower_debarments WHERE $where";
61 my $sth = C4
::Context
->dbh->prepare($sql);
62 $sth->execute(@values);
64 return $sth->fetchall_arrayref( {} );
69 my $success = AddDebarment({
70 borrowernumber => $borrowernumber,
71 expiration => $expiration,
72 type => $type, ## enum('FINES','OVERDUES','MANUAL')
76 Creates a new debarment.
78 Required keys: borrowernumber, type
85 my $borrowernumber = $params->{'borrowernumber'};
86 my $expiration = $params->{'expiration'} || undef;
87 my $type = $params->{'type'} || 'MANUAL';
88 my $comment = $params->{'comment'} || undef;
90 return unless ( $borrowernumber && $type );
93 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
96 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
97 VALUES ( ?, ?, ?, ?, ?, NOW() )
100 my $r = C4
::Context
->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
102 _UpdateBorrowerDebarmentFlags
($borrowernumber);
109 my $success = DelDebarment( $borrower_debarment_id );
118 my $borrowernumber = _GetBorrowernumberByDebarmentId
($id);
120 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
122 my $r = C4
::Context
->dbh->do( $sql, {}, ($id) );
124 _UpdateBorrowerDebarmentFlags
($borrowernumber);
131 my $success = ModDebarment({
132 borrower_debarment_id => $borrower_debarment_id,
133 expiration => $expiration,
134 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
138 Updates an existing debarment.
140 Required keys: borrower_debarment_id
147 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
149 return unless ($borrower_debarment_id);
151 delete( $params->{'borrower_debarment_id'} );
153 delete( $params->{'created'} );
154 delete( $params->{'updated'} );
156 $params->{'manager_id'} = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
158 my @keys = keys %$params;
159 my @values = values %$params;
161 my $sql = join( ',', map { "$_ = ?" } @keys );
163 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
165 my $r = C4
::Context
->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
167 _UpdateBorrowerDebarmentFlags
( _GetBorrowernumberByDebarmentId
($borrower_debarment_id) );
174 my $debarment_expiration = IsDebarred( $borrowernumber );
176 Returns the date a borrowers debarment will expire, or
177 undef if the borrower is not debarred
182 my ($borrowernumber) = @_;
184 return unless ($borrowernumber);
186 my $sql = "SELECT debarred FROM borrowers WHERE borrowernumber = ? AND debarred > CURRENT_DATE()";
187 my $sth = C4
::Context
->dbh->prepare($sql);
188 $sth->execute($borrowernumber);
189 my ($debarred) = $sth->fetchrow_array();
194 =head2 AddUniqueDebarment
196 my $success = AddUniqueDebarment({
197 borrowernumber => $borrowernumber,
199 expiration => $expiration,
203 Creates a new debarment of the type defined by the key type.
204 If a unique debarment already exists of the given type, it is updated instead.
205 The current unique debarment types are OVERDUES, and SUSPENSION
207 Required keys: borrowernumber, type
211 sub AddUniqueDebarment
{
214 my $borrowernumber = $params->{'borrowernumber'};
215 my $type = $params->{'type'};
217 return unless ( $borrowernumber && $type );
219 my $debarment = @
{ GetDebarments
( { borrowernumber
=> $borrowernumber, type
=> $type } ) }[0];
224 # 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
225 $params->{'expiration'} = $debarment->{'expiration'}
226 if ( $debarment->{'expiration'}
227 && $debarment->{'expiration'} gt $params->{'expiration'} );
229 $params->{'borrower_debarment_id'} =
230 $debarment->{'borrower_debarment_id'};
231 $r = ModDebarment
($params);
234 $r = AddDebarment
($params);
237 _UpdateBorrowerDebarmentFlags
($borrowernumber);
242 =head2 DelUniqueDebarment
244 my $success = _DelUniqueDebarment({
245 borrowernumber => $borrowernumber,
249 Deletes a unique debarment of the type defined by the key type.
250 The current unique debarment types are OVERDUES, and SUSPENSION
252 Required keys: borrowernumber, type
256 sub DelUniqueDebarment
{
259 my $borrowernumber = $params->{'borrowernumber'};
260 my $type = $params->{'type'};
262 return unless ( $borrowernumber && $type );
264 my $debarment = @
{ GetDebarments
( { borrowernumber
=> $borrowernumber, type
=> $type } ) }[0];
266 return unless ( $debarment );
268 return DelDebarment
( $debarment->{'borrower_debarment_id'} );
271 =head2 _UpdateBorrowerDebarmentFlags
273 my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );
275 So as not to create additional latency, the fields borrowers.debarred
276 and borrowers.debarredcomment remain in the borrowers table. Whenever
277 the a borrowers debarrments are modified, this subroutine is run to
278 decide if the borrower is currently debarred and update the 'quick flags'
279 in the borrowers table accordingly.
283 sub _UpdateBorrowerDebarmentFlags
{
284 my ($borrowernumber) = @_;
286 return unless ($borrowernumber);
288 my $dbh = C4
::Context
->dbh;
291 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
292 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
294 my $sth = $dbh->prepare($sql);
295 $sth->execute($borrowernumber);
296 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
299 $expiration = "9999-12-31" if ($indefinite_expiration);
305 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
308 =head2 _GetBorrowernumberByDebarmentId
310 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
314 sub _GetBorrowernumberByDebarmentId {
315 my ($borrower_debarment_id) = @_;
317 return unless ($borrower_debarment_id);
319 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
320 my $sth = C4::Context->dbh->prepare($sql);
321 $sth->execute($borrower_debarment_id);
322 my ($borrowernumber) = $sth->fetchrow_array();
324 return $borrowernumber;
331 Kyle M Hall <kyle@bywatersoltuions.com>