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