Line 0
Link Here
|
|
|
1 |
package Koha::Borrower::Debarments; |
2 |
|
3 |
# Copyright 2013 ByWater Solutions |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Koha is free software; you can redistribute it and/or modify it under the |
8 |
# terms of the GNU General Public License as published by the Free Software |
9 |
# Foundation; either version 2 of the License, or (at your option) any later |
10 |
# version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
13 |
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
14 |
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
15 |
# |
16 |
# You should have received a copy of the GNU General Public License along with |
17 |
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, |
18 |
# Suite 330, Boston, MA 02111-1307 USA |
19 |
|
20 |
use Modern::Perl; |
21 |
|
22 |
use C4::Context; |
23 |
|
24 |
use parent qw( Exporter ); |
25 |
|
26 |
our @EXPORT = qw( |
27 |
GetDebarments |
28 |
|
29 |
AddDebarment |
30 |
DelDebarment |
31 |
ModDebarment |
32 |
|
33 |
AddUniqueDebarment |
34 |
DelUniqueDebarment |
35 |
|
36 |
IsDebarred |
37 |
); |
38 |
|
39 |
=head1 Koha::Borrower::Debarments |
40 |
|
41 |
Koha::Borrower::Debarments - Module for managing borrower debarments |
42 |
|
43 |
=cut |
44 |
|
45 |
=head2 GetDebarments |
46 |
|
47 |
my $arrayref = GetDebarments( $borrowernumber, { key => $value } ); |
48 |
|
49 |
=cut |
50 |
|
51 |
sub GetDebarments { |
52 |
my ($params) = @_; |
53 |
|
54 |
return unless ( $params->{'borrowernumber'} ); |
55 |
|
56 |
my @keys = keys %$params; |
57 |
my @values = values %$params; |
58 |
|
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); |
63 |
|
64 |
return $sth->fetchall_arrayref( {} ); |
65 |
} |
66 |
|
67 |
=head2 AddDebarment |
68 |
|
69 |
my $success = AddDebarment({ |
70 |
borrowernumber => $borrowernumber, |
71 |
expiration => $expiration, |
72 |
type => $type, ## enum('FINES','OVERDUES','MANUAL') |
73 |
comment => $comment, |
74 |
}); |
75 |
|
76 |
Creates a new debarment. |
77 |
|
78 |
Required keys: borrowernumber, type |
79 |
|
80 |
=cut |
81 |
|
82 |
sub AddDebarment { |
83 |
my ($params) = @_; |
84 |
|
85 |
my $borrowernumber = $params->{'borrowernumber'}; |
86 |
my $expiration = $params->{'expiration'} || undef; |
87 |
my $type = $params->{'type'} || 'MANUAL'; |
88 |
my $comment = $params->{'comment'} || undef; |
89 |
|
90 |
return unless ( $borrowernumber && $type ); |
91 |
|
92 |
my $manager_id; |
93 |
$manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; |
94 |
|
95 |
my $sql = " |
96 |
INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created ) |
97 |
VALUES ( ?, ?, ?, ?, ?, NOW() ) |
98 |
"; |
99 |
|
100 |
my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) ); |
101 |
|
102 |
_UpdateBorrowerDebarmentFlags($borrowernumber); |
103 |
|
104 |
return $r; |
105 |
} |
106 |
|
107 |
=head2 DelDebarment |
108 |
|
109 |
my $success = DelDebarment( $borrower_debarment_id ); |
110 |
|
111 |
Deletes a debarment. |
112 |
|
113 |
=cut |
114 |
|
115 |
sub DelDebarment { |
116 |
my ($id) = @_; |
117 |
|
118 |
my $borrowernumber = _GetBorrowernumberByDebarmentId($id); |
119 |
|
120 |
my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?"; |
121 |
|
122 |
my $r = C4::Context->dbh->do( $sql, {}, ($id) ); |
123 |
|
124 |
_UpdateBorrowerDebarmentFlags($borrowernumber); |
125 |
|
126 |
return $r; |
127 |
} |
128 |
|
129 |
=head2 ModDebarment |
130 |
|
131 |
my $success = ModDebarment({ |
132 |
borrower_debarment_id => $borrower_debarment_id, |
133 |
expiration => $expiration, |
134 |
type => $type, ## enum('FINES','OVERDUES','MANUAL') |
135 |
comment => $comment, |
136 |
}); |
137 |
|
138 |
Updates an existing debarment. |
139 |
|
140 |
Required keys: borrower_debarment_id |
141 |
|
142 |
=cut |
143 |
|
144 |
sub ModDebarment { |
145 |
my ($params) = @_; |
146 |
|
147 |
my $borrower_debarment_id = $params->{'borrower_debarment_id'}; |
148 |
|
149 |
return unless ($borrower_debarment_id); |
150 |
|
151 |
delete( $params->{'borrower_debarment_id'} ); |
152 |
|
153 |
delete( $params->{'created'} ); |
154 |
delete( $params->{'updated'} ); |
155 |
|
156 |
$params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv; |
157 |
|
158 |
my @keys = keys %$params; |
159 |
my @values = values %$params; |
160 |
|
161 |
my $sql = join( ',', map { "$_ = ?" } @keys ); |
162 |
|
163 |
$sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?"; |
164 |
|
165 |
my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) ); |
166 |
|
167 |
_UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) ); |
168 |
|
169 |
return $r; |
170 |
} |
171 |
|
172 |
=head2 IsDebarred |
173 |
|
174 |
my $debarment_expiration = IsDebarred( $borrowernumber ); |
175 |
|
176 |
Returns the date a borrowers debarment will expire, or |
177 |
undef if the borrower is not debarred |
178 |
|
179 |
=cut |
180 |
|
181 |
sub IsDebarred { |
182 |
my ($borrowernumber) = @_; |
183 |
|
184 |
return unless ($borrowernumber); |
185 |
|
186 |
my $sql = "SELECT debarred FROM borrowers WHERE borrowernumber = ?"; |
187 |
my $sth = C4::Context->dbh->prepare($sql); |
188 |
$sth->execute($borrowernumber); |
189 |
my ($debarred) = $sth->fetchrow_array(); |
190 |
|
191 |
return $debarred; |
192 |
} |
193 |
|
194 |
=head2 AddUniqueDebarment |
195 |
|
196 |
my $success = AddUniqueDebarment({ |
197 |
borrowernumber => $borrowernumber, |
198 |
type => $type, |
199 |
expiration => $expiration, |
200 |
comment => $comment, |
201 |
}); |
202 |
|
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 |
206 |
|
207 |
Required keys: borrowernumber, type |
208 |
|
209 |
=cut |
210 |
|
211 |
sub AddUniqueDebarment { |
212 |
my ($params) = @_; |
213 |
|
214 |
my $borrowernumber = $params->{'borrowernumber'}; |
215 |
my $type = $params->{'type'}; |
216 |
|
217 |
return unless ( $borrowernumber && $type ); |
218 |
|
219 |
my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0]; |
220 |
|
221 |
my $r; |
222 |
if ($debarment) { |
223 |
|
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'} ); |
228 |
|
229 |
$params->{'borrower_debarment_id'} = |
230 |
$debarment->{'borrower_debarment_id'}; |
231 |
$r = ModDebarment($params); |
232 |
} else { |
233 |
|
234 |
$r = AddDebarment($params); |
235 |
} |
236 |
|
237 |
_UpdateBorrowerDebarmentFlags($borrowernumber); |
238 |
|
239 |
return $r; |
240 |
} |
241 |
|
242 |
=head2 DelUniqueDebarment |
243 |
|
244 |
my $success = _DelUniqueDebarment({ |
245 |
borrowernumber => $borrowernumber, |
246 |
type => $type, |
247 |
}); |
248 |
|
249 |
Deletes a unique debarment of the type defined by the key type. |
250 |
The current unique debarment types are OVERDUES, and SUSPENSION |
251 |
|
252 |
Required keys: borrowernumber, type |
253 |
|
254 |
=cut |
255 |
|
256 |
sub DelUniqueDebarment { |
257 |
my ($params) = @_; |
258 |
|
259 |
my $borrowernumber = $params->{'borrowernumber'}; |
260 |
my $type = $params->{'type'}; |
261 |
|
262 |
return unless ( $borrowernumber && $type ); |
263 |
|
264 |
my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0]; |
265 |
|
266 |
return unless ( $debarment ); |
267 |
|
268 |
return DelDebarment( $debarment->{'borrower_debarment_id'} ); |
269 |
} |
270 |
|
271 |
=head2 _UpdateBorrowerDebarmentFlags |
272 |
|
273 |
my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber ); |
274 |
|
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. |
280 |
|
281 |
=cut |
282 |
|
283 |
sub _UpdateBorrowerDebarmentFlags { |
284 |
my ($borrowernumber) = @_; |
285 |
|
286 |
return unless ($borrowernumber); |
287 |
|
288 |
my $dbh = C4::Context->dbh; |
289 |
|
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 = ? |
293 |
}; |
294 |
my $sth = $dbh->prepare($sql); |
295 |
$sth->execute($borrowernumber); |
296 |
my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array(); |
297 |
|
298 |
if ($count) { |
299 |
$expiration = "9999-12-31" if ($indefinite_expiration); |
300 |
} else { |
301 |
$expiration = undef; |
302 |
$comment = undef; |
303 |
} |
304 |
|
305 |
return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) ); |
306 |
} |
307 |
|
308 |
=head2 _GetBorrowernumberByDebarmentId |
309 |
|
310 |
my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id ); |
311 |
|
312 |
=cut |
313 |
|
314 |
sub _GetBorrowernumberByDebarmentId { |
315 |
my ($borrower_debarment_id) = @_; |
316 |
|
317 |
return unless ($borrower_debarment_id); |
318 |
|
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(); |
323 |
|
324 |
return $borrowernumber; |
325 |
} |
326 |
|
327 |
1; |
328 |
|
329 |
=head2 AUTHOR |
330 |
|
331 |
Kyle M Hall <kyle@bywatersoltuions.com> |
332 |
|
333 |
=cut |