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