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