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/;
36 sub get_processor_settings {
39 my $processor = lc shift;
41 # Get the names of every credit processor setting for our given processor.
42 # They're a little different per processor.
43 my $setting_names = $e->json_query({
44 select => {coust => ["name"]},
45 from => {coust => {}},
46 where => {name => {like => "credit.processor.${processor}.%"}}
47 }) or return $e->die_event;
49 # Make keys for a hash we're going to build out of the last dot-delimited
50 # component of each setting name.
51 ($_->{key} = $_->{name}) =~ s/.+\.(\w+)$/$1/ for @$setting_names;
53 # Return a hash with those short keys, and for values the value of
54 # the corresponding OU setting within our scope.
57 $_->{key} => $U->ou_ancestor_setting_value($org_unit, $_->{name})
62 # process_stripe_or_bop_payment()
63 # This is a helper method to make_payments() below (specifically,
64 # the credit-card part). It's the first point in the Perl code where
65 # we need to care about the distinction between Stripe and the
66 # Paypal/PayflowPro/AuthorizeNet kinds of processors (the latter group
67 # uses B::OP and handles payment card info, whereas Stripe doesn't use
68 # B::OP and doesn't require us to know anything about the payment card
71 # Return an event in all cases. That means a success returns a SUCCESS
73 sub process_stripe_or_bop_payment {
74 my ($e, $user_id, $this_ou, $total_paid, $cc_args) = @_;
76 # A few stanzas to determine which processor we're using and whether we're
77 # really adequately set up for it.
78 if (!$cc_args->{processor}) {
79 if (!($cc_args->{processor} =
80 $U->ou_ancestor_setting_value(
81 $this_ou, 'credit.processor.default'
85 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
89 # Make sure the configured credit processor has a safe/correct name.
90 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED')
91 unless $cc_args->{processor} =~ /^[a-z0-9_\-]+$/i;
93 # Get the settings for the processor and make sure they're serviceable.
94 my $psettings = get_processor_settings($e, $this_ou, $cc_args->{processor});
95 return $psettings if defined $U->event_code($psettings);
96 return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED')
97 unless $psettings->{enabled};
99 # Now we branch. Stripe is one thing, and everything else is another.
101 if ($cc_args->{processor} eq 'Stripe') { # Stripe
102 my $stripe = Business::Stripe->new(-api_key => $psettings->{secretkey});
103 $stripe->charges_create(
104 amount => int($total_paid * 100.0), # Stripe takes amount in pennies
105 card => $cc_args->{stripe_token},
106 description => $cc_args->{note}
109 if ($stripe->success) {
110 $logger->info("Stripe payment succeeded");
111 return OpenILS::Event->new(
112 "SUCCESS", payload => {
113 map { $_ => $stripe->success->{$_} } qw(
114 invoice customer balance_transaction id created card
119 $logger->info("Stripe payment failed");
120 return OpenILS::Event->new(
121 "CREDIT_PROCESSOR_DECLINED_TRANSACTION",
122 payload => $stripe->error # XXX what happens if this contains
123 # JSON::backportPP::* objects?
127 } else { # B::OP style (Paypal/PayflowPro/AuthorizeNet)
128 return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number')
129 unless $cc_args->{number};
131 return OpenILS::Application::Circ::CreditCard::process_payment({
132 "processor" => $cc_args->{processor},
133 "desc" => $cc_args->{note},
134 "amount" => $total_paid,
135 "patron_id" => $user_id,
136 "cc" => $cc_args->{number},
137 "expiration" => sprintf(
139 $cc_args->{expire_month},
140 $cc_args->{expire_year}
143 "first_name" => $cc_args->{billing_first},
144 "last_name" => $cc_args->{billing_last},
145 "address" => $cc_args->{billing_address},
146 "city" => $cc_args->{billing_city},
147 "state" => $cc_args->{billing_state},
148 "zip" => $cc_args->{billing_zip},
149 "cvv2" => $cc_args->{cvv2},
156 __PACKAGE__->register_method(
157 method => "make_payments",
158 api_name => "open-ils.circ.money.payment",
160 desc => q/Create payments for a given user and set of transactions,
161 login must have CREATE_PAYMENT privileges.
162 If any payments fail, all are reverted back./,
164 {desc => 'Authtoken', type => 'string'},
165 {desc => q/Arguments Hash, supporting the following params:
172 where_process 1 to use processor, !1 for out-of-band
173 approval_code (for out-of-band payment)
174 type (for out-of-band payment)
175 number (for call to payment processor)
176 stripe_token (for call to Stripe payment processor)
177 expire_month (for call to payment processor)
178 expire_year (for call to payment processor)
179 billing_first (for out-of-band payments and for call to payment processor)
180 billing_last (for out-of-band payments and for call to payment processor)
181 billing_address (for call to payment processor)
182 billing_city (for call to payment processor)
183 billing_state (for call to payment processor)
184 billing_zip (for call to payment processor)
185 note (if payments->{note} is blank, use this)
195 desc => q/Last user transaction ID. This is the actor.usr.last_xact_id value/,
201 q{Array of payment IDs on success, event on failure. Event possibilities include:
203 Bad parameters were given to this API method itself.
206 The last user transaction ID does not match the ID in the database. This means
207 the user object has been updated since the last retrieval. The client should
208 be instructed to reload the user object and related transactions before attempting
210 REFUND_EXCEEDS_BALANCE
211 REFUND_EXCEEDS_DESK_PAYMENTS
212 CREDIT_PROCESSOR_NOT_SPECIFIED
213 Evergreen has not been set up to process CC payments.
214 CREDIT_PROCESSOR_NOT_ALLOWED
215 Evergreen has been incorrectly setup for CC payments.
216 CREDIT_PROCESSOR_NOT_ENABLED
217 Evergreen has been set up for CC payments, but an admin
218 has not explicitly enabled them.
219 CREDIT_PROCESSOR_BAD_PARAMS
220 Evergreen has been incorrectly setup for CC payments;
221 specifically, the login and/or password for the CC
222 processor weren't provided.
223 CREDIT_PROCESSOR_INVALID_CC_NUMBER
224 You have supplied a credit card number that Evergreen
225 has judged to be invalid even before attempting to contact
226 the payment processor.
227 CREDIT_PROCESSOR_DECLINED_TRANSACTION
228 We contacted the CC processor to attempt the charge, but
230 The error_message field of the event payload will
231 contain the payment processor's response. This
232 typically includes a message in plain English intended
233 for human consumption. In PayPal's case, the message
234 is preceded by an integer, a colon, and a space, so
235 a caller might take the 2nd match from /^(\d+: )?(.+)$/
236 to present to the user.
237 The payload also contains other fields from the payment
238 processor, but these are generally not user-friendly
240 CREDIT_PROCESSOR_SUCCESS_WO_RECORD
241 A payment was processed successfully, but couldn't be
242 recorded in Evergreen. This is _bad bad bad_, as it means
243 somebody made a payment but isn't getting credit for it.
244 See errors in the system log if this happens. Info from
245 the credit card transaction will also be available in the
246 event payload, although this probably won't be suitable for
247 staff client/OPAC display.
254 my($self, $client, $auth, $payments, $last_xact_id) = @_;
256 my $e = new_editor(authtoken => $auth, xact => 1);
257 return $e->die_event unless $e->checkauth;
259 my $type = $payments->{payment_type};
260 my $user_id = $payments->{userid};
261 my $credit = $payments->{patron_credit} || 0;
262 my $drawer = $e->requestor->wsid;
263 my $note = $payments->{note};
264 my $cc_args = $payments->{cc_args};
265 my $check_number = $payments->{check_number};
267 my $this_ou = $e->requestor->ws_ou || $e->requestor->home_ou;
271 # unless/until determined by payment processor API
272 my ($approval_code, $cc_processor, $cc_order_number) = (undef,undef,undef, undef);
274 my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event;
276 if($patron->last_xact_id ne $last_xact_id) {
278 return OpenILS::Event->new('INVALID_USER_XACT_ID');
281 # A user is allowed to make credit card payments on his/her own behalf
282 # All other scenarious require permission
283 unless($type eq 'credit_card_payment' and $user_id == $e->requestor->id) {
284 return $e->die_event unless $e->allowed('CREATE_PAYMENT', $patron->home_ou);
287 # first collect the transactions and make sure the transaction
288 # user matches the requested user
291 # We rewrite the payments array for sanity's sake, to avoid more
292 # than one payment per transaction per call, which is not legitimate
293 # but has been seen in the wild coming from the staff client. This
294 # is presumably a staff client (xulrunner) bug.
295 my @unique_xact_payments;
296 for my $pay (@{$payments->{payments}}) {
297 my $xact_id = $pay->[0];
298 if (exists($xacts{$xact_id})) {
300 return OpenILS::Event->new('MULTIPLE_PAYMENTS_FOR_XACT');
303 my $xact = $e->retrieve_money_billable_transaction_summary($xact_id)
304 or return $e->die_event;
306 if($xact->usr != $user_id) {
308 return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/);
311 $xacts{$xact_id} = $xact;
312 push @unique_xact_payments, $pay;
314 $payments->{payments} = \@unique_xact_payments;
318 for my $pay (@{$payments->{payments}}) {
319 my $transid = $pay->[0];
320 my $amount = $pay->[1];
321 $amount =~ s/\$//og; # just to be safe
322 my $trans = $xacts{$transid};
324 $total_paid += $amount;
326 my $org_id = $U->xact_org($transid, $e);
328 if (!$orgs{$org_id}) {
331 # patron credit has to be allowed at all orgs receiving payment
332 if ($type eq 'credit_payment' and $U->ou_ancestor_setting_value(
333 $org_id, 'circ.disable_patron_credit', $e)) {
335 return OpenILS::Event->new('PATRON_CREDIT_DISABLED');
339 # A negative payment is a refund.
342 # Negative credit card payments are not allowed
343 if($type eq 'credit_card_payment') {
345 return OpenILS::Event->new(
347 note => q/Negative credit card payments not allowed/
351 # If the refund causes the transaction balance to exceed 0 dollars,
352 # we are in effect loaning the patron money. This is not allowed.
353 if( ($trans->balance_owed - $amount) > 0 ) {
355 return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
358 # Otherwise, make sure the refund does not exceed desk payments
359 # This is also not allowed
361 my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
362 $desk_total += $_->amount for @$desk_payments;
364 if( (-$amount) > $desk_total ) {
366 return OpenILS::Event->new(
367 'REFUND_EXCEEDS_DESK_PAYMENTS',
368 payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
372 my $payobj = "Fieldmapper::money::$type";
373 $payobj = $payobj->new;
375 $payobj->amount($amount);
376 $payobj->amount_collected($amount);
377 $payobj->xact($transid);
378 $payobj->note($note);
379 if ((not $payobj->note) and ($type eq 'credit_card_payment')) {
380 $payobj->note($cc_args->{note});
383 if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); }
384 if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); }
385 if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); }
387 # Store the last 4 digits of the CC number
388 if ($payobj->has_field('cc_number')) {
389 $payobj->cc_number(substr($cc_args->{number}, -4));
392 # Note: It is important not to set approval_code
393 # on the fieldmapper object yet.
395 push(@payment_objs, $payobj);
397 } # all payment objects have been created and inserted.
399 #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED ###
402 # After we try to externally process a credit card (if desired), we'll
403 # open a new transaction. We cannot leave one open while credit card
404 # processing might be happening, as it can easily time out the database
409 if($type eq 'credit_card_payment') {
410 $approval_code = $cc_args->{approval_code};
411 # If an approval code was not given, we'll need
412 # to call to the payment processor ourselves.
413 if ($cc_args->{where_process} == 1) {
414 my $response = process_stripe_or_bop_payment(
415 $e, $user_id, $this_ou, $total_paid, $cc_args
418 if ($U->event_code($response)) { # non-success (success is 0)
420 "Credit card payment for user $user_id failed: " .
421 $response->{textcode} . " " .
422 ($response->{payload}->{error_message} ||
423 $response->{payload}{message})
427 # We need to save this for later in case there's a failure on
428 # the EG side to store the processor's result.
430 $cc_payload = $response->{"payload"}; # also used way later
433 no warnings 'uninitialized';
434 $approval_code = $cc_payload->{authorization} ||
436 $cc_processor = $cc_payload->{processor} ||
437 $cc_args->{processor};
438 $cc_order_number = $cc_payload->{order_number} ||
439 $cc_payload->{invoice};
441 $logger->info("Credit card payment for user $user_id succeeded");
444 return OpenILS::Event->new(
445 'BAD_PARAMS', note => 'Need approval code'
446 ) if not $cc_args->{approval_code};
450 ### RE-OPEN TRANSACTION HERE ###
454 # create payment records
455 my $create_money_method = "create_money_" . $type;
456 for my $payment (@payment_objs) {
457 # update the transaction if it's done
458 my $amount = $payment->amount;
459 my $transid = $payment->xact;
460 my $trans = $xacts{$transid};
461 # making payment with existing patron credit.
462 $credit -= $amount if $type eq 'credit_payment';
463 if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) {
464 # Any overpay on this transaction goes directly into patron
468 my $circ = $e->retrieve_action_circulation(
473 flesh_fields => {circ => ['target_copy','billings']}
476 ); # Flesh the copy, so we can monkey with the status if
479 # Whether or not we close the transaction. We definitely
480 # close if no circulation transaction is present,
481 # otherwise we check if the circulation is in a state that
482 # allows itself to be closed.
483 if (!$circ || $CC->can_close_circ($e, $circ)) {
484 $trans = $e->retrieve_money_billable_transaction($transid);
485 $trans->xact_finish("now");
486 if (!$e->update_money_billable_transaction($trans)) {
487 return _recording_failure(
488 $e, "update_money_billable_transaction() failed",
489 $payment, $cc_payload
493 # If we have a circ, we need to check if the copy
494 # status is lost or long overdue. If it is then we
495 # check org_unit_settings for the copy owning library
496 # and adjust and possibly adjust copy status to lost
498 if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
499 # We need the copy to check settings and to possibly
501 my $copy = $circ->target_copy();
502 # Library where we'll check settings.
503 my $check_lib = $copy->circ_lib();
505 # check the copy status
506 if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
507 && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
508 $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
509 if (!$e->update_asset_copy($copy)) {
510 return _recording_failure(
511 $e, "update_asset_copy_failed()",
512 $payment, $cc_payload
520 # Urgh, clean up this mega-function one day.
521 if ($cc_processor eq 'Stripe' and $approval_code and $cc_payload) {
522 $payment->cc_number($cc_payload->{card}{last4});
525 $payment->approval_code($approval_code) if $approval_code;
526 $payment->cc_order_number($cc_order_number) if $cc_order_number;
527 $payment->cc_processor($cc_processor) if $cc_processor;
528 if (!$e->$create_money_method($payment)) {
529 return _recording_failure(
530 $e, "$create_money_method failed", $payment, $cc_payload
534 push(@payment_ids, $payment->id);
537 my $evt = _update_patron_credit($e, $patron, $credit);
539 return _recording_failure(
540 $e, "_update_patron_credit() failed", undef, $cc_payload
544 for my $org_id (keys %orgs) {
545 # calculate penalties for each of the affected orgs
546 $evt = OpenILS::Utils::Penalty->calculate_penalties(
547 $e, $user_id, $org_id
550 return _recording_failure(
551 $e, "calculate_penalties() failed", undef, $cc_payload
556 # update the user to create a new last_xact_id
557 $e->update_actor_user($patron) or return $e->die_event;
558 $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
561 # update the cached user object if a user is making a payment toward
562 # his/her own account
563 $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
564 if $user_id == $e->requestor->id;
566 return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
569 sub _recording_failure {
570 my ($e, $msg, $payment, $payload) = @_;
572 if ($payload) { # If the payment processor already accepted a payment:
573 $logger->error($msg);
574 $logger->error("Payment processor payload: " . Dumper($payload));
575 # payment shouldn't contain CC number
576 $logger->error("Payment: " . Dumper($payment)) if $payment;
580 return new OpenILS::Event(
581 "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
582 "payload" => $payload
584 } else { # Otherwise, the problem is somewhat less severe:
586 $logger->warn("Payment: " . Dumper($payment)) if $payment;
587 return $e->die_event;
591 sub _update_patron_credit {
592 my($e, $patron, $credit) = @_;
593 return undef if $credit == 0;
594 $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
595 return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
596 $e->update_actor_user($patron) or return $e->die_event;
601 __PACKAGE__->register_method(
602 method => "retrieve_payments",
603 api_name => "open-ils.circ.money.payment.retrieve.all_",
604 notes => "Returns a list of payments attached to a given transaction"
606 sub retrieve_payments {
607 my( $self, $client, $login, $transid ) = @_;
610 $apputils->checksesperm($login, 'VIEW_TRANSACTION');
613 # XXX the logic here is wrong.. we need to check the owner of the transaction
614 # to make sure the requestor has access
616 # XXX grab the view, for each object in the view, grab the real object
618 return $apputils->simplereq(
620 'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
624 __PACKAGE__->register_method(
625 method => "retrieve_payments2",
627 api_name => "open-ils.circ.money.payment.retrieve.all",
628 notes => "Returns a list of payments attached to a given transaction"
631 sub retrieve_payments2 {
632 my( $self, $client, $login, $transid ) = @_;
634 my $e = new_editor(authtoken=>$login);
635 return $e->event unless $e->checkauth;
636 return $e->event unless $e->allowed('VIEW_TRANSACTION');
639 my $pmnts = $e->search_money_payment({ xact => $transid });
641 my $type = $_->payment_type;
642 my $meth = "retrieve_money_$type";
643 my $p = $e->$meth($_->id) or return $e->event;
644 $p->payment_type($type);
645 $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
646 if $p->has_field('cash_drawer');
647 push( @payments, $p );
653 __PACKAGE__->register_method(
654 method => "format_payment_receipt",
655 api_name => "open-ils.circ.money.payment_receipt.print",
657 desc => 'Returns a printable receipt for the specified payments',
659 { desc => 'Authentication token', type => 'string'},
660 { desc => 'Payment ID or array of payment IDs', type => 'number' },
663 desc => q/An action_trigger.event object or error event./,
668 __PACKAGE__->register_method(
669 method => "format_payment_receipt",
670 api_name => "open-ils.circ.money.payment_receipt.email",
672 desc => 'Emails a receipt for the specified payments to the user associated with the first payment',
674 { desc => 'Authentication token', type => 'string'},
675 { desc => 'Payment ID or array of payment IDs', type => 'number' },
678 desc => q/Undefined on success, otherwise an error event./,
684 sub format_payment_receipt {
685 my($self, $conn, $auth, $mp_id) = @_;
688 if (ref $mp_id ne 'ARRAY') {
689 $mp_ids = [ $mp_id ];
694 my $for_print = ($self->api_name =~ /print/);
695 my $for_email = ($self->api_name =~ /email/);
697 # manually use xact (i.e. authoritative) so we can kill the cstore
698 # connection before sending the action/trigger request. This prevents our cstore
699 # backend from sitting idle while A/T (which uses its own transactions) runs.
700 my $e = new_editor(xact => 1, authtoken => $auth);
701 return $e->die_event unless $e->checkauth;
704 for my $id (@$mp_ids) {
706 my $payment = $e->retrieve_money_payment([
714 ]) or return $e->die_event;
716 return $e->die_event unless
717 $e->requestor->id == $payment->xact->usr->id or
718 $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou);
720 push @$payments, $payment;
727 return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
729 } elsif ($for_email) {
731 for my $p (@$payments) {
732 $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
739 __PACKAGE__->register_method(
740 method => "create_grocery_bill",
741 api_name => "open-ils.circ.money.grocery.create",
743 Creates a new grocery transaction using the transaction object provided
744 PARAMS: (login_session, money.grocery (mg) object)
747 sub create_grocery_bill {
748 my( $self, $client, $login, $transaction ) = @_;
750 my( $staff, $evt ) = $apputils->checkses($login);
752 $evt = $apputils->check_perms($staff->id,
753 $transaction->billing_location, 'CREATE_TRANSACTION' );
757 $logger->activity("Creating grocery bill " . Dumper($transaction) );
759 $transaction->clear_id;
760 my $session = $apputils->start_db_session;
761 $apputils->set_audit_info($session, $login, $staff->id, $staff->wsid);
762 my $transid = $session->request(
763 'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
765 throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
767 $logger->debug("Created new grocery transaction $transid");
769 $apputils->commit_db_session($session);
771 my $e = new_editor(xact=>1);
772 $evt = $U->check_open_xact($e, $transid);
780 __PACKAGE__->register_method(
781 method => 'fetch_reservation',
782 api_name => 'open-ils.circ.booking.reservation.retrieve'
784 sub fetch_reservation {
785 my( $self, $conn, $auth, $id ) = @_;
786 my $e = new_editor(authtoken=>$auth);
787 return $e->event unless $e->checkauth;
788 return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
789 my $g = $e->retrieve_booking_reservation($id)
794 __PACKAGE__->register_method(
795 method => 'fetch_grocery',
796 api_name => 'open-ils.circ.money.grocery.retrieve'
799 my( $self, $conn, $auth, $id ) = @_;
800 my $e = new_editor(authtoken=>$auth);
801 return $e->event unless $e->checkauth;
802 return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
803 my $g = $e->retrieve_money_grocery($id)
809 __PACKAGE__->register_method(
810 method => "billing_items",
811 api_name => "open-ils.circ.money.billing.retrieve.all",
814 desc => 'Returns a list of billing items for the given transaction ID. ' .
815 'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
817 { desc => 'Authentication token', type => 'string'},
818 { desc => 'Transaction ID', type => 'number'}
821 desc => 'Transaction object, event on error'
827 my( $self, $client, $login, $transid ) = @_;
829 my( $trans, $evt ) = $U->fetch_billable_xact($transid);
833 ($staff, $evt ) = $apputils->checkses($login);
836 if($staff->id ne $trans->usr) {
837 $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
841 return $apputils->simplereq( 'open-ils.cstore',
842 'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
846 __PACKAGE__->register_method(
847 method => "billing_items_create",
848 api_name => "open-ils.circ.money.billing.create",
850 Creates a new billing line item
851 PARAMS( login, bill_object (mb) )
854 sub billing_items_create {
855 my( $self, $client, $login, $billing ) = @_;
857 my $e = new_editor(authtoken => $login, xact => 1);
858 return $e->die_event unless $e->checkauth;
859 return $e->die_event unless $e->allowed('CREATE_BILL');
861 my $xact = $e->retrieve_money_billable_transaction($billing->xact)
862 or return $e->die_event;
864 # if the transaction was closed, re-open it
865 if($xact->xact_finish) {
866 $xact->clear_xact_finish;
867 $e->update_money_billable_transaction($xact)
868 or return $e->die_event;
871 my $amt = $billing->amount;
873 $billing->amount($amt);
875 $e->create_money_billing($billing) or return $e->die_event;
876 my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id,$e));
879 $evt = $U->check_open_xact($e, $xact->id, $xact);
888 __PACKAGE__->register_method(
889 method => 'void_bill',
890 api_name => 'open-ils.circ.money.billing.void',
893 @param authtoken Login session key
894 @param billid Id for the bill to void. This parameter may be repeated to reference other bills.
895 @return 1 on success, Event on error
899 my( $s, $c, $authtoken, @billids ) = @_;
900 my $editor = new_editor(authtoken=>$authtoken, xact=>1);
901 return $editor->die_event unless $editor->checkauth;
902 return $editor->die_event unless $editor->allowed('VOID_BILLING');
903 my $rv = $CC->void_bills($editor, \@billids);
904 if (ref($rv) eq 'HASH') {
908 # We should have gotten 1.
915 __PACKAGE__->register_method(
916 method => 'adjust_bills_to_zero_manual',
917 api_name => 'open-ils.circ.money.billable_xact.adjust_to_zero',
920 Given a list of billable transactions, manipulate the
921 transaction using account adjustments to result in a
925 {desc => 'Authtoken', type => 'string'},
926 {desc => 'Array of transaction IDs', type => 'array'}
929 desc => q/Array of IDs for each transaction updated,
938 my $xact_id = $xact->id;
939 # the plan: rebill voided billings until we get a positive balance
941 # step 1: get the voided/adjusted billings
942 my $billings = $e->search_money_billing([
947 order_by => {mb => 'amount desc'},
949 flesh_fields => {mb => ['adjustments']},
952 my @billings = grep { $U->is_true($_->voided) or @{$_->adjustments} } @$billings;
954 my $xact_balance = $xact->balance_owed;
955 $logger->debug("rebilling for xact $xact_id with balance $xact_balance");
957 my $rebill_amount = 0;
959 # step 2: generate new bills just like the old ones
960 for my $billing (@billings) {
962 if ($U->is_true($billing->voided)) {
963 $amount = $billing->amount;
964 } else { # adjusted billing
965 map { $amount = $U->fpadd($amount, $_->amount) } @{$billing->adjustments};
967 my $evt = $CC->create_bill(
971 $billing->billing_type,
973 "System: MANUAL ADJUSTMENT, BILLING #".$billing->id." REINSTATED\n(PREV: ".$billing->note.")",
974 $billing->billing_ts()
977 $rebill_amount += $billing->amount;
979 # if we have a postive (or zero) balance now, stop
980 last if $rebill_amount >= $xact_balance;
984 sub _is_fully_adjusted {
988 map { $amount_adj = $U->fpadd($amount_adj, $_->amount) } @{$billing->adjustments};
990 return $billing->amount == $amount_adj;
993 sub adjust_bills_to_zero_manual {
994 my ($self, $client, $auth, $xact_ids) = @_;
996 my $e = new_editor(xact => 1, authtoken => $auth);
997 return $e->die_event unless $e->checkauth;
999 # in case a bare ID is passed
1000 $xact_ids = [$xact_ids] unless ref $xact_ids;
1003 for my $xact_id (@$xact_ids) {
1006 $e->retrieve_money_billable_transaction_summary([
1008 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1009 ]) or return $e->die_event;
1011 return $e->die_event unless
1012 $e->allowed('ADJUST_BILLS', $xact->usr->home_ou);
1014 if ($xact->balance_owed < 0) {
1015 my $evt = _rebill_xact($e, $xact);
1016 return $evt if $evt;
1017 # refetch xact to get new balance
1019 $e->retrieve_money_billable_transaction_summary([
1021 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1022 ]) or return $e->die_event;
1025 my $billings = $e->search_money_billing([
1030 order_by => {mb => 'amount desc'},
1032 flesh_fields => {mb => ['adjustments']},
1036 if ($xact->balance_owed == 0) {
1037 # if was zero, or we rebilled it to zero
1040 # it's positive and needs to be adjusted
1041 my @billings_to_zero = grep { !$U->is_true($_->voided) or !_is_fully_adjusted($_) } @$billings;
1042 $CC->adjust_bills_to_zero($e, \@billings_to_zero, "System: MANUAL ADJUSTMENT");
1045 push(@modified, $xact->id);
1047 # now we see if we can close the transaction
1048 # same logic as make_payments();
1049 my $circ = $e->retrieve_action_circulation($xact_id);
1050 if ($circ and !$CC->can_close_circ($e, $circ)) {
1051 # we don't check to see if the xact is already closed. since the
1052 # xact had a negative balance, it should not have been closed, so
1053 # assume 'now' is the correct close time regardless.
1054 my $trans = $e->retrieve_money_billable_transaction($xact_id);
1055 $trans->xact_finish("now");
1056 $e->update_money_billable_transaction($trans) or return $e->die_event;
1065 __PACKAGE__->register_method(
1066 method => 'edit_bill_note',
1067 api_name => 'open-ils.circ.money.billing.note.edit',
1069 Edits the note for a bill
1070 @param authtoken Login session key
1071 @param note The replacement note for the bills we're editing
1072 @param billid Id for the bill to edit the note of. This parameter may be repeated to reference other bills.
1073 @return 1 on success, Event on error
1076 sub edit_bill_note {
1077 my( $s, $c, $authtoken, $note, @billids ) = @_;
1079 my $e = new_editor( authtoken => $authtoken, xact => 1 );
1080 return $e->die_event unless $e->checkauth;
1081 return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
1083 for my $billid (@billids) {
1085 my $bill = $e->retrieve_money_billing($billid)
1086 or return $e->die_event;
1089 # 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.
1091 $e->update_money_billing($bill) or return $e->die_event;
1098 __PACKAGE__->register_method(
1099 method => 'edit_payment_note',
1100 api_name => 'open-ils.circ.money.payment.note.edit',
1102 Edits the note for a payment
1103 @param authtoken Login session key
1104 @param note The replacement note for the payments we're editing
1105 @param paymentid Id for the payment to edit the note of. This parameter may be repeated to reference other payments.
1106 @return 1 on success, Event on error
1109 sub edit_payment_note {
1110 my( $s, $c, $authtoken, $note, @paymentids ) = @_;
1112 my $e = new_editor( authtoken => $authtoken, xact => 1 );
1113 return $e->die_event unless $e->checkauth;
1114 return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
1116 for my $paymentid (@paymentids) {
1118 my $payment = $e->retrieve_money_payment($paymentid)
1119 or return $e->die_event;
1121 $payment->note($note);
1122 # 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.
1124 $e->update_money_payment($payment) or return $e->die_event;
1132 __PACKAGE__->register_method (
1133 method => 'fetch_mbts',
1135 api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
1138 my( $self, $conn, $auth, $id) = @_;
1140 my $e = new_editor(xact => 1, authtoken=>$auth);
1141 return $e->event unless $e->checkauth;
1142 my ($mbts) = $U->fetch_mbts($id, $e);
1144 my $user = $e->retrieve_actor_user($mbts->usr)
1145 or return $e->die_event;
1147 return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1153 __PACKAGE__->register_method(
1154 method => 'desk_payments',
1155 api_name => 'open-ils.circ.money.org_unit.desk_payments'
1158 my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1159 my $e = new_editor(authtoken=>$auth);
1160 return $e->event unless $e->checkauth;
1161 return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1162 my $data = $U->storagereq(
1163 'open-ils.storage.money.org_unit.desk_payments.atomic',
1164 $org, $start_date, $end_date );
1166 $_->workstation( $_->workstation->name ) for(@$data);
1171 __PACKAGE__->register_method(
1172 method => 'user_payments',
1173 api_name => 'open-ils.circ.money.org_unit.user_payments'
1177 my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1178 my $e = new_editor(authtoken=>$auth);
1179 return $e->event unless $e->checkauth;
1180 return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1181 my $data = $U->storagereq(
1182 'open-ils.storage.money.org_unit.user_payments.atomic',
1183 $org, $start_date, $end_date );
1186 $e->retrieve_actor_card($_->usr->card)->barcode);
1188 $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1194 __PACKAGE__->register_method(
1195 method => 'retrieve_credit_payable_balance',
1196 api_name => 'open-ils.circ.credit.payable_balance.retrieve',
1199 desc => q/Returns the total amount the patron can pay via credit card/,
1201 { desc => 'Authentication token', type => 'string' },
1202 { desc => 'User id', type => 'number' }
1204 return => { desc => 'The ID of the new provider' }
1208 sub retrieve_credit_payable_balance {
1209 my ( $self, $conn, $auth, $user_id ) = @_;
1210 my $e = new_editor(authtoken => $auth);
1211 return $e->event unless $e->checkauth;
1213 my $user = $e->retrieve_actor_user($user_id)
1214 or return $e->event;
1216 if($e->requestor->id != $user_id) {
1217 return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1220 my $circ_orgs = $e->json_query({
1221 "select" => {circ => ["circ_lib"]},
1223 "where" => {usr => $user_id, xact_finish => undef},
1227 my $groc_orgs = $e->json_query({
1228 "select" => {mg => ["billing_location"]},
1230 "where" => {usr => $user_id, xact_finish => undef},
1235 for my $org ( @$circ_orgs, @$groc_orgs ) {
1236 my $o = $org->{billing_location};
1237 $o = $org->{circ_lib} unless $o;
1238 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.
1239 $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
1242 my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1243 $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1245 my $xact_summaries =
1246 OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1247 'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1251 for my $xact (@$xact_summaries) {
1253 # make two lists and grab them in batch XXX
1254 if ( $xact->xact_type eq 'circulation' ) {
1255 my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
1256 next unless grep { $_ == $circ->circ_lib } @credit_orgs;
1258 } elsif ($xact->xact_type eq 'grocery') {
1259 my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
1260 next unless grep { $_ == $bill->billing_location } @credit_orgs;
1261 } elsif ($xact->xact_type eq 'reservation') {
1262 my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
1263 next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
1265 $sum += $xact->balance_owed();