22d37a996a7ad68896c290e78580d68a16bdcca2
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Circ / Money.pm
1 # ---------------------------------------------------------------
2 # Copyright (C) 2005  Georgia Public Library Service 
3 # Bill Erickson <billserickson@gmail.com>
4
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.
9
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 # ---------------------------------------------------------------
15
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";
24
25 use OpenSRF::EX qw(:try);
26 use OpenILS::Perm;
27 use Data::Dumper;
28 use OpenILS::Event;
29 use OpenSRF::Utils::Logger qw/:logger/;
30 use OpenILS::Utils::CStoreEditor qw/:funcs/;
31 use OpenILS::Utils::Penalty;
32 use Business::Stripe;
33 $Data::Dumper::Indent = 0;
34 use OpenILS::Const qw/:const/;
35
36 sub get_processor_settings {
37     my $e = shift;
38     my $org_unit = shift;
39     my $processor = lc shift;
40
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;
48
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;
52
53     # Return a hash with those short keys, and for values the value of
54     # the corresponding OU setting within our scope.
55     return {
56         map {
57             $_->{key} => $U->ou_ancestor_setting_value($org_unit, $_->{name})
58         } @$setting_names
59     };
60 }
61
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
69 # info).
70 #
71 # Return an event in all cases.  That means a success returns a SUCCESS
72 # event.
73 sub process_stripe_or_bop_payment {
74     my ($e, $user_id, $this_ou, $total_paid, $cc_args) = @_;
75
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'
82                 )
83             )
84         ) {
85             return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
86         }
87     }
88
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;
92
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};
98
99     # Now we branch. Stripe is one thing, and everything else is another.
100
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}
107         );
108
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
115                     )
116                 }
117             );
118         } else {
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?
124             );
125         }
126
127     } else { # B::OP style (Paypal/PayflowPro/AuthorizeNet)
128         return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number')
129             unless $cc_args->{number};
130
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(
138                 "%02d-%04d",
139                 $cc_args->{expire_month},
140                 $cc_args->{expire_year}
141             ),
142             "ou" => $this_ou,
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},
150             %$psettings
151         });
152
153     }
154 }
155
156 __PACKAGE__->register_method(
157     method => "make_payments",
158     api_name => "open-ils.circ.money.payment",
159     signature => {
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./,
163         params => [
164             {desc => 'Authtoken', type => 'string'},
165             {desc => q/Arguments Hash, supporting the following params:
166                 { 
167                     payment_type
168                     userid
169                     patron_credit
170                     note
171                     cc_args: {
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)
186                     },
187                     check_number
188                     payments: [ 
189                         [trans_id, amt], 
190                         [...]
191                     ], 
192                 }/, type => 'hash'
193             },
194             {
195                 desc => q/Last user transaction ID.  This is the actor.usr.last_xact_id value/, 
196                 type => 'string'
197             }
198         ],
199         "return" => {
200             "desc" =>
201                 q{Array of payment IDs on success, event on failure.  Event possibilities include:
202                 BAD_PARAMS
203                     Bad parameters were given to this API method itself.
204                     See note field.
205                 INVALID_USER_XACT_ID
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
209                     another payment
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
229                     they declined it.
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
239                         strings.
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.
248 },
249             "type" => "number"
250         }
251     }
252 );
253 sub make_payments {
254     my($self, $client, $auth, $payments, $last_xact_id) = @_;
255
256     my $e = new_editor(authtoken => $auth, xact => 1);
257     return $e->die_event unless $e->checkauth;
258
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};
266     my $total_paid = 0;
267     my $this_ou = $e->requestor->ws_ou || $e->requestor->home_ou;
268     my %orgs;
269
270
271     # unless/until determined by payment processor API
272     my ($approval_code, $cc_processor, $cc_order_number) = (undef,undef,undef, undef);
273
274     my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event;
275
276     if($patron->last_xact_id ne $last_xact_id) {
277         $e->rollback;
278         return OpenILS::Event->new('INVALID_USER_XACT_ID');
279     }
280
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);
285     }
286
287     # first collect the transactions and make sure the transaction
288     # user matches the requested user
289     my %xacts;
290
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})) {
299             $e->rollback;
300             return OpenILS::Event->new('MULTIPLE_PAYMENTS_FOR_XACT');
301         }
302
303         my $xact = $e->retrieve_money_billable_transaction_summary($xact_id)
304             or return $e->die_event;
305         
306         if($xact->usr != $user_id) {
307             $e->rollback;
308             return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/);
309         }
310
311         $xacts{$xact_id} = $xact;
312         push @unique_xact_payments, $pay;
313     }
314     $payments->{payments} = \@unique_xact_payments;
315
316     my @payment_objs;
317
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};
323
324         # add amounts as integers
325         $total_paid += (100 * $amount);
326
327         my $org_id = $U->xact_org($transid, $e);
328
329         if (!$orgs{$org_id}) {
330             $orgs{$org_id} = 1;
331
332             # patron credit has to be allowed at all orgs receiving payment
333             if ($type eq 'credit_payment' and $U->ou_ancestor_setting_value(
334                     $org_id, 'circ.disable_patron_credit', $e)) {
335                 $e->rollback;
336                 return OpenILS::Event->new('PATRON_CREDIT_DISABLED');
337             }
338         }
339
340         # A negative payment is a refund.  
341         if( $amount < 0 ) {
342
343             # Negative credit card payments are not allowed
344             if($type eq 'credit_card_payment') {
345                 $e->rollback;
346                 return OpenILS::Event->new(
347                     'BAD_PARAMS', 
348                     note => q/Negative credit card payments not allowed/
349                 );
350             }
351
352             # If the refund causes the transaction balance to exceed 0 dollars, 
353             # we are in effect loaning the patron money.  This is not allowed.
354             if( ($trans->balance_owed - $amount) > 0 ) {
355                 $e->rollback;
356                 return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
357             }
358
359             # Otherwise, make sure the refund does not exceed desk payments
360             # This is also not allowed
361             my $desk_total = 0;
362             my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
363             $desk_total += $_->amount for @$desk_payments;
364
365             if( (-$amount) > $desk_total ) {
366                 $e->rollback;
367                 return OpenILS::Event->new(
368                     'REFUND_EXCEEDS_DESK_PAYMENTS', 
369                     payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
370             }
371         }
372
373         my $payobj = "Fieldmapper::money::$type";
374         $payobj = $payobj->new;
375
376         $payobj->amount($amount);
377         $payobj->amount_collected($amount);
378         $payobj->xact($transid);
379         $payobj->note($note);
380         if ((not $payobj->note) and ($type eq 'credit_card_payment')) {
381             $payobj->note($cc_args->{note});
382         }
383
384         if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); }
385         if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); }
386         if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); }
387
388         # Store the last 4 digits of the CC number
389         if ($payobj->has_field('cc_number')) {
390             $payobj->cc_number(substr($cc_args->{number}, -4));
391         }
392
393         # Note: It is important not to set approval_code
394         # on the fieldmapper object yet.
395
396         push(@payment_objs, $payobj);
397
398     } # all payment objects have been created and inserted. 
399
400     # return to decimal format, forcing X.YY format for consistency.
401     $total_paid = sprintf("%.2f", $total_paid / 100);
402
403     #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED  ###
404     $e->rollback;
405
406     # After we try to externally process a credit card (if desired), we'll
407     # open a new transaction.  We cannot leave one open while credit card
408     # processing might be happening, as it can easily time out the database
409     # transaction.
410
411     my $cc_payload;
412
413     if($type eq 'credit_card_payment') {
414         $approval_code = $cc_args->{approval_code};
415         # If an approval code was not given, we'll need
416         # to call to the payment processor ourselves.
417         if ($cc_args->{where_process} == 1) {
418             my $response = process_stripe_or_bop_payment(
419                 $e, $user_id, $this_ou, $total_paid, $cc_args
420             );
421
422             if ($U->event_code($response)) { # non-success (success is 0)
423                 $logger->info(
424                     "Credit card payment for user $user_id failed: " .
425                     $response->{textcode} . " " .
426                     ($response->{payload}->{error_message} ||
427                         $response->{payload}{message})
428                 );
429                 return $response;
430             } else {
431                 # We need to save this for later in case there's a failure on
432                 # the EG side to store the processor's result.
433
434                 $cc_payload = $response->{"payload"};   # also used way later
435
436                 {
437                     no warnings 'uninitialized';
438                     $approval_code = $cc_payload->{authorization} ||
439                         $cc_payload->{id};
440                     $cc_processor = $cc_payload->{processor} ||
441                         $cc_args->{processor};
442                     $cc_order_number = $cc_payload->{order_number} ||
443                         $cc_payload->{invoice};
444                 };
445                 $logger->info("Credit card payment for user $user_id succeeded");
446             }
447         } else {
448             return OpenILS::Event->new(
449                 'BAD_PARAMS', note => 'Need approval code'
450             ) if not $cc_args->{approval_code};
451         }
452     }
453
454     ### RE-OPEN TRANSACTION HERE ###
455     $e->xact_begin;
456     my @payment_ids;
457
458     # create payment records
459     my $create_money_method = "create_money_" . $type;
460     for my $payment (@payment_objs) {
461         # update the transaction if it's done
462         my $amount = $payment->amount;
463         my $transid = $payment->xact;
464         my $trans = $xacts{$transid};
465         # making payment with existing patron credit.
466         $credit -= $amount if $type eq 'credit_payment';
467         if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) {
468             # Any overpay on this transaction goes directly into patron
469             # credit
470             $cred = -$cred;
471             $credit += $cred;
472             my $circ = $e->retrieve_action_circulation(
473                 [
474                     $transid,
475                     {
476                         flesh => 1,
477                         flesh_fields => {circ => ['target_copy','billings']}
478                     }
479                 ]
480             ); # Flesh the copy, so we can monkey with the status if
481                # necessary.
482
483             # Whether or not we close the transaction. We definitely
484             # close if no circulation transaction is present,
485             # otherwise we check if the circulation is in a state that
486             # allows itself to be closed.
487             if (!$circ || $CC->can_close_circ($e, $circ)) {
488                 $trans = $e->retrieve_money_billable_transaction($transid);
489                 $trans->xact_finish("now");
490                 if (!$e->update_money_billable_transaction($trans)) {
491                     return _recording_failure(
492                         $e, "update_money_billable_transaction() failed",
493                         $payment, $cc_payload
494                     )
495                 }
496
497                 # If we have a circ, we need to check if the copy
498                 # status is lost or long overdue.  If it is then we
499                 # check org_unit_settings for the copy owning library
500                 # and adjust and possibly adjust copy status to lost
501                 # and paid.
502                 if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
503                     # We need the copy to check settings and to possibly
504                     # change its status.
505                     my $copy = $circ->target_copy();
506                     # Library where we'll check settings.
507                     my $check_lib = $copy->circ_lib();
508
509                     # check the copy status
510                     if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
511                             && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
512                         $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
513                         if (!$e->update_asset_copy($copy)) {
514                             return _recording_failure(
515                                 $e, "update_asset_copy_failed()",
516                                 $payment, $cc_payload
517                             )
518                         }
519                     }
520                 }
521             }
522         }
523
524         # Urgh, clean up this mega-function one day.
525         if ($cc_processor eq 'Stripe' and $approval_code and $cc_payload) {
526             $payment->cc_number($cc_payload->{card}{last4});
527         }
528
529         $payment->approval_code($approval_code) if $approval_code;
530         $payment->cc_order_number($cc_order_number) if $cc_order_number;
531         $payment->cc_processor($cc_processor) if $cc_processor;
532         if (!$e->$create_money_method($payment)) {
533             return _recording_failure(
534                 $e, "$create_money_method failed", $payment, $cc_payload
535             );
536         }
537
538         push(@payment_ids, $payment->id);
539     }
540
541     my $evt = _update_patron_credit($e, $patron, $credit);
542     if ($evt) {
543         return _recording_failure(
544             $e, "_update_patron_credit() failed", undef, $cc_payload
545         );
546     }
547
548     for my $org_id (keys %orgs) {
549         # calculate penalties for each of the affected orgs
550         $evt = OpenILS::Utils::Penalty->calculate_penalties(
551             $e, $user_id, $org_id
552         );
553         if ($evt) {
554             return _recording_failure(
555                 $e, "calculate_penalties() failed", undef, $cc_payload
556             );
557         }
558     }
559
560     # update the user to create a new last_xact_id
561     $e->update_actor_user($patron) or return $e->die_event;
562     $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
563     $e->commit;
564
565     # update the cached user object if a user is making a payment toward 
566     # his/her own account
567     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
568         if $user_id == $e->requestor->id;
569
570     return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
571 }
572
573 sub _recording_failure {
574     my ($e, $msg, $payment, $payload) = @_;
575
576     if ($payload) { # If the payment processor already accepted a payment:
577         $logger->error($msg);
578         $logger->error("Payment processor payload: " . Dumper($payload));
579         # payment shouldn't contain CC number
580         $logger->error("Payment: " . Dumper($payment)) if $payment;
581
582         $e->rollback;
583
584         return new OpenILS::Event(
585             "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
586             "payload" => $payload
587         );
588     } else { # Otherwise, the problem is somewhat less severe:
589         $logger->warn($msg);
590         $logger->warn("Payment: " . Dumper($payment)) if $payment;
591         return $e->die_event;
592     }
593 }
594
595 sub _update_patron_credit {
596     my($e, $patron, $credit) = @_;
597     return undef if $credit == 0;
598     $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
599     return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
600     $e->update_actor_user($patron) or return $e->die_event;
601     return undef;
602 }
603
604
605 __PACKAGE__->register_method(
606     method    => "retrieve_payments",
607     api_name    => "open-ils.circ.money.payment.retrieve.all_",
608     notes        => "Returns a list of payments attached to a given transaction"
609     );
610 sub retrieve_payments {
611     my( $self, $client, $login, $transid ) = @_;
612
613     my( $staff, $evt ) =  
614         $apputils->checksesperm($login, 'VIEW_TRANSACTION');
615     return $evt if $evt;
616
617     # XXX the logic here is wrong.. we need to check the owner of the transaction
618     # to make sure the requestor has access
619
620     # XXX grab the view, for each object in the view, grab the real object
621
622     return $apputils->simplereq(
623         'open-ils.cstore',
624         'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
625 }
626
627
628 __PACKAGE__->register_method(
629     method    => "retrieve_payments2",
630     authoritative => 1,
631     api_name    => "open-ils.circ.money.payment.retrieve.all",
632     notes        => "Returns a list of payments attached to a given transaction"
633     );
634     
635 sub retrieve_payments2 {
636     my( $self, $client, $login, $transid ) = @_;
637
638     my $e = new_editor(authtoken=>$login);
639     return $e->event unless $e->checkauth;
640     return $e->event unless $e->allowed('VIEW_TRANSACTION');
641
642     my @payments;
643     my $pmnts = $e->search_money_payment({ xact => $transid });
644     for( @$pmnts ) {
645         my $type = $_->payment_type;
646         my $meth = "retrieve_money_$type";
647         my $p = $e->$meth($_->id) or return $e->event;
648         $p->payment_type($type);
649         $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
650             if $p->has_field('cash_drawer');
651         push( @payments, $p );
652     }
653
654     return \@payments;
655 }
656
657 __PACKAGE__->register_method(
658     method    => "format_payment_receipt",
659     api_name  => "open-ils.circ.money.payment_receipt.print",
660     signature => {
661         desc   => 'Returns a printable receipt for the specified payments',
662         params => [
663             { desc => 'Authentication token',  type => 'string'},
664             { desc => 'Payment ID or array of payment IDs', type => 'number' },
665         ],
666         return => {
667             desc => q/An action_trigger.event object or error event./,
668             type => 'object',
669         }
670     }
671 );
672 __PACKAGE__->register_method(
673     method    => "format_payment_receipt",
674     api_name  => "open-ils.circ.money.payment_receipt.email",
675     signature => {
676         desc   => 'Emails a receipt for the specified payments to the user associated with the first payment',
677         params => [
678             { desc => 'Authentication token',  type => 'string'},
679             { desc => 'Payment ID or array of payment IDs', type => 'number' },
680         ],
681         return => {
682             desc => q/Undefined on success, otherwise an error event./,
683             type => 'object',
684         }
685     }
686 );
687
688 sub format_payment_receipt {
689     my($self, $conn, $auth, $mp_id) = @_;
690
691     my $mp_ids;
692     if (ref $mp_id ne 'ARRAY') {
693         $mp_ids = [ $mp_id ];
694     } else {
695         $mp_ids = $mp_id;
696     }
697
698     my $for_print = ($self->api_name =~ /print/);
699     my $for_email = ($self->api_name =~ /email/);
700
701     # manually use xact (i.e. authoritative) so we can kill the cstore
702     # connection before sending the action/trigger request.  This prevents our cstore
703     # backend from sitting idle while A/T (which uses its own transactions) runs.
704     my $e = new_editor(xact => 1, authtoken => $auth);
705     return $e->die_event unless $e->checkauth;
706
707     my $payments = [];
708     for my $id (@$mp_ids) {
709
710         my $payment = $e->retrieve_money_payment([
711             $id,
712             {   flesh => 2,
713                 flesh_fields => {
714                     mp => ['xact'],
715                     mbt => ['usr']
716                 }
717             }
718         ]) or return $e->die_event;
719
720         return $e->die_event unless 
721             $e->requestor->id == $payment->xact->usr->id or
722             $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou); 
723
724         push @$payments, $payment;
725     }
726
727     $e->rollback;
728
729     if ($for_print) {
730
731         return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
732
733     } elsif ($for_email) {
734
735         for my $p (@$payments) {
736             $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
737         }
738     }
739
740     return undef;
741 }
742
743 __PACKAGE__->register_method(
744     method    => "create_grocery_bill",
745     api_name    => "open-ils.circ.money.grocery.create",
746     notes        => <<"    NOTE");
747     Creates a new grocery transaction using the transaction object provided
748     PARAMS: (login_session, money.grocery (mg) object)
749     NOTE
750
751 sub create_grocery_bill {
752     my( $self, $client, $login, $transaction ) = @_;
753
754     my( $staff, $evt ) = $apputils->checkses($login);
755     return $evt if $evt;
756     $evt = $apputils->check_perms($staff->id, 
757         $transaction->billing_location, 'CREATE_TRANSACTION' );
758     return $evt if $evt;
759
760
761     $logger->activity("Creating grocery bill " . Dumper($transaction) );
762
763     $transaction->clear_id;
764     my $session = $apputils->start_db_session;
765     $apputils->set_audit_info($session, $login, $staff->id, $staff->wsid);
766     my $transid = $session->request(
767         'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
768
769     throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
770
771     $logger->debug("Created new grocery transaction $transid");
772     
773     $apputils->commit_db_session($session);
774
775     my $e = new_editor(xact=>1);
776     $evt = $U->check_open_xact($e, $transid);
777     return $evt if $evt;
778     $e->commit;
779
780     return $transid;
781 }
782
783
784 __PACKAGE__->register_method(
785     method => 'fetch_reservation',
786     api_name => 'open-ils.circ.booking.reservation.retrieve'
787 );
788 sub fetch_reservation {
789     my( $self, $conn, $auth, $id ) = @_;
790     my $e = new_editor(authtoken=>$auth);
791     return $e->event unless $e->checkauth;
792     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
793     my $g = $e->retrieve_booking_reservation($id)
794         or return $e->event;
795     return $g;
796 }
797
798 __PACKAGE__->register_method(
799     method   => 'fetch_grocery',
800     api_name => 'open-ils.circ.money.grocery.retrieve'
801 );
802 sub fetch_grocery {
803     my( $self, $conn, $auth, $id ) = @_;
804     my $e = new_editor(authtoken=>$auth);
805     return $e->event unless $e->checkauth;
806     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
807     my $g = $e->retrieve_money_grocery($id)
808         or return $e->event;
809     return $g;
810 }
811
812
813 __PACKAGE__->register_method(
814     method        => "billing_items",
815     api_name      => "open-ils.circ.money.billing.retrieve.all",
816     authoritative => 1,
817     signature     => {
818         desc   => 'Returns a list of billing items for the given transaction ID.  ' .
819                   'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
820         params => [
821             { desc => 'Authentication token', type => 'string'},
822             { desc => 'Transaction ID',       type => 'number'}
823         ],
824         return => {
825             desc => 'Transaction object, event on error'
826         },
827     }
828 );
829
830 sub billing_items {
831     my( $self, $client, $login, $transid ) = @_;
832
833     my( $trans, $evt ) = $U->fetch_billable_xact($transid);
834     return $evt if $evt;
835
836     my $staff;
837     ($staff, $evt ) = $apputils->checkses($login);
838     return $evt if $evt;
839
840     if($staff->id ne $trans->usr) {
841         $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
842         return $evt if $evt;
843     }
844     
845     return $apputils->simplereq( 'open-ils.cstore',
846         'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
847 }
848
849
850 __PACKAGE__->register_method(
851     method   => "billing_items_create",
852     api_name => "open-ils.circ.money.billing.create",
853     notes    => <<"    NOTE");
854     Creates a new billing line item
855     PARAMS( login, bill_object (mb) )
856     NOTE
857
858 sub billing_items_create {
859     my( $self, $client, $login, $billing ) = @_;
860
861     my $e = new_editor(authtoken => $login, xact => 1);
862     return $e->die_event unless $e->checkauth;
863     return $e->die_event unless $e->allowed('CREATE_BILL');
864
865     my $xact = $e->retrieve_money_billable_transaction($billing->xact)
866         or return $e->die_event;
867
868     # if the transaction was closed, re-open it
869     if($xact->xact_finish) {
870         $xact->clear_xact_finish;
871         $e->update_money_billable_transaction($xact)
872             or return $e->die_event;
873     }
874
875     my $amt = $billing->amount;
876     $amt =~ s/\$//og;
877     $billing->amount($amt);
878
879     $e->create_money_billing($billing) or return $e->die_event;
880     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id,$e));
881     return $evt if $evt;
882
883     $evt = $U->check_open_xact($e, $xact->id, $xact);
884     return $evt if $evt;
885
886     $e->commit;
887
888     return $billing->id;
889 }
890
891
892 __PACKAGE__->register_method(
893     method        =>    'void_bill',
894     api_name        => 'open-ils.circ.money.billing.void',
895     signature    => q/
896         Voids a bill
897         @param authtoken Login session key
898         @param billid Id for the bill to void.  This parameter may be repeated to reference other bills.
899         @return 1 on success, Event on error
900     /
901 );
902 sub void_bill {
903     my( $s, $c, $authtoken, @billids ) = @_;
904     my $editor = new_editor(authtoken=>$authtoken, xact=>1);
905     return $editor->die_event unless $editor->checkauth;
906     return $editor->die_event unless $editor->allowed('VOID_BILLING');
907     my $rv = $CC->void_bills($editor, \@billids);
908     if (ref($rv) eq 'HASH') {
909         # We got an event.
910         $editor->rollback();
911     } else {
912         # We should have gotten 1.
913         $editor->commit();
914     }
915     return $rv;
916 }
917
918
919 __PACKAGE__->register_method(
920     method => 'adjust_bills_to_zero_manual',
921     api_name => 'open-ils.circ.money.billable_xact.adjust_to_zero',
922     signature => {
923         desc => q/
924             Given a list of billable transactions, manipulate the
925             transaction using account adjustments to result in a
926             balance of $0.
927             /,
928         params => [
929             {desc => 'Authtoken', type => 'string'},
930             {desc => 'Array of transaction IDs', type => 'array'}
931         ],
932         return => {
933             desc => q/Array of IDs for each transaction updated,
934             Event on error./
935         }
936     }
937 );
938
939 sub _rebill_xact {
940     my ($e, $xact) = @_;
941
942     my $xact_id = $xact->id;
943     # the plan: rebill voided billings until we get a positive balance
944     #
945     # step 1: get the voided/adjusted billings
946     my $billings = $e->search_money_billing([
947         {
948             xact => $xact_id,
949         },
950         {
951             order_by => {mb => 'amount desc'},
952             flesh => 1,
953             flesh_fields => {mb => ['adjustments']},
954         }
955     ]);
956     my @billings = grep { $U->is_true($_->voided) or @{$_->adjustments} } @$billings;
957
958     my $xact_balance = $xact->balance_owed;
959     $logger->debug("rebilling for xact $xact_id with balance $xact_balance");
960
961     my $rebill_amount = 0;
962     my @rebill_ids;
963     # step 2: generate new bills just like the old ones
964     for my $billing (@billings) {
965         my $amount = 0;
966         if ($U->is_true($billing->voided)) {
967             $amount = $billing->amount;
968         } else { # adjusted billing
969             map { $amount = $U->fpsum($amount, $_->amount) } @{$billing->adjustments};
970         }
971         my $evt = $CC->create_bill(
972             $e,
973             $amount,
974             $billing->btype,
975             $billing->billing_type,
976             $xact_id,
977             "System: MANUAL ADJUSTMENT, BILLING #".$billing->id." REINSTATED\n(PREV: ".$billing->note.")",
978             $billing->billing_ts()
979         );
980         return $evt if $evt;
981         $rebill_amount += $billing->amount;
982
983         # if we have a postive (or zero) balance now, stop
984         last if $rebill_amount >= $xact_balance;
985     }
986 }
987
988 sub _is_fully_adjusted {
989     my ($billing) = @_;
990
991     my $amount_adj = 0;
992     map { $amount_adj = $U->fpsum($amount_adj, $_->amount) } @{$billing->adjustments};
993
994     return $billing->amount == $amount_adj;
995 }
996
997 sub adjust_bills_to_zero_manual {
998     my ($self, $client, $auth, $xact_ids) = @_;
999
1000     my $e = new_editor(xact => 1, authtoken => $auth);
1001     return $e->die_event unless $e->checkauth;
1002
1003     # in case a bare ID is passed
1004     $xact_ids = [$xact_ids] unless ref $xact_ids;
1005
1006     my @modified;
1007     for my $xact_id (@$xact_ids) {
1008
1009         my $xact =
1010             $e->retrieve_money_billable_transaction_summary([
1011                 $xact_id,
1012                 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1013             ]) or return $e->die_event;
1014
1015         return $e->die_event unless
1016             $e->allowed('ADJUST_BILLS', $xact->usr->home_ou);
1017
1018         if ($xact->balance_owed < 0) {
1019             my $evt = _rebill_xact($e, $xact);
1020             return $evt if $evt;
1021             # refetch xact to get new balance
1022             $xact =
1023                 $e->retrieve_money_billable_transaction_summary([
1024                     $xact_id,
1025                     {flesh => 1, flesh_fields => {mbts => ['usr']}}
1026                 ]) or return $e->die_event;
1027         }
1028
1029         my $billings = $e->search_money_billing([
1030             {
1031                 xact => $xact_id,
1032             },
1033             {
1034                 order_by => {mb => 'amount desc'},
1035                 flesh => 1,
1036                 flesh_fields => {mb => ['adjustments']},
1037             }
1038         ]);
1039
1040         if ($xact->balance_owed == 0) {
1041             # if was zero, or we rebilled it to zero
1042             next;
1043         } else {
1044             # it's positive and needs to be adjusted
1045             my @billings_to_zero = grep { !$U->is_true($_->voided) or !_is_fully_adjusted($_) } @$billings;
1046             $CC->adjust_bills_to_zero($e, \@billings_to_zero, "System: MANUAL ADJUSTMENT");
1047         }
1048
1049         push(@modified, $xact->id);
1050
1051         # now we see if we can close the transaction
1052         # same logic as make_payments();
1053         my $circ = $e->retrieve_action_circulation($xact_id);
1054         if (!$circ or $CC->can_close_circ($e, $circ)) {
1055             # we don't check to see if the xact is already closed.  since the
1056             # xact had a negative balance, it should not have been closed, so
1057             # assume 'now' is the correct close time regardless.
1058             my $trans = $e->retrieve_money_billable_transaction($xact_id);
1059             $trans->xact_finish("now");
1060             $e->update_money_billable_transaction($trans) or return $e->die_event;
1061         }
1062     }
1063
1064     $e->commit;
1065     return \@modified;
1066 }
1067
1068
1069 __PACKAGE__->register_method(
1070     method        =>    'edit_bill_note',
1071     api_name        => 'open-ils.circ.money.billing.note.edit',
1072     signature    => q/
1073         Edits the note for a bill
1074         @param authtoken Login session key
1075         @param note The replacement note for the bills we're editing
1076         @param billid Id for the bill to edit the note of.  This parameter may be repeated to reference other bills.
1077         @return 1 on success, Event on error
1078     /
1079 );
1080 sub edit_bill_note {
1081     my( $s, $c, $authtoken, $note, @billids ) = @_;
1082
1083     my $e = new_editor( authtoken => $authtoken, xact => 1 );
1084     return $e->die_event unless $e->checkauth;
1085     return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
1086
1087     for my $billid (@billids) {
1088
1089         my $bill = $e->retrieve_money_billing($billid)
1090             or return $e->die_event;
1091
1092         $bill->note($note);
1093         # 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.
1094     
1095         $e->update_money_billing($bill) or return $e->die_event;
1096     }
1097     $e->commit;
1098     return 1;
1099 }
1100
1101
1102 __PACKAGE__->register_method(
1103     method        =>    'edit_payment_note',
1104     api_name        => 'open-ils.circ.money.payment.note.edit',
1105     signature    => q/
1106         Edits the note for a payment
1107         @param authtoken Login session key
1108         @param note The replacement note for the payments we're editing
1109         @param paymentid Id for the payment to edit the note of.  This parameter may be repeated to reference other payments.
1110         @return 1 on success, Event on error
1111     /
1112 );
1113 sub edit_payment_note {
1114     my( $s, $c, $authtoken, $note, @paymentids ) = @_;
1115
1116     my $e = new_editor( authtoken => $authtoken, xact => 1 );
1117     return $e->die_event unless $e->checkauth;
1118     return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
1119
1120     for my $paymentid (@paymentids) {
1121
1122         my $payment = $e->retrieve_money_payment($paymentid)
1123             or return $e->die_event;
1124
1125         $payment->note($note);
1126         # 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.
1127     
1128         $e->update_money_payment($payment) or return $e->die_event;
1129     }
1130
1131     $e->commit;
1132     return 1;
1133 }
1134
1135
1136 __PACKAGE__->register_method (
1137     method => 'fetch_mbts',
1138     authoritative => 1,
1139     api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
1140 );
1141 sub fetch_mbts {
1142     my( $self, $conn, $auth, $id) = @_;
1143
1144     my $e = new_editor(xact => 1, authtoken=>$auth);
1145     return $e->event unless $e->checkauth;
1146     my ($mbts) = $U->fetch_mbts($id, $e);
1147
1148     my $user = $e->retrieve_actor_user($mbts->usr)
1149         or return $e->die_event;
1150
1151     return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1152     $e->rollback;
1153     return $mbts
1154 }
1155
1156
1157 __PACKAGE__->register_method(
1158     method => 'desk_payments',
1159     api_name => 'open-ils.circ.money.org_unit.desk_payments'
1160 );
1161 sub desk_payments {
1162     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1163     my $e = new_editor(authtoken=>$auth);
1164     return $e->event unless $e->checkauth;
1165     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1166     my $data = $U->storagereq(
1167         'open-ils.storage.money.org_unit.desk_payments.atomic',
1168         $org, $start_date, $end_date );
1169
1170     $_->workstation( $_->workstation->name ) for(@$data);
1171     return $data;
1172 }
1173
1174
1175 __PACKAGE__->register_method(
1176     method => 'user_payments',
1177     api_name => 'open-ils.circ.money.org_unit.user_payments'
1178 );
1179
1180 sub user_payments {
1181     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1182     my $e = new_editor(authtoken=>$auth);
1183     return $e->event unless $e->checkauth;
1184     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1185     my $data = $U->storagereq(
1186         'open-ils.storage.money.org_unit.user_payments.atomic',
1187         $org, $start_date, $end_date );
1188     for(@$data) {
1189         $_->usr->card(
1190             $e->retrieve_actor_card($_->usr->card)->barcode);
1191         $_->usr->home_ou(
1192             $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1193     }
1194     return $data;
1195 }
1196
1197
1198 __PACKAGE__->register_method(
1199     method    => 'retrieve_credit_payable_balance',
1200     api_name  => 'open-ils.circ.credit.payable_balance.retrieve',
1201     authoritative => 1,
1202     signature => {
1203         desc   => q/Returns the total amount the patron can pay via credit card/,
1204         params => [
1205             { desc => 'Authentication token', type => 'string' },
1206             { desc => 'User id', type => 'number' }
1207         ],
1208         return => { desc => 'The ID of the new provider' }
1209     }
1210 );
1211
1212 sub retrieve_credit_payable_balance {
1213     my ( $self, $conn, $auth, $user_id ) = @_;
1214     my $e = new_editor(authtoken => $auth);
1215     return $e->event unless $e->checkauth;
1216
1217     my $user = $e->retrieve_actor_user($user_id) 
1218         or return $e->event;
1219
1220     if($e->requestor->id != $user_id) {
1221         return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1222     }
1223
1224     my $circ_orgs = $e->json_query({
1225         "select" => {circ => ["circ_lib"]},
1226         from     => "circ",
1227         "where"  => {usr => $user_id, xact_finish => undef},
1228         distinct => 1
1229     });
1230
1231     my $groc_orgs = $e->json_query({
1232         "select" => {mg => ["billing_location"]},
1233         from     => "mg",
1234         "where"  => {usr => $user_id, xact_finish => undef},
1235         distinct => 1
1236     });
1237
1238     my %hash;
1239     for my $org ( @$circ_orgs, @$groc_orgs ) {
1240         my $o = $org->{billing_location};
1241         $o = $org->{circ_lib} unless $o;
1242         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.
1243         $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
1244     }
1245
1246     my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1247     $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1248
1249     my $xact_summaries =
1250       OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1251         'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1252
1253     my $sum = 0.0;
1254
1255     for my $xact (@$xact_summaries) {
1256
1257         # make two lists and grab them in batch XXX
1258         if ( $xact->xact_type eq 'circulation' ) {
1259             my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
1260             next unless grep { $_ == $circ->circ_lib } @credit_orgs;
1261
1262         } elsif ($xact->xact_type eq 'grocery') {
1263             my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
1264             next unless grep { $_ == $bill->billing_location } @credit_orgs;
1265         } elsif ($xact->xact_type eq 'reservation') {
1266             my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
1267             next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
1268         }
1269         $sum += $xact->balance_owed();
1270     }
1271
1272     return $sum;
1273 }
1274
1275
1276 1;