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 __PACKAGE__->register_method(
  14         method => 'build_invoice_api',
  15         api_name        => 'open-ils.acq.invoice.update',
  16         signature => {
  17         desc => q/Creates, updates, and deletes invoices, and related invoice entries, and invoice items/,
  18         params => [
  19             {desc => 'Authentication token', type => 'string'},
  20             {desc => q/Invoice/, type => 'number'},
  21             {desc => q/Entries.  Array of 'acqie' objects/, type => 'array'},
  22             {desc => q/Items.  Array of 'acqii' objects/, type => 'array'},
  23         ],
  24         return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
  25     }
  26 );
  27
  28 sub build_invoice_api {
  29     my($self, $conn, $auth, $invoice, $entries, $items) = @_;
  30
  31     my $e = new_editor(xact => 1, authtoken=>$auth);
  32     return $e->die_event unless $e->checkauth;
  33     my $evt;
  34
  35     if(ref $invoice) {
  36         if($invoice->isnew) {
  37             $invoice->receiver($e->requestor->ws_ou) unless $invoice->receiver;
  38             $invoice->recv_method('PPR') unless $invoice->recv_method;
  39             $invoice->recv_date('now') unless $invoice->recv_date;
  40             $e->create_acq_invoice($invoice) or return $e->die_event;
  41         } elsif($invoice->isdeleted) {
  42             i$e->delete_acq_invoice($invoice) or return $e->die_event;
  43         } else {
  44             $e->update_acq_invoice($invoice) or return $e->die_event;
  45         }
  46     } else {
  47         # caller only provided the ID
  48         $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event;
  49     }
  50
  51     return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
  52
  53     if($entries) {
  54         for my $entry (@$entries) {
  55             $entry->invoice($invoice->id);
  56
  57             if($entry->isnew) {
  58
  59                 $e->create_acq_invoice_entry($entry) or return $e->die_event;
  60                 return $evt if $evt = update_entry_debits($e, $entry);
  61
  62             } elsif($entry->isdeleted) {
  63
  64                 return $evt if $evt = rollback_entry_debits($e, $entry);
  65                 $e->delete_acq_invoice_entry($entry) or return $e->die_event;
  66
  67             } elsif($entry->ischanged) {
  68
  69                 my $orig_entry = $e->retrieve_acq_invoice_entry($entry->id) or return $e->die_event;
  70
  71                 if($orig_entry->amount_paid != $entry->amount_paid or
  72                         $entry->phys_item_count != $orig_entry->phys_item_count) {
  73
  74                     return $evt if $evt = rollback_entry_debits($e, $orig_entry);
  75                     return $evt if $evt = update_entry_debits($e, $entry);
  76
  77                 }
  78
  79                 $e->update_acq_invoice_entry($entry) or return $e->die_event;
  80             }
  81         }
  82     }
  83
  84     if($items) {
  85         for my $item (@$items) {
  86             $item->invoice($invoice->id);
  87
  88             if($item->isnew) {
  89
  90                 $e->create_acq_invoice_item($item) or return $e->die_event;
  91
  92                 # future: cache item types
  93                 my $item_type = $e->retrieve_acq_invoice_item_type(
  94                     $item->inv_item_type) or return $e->die_event;
  95
  96                 # prorated items are handled separately
  97                 unless($U->is_true($item_type->prorate)) {
  98                     my $debit;
  99                     if($item->po_item) {
 100                         my $po_item = $e->retrieve_acq_po_item($item->po_item) or return $e->die_event;
 101                         $debit = $e->retrieve_acq_fund_debit($po_item->fund_debit) or return $e->die_event;
 102                     } else {
 103                         $debit = Fieldmapper::acq::fund_debit->new;
 104                         $debit->isnew(1);
 105                     }
 106                     $debit->fund($item->fund);
 107                     $debit->amount($item->amount_paid);
 108                     $debit->origin_amount($item->amount_paid);
 109                     $debit->origin_currency_type($e->retrieve_acq_fund($item->fund)->currency_type); # future: cache funds locally
 110                     $debit->encumbrance('f');
 111                     $debit->debit_type('direct_charge');
 112
 113                     if($debit->isnew) {
 114                         $e->create_acq_fund_debit($debit) or return $e->die_event;
 115                     } else {
 116                         $e->update_acq_fund_debit($debit) or return $e->die_event;
 117                     }
 118
 119                     $item->fund_debit($debit->id);
 120                     $e->update_acq_invoice_item($item) or return $e->die_event;
 121                 }
 122
 123             } elsif($item->isdeleted) {
 124
 125                 $e->delete_acq_invoice_item($item) or return $e->die_event;
 126
 127                 if($item->po_item and $e->retrieve_acq_po_item($item->po_item)->fund_debit == $item->fund_debit) {
 128                     # the debit is attached to the po_item.  instead of deleting it, roll it back
 129                     # to being an encumbrance.  Note: a prorated invoice_item that points to a po_item
 130                     # could point to a different fund_debit.  We can't go back in time to collect all the
 131                     # prorated invoice_items (nor is the caller asking us too), so when that happens,
 132                     # just delete the extraneous debit (in the else block).
 133                     my $debit = $e->retrieve_acq_fund_debit($item->fund_debit);
 134                     $debit->encumbrance('t');
 135                     $e->update_acq_fund_debit($debit) or return $e->die_event;
 136                 } elsif($item->fund_debit) {
 137                     $e->delete_acq_fund_debit($e->retrieve_acq_fund_debit($item->fund_debit))
 138                         or return $e->die_event;
 139                 }
 140
 141
 142             } elsif($item->ischanged) {
 143
 144                 my $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or return $e->die_event;
 145                 $debit->amount($item->amount_paid);
 146                 $debit->fund($item->fund);
 147                 $e->update_acq_fund_debit($debit) or return $e->die_event;
 148                 $e->update_acq_invoice_item($item) or return $e->die_event;
 149             }
 150         }
 151     }
 152
 153     $invoice = fetch_invoice_impl($e, $invoice->id);
 154     $e->commit;
 155
 156     return $invoice;
 157 }
 158
 159
 160 sub rollback_entry_debits {
 161     my($e, $entry) = @_;
 162     my $debits = find_entry_debits($e, $entry, 'f', entry_amount_per_item($entry));
 163     my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem) or return $e->die_event;
 164
 165     for my $debit (@$debits) {
 166         # revert to the original estimated amount re-encumber
 167         $debit->encumbrance('t');
 168         $debit->amount($lineitem->estimated_unit_price());
 169         $e->update_acq_fund_debit($debit) or return $e->die_event;
 170         update_copy_cost($e, $debit) or return $e->die_event; # clear the cost
 171     }
 172
 173     return undef;
 174 }
 175
 176 sub update_entry_debits {
 177     my($e, $entry) = @_;
 178
 179     my $debits = find_entry_debits($e, $entry, 't');
 180     return undef unless @$debits;
 181
 182     if($entry->phys_item_count > @$debits) {
 183         $e->rollback;
 184         # We can't invoice for more items than we have debits for
 185         return OpenILS::Event->new(
 186             'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS',
 187             payload => {entry => $entry->id});
 188     }
 189
 190     for my $debit (@$debits) {
 191         my $amount = entry_amount_per_item($entry);
 192         $debit->amount($amount);
 193         $debit->encumbrance('f');
 194         $e->update_acq_fund_debit($debit) or return $e->die_event;
 195
 196         # TODO: this does not reflect ancillary charges, like taxes, etc.
 197         # We may need a way to indicate whether the amount attached to an
 198         # invoice_item should be prorated and included in the copy cost.
 199         # Note that acq.invoice_item_type.prorate does not necessarily
 200         # mean a charge should be included in the copy price, only that
 201         # it should spread accross funds.
 202         update_copy_cost($e, $debit, $amount) or return $e->die_event;
 203     }
 204
 205     return undef;
 206 }
 207
 208 # update the linked copy to reflect the amount paid for the item
 209 # returns true on success, false on error
 210 sub update_copy_cost {
 211     my ($e, $debit, $amount) = @_;
 212
 213     my $lid = $e->search_acq_lineitem_detail([
 214         {fund_debit => $debit->id},
 215         {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}}
 216     ])->[0];
 217
 218     if($lid and my $copy = $lid->eg_copy_id) {
 219         defined $amount and $copy->cost($amount) or $copy->clear_cost;
 220         $copy->editor($e->requestor->id);
 221         $copy->edit_date('now');
 222         $e->update_asset_copy($copy) or return 0;
 223     }
 224
 225     return 1;
 226 }
 227
 228
 229 sub entry_amount_per_item {
 230     my $entry = shift;
 231     return $entry->amount_paid if $U->is_true($entry->billed_per_item);
 232     return 0 if $entry->phys_item_count == 0;
 233     return $entry->amount_paid / $entry->phys_item_count;
 234 }
 235
 236 sub easy_money { # TODO XXX replace with something from a library
 237     my ($val) = @_;
 238
 239     my $rounded = int($val * 100) / 100.0;
 240     if ($rounded == $val) {
 241         return sprintf("%.02f", $val);
 242     } else {
 243         return sprintf("%g", $val);
 244     }
 245 }
 246
 247 # 0 on failure (caller should call $e->die_event), array on success
 248 sub amounts_spent_per_fund {
 249     my ($e, $inv_id) = @_;
 250
 251     my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or
 252         return 0;
 253
 254     my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or
 255         return 0;
 256
 257     my %totals_by_fund;
 258     foreach my $entry (@$entries) {
 259         my $debits = find_entry_debits($e, $entry, "f") or return 0;
 260         foreach (@$debits) {
 261             $totals_by_fund{$_->fund} ||= 0.0;
 262             $totals_by_fund{$_->fund} += $_->amount;
 263         }
 264     }
 265
 266     foreach my $item (@$items) {
 267         next unless $item->fund and $item->amount_paid;
 268         $totals_by_fund{$item->fund} ||= 0.0;
 269         $totals_by_fund{$item->fund} += $item->amount_paid;
 270     }
 271
 272     my @totals;
 273     foreach my $fund_id (keys %totals_by_fund) {
 274         my $fund = $e->retrieve_acq_fund($fund_id) or return 0;
 275         push @totals, {
 276             "fund" => $fund->to_bare_hash,
 277             "total" => easy_money($totals_by_fund{$fund_id})
 278         };
 279     }
 280
 281     return \@totals;
 282 }
 283
 284 # there is no direct link between invoice_entry and fund debits.
 285 # when we need to retrieve the related debits, we have to do some searching
 286 sub find_entry_debits {
 287     my($e, $entry, $encumbrance, $amount) = @_;
 288
 289     my $query = {
 290         select => {acqfdeb => ['id']},
 291         from => {
 292             acqfdeb => {
 293                 acqlid => {
 294                     join => {
 295                         jub =>  {
 296                             join => {
 297                                 acqie => {
 298                                     filter => {id => $entry->id}
 299                                 }
 300                             }
 301                         }
 302                     }
 303                 }
 304             }
 305         },
 306         where => {'+acqfdeb' => {encumbrance => $encumbrance}},
 307         order_by => {'acqlid' => ['recv_time']}, # un-received items will sort to the end
 308         limit => $entry->phys_item_count
 309     };
 310
 311     $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
 312
 313     my $debits = $e->json_query($query);
 314     my $debit_ids = [map { $_->{id} } @$debits];
 315     return (@$debit_ids) ? $e->search_acq_fund_debit({id => $debit_ids}) : [];
 316 }
 317
 318
 319 __PACKAGE__->register_method(
 320         method => 'build_invoice_api',
 321         api_name        => 'open-ils.acq.invoice.retrieve',
 322     authoritative => 1,
 323         signature => {
 324         desc => q/Creates a new stub invoice/,
 325         params => [
 326             {desc => 'Authentication token', type => 'string'},
 327             {desc => q/Invoice Id/, type => 'number'},
 328         ],
 329         return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 330     }
 331 );
 332
 333
 334 sub fetch_invoice_api {
 335     my($self, $conn, $auth, $invoice_id, $options) = @_;
 336
 337     my $e = new_editor(authtoken=>$auth);
 338     return $e->event unless $e->checkauth;
 339
 340     my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
 341         return $e->event;
 342     return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
 343
 344     return $invoice;
 345 }
 346
 347 sub fetch_invoice_impl {
 348     my ($e, $invoice_id, $options) = @_;
 349
 350     $options ||= {};
 351
 352     my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
 353         $invoice_id,
 354         {
 355             "flesh" => 6,
 356             "flesh_fields" => {
 357                 "acqinv" => ["entries", "items"],
 358                 "acqii" => ["fund_debit", "purchase_order", "po_item"]
 359             }
 360         }
 361     ];
 362
 363     return $e->retrieve_acq_invoice($args);
 364 }
 365
 366 __PACKAGE__->register_method(
 367         method => 'prorate_invoice',
 368         api_name        => 'open-ils.acq.invoice.apply_prorate',
 369         signature => {
 370         desc => q/
 371             For all invoice items that have the prorate flag set to true, this will create the necessary
 372             additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
 373         /,
 374         params => [
 375             {desc => 'Authentication token', type => 'string'},
 376             {desc => q/Invoice Id/, type => 'number'},
 377         ],
 378         return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 379     }
 380 );
 381
 382
 383 sub prorate_invoice {
 384     my($self, $conn, $auth, $invoice_id) = @_;
 385
 386     my $e = new_editor(xact => 1, authtoken=>$auth);
 387     return $e->die_event unless $e->checkauth;
 388
 389     my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
 390     return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
 391
 392     my @lid_debits;
 393     push(@lid_debits, @{find_entry_debits($e, $_, 'f', entry_amount_per_item($_))}) for @{$invoice->entries};
 394
 395     my $inv_items = $e->search_acq_invoice_item([
 396         {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}},
 397         {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}}
 398     ]) or return $e->die_event;
 399
 400     my @item_debits = map { $_->fund_debit } @$inv_items;
 401
 402     my %fund_totals;
 403     my $total_entry_paid = 0;
 404     for my $debit (@lid_debits, @item_debits) {
 405         $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
 406         $fund_totals{$debit->fund} += $debit->amount;
 407         $total_entry_paid += $debit->amount;
 408     }
 409
 410     $logger->info("invoice: prorating against invoice amount $total_entry_paid");
 411
 412     for my $item (@{$invoice->items}) {
 413
 414         next if $item->fund_debit; # item has already been processed
 415
 416         # future: cache item types locally
 417         my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
 418         next unless $U->is_true($item_type->prorate);
 419
 420         # Prorate charges across applicable funds
 421         my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
 422         my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
 423         my $first_round = 1;
 424         my $largest_debit;
 425         my $largest_item;
 426         my $total_debited = 0;
 427         my $total_costed = 0;
 428
 429         for my $fund_id (keys %fund_totals) {
 430
 431             my $spent_for_fund = $fund_totals{$fund_id};
 432             next unless $spent_for_fund > 0;
 433
 434             my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
 435             my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
 436             $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
 437
 438             my $debit;
 439             if($first_round and $item->po_item) {
 440                 # if this item is the result of a PO item, repurpose the original debit
 441                 # for the first chunk of the prorated amount
 442                 $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
 443             } else {
 444                 $debit = Fieldmapper::acq::fund_debit->new;
 445                 $debit->isnew(1);
 446             }
 447
 448             $debit->fund($fund_id);
 449             $debit->amount($prorated_amount);
 450             $debit->origin_amount($prorated_amount);
 451             $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
 452             $debit->encumbrance('f');
 453             $debit->debit_type('prorated_charge');
 454
 455             if($debit->isnew) {
 456                 $e->create_acq_fund_debit($debit) or return $e->die_event;
 457             } else {
 458                 $e->update_acq_fund_debit($debit) or return $e->die_event;
 459             }
 460
 461             $total_debited += $prorated_amount;
 462             $total_costed += $prorated_cost;
 463             $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
 464
 465             if($first_round) {
 466
 467                 # re-purpose the original invoice_item for the first prorated amount
 468                 $item->fund($fund_id);
 469                 $item->fund_debit($debit->id);
 470                 $item->amount_paid($prorated_amount);
 471                 $item->cost_billed($prorated_cost);
 472                 $e->update_acq_invoice_item($item) or return $e->die_event;
 473                 $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 474
 475             } else {
 476
 477                 # for subsequent prorated amounts, create a new invoice_item
 478                 my $new_item = $item->clone;
 479                 $new_item->clear_id;
 480                 $new_item->fund($fund_id);
 481                 $new_item->fund_debit($debit->id);
 482                 $new_item->amount_paid($prorated_amount);
 483                 $new_item->cost_billed($prorated_cost);
 484                 $e->create_acq_invoice_item($new_item) or return $e->die_event;
 485                 $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 486             }
 487
 488             $first_round = 0;
 489         }
 490
 491         # make sure the percentages didn't leave a small sliver of money over/under-debited
 492         # if so, tweak the largest debit to smooth out the difference
 493         if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
 494
 495             my $paid_diff = $full_item_paid - $total_debited;
 496             my $cost_diff = $full_item_cost - $total_debited;
 497             $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
 498             my $new_paid = $largest_item->amount_paid + $paid_diff;
 499             my $new_cost = $largest_item->cost_billed + $cost_diff;
 500
 501             $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
 502             $largest_debit->amount($new_paid);
 503             $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
 504
 505             $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
 506             $largest_item->amount_paid($new_paid);
 507             $largest_item->cost_billed($new_cost);
 508
 509             $e->update_acq_invoice_item($largest_item) or return $e->die_event;
 510         }
 511     }
 512
 513     $invoice = fetch_invoice_impl($e, $invoice_id);
 514     $e->commit;
 515
 516     return $invoice;
 517 }
 518
 519
 520 __PACKAGE__->register_method(
 521     method      => "print_html_invoice",
 522     api_name    => "open-ils.acq.invoice.print.html",
 523     stream      => 1,
 524     signature   => {
 525         desc    => "Retrieve printable HTML vouchers for each given invoice",
 526         params => [
 527             {desc => "Authentication token", type => "string"},
 528             {desc => "Invoice ID or a list of them", type => "mixed"},
 529         ],
 530         return => {
 531             desc => q{One A/T event containing a printable HTML voucher for
 532                 each given invoice},
 533             type => "object", class => "atev"}
 534     }
 535 );
 536
 537
 538 sub print_html_invoice {
 539     my ($self, $conn, $auth, $id_list) = @_;
 540
 541     my $e = new_editor("authtoken" => $auth);
 542     return $e->die_event unless $e->checkauth;
 543
 544     $id_list = [$id_list] unless ref $id_list;
 545
 546     my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
 547         return $e->die_event;
 548
 549     foreach my $invoice (@$invoices) {
 550         return $e->die_event unless
 551             $e->allowed("VIEW_INVOICE", $invoice->receiver);
 552
 553         my $amounts = amounts_spent_per_fund($e, $invoice->id) or
 554             return $e->die_event;
 555
 556         $conn->respond(
 557             $U->fire_object_event(
 558                 undef, "format.acqinv.html", $invoice, $invoice->receiver,
 559                 "print-on-demand", $amounts
 560             )
 561         );
 562     }
 563
 564     $e->disconnect;
 565     undef;
 566 }
 567
 568 1;