Koha/Patron/Debarments.pm

   1 package Koha::Patron::Debarments;
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright 2013 ByWater Solutions
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Context;
  23
  24 our ( @ISA, @EXPORT_OK );
  25
  26 BEGIN {
  27     require Exporter;
  28     @ISA       = qw(Exporter);
  29     @EXPORT_OK = qw(
  30       GetDebarments
  31
  32       AddDebarment
  33       DelDebarment
  34       ModDebarment
  35
  36       AddUniqueDebarment
  37       DelUniqueDebarment
  38
  39     );
  40 }
  41
  42 =head1 Koha::Patron::Debarments
  43
  44 Koha::Patron::Debarments - Module for managing patron debarments
  45
  46 =cut
  47
  48 =head2 GetDebarments
  49
  50 my $arrayref = GetDebarments({ borrowernumber => $borrowernumber [, key => $value ] );
  51
  52 =cut
  53
  54 sub GetDebarments {
  55     my ($params) = @_;
  56
  57     return unless ( $params->{'borrowernumber'} );
  58
  59     my @keys   = keys %$params;
  60     my @values = values %$params;
  61
  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);
  66
  67     return $sth->fetchall_arrayref( {} );
  68 }
  69
  70 =head2 AddDebarment
  71
  72 my $success = AddDebarment({
  73     borrowernumber => $borrowernumber,
  74     expiration     => $expiration,
  75     type           => $type, ## enum('FINES','OVERDUES','MANUAL')
  76     comment        => $comment,
  77 });
  78
  79 Creates a new debarment.
  80
  81 Required keys: borrowernumber, type
  82
  83 =cut
  84
  85 sub AddDebarment {
  86     my ($params) = @_;
  87
  88     my $borrowernumber = $params->{'borrowernumber'};
  89     my $expiration     = $params->{'expiration'} || undef;
  90     my $type           = $params->{'type'} || 'MANUAL';
  91     my $comment        = $params->{'comment'} || undef;
  92
  93     return unless ( $borrowernumber && $type );
  94
  95     my $manager_id;
  96     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
  97
  98     my $sql = "
  99         INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
 100         VALUES ( ?, ?, ?, ?, ?, NOW() )
 101     ";
 102
 103     my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
 104
 105     UpdateBorrowerDebarmentFlags($borrowernumber);
 106
 107     return $r;
 108 }
 109
 110 =head2 DelDebarment
 111
 112 my $success = DelDebarment( $borrower_debarment_id );
 113
 114 Deletes a debarment.
 115
 116 =cut
 117
 118 sub DelDebarment {
 119     my ($id) = @_;
 120
 121     my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
 122
 123     my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
 124
 125     my $r = C4::Context->dbh->do( $sql, {}, ($id) );
 126
 127     UpdateBorrowerDebarmentFlags($borrowernumber);
 128
 129     return $r;
 130 }
 131
 132 =head2 ModDebarment
 133
 134 my $success = ModDebarment({
 135     borrower_debarment_id => $borrower_debarment_id,
 136     expiration            => $expiration,
 137     type                  => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
 138     comment               => $comment,
 139 });
 140
 141 Updates an existing debarment.
 142
 143 Required keys: borrower_debarment_id
 144
 145 =cut
 146
 147 sub ModDebarment {
 148     my ($params) = @_;
 149
 150     my $borrower_debarment_id = $params->{'borrower_debarment_id'};
 151
 152     return unless ($borrower_debarment_id);
 153
 154     delete( $params->{'borrower_debarment_id'} );
 155
 156     delete( $params->{'created'} );
 157     delete( $params->{'updated'} );
 158
 159     $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
 160
 161     my @keys   = keys %$params;
 162     my @values = values %$params;
 163
 164     my $sql = join( ',', map { "$_ = ?" } @keys );
 165
 166     $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
 167
 168     my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
 169
 170     UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
 171
 172     return $r;
 173 }
 174
 175 =head2 AddUniqueDebarment
 176
 177 my $success = AddUniqueDebarment({
 178     borrowernumber => $borrowernumber,
 179     type           => $type,
 180     expiration     => $expiration,
 181     comment        => $comment,
 182 });
 183
 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
 187
 188 Required keys: borrowernumber, type
 189
 190 =cut
 191
 192 sub AddUniqueDebarment {
 193     my ($params) = @_;
 194
 195     my $borrowernumber = $params->{'borrowernumber'};
 196     my $type           = $params->{'type'};
 197
 198     return unless ( $borrowernumber && $type );
 199
 200     my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
 201
 202     my $r;
 203     if ($debarment) {
 204
 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'} );
 209
 210         $params->{'borrower_debarment_id'} =
 211           $debarment->{'borrower_debarment_id'};
 212         $r = ModDebarment($params);
 213     } else {
 214
 215         $r = AddDebarment($params);
 216     }
 217
 218     UpdateBorrowerDebarmentFlags($borrowernumber);
 219
 220     return $r;
 221 }
 222
 223 =head2 DelUniqueDebarment
 224
 225 my $success = _DelUniqueDebarment({
 226     borrowernumber => $borrowernumber,
 227     type           => $type,
 228 });
 229
 230 Deletes a unique debarment of the type defined by the key type.
 231 The current unique debarment types are OVERDUES, and SUSPENSION
 232
 233 Required keys: borrowernumber, type
 234
 235 =cut
 236
 237 sub DelUniqueDebarment {
 238     my ($params) = @_;
 239
 240     my $borrowernumber = $params->{'borrowernumber'};
 241     my $type           = $params->{'type'};
 242
 243     return unless ( $borrowernumber && $type );
 244
 245     my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
 246
 247     return unless ( $debarment );
 248
 249     return DelDebarment( $debarment->{'borrower_debarment_id'} );
 250 }
 251
 252 =head2 UpdateBorrowerDebarmentFlags
 253
 254 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
 255
 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.
 261
 262 =cut
 263
 264 sub UpdateBorrowerDebarmentFlags {
 265     my ($borrowernumber) = @_;
 266
 267     return unless ($borrowernumber);
 268
 269     my $dbh = C4::Context->dbh;
 270
 271     my $sql = q{
 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 = ?
 274     };
 275     my $sth = $dbh->prepare($sql);
 276     $sth->execute($borrowernumber);
 277     my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
 278
 279     if ($count) {
 280         $expiration = "9999-12-31" if ($indefinite_expiration);
 281     } else {
 282         $expiration = undef;
 283         $comment    = undef;
 284     }
 285
 286     return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
 287 }
 288
 289 =head2 _GetBorrowernumberByDebarmentId
 290
 291 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
 292
 293 =cut
 294
 295 sub _GetBorrowernumberByDebarmentId {
 296     my ($borrower_debarment_id) = @_;
 297
 298     return unless ($borrower_debarment_id);
 299
 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();
 304
 305     return $borrowernumber;
 306 }
 307
 308 1;
 309
 310 =head2 AUTHOR
 311
 312 Kyle M Hall <kyle@bywatersoltuions.com>
 313
 314 =cut