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