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     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     return $self;
 704 }
 705
 706 =head3 payout
 707
 708   $credit_accountline->payout(
 709     {
 710         payout_type => $payout_type,
 711         register_id => $register_id,
 712         staff_id    => $staff_id,
 713         interface   => 'intranet',
 714         amount      => $amount
 715     }
 716   );
 717
 718 Used to 'pay out' a credit to a user.
 719
 720 Payout type may be one of any existing payment types
 721
 722 Returns the payout debit line that is created via this transaction.
 723
 724 =cut
 725
 726 sub payout {
 727     my ( $self, $params ) = @_;
 728
 729     # Make sure it is a credit we are paying out
 730     unless ( $self->is_credit ) {
 731         Koha::Exceptions::Account::IsNotCredit->throw(
 732             error => 'Account line ' . $self->id . ' is not a credit' );
 733     }
 734
 735     # Check for mandatory parameters
 736     my @mandatory =
 737       ( 'interface', 'staff_id', 'branch', 'payout_type', 'amount' );
 738     for my $param (@mandatory) {
 739         unless ( defined( $params->{$param} ) ) {
 740             Koha::Exceptions::MissingParameter->throw(
 741                 error => "The $param parameter is mandatory" );
 742         }
 743     }
 744
 745     # Make sure there is outstanding credit to pay out
 746     my $outstanding = -1 * $self->amountoutstanding;
 747     my $amount =
 748       $params->{amount} ? $params->{amount} : $outstanding;
 749     Koha::Exceptions::Account::AmountNotPositive->throw(
 750         error => 'Payout amount passed is not positive' )
 751       unless ( $amount > 0 );
 752     Koha::Exceptions::ParameterTooHigh->throw(
 753         error => "Amount to payout ($amount) is higher than amountoutstanding ($outstanding)" )
 754       unless ($outstanding >= $amount );
 755
 756     # Make sure we record the cash register for cash transactions
 757     Koha::Exceptions::Account::RegisterRequired->throw()
 758       if ( C4::Context->preference("UseCashRegisters")
 759         && defined( $params->{payout_type} )
 760         && ( $params->{payout_type} eq 'CASH' || $params->{payout_type} eq 'SIP00' )
 761         && !defined( $params->{cash_register} ) );
 762
 763     my $payout;
 764     $self->_result->result_source->schema->txn_do(
 765         sub {
 766
 767             # A 'payout' is a 'debit'
 768             $payout = Koha::Account::Line->new(
 769                 {
 770                     date              => \'NOW()',
 771                     amount            => $amount,
 772                     debit_type_code   => 'PAYOUT',
 773                     payment_type      => $params->{payout_type},
 774                     amountoutstanding => $amount,
 775                     manager_id        => $params->{staff_id},
 776                     borrowernumber    => $self->borrowernumber,
 777                     interface         => $params->{interface},
 778                     branchcode        => $params->{branch},
 779                     register_id       => $params->{cash_register}
 780                 }
 781             )->store();
 782
 783             my $payout_offset = Koha::Account::Offset->new(
 784                 {
 785                     debit_id => $payout->accountlines_id,
 786                     type     => 'CREATE',
 787                     amount   => $amount
 788                 }
 789             )->store();
 790
 791             $self->apply( { debits => [$payout] } );
 792             $self->status('PAID')->store;
 793         }
 794     );
 795
 796     $payout->discard_changes;
 797     return $payout;
 798 }
 799
 800 =head3 adjust
 801
 802 This method allows updating a debit or credit on a patron's account
 803
 804     $account_line->adjust(
 805         {
 806             amount    => $amount,
 807             type      => $update_type,
 808             interface => $interface
 809         }
 810     );
 811
 812 $update_type can be any of:
 813   - overdue_update
 814
 815 Authors Note: The intention here is that this method is only used
 816 to adjust accountlines where the final amount is not yet known/fixed.
 817 Incrementing fines are the only existing case at the time of writing,
 818 all other forms of 'adjustment' should be recorded as distinct credits
 819 or debits and applied, via an offset, to the corresponding debit or credit.
 820
 821 =cut
 822
 823 sub adjust {
 824     my ( $self, $params ) = @_;
 825
 826     my $amount       = $params->{amount};
 827     my $update_type  = $params->{type};
 828     my $interface    = $params->{interface};
 829
 830     unless ( exists($Koha::Account::Line::allowed_update->{$update_type}) ) {
 831         Koha::Exceptions::Account::UnrecognisedType->throw(
 832             error => 'Update type not recognised'
 833         );
 834     }
 835
 836     my $debit_type_code = $self->debit_type_code;
 837     my $account_status  = $self->status;
 838     unless (
 839         (
 840             exists(
 841                 $Koha::Account::Line::allowed_update->{$update_type}
 842                   ->{$debit_type_code}
 843             )
 844             && ( $Koha::Account::Line::allowed_update->{$update_type}
 845                 ->{$debit_type_code} eq $account_status )
 846         )
 847       )
 848     {
 849         Koha::Exceptions::Account::UnrecognisedType->throw(
 850             error => 'Update type not allowed on this debit_type' );
 851     }
 852
 853     my $schema = Koha::Database->new->schema;
 854
 855     $schema->txn_do(
 856         sub {
 857
 858             my $amount_before             = $self->amount;
 859             my $amount_outstanding_before = $self->amountoutstanding;
 860             my $difference                = $amount - $amount_before;
 861             my $new_outstanding           = $amount_outstanding_before + $difference;
 862
 863             my $offset_type = $debit_type_code;
 864             $offset_type .= ( $difference > 0 ) ? "_INCREASE" : "_DECREASE";
 865
 866             # Catch cases that require patron refunds
 867             if ( $new_outstanding < 0 ) {
 868                 my $account =
 869                   Koha::Patrons->find( $self->borrowernumber )->account;
 870                 my $credit = $account->add_credit(
 871                     {
 872                         amount      => $new_outstanding * -1,
 873                         type        => 'OVERPAYMENT',
 874                         interface   => $interface,
 875                         ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : ()),
 876                     }
 877                 );
 878                 $new_outstanding = 0;
 879             }
 880
 881             # Update the account line
 882             $self->set(
 883                 {
 884                     date              => \'NOW()',
 885                     amount            => $amount,
 886                     amountoutstanding => $new_outstanding,
 887                 }
 888             )->store();
 889
 890             # Record the account offset
 891             my $account_offset = Koha::Account::Offset->new(
 892                 {
 893                     debit_id => $self->id,
 894                     type     => $offset_type,
 895                     amount   => $difference
 896                 }
 897             )->store();
 898
 899             if ( C4::Context->preference("FinesLog") ) {
 900                 logaction(
 901                     "FINES", 'UPDATE', #undef becomes UPDATE in UpdateFine
 902                     $self->borrowernumber,
 903                     Dumper(
 904                         {   action            => $update_type,
 905                             borrowernumber    => $self->borrowernumber,
 906                             amount            => $amount,
 907                             description       => undef,
 908                             amountoutstanding => $new_outstanding,
 909                             debit_type_code   => $self->debit_type_code,
 910                             note              => undef,
 911                             itemnumber        => $self->itemnumber,
 912                             manager_id        => undef,
 913                         }
 914                     )
 915                 ) if ( $update_type eq 'overdue_update' );
 916             }
 917         }
 918     );
 919
 920     return $self;
 921 }
 922
 923 =head3 is_credit
 924
 925     my $bool = $line->is_credit;
 926
 927 =cut
 928
 929 sub is_credit {
 930     my ($self) = @_;
 931
 932     return defined $self->credit_type_code;
 933 }
 934
 935 =head3 is_debit
 936
 937     my $bool = $line->is_debit;
 938
 939 =cut
 940
 941 sub is_debit {
 942     my ($self) = @_;
 943
 944     return !$self->is_credit;
 945 }
 946
 947 =head3 to_api_mapping
 948
 949 This method returns the mapping for representing a Koha::Account::Line object
 950 on the API.
 951
 952 =cut
 953
 954 sub to_api_mapping {
 955     return {
 956         accountlines_id   => 'account_line_id',
 957         credit_number     => undef,
 958         credit_type_code  => 'credit_type',
 959         debit_type_code   => 'debit_type',
 960         amountoutstanding => 'amount_outstanding',
 961         borrowernumber    => 'patron_id',
 962         branchcode        => 'library_id',
 963         issue_id          => 'checkout_id',
 964         itemnumber        => 'item_id',
 965         manager_id        => 'user_id',
 966         note              => 'internal_note',
 967         register_id       => 'cash_register_id',
 968     };
 969
 970 }
 971
 972 =head3 is_renewable
 973
 974     my $bool = $line->is_renewable;
 975
 976 =cut
 977
 978 sub is_renewable {
 979     my ($self) = @_;
 980
 981     return (
 982         $self->amountoutstanding == 0 &&
 983         $self->debit_type_code &&
 984         $self->debit_type_code eq 'OVERDUE' &&
 985         $self->status &&
 986         $self->status eq 'UNRETURNED' &&
 987         $self->item &&
 988         $self->patron
 989     ) ? 1 : 0;
 990 }
 991
 992 =head3 renew_item
 993
 994     my $renew_result = $line->renew_item;
 995
 996 Conditionally attempt to renew an item and return the outcome. This is
 997 as a consequence of the fine on an item being fully paid off.
 998 Caller must call is_renewable before.
 999
1000 =cut
1001
1002 sub renew_item {
1003     my ($self, $params) = @_;
1004
1005     my $outcome = {};
1006
1007     # We want to reject the call to renew if:
1008     # - The RenewAccruingItemWhenPaid syspref is off
1009     # OR
1010     # - The RenewAccruingItemInOpac syspref is off
1011     # - There is an interface param passed and it's value is 'opac'
1012
1013     if (
1014         !C4::Context->preference('RenewAccruingItemWhenPaid') ||
1015         (
1016             !C4::Context->preference('RenewAccruingItemInOpac') &&
1017             $params->{interface} &&
1018             $params->{interface} eq 'opac'
1019         )
1020     ) {
1021         return;
1022     }
1023
1024     my $itemnumber = $self->item->itemnumber;
1025     my $borrowernumber = $self->patron->borrowernumber;
1026     my ( $can_renew, $error ) = C4::Circulation::CanBookBeRenewed(
1027         $borrowernumber,
1028         $itemnumber
1029     );
1030     if ( $can_renew ) {
1031         my $due_date = C4::Circulation::AddRenewal(
1032             $borrowernumber,
1033             $itemnumber,
1034             $self->{branchcode},
1035             undef,
1036             undef,
1037             undef,
1038             0
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