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