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
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Carp;
  21 use Data::Dumper;
  22
  23 use C4::Log qw(logaction);
  24 use C4::Overdues qw(GetFine);
  25
  26 use Koha::Account::CreditType;
  27 use Koha::Account::DebitType;
  28 use Koha::Account::Offsets;
  29 use Koha::Database;
  30 use Koha::DateUtils;
  31 use Koha::Exceptions::Account;
  32 use Koha::Items;
  33
  34 use base qw(Koha::Object);
  35
  36 =encoding utf8
  37
  38 =head1 NAME
  39
  40 Koha::Account::Line - Koha accountline Object class
  41
  42 =head1 API
  43
  44 =head2 Class methods
  45
  46 =cut
  47
  48 =head3 patron
  49
  50 Return the patron linked to this account line
  51
  52 =cut
  53
  54 sub patron {
  55     my ( $self ) = @_;
  56     my $rs = $self->_result->borrowernumber;
  57     return unless $rs;
  58     return Koha::Patron->_new_from_dbic( $rs );
  59 }
  60
  61 =head3 item
  62
  63 Return the item linked to this account line if exists
  64
  65 =cut
  66
  67 sub item {
  68     my ( $self ) = @_;
  69     my $rs = $self->_result->itemnumber;
  70     return unless $rs;
  71     return Koha::Item->_new_from_dbic( $rs );
  72 }
  73
  74 =head3 checkout
  75
  76 Return the checkout linked to this account line if exists
  77
  78 =cut
  79
  80 sub checkout {
  81     my ( $self ) = @_;
  82     return unless $self->issue_id ;
  83
  84     $self->{_checkout} ||= Koha::Checkouts->find( $self->issue_id );
  85     $self->{_checkout} ||= Koha::Old::Checkouts->find( $self->issue_id );
  86     return $self->{_checkout};
  87 }
  88
  89 =head3 library
  90
  91 Returns a Koha::Library object representing where the accountline was recorded
  92
  93 =cut
  94
  95 sub library {
  96     my ( $self ) = @_;
  97     my $rs = $self->_result->library;
  98     return unless $rs;
  99     return Koha::Library->_new_from_dbic($rs);
 100 }
 101
 102 =head3 credit_type
 103
 104 Return the credit_type linked to this account line
 105
 106 =cut
 107
 108 sub credit_type {
 109     my ( $self ) = @_;
 110     my $rs = $self->_result->credit_type_code;
 111     return unless $rs;
 112     return Koha::Account::CreditType->_new_from_dbic( $rs );
 113 }
 114
 115 =head3 debit_type
 116
 117 Return the debit_type linked to this account line
 118
 119 =cut
 120
 121 sub debit_type {
 122     my ( $self ) = @_;
 123     my $rs = $self->_result->debit_type_code;
 124     return unless $rs;
 125     return Koha::Account::DebitType->_new_from_dbic( $rs );
 126 }
 127
 128 =head3 credit_offsets
 129
 130 Return the credit_offsets linked to this account line if some exist
 131
 132 =cut
 133
 134 sub credit_offsets {
 135     my ( $self, $cond, $attr ) = @_;
 136
 137     unless ( $self->is_credit ) {
 138         Koha::Exceptions::Account::IsNotCredit->throw(
 139             error => 'Account line ' . $self->id . ' is not a credit'
 140         );
 141     }
 142
 143     my $rs = $self->_result->search_related( 'account_offsets_credits', $cond, $attr);
 144     return unless $rs;
 145     return Koha::Account::Offsets->_new_from_dbic($rs);
 146 }
 147
 148 =head3 debit_offsets
 149
 150 Return the debit_offsets linked to this account line if some exist
 151
 152 =cut
 153
 154 sub debit_offsets {
 155     my ( $self, $cond, $attr ) = @_;
 156
 157     unless ( $self->is_debit ) {
 158         Koha::Exceptions::Account::IsNotDebit->throw(
 159             error => 'Account line ' . $self->id . ' is not a debit'
 160         );
 161     }
 162
 163     my $rs = $self->_result->search_related( 'account_offsets_debits', $cond, $attr);
 164     return unless $rs;
 165     return Koha::Account::Offsets->_new_from_dbic($rs);
 166 }
 167
 168 =head3 credits
 169
 170   my $credits = $accountline->credits;
 171   my $credits = $accountline->credits( $cond, $attr );
 172
 173 Return the credits linked to this account line if some exist.
 174 Search conditions and attributes may be passed if you wish to filter
 175 the resultant resultant resultset.
 176
 177 =cut
 178
 179 sub credits {
 180     my ( $self, $cond, $attr ) = @_;
 181
 182     unless ( $self->is_debit ) {
 183         Koha::Exceptions::Account::IsNotDebit->throw(
 184             error => 'Account line ' . $self->id . ' is not a debit'
 185         );
 186     }
 187
 188     my $cond_m = { map { "credit.".$_ => $cond->{$_} } keys %{$cond}};
 189     my $rs =
 190       $self->_result->search_related('account_offsets_debits')
 191       ->search_related( 'credit', $cond_m, $attr );
 192     return unless $rs;
 193     return Koha::Account::Lines->_new_from_dbic($rs);
 194 }
 195
 196 =head3 debits
 197
 198   my $debits = $accountline->debits;
 199   my $debits = $accountline->debits( $cond, $attr );
 200
 201 Return the debits linked to this account line if some exist.
 202 Search conditions and attributes may be passed if you wish to filter
 203 the resultant resultant resultset.
 204
 205 =cut
 206
 207 sub debits {
 208     my ( $self, $cond, $attr ) = @_;
 209
 210     unless ( $self->is_credit ) {
 211         Koha::Exceptions::Account::IsNotCredit->throw(
 212             error => 'Account line ' . $self->id . ' is not a credit'
 213         );
 214     }
 215
 216     my $cond_m = { map { "debit.".$_ => $cond->{$_} } keys %{$cond}};
 217     my $rs =
 218       $self->_result->search_related('account_offsets_credits')
 219       ->search_related( 'debit', $cond_m, $attr );
 220     return unless $rs;
 221     return Koha::Account::Lines->_new_from_dbic($rs);
 222 }
 223
 224 =head3 void
 225
 226   $payment_accountline->void({
 227       interface => $interface,
 228       [ staff_id => $staff_id, branch => $branchcode ]
 229   });
 230
 231 Used to 'void' (or reverse) a payment/credit. It will roll back any offsets
 232 created by the application of this credit upon any debits and mark the credit
 233 as 'void' by updating it's status to "VOID".
 234
 235 =cut
 236
 237 sub void {
 238     my ($self, $params) = @_;
 239
 240     # Make sure it is a credit we are voiding
 241     unless ( $self->is_credit ) {
 242         Koha::Exceptions::Account::IsNotCredit->throw(
 243             error => 'Account line ' . $self->id . 'is not a credit' );
 244     }
 245
 246     # Make sure it is not already voided
 247     if ( $self->status && $self->status eq 'VOID' ) {
 248         Koha::Exceptions::Account->throw(
 249             error => 'Account line ' . $self->id . 'is already void' );
 250     }
 251
 252     # Check for mandatory parameters
 253     my @mandatory = ( 'interface' );
 254     for my $param (@mandatory) {
 255         unless ( defined( $params->{$param} ) ) {
 256             Koha::Exceptions::MissingParameter->throw(
 257                 error => "The $param parameter is mandatory" );
 258         }
 259     }
 260
 261     # More mandatory parameters
 262     if ( $params->{interface} eq 'intranet' ) {
 263         my @optional = ( 'staff_id', 'branch' );
 264         for my $param (@optional) {
 265             unless ( defined( $params->{$param} ) ) {
 266                 Koha::Exceptions::MissingParameter->throw( error =>
 267 "The $param parameter is mandatory when interface is set to 'intranet'"
 268                 );
 269             }
 270         }
 271     }
 272
 273     # Find any applied offsets for the credit so we may reverse them
 274     my @account_offsets =
 275       Koha::Account::Offsets->search(
 276         { credit_id => $self->id, amount => { '<' => 0 }  } );
 277
 278     my $void;
 279     $self->_result->result_source->schema->txn_do(
 280         sub {
 281
 282             # A 'void' is a 'debit'
 283             $void = Koha::Account::Line->new(
 284                 {
 285                     borrowernumber    => $self->borrowernumber,
 286                     date              => \'NOW()',
 287                     debit_type_code   => 'VOID',
 288                     amount            => $self->amount * -1,
 289                     amountoutstanding => $self->amount * -1,
 290                     manager_id        => $params->{staff_id},
 291                     interface         => $params->{interface},
 292                     branchcode        => $params->{branch},
 293                 }
 294             )->store();
 295
 296             # Record the creation offset
 297             Koha::Account::Offset->new(
 298                 {
 299                     debit_id => $void->id,
 300                     type     => 'VOID',
 301                     amount   => $self->amount * -1
 302                 }
 303             )->store();
 304
 305             # Reverse any applied payments
 306             foreach my $account_offset (@account_offsets) {
 307                 my $fee_paid =
 308                   Koha::Account::Lines->find( $account_offset->debit_id );
 309
 310                 next unless $fee_paid;
 311
 312                 my $amount_paid = $account_offset->amount * -1; # amount paid is stored as a negative amount
 313                 my $new_amount = $fee_paid->amountoutstanding + $amount_paid;
 314                 $fee_paid->amountoutstanding($new_amount);
 315                 $fee_paid->store();
 316
 317                 Koha::Account::Offset->new(
 318                     {
 319                         credit_id => $self->id,
 320                         debit_id  => $fee_paid->id,
 321                         amount    => $amount_paid,
 322                         type      => 'VOID',
 323                     }
 324                 )->store();
 325             }
 326
 327             # Link void to payment
 328             $self->set({
 329                 amountoutstanding => $self->amount,
 330                 status => 'VOID'
 331             })->store();
 332             $self->apply({ debits => [$void]});
 333
 334             if ( C4::Context->preference("FinesLog") ) {
 335                 logaction(
 336                     "FINES", 'VOID',
 337                     $self->borrowernumber,
 338                     Dumper(
 339                         {
 340                             action         => 'void_payment',
 341                             borrowernumber => $self->borrowernumber,
 342                             amount            => $self->amount,
 343                             amountoutstanding => $self->amountoutstanding,
 344                             description       => $self->description,
 345                             credit_type_code  => $self->credit_type_code,
 346                             payment_type      => $self->payment_type,
 347                             note              => $self->note,
 348                             itemnumber        => $self->itemnumber,
 349                             manager_id        => $self->manager_id,
 350                             offsets =>
 351                               [ map { $_->unblessed } @account_offsets ],
 352                         }
 353                     )
 354                 );
 355             }
 356         }
 357     );
 358
 359     $void->discard_changes;
 360     return $void;
 361 }
 362
 363 =head3 cancel
 364
 365   $debit_accountline->cancel();
 366
 367 Cancel a charge. It will mark the debit as 'cancelled' by updating its
 368 status to 'CANCELLED'.
 369
 370 Charges that have been fully or partially paid cannot be cancelled.
 371
 372 Returns the cancellation accountline.
 373
 374 =cut
 375
 376 sub cancel {
 377     my ( $self, $params ) = @_;
 378
 379     # Make sure it is a charge we are reducing
 380     unless ( $self->is_debit ) {
 381         Koha::Exceptions::Account::IsNotDebit->throw(
 382             error => 'Account line ' . $self->id . 'is not a debit' );
 383     }
 384     if ( $self->debit_type_code eq 'PAYOUT' ) {
 385         Koha::Exceptions::Account::IsNotDebit->throw(
 386             error => 'Account line ' . $self->id . 'is a payout' );
 387     }
 388
 389     # Make sure it is not already cancelled
 390     if ( $self->status && $self->status eq 'CANCELLED' ) {
 391         Koha::Exceptions::Account->throw(
 392             error => 'Account line ' . $self->id . 'is already cancelled' );
 393     }
 394
 395     # Make sure it has not be paid yet
 396     if ( $self->amount != $self->amountoutstanding ) {
 397         Koha::Exceptions::Account->throw(
 398             error => 'Account line ' . $self->id . 'is already offset' );
 399     }
 400
 401     # Check for mandatory parameters
 402     my @mandatory = ( 'staff_id', 'branch' );
 403     for my $param (@mandatory) {
 404         unless ( defined( $params->{$param} ) ) {
 405             Koha::Exceptions::MissingParameter->throw(
 406                 error => "The $param parameter is mandatory" );
 407         }
 408     }
 409
 410     my $cancellation;
 411     $self->_result->result_source->schema->txn_do(
 412         sub {
 413
 414             # A 'cancellation' is a 'credit'
 415             $cancellation = Koha::Account::Line->new(
 416                 {
 417                     date              => \'NOW()',
 418                     amount            => 0 - $self->amount,
 419                     credit_type_code  => 'CANCELLATION',
 420                     status            => 'ADDED',
 421                     amountoutstanding => 0 - $self->amount,
 422                     manager_id        => $params->{staff_id},
 423                     borrowernumber    => $self->borrowernumber,
 424                     interface         => 'intranet',
 425                     branchcode        => $params->{branch},
 426                 }
 427             )->store();
 428
 429             my $cancellation_offset = Koha::Account::Offset->new(
 430                 {
 431                     credit_id => $cancellation->accountlines_id,
 432                     type      => 'CANCELLATION',
 433                     amount    => $self->amount
 434                 }
 435             )->store();
 436
 437             # Link cancellation to charge
 438             $cancellation->apply(
 439                 {
 440                     debits      => [$self],
 441                     offset_type => 'CANCELLATION'
 442                 }
 443             );
 444             $cancellation->status('APPLIED')->store();
 445
 446             # Update status of original debit
 447             $self->status('CANCELLED')->store;
 448         }
 449     );
 450
 451     $cancellation->discard_changes;
 452     return $cancellation;
 453 }
 454
 455 =head3 reduce
 456
 457   $charge_accountline->reduce({
 458       reduction_type => $reduction_type
 459   });
 460
 461 Used to 'reduce' a charge/debit by adding a credit to offset against the amount
 462 outstanding.
 463
 464 May be used to apply a discount whilst retaining the original debit amounts or
 465 to apply a full or partial refund for example when a lost item is found and
 466 returned.
 467
 468 It will immediately be applied to the given debit unless the debit has already
 469 been paid, in which case a 'zero' offset will be added to maintain a link to
 470 the debit but the outstanding credit will be left so it may be applied to other
 471 debts.
 472
 473 Reduction type may be one of:
 474
 475 * REFUND
 476 * DISCOUNT
 477
 478 Returns the reduction accountline (which will be a credit)
 479
 480 =cut
 481
 482 sub reduce {
 483     my ( $self, $params ) = @_;
 484
 485     # Make sure it is a charge we are reducing
 486     unless ( $self->is_debit ) {
 487         Koha::Exceptions::Account::IsNotDebit->throw(
 488             error => 'Account line ' . $self->id . 'is not a debit' );
 489     }
 490     if ( $self->debit_type_code eq 'PAYOUT' ) {
 491         Koha::Exceptions::Account::IsNotDebit->throw(
 492             error => 'Account line ' . $self->id . 'is a payout' );
 493     }
 494
 495     # Check for mandatory parameters
 496     my @mandatory = ( 'interface', 'reduction_type', 'amount' );
 497     for my $param (@mandatory) {
 498         unless ( defined( $params->{$param} ) ) {
 499             Koha::Exceptions::MissingParameter->throw(
 500                 error => "The $param parameter is mandatory" );
 501         }
 502     }
 503
 504     # More mandatory parameters
 505     if ( $params->{interface} eq 'intranet' ) {
 506         my @optional = ( 'staff_id', 'branch' );
 507         for my $param (@optional) {
 508             unless ( defined( $params->{$param} ) ) {
 509                 Koha::Exceptions::MissingParameter->throw( error =>
 510 "The $param parameter is mandatory when interface is set to 'intranet'"
 511                 );
 512             }
 513         }
 514     }
 515
 516     # Make sure the reduction isn't more than the original
 517     my $original = $self->amount;
 518     Koha::Exceptions::Account::AmountNotPositive->throw(
 519         error => 'Reduce amount passed is not positive' )
 520       unless ( $params->{amount} > 0 );
 521     Koha::Exceptions::ParameterTooHigh->throw( error =>
 522 "Amount to reduce ($params->{amount}) is higher than original amount ($original)"
 523     ) unless ( $original >= $params->{amount} );
 524     my $reduced =
 525       $self->credits( { credit_type_code => [ 'DISCOUNT', 'REFUND' ] } )->total;
 526     Koha::Exceptions::ParameterTooHigh->throw( error =>
 527 "Combined reduction ($params->{amount} + $reduced) is higher than original amount ("
 528           . abs($original)
 529           . ")" )
 530       unless ( $original >= ( $params->{amount} + abs($reduced) ) );
 531
 532     my $status = { 'REFUND' => 'REFUNDED', 'DISCOUNT' => 'DISCOUNTED' };
 533
 534     my $reduction;
 535     $self->_result->result_source->schema->txn_do(
 536         sub {
 537
 538             # A 'reduction' is a 'credit'
 539             $reduction = Koha::Account::Line->new(
 540                 {
 541                     date              => \'NOW()',
 542                     amount            => 0 - $params->{amount},
 543                     credit_type_code  => $params->{reduction_type},
 544                     status            => 'ADDED',
 545                     amountoutstanding => 0 - $params->{amount},
 546                     manager_id        => $params->{staff_id},
 547                     borrowernumber    => $self->borrowernumber,
 548                     interface         => $params->{interface},
 549                     branchcode        => $params->{branch},
 550                 }
 551             )->store();
 552
 553             my $reduction_offset = Koha::Account::Offset->new(
 554                 {
 555                     credit_id => $reduction->accountlines_id,
 556                     type      => uc( $params->{reduction_type} ),
 557                     amount    => $params->{amount}
 558                 }
 559             )->store();
 560
 561             # Link reduction to charge (and apply as required)
 562             my $debit_outstanding = $self->amountoutstanding;
 563             if ( $debit_outstanding >= $params->{amount} ) {
 564
 565                 $reduction->apply(
 566                     {
 567                         debits      => [$self],
 568                         offset_type => uc( $params->{reduction_type} )
 569                     }
 570                 );
 571                 $reduction->status('APPLIED')->store();
 572             }
 573             else {
 574
 575                 # Zero amount offset used to link original 'debit' to
 576                 # reduction 'credit'
 577                 my $link_reduction_offset = Koha::Account::Offset->new(
 578                     {
 579                         credit_id => $reduction->accountlines_id,
 580                         debit_id  => $self->accountlines_id,
 581                         type      => uc( $params->{reduction_type} ),
 582                         amount    => 0
 583                     }
 584                 )->store();
 585             }
 586
 587             # Update status of original debit
 588             $self->status( $status->{ $params->{reduction_type} } )->store;
 589         }
 590     );
 591
 592     $reduction->discard_changes;
 593     return $reduction;
 594 }
 595
 596 =head3 apply
 597
 598     my $debits = $account->outstanding_debits;
 599     my $credit = $credit->apply( { debits => $debits, [ offset_type => $offset_type ] } );
 600
 601 Applies the credit to a given debits array reference.
 602
 603 =head4 arguments hashref
 604
 605 =over 4
 606
 607 =item debits - Koha::Account::Lines object set of debits
 608
 609 =item offset_type (optional) - a string indicating the offset type (valid values are those from
 610 the 'account_offset_types' table)
 611
 612 =back
 613
 614 =cut
 615
 616 sub apply {
 617     my ( $self, $params ) = @_;
 618
 619     my $debits      = $params->{debits};
 620     my $offset_type = $params->{offset_type} // 'Credit Applied';
 621
 622     unless ( $self->is_credit ) {
 623         Koha::Exceptions::Account::IsNotCredit->throw(
 624             error => 'Account line ' . $self->id . ' is not a credit'
 625         );
 626     }
 627
 628     my $available_credit = $self->amountoutstanding * -1;
 629
 630     unless ( $available_credit > 0 ) {
 631         Koha::Exceptions::Account::NoAvailableCredit->throw(
 632             error => 'Outstanding credit is ' . $available_credit . ' and cannot be applied'
 633         );
 634     }
 635
 636     my $schema = Koha::Database->new->schema;
 637
 638     $schema->txn_do( sub {
 639         for my $debit ( @{$debits} ) {
 640
 641             unless ( $debit->is_debit ) {
 642                 Koha::Exceptions::Account::IsNotDebit->throw(
 643                     error => 'Account line ' . $debit->id . 'is not a debit'
 644                 );
 645             }
 646             my $amount_to_cancel;
 647             my $owed = $debit->amountoutstanding;
 648
 649             if ( $available_credit >= $owed ) {
 650                 $amount_to_cancel = $owed;
 651             }
 652             else {    # $available_credit < $debit->amountoutstanding
 653                 $amount_to_cancel = $available_credit;
 654             }
 655
 656             # record the account offset
 657             Koha::Account::Offset->new(
 658                 {   credit_id => $self->id,
 659                     debit_id  => $debit->id,
 660                     amount    => $amount_to_cancel * -1,
 661                     type      => $offset_type,
 662                 }
 663             )->store();
 664
 665             $available_credit -= $amount_to_cancel;
 666
 667             $self->amountoutstanding( $available_credit * -1 )->store;
 668             $debit->amountoutstanding( $owed - $amount_to_cancel )->store;
 669
 670             # Attempt to renew the item associated with this debit if
 671             # appropriate
 672             if ( $self->credit_type_code ne 'FORGIVEN' && $debit->is_renewable ) {
 673                 my $outcome = $debit->renew_item( { interface => $params->{interface} } );
 674                 $self->add_message(
 675                     {
 676                         type    => 'info',
 677                         message => 'renewal',
 678                         payload => $outcome
 679                     }
 680                 ) if $outcome;
 681             }
 682             $debit->discard_changes; # Refresh values from DB to clear floating point remainders
 683
 684             # Same logic exists in Koha::Account::pay
 685             if (
 686                 C4::Context->preference('MarkLostItemsAsReturned') =~
 687                 m|onpayment|
 688                 && $debit->debit_type_code
 689                 && $debit->debit_type_code eq 'LOST'
 690                 && $debit->amountoutstanding == 0
 691                 && $debit->itemnumber
 692                 && !(
 693                        $self->credit_type_code eq 'LOST_FOUND'
 694                     && $self->itemnumber == $debit->itemnumber
 695                 )
 696               )
 697             {
 698                 C4::Circulation::ReturnLostItem( $self->borrowernumber,
 699                     $debit->itemnumber );
 700             }
 701
 702             last if $available_credit == 0;
 703         }
 704     });
 705
 706     return $self;
 707 }
 708
 709 =head3 payout
 710
 711   $credit_accountline->payout(
 712     {
 713         payout_type => $payout_type,
 714         register_id => $register_id,
 715         staff_id    => $staff_id,
 716         interface   => 'intranet',
 717         amount      => $amount
 718     }
 719   );
 720
 721 Used to 'pay out' a credit to a user.
 722
 723 Payout type may be one of any existing payment types
 724
 725 Returns the payout debit line that is created via this transaction.
 726
 727 =cut
 728
 729 sub payout {
 730     my ( $self, $params ) = @_;
 731
 732     # Make sure it is a credit we are paying out
 733     unless ( $self->is_credit ) {
 734         Koha::Exceptions::Account::IsNotCredit->throw(
 735             error => 'Account line ' . $self->id . ' is not a credit' );
 736     }
 737
 738     # Check for mandatory parameters
 739     my @mandatory =
 740       ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
 741     for my $param (@mandatory) {
 742         unless ( defined( $params->{$param} ) ) {
 743             Koha::Exceptions::MissingParameter->throw(
 744                 error => "The $param parameter is mandatory" );
 745         }
 746     }
 747
 748     # Make sure there is outstanding credit to pay out
 749     my $outstanding = -1 * $self->amountoutstanding;
 750     my $amount =
 751       $params->{amount} ? $params->{amount} : $outstanding;
 752     Koha::Exceptions::Account::AmountNotPositive->throw(
 753         error => 'Payout amount passed is not positive' )
 754       unless ( $amount > 0 );
 755     Koha::Exceptions::ParameterTooHigh->throw(
 756         error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
 757       unless ($outstanding >= $amount );
 758
 759     # Make sure we record the cash register for cash transactions
 760     Koha::Exceptions::Account::RegisterRequired->throw()
 761       if ( C4::Context->preference("UseCashRegisters")
 762         && defined( $params->{payout_type} )
 763         && ( $params->{payout_type} eq 'CASH' )
 764         && !defined( $params->{cash_register} ) );
 765
 766     my $payout;
 767     $self->_result->result_source->schema->txn_do(
 768         sub {
 769
 770             # A 'payout' is a 'debit'
 771             $payout = Koha::Account::Line->new(
 772                 {
 773                     date              => \'NOW()',
 774                     amount            => $amount,
 775                     debit_type_code   => 'PAYOUT',
 776                     payment_type      => $params->{payout_type},
 777                     amountoutstanding => $amount,
 778                     manager_id        => $params->{staff_id},
 779                     borrowernumber    => $self->borrowernumber,
 780                     interface         => $params->{interface},
 781                     branchcode        => $params->{branch},
 782                     register_id       => $params->{cash_register}
 783                 }
 784             )->store();
 785
 786             my $payout_offset = Koha::Account::Offset->new(
 787                 {
 788                     debit_id => $payout->accountlines_id,
 789                     type     => 'PAYOUT',
 790                     amount   => $amount
 791                 }
 792             )->store();
 793
 794             $self->apply( { debits => [$payout], offset_type => 'PAYOUT' } );
 795             $self->status('PAID')->store;
 796         }
 797     );
 798
 799     $payout->discard_changes;
 800     return $payout;
 801 }
 802
 803 =head3 adjust
 804
 805 This method allows updating a debit or credit on a patron's account
 806
 807     $account_line->adjust(
 808         {
 809             amount    => $amount,
 810             type      => $update_type,
 811             interface => $interface
 812         }
 813     );
 814
 815 $update_type can be any of:
 816   - overdue_update
 817
 818 Authors Note: The intention here is that this method is only used
 819 to adjust accountlines where the final amount is not yet known/fixed.
 820 Incrementing fines are the only existing case at the time of writing,
 821 all other forms of 'adjustment' should be recorded as distinct credits
 822 or debits and applied, via an offset, to the corresponding debit or credit.
 823
 824 =cut
 825
 826 sub adjust {
 827     my ( $self, $params ) = @_;
 828
 829     my $amount       = $params->{amount};
 830     my $update_type  = $params->{type};
 831     my $interface    = $params->{interface};
 832
 833     unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
 834         Koha::Exceptions::Account::UnrecognisedType->throw(
 835             error => 'Update type not recognised'
 836         );
 837     }
 838
 839     my $debit_type_code = $self->debit_type_code;
 840     my $account_status  = $self->status;
 841     unless (
 842         (
 843             exists(
 844                 $Koha::Account::Line::allowed_update->{$update_type}
 845                   ->{$debit_type_code}
 846             )
 847             && ( $Koha::Account::Line::allowed_update->{$update_type}
 848                 ->{$debit_type_code} eq $account_status )
 849         )
 850       )
 851     {
 852         Koha::Exceptions::Account::UnrecognisedType->throw(
 853             error => 'Update type not allowed on this debit_type' );
 854     }
 855
 856     my $schema = Koha::Database->new->schema;
 857
 858     $schema->txn_do(
 859         sub {
 860
 861             my $amount_before             = $self->amount;
 862             my $amount_outstanding_before = $self->amountoutstanding;
 863             my $difference                = $amount - $amount_before;
 864             my $new_outstanding           = $amount_outstanding_before + $difference;
 865
 866             my $offset_type = $debit_type_code;
 867             $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
 868
 869             # Catch cases that require patron refunds
 870             if ( $new_outstanding < 0 ) {
 871                 my $account =
 872                   Koha::Patrons->find( $self->borrowernumber )->account;
 873                 my $credit = $account->add_credit(
 874                     {
 875                         amount      => $new_outstanding * -1,
 876                         type        => 'OVERPAYMENT',
 877                         interface   => $interface,
 878                         ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
 879                     }
 880                 );
 881                 $new_outstanding = 0;
 882             }
 883
 884             # Update the account line
 885             $self->set(
 886                 {
 887                     date              => \'NOW()',
 888                     amount            => $amount,
 889                     amountoutstanding => $new_outstanding,
 890                 }
 891             )->store();
 892
 893             # Record the account offset
 894             my $account_offset = Koha::Account::Offset->new(
 895                 {
 896                     debit_id => $self->id,
 897                     type     => $offset_type,
 898                     amount   => $difference
 899                 }
 900             )->store();
 901
 902             if ( C4::Context->preference("FinesLog") ) {
 903                 logaction(
 904                     "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
 905                     $self->borrowernumber,
 906                     Dumper(
 907                         {   action            => $update_type,
 908                             borrowernumber    => $self->borrowernumber,
 909                             amount            => $amount,
 910                             description       => undef,
 911                             amountoutstanding => $new_outstanding,
 912                             debit_type_code   => $self->debit_type_code,
 913                             note              => undef,
 914                             itemnumber        => $self->itemnumber,
 915                             manager_id        => undef,
 916                         }
 917                     )
 918                 ) if ( $update_type eq 'overdue_update' );
 919             }
 920         }
 921     );
 922
 923     return $self;
 924 }
 925
 926 =head3 is_credit
 927
 928     my $bool = $line->is_credit;
 929
 930 =cut
 931
 932 sub is_credit {
 933     my ($self) = @_;
 934
 935     return defined $self->credit_type_code;
 936 }
 937
 938 =head3 is_debit
 939
 940     my $bool = $line->is_debit;
 941
 942 =cut
 943
 944 sub is_debit {
 945     my ($self) = @_;
 946
 947     return !$self->is_credit;
 948 }
 949
 950 =head3 to_api_mapping
 951
 952 This method returns the mapping for representing a Koha::Account::Line object
 953 on the API.
 954
 955 =cut
 956
 957 sub to_api_mapping {
 958     return {
 959         accountlines_id   => 'account_line_id',
 960         credit_number     => undef,
 961         credit_type_code  => 'credit_type',
 962         debit_type_code   => 'debit_type',
 963         amountoutstanding => 'amount_outstanding',
 964         borrowernumber    => 'patron_id',
 965         branchcode        => 'library_id',
 966         issue_id          => 'checkout_id',
 967         itemnumber        => 'item_id',
 968         manager_id        => 'user_id',
 969         note              => 'internal_note',
 970         register_id       => 'cash_register_id',
 971     };
 972
 973 }
 974
 975 =head3 is_renewable
 976
 977     my $bool = $line->is_renewable;
 978
 979 =cut
 980
 981 sub is_renewable {
 982     my ($self) = @_;
 983
 984     return (
 985         $self->amountoutstanding == 0 &&
 986         $self->debit_type_code &&
 987         $self->debit_type_code eq 'OVERDUE' &&
 988         $self->status &&
 989         $self->status eq 'UNRETURNED' &&
 990         $self->item &&
 991         $self->patron
 992     ) ? 1 : 0;
 993 }
 994
 995 =head3 renew_item
 996
 997     my $renew_result = $line->renew_item;
 998
 999 Conditionally attempt to renew an item and return the outcome. This is
1000 as a consequence of the fine on an item being fully paid off.
1001 Caller must call is_renewable before.
1002
1003 =cut
1004
1005 sub renew_item {
1006     my ($self, $params) = @_;
1007
1008     my $outcome = {};
1009
1010     # We want to reject the call to renew if:
1011     # - The RenewAccruingItemWhenPaid syspref is off
1012     # OR
1013     # - The RenewAccruingItemInOpac syspref is off
1014     # - There is an interface param passed and it's value is 'opac'
1015
1016     if (
1017         !C4::Context->preference('RenewAccruingItemWhenPaid') ||
1018         (
1019             !C4::Context->preference('RenewAccruingItemInOpac') &&
1020             $params->{interface} &&
1021             $params->{interface} eq 'opac'
1022         )
1023     ) {
1024         return;
1025     }
1026
1027     my $itemnumber = $self->item->itemnumber;
1028     my $borrowernumber = $self->patron->borrowernumber;
1029     my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
1030         $borrowernumber,
1031         $itemnumber
1032     );
1033     if ( $can_renew ) {
1034         my $due_date = C4::Circulation::AddRenewal(
1035             $borrowernumber,
1036             $itemnumber,
1037             $self->{branchcode},
1038             undef,
1039             undef,
1040             1
1041         );
1042         return {
1043             itemnumber => $itemnumber,
1044             due_date   => $due_date,
1045             success    => 1
1046         };
1047     } else {
1048         return {
1049             itemnumber => $itemnumber,
1050             error      => $error,
1051             success    => 0
1052         };
1053     }
1054
1055 }
1056
1057 =head3 store
1058
1059 Specific store method to generate credit number before saving
1060
1061 =cut
1062
1063 sub store {
1064     my ($self) = @_;
1065
1066     my $AutoCreditNumber = C4::Context->preference('AutoCreditNumber');
1067     my $credit_number_enabled = $self->is_credit && $self->credit_type->credit_number_enabled;
1068
1069     if ($AutoCreditNumber && $credit_number_enabled && !$self->in_storage) {
1070         if (defined $self->credit_number) {
1071             Koha::Exceptions::Account->throw('AutoCreditNumber is enabled but credit_number is already defined');
1072         }
1073
1074         my $rs = Koha::Database->new->schema->resultset($self->_type);
1075
1076         if ($AutoCreditNumber eq 'incremental') {
1077             my $max = $rs->search({
1078                 credit_number => { -regexp => '^[0-9]+$' }
1079             }, {
1080                 select => \'CAST(credit_number AS UNSIGNED)',
1081                 as => ['credit_number'],
1082             })->get_column('credit_number')->max;
1083             $max //= 0;
1084             $self->credit_number($max + 1);
1085         } elsif ($AutoCreditNumber eq 'annual') {
1086             my $now = dt_from_string;
1087             my $prefix = sprintf('%d-', $now->year);
1088             my $max = $rs->search({
1089                 -and => [
1090                     credit_number => { -regexp => '[0-9]{4}$' },
1091                     credit_number => { -like => "$prefix%" },
1092                 ],
1093             })->get_column('credit_number')->max;
1094             $max //= $prefix . '0000';
1095             my $incr = substr($max, length $prefix);
1096             $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1097         } elsif ($AutoCreditNumber eq 'branchyyyymmincr') {
1098             my $userenv = C4::Context->userenv;
1099             if ($userenv) {
1100                 my $branch = $userenv->{branch};
1101                 my $now = dt_from_string;
1102                 my $prefix = sprintf('%s%d%02d', $branch, $now->year, $now->month);
1103                 my $pattern = $prefix;
1104                 $pattern =~ s/([\?%_])/\\$1/g;
1105                 my $max = $rs->search({
1106                     -and => [
1107                         credit_number => { -regexp => '[0-9]{4}$' },
1108                         credit_number => { -like => "$pattern%" },
1109                     ],
1110                 })->get_column('credit_number')->max;
1111                 $max //= $prefix . '0000';
1112                 my $incr = substr($max, length $prefix);
1113                 $self->credit_number(sprintf('%s%04d', $prefix, $incr + 1));
1114             }
1115         }
1116     }
1117
1118     return $self->SUPER::store();
1119 }
1120
1121 =head2 Internal methods
1122
1123 =cut
1124
1125 =head3 _type
1126
1127 =cut
1128
1129 sub _type {
1130     return 'Accountline';
1131 }
1132
1133 1;
1134
1135 =head2 Name mappings
1136
1137 =head3 $allowed_update
1138
1139 =cut
1140
1141 our $allowed_update = { 'overdue_update' => { 'OVERDUE' => 'UNRETURNED' } };
1142
1143 =head1 AUTHORS
1144
1145 Kyle M Hall <kyle@bywatersolutions.com >
1146 Tomás Cohen Arazi <tomascohen@theke.io>
1147 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1148
1149 =cut