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 our ( @ISA, @EXPORT_OK );
40 =head1 Koha::Patron::Debarments
42 Koha::Patron::Debarments - Module for managing patron debarments
48 my $success = AddDebarment({
49 borrowernumber => $borrowernumber,
50 expiration => $expiration,
51 type => $type, ## enum('FINES','OVERDUES','MANUAL')
55 Creates a new debarment.
57 Required keys: borrowernumber, type
64 my $borrowernumber = $params->{'borrowernumber'};
65 my $expiration = $params->{'expiration'} || undef;
66 my $type = $params->{'type'} || 'MANUAL';
67 my $comment = $params->{'comment'} || undef;
69 return unless ( $borrowernumber && $type );
72 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
75 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
76 VALUES ( ?, ?, ?, ?, ?, NOW() )
79 my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
81 UpdateBorrowerDebarmentFlags($borrowernumber);
88 my $success = DelDebarment( $borrower_debarment_id );
97 my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
99 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
101 my $r = C4::Context->dbh->do( $sql, {}, ($id) );
103 UpdateBorrowerDebarmentFlags($borrowernumber);
110 my $success = ModDebarment({
111 borrower_debarment_id => $borrower_debarment_id,
112 expiration => $expiration,
113 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
117 Updates an existing debarment.
119 Required keys: borrower_debarment_id
126 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
128 return unless ($borrower_debarment_id);
130 delete( $params->{'borrower_debarment_id'} );
132 delete( $params->{'created'} );
133 delete( $params->{'updated'} );
135 $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
137 my @keys = keys %$params;
138 my @values = values %$params;
140 my $sql = join( ',', map { "$_ = ?" } @keys );
142 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
144 my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
146 UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
151 =head2 AddUniqueDebarment
153 my $success = AddUniqueDebarment({
154 borrowernumber => $borrowernumber,
156 expiration => $expiration,
160 Creates a new debarment of the type defined by the key type.
161 If a unique debarment already exists of the given type, it is updated instead.
162 The current unique debarment types are OVERDUES, and SUSPENSION
164 Required keys: borrowernumber, type
168 sub AddUniqueDebarment {
171 my $borrowernumber = $params->{'borrowernumber'};
172 my $type = $params->{'type'};
174 return unless ( $borrowernumber && $type );
176 my $patron = Koha::Patrons->find($borrowernumber);
177 return unless $patron;
180 $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
185 # 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
186 $params->{'expiration'} = $debarment->expiration
187 if ( $debarment->expiration
188 && $debarment->expiration gt $params->{'expiration'} );
190 $params->{'borrower_debarment_id'} =
191 $debarment->borrower_debarment_id;
192 $r = ModDebarment($params);
195 $r = AddDebarment($params);
198 UpdateBorrowerDebarmentFlags($borrowernumber);
203 =head2 DelUniqueDebarment
205 my $success = _DelUniqueDebarment({
206 borrowernumber => $borrowernumber,
210 Deletes a unique debarment of the type defined by the key type.
211 The current unique debarment types are OVERDUES, and SUSPENSION
213 Required keys: borrowernumber, type
217 sub DelUniqueDebarment {
220 my $borrowernumber = $params->{'borrowernumber'};
221 my $type = $params->{'type'};
223 return unless ( $borrowernumber && $type );
225 my $patron = Koha::Patrons->find($borrowernumber);
226 return unless $patron;
229 $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
231 return unless ( $debarment );
233 return DelDebarment( $debarment->borrower_debarment_id );
236 =head2 UpdateBorrowerDebarmentFlags
238 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
240 So as not to create additional latency, the fields borrowers.debarred
241 and borrowers.debarredcomment remain in the borrowers table. Whenever
242 the a borrowers debarrments are modified, this subroutine is run to
243 decide if the borrower is currently debarred and update the 'quick flags'
244 in the borrowers table accordingly.
248 sub UpdateBorrowerDebarmentFlags {
249 my ($borrowernumber) = @_;
251 return unless ($borrowernumber);
253 my $dbh = C4::Context->dbh;
256 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
257 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
259 my $sth = $dbh->prepare($sql);
260 $sth->execute($borrowernumber);
261 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
264 $expiration = "9999-12-31" if ($indefinite_expiration);
270 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
273 =head2 _GetBorrowernumberByDebarmentId
275 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
279 sub _GetBorrowernumberByDebarmentId {
280 my ($borrower_debarment_id) = @_;
282 return unless ($borrower_debarment_id);
284 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
285 my $sth = C4::Context->dbh->prepare($sql);
286 $sth->execute($borrower_debarment_id);
287 my ($borrowernumber) = $sth->fetchrow_array();
289 return $borrowernumber;
296 Kyle M Hall <kyle@bywatersoltuions.com>