Open-ILS/src/perlmods/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 = Fieldmapper::acq::fund_debit->new;
  99                     $debit->fund($item->fund);
 100                     $debit->amount($item->amount_paid);
 101                     $debit->origin_amount($item->amount_paid);
 102                     $debit->origin_currency_type($e->retrieve_acq_fund($item->fund)->currency_type); # future: cache funds locally
 103                     $debit->encumbrance('f');
 104                     $debit->debit_type('direct_charge');
 105                     $e->create_acq_fund_debit($debit) or return $e->die_event;
 106
 107                     $item->fund_debit($debit->id);
 108                     $e->update_acq_invoice_item($item) or return $e->die_event;
 109                 }
 110
 111             } elsif($item->isdeleted) {
 112
 113                 $e->delete_acq_invoice_item($item) or return $e->die_event;
 114
 115                 # kill the debit
 116                 $e->delete_acq_fund_debit(
 117                     $e->retrieve_acq_fund_debit($item->fund_debit)
 118                 ) or return $e->die_event;
 119
 120
 121             } elsif($item->ischanged) {
 122
 123                 my $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or return $e->die_event;
 124                 $debit->amount($item->amount_paid);
 125                 $debit->fund($item->fund);
 126                 $e->update_acq_fund_debit($debit) or return $e->die_event;
 127                 $e->update_acq_invoice_item($item) or return $e->die_event;
 128             }
 129         }
 130     }
 131
 132     $invoice = fetch_invoice_impl($e, $invoice->id);
 133     $e->commit;
 134
 135     return $invoice;
 136 }
 137
 138
 139 sub rollback_entry_debits {
 140     my($e, $entry) = @_;
 141     my $debits = find_entry_debits($e, $entry, 'f', entry_amount_per_item($entry));
 142     my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem) or return $e->die_event;
 143
 144     for my $debit (@$debits) {
 145
 146         # revert to the original estimated amount re-encumber
 147         $debit->encumbrance('t');
 148         $debit->amount($lineitem->estimated_unit_price());
 149         $e->update_acq_fund_debit($debit) or return $e->die_event;
 150     }
 151
 152     return undef;
 153 }
 154
 155 sub update_entry_debits {
 156     my($e, $entry) = @_;
 157
 158     my $debits = find_entry_debits($e, $entry, 't');
 159     return undef unless @$debits;
 160
 161     if($entry->phys_item_count > @$debits) {
 162         $e->rollback;
 163         # We can't invoice for more items than we have debits for
 164         return OpenILS::Event->new(
 165             'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS',
 166             payload => {entry => $entry->id});
 167     }
 168
 169     for my $debit (@$debits) {
 170         $debit->amount(entry_amount_per_item($entry));
 171         $debit->encumbrance('f');
 172         $e->update_acq_fund_debit($debit) or return $e->die_event;
 173     }
 174
 175     return undef;
 176 }
 177
 178
 179 sub entry_amount_per_item {
 180     my $entry = shift;
 181     return $entry->amount_paid if $U->is_true($entry->billed_per_item);
 182     return 0 if $entry->phys_item_count == 0;
 183     return $entry->amount_paid / $entry->phys_item_count;
 184 }
 185
 186
 187 # there is no direct link between invoice_entry and fund debits.
 188 # when we need to retrieve the related debits, we have to do some searching
 189 sub find_entry_debits {
 190     my($e, $entry, $encumbrance, $amount) = @_;
 191
 192     my $query = {
 193         select => {acqfdeb => ['id']},
 194         from => {
 195             acqfdeb => {
 196                 acqlid => {
 197                     join => {
 198                         jub =>  {
 199                             join => {
 200                                 acqie => {
 201                                     filter => {id => $entry->id}
 202                                 }
 203                             }
 204                         }
 205                     }
 206                 }
 207             }
 208         },
 209         where => {'+acqfdeb' => {encumbrance => $encumbrance}},
 210         order_by => {'acqlid' => ['recv_time']}, # un-received items will sort to the end
 211         limit => $entry->phys_item_count
 212     };
 213
 214     $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
 215
 216     my $debits = $e->json_query($query);
 217     my $debit_ids = [map { $_->{id} } @$debits];
 218     return (@$debit_ids) ? $e->search_acq_fund_debit({id => $debit_ids}) : [];
 219 }
 220
 221
 222 __PACKAGE__->register_method(
 223         method => 'build_invoice_api',
 224         api_name        => 'open-ils.acq.invoice.retrieve',
 225         signature => {
 226         desc => q/Creates a new stub invoice/,
 227         params => [
 228             {desc => 'Authentication token', type => 'string'},
 229             {desc => q/Invoice Id/, type => 'number'},
 230         ],
 231         return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 232     }
 233 );
 234
 235
 236 sub fetch_invoice_api {
 237     my($self, $conn, $auth, $invoice_id, $options) = @_;
 238
 239     my $e = new_editor(authtoken=>$auth);
 240     return $e->event unless $e->checkauth;
 241
 242     my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
 243         return $e->event;
 244     return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
 245
 246     return $invoice;
 247 }
 248
 249 sub fetch_invoice_impl {
 250     my ($e, $invoice_id, $options) = @_;
 251
 252     $options ||= {};
 253
 254     my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
 255         $invoice_id,
 256         {
 257             "flesh" => 6,
 258             "flesh_fields" => {
 259                 "acqinv" => ["entries", "items"],
 260                 "acqii" => ["fund_debit"],
 261             }
 262         }
 263     ];
 264
 265     return $e->retrieve_acq_invoice($args);
 266 }
 267
 268 __PACKAGE__->register_method(
 269         method => 'prorate_invoice',
 270         api_name        => 'open-ils.acq.invoice.apply_prorate',
 271         signature => {
 272         desc => q/
 273             For all invoice items that have the prorate flag set to true, this will create the necessary
 274             additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
 275         /,
 276         params => [
 277             {desc => 'Authentication token', type => 'string'},
 278             {desc => q/Invoice Id/, type => 'number'},
 279         ],
 280         return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
 281     }
 282 );
 283
 284
 285 sub prorate_invoice {
 286     my($self, $conn, $auth, $invoice_id) = @_;
 287
 288     my $e = new_editor(xact => 1, authtoken=>$auth);
 289     return $e->die_event unless $e->checkauth;
 290
 291     my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
 292     return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
 293
 294     my @lid_debits;
 295     push(@lid_debits, @{find_entry_debits($e, $_, 'f', entry_amount_per_item($_))}) for @{$invoice->entries};
 296
 297     my %fund_totals;
 298     my $total_entry_paid = 0;
 299     for my $debit (@lid_debits) {
 300         $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
 301         $fund_totals{$debit->fund} += $debit->amount;
 302         $total_entry_paid += $debit->amount;
 303     }
 304
 305     $logger->info("invoice: prorating against invoice amount $total_entry_paid");
 306
 307     for my $item (@{$invoice->items}) {
 308
 309         next if $item->fund_debit; # item has already been processed
 310
 311         # future: cache item types locally
 312         my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
 313         next unless $U->is_true($item_type->prorate);
 314
 315         # Prorate charges across applicable funds
 316         my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
 317         my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
 318         my $first_round = 1;
 319         my $largest_debit;
 320         my $largest_item;
 321         my $total_debited = 0;
 322         my $total_costed = 0;
 323
 324         for my $fund_id (keys %fund_totals) {
 325
 326             my $spent_for_fund = $fund_totals{$fund_id};
 327             next unless $spent_for_fund > 0;
 328
 329             my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
 330             my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
 331             $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
 332
 333             my $debit = Fieldmapper::acq::fund_debit->new;
 334             $debit->fund($fund_id);
 335             $debit->amount($prorated_amount);
 336             $debit->origin_amount($prorated_amount);
 337             $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
 338             $debit->encumbrance('f');
 339             $debit->debit_type('prorated_charge');
 340
 341             $e->create_acq_fund_debit($debit) or return $e->die_event;
 342
 343             $total_debited += $prorated_amount;
 344             $total_costed += $prorated_cost;
 345             $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
 346
 347             if($first_round) {
 348
 349                 # re-purpose the original invoice_item for the first prorated amount
 350                 $item->fund($fund_id);
 351                 $item->fund_debit($debit->id);
 352                 $item->amount_paid($prorated_amount);
 353                 $item->cost_billed($prorated_cost);
 354                 $e->update_acq_invoice_item($item) or return $e->die_event;
 355                 $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 356
 357             } else {
 358
 359                 # for subsequent prorated amounts, create a new invoice_item
 360                 my $new_item = $item->clone;
 361                 $new_item->clear_id;
 362                 $new_item->fund($fund_id);
 363                 $new_item->fund_debit($debit->id);
 364                 $new_item->amount_paid($prorated_amount);
 365                 $new_item->cost_billed($prorated_cost);
 366                 $e->create_acq_invoice_item($new_item) or return $e->die_event;
 367                 $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
 368             }
 369
 370             $first_round = 0;
 371         }
 372
 373         # make sure the percentages didn't leave a small sliver of money over/under-debited
 374         # if so, tweak the largest debit to smooth out the difference
 375         if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
 376
 377             my $paid_diff = $full_item_paid - $total_debited;
 378             my $cost_diff = $full_item_cost - $total_debited;
 379             $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
 380             my $new_paid = $largest_item->amount + $paid_diff;
 381             my $new_cost = $largest_item->cost_billed + $cost_diff;
 382
 383             $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
 384             $largest_debit->amount($new_paid);
 385             $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
 386
 387             $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
 388             $largest_item->amount_paid($new_paid);
 389             $largest_item->cost_billed($new_cost);
 390
 391             $e->update_acq_invoice_item($largest_item) or return $e->die_event;
 392         }
 393     }
 394
 395     $invoice = fetch_invoice_impl($e, $invoice_id);
 396     $e->commit;
 397
 398     return $invoice;
 399 }
 400
 401
 402 __PACKAGE__->register_method(
 403     method      => "print_html_invoice",
 404     api_name    => "open-ils.acq.invoice.print.html",
 405     stream      => 1,
 406     signature   => {
 407         desc    => "Retrieve printable HTML vouchers for each given invoice",
 408         params => [
 409             {desc => "Authentication token", type => "string"},
 410             {desc => "Invoice ID or a list of them", type => "mixed"},
 411         ],
 412         return => {
 413             desc => q{One A/T event containing a printable HTML voucher for
 414                 each given invoice},
 415             type => "object", class => "atev"}
 416     }
 417 );
 418
 419
 420 sub print_html_invoice {
 421     my ($self, $conn, $auth, $id_list) = @_;
 422
 423     my $e = new_editor("authtoken" => $auth);
 424     return $e->die_event unless $e->checkauth;
 425
 426     $id_list = [$id_list] unless ref $id_list;
 427
 428     my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
 429         return $e->die_event;
 430
 431     foreach my $invoice (@$invoices) {
 432         return $e->die_event unless
 433             $e->allowed("VIEW_INVOICE", $invoice->receiver);
 434
 435         $conn->respond(
 436             $U->fire_object_event(
 437                 undef, "format.acqinv.html", $invoice, $invoice->receiver,
 438                 "print-on-demand"
 439             )
 440         );
 441     }
 442
 443     $e->disconnect;
 444     undef;
 445 }
 446
 447 1;