1 package OpenILS::Application::Acq::Invoice;
2 use base qw/OpenILS::Application/;
3 use strict; use warnings;
5 use OpenSRF::Utils::Logger qw(:logger);
6 use OpenILS::Utils::Fieldmapper;
7 use OpenILS::Utils::CStoreEditor q/:funcs/;
8 use OpenILS::Application::AppUtils;
10 my $U = 'OpenILS::Application::AppUtils';
13 # return nothing on success, event on failure
14 sub _prepare_fund_debit_for_inv_item {
15 my ($debit, $item, $e, $inv_closing) = @_;
17 $debit->fund($item->fund);
18 $debit->amount($item->amount_paid);
19 $debit->origin_amount($item->amount_paid);
21 # future: cache funds locally
22 my $fund = $e->retrieve_acq_fund($item->fund) or return $e->die_event;
24 $debit->origin_currency_type($fund->currency_type);
25 $debit->encumbrance($inv_closing ? 'f' : 't');
26 $debit->debit_type('direct_charge');
31 __PACKAGE__->register_method(
32 method => 'build_invoice_api',
33 api_name => 'open-ils.acq.invoice.update',
35 desc => q/Creates, updates, and deletes invoices, and related invoice entries, and invoice items/,
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'},
43 return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
48 sub build_invoice_impl {
49 my ($e, $invoice, $entries, $items, $do_commit, $finalize_pos) = @_;
54 my $inv_reopening = 0;
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) {
61 $invoice->closed_by($e->requestor->id);
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;
67 my $orig_inv = $e->retrieve_acq_invoice($invoice->id)
68 or return $e->die_event;
70 if (!$orig_inv->close_date && $invoice->close_date) {
72 $invoice->closed_by($e->requestor->id);
74 } elsif ($orig_inv->close_date && !$invoice->close_date) {
76 $invoice->clear_closed_by;
79 $e->update_acq_invoice($invoice) or return $e->die_event;
85 for my $entry (@$entries) {
86 $entry->invoice($invoice->id);
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
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;
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);
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);
112 # debits were rolled back (encumbrance=t) above, so now
113 # search for un-invoiced, potentially linked debits
115 return $evt if $evt = update_entry_debits(
116 $e, $entry, 'all', $inv_closing, $inv_reopening);
119 $e->update_acq_invoice_entry($entry) or return $e->die_event;
125 for my $item (@$items) {
126 $item->invoice($invoice->id);
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;
133 $e->create_acq_invoice_item($item) or return $e->die_event;
136 # This following complex conditional statement effecively means:
137 # 1) Items with item_types that are prorate are handled
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
146 if (not $U->is_true($item_type->prorate) and
147 ($item->po_item or $item->fund or $invoice->close_date)) {
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;
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
168 $debit = Fieldmapper::acq::fund_debit->new;
172 return $evt if $evt = _prepare_fund_debit_for_inv_item(
173 $debit, $item, $e, $inv_closing);
176 $e->create_acq_fund_debit($debit)
177 or return $e->die_event;
179 $e->update_acq_fund_debit($debit)
180 or return $e->die_event;
183 $item->fund_debit($debit->id);
184 $e->update_acq_invoice_item($item) or return $e->die_event;
186 } elsif ($item->isdeleted) {
187 $e->delete_acq_invoice_item($item) or return $e->die_event;
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;
206 } elsif ($item->fund_debit) {
208 my $inv_debit = $e->retrieve_acq_fund_debit($item->fund_debit);
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.
215 my $po_debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
216 $po_debit->amount($po_debit->amount + $inv_debit->amount);
218 $e->update_acq_fund_debit($po_debit)
219 or return $e->die_event;
222 $e->delete_acq_fund_debit($inv_debit) or return $e->die_event;
225 } elsif ($item->ischanged) {
228 if (!$item->fund_debit) {
229 # No fund_debit yet? Make one now.
230 $debit = Fieldmapper::acq::fund_debit->new;
234 $evt = _prepare_fund_debit_for_inv_item(
235 $debit, $item, $e, $inv_closing);
237 $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or
238 return $e->die_event;
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.
246 my $po_debit = $e->retrieve_acq_fund_debit(
247 $item->po_item->fund_debit);
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;
255 $debit->amount($item->amount_paid);
256 $debit->fund($item->fund);
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);
263 $e->update_acq_fund_debit($debit) or return $e->die_event;
266 $e->update_acq_invoice_item($item) or return $e->die_event;
271 for my $po_id (@$finalize_pos) {
272 my $po = $e->retrieve_acq_purchase_order($po_id)
273 or return $e->die_event;
275 my $evt = finalize_blanket_po($e, $po);
279 $invoice = fetch_invoice_impl($e, $invoice->id);
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) {
285 # inv_closing=false implies inv_reopening=true
286 $evt = handle_invoice_state_change($e, $invoice, $inv_closing);
289 $invoice = fetch_invoice_impl($e, $invoice->id);
293 $e->commit or return $e->die_event;
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) = @_;
305 my $enc_find = $closing ? 't' : 'f'; # debits to process
306 my $enc_set = $closing ? 'f' : 't'; # new encumbrance value
309 for my $entry (@{$invoice->entries}) {
310 push(@debits, @{find_linked_entry_debits($e, $entry, $enc_find)});
313 for my $item (@{$invoice->items}) {
314 push(@debits, $item->fund_debit) if
316 $item->fund_debit->encumbrance eq $enc_find;
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;
328 sub build_invoice_api {
329 my($self, $conn, $auth, $invoice, $entries, $items, $finalize_pos) = @_;
331 my $e = new_editor(xact => 1, authtoken=>$auth);
332 return $e->die_event unless $e->checkauth;
334 if (not ref $invoice) {
335 # caller only provided the ID
336 $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event;
339 if (not $invoice->receiver and $invoice->isnew) {
340 $invoice->receiver($e->requestor->ws_ou);
343 return $e->die_event unless
344 $e->allowed('CREATE_INVOICE', $invoice->receiver);
346 return build_invoice_impl($e, $invoice, $entries, $items, 1, $finalize_pos);
350 # 1. set encumbrance=true
351 # 2. unlink debit entries.
352 sub rollback_entry_debits {
353 my($e, $entry, $orig_entry) = @_;
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;
360 # Un-link all linked debits when rolling back
361 my $debits = find_linked_entry_debits($e, $entry);
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')});
368 my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem)
369 or return $e->die_event;
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());
376 # debit is no longer "invoiced"; detach it from the entry;
377 $debit->clear_invoice_entry;
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
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) = @_;
392 my $debits = find_entry_debits(
393 $e, $entry, $link_state, $inv_reopening ? 'f' : 't');
394 return undef unless @$debits;
396 if($entry->phys_item_count > @$debits) {
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});
404 for my $debit (@$debits) {
405 my $amount = entry_amount_per_item($entry);
406 $debit->amount($amount);
407 $debit->encumbrance($inv_closing ? 'f' : 't');
409 # debit always reports the invoice_entry responsible
410 # for its most recent modification.
411 $debit->invoice_entry($entry->id);
413 $e->update_acq_fund_debit($debit) or return $e->die_event;
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;
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) = @_;
432 return unless $entry->lineitem and $entry->phys_item_count;
434 my $li = $e->retrieve_acq_lineitem($entry->lineitem) or
435 return $e->die_event;
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
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.
445 my $lid_ids = $e->json_query({
446 select => {acqlid => ['id']},
449 acqcr => {type => 'left'},
450 acqfdeb => {type => 'left'}
454 '+acqlid' => {lineitem => $li->id},
455 '+acqfdeb' => {invoice_entry => undef} # not-yet invoiced copies
459 field => 'keep_debits',
462 limit => $entry->phys_item_count # crucial
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;
470 "un-cancelling invoice lineitem " . $li->id .
471 " lineitem_detail " . $lid_id
473 $lid->clear_cancel_reason;
474 return $e->die_event unless $e->update_acq_lineitem_detail($lid);
477 $li->clear_cancel_reason;
478 $li->state("on-order") if $li->state eq "cancelled"; # sic
479 $li->edit_time("now");
481 unless ($e->update_acq_lineitem($li)) {
482 my $evt = $e->die_event;
483 $logger->error("couldn't clear li cancel reason: ". $evt->{textcode});
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) = @_;
496 my $lid = $e->search_acq_lineitem_detail([
497 {fund_debit => $debit->id},
498 {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}}
501 if($lid and my $copy = $lid->eg_copy_id) {
502 defined $amount and $copy->cost($amount) or $copy->clear_cost;
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.
508 $copy->editor($e->requestor->id);
509 $copy->edit_date('now');
512 $e->update_asset_copy($copy) or return 0;
519 sub entry_amount_per_item {
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;
526 sub easy_money { # TODO XXX replace with something from a library
529 my $rounded = int($val * 100) / 100.0;
530 if ($rounded == $val) {
531 return sprintf("%.02f", $val);
533 return sprintf("%g", $val);
537 # 0 on failure (caller should call $e->die_event), array on success
538 sub amounts_spent_per_fund {
539 my ($e, $inv_id) = @_;
541 my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or
544 my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or
548 foreach my $entry (@$entries) {
549 my $debits = find_entry_debits($e, $entry, 'linked', "f") or return 0;
551 $totals_by_fund{$_->fund} ||= 0.0;
552 $totals_by_fund{$_->fund} += $_->amount;
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;
563 foreach my $fund_id (keys %totals_by_fund) {
564 my $fund = $e->retrieve_acq_fund($fund_id) or return 0;
566 "fund" => $fund->to_bare_hash,
567 "total" => easy_money($totals_by_fund{$fund_id})
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) = @_;
581 select => {acqfdeb => ['id']},
582 order_by => {'acqlid' => ['recv_time']},
583 from => {acqfdeb => 'acqlid'},
584 where => {'+acqfdeb' => {invoice_entry => $entry->id}}
587 $query->{where}->{'+acqfdeb'}->{encumbrance}
588 = $encumbrance if $encumbrance;
590 my $debits = $e->json_query($query);
592 return [] unless @$debits;
594 my $debit_ids = [map { $_->{id} } @$debits];
595 return $e->search_acq_fund_debit({id => $debit_ids});
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) = @_;
608 select => {acqfdeb => ['id']},
609 order_by => {'acqlid' => ['recv_time']},
610 where => {'+acqfdeb' => {invoice_entry => undef}},
616 filter => {id => $li_id}
624 $query->{where}->{'+acqfdeb'}->{encumbrance} = $encumbrance if $encumbrance;
625 $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
626 $query->{limit} = $count if defined $count;
628 my $debits = $e->json_query($query);
630 return [] unless @$debits;
632 my $debit_ids = [map { $_->{id} } @$debits];
633 return $e->search_acq_fund_debit({id => $debit_ids});
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) = @_;
642 my $need_count = $count || $entry->phys_item_count;
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;
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.
653 if ($link_state eq 'all' || $link_state eq 'unlinked') {
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);
659 push (@$debits, @{find_non_linked_debits(
660 $e, $entry->lineitem, $need_count, $amount, $encumbrance)});
662 } elsif (scalar(@$debits) == 0) {
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.
669 push (@$debits, @{find_non_linked_debits(
670 $e, $entry->lineitem, $need_count, $amount, $encumbrance)});
677 __PACKAGE__->register_method(
678 method => 'build_invoice_api',
679 api_name => 'open-ils.acq.invoice.retrieve',
682 desc => q/Creates a new stub invoice/,
684 {desc => 'Authentication token', type => 'string'},
685 {desc => q/Invoice Id/, type => 'number'},
687 return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
692 sub fetch_invoice_api {
693 my($self, $conn, $auth, $invoice_id, $options) = @_;
695 my $e = new_editor(authtoken=>$auth);
696 return $e->event unless $e->checkauth;
698 my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
700 return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
705 sub fetch_invoice_impl {
706 my ($e, $invoice_id, $options) = @_;
710 my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
715 "acqinv" => ["entries", "items", "closed_by"],
716 "acqii" => ["fund_debit", "purchase_order", "po_item"]
721 return $e->retrieve_acq_invoice($args);
724 __PACKAGE__->register_method(
725 method => 'prorate_invoice',
726 api_name => 'open-ils.acq.invoice.apply_prorate',
729 For all invoice items that have the prorate flag set to true, this will create the necessary
730 additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
733 {desc => 'Authentication token', type => 'string'},
734 {desc => q/Invoice Id/, type => 'number'},
736 return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
741 sub prorate_invoice {
742 my($self, $conn, $auth, $invoice_id) = @_;
744 my $e = new_editor(xact => 1, authtoken=>$auth);
745 return $e->die_event unless $e->checkauth;
747 my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
748 return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
752 @{find_entry_debits($e, $_, 'linked', undef, entry_amount_per_item($_))})
753 for @{$invoice->entries};
755 my $inv_items = $e->search_acq_invoice_item([
756 {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}},
757 {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}}
758 ]) or return $e->die_event;
760 my @item_debits = map { $_->fund_debit } @$inv_items;
763 my $total_entry_paid = 0;
764 for my $debit (@lid_debits, @item_debits) {
765 $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
766 $fund_totals{$debit->fund} += $debit->amount;
767 $total_entry_paid += $debit->amount;
770 $logger->info("invoice: prorating against invoice amount $total_entry_paid");
772 for my $item (@{$invoice->items}) {
774 next if $item->fund_debit; # item has already been processed
776 # future: cache item types locally
777 my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
778 next unless $U->is_true($item_type->prorate);
780 # Prorate charges across applicable funds
781 my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
782 my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
786 my $total_debited = 0;
787 my $total_costed = 0;
789 for my $fund_id (keys %fund_totals) {
791 my $spent_for_fund = $fund_totals{$fund_id};
792 next unless $spent_for_fund > 0;
794 my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
795 my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
796 $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
799 if($first_round and $item->po_item) {
800 # if this item is the result of a PO item, repurpose the original debit
801 # for the first chunk of the prorated amount
802 $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
804 $debit = Fieldmapper::acq::fund_debit->new;
808 $debit->fund($fund_id);
809 $debit->amount($prorated_amount);
810 $debit->origin_amount($prorated_amount);
811 $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
812 $debit->encumbrance('t'); # Set to 'f' when invoice is closed
813 $debit->debit_type('prorated_charge');
816 $e->create_acq_fund_debit($debit) or return $e->die_event;
818 $e->update_acq_fund_debit($debit) or return $e->die_event;
821 $total_debited += $prorated_amount;
822 $total_costed += $prorated_cost;
823 $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
827 # re-purpose the original invoice_item for the first prorated amount
828 $item->fund($fund_id);
829 $item->fund_debit($debit->id);
830 $item->amount_paid($prorated_amount);
831 $item->cost_billed($prorated_cost);
832 $e->update_acq_invoice_item($item) or return $e->die_event;
833 $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
837 # for subsequent prorated amounts, create a new invoice_item
838 my $new_item = $item->clone;
840 $new_item->fund($fund_id);
841 $new_item->fund_debit($debit->id);
842 $new_item->amount_paid($prorated_amount);
843 $new_item->cost_billed($prorated_cost);
844 $e->create_acq_invoice_item($new_item) or return $e->die_event;
845 $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
851 # make sure the percentages didn't leave a small sliver of money over/under-debited
852 # if so, tweak the largest debit to smooth out the difference
853 if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
855 my $paid_diff = $full_item_paid - $total_debited;
856 my $cost_diff = $full_item_cost - $total_debited;
857 $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
858 my $new_paid = $largest_item->amount_paid + $paid_diff;
859 my $new_cost = $largest_item->cost_billed + $cost_diff;
861 $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
862 $largest_debit->amount($new_paid);
863 $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
865 $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
866 $largest_item->amount_paid($new_paid);
867 $largest_item->cost_billed($new_cost);
869 $e->update_acq_invoice_item($largest_item) or return $e->die_event;
873 $invoice = fetch_invoice_impl($e, $invoice_id);
880 __PACKAGE__->register_method(
881 method => "print_html_invoice",
882 api_name => "open-ils.acq.invoice.print.html",
885 desc => "Retrieve printable HTML vouchers for each given invoice",
887 {desc => "Authentication token", type => "string"},
888 {desc => "Invoice ID or a list of them", type => "mixed"},
891 desc => q{One A/T event containing a printable HTML voucher for
893 type => "object", class => "atev"}
898 sub print_html_invoice {
899 my ($self, $conn, $auth, $id_list) = @_;
901 my $e = new_editor("authtoken" => $auth);
902 return $e->die_event unless $e->checkauth;
904 $id_list = [$id_list] unless ref $id_list;
906 my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
907 return $e->die_event;
909 foreach my $invoice (@$invoices) {
910 return $e->die_event unless
911 $e->allowed("VIEW_INVOICE", $invoice->receiver);
913 my $amounts = amounts_spent_per_fund($e, $invoice->id) or
914 return $e->die_event;
917 $U->fire_object_event(
918 undef, "format.acqinv.html", $invoice, $invoice->receiver,
919 "print-on-demand", $amounts
928 __PACKAGE__->register_method(
929 method => 'finalize_blanket_po_api',
930 api_name => 'open-ils.acq.purchase_order.blanket.finalize',
933 1. Set encumbered amount to zero for all blanket po_item's
934 2. If the PO does not have any outstanding lineitems, mark
935 the PO as 'received'.
938 {desc => 'Authentication token', type => 'string'},
939 {desc => q/PO ID/, type => 'number'}
941 return => {desc => '1 on success, event on error'}
945 sub finalize_blanket_po_api {
946 my ($self, $client, $auth, $po_id) = @_;
948 my $e = new_editor(xact => 1, authtoken=>$auth);
949 return $e->die_event unless $e->checkauth;
951 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
953 return $e->die_event unless
954 $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
956 my $evt = finalize_blanket_po($e, $po);
964 # 1. set any remaining blanket encumbrances to $0.
965 # 2. mark the PO as received if there are no pending lineitems.
966 sub finalize_blanket_po {
971 # blanket po_items on this PO
972 my $blanket_items = $e->json_query({
973 select => {acqpoi => ['id']},
974 from => {acqpoi => {aiit => {}}},
976 '+aiit' => {blanket => 't'},
977 '+acqpoi' => {purchase_order => $po_id}
981 for my $item_id (map { $_->{id} } @$blanket_items) {
983 my $item = $e->retrieve_acq_po_item([
986 flesh_fields => {acqpoi => ['fund_debit']}
990 my $debit = $item->fund_debit or next;
992 next if $debit->amount == 0;
995 $e->update_acq_fund_debit($debit) or return $e->die_event;
998 # Number of pending lineitems on this PO.
999 # If there are any, we don't mark 'received'
1000 my $li_count = $e->json_query({
1001 select => {jub => [{column => 'id', transform => 'count'}]},
1005 purchase_order => $po_id,
1011 if ($li_count->{count} > 0) {
1012 $logger->info("skipping 'received' state change for po $po_id ".
1013 "during finalization, because PO has pending lineitems");
1017 $po->state('received');
1018 $po->edit_time('now');
1019 $po->editor($e->requestor->id);
1021 $e->update_acq_purchase_order($po) or return $e->die_event;