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'} if ( $debarment->{'expiration'} && $debarment->{'expiration'} < $params->{'expiration'} ); |
226 |
|
227 |
$params->{'borrower_debarment_id'} = $debarment->{'borrower_debarment_id'}; |
228 |
$r = ModDebarment($params); |
229 |
} else { |
230 |
$r = AddDebarment($params); |
231 |
} |
232 |
|
233 |
_UpdateBorrowerDebarmentFlags($borrowernumber); |
234 |
|
235 |
return $r; |
236 |
} |
237 |
|
238 |
=head2 DelUniqueDebarment |
239 |
|
240 |
my $success = _DelUniqueDebarment({ |
241 |
borrowernumber => $borrowernumber, |
242 |
type => $type, |
243 |
}); |
244 |
|
245 |
Deletes a unique debarment of the type defined by the key type. |
246 |
The current unique debarment types are OVERDUES, and SUSPENSION |
247 |
|
248 |
Required keys: borrowernumber, type |
249 |
|
250 |
=cut |
251 |
|
252 |
sub DelUniqueDebarment { |
253 |
my ($params) = @_; |
254 |
|
255 |
my $borrowernumber = $params->{'borrowernumber'}; |
256 |
my $type = $params->{'type'}; |
257 |
|
258 |
return unless ( $borrowernumber && $type ); |
259 |
|
260 |
my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0]; |
261 |
|
262 |
return unless ( $debarment ); |
263 |
|
264 |
return DelDebarment( $debarment->{'borrower_debarment_id'} ); |
265 |
} |
266 |
|
267 |
=head2 _UpdateBorrowerDebarmentFlags |
268 |
|
269 |
my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber ); |
270 |
|
271 |
So as not to create additional latency, the fields borrowers.debarred |
272 |
and borrowers.debarredcomment remain in the borrowers table. Whenever |
273 |
the a borrowers debarrments are modified, this subroutine is run to |
274 |
decide if the borrower is currently debarred and update the 'quick flags' |
275 |
in the borrowers table accordingly. |
276 |
|
277 |
=cut |
278 |
|
279 |
sub _UpdateBorrowerDebarmentFlags { |
280 |
my ($borrowernumber) = @_; |
281 |
|
282 |
return unless ($borrowernumber); |
283 |
|
284 |
my $dbh = C4::Context->dbh; |
285 |
|
286 |
my $sql = q{ |
287 |
SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments |
288 |
WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ? |
289 |
}; |
290 |
my $sth = $dbh->prepare($sql); |
291 |
$sth->execute($borrowernumber); |
292 |
my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array(); |
293 |
|
294 |
if ($count) { |
295 |
$expiration = "9999-12-31" if ($indefinite_expiration); |
296 |
} else { |
297 |
$expiration = undef; |
298 |
$comment = undef; |
299 |
} |
300 |
|
301 |
return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) ); |
302 |
} |
303 |
|
304 |
=head2 _GetBorrowernumberByDebarmentId |
305 |
|
306 |
my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id ); |
307 |
|
308 |
=cut |
309 |
|
310 |
sub _GetBorrowernumberByDebarmentId { |
311 |
my ($borrower_debarment_id) = @_; |
312 |
|
313 |
return unless ($borrower_debarment_id); |
314 |
|
315 |
my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?"; |
316 |
my $sth = C4::Context->dbh->prepare($sql); |
317 |
$sth->execute($borrower_debarment_id); |
318 |
my ($borrowernumber) = $sth->fetchrow_array(); |
319 |
|
320 |
return $borrowernumber; |
321 |
} |
322 |
|
323 |
1; |
324 |
|
325 |
=head2 AUTHOR |
326 |
|
327 |
Kyle M Hall <kyle@bywatersoltuions.com> |
328 |
|
329 |
=cut |