Koha/Account/Line.pm

   1 package Koha::Account::Line;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, write to the Free Software Foundation, Inc.,
  16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18 use Modern::Perl;
  19
  20 use Carp;
  21 use Data::Dumper;
  22
  23 use C4::Log qw(logaction);
  24
  25 use Koha::Account::Offsets;
  26 use Koha::Database;
  27 use Koha::Exceptions::Account;
  28 use Koha::Items;
  29
  30 use base qw(Koha::Object);
  31
  32 =encoding utf8
  33
  34 =head1 NAME
  35
  36 Koha::Account::Line - Koha accountline Object class
  37
  38 =head1 API
  39
  40 =head2 Class methods
  41
  42 =cut
  43
  44 =head3 item
  45
  46 Return the item linked to this account line if exists
  47
  48 =cut
  49
  50 sub item {
  51     my ( $self ) = @_;
  52     my $rs = $self->_result->itemnumber;
  53     return unless $rs;
  54     return Koha::Item->_new_from_dbic( $rs );
  55 }
  56
  57 =head3 checkout
  58
  59 Return the checkout linked to this account line if exists
  60
  61 =cut
  62
  63 sub checkout {
  64     my ( $self ) = @_;
  65     return unless $self->issue_id ;
  66
  67     $self->{_checkout} ||= Koha::Checkouts->find( $self->issue_id );
  68     $self->{_checkout} ||= Koha::Old::Checkouts->find( $self->issue_id );
  69     return $self->{_checkout};
  70 }
  71
  72 =head3 void
  73
  74   $payment_accountline->void();
  75
  76 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
  77 created by the application of this credit upon any debits and mark the credit
  78 as 'void' by updating it's status to "VOID".
  79
  80 =cut
  81
  82 sub void {
  83     my ($self) = @_;
  84
  85     # Make sure it is a payment we are voiding
  86     return unless $self->amount < 0;
  87
  88     my @account_offsets =
  89       Koha::Account::Offsets->search(
  90         { credit_id => $self->id, amount => { '<' => 0 }  } );
  91
  92     $self->_result->result_source->schema->txn_do(
  93         sub {
  94             foreach my $account_offset (@account_offsets) {
  95                 my $fee_paid =
  96                   Koha::Account::Lines->find( $account_offset->debit_id );
  97
  98                 next unless $fee_paid;
  99
 100                 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
 101                 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
 102                 $fee_paid->amountoutstanding($new_amount);
 103                 $fee_paid->store();
 104
 105                 Koha::Account::Offset->new(
 106                     {
 107                         credit_id => $self->id,
 108                         debit_id  => $fee_paid->id,
 109                         amount    => $amount_paid,
 110                         type      => 'Void Payment',
 111                     }
 112                 )->store();
 113             }
 114
 115             if ( C4::Context->preference("FinesLog") ) {
 116                 logaction(
 117                     "FINES", 'VOID',
 118                     $self->borrowernumber,
 119                     Dumper(
 120                         {
 121                             action         => 'void_payment',
 122                             borrowernumber => $self->borrowernumber,
 123                             amount            => $self->amount,
 124                             amountoutstanding => $self->amountoutstanding,
 125                             description       => $self->description,
 126                             accounttype       => $self->accounttype,
 127                             payment_type      => $self->payment_type,
 128                             note              => $self->note,
 129                             itemnumber        => $self->itemnumber,
 130                             manager_id        => $self->manager_id,
 131                             offsets =>
 132                               [ map { $_->unblessed } @account_offsets ],
 133                         }
 134                     )
 135                 );
 136             }
 137
 138             $self->set(
 139                 {
 140                     status            => 'VOID',
 141                     amountoutstanding => 0,
 142                     amount            => 0,
 143                 }
 144             );
 145             $self->store();
 146         }
 147     );
 148
 149 }
 150
 151 =head3 apply
 152
 153     my $debits = $account->outstanding_debits;
 154     my $outstanding_amount = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
 155
 156 Applies the credit to a given debits set.
 157
 158 =head4 arguments hashref
 159
 160 =over 4
 161
 162 =item debits - Koha::Account::Lines object set of debits
 163
 164 =item offset_type (optional) - a string indicating the offset type (valid values are those from
 165 the 'account_offset_types' table)
 166
 167 =back
 168
 169 =cut
 170
 171 sub apply {
 172     my ( $self, $params ) = @_;
 173
 174     my $debits      = $params->{debits};
 175     my $offset_type = $params->{offset_type} // 'Credit Applied';
 176
 177     unless ( $self->is_credit ) {
 178         Koha::Exceptions::Account::IsNotCredit->throw(
 179             error => 'Account line ' . $self->id . ' is not a credit'
 180         );
 181     }
 182
 183     my $available_credit = $self->amountoutstanding * -1;
 184
 185     unless ( $available_credit > 0 ) {
 186         Koha::Exceptions::Account::NoAvailableCredit->throw(
 187             error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
 188         );
 189     }
 190
 191     my $schema = Koha::Database->new->schema;
 192
 193     $schema->txn_do( sub {
 194         while ( my $debit = $debits->next ) {
 195
 196             unless ( $debit->is_debit ) {
 197                 Koha::Exceptions::Account::IsNotDebit->throw(
 198                     error => 'Account line ' . $debit->id . 'is not a debit'
 199                 );
 200             }
 201             my $amount_to_cancel;
 202             my $owed = $debit->amountoutstanding;
 203
 204             if ( $available_credit >= $owed ) {
 205                 $amount_to_cancel = $owed;
 206             }
 207             else {    # $available_credit < $debit->amountoutstanding
 208                 $amount_to_cancel = $available_credit;
 209             }
 210
 211             # record the account offset
 212             Koha::Account::Offset->new(
 213                 {   credit_id => $self->id,
 214                     debit_id  => $debit->id,
 215                     amount    => $amount_to_cancel * -1,
 216                     type      => $offset_type,
 217                 }
 218             )->store();
 219
 220             $available_credit -= $amount_to_cancel;
 221
 222             $self->amountoutstanding( $available_credit * -1 )->store;
 223             $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
 224
 225             # Same logic exists in Koha::Account::pay
 226             if (   $debit->amountoutstanding == 0
 227                 && $debit->itemnumber
 228                 && $debit->accounttype
 229                 && $debit->accounttype eq 'LOST' )
 230             {
 231                 C4::Circulation::ReturnLostItem( $self->borrowernumber, $debit->itemnumber );
 232             }
 233
 234         }
 235     });
 236
 237     return $available_credit;
 238 }
 239
 240 =head3 adjust
 241
 242 This method allows updating a debit or credit on a patron's account
 243
 244     $account_line->adjust(
 245         {
 246             amount    => $amount,
 247             type      => $update_type,
 248             interface => $interface
 249         }
 250     );
 251
 252 $update_type can be any of:
 253   - overdue_update
 254
 255 Authors Note: The intention here is that this method is only used
 256 to adjust accountlines where the final amount is not yet known/fixed.
 257 Incrementing fines are the only existing case at the time of writing,
 258 all other forms of 'adjustment' should be recorded as distinct credits
 259 or debits and applied, via an offset, to the corresponding debit or credit.
 260
 261 =cut
 262
 263 sub adjust {
 264     my ( $self, $params ) = @_;
 265
 266     my $amount       = $params->{amount};
 267     my $update_type  = $params->{type};
 268     my $interface    = $params->{interface};
 269
 270     unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
 271         Koha::Exceptions::Account::UnrecognisedType->throw(
 272             error => 'Update type not recognised'
 273         );
 274     }
 275
 276     my $account_type   = $self->accounttype;
 277     my $account_status = $self->status;
 278     unless (
 279         (
 280             exists(
 281                 $Koha::Account::Line::allowed_update->{$update_type}
 282                   ->{$account_type}
 283             )
 284             && ( $Koha::Account::Line::allowed_update->{$update_type}
 285                 ->{$account_type} eq $account_status )
 286         )
 287       )
 288     {
 289         Koha::Exceptions::Account::UnrecognisedType->throw(
 290             error => 'Update type not allowed on this accounttype' );
 291     }
 292
 293     my $schema = Koha::Database->new->schema;
 294
 295     $schema->txn_do(
 296         sub {
 297
 298             my $amount_before             = $self->amount;
 299             my $amount_outstanding_before = $self->amountoutstanding;
 300             my $difference                = $amount - $amount_before;
 301             my $new_outstanding           = $amount_outstanding_before + $difference;
 302
 303             my $offset_type = $account_type;
 304             $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
 305
 306             # Catch cases that require patron refunds
 307             if ( $new_outstanding < 0 ) {
 308                 my $account =
 309                   Koha::Patrons->find( $self->borrowernumber )->account;
 310                 my $credit = $account->add_credit(
 311                     {
 312                         amount      => $new_outstanding * -1,
 313                         description => 'Overpayment refund',
 314                         type        => 'credit',
 315                         interface   => $interface,
 316                         ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
 317                     }
 318                 );
 319                 $new_outstanding = 0;
 320             }
 321
 322             # Update the account line
 323             $self->set(
 324                 {
 325                     date              => \'NOW()',
 326                     amount            => $amount,
 327                     amountoutstanding => $new_outstanding,
 328                 }
 329             )->store();
 330
 331             # Record the account offset
 332             my $account_offset = Koha::Account::Offset->new(
 333                 {
 334                     debit_id => $self->id,
 335                     type     => $offset_type,
 336                     amount   => $difference
 337                 }
 338             )->store();
 339
 340             if ( C4::Context->preference("FinesLog") ) {
 341                 logaction(
 342                     "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
 343                     $self->borrowernumber,
 344                     Dumper(
 345                         {   action            => $update_type,
 346                             borrowernumber    => $self->borrowernumber,
 347                             amount            => $amount,
 348                             description       => undef,
 349                             amountoutstanding => $new_outstanding,
 350                             accounttype       => $self->accounttype,
 351                             note              => undef,
 352                             itemnumber        => $self->itemnumber,
 353                             manager_id        => undef,
 354                         }
 355                     )
 356                 ) if ( $update_type eq 'overdue_update' );
 357             }
 358         }
 359     );
 360
 361     return $self;
 362 }
 363
 364 =head3 is_credit
 365
 366     my $bool = $line->is_credit;
 367
 368 =cut
 369
 370 sub is_credit {
 371     my ($self) = @_;
 372
 373     return ( $self->amount < 0 );
 374 }
 375
 376 =head3 is_debit
 377
 378     my $bool = $line->is_debit;
 379
 380 =cut
 381
 382 sub is_debit {
 383     my ($self) = @_;
 384
 385     return !$self->is_credit;
 386 }
 387
 388 =head2 Internal methods
 389
 390 =cut
 391
 392 =head3 _type
 393
 394 =cut
 395
 396 sub _type {
 397     return 'Accountline';
 398 }
 399
 400 1;
 401
 402 =head2 Name mappings
 403
 404 =head3 $allowed_update
 405
 406 =cut
 407
 408 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
 409
 410 =head1 AUTHORS
 411
 412 Kyle M Hall <kyle@bywatersolutions.com >
 413 Tomás Cohen Arazi <tomascohen@theke.io>
 414 Martin Renvoize <martin.renvoize@ptfs-europe.com>
 415
 416 =cut