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         $total_paid += $amount;
 325
 326         my $org_id = $U->xact_org($transid, $e);
 327
 328         if (!$orgs{$org_id}) {
 329             $orgs{$org_id} = 1;
 330
 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)) {
 334                 $e->rollback;
 335                 return OpenILS::Event->new('PATRON_CREDIT_DISABLED');
 336             }
 337         }
 338
 339         # A negative payment is a refund.
 340         if( $amount < 0 ) {
 341
 342             # Negative credit card payments are not allowed
 343             if($type eq 'credit_card_payment') {
 344                 $e->rollback;
 345                 return OpenILS::Event->new(
 346                     'BAD_PARAMS',
 347                     note => q/Negative credit card payments not allowed/
 348                 );
 349             }
 350
 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 ) {
 354                 $e->rollback;
 355                 return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
 356             }
 357
 358             # Otherwise, make sure the refund does not exceed desk payments
 359             # This is also not allowed
 360             my $desk_total = 0;
 361             my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
 362             $desk_total += $_->amount for @$desk_payments;
 363
 364             if( (-$amount) > $desk_total ) {
 365                 $e->rollback;
 366                 return OpenILS::Event->new(
 367                     'REFUND_EXCEEDS_DESK_PAYMENTS',
 368                     payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
 369             }
 370         }
 371
 372         my $payobj = "Fieldmapper::money::$type";
 373         $payobj = $payobj->new;
 374
 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});
 381         }
 382
 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); }
 386
 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));
 390         }
 391
 392         # Note: It is important not to set approval_code
 393         # on the fieldmapper object yet.
 394
 395         push(@payment_objs, $payobj);
 396
 397     } # all payment objects have been created and inserted.
 398
 399     #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED  ###
 400     $e->rollback;
 401
 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
 405     # transaction.
 406
 407     my $cc_payload;
 408
 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
 416             );
 417
 418             if ($U->event_code($response)) { # non-success (success is 0)
 419                 $logger->info(
 420                     "Credit card payment for user $user_id failed: " .
 421                     $response->{textcode} . " " .
 422                     ($response->{payload}->{error_message} ||
 423                         $response->{payload}{message})
 424                 );
 425                 return $response;
 426             } else {
 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.
 429
 430                 $cc_payload = $response->{"payload"};   # also used way later
 431
 432                 {
 433                     no warnings 'uninitialized';
 434                     $approval_code = $cc_payload->{authorization} ||
 435                         $cc_payload->{id};
 436                     $cc_processor = $cc_payload->{processor} ||
 437                         $cc_args->{processor};
 438                     $cc_order_number = $cc_payload->{order_number} ||
 439                         $cc_payload->{invoice};
 440                 };
 441                 $logger->info("Credit card payment for user $user_id succeeded");
 442             }
 443         } else {
 444             return OpenILS::Event->new(
 445                 'BAD_PARAMS', note => 'Need approval code'
 446             ) if not $cc_args->{approval_code};
 447         }
 448     }
 449
 450     ### RE-OPEN TRANSACTION HERE ###
 451     $e->xact_begin;
 452     my @payment_ids;
 453
 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
 465             # credit
 466             $cred = -$cred;
 467             $credit += $cred;
 468             my $circ = $e->retrieve_action_circulation(
 469                 [
 470                     $transid,
 471                     {
 472                         flesh => 1,
 473                         flesh_fields => {circ => ['target_copy','billings']}
 474                     }
 475                 ]
 476             ); # Flesh the copy, so we can monkey with the status if
 477                # necessary.
 478
 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
 490                     )
 491                 }
 492
 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
 497                 # and paid.
 498                 if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
 499                     # We need the copy to check settings and to possibly
 500                     # change its status.
 501                     my $copy = $circ->target_copy();
 502                     # Library where we'll check settings.
 503                     my $check_lib = $copy->circ_lib();
 504
 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
 513                             )
 514                         }
 515                     }
 516                 }
 517             }
 518         }
 519
 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});
 523         }
 524
 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
 531             );
 532         }
 533
 534         push(@payment_ids, $payment->id);
 535     }
 536
 537     my $evt = _update_patron_credit($e, $patron, $credit);
 538     if ($evt) {
 539         return _recording_failure(
 540             $e, "_update_patron_credit() failed", undef, $cc_payload
 541         );
 542     }
 543
 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
 548         );
 549         if ($evt) {
 550             return _recording_failure(
 551                 $e, "calculate_penalties() failed", undef, $cc_payload
 552             );
 553         }
 554     }
 555
 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;
 559     $e->commit;
 560
 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;
 565
 566     return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
 567 }
 568
 569 sub _recording_failure {
 570     my ($e, $msg, $payment, $payload) = @_;
 571
 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;
 577
 578         $e->rollback;
 579
 580         return new OpenILS::Event(
 581             "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
 582             "payload" => $payload
 583         );
 584     } else { # Otherwise, the problem is somewhat less severe:
 585         $logger->warn($msg);
 586         $logger->warn("Payment: " . Dumper($payment)) if $payment;
 587         return $e->die_event;
 588     }
 589 }
 590
 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;
 597     return undef;
 598 }
 599
 600
 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"
 605     );
 606 sub retrieve_payments {
 607     my( $self, $client, $login, $transid ) = @_;
 608
 609     my( $staff, $evt ) =
 610         $apputils->checksesperm($login, 'VIEW_TRANSACTION');
 611     return $evt if $evt;
 612
 613     # XXX the logic here is wrong.. we need to check the owner of the transaction
 614     # to make sure the requestor has access
 615
 616     # XXX grab the view, for each object in the view, grab the real object
 617
 618     return $apputils->simplereq(
 619         'open-ils.cstore',
 620         'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
 621 }
 622
 623
 624 __PACKAGE__->register_method(
 625     method    => "retrieve_payments2",
 626     authoritative => 1,
 627     api_name    => "open-ils.circ.money.payment.retrieve.all",
 628     notes        => "Returns a list of payments attached to a given transaction"
 629     );
 630
 631 sub retrieve_payments2 {
 632     my( $self, $client, $login, $transid ) = @_;
 633
 634     my $e = new_editor(authtoken=>$login);
 635     return $e->event unless $e->checkauth;
 636     return $e->event unless $e->allowed('VIEW_TRANSACTION');
 637
 638     my @payments;
 639     my $pmnts = $e->search_money_payment({ xact => $transid });
 640     for( @$pmnts ) {
 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 );
 648     }
 649
 650     return \@payments;
 651 }
 652
 653 __PACKAGE__->register_method(
 654     method    => "format_payment_receipt",
 655     api_name  => "open-ils.circ.money.payment_receipt.print",
 656     signature => {
 657         desc   => 'Returns a printable receipt for the specified payments',
 658         params => [
 659             { desc => 'Authentication token',  type => 'string'},
 660             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 661         ],
 662         return => {
 663             desc => q/An action_trigger.event object or error event./,
 664             type => 'object',
 665         }
 666     }
 667 );
 668 __PACKAGE__->register_method(
 669     method    => "format_payment_receipt",
 670     api_name  => "open-ils.circ.money.payment_receipt.email",
 671     signature => {
 672         desc   => 'Emails a receipt for the specified payments to the user associated with the first payment',
 673         params => [
 674             { desc => 'Authentication token',  type => 'string'},
 675             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 676         ],
 677         return => {
 678             desc => q/Undefined on success, otherwise an error event./,
 679             type => 'object',
 680         }
 681     }
 682 );
 683
 684 sub format_payment_receipt {
 685     my($self, $conn, $auth, $mp_id) = @_;
 686
 687     my $mp_ids;
 688     if (ref $mp_id ne 'ARRAY') {
 689         $mp_ids = [ $mp_id ];
 690     } else {
 691         $mp_ids = $mp_id;
 692     }
 693
 694     my $for_print = ($self->api_name =~ /print/);
 695     my $for_email = ($self->api_name =~ /email/);
 696
 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;
 702
 703     my $payments = [];
 704     for my $id (@$mp_ids) {
 705
 706         my $payment = $e->retrieve_money_payment([
 707             $id,
 708             {   flesh => 2,
 709                 flesh_fields => {
 710                     mp => ['xact'],
 711                     mbt => ['usr']
 712                 }
 713             }
 714         ]) or return $e->die_event;
 715
 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);
 719
 720         push @$payments, $payment;
 721     }
 722
 723     $e->rollback;
 724
 725     if ($for_print) {
 726
 727         return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
 728
 729     } elsif ($for_email) {
 730
 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);
 733         }
 734     }
 735
 736     return undef;
 737 }
 738
 739 __PACKAGE__->register_method(
 740     method    => "create_grocery_bill",
 741     api_name    => "open-ils.circ.money.grocery.create",
 742     notes        => <<"    NOTE");
 743     Creates a new grocery transaction using the transaction object provided
 744     PARAMS: (login_session, money.grocery (mg) object)
 745     NOTE
 746
 747 sub create_grocery_bill {
 748     my( $self, $client, $login, $transaction ) = @_;
 749
 750     my( $staff, $evt ) = $apputils->checkses($login);
 751     return $evt if $evt;
 752     $evt = $apputils->check_perms($staff->id,
 753         $transaction->billing_location, 'CREATE_TRANSACTION' );
 754     return $evt if $evt;
 755
 756
 757     $logger->activity("Creating grocery bill " . Dumper($transaction) );
 758
 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);
 764
 765     throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
 766
 767     $logger->debug("Created new grocery transaction $transid");
 768
 769     $apputils->commit_db_session($session);
 770
 771     my $e = new_editor(xact=>1);
 772     $evt = $U->check_open_xact($e, $transid);
 773     return $evt if $evt;
 774     $e->commit;
 775
 776     return $transid;
 777 }
 778
 779
 780 __PACKAGE__->register_method(
 781     method => 'fetch_reservation',
 782     api_name => 'open-ils.circ.booking.reservation.retrieve'
 783 );
 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)
 790         or return $e->event;
 791     return $g;
 792 }
 793
 794 __PACKAGE__->register_method(
 795     method   => 'fetch_grocery',
 796     api_name => 'open-ils.circ.money.grocery.retrieve'
 797 );
 798 sub fetch_grocery {
 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)
 804         or return $e->event;
 805     return $g;
 806 }
 807
 808
 809 __PACKAGE__->register_method(
 810     method        => "billing_items",
 811     api_name      => "open-ils.circ.money.billing.retrieve.all",
 812     authoritative => 1,
 813     signature     => {
 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.',
 816         params => [
 817             { desc => 'Authentication token', type => 'string'},
 818             { desc => 'Transaction ID',       type => 'number'}
 819         ],
 820         return => {
 821             desc => 'Transaction object, event on error'
 822         },
 823     }
 824 );
 825
 826 sub billing_items {
 827     my( $self, $client, $login, $transid ) = @_;
 828
 829     my( $trans, $evt ) = $U->fetch_billable_xact($transid);
 830     return $evt if $evt;
 831
 832     my $staff;
 833     ($staff, $evt ) = $apputils->checkses($login);
 834     return $evt if $evt;
 835
 836     if($staff->id ne $trans->usr) {
 837         $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
 838         return $evt if $evt;
 839     }
 840
 841     return $apputils->simplereq( 'open-ils.cstore',
 842         'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
 843 }
 844
 845
 846 __PACKAGE__->register_method(
 847     method   => "billing_items_create",
 848     api_name => "open-ils.circ.money.billing.create",
 849     notes    => <<"    NOTE");
 850     Creates a new billing line item
 851     PARAMS( login, bill_object (mb) )
 852     NOTE
 853
 854 sub billing_items_create {
 855     my( $self, $client, $login, $billing ) = @_;
 856
 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');
 860
 861     my $xact = $e->retrieve_money_billable_transaction($billing->xact)
 862         or return $e->die_event;
 863
 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;
 869     }
 870
 871     my $amt = $billing->amount;
 872     $amt =~ s/\$//og;
 873     $billing->amount($amt);
 874
 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));
 877     return $evt if $evt;
 878
 879     $evt = $U->check_open_xact($e, $xact->id, $xact);
 880     return $evt if $evt;
 881
 882     $e->commit;
 883
 884     return $billing->id;
 885 }
 886
 887
 888 __PACKAGE__->register_method(
 889     method        =>    'void_bill',
 890     api_name        => 'open-ils.circ.money.billing.void',
 891     signature    => q/
 892         Voids a bill
 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
 896     /
 897 );
 898 sub void_bill {
 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') {
 905         # We got an event.
 906         $editor->rollback();
 907     } else {
 908         # We should have gotten 1.
 909         $editor->commit();
 910     }
 911     return $rv;
 912 }
 913
 914
 915 __PACKAGE__->register_method(
 916     method => 'adjust_bills_to_zero_manual',
 917     api_name => 'open-ils.circ.money.billable_xact.adjust_to_zero',
 918     signature => {
 919         desc => q/
 920             Given a list of billable transactions, manipulate the
 921             transaction using account adjustments to result in a
 922             balance of $0.
 923             /,
 924         params => [
 925             {desc => 'Authtoken', type => 'string'},
 926             {desc => 'Array of transaction IDs', type => 'array'}
 927         ],
 928         return => {
 929             desc => q/Array of IDs for each transaction updated,
 930             Event on error./
 931         }
 932     }
 933 );
 934
 935 sub _rebill_xact {
 936     my ($e, $xact) = @_;
 937
 938     my $xact_id = $xact->id;
 939     # the plan: rebill voided billings until we get a positive balance
 940     #
 941     # step 1: get the voided/adjusted billings
 942     my $billings = $e->search_money_billing([
 943         {
 944             xact => $xact_id,
 945         },
 946         {
 947             order_by => {mb => 'amount desc'},
 948             flesh => 1,
 949             flesh_fields => {mb => ['adjustments']},
 950         }
 951     ]);
 952     my @billings = grep { $U->is_true($_->voided) or @{$_->adjustments} } @$billings;
 953
 954     my $xact_balance = $xact->balance_owed;
 955     $logger->debug("rebilling for xact $xact_id with balance $xact_balance");
 956
 957     my $rebill_amount = 0;
 958     my @rebill_ids;
 959     # step 2: generate new bills just like the old ones
 960     for my $billing (@billings) {
 961         my $amount = 0;
 962         if ($U->is_true($billing->voided)) {
 963             $amount = $billing->amount;
 964         } else { # adjusted billing
 965             map { $amount = $U->fpadd($amount, $_->amount) } @{$billing->adjustments};
 966         }
 967         my $evt = $CC->create_bill(
 968             $e,
 969             $amount,
 970             $billing->btype,
 971             $billing->billing_type,
 972             $xact_id,
 973             "System: MANUAL ADJUSTMENT, BILLING #".$billing->id." REINSTATED\n(PREV: ".$billing->note.")",
 974             $billing->billing_ts()
 975         );
 976         return $evt if $evt;
 977         $rebill_amount += $billing->amount;
 978
 979         # if we have a postive (or zero) balance now, stop
 980         last if $rebill_amount >= $xact_balance;
 981     }
 982 }
 983
 984 sub _is_fully_adjusted {
 985     my ($billing) = @_;
 986
 987     my $amount_adj = 0;
 988     map { $amount_adj = $U->fpadd($amount_adj, $_->amount) } @{$billing->adjustments};
 989
 990     return $billing->amount == $amount_adj;
 991 }
 992
 993 sub adjust_bills_to_zero_manual {
 994     my ($self, $client, $auth, $xact_ids) = @_;
 995
 996     my $e = new_editor(xact => 1, authtoken => $auth);
 997     return $e->die_event unless $e->checkauth;
 998
 999     # in case a bare ID is passed
1000     $xact_ids = [$xact_ids] unless ref $xact_ids;
1001
1002     my @modified;
1003     for my $xact_id (@$xact_ids) {
1004
1005         my $xact =
1006             $e->retrieve_money_billable_transaction_summary([
1007                 $xact_id,
1008                 {flesh => 1, flesh_fields => {mbts => ['usr']}}
1009             ]) or return $e->die_event;
1010
1011         return $e->die_event unless
1012             $e->allowed('ADJUST_BILLS', $xact->usr->home_ou);
1013
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
1018             $xact =
1019                 $e->retrieve_money_billable_transaction_summary([
1020                     $xact_id,
1021                     {flesh => 1, flesh_fields => {mbts => ['usr']}}
1022                 ]) or return $e->die_event;
1023         }
1024
1025         my $billings = $e->search_money_billing([
1026             {
1027                 xact => $xact_id,
1028             },
1029             {
1030                 order_by => {mb => 'amount desc'},
1031                 flesh => 1,
1032                 flesh_fields => {mb => ['adjustments']},
1033             }
1034         ]);
1035
1036         if ($xact->balance_owed == 0) {
1037             # if was zero, or we rebilled it to zero
1038             next;
1039         } else {
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");
1043         }
1044
1045         push(@modified, $xact->id);
1046
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;
1057         }
1058     }
1059
1060     $e->commit;
1061     return \@modified;
1062 }
1063
1064
1065 __PACKAGE__->register_method(
1066     method        =>    'edit_bill_note',
1067     api_name        => 'open-ils.circ.money.billing.note.edit',
1068     signature    => q/
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
1074     /
1075 );
1076 sub edit_bill_note {
1077     my( $s, $c, $authtoken, $note, @billids ) = @_;
1078
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');
1082
1083     for my $billid (@billids) {
1084
1085         my $bill = $e->retrieve_money_billing($billid)
1086             or return $e->die_event;
1087
1088         $bill->note($note);
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.
1090
1091         $e->update_money_billing($bill) or return $e->die_event;
1092     }
1093     $e->commit;
1094     return 1;
1095 }
1096
1097
1098 __PACKAGE__->register_method(
1099     method        =>    'edit_payment_note',
1100     api_name        => 'open-ils.circ.money.payment.note.edit',
1101     signature    => q/
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
1107     /
1108 );
1109 sub edit_payment_note {
1110     my( $s, $c, $authtoken, $note, @paymentids ) = @_;
1111
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');
1115
1116     for my $paymentid (@paymentids) {
1117
1118         my $payment = $e->retrieve_money_payment($paymentid)
1119             or return $e->die_event;
1120
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.
1123
1124         $e->update_money_payment($payment) or return $e->die_event;
1125     }
1126
1127     $e->commit;
1128     return 1;
1129 }
1130
1131
1132 __PACKAGE__->register_method (
1133     method => 'fetch_mbts',
1134     authoritative => 1,
1135     api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
1136 );
1137 sub fetch_mbts {
1138     my( $self, $conn, $auth, $id) = @_;
1139
1140     my $e = new_editor(xact => 1, authtoken=>$auth);
1141     return $e->event unless $e->checkauth;
1142     my ($mbts) = $U->fetch_mbts($id, $e);
1143
1144     my $user = $e->retrieve_actor_user($mbts->usr)
1145         or return $e->die_event;
1146
1147     return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1148     $e->rollback;
1149     return $mbts
1150 }
1151
1152
1153 __PACKAGE__->register_method(
1154     method => 'desk_payments',
1155     api_name => 'open-ils.circ.money.org_unit.desk_payments'
1156 );
1157 sub 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 );
1165
1166     $_->workstation( $_->workstation->name ) for(@$data);
1167     return $data;
1168 }
1169
1170
1171 __PACKAGE__->register_method(
1172     method => 'user_payments',
1173     api_name => 'open-ils.circ.money.org_unit.user_payments'
1174 );
1175
1176 sub 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 );
1184     for(@$data) {
1185         $_->usr->card(
1186             $e->retrieve_actor_card($_->usr->card)->barcode);
1187         $_->usr->home_ou(
1188             $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1189     }
1190     return $data;
1191 }
1192
1193
1194 __PACKAGE__->register_method(
1195     method    => 'retrieve_credit_payable_balance',
1196     api_name  => 'open-ils.circ.credit.payable_balance.retrieve',
1197     authoritative => 1,
1198     signature => {
1199         desc   => q/Returns the total amount the patron can pay via credit card/,
1200         params => [
1201             { desc => 'Authentication token', type => 'string' },
1202             { desc => 'User id', type => 'number' }
1203         ],
1204         return => { desc => 'The ID of the new provider' }
1205     }
1206 );
1207
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;
1212
1213     my $user = $e->retrieve_actor_user($user_id)
1214         or return $e->event;
1215
1216     if($e->requestor->id != $user_id) {
1217         return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1218     }
1219
1220     my $circ_orgs = $e->json_query({
1221         "select" => {circ => ["circ_lib"]},
1222         from     => "circ",
1223         "where"  => {usr => $user_id, xact_finish => undef},
1224         distinct => 1
1225     });
1226
1227     my $groc_orgs = $e->json_query({
1228         "select" => {mg => ["billing_location"]},
1229         from     => "mg",
1230         "where"  => {usr => $user_id, xact_finish => undef},
1231         distinct => 1
1232     });
1233
1234     my %hash;
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);
1240     }
1241
1242     my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1243     $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1244
1245     my $xact_summaries =
1246       OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1247         'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1248
1249     my $sum = 0.0;
1250
1251     for my $xact (@$xact_summaries) {
1252
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;
1257
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;
1264         }
1265         $sum += $xact->balance_owed();
1266     }
1267
1268     return $sum;
1269 }
1270
1271
1272 1;