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