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 use Koha::Patron::Restriction::Types;
  25
  26 our ( @ISA, @EXPORT_OK );
  27
  28 BEGIN {
  29     require Exporter;
  30     @ISA       = qw(Exporter);
  31     @EXPORT_OK = qw(
  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 AddDebarment
  49
  50 my $success = AddDebarment({
  51     borrowernumber => $borrowernumber,
  52     expiration     => $expiration,
  53     type           => $type, ## enum('FINES','OVERDUES','MANUAL')
  54     comment        => $comment,
  55 });
  56
  57 Creates a new debarment.
  58
  59 Required keys: borrowernumber, type
  60
  61 =cut
  62
  63 sub AddDebarment {
  64     my ($params) = @_;
  65
  66     my $borrowernumber = $params->{'borrowernumber'};
  67     my $expiration     = $params->{'expiration'} || undef;
  68     my $type           = $params->{'type'} || 'MANUAL';
  69     my $comment        = $params->{'comment'} || undef;
  70
  71     return unless ( $borrowernumber && $type );
  72
  73     my $manager_id;
  74     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
  75
  76     my $sql = "
  77         INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
  78         VALUES ( ?, ?, ?, ?, ?, NOW() )
  79     ";
  80
  81     my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
  82
  83     UpdateBorrowerDebarmentFlags($borrowernumber);
  84
  85     return $r;
  86 }
  87
  88 =head2 DelDebarment
  89
  90 my $success = DelDebarment( $borrower_debarment_id );
  91
  92 Deletes a debarment.
  93
  94 =cut
  95
  96 sub DelDebarment {
  97     my ($id) = @_;
  98
  99     my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
 100
 101     my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
 102
 103     my $r = C4::Context->dbh->do( $sql, {}, ($id) );
 104
 105     UpdateBorrowerDebarmentFlags($borrowernumber);
 106
 107     return $r;
 108 }
 109
 110 =head2 ModDebarment
 111
 112 my $success = ModDebarment({
 113     borrower_debarment_id => $borrower_debarment_id,
 114     expiration            => $expiration,
 115     type                  => $type, ## enum('FINES','OVERDUES','MANUAL','DISCHARGE')
 116     comment               => $comment,
 117 });
 118
 119 Updates an existing debarment.
 120
 121 Required keys: borrower_debarment_id
 122
 123 =cut
 124
 125 sub ModDebarment {
 126     my ($params) = @_;
 127
 128     my $borrower_debarment_id = $params->{'borrower_debarment_id'};
 129
 130     return unless ($borrower_debarment_id);
 131
 132     delete( $params->{'borrower_debarment_id'} );
 133
 134     delete( $params->{'created'} );
 135     delete( $params->{'updated'} );
 136
 137     $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
 138
 139     my @keys   = keys %$params;
 140     my @values = values %$params;
 141
 142     my $sql = join( ',', map { "$_ = ?" } @keys );
 143
 144     $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
 145
 146     my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
 147
 148     UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
 149
 150     return $r;
 151 }
 152
 153 =head2 AddUniqueDebarment
 154
 155 my $success = AddUniqueDebarment({
 156     borrowernumber => $borrowernumber,
 157     type           => $type,
 158     expiration     => $expiration,
 159     comment        => $comment,
 160 });
 161
 162 Creates a new debarment of the type defined by the key type.
 163 If a unique debarment already exists of the given type, it is updated instead.
 164 The current unique debarment types are OVERDUES, and SUSPENSION
 165
 166 Required keys: borrowernumber, type
 167
 168 =cut
 169
 170 sub AddUniqueDebarment {
 171     my ($params) = @_;
 172
 173     my $borrowernumber = $params->{'borrowernumber'};
 174     my $type           = $params->{'type'};
 175
 176     return unless ( $borrowernumber && $type );
 177
 178     my $patron = Koha::Patrons->find($borrowernumber);
 179     return unless $patron;
 180
 181     my $debarment =
 182       $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
 183
 184     my $r;
 185     if ($debarment) {
 186
 187         # 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
 188         $params->{'expiration'} = $debarment->expiration
 189           if ( $debarment->expiration
 190             && $debarment->expiration gt $params->{'expiration'} );
 191
 192         $params->{'borrower_debarment_id'} =
 193           $debarment->borrower_debarment_id;
 194         $r = ModDebarment($params);
 195     } else {
 196
 197         $r = AddDebarment($params);
 198     }
 199
 200     UpdateBorrowerDebarmentFlags($borrowernumber);
 201
 202     return $r;
 203 }
 204
 205 =head2 DelUniqueDebarment
 206
 207 my $success = _DelUniqueDebarment({
 208     borrowernumber => $borrowernumber,
 209     type           => $type,
 210 });
 211
 212 Deletes a unique debarment of the type defined by the key type.
 213 The current unique debarment types are OVERDUES, and SUSPENSION
 214
 215 Required keys: borrowernumber, type
 216
 217 =cut
 218
 219 sub DelUniqueDebarment {
 220     my ($params) = @_;
 221
 222     my $borrowernumber = $params->{'borrowernumber'};
 223     my $type           = $params->{'type'};
 224
 225     return unless ( $borrowernumber && $type );
 226
 227     my $patron = Koha::Patrons->find($borrowernumber);
 228     return unless $patron;
 229
 230     my $debarment =
 231       $patron->restrictions->search( { type => $type }, { rows => 1 } )->single;
 232
 233     return unless ( $debarment );
 234
 235     return DelDebarment( $debarment->borrower_debarment_id );
 236 }
 237
 238 =head2 UpdateBorrowerDebarmentFlags
 239
 240 my $success = UpdateBorrowerDebarmentFlags( $borrowernumber );
 241
 242 So as not to create additional latency, the fields borrowers.debarred
 243 and borrowers.debarredcomment remain in the borrowers table. Whenever
 244 the a borrowers debarrments are modified, this subroutine is run to
 245 decide if the borrower is currently debarred and update the 'quick flags'
 246 in the borrowers table accordingly.
 247
 248 =cut
 249
 250 sub UpdateBorrowerDebarmentFlags {
 251     my ($borrowernumber) = @_;
 252
 253     return unless ($borrowernumber);
 254
 255     my $dbh = C4::Context->dbh;
 256
 257     my $sql = q{
 258         SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
 259         WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
 260     };
 261     my $sth = $dbh->prepare($sql);
 262     $sth->execute($borrowernumber);
 263     my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
 264
 265     if ($count) {
 266         $expiration = "9999-12-31" if ($indefinite_expiration);
 267     } else {
 268         $expiration = undef;
 269         $comment    = undef;
 270     }
 271
 272     return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
 273 }
 274
 275 =head2 del_restrictions_after_payment
 276
 277 my $success = del_restrictions_after_payment({
 278     borrowernumber => $borrowernumber,
 279 });
 280
 281 Deletes any restrictions from patron by following the rules
 282 defined in "Patron restrictions".
 283
 284 =cut
 285
 286 sub del_restrictions_after_payment {
 287     my ($params) = @_;
 288
 289     my $borrowernumber = $params->{'borrowernumber'};
 290     return unless ($borrowernumber);
 291
 292     my $patron = Koha::Patrons->find($borrowernumber);
 293     return unless ($patron);
 294
 295     my $restrictions = $patron->restrictions;
 296     return unless ( $restrictions->count );
 297
 298     my $lines =
 299       Koha::Account::Lines->search( { borrowernumber => $borrowernumber } );
 300     my $total_due = $lines->total_outstanding;
 301
 302     while ( my $restriction = $restrictions->next ) {
 303         if (   $restriction->type->lift_after_payment
 304             && $total_due <= $restriction->type->fee_limit )
 305         {
 306             DelDebarment( $restriction->borrower_debarment_id );
 307         }
 308     }
 309 }
 310
 311 =head2 _GetBorrowernumberByDebarmentId
 312
 313 my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
 314
 315 =cut
 316
 317 sub _GetBorrowernumberByDebarmentId {
 318     my ($borrower_debarment_id) = @_;
 319
 320     return unless ($borrower_debarment_id);
 321
 322     my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
 323     my $sth = C4::Context->dbh->prepare($sql);
 324     $sth->execute($borrower_debarment_id);
 325     my ($borrowernumber) = $sth->fetchrow_array();
 326
 327     return $borrowernumber;
 328 }
 329
 330 1;
 331
 332 =head2 AUTHOR
 333
 334 Kyle M Hall <kyle@bywatersoltuions.com>
 335
 336 =cut