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