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