Bug 14321: (RM followup) DBIx update
[koha.git] / Koha / Borrower / Debarments.pm
blob9efdc42d0381f3a1c99334a0ed8dbda17ad59904
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>.
20 use Modern::Perl;
22 use C4::Context;
24 use parent qw( Exporter );
26 our @EXPORT = qw(
27 GetDebarments
29 AddDebarment
30 DelDebarment
31 ModDebarment
33 AddUniqueDebarment
34 DelUniqueDebarment
36 IsDebarred
39 =head1 Koha::Borrower::Debarments
41 Koha::Borrower::Debarments - Module for managing borrower debarments
43 =cut
45 =head2 GetDebarments
47 my $arrayref = GetDebarments({ borrowernumber => $borrowernumber [, key => $value ] );
49 =cut
51 sub GetDebarments {
52 my ($params) = @_;
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( {} );
67 =head2 AddDebarment
69 my $success = AddDebarment({
70 borrowernumber => $borrowernumber,
71 expiration => $expiration,
72 type => $type, ## enum('FINES','OVERDUES','MANUAL')
73 comment => $comment,
74 });
76 Creates a new debarment.
78 Required keys: borrowernumber, type
80 =cut
82 sub AddDebarment {
83 my ($params) = @_;
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 );
92 my $manager_id;
93 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
95 my $sql = "
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);
104 return $r;
107 =head2 DelDebarment
109 my $success = DelDebarment( $borrower_debarment_id );
111 Deletes a debarment.
113 =cut
115 sub DelDebarment {
116 my ($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);
126 return $r;
129 =head2 ModDebarment
131 my $success = ModDebarment({
132 borrower_debarment_id => $borrower_debarment_id,
133 expiration => $expiration,
134 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
135 comment => $comment,
138 Updates an existing debarment.
140 Required keys: borrower_debarment_id
142 =cut
144 sub ModDebarment {
145 my ($params) = @_;
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) );
169 return $r;
172 =head2 IsDebarred
174 my $debarment_expiration = IsDebarred( $borrowernumber );
176 Returns the date a borrowers debarment will expire, or
177 undef if the borrower is not debarred
179 =cut
181 sub IsDebarred {
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();
191 return $debarred;
194 =head2 AddUniqueDebarment
196 my $success = AddUniqueDebarment({
197 borrowernumber => $borrowernumber,
198 type => $type,
199 expiration => $expiration,
200 comment => $comment,
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
209 =cut
211 sub AddUniqueDebarment {
212 my ($params) = @_;
214 my $borrowernumber = $params->{'borrowernumber'};
215 my $type = $params->{'type'};
217 return unless ( $borrowernumber && $type );
219 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
221 my $r;
222 if ($debarment) {
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);
232 } else {
234 $r = AddDebarment($params);
237 _UpdateBorrowerDebarmentFlags($borrowernumber);
239 return $r;
242 =head2 DelUniqueDebarment
244 my $success = _DelUniqueDebarment({
245 borrowernumber => $borrowernumber,
246 type => $type,
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
254 =cut
256 sub DelUniqueDebarment {
257 my ($params) = @_;
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.
281 =cut
283 sub _UpdateBorrowerDebarmentFlags {
284 my ($borrowernumber) = @_;
286 return unless ($borrowernumber);
288 my $dbh = C4::Context->dbh;
290 my $sql = q{
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();
298 if ($count) {
299 $expiration = "9999-12-31" if ($indefinite_expiration);
300 } else {
301 $expiration = undef;
302 $comment = undef;
305 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
308 =head2 _GetBorrowernumberByDebarmentId
310 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
312 =cut
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;
329 =head2 AUTHOR
331 Kyle M Hall <kyle@bywatersoltuions.com>
333 =cut