Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Invoice.pm

   1 package OpenILS::Application::Acq::Invoice;
   2 use base qw/OpenILS::Application/;
   3 use strict; use warnings;
   4
   5 use OpenSRF::Utils::Logger qw(:logger);
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Utils::CStoreEditor q/:funcs/;
   8 use OpenILS::Application::AppUtils;
   9 use OpenILS::Event;
  10 my $U = 'OpenILS::Application::AppUtils';
  11
  12
  13 # return nothing on success, event on failure
  14 sub _prepare_fund_debit_for_inv_item {
  15     my ($debit, $item, $e) = @_;
  16
  17     $debit->fund($item->fund);
  18     $debit->amount($item->amount_paid);
  19     $debit->origin_amount($item->amount_paid);
  20
  21     # future: cache funds locally
  22     my $fund = $e->retrieve_acq_fund($item->fund) or return $e->die_event;
  23
  24     $debit->origin_currency_type($fund->currency_type);
  25     $debit->encumbrance('f');
  26     $debit->debit_type('direct_charge');
  27
  28     return;
  29 }
  30
  31 __PACKAGE__->register_method(
  32     method => 'build_invoice_api',
  33     api_name    => 'open-ils.acq.invoice.update',
  34     signature => {
  35         desc => q/Creates, updates, and deletes invoices, and related invoice entries, and invoice items/,
  36         params => [
  37             {desc => 'Authentication token', type => 'string'},
  38             {desc => q/Invoice/, type => 'number'},
  39             {desc => q/Entries.  Array of 'acqie' objects/, type => 'array'},
  40             {desc => q/Items.  Array of 'acqii' objects/, type => 'array'},
  41         ],
  42         return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
  43     }
  44 );
  45
  46
  47 sub build_invoice_impl {
  48     my ($e, $invoice, $entries, $items, $do_commit) = @_;
  49
  50     if ($invoice->isnew) {
  51         $invoice->recv_method('PPR') unless $invoice->recv_method;
  52         $invoice->recv_date('now') unless $invoice->recv_date;
  53         $e->create_acq_invoice($invoice) or return $e->die_event;
  54     } elsif ($invoice->isdeleted) {
  55         $e->delete_acq_invoice($invoice) or return $e->die_event;
  56     } else {
  57         $e->update_acq_invoice($invoice) or return $e->die_event;
  58     }
  59
  60     my $evt;
  61
  62     if ($entries) {
  63         for my $entry (@$entries) {
  64             $entry->invoice($invoice->id);
  65
  66             if ($entry->isnew) {
  67                 $e->create_acq_invoice_entry($entry) or return $e->die_event;
  68                 return $evt if $evt = uncancel_copies_as_needed($e, $entry);
  69                 return $evt if $evt = update_entry_debits($e, $entry);
  70             } elsif ($entry->isdeleted) {
  71                 # XXX Deleting entries does not recancel anything previously
  72                 # uncanceled.
  73                 return $evt if $evt = rollback_entry_debits($e, $entry);
  74                 $e->delete_acq_invoice_entry($entry) or return $e->die_event;
  75             } elsif ($entry->ischanged) {
  76                 my $orig_entry = $e->retrieve_acq_invoice_entry($entry->id) or
  77                     return $e->die_event;
  78
  79                 if ($orig_entry->amount_paid != $entry->amount_paid or
  80                     $entry->phys_item_count != $orig_entry->phys_item_count) {
  81                     return $evt if $evt = rollback_entry_debits($e,$orig_entry);
  82
  83                     # XXX Updates can only uncancel more LIDs when
  84                     # phys_item_count goes up, but cannot recancel them when
  85                     # phys_item_count goes down.
  86                     return $evt if $evt = uncancel_copies_as_needed($e, $entry);
  87
  88                     return $evt if $evt = update_entry_debits($e, $entry);
  89                 }
  90
  91                 $e->update_acq_invoice_entry($entry) or return $e->die_event;
  92             }
  93         }
  94     }
  95
  96     if ($items) {
  97         for my $item (@$items) {
  98             $item->invoice($invoice->id);
  99
 100             # future: cache item types
 101             my $item_type = $e->retrieve_acq_invoice_item_type(
 102                 $item->inv_item_type) or return $e->die_event;
 103
 104             if ($item->isnew) {
 105                 $e->create_acq_invoice_item($item) or return $e->die_event;
 106
 107
 108                 # This following complex conditional statement effecively means:
 109                 #   1) Items with item_types that are prorate are handled
 110                 #       differently.
 111                 #   2) Only items with a po_item, or which are linked to a fund
 112                 #       already, or which belong to invoices which we're trying
 113                 #       to *close* will actually go through this fund_debit
 114                 #       creation process.  In other cases, we'll consider it
 115                 #       ok for an item to remain sans fund_debit for the time
 116                 #       being.
 117
 118                 if (not $U->is_true($item_type->prorate) and
 119                     ($item->po_item or $item->fund or
 120                         $U->is_true($invoice->complete))) {
 121
 122                     my $debit;
 123                     if ($item->po_item) {
 124                         my $po_item = $e->retrieve_acq_po_item($item->po_item)
 125                             or return $e->die_event;
 126                         $debit = $e->retrieve_acq_fund_debit($po_item->fund_debit)
 127                             or return $e->die_event;
 128
 129                         if ($U->is_true($item_type->blanket)) {
 130                             # Each payment toward a blanket charge results
 131                             # in a new debit to track the payment and
 132                             # decreasing the (encumbered) amount on the
 133                             # origin po-item debit by the amount paid.
 134
 135                             $debit->amount($debit->amount - $item->amount_paid);
 136                             $e->update_acq_fund_debit($debit) or return $e->die_event;
 137                             $debit = undef;
 138                         }
 139                     }
 140
 141                     if (!$debit) {
 142                         $debit = Fieldmapper::acq::fund_debit->new;
 143                         $debit->isnew(1);
 144                     }
 145
 146                     return $evt if
 147                         $evt = _prepare_fund_debit_for_inv_item($debit, $item, $e);
 148
 149                     if ($debit->isnew) {
 150                         $e->create_acq_fund_debit($debit)
 151                             or return $e->die_event;
 152                     } else {
 153                         $e->update_acq_fund_debit($debit)
 154                             or return $e->die_event;
 155                     }
 156
 157                     $item->fund_debit($debit->id);
 158                     $e->update_acq_invoice_item($item) or return $e->die_event;
 159                 }
 160             } elsif ($item->isdeleted) {
 161                 $e->delete_acq_invoice_item($item) or return $e->die_event;
 162
 163                 if ($item->po_item and
 164                     $e->retrieve_acq_po_item($item->po_item)->fund_debit == $item->fund_debit) {
 165                     # the debit is attached to the po_item. instead of
 166                     # deleting it, roll it back to being an encumbrance.
 167                     # Note: a prorated invoice_item that points to a
 168                     # po_item could point to a different fund_debit. We
 169                     # can't go back in time to collect all the prorated
 170                     # invoice_items (nor is the caller asking us too),
 171                     # so when that happens, just delete the extraneous
 172                     # debit (in the else block).
 173                     my $debit = $e->retrieve_acq_fund_debit($item->fund_debit);
 174                     $debit->encumbrance('t');
 175                     $e->update_acq_fund_debit($debit) or return $e->die_event;
 176
 177                 } elsif ($item->fund_debit) {
 178
 179                     my $inv_debit = $e->retrieve_acq_fund_debit($item->fund_debit);
 180
 181                     if ($U->is_true($item_type->blanket)) {
 182                         # deleting a payment against a blanket charge means
 183                         # we have to re-encumber the paid amount by adding
 184                         # it back to the debit linked to the source po_item.
 185
 186                         my $po_debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
 187                         $po_debit->amount($po_debit->amount + $inv_debit->amount);
 188
 189                         $e->update_acq_fund_debit($po_debit)
 190                             or return $e->die_event;
 191                     }
 192
 193                     $e->delete_acq_fund_debit($inv_debit) or return $e->die_event;
 194                 }
 195
 196             } elsif ($item->ischanged) {
 197                 my $debit;
 198
 199                 if (!$item->fund_debit) {
 200                     # No fund_debit yet? Make one now.
 201                     $debit = Fieldmapper::acq::fund_debit->new;
 202                     $debit->isnew(1);
 203
 204                     return $evt if
 205                         $evt = _prepare_fund_debit_for_inv_item($debit, $item, $e);
 206                 } else {
 207                     $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or
 208                         return $e->die_event;
 209                 }
 210
 211                 if ($U->is_true($item_type->blanket)) {
 212                     # modifying a payment against a blanket charge means
 213                     # also modifying the amount encumbered on the source
 214                     # debit from the blanket po_item to keep things balanced.
 215
 216                     my $po_debit = $e->retrieve_acq_fund_debit(
 217                         $item->po_item->fund_debit);
 218                     my $delta = $debit->amount - $item->amount_paid;
 219                     $po_debit->amount($po_debit->amount + $delta);
 220
 221                     $e->update_acq_fund_debit($po_debit)
 222                         or return $e->die_event;
 223                 }
 224
 225
 226                 $debit->amount($item->amount_paid);
 227                 $debit->fund($item->fund);
 228
 229                 if ($debit->isnew) {
 230                     # Making a new debit, so make it and link our item to it.
 231                     $e->create_acq_fund_debit($debit) or return $e->die_event;
 232                     $item->fund_debit($e->data->id);
 233                 } else {
 234                     $e->update_acq_fund_debit($debit) or return $e->die_event;
 235                 }
 236
 237                 $e->update_acq_invoice_item($item) or return $e->die_event;
 238             }
 239         }
 240     }
 241
 242     $invoice = fetch_invoice_impl($e, $invoice->id);
 243     if ($do_commit) {
 244         $e->commit or return $e->die_event;
 245     }
 246
 247     return $invoice;
 248 }
 249
 250 sub build_invoice_api {
 251     my($self, $conn, $auth, $invoice, $entries, $items) = @_;
 252
 253     my $e = new_editor(xact => 1, authtoken=>$auth);
 254     return $e->die_event unless $e->checkauth;
 255
 256     if (not ref $invoice) {
 257         # caller only provided the ID
 258         $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event;
 259     }
 260
 261     if (not $invoice->receiver and $invoice->isnew) {
 262         $invoice->receiver($e->requestor->ws_ou);
 263     }
 264
 265     return $e->die_event unless
 266         $e->allowed('CREATE_INVOICE', $invoice->receiver);
 267
 268     return build_invoice_impl($e, $invoice, $entries, $items, 1);
 269 }
 270
 271
 272 sub rollback_entry_debits {
 273     my($e, $entry) = @_;
 274     my $debits = find_entry_debits($e, $entry, 'f', entry_amount_per_item($entry));
 275     my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem) or return $e->die_event;
 276
 277     for my $debit (@$debits) {
 278         # revert to the original estimated amount re-encumber
 279         $debit->encumbrance('t');
 280         $debit->amount($lineitem->estimated_unit_price());
 281         $e->update_acq_fund_debit($debit) or return $e->die_event;
 282         update_copy_cost($e, $debit) or return $e->die_event; # clear the cost
 283     }
 284
 285     return undef;
 286 }
 287
 288 sub update_entry_debits {
 289     my($e, $entry) = @_;
 290
 291     my $debits = find_entry_debits($e, $entry, 't');
 292     return undef unless @$debits;
 293
 294     if($entry->phys_item_count > @$debits) {
 295         $e->rollback;
 296         # We can't invoice for more items than we have debits for
 297         return OpenILS::Event->new(
 298             'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS',
 299             payload => {entry => $entry->id});
 300     }
 301
 302     for my $debit (@$debits) {
 303         my $amount = entry_amount_per_item($entry);
 304         $debit->amount($amount);
 305         $debit->encumbrance('f');
 306         $e->update_acq_fund_debit($debit) or return $e->die_event;
 307
 308         # TODO: this does not reflect ancillary charges, like taxes, etc.
 309         # We may need a way to indicate whether the amount attached to an
 310         # invoice_item should be prorated and included in the copy cost.
 311         # Note that acq.invoice_item_type.prorate does not necessarily
 312         # mean a charge should be included in the copy price, only that
 313         # it should spread accross funds.
 314         update_copy_cost($e, $debit, $amount) or return $e->die_event;
 315     }
 316
 317     return undef;
 318 }
 319
 320 # This was originally done only for EDI invoices, but needs added to the
 321 # manual invoice-entering process for consistency's sake.
 322 sub uncancel_copies_as_needed {
 323     my ($e, $entry) = @_;
 324
 325     return unless $entry->lineitem and $entry->phys_item_count;
 326
 327     my $li = $e->retrieve_acq_lineitem($entry->lineitem) or
 328         return $e->die_event;
 329
 330     # if an invoiced lineitem is marked as cancelled
 331     # (e.g. back-order), invoicing the lineitem implies
 332     # we need to un-cancel it
 333
 334     # collect the LIDs, starting with those that are
 335     # not cancelled, followed by those that have keep-debits cancel_reasons,
 336     # followed by non-keep-debit cancel reasons.
 337
 338     my $lid_ids = $e->json_query({
 339         select => {acqlid => ['id']},
 340         from => {
 341             acqlid => {
 342                 acqcr => {type => 'left'},
 343                 acqfdeb => {type => 'left'}
 344             }
 345         },
 346         where => {
 347             '+acqlid' => {lineitem => $li->id},
 348             '+acqfdeb' => {encumbrance => 't'}  # not-yet invoiced copies
 349         },
 350         order_by => [{
 351             class => 'acqcr',
 352             field => 'keep_debits',
 353             direction => 'desc'
 354         }],
 355         limit => $entry->phys_item_count    # crucial
 356     });
 357
 358     for my $lid_id (map {$_->{id}} @$lid_ids) {
 359         my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
 360         next unless $lid->cancel_reason;
 361
 362         $logger->info(
 363             "un-cancelling invoice lineitem " . $li->id .
 364             " lineitem_detail " . $lid_id
 365         );
 366         $lid->clear_cancel_reason;
 367         return $e->die_event unless $e->update_acq_lineitem_detail($lid);
 368     }
 369
 370     $li->clear_cancel_reason;
 371     $li->state("on-order") if $li->state eq "cancelled";    # sic
 372     $li->edit_time("now");
 373
 374     unless ($e->update_acq_lineitem($li)) {
 375         my $evt = $e->die_event;
 376         $logger->error("couldn't clear li cancel reason: ". $evt->{textcode});
 377         return $evt;
 378     }
 379
 380     return;
 381 }
 382
 383
 384 # update the linked copy to reflect the amount paid for the item
 385 # returns true on success, false on error
 386 sub update_copy_cost {
 387     my ($e, $debit, $amount) = @_;
 388
 389     my $lid = $e->search_acq_lineitem_detail([
 390         {fund_debit => $debit->id},
 391         {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}}
 392     ])->[0];
 393
 394     if($lid and my $copy = $lid->eg_copy_id) {
 395         defined $amount and $copy->cost($amount) or $copy->clear_cost;
 396
 397         # XXX It would be nice to have a way to record that a copy was
 398         # updated by a non-user mechanism, like EDI, but we don't have
 399         # a clear way to do that here.
 400         if ($e->requestor) {
 401             $copy->editor($e->requestor->id);
 402             $copy->edit_date('now');
 403         }
 404
 405         $e->update_asset_copy($copy) or return 0;
 406     }
 407
 408     return 1;
 409 }
 410
 411
 412 sub entry_amount_per_item {
 413     my $entry = shift;
 414     return $entry->amount_paid if $U->is_true($entry->billed_per_item);
 415     return 0 if $entry->phys_item_count == 0;
 416     return $entry->amount_paid / $entry->phys_item_count;
 417 }
 418
 419 sub easy_money { # TODO XXX replace with something from a library
 420     my ($val) = @_;
 421
 422     my $rounded = int($val * 100) / 100.0;
 423     if ($rounded == $val) {
 424         return sprintf("%.02f", $val);
 425     } else {
 426         return sprintf("%g", $val);
 427     }
 428 }
 429
 430 # 0 on failure (caller should call $e->die_event), array on success
 431 sub amounts_spent_per_fund {
 432     my ($e, $inv_id) = @_;
 433
 434     my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or
 435         return 0;
 436
 437     my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or
 438         return 0;
 439
 440     my %totals_by_fund;
 441     foreach my $entry (@$entries) {
 442         my $debits = find_entry_debits($e, $entry, "f") or return 0;
 443         foreach (@$debits) {
 444             $totals_by_fund{$_->fund} ||= 0.0;
 445             $totals_by_fund{$_->fund} += $_->amount;
 446         }
 447     }
 448
 449     foreach my $item (@$items) {
 450         next unless $item->fund and $item->amount_paid;
 451         $totals_by_fund{$item->fund} ||= 0.0;
 452         $totals_by_fund{$item->fund} += $item->amount_paid;
 453     }
 454
 455     my @totals;
 456     foreach my $fund_id (keys %totals_by_fund) {
 457         my $fund = $e->retrieve_acq_fund($fund_id) or return 0;
 458         push @totals, {
 459             "fund" => $fund->to_bare_hash,
 460             "total" => easy_money($totals_by_fund{$fund_id})
 461         };
 462     }
 463
 464     return \@totals;
 465 }
 466
 467 # there is no direct link between invoice_entry and fund debits.
 468 # when we need to retrieve the related debits, we have to do some searching
 469 sub find_entry_debits {
 470     my($e, $entry, $encumbrance, $amount) = @_;
 471
 472     my $query = {
 473         select => {acqfdeb => ['id']},
 474         from => {
 475             acqfdeb => {
 476                 acqlid => {
 477                     join => {
 478                         jub =>  {
 479                             join => {
 480                                 acqie => {
 481                                     filter => {id => $entry->id}
 482                                 }
 483                             }
 484                         }
 485                     }
 486                 }
 487             }
 488         },
 489         where => {'+acqfdeb' => {encumbrance => $encumbrance}},
 490         order_by => {'acqlid' => ['recv_time']}, # un-received items will sort to the end
 491         limit => $entry->phys_item_count
 492     };
 493
 494     $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
 495
 496     my $debits = $e->json_query($query);
 497     my $debit_ids = [map { $_->{id} } @$debits];
 498     return (@$debit_ids) ? $e->search_acq_fund_debit({id => $debit_ids}) : [];
 499 }
 500
 501
 502 __PACKAGE__->register_method(
 503     method => 'build_invoice_api',
 504     api_name    => 'open-ils.acq.invoice.retrieve',
 505     authoritative => 1,
 506     signature => {
 507         desc => q/Creates a new stub invoice/,
 508         params => [
 509             {desc => 'Authentication token', type => 'string'},
 510             {desc => q/Invoice Id/, type => 'number'},
 511         ],
 512         return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 513     }
 514 );
 515
 516
 517 sub fetch_invoice_api {
 518     my($self, $conn, $auth, $invoice_id, $options) = @_;
 519
 520     my $e = new_editor(authtoken=>$auth);
 521     return $e->event unless $e->checkauth;
 522
 523     my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
 524         return $e->event;
 525     return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
 526
 527     return $invoice;
 528 }
 529
 530 sub fetch_invoice_impl {
 531     my ($e, $invoice_id, $options) = @_;
 532
 533     $options ||= {};
 534
 535     my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
 536         $invoice_id,
 537         {
 538             "flesh" => 6,
 539             "flesh_fields" => {
 540                 "acqinv" => ["entries", "items"],
 541                 "acqii" => ["fund_debit", "purchase_order", "po_item"]
 542             }
 543         }
 544     ];
 545
 546     return $e->retrieve_acq_invoice($args);
 547 }
 548
 549 __PACKAGE__->register_method(
 550     method => 'prorate_invoice',
 551     api_name    => 'open-ils.acq.invoice.apply_prorate',
 552     signature => {
 553         desc => q/
 554             For all invoice items that have the prorate flag set to true, this will create the necessary
 555             additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
 556         /,
 557         params => [
 558             {desc => 'Authentication token', type => 'string'},
 559             {desc => q/Invoice Id/, type => 'number'},
 560         ],
 561         return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 562     }
 563 );
 564
 565
 566 sub prorate_invoice {
 567     my($self, $conn, $auth, $invoice_id) = @_;
 568
 569     my $e = new_editor(xact => 1, authtoken=>$auth);
 570     return $e->die_event unless $e->checkauth;
 571
 572     my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
 573     return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
 574
 575     my @lid_debits;
 576     push(@lid_debits, @{find_entry_debits($e, $_, 'f', entry_amount_per_item($_))}) for @{$invoice->entries};
 577
 578     my $inv_items = $e->search_acq_invoice_item([
 579         {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}},
 580         {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}}
 581     ]) or return $e->die_event;
 582
 583     my @item_debits = map { $_->fund_debit } @$inv_items;
 584
 585     my %fund_totals;
 586     my $total_entry_paid = 0;
 587     for my $debit (@lid_debits, @item_debits) {
 588         $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
 589         $fund_totals{$debit->fund} += $debit->amount;
 590         $total_entry_paid += $debit->amount;
 591     }
 592
 593     $logger->info("invoice: prorating against invoice amount $total_entry_paid");
 594
 595     for my $item (@{$invoice->items}) {
 596
 597         next if $item->fund_debit; # item has already been processed
 598
 599         # future: cache item types locally
 600         my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
 601         next unless $U->is_true($item_type->prorate);
 602
 603         # Prorate charges across applicable funds
 604         my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
 605         my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
 606         my $first_round = 1;
 607         my $largest_debit;
 608         my $largest_item;
 609         my $total_debited = 0;
 610         my $total_costed = 0;
 611
 612         for my $fund_id (keys %fund_totals) {
 613
 614             my $spent_for_fund = $fund_totals{$fund_id};
 615             next unless $spent_for_fund > 0;
 616
 617             my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
 618             my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
 619             $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
 620
 621             my $debit;
 622             if($first_round and $item->po_item) {
 623                 # if this item is the result of a PO item, repurpose the original debit
 624                 # for the first chunk of the prorated amount
 625                 $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
 626             } else {
 627                 $debit = Fieldmapper::acq::fund_debit->new;
 628                 $debit->isnew(1);
 629             }
 630
 631             $debit->fund($fund_id);
 632             $debit->amount($prorated_amount);
 633             $debit->origin_amount($prorated_amount);
 634             $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
 635             $debit->encumbrance('f');
 636             $debit->debit_type('prorated_charge');
 637
 638             if($debit->isnew) {
 639                 $e->create_acq_fund_debit($debit) or return $e->die_event;
 640             } else {
 641                 $e->update_acq_fund_debit($debit) or return $e->die_event;
 642             }
 643
 644             $total_debited += $prorated_amount;
 645             $total_costed += $prorated_cost;
 646             $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
 647
 648             if($first_round) {
 649
 650                 # re-purpose the original invoice_item for the first prorated amount
 651                 $item->fund($fund_id);
 652                 $item->fund_debit($debit->id);
 653                 $item->amount_paid($prorated_amount);
 654                 $item->cost_billed($prorated_cost);
 655                 $e->update_acq_invoice_item($item) or return $e->die_event;
 656                 $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 657
 658             } else {
 659
 660                 # for subsequent prorated amounts, create a new invoice_item
 661                 my $new_item = $item->clone;
 662                 $new_item->clear_id;
 663                 $new_item->fund($fund_id);
 664                 $new_item->fund_debit($debit->id);
 665                 $new_item->amount_paid($prorated_amount);
 666                 $new_item->cost_billed($prorated_cost);
 667                 $e->create_acq_invoice_item($new_item) or return $e->die_event;
 668                 $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 669             }
 670
 671             $first_round = 0;
 672         }
 673
 674         # make sure the percentages didn't leave a small sliver of money over/under-debited
 675         # if so, tweak the largest debit to smooth out the difference
 676         if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
 677
 678             my $paid_diff = $full_item_paid - $total_debited;
 679             my $cost_diff = $full_item_cost - $total_debited;
 680             $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
 681             my $new_paid = $largest_item->amount_paid + $paid_diff;
 682             my $new_cost = $largest_item->cost_billed + $cost_diff;
 683
 684             $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
 685             $largest_debit->amount($new_paid);
 686             $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
 687
 688             $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
 689             $largest_item->amount_paid($new_paid);
 690             $largest_item->cost_billed($new_cost);
 691
 692             $e->update_acq_invoice_item($largest_item) or return $e->die_event;
 693         }
 694     }
 695
 696     $invoice = fetch_invoice_impl($e, $invoice_id);
 697     $e->commit;
 698
 699     return $invoice;
 700 }
 701
 702
 703 __PACKAGE__->register_method(
 704     method      => "print_html_invoice",
 705     api_name    => "open-ils.acq.invoice.print.html",
 706     stream      => 1,
 707     signature   => {
 708         desc    => "Retrieve printable HTML vouchers for each given invoice",
 709         params => [
 710             {desc => "Authentication token", type => "string"},
 711             {desc => "Invoice ID or a list of them", type => "mixed"},
 712         ],
 713         return => {
 714             desc => q{One A/T event containing a printable HTML voucher for
 715                 each given invoice},
 716             type => "object", class => "atev"}
 717     }
 718 );
 719
 720
 721 sub print_html_invoice {
 722     my ($self, $conn, $auth, $id_list) = @_;
 723
 724     my $e = new_editor("authtoken" => $auth);
 725     return $e->die_event unless $e->checkauth;
 726
 727     $id_list = [$id_list] unless ref $id_list;
 728
 729     my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
 730         return $e->die_event;
 731
 732     foreach my $invoice (@$invoices) {
 733         return $e->die_event unless
 734             $e->allowed("VIEW_INVOICE", $invoice->receiver);
 735
 736         my $amounts = amounts_spent_per_fund($e, $invoice->id) or
 737             return $e->die_event;
 738
 739         $conn->respond(
 740             $U->fire_object_event(
 741                 undef, "format.acqinv.html", $invoice, $invoice->receiver,
 742                 "print-on-demand", $amounts
 743             )
 744         );
 745     }
 746
 747     $e->disconnect;
 748     undef;
 749 }
 750
 751 1;