1 # ---------------------------------------------------------------
2 # Copyright (C) 2005 Georgia Public Library Service
3 # Bill Erickson <billserickson@gmail.com>
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 # ---------------------------------------------------------------
16 package OpenILS::Application::Circ::Money;
17 use base qw/OpenILS::Application/;
18 use strict; use warnings;
19 use OpenILS::Application::AppUtils;
20 use OpenILS::Application::Circ::CircCommon;
21 my $apputils = "OpenILS::Application::AppUtils";
22 my $U = "OpenILS::Application::AppUtils";
23 my $CC = "OpenILS::Application::Circ::CircCommon";
25 use OpenSRF::EX qw(:try);
29 use OpenSRF::Utils::Logger qw/:logger/;
30 use OpenILS::Utils::CStoreEditor qw/:funcs/;
31 use OpenILS::Utils::Penalty;
33 $Data::Dumper::Indent = 0;
34 use OpenILS::Const qw/:const/;
35 use OpenILS::Utils::DateTime qw/:datetime/;
36 use DateTime::Format::ISO8601;
37 my $parser = DateTime::Format::ISO8601->new;
39 sub get_processor_settings {
42 my $processor = lc shift;
44 # Get the names of every credit processor setting for our given processor.
45 # They're a little different per processor.
46 my $setting_names = $e->json_query({
47 select => {coust => ["name"]},
48 from => {coust => {}},
49 where => {name => {like => "credit.processor.${processor}.%"}}
50 }) or return $e->die_event;
52 # Make keys for a hash we're going to build out of the last dot-delimited
53 # component of each setting name.
54 ($_->{key} = $_->{name}) =~ s/.+\.(\w+)$/$1/ for @$setting_names;
56 # Return a hash with those short keys, and for values the value of
57 # the corresponding OU setting within our scope.
60 $_->{key} => $U->ou_ancestor_setting_value($org_unit, $_->{name})
65 # process_stripe_or_bop_payment()
66 # This is a helper method to make_payments() below (specifically,
67 # the credit-card part). It's the first point in the Perl code where
68 # we need to care about the distinction between Stripe and the
69 # Paypal/PayflowPro/AuthorizeNet kinds of processors (the latter group
70 # uses B::OP and handles payment card info, whereas Stripe doesn't use
71 # B::OP and doesn't require us to know anything about the payment card
74 # Return an event in all cases. That means a success returns a SUCCESS
76 sub process_stripe_or_bop_payment {
77 my ($e, $user_id, $this_ou, $total_paid, $cc_args) = @_;
79 # A few stanzas to determine which processor we're using and whether we're
80 # really adequately set up for it.
81 if (!$cc_args->{processor}) {
82 if (!($cc_args->{processor} =
83 $U->ou_ancestor_setting_value(
84 $this_ou, 'credit.processor.default'
88 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
92 # Make sure the configured credit processor has a safe/correct name.
93 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED')
94 unless $cc_args->{processor} =~ /^[a-z0-9_\-]+$/i;
96 # Get the settings for the processor and make sure they're serviceable.
97 my $psettings = get_processor_settings($e, $this_ou, $cc_args->{processor});
98 return $psettings if defined $U->event_code($psettings);
99 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED')
100 unless $psettings->{enabled};
102 # Now we branch. Stripe is one thing, and everything else is another.
104 if ($cc_args->{processor} eq 'Stripe') { # Stripe
105 my $stripe = Business::Stripe->new(-api_key => $psettings->{secretkey});
106 $stripe->charges_create(
107 amount => ($total_paid * 100), # Stripe takes amount in pennies
108 card => $cc_args->{stripe_token},
109 description => $cc_args->{note}
112 if ($stripe->success) {
113 $logger->info("Stripe payment succeeded");
114 return OpenILS::Event->new(
115 "SUCCESS", payload => {
116 map { $_ => $stripe->success->{$_} } qw(
117 invoice customer balance_transaction id created card
122 $logger->info("Stripe payment failed");
123 return OpenILS::Event->new(
124 "CREDIT_PROCESSOR_DECLINED_TRANSACTION",
125 payload => $stripe->error # XXX what happens if this contains
126 # JSON::backportPP::* objects?
130 } else { # B::OP style (Paypal/PayflowPro/AuthorizeNet)
131 return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number')
132 unless $cc_args->{number};
134 return OpenILS::Application::Circ::CreditCard::process_payment({
135 "processor" => $cc_args->{processor},
136 "desc" => $cc_args->{note},
137 "amount" => $total_paid,
138 "patron_id" => $user_id,
139 "cc" => $cc_args->{number},
140 "expiration" => sprintf(
142 $cc_args->{expire_month},
143 $cc_args->{expire_year}
146 "first_name" => $cc_args->{billing_first},
147 "last_name" => $cc_args->{billing_last},
148 "address" => $cc_args->{billing_address},
149 "city" => $cc_args->{billing_city},
150 "state" => $cc_args->{billing_state},
151 "zip" => $cc_args->{billing_zip},
152 "cvv2" => $cc_args->{cvv2},
159 __PACKAGE__->register_method(
160 method => "make_payments",
161 api_name => "open-ils.circ.money.payment",
163 desc => q/Create payments for a given user and set of transactions,
164 login must have CREATE_PAYMENT privileges.
165 If any payments fail, all are reverted back./,
167 {desc => 'Authtoken', type => 'string'},
168 {desc => q/Arguments Hash, supporting the following params:
175 where_process 1 to use processor, !1 for out-of-band
176 approval_code (for out-of-band payment)
177 type (for out-of-band payment)
178 number (for call to payment processor)
179 stripe_token (for call to Stripe payment processor)
180 expire_month (for call to payment processor)
181 expire_year (for call to payment processor)
182 billing_first (for out-of-band payments and for call to payment processor)
183 billing_last (for out-of-band payments and for call to payment processor)
184 billing_address (for call to payment processor)
185 billing_city (for call to payment processor)
186 billing_state (for call to payment processor)
187 billing_zip (for call to payment processor)
188 note (if payments->{note} is blank, use this)
198 desc => q/Last user transaction ID. This is the actor.usr.last_xact_id value/,
204 q{Array of payment IDs on success, event on failure. Event possibilities include:
206 Bad parameters were given to this API method itself.
209 The last user transaction ID does not match the ID in the database. This means
210 the user object has been updated since the last retrieval. The client should
211 be instructed to reload the user object and related transactions before attempting
213 REFUND_EXCEEDS_BALANCE
214 REFUND_EXCEEDS_DESK_PAYMENTS
215 CREDIT_PROCESSOR_NOT_SPECIFIED
216 Evergreen has not been set up to process CC payments.
217 CREDIT_PROCESSOR_NOT_ALLOWED
218 Evergreen has been incorrectly setup for CC payments.
219 CREDIT_PROCESSOR_NOT_ENABLED
220 Evergreen has been set up for CC payments, but an admin
221 has not explicitly enabled them.
222 CREDIT_PROCESSOR_BAD_PARAMS
223 Evergreen has been incorrectly setup for CC payments;
224 specifically, the login and/or password for the CC
225 processor weren't provided.
226 CREDIT_PROCESSOR_INVALID_CC_NUMBER
227 You have supplied a credit card number that Evergreen
228 has judged to be invalid even before attempting to contact
229 the payment processor.
230 CREDIT_PROCESSOR_DECLINED_TRANSACTION
231 We contacted the CC processor to attempt the charge, but
233 The error_message field of the event payload will
234 contain the payment processor's response. This
235 typically includes a message in plain English intended
236 for human consumption. In PayPal's case, the message
237 is preceded by an integer, a colon, and a space, so
238 a caller might take the 2nd match from /^(\d+: )?(.+)$/
239 to present to the user.
240 The payload also contains other fields from the payment
241 processor, but these are generally not user-friendly
243 CREDIT_PROCESSOR_SUCCESS_WO_RECORD
244 A payment was processed successfully, but couldn't be
245 recorded in Evergreen. This is _bad bad bad_, as it means
246 somebody made a payment but isn't getting credit for it.
247 See errors in the system log if this happens. Info from
248 the credit card transaction will also be available in the
249 event payload, although this probably won't be suitable for
250 staff client/OPAC display.
257 my($self, $client, $auth, $payments, $last_xact_id) = @_;
259 my $e = new_editor(authtoken => $auth, xact => 1);
260 return $e->die_event unless $e->checkauth;
262 my $type = $payments->{payment_type};
263 my $user_id = $payments->{userid};
264 my $credit = $payments->{patron_credit} || 0;
265 my $drawer = $e->requestor->wsid;
266 my $note = $payments->{note};
267 my $cc_args = $payments->{cc_args};
268 my $check_number = $payments->{check_number};
270 my $this_ou = $e->requestor->ws_ou || $e->requestor->home_ou;
274 # unless/until determined by payment processor API
275 my ($approval_code, $cc_processor, $cc_order_number) = (undef,undef,undef, undef);
277 my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event;
279 if($patron->last_xact_id ne $last_xact_id) {
281 return OpenILS::Event->new('INVALID_USER_XACT_ID');
284 # A user is allowed to make credit card payments on his/her own behalf
285 # All other scenarious require permission
286 unless($type eq 'credit_card_payment' and $user_id == $e->requestor->id) {
287 return $e->die_event unless $e->allowed('CREATE_PAYMENT', $patron->home_ou);
290 # first collect the transactions and make sure the transaction
291 # user matches the requested user
294 # We rewrite the payments array for sanity's sake, to avoid more
295 # than one payment per transaction per call, which is not legitimate
296 # but has been seen in the wild coming from the staff client. This
297 # is presumably a staff client (xulrunner) bug.
298 my @unique_xact_payments;
299 for my $pay (@{$payments->{payments}}) {
300 my $xact_id = $pay->[0];
301 if (exists($xacts{$xact_id})) {
303 return OpenILS::Event->new('MULTIPLE_PAYMENTS_FOR_XACT');
306 my $xact = $e->retrieve_money_billable_transaction_summary($xact_id)
307 or return $e->die_event;
309 if($xact->usr != $user_id) {
311 return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/);
314 $xacts{$xact_id} = $xact;
315 push @unique_xact_payments, $pay;
317 $payments->{payments} = \@unique_xact_payments;
321 for my $pay (@{$payments->{payments}}) {
322 my $transid = $pay->[0];
323 my $amount = $pay->[1];
324 $amount =~ s/\$//og; # just to be safe
325 my $trans = $xacts{$transid};
327 # add amounts as integers
328 $total_paid += (100 * $amount);
330 my $org_id = $U->xact_org($transid, $e);
332 if (!$orgs{$org_id}) {
335 # patron credit has to be allowed at all orgs receiving payment
336 if ($type eq 'credit_payment' and $U->ou_ancestor_setting_value(
337 $org_id, 'circ.disable_patron_credit', $e)) {
339 return OpenILS::Event->new('PATRON_CREDIT_DISABLED');
343 # A negative payment is a refund.
346 # Negative credit card payments are not allowed
347 if($type eq 'credit_card_payment') {
349 return OpenILS::Event->new(
351 note => q/Negative credit card payments not allowed/
355 # If the refund causes the transaction balance to exceed 0 dollars,
356 # we are in effect loaning the patron money. This is not allowed.
357 if( ($trans->balance_owed - $amount) > 0 ) {
359 return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
362 # Otherwise, make sure the refund does not exceed desk payments
363 # This is also not allowed
365 my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
366 $desk_total += $_->amount for @$desk_payments;
368 if( (-$amount) > $desk_total ) {
370 return OpenILS::Event->new(
371 'REFUND_EXCEEDS_DESK_PAYMENTS',
372 payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
376 my $payobj = "Fieldmapper::money::$type";
377 $payobj = $payobj->new;
379 $payobj->amount($amount);
380 $payobj->amount_collected($amount);
381 $payobj->xact($transid);
382 $payobj->note($note);
383 if ((not $payobj->note) and ($type eq 'credit_card_payment')) {
384 $payobj->note($cc_args->{note});
387 if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); }
388 if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); }
389 if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); }
391 # Store the last 4 digits of the CC number
392 if ($payobj->has_field('cc_number')) {
393 $payobj->cc_number(substr($cc_args->{number}, -4));
396 # Note: It is important not to set approval_code
397 # on the fieldmapper object yet.
399 push(@payment_objs, $payobj);
401 } # all payment objects have been created and inserted.
403 # return to decimal format, forcing X.YY format for consistency.
404 $total_paid = sprintf("%.2f", $total_paid / 100);
406 #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED ###
409 # After we try to externally process a credit card (if desired), we'll
410 # open a new transaction. We cannot leave one open while credit card
411 # processing might be happening, as it can easily time out the database
416 if($type eq 'credit_card_payment') {
417 $approval_code = $cc_args->{approval_code};
418 # If an approval code was not given, we'll need
419 # to call to the payment processor ourselves.
420 if ($cc_args->{where_process} == 1) {
421 my $response = process_stripe_or_bop_payment(
422 $e, $user_id, $this_ou, $total_paid, $cc_args
425 if ($U->event_code($response)) { # non-success (success is 0)
427 "Credit card payment for user $user_id failed: " .
428 $response->{textcode} . " " .
429 ($response->{payload}->{error_message} ||
430 $response->{payload}{message})
434 # We need to save this for later in case there's a failure on
435 # the EG side to store the processor's result.
437 $cc_payload = $response->{"payload"}; # also used way later
440 no warnings 'uninitialized';
441 $approval_code = $cc_payload->{authorization} ||
443 $cc_processor = $cc_payload->{processor} ||
444 $cc_args->{processor};
445 $cc_order_number = $cc_payload->{order_number} ||
446 $cc_payload->{invoice};
448 $logger->info("Credit card payment for user $user_id succeeded");
451 return OpenILS::Event->new(
452 'BAD_PARAMS', note => 'Need approval code'
453 ) if not $cc_args->{approval_code};
457 ### RE-OPEN TRANSACTION HERE ###
461 # create payment records
462 my $create_money_method = "create_money_" . $type;
463 for my $payment (@payment_objs) {
464 # update the transaction if it's done
465 my $amount = $payment->amount;
466 my $transid = $payment->xact;
467 my $trans = $xacts{$transid};
468 # making payment with existing patron credit.
469 $credit -= $amount if $type eq 'credit_payment';
470 if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) {
471 # Any overpay on this transaction goes directly into patron
475 my $circ = $e->retrieve_action_circulation(
480 flesh_fields => {circ => ['target_copy','billings']}
483 ); # Flesh the copy, so we can monkey with the status if
486 # Whether or not we close the transaction. We definitely
487 # close if no circulation transaction is present,
488 # otherwise we check if the circulation is in a state that
489 # allows itself to be closed.
490 if (!$circ || $CC->can_close_circ($e, $circ)) {
491 $trans = $e->retrieve_money_billable_transaction($transid);
492 $trans->xact_finish("now");
493 if (!$e->update_money_billable_transaction($trans)) {
494 return _recording_failure(
495 $e, "update_money_billable_transaction() failed",
496 $payment, $cc_payload
500 # If we have a circ, we need to check if the copy
501 # status is lost or long overdue. If it is then we
502 # check org_unit_settings for the copy owning library
503 # and adjust and possibly adjust copy status to lost
505 if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
506 # We need the copy to check settings and to possibly
508 my $copy = $circ->target_copy();
509 # Library where we'll check settings.
510 my $check_lib = $copy->circ_lib();
512 # check the copy status
513 if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
514 && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
515 $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
516 if (!$e->update_asset_copy($copy)) {
517 return _recording_failure(
518 $e, "update_asset_copy_failed()",
519 $payment, $cc_payload
527 # Urgh, clean up this mega-function one day.
528 if ($cc_processor eq 'Stripe' and $approval_code and $cc_payload) {
529 $payment->cc_number($cc_payload->{card}{last4});
532 $payment->approval_code($approval_code) if $approval_code;
533 $payment->cc_order_number($cc_order_number) if $cc_order_number;
534 $payment->cc_processor($cc_processor) if $cc_processor;
535 if (!$e->$create_money_method($payment)) {
536 return _recording_failure(
537 $e, "$create_money_method failed", $payment, $cc_payload
541 push(@payment_ids, $payment->id);
544 my $evt = _update_patron_credit($e, $patron, $credit);
546 return _recording_failure(
547 $e, "_update_patron_credit() failed", undef, $cc_payload
551 for my $org_id (keys %orgs) {
552 # calculate penalties for each of the affected orgs
553 $evt = OpenILS::Utils::Penalty->calculate_penalties(
554 $e, $user_id, $org_id
557 return _recording_failure(
558 $e, "calculate_penalties() failed", undef, $cc_payload
563 # update the user to create a new last_xact_id
564 $e->update_actor_user($patron) or return $e->die_event;
565 $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
568 # update the cached user object if a user is making a payment toward
569 # his/her own account
570 $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
571 if $user_id == $e->requestor->id;
573 return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
576 sub _recording_failure {
577 my ($e, $msg, $payment, $payload) = @_;
579 if ($payload) { # If the payment processor already accepted a payment:
580 $logger->error($msg);
581 $logger->error("Payment processor payload: " . Dumper($payload));
582 # payment shouldn't contain CC number
583 $logger->error("Payment: " . Dumper($payment)) if $payment;
587 return new OpenILS::Event(
588 "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
589 "payload" => $payload
591 } else { # Otherwise, the problem is somewhat less severe:
593 $logger->warn("Payment: " . Dumper($payment)) if $payment;
594 return $e->die_event;
598 sub _update_patron_credit {
599 my($e, $patron, $credit) = @_;
600 return undef if $credit == 0;
601 $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
602 return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
603 $e->update_actor_user($patron) or return $e->die_event;
608 __PACKAGE__->register_method(
609 method => "retrieve_payments",
610 api_name => "open-ils.circ.money.payment.retrieve.all_",
611 notes => "Returns a list of payments attached to a given transaction"
613 sub retrieve_payments {
614 my( $self, $client, $login, $transid ) = @_;
617 $apputils->checksesperm($login, 'VIEW_TRANSACTION');
620 # XXX the logic here is wrong.. we need to check the owner of the transaction
621 # to make sure the requestor has access
623 # XXX grab the view, for each object in the view, grab the real object
625 return $apputils->simplereq(
627 'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
631 __PACKAGE__->register_method(
632 method => "retrieve_payments2",
634 api_name => "open-ils.circ.money.payment.retrieve.all",
635 notes => "Returns a list of payments attached to a given transaction"
638 sub retrieve_payments2 {
639 my( $self, $client, $login, $transid ) = @_;
641 my $e = new_editor(authtoken=>$login);
642 return $e->event unless $e->checkauth;
643 return $e->event unless $e->allowed('VIEW_TRANSACTION');
646 my $pmnts = $e->search_money_payment({ xact => $transid });
648 my $type = $_->payment_type;
649 my $meth = "retrieve_money_$type";
650 my $p = $e->$meth($_->id) or return $e->event;
651 $p->payment_type($type);
652 $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
653 if $p->has_field('cash_drawer');
654 push( @payments, $p );
660 __PACKAGE__->register_method(
661 method => "format_payment_receipt",
662 api_name => "open-ils.circ.money.payment_receipt.print",
664 desc => 'Returns a printable receipt for the specified payments',
666 { desc => 'Authentication token', type => 'string'},
667 { desc => 'Payment ID or array of payment IDs', type => 'number' },
670 desc => q/An action_trigger.event object or error event./,
675 __PACKAGE__->register_method(
676 method => "format_payment_receipt",
677 api_name => "open-ils.circ.money.payment_receipt.email",
679 desc => 'Emails a receipt for the specified payments to the user associated with the first payment',
681 { desc => 'Authentication token', type => 'string'},
682 { desc => 'Payment ID or array of payment IDs', type => 'number' },
685 desc => q/Undefined on success, otherwise an error event./,
691 sub format_payment_receipt {
692 my($self, $conn, $auth, $mp_id) = @_;
695 if (ref $mp_id ne 'ARRAY') {
696 $mp_ids = [ $mp_id ];
701 my $for_print = ($self->api_name =~ /print/);
702 my $for_email = ($self->api_name =~ /email/);
704 # manually use xact (i.e. authoritative) so we can kill the cstore
705 # connection before sending the action/trigger request. This prevents our cstore
706 # backend from sitting idle while A/T (which uses its own transactions) runs.
707 my $e = new_editor(xact => 1, authtoken => $auth);
708 return $e->die_event unless $e->checkauth;
711 for my $id (@$mp_ids) {
713 my $payment = $e->retrieve_money_payment([
721 ]) or return $e->die_event;
723 return $e->die_event unless
724 $e->requestor->id == $payment->xact->usr->id or
725 $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou);
727 push @$payments, $payment;
734 return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
736 } elsif ($for_email) {
738 for my $p (@$payments) {
739 $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
746 __PACKAGE__->register_method(
747 method => "create_grocery_bill",
748 api_name => "open-ils.circ.money.grocery.create",
750 Creates a new grocery transaction using the transaction object provided
751 PARAMS: (login_session, money.grocery (mg) object)
754 sub create_grocery_bill {
755 my( $self, $client, $login, $transaction ) = @_;
757 my( $staff, $evt ) = $apputils->checkses($login);
759 $evt = $apputils->check_perms($staff->id,
760 $transaction->billing_location, 'CREATE_TRANSACTION' );
764 $logger->activity("Creating grocery bill " . Dumper($transaction) );
766 $transaction->clear_id;
767 my $session = $apputils->start_db_session;
768 $apputils->set_audit_info($session, $login, $staff->id, $staff->wsid);
769 my $transid = $session->request(
770 'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
772 throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
774 $logger->debug("Created new grocery transaction $transid");
776 $apputils->commit_db_session($session);
778 my $e = new_editor(xact=>1);
779 $evt = $U->check_open_xact($e, $transid);
787 __PACKAGE__->register_method(
788 method => 'fetch_reservation',
789 api_name => 'open-ils.circ.booking.reservation.retrieve'
791 sub fetch_reservation {
792 my( $self, $conn, $auth, $id ) = @_;
793 my $e = new_editor(authtoken=>$auth);
794 return $e->event unless $e->checkauth;
795 return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
796 my $g = $e->retrieve_booking_reservation($id)
801 __PACKAGE__->register_method(
802 method => 'fetch_grocery',
803 api_name => 'open-ils.circ.money.grocery.retrieve'
806 my( $self, $conn, $auth, $id ) = @_;
807 my $e = new_editor(authtoken=>$auth);
808 return $e->event unless $e->checkauth;
809 return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
810 my $g = $e->retrieve_money_grocery($id)
816 __PACKAGE__->register_method(
817 method => "billing_items",
818 api_name => "open-ils.circ.money.billing.retrieve.all",
821 desc => 'Returns a list of billing items for the given transaction ID. ' .
822 'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
824 { desc => 'Authentication token', type => 'string'},
825 { desc => 'Transaction ID', type => 'number'}
828 desc => 'Transaction object, event on error'
834 my( $self, $client, $login, $transid ) = @_;
836 my( $trans, $evt ) = $U->fetch_billable_xact($transid);
840 ($staff, $evt ) = $apputils->checkses($login);
843 if($staff->id ne $trans->usr) {
844 $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
848 return $apputils->simplereq( 'open-ils.cstore',
849 'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
853 __PACKAGE__->register_method(
854 method => "billing_items_create",
855 api_name => "open-ils.circ.money.billing.create",
857 Creates a new billing line item
858 PARAMS( login, bill_object (mb) )
861 sub billing_items_create {
862 my( $self, $client, $login, $billing ) = @_;
864 my $e = new_editor(authtoken => $login, xact => 1);
865 return $e->die_event unless $e->checkauth;
866 return $e->die_event unless $e->allowed('CREATE_BILL');
868 my $xact = $e->retrieve_money_billable_transaction($billing->xact)
869 or return $e->die_event;
871 # if the transaction was closed, re-open it
872 if($xact->xact_finish) {
873 $xact->clear_xact_finish;
874 $e->update_money_billable_transaction($xact)
875 or return $e->die_event;
878 my $amt = $billing->amount;
880 $billing->amount($amt);
882 $e->create_money_billing($billing) or return $e->die_event;
883 my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id,$e));
886 $evt = $U->check_open_xact($e, $xact->id, $xact);
895 __PACKAGE__->register_method(
896 method => 'void_bill',
897 api_name => 'open-ils.circ.money.billing.void',
900 @param authtoken Login session key
901 @param billid Id for the bill to void. This parameter may be repeated to reference other bills.
902 @return 1 on success, Event on error
906 my( $s, $c, $authtoken, @billids ) = @_;
907 my $editor = new_editor(authtoken=>$authtoken, xact=>1);
908 return $editor->die_event unless $editor->checkauth;
909 return $editor->die_event unless $editor->allowed('VOID_BILLING');
910 my $rv = $CC->void_bills($editor, \@billids);
911 if (ref($rv) eq 'HASH') {
915 # We should have gotten 1.
922 __PACKAGE__->register_method(
923 method => 'adjust_bills_to_zero_manual',
924 api_name => 'open-ils.circ.money.billable_xact.adjust_to_zero',
927 Given a list of billable transactions, manipulate the
928 transaction using account adjustments to result in a
932 {desc => 'Authtoken', type => 'string'},
933 {desc => 'Array of transaction IDs', type => 'array'}
936 desc => q/Array of IDs for each transaction updated,
945 my $xact_id = $xact->id;
946 # the plan: rebill voided billings until we get a positive balance
948 # step 1: get the voided/adjusted billings
949 my $billings = $e->search_money_billing([
954 order_by => {mb => 'amount desc'},
956 flesh_fields => {mb => ['adjustments']},
959 my @billings = grep { $U->is_true($_->voided) or @{$_->adjustments} } @$billings;
961 my $xact_balance = $xact->balance_owed;
962 $logger->debug("rebilling for xact $xact_id with balance $xact_balance");
964 my $rebill_amount = 0;
966 # step 2: generate new bills just like the old ones
967 for my $billing (@billings) {
969 if ($U->is_true($billing->voided)) {
970 $amount = $billing->amount;
971 } else { # adjusted billing
972 map { $amount = $U->fpsum($amount, $_->amount) } @{$billing->adjustments};
974 my $evt = $CC->create_bill(
978 $billing->billing_type,
980 "System: MANUAL ADJUSTMENT, BILLING #".$billing->id." REINSTATED\n(PREV: ".$billing->note.")",
981 $billing->period_start(),
982 $billing->period_end()
985 $rebill_amount += $billing->amount;
987 # if we have a postive (or zero) balance now, stop
988 last if ($xact_balance + $rebill_amount >= 0);
992 sub _is_fully_adjusted {
996 map { $amount_adj = $U->fpsum($amount_adj, $_->amount) } @{$billing->adjustments};
998 return $billing->amount == $amount_adj;
1001 sub adjust_bills_to_zero_manual {
1002 my ($self, $client, $auth, $xact_ids) = @_;
1004 my $e = new_editor(xact => 1, authtoken => $auth);
1005 return $e->die_event unless $e->checkauth;
1007 # in case a bare ID is passed
1008 $xact_ids = [$xact_ids] unless ref $xact_ids;
1011 for my $xact_id (@$xact_ids) {
1014 $e->retrieve_money_billable_transaction_summary([
1016 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1017 ]) or return $e->die_event;
1019 if ($xact->balance_owed == 0) {
1020 # zero already, all done
1024 return $e->die_event unless
1025 $e->allowed('ADJUST_BILLS', $xact->usr->home_ou);
1027 if ($xact->balance_owed < 0) {
1028 my $evt = _rebill_xact($e, $xact);
1029 return $evt if $evt;
1030 # refetch xact to get new balance
1032 $e->retrieve_money_billable_transaction_summary([
1034 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1035 ]) or return $e->die_event;
1038 if ($xact->balance_owed > 0) {
1039 # it's positive and needs to be adjusted
1040 # (it either started positive, or we rebilled it positive)
1041 my $billings = $e->search_money_billing([
1046 order_by => {mb => 'amount desc'},
1048 flesh_fields => {mb => ['adjustments']},
1052 my @billings_to_zero = grep { !$U->is_true($_->voided) or !_is_fully_adjusted($_) } @$billings;
1053 $CC->adjust_bills_to_zero($e, \@billings_to_zero, "System: MANUAL ADJUSTMENT");
1056 push(@modified, $xact->id);
1058 # now we see if we can close the transaction
1059 # same logic as make_payments();
1060 my $circ = $e->retrieve_action_circulation($xact_id);
1061 if (!$circ or $CC->can_close_circ($e, $circ)) {
1062 # we don't check to see if the xact is already closed. since the
1063 # xact had a negative balance, it should not have been closed, so
1064 # assume 'now' is the correct close time regardless.
1065 my $trans = $e->retrieve_money_billable_transaction($xact_id);
1066 $trans->xact_finish("now");
1067 $e->update_money_billable_transaction($trans) or return $e->die_event;
1076 __PACKAGE__->register_method(
1077 method => 'edit_bill_note',
1078 api_name => 'open-ils.circ.money.billing.note.edit',
1080 Edits the note for a bill
1081 @param authtoken Login session key
1082 @param note The replacement note for the bills we're editing
1083 @param billid Id for the bill to edit the note of. This parameter may be repeated to reference other bills.
1084 @return 1 on success, Event on error
1087 sub edit_bill_note {
1088 my( $s, $c, $authtoken, $note, @billids ) = @_;
1090 my $e = new_editor( authtoken => $authtoken, xact => 1 );
1091 return $e->die_event unless $e->checkauth;
1092 return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
1094 for my $billid (@billids) {
1096 my $bill = $e->retrieve_money_billing($billid)
1097 or return $e->die_event;
1100 # FIXME: Does this get audited? Need some way so that the original creator of the bill does not get credit/blame for the new note.
1102 $e->update_money_billing($bill) or return $e->die_event;
1109 __PACKAGE__->register_method(
1110 method => 'edit_payment_note',
1111 api_name => 'open-ils.circ.money.payment.note.edit',
1113 Edits the note for a payment
1114 @param authtoken Login session key
1115 @param note The replacement note for the payments we're editing
1116 @param paymentid Id for the payment to edit the note of. This parameter may be repeated to reference other payments.
1117 @return 1 on success, Event on error
1120 sub edit_payment_note {
1121 my( $s, $c, $authtoken, $note, @paymentids ) = @_;
1123 my $e = new_editor( authtoken => $authtoken, xact => 1 );
1124 return $e->die_event unless $e->checkauth;
1125 return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
1127 for my $paymentid (@paymentids) {
1129 my $payment = $e->retrieve_money_payment($paymentid)
1130 or return $e->die_event;
1132 $payment->note($note);
1133 # FIXME: Does this get audited? Need some way so that the original taker of the payment does not get credit/blame for the new note.
1135 $e->update_money_payment($payment) or return $e->die_event;
1143 __PACKAGE__->register_method (
1144 method => 'fetch_mbts',
1146 api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
1149 my( $self, $conn, $auth, $id) = @_;
1151 my $e = new_editor(xact => 1, authtoken=>$auth);
1152 return $e->event unless $e->checkauth;
1153 my ($mbts) = $U->fetch_mbts($id, $e);
1155 my $user = $e->retrieve_actor_user($mbts->usr)
1156 or return $e->die_event;
1158 return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1164 __PACKAGE__->register_method(
1165 method => 'desk_payments',
1166 api_name => 'open-ils.circ.money.org_unit.desk_payments'
1169 my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1170 my $e = new_editor(authtoken=>$auth);
1171 return $e->event unless $e->checkauth;
1172 return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1173 my $data = $U->storagereq(
1174 'open-ils.storage.money.org_unit.desk_payments.atomic',
1175 $org, $start_date, $end_date );
1177 $_->workstation( $_->workstation->name ) for(@$data);
1182 __PACKAGE__->register_method(
1183 method => 'user_payments',
1184 api_name => 'open-ils.circ.money.org_unit.user_payments'
1188 my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1189 my $e = new_editor(authtoken=>$auth);
1190 return $e->event unless $e->checkauth;
1191 return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1192 my $data = $U->storagereq(
1193 'open-ils.storage.money.org_unit.user_payments.atomic',
1194 $org, $start_date, $end_date );
1197 $e->retrieve_actor_card($_->usr->card)->barcode);
1199 $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1205 __PACKAGE__->register_method(
1206 method => 'retrieve_credit_payable_balance',
1207 api_name => 'open-ils.circ.credit.payable_balance.retrieve',
1210 desc => q/Returns the total amount the patron can pay via credit card/,
1212 { desc => 'Authentication token', type => 'string' },
1213 { desc => 'User id', type => 'number' }
1215 return => { desc => 'The ID of the new provider' }
1219 sub retrieve_credit_payable_balance {
1220 my ( $self, $conn, $auth, $user_id ) = @_;
1221 my $e = new_editor(authtoken => $auth);
1222 return $e->event unless $e->checkauth;
1224 my $user = $e->retrieve_actor_user($user_id)
1225 or return $e->event;
1227 if($e->requestor->id != $user_id) {
1228 return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1231 my $circ_orgs = $e->json_query({
1232 "select" => {circ => ["circ_lib"]},
1234 "where" => {usr => $user_id, xact_finish => undef},
1238 my $groc_orgs = $e->json_query({
1239 "select" => {mg => ["billing_location"]},
1241 "where" => {usr => $user_id, xact_finish => undef},
1246 for my $org ( @$circ_orgs, @$groc_orgs ) {
1247 my $o = $org->{billing_location};
1248 $o = $org->{circ_lib} unless $o;
1249 next if $hash{$o}; # was $hash{$org}, but that doesn't make sense. $org is a hashref and $o gets added in the next line.
1250 $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
1253 my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1254 $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1256 my $xact_summaries =
1257 OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1258 'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1262 for my $xact (@$xact_summaries) {
1264 # make two lists and grab them in batch XXX
1265 if ( $xact->xact_type eq 'circulation' ) {
1266 my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
1267 next unless grep { $_ == $circ->circ_lib } @credit_orgs;
1269 } elsif ($xact->xact_type eq 'grocery') {
1270 my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
1271 next unless grep { $_ == $bill->billing_location } @credit_orgs;
1272 } elsif ($xact->xact_type eq 'reservation') {
1273 my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
1274 next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
1276 $sum += $xact->balance_owed();
1283 __PACKAGE__->register_method(
1284 method => "retrieve_statement",
1286 api_name => "open-ils.circ.money.statement.retrieve",
1287 notes => "Returns an organized summary of a billable transaction, including all bills, payments, adjustments, and voids."
1293 return $parser->parse_datetime(clean_ISO8601($ts))->epoch;
1296 my %_statement_sort = (
1298 'account_adjustment' => 1,
1303 sub retrieve_statement {
1304 my ( $self, $client, $auth, $xact_id ) = @_;
1306 my $e = new_editor(authtoken=>$auth);
1307 return $e->event unless $e->checkauth;
1308 return $e->event unless $e->allowed('VIEW_TRANSACTION');
1310 # XXX: move this lookup login into a DB query?
1313 # collect all payments/adjustments
1314 my $payments = $e->search_money_payment({ xact => $xact_id });
1315 foreach my $payment (@$payments) {
1316 my $type = $payment->payment_type;
1317 $type = 'payment' if $type ne 'account_adjustment';
1318 push(@line_prep, [$type, _to_epoch($payment->payment_ts), $payment->payment_ts, $payment->id, $payment]);
1321 # collect all billings
1322 my $billings = $e->search_money_billing({ xact => $xact_id });
1323 foreach my $billing (@$billings) {
1324 if ($U->is_true($billing->voided)){
1325 push(@line_prep, ['void', _to_epoch($billing->void_time), $billing->void_time, $billing->id, $billing]); # voids get two entries, one to represent the bill event, one for the void event
1327 push(@line_prep, ['billing', _to_epoch($billing->billing_ts), $billing->billing_ts, $billing->id, $billing]);
1330 # order every event by timestamp, then bills/adjustments/voids/payments order, then id
1331 my @ordered_line_prep = sort {
1334 $_statement_sort{$a->[0]} <=> $_statement_sort{$b->[0]}
1339 # let's start building the statement structure
1340 my (@lines, %current_line, $running_balance);
1341 foreach my $event (@ordered_line_prep) {
1342 my $obj = $event->[4];
1343 my $type = $event->[0];
1344 my $ts = $event->[2];
1345 my $billing_type = $type =~ /billing|void/ ? $obj->billing_type : ''; # TODO: get non-legacy billing type
1346 my $note = $obj->note || '';
1347 # last line should be void information, try to isolate it
1348 if ($type eq 'billing' and $obj->voided) {
1350 } elsif ($type eq 'void') {
1351 $note = (split(/\n/, $note))[-1];
1354 # if we have new details, start a new line
1355 if ($current_line{amount} and (
1356 $type ne $current_line{type}
1357 or ($note ne $current_line{note})
1358 or ($billing_type ne $current_line{billing_type})
1361 push(@lines, {%current_line}); # push a copy of the hash, not the real thing
1364 if (!$current_line{type}) {
1365 $current_line{type} = $type;
1366 $current_line{billing_type} = $billing_type;
1367 $current_line{note} = $note;
1369 if (!$current_line{start_date}) {
1370 $current_line{start_date} = $ts;
1371 } elsif ($ts ne $current_line{start_date}) {
1372 $current_line{end_date} = $ts;
1374 $current_line{amount} += $obj->amount;
1375 if ($current_line{details}) {
1376 push(@{$current_line{details}}, $obj);
1378 $current_line{details} = [$obj];
1381 push(@lines, {%current_line}); # push last one on
1383 # get/update totals, format notes
1387 account_adjustment => 0,
1390 foreach my $line (@lines) {
1391 $totals{$line->{type}} += $line->{amount};
1392 if ($line->{type} eq 'billing') {
1393 $running_balance += $line->{amount};
1394 } else { # not a billing; balance goes down for everything else
1395 $running_balance -= $line->{amount};
1397 $line->{running_balance} = $running_balance;
1398 $line->{note} = $line->{note} ? [split(/\n/, $line->{note})] : [];
1402 xact_id => $xact_id,
1404 balance_due => $totals{billing} - ($totals{payment} + $totals{account_adjustment} + $totals{void}),
1405 billing_total => $totals{billing},
1406 credit_total => $totals{payment} + $totals{account_adjustment},
1407 payment_total => $totals{payment},
1408 account_adjustment_total => $totals{account_adjustment},
1409 void_total => $totals{void}