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, $inv_closing) = @_;
  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($inv_closing ? 'f' : 't');
  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             {desc => q/Finalize PO's.  Array of 'acqpo' ID's/, type => 'array'},
  42         ],
  43         return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
  44     }
  45 );
  46
  47
  48 sub build_invoice_impl {
  49     my ($e, $invoice, $entries, $items, $do_commit, $finalize_pos) = @_;
  50
  51     $finalize_pos ||= [];
  52
  53     my $inv_closing = 0;
  54     my $inv_reopening = 0;
  55
  56     if ($invoice->isnew) {
  57         $invoice->recv_method('PPR') unless $invoice->recv_method;
  58         $invoice->recv_date('now') unless $invoice->recv_date;
  59         $inv_closing = $U->is_true($invoice->complete);
  60         $e->create_acq_invoice($invoice) or return $e->die_event;
  61     } elsif ($invoice->isdeleted) {
  62         $e->delete_acq_invoice($invoice) or return $e->die_event;
  63     } else {
  64         my $orig_inv = $e->retrieve_acq_invoice($invoice->id)
  65             or return $e->die_event;
  66
  67         $inv_closing = (
  68             !$U->is_true($orig_inv->complete) &&
  69             $U->is_true($invoice->complete));
  70
  71         $inv_reopening = (
  72             $U->is_true($orig_inv->complete) &&
  73             !$U->is_true($invoice->complete));
  74
  75         $e->update_acq_invoice($invoice) or return $e->die_event;
  76     }
  77
  78     my $evt;
  79
  80     if ($entries) {
  81         for my $entry (@$entries) {
  82             $entry->invoice($invoice->id);
  83
  84             if ($entry->isnew) {
  85                 $e->create_acq_invoice_entry($entry) or return $e->die_event;
  86                 return $evt if $evt = uncancel_copies_as_needed($e, $entry);
  87                 return $evt if $evt = update_entry_debits(
  88                     $e, $entry, 'unlinked', $inv_closing, $inv_reopening);
  89             } elsif ($entry->isdeleted) {
  90                 # XXX Deleting entries does not recancel anything previously
  91                 # uncanceled.
  92                 return $evt if $evt = rollback_entry_debits($e, $entry);
  93                 $e->delete_acq_invoice_entry($entry) or return $e->die_event;
  94             } elsif ($entry->ischanged) {
  95                 my $orig_entry = $e->retrieve_acq_invoice_entry($entry->id) or
  96                     return $e->die_event;
  97
  98                 if ($orig_entry->amount_paid != $entry->amount_paid or
  99                     $entry->phys_item_count != $orig_entry->phys_item_count) {
 100                     return $evt if $evt = rollback_entry_debits(
 101                         $e, $orig_entry, $orig_entry);
 102
 103                     # XXX Updates can only uncancel more LIDs when
 104                     # phys_item_count goes up, but cannot recancel them when
 105                     # phys_item_count goes down.
 106                     return $evt if $evt = uncancel_copies_as_needed($e, $entry);
 107
 108                     # debits were rolled back (encumbrance=t) above, so now
 109                     # search for un-invoiced, potentially linked debits
 110                     # to (re-) invoice.
 111                     return $evt if $evt = update_entry_debits(
 112                         $e, $entry, 'all', $inv_closing, $inv_reopening);
 113                 }
 114
 115                 $e->update_acq_invoice_entry($entry) or return $e->die_event;
 116             }
 117         }
 118     }
 119
 120     if ($items) {
 121         for my $item (@$items) {
 122             $item->invoice($invoice->id);
 123
 124             # future: cache item types
 125             my $item_type = $e->retrieve_acq_invoice_item_type(
 126                 $item->inv_item_type) or return $e->die_event;
 127
 128             if ($item->isnew) {
 129                 $e->create_acq_invoice_item($item) or return $e->die_event;
 130
 131
 132                 # This following complex conditional statement effecively means:
 133                 #   1) Items with item_types that are prorate are handled
 134                 #       differently.
 135                 #   2) Only items with a po_item, or which are linked to a fund
 136                 #       already, or which belong to invoices which we're trying
 137                 #       to *close* will actually go through this fund_debit
 138                 #       creation process.  In other cases, we'll consider it
 139                 #       ok for an item to remain sans fund_debit for the time
 140                 #       being.
 141
 142                 if (not $U->is_true($item_type->prorate) and
 143                     ($item->po_item or $item->fund or
 144                         $U->is_true($invoice->complete))) {
 145
 146                     my $debit;
 147                     if ($item->po_item) {
 148                         my $po_item = $e->retrieve_acq_po_item($item->po_item)
 149                             or return $e->die_event;
 150                         $debit = $e->retrieve_acq_fund_debit($po_item->fund_debit)
 151                             or return $e->die_event;
 152
 153                         if ($U->is_true($item_type->blanket)) {
 154                             # Each payment toward a blanket charge results
 155                             # in a new debit to track the payment and a
 156                             # decrease in the original encumbrance by
 157                             # the amount paid on this invoice item
 158                             $debit->amount($debit->amount - $item->amount_paid);
 159                             $e->update_acq_fund_debit($debit) or return $e->die_event;
 160                             $debit = undef; # new debit created below
 161                         }
 162                     }
 163
 164                     if (!$debit) {
 165                         $debit = Fieldmapper::acq::fund_debit->new;
 166                         $debit->isnew(1);
 167                     }
 168
 169                     return $evt if $evt = _prepare_fund_debit_for_inv_item(
 170                         $debit, $item, $e, $inv_closing);
 171
 172                     if ($debit->isnew) {
 173                         $e->create_acq_fund_debit($debit)
 174                             or return $e->die_event;
 175                     } else {
 176                         $e->update_acq_fund_debit($debit)
 177                             or return $e->die_event;
 178                     }
 179
 180                     $item->fund_debit($debit->id);
 181                     $e->update_acq_invoice_item($item) or return $e->die_event;
 182                 }
 183             } elsif ($item->isdeleted) {
 184                 $e->delete_acq_invoice_item($item) or return $e->die_event;
 185
 186                 if ($item->po_item and
 187                     $e->retrieve_acq_po_item($item->po_item)->fund_debit == $item->fund_debit) {
 188                     # the debit is attached to the po_item. instead of
 189                     # deleting it, roll it back to being an encumbrance.
 190                     # Note: a prorated invoice_item that points to a
 191                     # po_item could point to a different fund_debit. We
 192                     # can't go back in time to collect all the prorated
 193                     # invoice_items (nor is the caller asking us too),
 194                     # so when that happens, just delete the extraneous
 195                     # debit (in the else block).
 196                     my $debit = $e->retrieve_acq_fund_debit($item->fund_debit);
 197                     if (!$U->us_true($debit->encumbrance)) {
 198                         $debit->encumbrance('t');
 199                         $e->update_acq_fund_debit($debit)
 200                             or return $e->die_event;
 201                     }
 202
 203                 } elsif ($item->fund_debit) {
 204
 205                     my $inv_debit = $e->retrieve_acq_fund_debit($item->fund_debit);
 206
 207                     if ($U->is_true($item_type->blanket)) {
 208                         # deleting a payment against a blanket charge means
 209                         # we have to re-encumber the paid amount by adding
 210                         # it back to the debit linked to the source po_item.
 211
 212                         my $po_debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
 213                         $po_debit->amount($po_debit->amount + $inv_debit->amount);
 214
 215                         $e->update_acq_fund_debit($po_debit)
 216                             or return $e->die_event;
 217                     }
 218
 219                     $e->delete_acq_fund_debit($inv_debit) or return $e->die_event;
 220                 }
 221
 222             } elsif ($item->ischanged) {
 223                 my $debit;
 224
 225                 if (!$item->fund_debit) {
 226                     # No fund_debit yet? Make one now.
 227                     $debit = Fieldmapper::acq::fund_debit->new;
 228                     $debit->isnew(1);
 229
 230                     return $evt if
 231                         $evt = _prepare_fund_debit_for_inv_item(
 232                             $debit, $item, $e, $inv_closing);
 233                 } else {
 234                     $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or
 235                         return $e->die_event;
 236                 }
 237
 238                 if ($U->is_true($item_type->blanket)) {
 239                     # modifying a payment against a blanket charge means
 240                     # modifying the amount encumbered on the source debit
 241                     # by the same (but opposite) amount.
 242
 243                     my $po_debit = $e->retrieve_acq_fund_debit(
 244                         $item->po_item->fund_debit);
 245
 246                     my $delta = $debit->amount - $item->amount_paid;
 247                     $po_debit->amount($po_debit->amount + $delta);
 248                     $e->update_acq_fund_debit($po_debit) or return $e->die_event;
 249                 }
 250
 251
 252                 $debit->amount($item->amount_paid);
 253                 $debit->fund($item->fund);
 254
 255                 if ($debit->isnew) {
 256                     # Making a new debit, so make it and link our item to it.
 257                     $e->create_acq_fund_debit($debit) or return $e->die_event;
 258                     $item->fund_debit($e->data->id);
 259                 } else {
 260                     $e->update_acq_fund_debit($debit) or return $e->die_event;
 261                 }
 262
 263                 $e->update_acq_invoice_item($item) or return $e->die_event;
 264             }
 265         }
 266     }
 267
 268     for my $po_id (@$finalize_pos) {
 269         my $po = $e->retrieve_acq_purchase_order($po_id)
 270             or return $e->die_event;
 271
 272         my $evt = finalize_blanket_po($e, $po);
 273         return $evt if $evt;
 274     }
 275
 276     $invoice = fetch_invoice_impl($e, $invoice->id);
 277
 278     # entries and items processed above may not represent every item or
 279     # entry in the invoice.  This will synchronize any remaining debits.
 280     if ($inv_closing || $inv_reopening) {
 281
 282         # inv_closing=false implies inv_reopening=true
 283         $evt = handle_invoice_state_change($e, $invoice, $inv_closing);
 284         return $evt if $evt;
 285
 286         $invoice = fetch_invoice_impl($e, $invoice->id);
 287     }
 288
 289     if ($do_commit) {
 290         $e->commit or return $e->die_event;
 291     }
 292
 293     return $invoice;
 294 }
 295
 296 # When an invoice opens or closes, ensure all linked debits match
 297 # the open/close state of the invoice.
 298 # If $closing is false, code assumes the invoice is reopening.
 299 sub handle_invoice_state_change {
 300     my ($e, $invoice, $closing) = @_;
 301
 302     my $enc_find = $closing ? 't' : 'f'; # debits to process
 303     my $enc_set  = $closing ? 'f' : 't'; # new encumbrance value
 304
 305     my @debits;
 306     for my $entry (@{$invoice->entries}) {
 307         push(@debits, @{find_linked_entry_debits($e, $entry, $enc_find)});
 308     }
 309
 310     for my $item (@{$invoice->items}) {
 311         push(@debits, $item->fund_debit) if
 312             $item->fund_debit &&
 313             $item->fund_debit->encumbrance eq $enc_find;
 314     }
 315
 316     # udpate all linked debits to match the state of the invoice
 317     for my $debit (@debits) {
 318         $debit->encumbrance($enc_set);
 319         $e->update_acq_fund_debit($debit) or return $e->die_event;
 320     }
 321
 322     return undef;
 323 }
 324
 325 sub build_invoice_api {
 326     my($self, $conn, $auth, $invoice, $entries, $items, $finalize_pos) = @_;
 327
 328     my $e = new_editor(xact => 1, authtoken=>$auth);
 329     return $e->die_event unless $e->checkauth;
 330
 331     if (not ref $invoice) {
 332         # caller only provided the ID
 333         $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event;
 334     }
 335
 336     if (not $invoice->receiver and $invoice->isnew) {
 337         $invoice->receiver($e->requestor->ws_ou);
 338     }
 339
 340     return $e->die_event unless
 341         $e->allowed('CREATE_INVOICE', $invoice->receiver);
 342
 343     return build_invoice_impl($e, $invoice, $entries, $items, 1, $finalize_pos);
 344 }
 345
 346
 347 # 1. set encumbrance=true
 348 # 2. unlink debit entries.
 349 sub rollback_entry_debits {
 350     my($e, $entry, $orig_entry) = @_;
 351
 352     # when modifying an entry, roll back all debits that were
 353     # affected given the previous state of the entry.
 354     my $need_count = $orig_entry ?
 355         $orig_entry->phys_item_count : $entry->phys_item_count;
 356
 357     # Un-link all linked debits when rolling back
 358     my $debits = find_linked_entry_debits($e, $entry);
 359
 360     # Additionally, find legacy dis-encumbered debits that link
 361     # to this entry via lineitem.
 362     push (@$debits, @{find_non_linked_debits(
 363         $e, $entry->lineitem, $need_count, undef, 'f')});
 364
 365     my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem)
 366         or return $e->die_event;
 367
 368     for my $debit (@$debits) {
 369         # revert to the original estimated amount re-encumber
 370         $debit->encumbrance('t');
 371         $debit->amount($lineitem->estimated_unit_price());
 372
 373         # debit is no longer "invoiced"; detach it from the entry;
 374         $debit->clear_invoice_entry;
 375
 376         $e->update_acq_fund_debit($debit) or return $e->die_event;
 377         update_copy_cost($e, $debit) or return $e->die_event; # clear the cost
 378     }
 379
 380     return undef;
 381 }
 382
 383 # invoiced -- debits already linked to this invoice
 384 # inv_closing -- invoice is going from complete=f to t.
 385 # inv_reopening -- invoice is going from complete=t to f.
 386 sub update_entry_debits {
 387     my($e, $entry, $link_state, $inv_closing, $inv_reopening) = @_;
 388
 389     my $debits = find_entry_debits(
 390         $e, $entry, $link_state, $inv_reopening ? 'f' : 't');
 391     return undef unless @$debits;
 392
 393     if($entry->phys_item_count > @$debits) {
 394         $e->rollback;
 395         # We can't invoice for more items than we have debits for
 396         return OpenILS::Event->new(
 397             'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS',
 398             payload => {entry => $entry->id});
 399     }
 400
 401     for my $debit (@$debits) {
 402         my $amount = entry_amount_per_item($entry);
 403         $debit->amount($amount);
 404         $debit->encumbrance($inv_closing ? 'f' : 't');
 405
 406         # debit always reports the invoice_entry responsible
 407         # for its most recent modification.
 408         $debit->invoice_entry($entry->id);
 409
 410         $e->update_acq_fund_debit($debit) or return $e->die_event;
 411
 412         # TODO: this does not reflect ancillary charges, like taxes, etc.
 413         # We may need a way to indicate whether the amount attached to an
 414         # invoice_item should be prorated and included in the copy cost.
 415         # Note that acq.invoice_item_type.prorate does not necessarily
 416         # mean a charge should be included in the copy price, only that
 417         # it should spread accross funds.
 418         update_copy_cost($e, $debit, $amount) or return $e->die_event;
 419     }
 420
 421     return undef;
 422 }
 423
 424 # This was originally done only for EDI invoices, but needs added to the
 425 # manual invoice-entering process for consistency's sake.
 426 sub uncancel_copies_as_needed {
 427     my ($e, $entry) = @_;
 428
 429     return unless $entry->lineitem and $entry->phys_item_count;
 430
 431     my $li = $e->retrieve_acq_lineitem($entry->lineitem) or
 432         return $e->die_event;
 433
 434     # if an invoiced lineitem is marked as cancelled
 435     # (e.g. back-order), invoicing the lineitem implies
 436     # we need to un-cancel it
 437
 438     # collect the LIDs, starting with those that are
 439     # not cancelled, followed by those that have keep-debits cancel_reasons,
 440     # followed by non-keep-debit cancel reasons.
 441
 442     my $lid_ids = $e->json_query({
 443         select => {acqlid => ['id']},
 444         from => {
 445             acqlid => {
 446                 acqcr => {type => 'left'},
 447                 acqfdeb => {type => 'left'}
 448             }
 449         },
 450         where => {
 451             '+acqlid' => {lineitem => $li->id},
 452             '+acqfdeb' => {invoice_entry => undef}  # not-yet invoiced copies
 453         },
 454         order_by => [{
 455             class => 'acqcr',
 456             field => 'keep_debits',
 457             direction => 'desc'
 458         }],
 459         limit => $entry->phys_item_count    # crucial
 460     });
 461
 462     for my $lid_id (map {$_->{id}} @$lid_ids) {
 463         my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
 464         next unless $lid->cancel_reason;
 465
 466         $logger->info(
 467             "un-cancelling invoice lineitem " . $li->id .
 468             " lineitem_detail " . $lid_id
 469         );
 470         $lid->clear_cancel_reason;
 471         return $e->die_event unless $e->update_acq_lineitem_detail($lid);
 472     }
 473
 474     $li->clear_cancel_reason;
 475     $li->state("on-order") if $li->state eq "cancelled";    # sic
 476     $li->edit_time("now");
 477
 478     unless ($e->update_acq_lineitem($li)) {
 479         my $evt = $e->die_event;
 480         $logger->error("couldn't clear li cancel reason: ". $evt->{textcode});
 481         return $evt;
 482     }
 483
 484     return;
 485 }
 486
 487
 488 # update the linked copy to reflect the amount paid for the item
 489 # returns true on success, false on error
 490 sub update_copy_cost {
 491     my ($e, $debit, $amount) = @_;
 492
 493     my $lid = $e->search_acq_lineitem_detail([
 494         {fund_debit => $debit->id},
 495         {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}}
 496     ])->[0];
 497
 498     if($lid and my $copy = $lid->eg_copy_id) {
 499         defined $amount and $copy->cost($amount) or $copy->clear_cost;
 500
 501         # XXX It would be nice to have a way to record that a copy was
 502         # updated by a non-user mechanism, like EDI, but we don't have
 503         # a clear way to do that here.
 504         if ($e->requestor) {
 505             $copy->editor($e->requestor->id);
 506             $copy->edit_date('now');
 507         }
 508
 509         $e->update_asset_copy($copy) or return 0;
 510     }
 511
 512     return 1;
 513 }
 514
 515
 516 sub entry_amount_per_item {
 517     my $entry = shift;
 518     return $entry->amount_paid if $U->is_true($entry->billed_per_item);
 519     return 0 if $entry->phys_item_count == 0;
 520     return $entry->amount_paid / $entry->phys_item_count;
 521 }
 522
 523 sub easy_money { # TODO XXX replace with something from a library
 524     my ($val) = @_;
 525
 526     my $rounded = int($val * 100) / 100.0;
 527     if ($rounded == $val) {
 528         return sprintf("%.02f", $val);
 529     } else {
 530         return sprintf("%g", $val);
 531     }
 532 }
 533
 534 # 0 on failure (caller should call $e->die_event), array on success
 535 sub amounts_spent_per_fund {
 536     my ($e, $inv_id) = @_;
 537
 538     my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or
 539         return 0;
 540
 541     my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or
 542         return 0;
 543
 544     my %totals_by_fund;
 545     foreach my $entry (@$entries) {
 546         my $debits = find_entry_debits($e, $entry, 'linked', "f") or return 0;
 547         foreach (@$debits) {
 548             $totals_by_fund{$_->fund} ||= 0.0;
 549             $totals_by_fund{$_->fund} += $_->amount;
 550         }
 551     }
 552
 553     foreach my $item (@$items) {
 554         next unless $item->fund and $item->amount_paid;
 555         $totals_by_fund{$item->fund} ||= 0.0;
 556         $totals_by_fund{$item->fund} += $item->amount_paid;
 557     }
 558
 559     my @totals;
 560     foreach my $fund_id (keys %totals_by_fund) {
 561         my $fund = $e->retrieve_acq_fund($fund_id) or return 0;
 562         push @totals, {
 563             "fund" => $fund->to_bare_hash,
 564             "total" => easy_money($totals_by_fund{$fund_id})
 565         };
 566     }
 567
 568     return \@totals;
 569 }
 570
 571 # Returns all debits linked to the provided invoice entry.
 572 # If an encumbrance value is provided, only debits matching the
 573 # encumbrance state are returned.
 574 sub find_linked_entry_debits {
 575     my($e, $entry, $encumbrance) = @_;
 576
 577     my $query = {
 578         select => {acqfdeb => ['id']},
 579         order_by => {'acqlid' => ['recv_time']},
 580         from => {acqfdeb => 'acqlid'},
 581         where => {'+acqfdeb' => {invoice_entry => $entry->id}}
 582     };
 583
 584     $query->{where}->{'+acqfdeb'}->{encumbrance}
 585         = $encumbrance if $encumbrance;
 586
 587     my $debits = $e->json_query($query);
 588
 589     return [] unless @$debits;
 590
 591     my $debit_ids = [map { $_->{id} } @$debits];
 592     return $e->search_acq_fund_debit({id => $debit_ids});
 593 }
 594
 595 # Returns all debits for the requested lineitem
 596 # that are not yet linked to an invoice entry.
 597 # If an encumbrance value is provided, only debits matching the
 598 # encumbrance state are returned.
 599 # note: only legacy debits can exist in a state where
 600 # encumbrance=false and the debit is not linked to an entry.
 601 sub find_non_linked_debits {
 602     my($e, $li_id, $count, $amount, $encumbrance) = @_;
 603
 604     my $query = {
 605         select => {acqfdeb => ['id']},
 606         order_by => {'acqlid' => ['recv_time']},
 607         where => {'+acqfdeb' => {invoice_entry => undef}},
 608         from => {
 609             acqfdeb => {
 610                 acqlid => {
 611                     join => {
 612                         jub => {
 613                             filter => {id => $li_id}
 614                         }
 615                     }
 616                 }
 617             }
 618         }
 619     };
 620
 621     $query->{where}->{'+acqfdeb'}->{encumbrance} = $encumbrance if $encumbrance;
 622     $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
 623     $query->{limit} = $count if defined $count;
 624
 625     my $debits = $e->json_query($query);
 626
 627     return [] unless @$debits;
 628
 629     my $debit_ids = [map { $_->{id} } @$debits];
 630     return $e->search_acq_fund_debit({id => $debit_ids});
 631 }
 632
 633 # find fund debits related to an invoice entry.
 634 # link_state -- 'linked', 'unlinked', 'all'
 635 # When link_state==undef, start with linked debits, then add unlinked debits.
 636 sub find_entry_debits {
 637     my($e, $entry, $link_state, $encumbrance, $amount, $count) = @_;
 638
 639     my $need_count = $count || $entry->phys_item_count;
 640     my $debits = [];
 641
 642     if ($link_state eq 'all' || $link_state eq 'linked') {
 643         $debits = find_linked_entry_debits($e, $entry, $encumbrance);
 644         return $debits if @$debits && scalar(@$debits) == $need_count;
 645     }
 646
 647     # either we don't have enough linked debits to cover the need_count
 648     # or we are not looking for linked debits.  Keep looking.
 649
 650     if ($link_state eq 'all' || $link_state eq 'unlinked') {
 651
 652         # If we found linked debits above, reduce the number of
 653         # required debits remaining by the number already found.
 654         $need_count = $need_count - scalar(@$debits);
 655
 656         push (@$debits, @{find_non_linked_debits(
 657             $e, $entry->lineitem, $need_count, $amount, $encumbrance)});
 658
 659     } elsif (scalar(@$debits) == 0) {
 660
 661         # if a lookup for previously invoiced debits returns zero
 662         # results, it may be becuase the debits were created before
 663         # the presence of the acq.fund_debit.invoice_entry column.
 664         # Fall back to using the old-style lookup.
 665
 666         push (@$debits, @{find_non_linked_debits(
 667             $e, $entry->lineitem, $need_count, $amount, $encumbrance)});
 668     }
 669
 670     return $debits;
 671 }
 672
 673
 674 __PACKAGE__->register_method(
 675     method => 'build_invoice_api',
 676     api_name    => 'open-ils.acq.invoice.retrieve',
 677     authoritative => 1,
 678     signature => {
 679         desc => q/Creates a new stub invoice/,
 680         params => [
 681             {desc => 'Authentication token', type => 'string'},
 682             {desc => q/Invoice Id/, type => 'number'},
 683         ],
 684         return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 685     }
 686 );
 687
 688
 689 sub fetch_invoice_api {
 690     my($self, $conn, $auth, $invoice_id, $options) = @_;
 691
 692     my $e = new_editor(authtoken=>$auth);
 693     return $e->event unless $e->checkauth;
 694
 695     my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
 696         return $e->event;
 697     return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
 698
 699     return $invoice;
 700 }
 701
 702 sub fetch_invoice_impl {
 703     my ($e, $invoice_id, $options) = @_;
 704
 705     $options ||= {};
 706
 707     my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
 708         $invoice_id,
 709         {
 710             "flesh" => 6,
 711             "flesh_fields" => {
 712                 "acqinv" => ["entries", "items"],
 713                 "acqii" => ["fund_debit", "purchase_order", "po_item"]
 714             }
 715         }
 716     ];
 717
 718     return $e->retrieve_acq_invoice($args);
 719 }
 720
 721 __PACKAGE__->register_method(
 722     method => 'prorate_invoice',
 723     api_name    => 'open-ils.acq.invoice.apply_prorate',
 724     signature => {
 725         desc => q/
 726             For all invoice items that have the prorate flag set to true, this will create the necessary
 727             additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
 728         /,
 729         params => [
 730             {desc => 'Authentication token', type => 'string'},
 731             {desc => q/Invoice Id/, type => 'number'},
 732         ],
 733         return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 734     }
 735 );
 736
 737
 738 sub prorate_invoice {
 739     my($self, $conn, $auth, $invoice_id) = @_;
 740
 741     my $e = new_editor(xact => 1, authtoken=>$auth);
 742     return $e->die_event unless $e->checkauth;
 743
 744     my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
 745     return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
 746
 747     my @lid_debits;
 748     push(@lid_debits,
 749         @{find_entry_debits($e, $_, 'linked', undef, entry_amount_per_item($_))})
 750         for @{$invoice->entries};
 751
 752     my $inv_items = $e->search_acq_invoice_item([
 753         {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}},
 754         {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}}
 755     ]) or return $e->die_event;
 756
 757     my @item_debits = map { $_->fund_debit } @$inv_items;
 758
 759     my %fund_totals;
 760     my $total_entry_paid = 0;
 761     for my $debit (@lid_debits, @item_debits) {
 762         $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
 763         $fund_totals{$debit->fund} += $debit->amount;
 764         $total_entry_paid += $debit->amount;
 765     }
 766
 767     $logger->info("invoice: prorating against invoice amount $total_entry_paid");
 768
 769     for my $item (@{$invoice->items}) {
 770
 771         next if $item->fund_debit; # item has already been processed
 772
 773         # future: cache item types locally
 774         my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
 775         next unless $U->is_true($item_type->prorate);
 776
 777         # Prorate charges across applicable funds
 778         my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
 779         my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
 780         my $first_round = 1;
 781         my $largest_debit;
 782         my $largest_item;
 783         my $total_debited = 0;
 784         my $total_costed = 0;
 785
 786         for my $fund_id (keys %fund_totals) {
 787
 788             my $spent_for_fund = $fund_totals{$fund_id};
 789             next unless $spent_for_fund > 0;
 790
 791             my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
 792             my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
 793             $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
 794
 795             my $debit;
 796             if($first_round and $item->po_item) {
 797                 # if this item is the result of a PO item, repurpose the original debit
 798                 # for the first chunk of the prorated amount
 799                 $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
 800             } else {
 801                 $debit = Fieldmapper::acq::fund_debit->new;
 802                 $debit->isnew(1);
 803             }
 804
 805             $debit->fund($fund_id);
 806             $debit->amount($prorated_amount);
 807             $debit->origin_amount($prorated_amount);
 808             $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
 809             $debit->encumbrance('t'); # Set to 'f' when invoice is closed
 810             $debit->debit_type('prorated_charge');
 811
 812             if($debit->isnew) {
 813                 $e->create_acq_fund_debit($debit) or return $e->die_event;
 814             } else {
 815                 $e->update_acq_fund_debit($debit) or return $e->die_event;
 816             }
 817
 818             $total_debited += $prorated_amount;
 819             $total_costed += $prorated_cost;
 820             $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
 821
 822             if($first_round) {
 823
 824                 # re-purpose the original invoice_item for the first prorated amount
 825                 $item->fund($fund_id);
 826                 $item->fund_debit($debit->id);
 827                 $item->amount_paid($prorated_amount);
 828                 $item->cost_billed($prorated_cost);
 829                 $e->update_acq_invoice_item($item) or return $e->die_event;
 830                 $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 831
 832             } else {
 833
 834                 # for subsequent prorated amounts, create a new invoice_item
 835                 my $new_item = $item->clone;
 836                 $new_item->clear_id;
 837                 $new_item->fund($fund_id);
 838                 $new_item->fund_debit($debit->id);
 839                 $new_item->amount_paid($prorated_amount);
 840                 $new_item->cost_billed($prorated_cost);
 841                 $e->create_acq_invoice_item($new_item) or return $e->die_event;
 842                 $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 843             }
 844
 845             $first_round = 0;
 846         }
 847
 848         # make sure the percentages didn't leave a small sliver of money over/under-debited
 849         # if so, tweak the largest debit to smooth out the difference
 850         if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
 851
 852             my $paid_diff = $full_item_paid - $total_debited;
 853             my $cost_diff = $full_item_cost - $total_debited;
 854             $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
 855             my $new_paid = $largest_item->amount_paid + $paid_diff;
 856             my $new_cost = $largest_item->cost_billed + $cost_diff;
 857
 858             $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
 859             $largest_debit->amount($new_paid);
 860             $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
 861
 862             $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
 863             $largest_item->amount_paid($new_paid);
 864             $largest_item->cost_billed($new_cost);
 865
 866             $e->update_acq_invoice_item($largest_item) or return $e->die_event;
 867         }
 868     }
 869
 870     $invoice = fetch_invoice_impl($e, $invoice_id);
 871     $e->commit;
 872
 873     return $invoice;
 874 }
 875
 876
 877 __PACKAGE__->register_method(
 878     method      => "print_html_invoice",
 879     api_name    => "open-ils.acq.invoice.print.html",
 880     stream      => 1,
 881     signature   => {
 882         desc    => "Retrieve printable HTML vouchers for each given invoice",
 883         params => [
 884             {desc => "Authentication token", type => "string"},
 885             {desc => "Invoice ID or a list of them", type => "mixed"},
 886         ],
 887         return => {
 888             desc => q{One A/T event containing a printable HTML voucher for
 889                 each given invoice},
 890             type => "object", class => "atev"}
 891     }
 892 );
 893
 894
 895 sub print_html_invoice {
 896     my ($self, $conn, $auth, $id_list) = @_;
 897
 898     my $e = new_editor("authtoken" => $auth);
 899     return $e->die_event unless $e->checkauth;
 900
 901     $id_list = [$id_list] unless ref $id_list;
 902
 903     my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
 904         return $e->die_event;
 905
 906     foreach my $invoice (@$invoices) {
 907         return $e->die_event unless
 908             $e->allowed("VIEW_INVOICE", $invoice->receiver);
 909
 910         my $amounts = amounts_spent_per_fund($e, $invoice->id) or
 911             return $e->die_event;
 912
 913         $conn->respond(
 914             $U->fire_object_event(
 915                 undef, "format.acqinv.html", $invoice, $invoice->receiver,
 916                 "print-on-demand", $amounts
 917             )
 918         );
 919     }
 920
 921     $e->disconnect;
 922     undef;
 923 }
 924
 925 __PACKAGE__->register_method(
 926     method => 'finalize_blanket_po_api',
 927     api_name    => 'open-ils.acq.purchase_order.blanket.finalize',
 928     signature => {
 929         desc => q/
 930             1. Set encumbered amount to zero for all blanket po_item's
 931             2. If the PO does not have any outstanding lineitems, mark
 932                the PO as 'received'.
 933         /,
 934         params => [
 935             {desc => 'Authentication token', type => 'string'},
 936             {desc => q/PO ID/, type => 'number'}
 937         ],
 938         return => {desc => '1 on success, event on error'}
 939     }
 940 );
 941
 942 sub finalize_blanket_po_api {
 943     my ($self, $client, $auth, $po_id) = @_;
 944
 945     my $e = new_editor(xact => 1, authtoken=>$auth);
 946     return $e->die_event unless $e->checkauth;
 947
 948     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
 949
 950     return $e->die_event unless
 951         $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
 952
 953     my $evt = finalize_blanket_po($e, $po);
 954     return $evt if $evt;
 955
 956     $e->commit;
 957     return 1;
 958 }
 959
 960
 961 # 1. set any remaining blanket encumbrances to $0.
 962 # 2. mark the PO as received if there are no pending lineitems.
 963 sub finalize_blanket_po {
 964     my ($e, $po) = @_;
 965
 966     my $po_id = $po->id;
 967
 968     # blanket po_items on this PO
 969     my $blanket_items = $e->json_query({
 970         select => {acqpoi => ['id']},
 971         from => {acqpoi => {aiit => {}}},
 972         where => {
 973             '+aiit' => {blanket => 't'},
 974             '+acqpoi' => {purchase_order => $po_id}
 975         }
 976     });
 977
 978     for my $item_id (map { $_->{id} } @$blanket_items) {
 979
 980         my $item = $e->retrieve_acq_po_item([
 981             $item_id, {
 982                 flesh => 1,
 983                 flesh_fields => {acqpoi => ['fund_debit']}
 984             }
 985         ]);
 986
 987         my $debit = $item->fund_debit or next;
 988
 989         next if $debit->amount == 0;
 990
 991         $debit->amount(0);
 992         $e->update_acq_fund_debit($debit) or return $e->die_event;
 993     }
 994
 995     # Number of pending lineitems on this PO.
 996     # If there are any, we don't mark 'received'
 997     my $li_count = $e->json_query({
 998         select => {jub => [{column => 'id', transform => 'count'}]},
 999         from => 'jub',
1000         where => {
1001             '+jub' => {
1002                 purchase_order => $po_id,
1003                 state => 'on-order'
1004             }
1005         }
1006     })->[0];
1007
1008     if ($li_count->{count} > 0) {
1009         $logger->info("skipping 'received' state change for po $po_id ".
1010             "during finalization, because PO has pending lineitems");
1011         return undef;
1012     }
1013
1014     $po->state('received');
1015     $po->edit_time('now');
1016     $po->editor($e->requestor->id);
1017
1018     $e->update_acq_purchase_order($po) or return $e->die_event;
1019
1020     return undef;
1021 }
1022
1023 1;