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 );
42 =head1 Koha::Patron::Debarments
44 Koha::Patron::Debarments - Module for managing patron debarments
50 my $arrayref = GetDebarments({ borrowernumber => $borrowernumber [, key => $value ] );
57 return unless ( $params->{'borrowernumber'} );
59 my @keys = keys %$params;
60 my @values = values %$params;
62 my $where = join( ' AND ', map { "$_ = ?" } @keys );
63 my $sql = "SELECT * FROM borrower_debarments WHERE $where";
64 my $sth = C4::Context->dbh->prepare($sql);
65 $sth->execute(@values);
67 return $sth->fetchall_arrayref( {} );
72 my $success = AddDebarment({
73 borrowernumber => $borrowernumber,
74 expiration => $expiration,
75 type => $type, ## enum('FINES','OVERDUES','MANUAL')
79 Creates a new debarment.
81 Required keys: borrowernumber, type
88 my $borrowernumber = $params->{'borrowernumber'};
89 my $expiration = $params->{'expiration'} || undef;
90 my $type = $params->{'type'} || 'MANUAL';
91 my $comment = $params->{'comment'} || undef;
93 return unless ( $borrowernumber && $type );
96 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
99 INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
100 VALUES ( ?, ?, ?, ?, ?, NOW() )
103 my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
105 UpdateBorrowerDebarmentFlags($borrowernumber);
112 my $success = DelDebarment( $borrower_debarment_id );
121 my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
123 my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
125 my $r = C4::Context->dbh->do( $sql, {}, ($id) );
127 UpdateBorrowerDebarmentFlags($borrowernumber);
134 my $success = ModDebarment({
135 borrower_debarment_id => $borrower_debarment_id,
136 expiration => $expiration,
137 type => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
141 Updates an existing debarment.
143 Required keys: borrower_debarment_id
150 my $borrower_debarment_id = $params->{'borrower_debarment_id'};
152 return unless ($borrower_debarment_id);
154 delete( $params->{'borrower_debarment_id'} );
156 delete( $params->{'created'} );
157 delete( $params->{'updated'} );
159 $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
161 my @keys = keys %$params;
162 my @values = values %$params;
164 my $sql = join( ',', map { "$_ = ?" } @keys );
166 $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
168 my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
170 UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
175 =head2 AddUniqueDebarment
177 my $success = AddUniqueDebarment({
178 borrowernumber => $borrowernumber,
180 expiration => $expiration,
184 Creates a new debarment of the type defined by the key type.
185 If a unique debarment already exists of the given type, it is updated instead.
186 The current unique debarment types are OVERDUES, and SUSPENSION
188 Required keys: borrowernumber, type
192 sub AddUniqueDebarment {
195 my $borrowernumber = $params->{'borrowernumber'};
196 my $type = $params->{'type'};
198 return unless ( $borrowernumber && $type );
200 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
205 # 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
206 $params->{'expiration'} = $debarment->{'expiration'}
207 if ( $debarment->{'expiration'}
208 && $debarment->{'expiration'} gt $params->{'expiration'} );
210 $params->{'borrower_debarment_id'} =
211 $debarment->{'borrower_debarment_id'};
212 $r = ModDebarment($params);
215 $r = AddDebarment($params);
218 UpdateBorrowerDebarmentFlags($borrowernumber);
223 =head2 DelUniqueDebarment
225 my $success = _DelUniqueDebarment({
226 borrowernumber => $borrowernumber,
230 Deletes a unique debarment of the type defined by the key type.
231 The current unique debarment types are OVERDUES, and SUSPENSION
233 Required keys: borrowernumber, type
237 sub DelUniqueDebarment {
240 my $borrowernumber = $params->{'borrowernumber'};
241 my $type = $params->{'type'};
243 return unless ( $borrowernumber && $type );
245 my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
247 return unless ( $debarment );
249 return DelDebarment( $debarment->{'borrower_debarment_id'} );
252 =head2 UpdateBorrowerDebarmentFlags
254 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
256 So as not to create additional latency, the fields borrowers.debarred
257 and borrowers.debarredcomment remain in the borrowers table. Whenever
258 the a borrowers debarrments are modified, this subroutine is run to
259 decide if the borrower is currently debarred and update the 'quick flags'
260 in the borrowers table accordingly.
264 sub UpdateBorrowerDebarmentFlags {
265 my ($borrowernumber) = @_;
267 return unless ($borrowernumber);
269 my $dbh = C4::Context->dbh;
272 SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
273 WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
275 my $sth = $dbh->prepare($sql);
276 $sth->execute($borrowernumber);
277 my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
280 $expiration = "9999-12-31" if ($indefinite_expiration);
286 return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
289 =head2 _GetBorrowernumberByDebarmentId
291 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
295 sub _GetBorrowernumberByDebarmentId {
296 my ($borrower_debarment_id) = @_;
298 return unless ($borrower_debarment_id);
300 my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
301 my $sth = C4::Context->dbh->prepare($sql);
302 $sth->execute($borrower_debarment_id);
303 my ($borrowernumber) = $sth->fetchrow_array();
305 return $borrowernumber;
312 Kyle M Hall <kyle@bywatersoltuions.com>