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