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