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_type, $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('cc_type')) { $payobj->cc_type($cc_args->{type}); }
 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         if ($payobj->has_field('expire_month')) { $payobj->expire_month($cc_args->{expire_month}); $logger->info("LFW XXX expire_month is $cc_args->{expire_month}"); }
 393         if ($payobj->has_field('expire_year')) { $payobj->expire_year($cc_args->{expire_year}); }
 394
 395         # Note: It is important not to set approval_code
 396         # on the fieldmapper object yet.
 397
 398         push(@payment_objs, $payobj);
 399
 400     } # all payment objects have been created and inserted.
 401
 402     #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED  ###
 403     $e->rollback;
 404
 405     # After we try to externally process a credit card (if desired), we'll
 406     # open a new transaction.  We cannot leave one open while credit card
 407     # processing might be happening, as it can easily time out the database
 408     # transaction.
 409
 410     my $cc_payload;
 411
 412     if($type eq 'credit_card_payment') {
 413         $approval_code = $cc_args->{approval_code};
 414         # If an approval code was not given, we'll need
 415         # to call to the payment processor ourselves.
 416         if ($cc_args->{where_process} == 1) {
 417             my $response = process_stripe_or_bop_payment(
 418                 $e, $user_id, $this_ou, $total_paid, $cc_args
 419             );
 420
 421             if ($U->event_code($response)) { # non-success (success is 0)
 422                 $logger->info(
 423                     "Credit card payment for user $user_id failed: " .
 424                     $response->{textcode} . " " .
 425                     ($response->{payload}->{error_message} ||
 426                         $response->{payload}{message})
 427                 );
 428                 return $response;
 429             } else {
 430                 # We need to save this for later in case there's a failure on
 431                 # the EG side to store the processor's result.
 432
 433                 $cc_payload = $response->{"payload"};   # also used way later
 434
 435                 {
 436                     no warnings 'uninitialized';
 437                     $cc_type = $cc_payload->{card_type};
 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->expire_month($cc_payload->{card}{exp_month});
 527             $payment->expire_year($cc_payload->{card}{exp_year});
 528             $payment->cc_number($cc_payload->{card}{last4});
 529         }
 530
 531         $payment->approval_code($approval_code) if $approval_code;
 532         $payment->cc_order_number($cc_order_number) if $cc_order_number;
 533         $payment->cc_type($cc_type) if $cc_type;
 534         $payment->cc_processor($cc_processor) if $cc_processor;
 535         $payment->cc_first_name($cc_args->{'billing_first'}) if $cc_args->{'billing_first'};
 536         $payment->cc_last_name($cc_args->{'billing_last'}) if $cc_args->{'billing_last'};
 537         if (!$e->$create_money_method($payment)) {
 538             return _recording_failure(
 539                 $e, "$create_money_method failed", $payment, $cc_payload
 540             );
 541         }
 542
 543         push(@payment_ids, $payment->id);
 544     }
 545
 546     my $evt = _update_patron_credit($e, $patron, $credit);
 547     if ($evt) {
 548         return _recording_failure(
 549             $e, "_update_patron_credit() failed", undef, $cc_payload
 550         );
 551     }
 552
 553     for my $org_id (keys %orgs) {
 554         # calculate penalties for each of the affected orgs
 555         $evt = OpenILS::Utils::Penalty->calculate_penalties(
 556             $e, $user_id, $org_id
 557         );
 558         if ($evt) {
 559             return _recording_failure(
 560                 $e, "calculate_penalties() failed", undef, $cc_payload
 561             );
 562         }
 563     }
 564
 565     # update the user to create a new last_xact_id
 566     $e->update_actor_user($patron) or return $e->die_event;
 567     $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
 568     $e->commit;
 569
 570     # update the cached user object if a user is making a payment toward
 571     # his/her own account
 572     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
 573         if $user_id == $e->requestor->id;
 574
 575     return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
 576 }
 577
 578 sub _recording_failure {
 579     my ($e, $msg, $payment, $payload) = @_;
 580
 581     if ($payload) { # If the payment processor already accepted a payment:
 582         $logger->error($msg);
 583         $logger->error("Payment processor payload: " . Dumper($payload));
 584         # payment shouldn't contain CC number
 585         $logger->error("Payment: " . Dumper($payment)) if $payment;
 586
 587         $e->rollback;
 588
 589         return new OpenILS::Event(
 590             "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
 591             "payload" => $payload
 592         );
 593     } else { # Otherwise, the problem is somewhat less severe:
 594         $logger->warn($msg);
 595         $logger->warn("Payment: " . Dumper($payment)) if $payment;
 596         return $e->die_event;
 597     }
 598 }
 599
 600 sub _update_patron_credit {
 601     my($e, $patron, $credit) = @_;
 602     return undef if $credit == 0;
 603     $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
 604     return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
 605     $e->update_actor_user($patron) or return $e->die_event;
 606     return undef;
 607 }
 608
 609
 610 __PACKAGE__->register_method(
 611     method    => "retrieve_payments",
 612     api_name    => "open-ils.circ.money.payment.retrieve.all_",
 613     notes        => "Returns a list of payments attached to a given transaction"
 614     );
 615 sub retrieve_payments {
 616     my( $self, $client, $login, $transid ) = @_;
 617
 618     my( $staff, $evt ) =
 619         $apputils->checksesperm($login, 'VIEW_TRANSACTION');
 620     return $evt if $evt;
 621
 622     # XXX the logic here is wrong.. we need to check the owner of the transaction
 623     # to make sure the requestor has access
 624
 625     # XXX grab the view, for each object in the view, grab the real object
 626
 627     return $apputils->simplereq(
 628         'open-ils.cstore',
 629         'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
 630 }
 631
 632
 633 __PACKAGE__->register_method(
 634     method    => "retrieve_payments2",
 635     authoritative => 1,
 636     api_name    => "open-ils.circ.money.payment.retrieve.all",
 637     notes        => "Returns a list of payments attached to a given transaction"
 638     );
 639
 640 sub retrieve_payments2 {
 641     my( $self, $client, $login, $transid ) = @_;
 642
 643     my $e = new_editor(authtoken=>$login);
 644     return $e->event unless $e->checkauth;
 645     return $e->event unless $e->allowed('VIEW_TRANSACTION');
 646
 647     my @payments;
 648     my $pmnts = $e->search_money_payment({ xact => $transid });
 649     for( @$pmnts ) {
 650         my $type = $_->payment_type;
 651         my $meth = "retrieve_money_$type";
 652         my $p = $e->$meth($_->id) or return $e->event;
 653         $p->payment_type($type);
 654         $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
 655             if $p->has_field('cash_drawer');
 656         push( @payments, $p );
 657     }
 658
 659     return \@payments;
 660 }
 661
 662 __PACKAGE__->register_method(
 663     method    => "format_payment_receipt",
 664     api_name  => "open-ils.circ.money.payment_receipt.print",
 665     signature => {
 666         desc   => 'Returns a printable receipt for the specified payments',
 667         params => [
 668             { desc => 'Authentication token',  type => 'string'},
 669             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 670         ],
 671         return => {
 672             desc => q/An action_trigger.event object or error event./,
 673             type => 'object',
 674         }
 675     }
 676 );
 677 __PACKAGE__->register_method(
 678     method    => "format_payment_receipt",
 679     api_name  => "open-ils.circ.money.payment_receipt.email",
 680     signature => {
 681         desc   => 'Emails a receipt for the specified payments to the user associated with the first payment',
 682         params => [
 683             { desc => 'Authentication token',  type => 'string'},
 684             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 685         ],
 686         return => {
 687             desc => q/Undefined on success, otherwise an error event./,
 688             type => 'object',
 689         }
 690     }
 691 );
 692
 693 sub format_payment_receipt {
 694     my($self, $conn, $auth, $mp_id) = @_;
 695
 696     my $mp_ids;
 697     if (ref $mp_id ne 'ARRAY') {
 698         $mp_ids = [ $mp_id ];
 699     } else {
 700         $mp_ids = $mp_id;
 701     }
 702
 703     my $for_print = ($self->api_name =~ /print/);
 704     my $for_email = ($self->api_name =~ /email/);
 705
 706     # manually use xact (i.e. authoritative) so we can kill the cstore
 707     # connection before sending the action/trigger request.  This prevents our cstore
 708     # backend from sitting idle while A/T (which uses its own transactions) runs.
 709     my $e = new_editor(xact => 1, authtoken => $auth);
 710     return $e->die_event unless $e->checkauth;
 711
 712     my $payments = [];
 713     for my $id (@$mp_ids) {
 714
 715         my $payment = $e->retrieve_money_payment([
 716             $id,
 717             {   flesh => 2,
 718                 flesh_fields => {
 719                     mp => ['xact'],
 720                     mbt => ['usr']
 721                 }
 722             }
 723         ]) or return $e->die_event;
 724
 725         return $e->die_event unless
 726             $e->requestor->id == $payment->xact->usr->id or
 727             $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou);
 728
 729         push @$payments, $payment;
 730     }
 731
 732     $e->rollback;
 733
 734     if ($for_print) {
 735
 736         return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
 737
 738     } elsif ($for_email) {
 739
 740         for my $p (@$payments) {
 741             $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
 742         }
 743     }
 744
 745     return undef;
 746 }
 747
 748 __PACKAGE__->register_method(
 749     method    => "create_grocery_bill",
 750     api_name    => "open-ils.circ.money.grocery.create",
 751     notes        => <<"    NOTE");
 752     Creates a new grocery transaction using the transaction object provided
 753     PARAMS: (login_session, money.grocery (mg) object)
 754     NOTE
 755
 756 sub create_grocery_bill {
 757     my( $self, $client, $login, $transaction ) = @_;
 758
 759     my( $staff, $evt ) = $apputils->checkses($login);
 760     return $evt if $evt;
 761     $evt = $apputils->check_perms($staff->id,
 762         $transaction->billing_location, 'CREATE_TRANSACTION' );
 763     return $evt if $evt;
 764
 765
 766     $logger->activity("Creating grocery bill " . Dumper($transaction) );
 767
 768     $transaction->clear_id;
 769     my $session = $apputils->start_db_session;
 770     $apputils->set_audit_info($session, $login, $staff->id, $staff->wsid);
 771     my $transid = $session->request(
 772         'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
 773
 774     throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
 775
 776     $logger->debug("Created new grocery transaction $transid");
 777
 778     $apputils->commit_db_session($session);
 779
 780     my $e = new_editor(xact=>1);
 781     $evt = $U->check_open_xact($e, $transid);
 782     return $evt if $evt;
 783     $e->commit;
 784
 785     return $transid;
 786 }
 787
 788
 789 __PACKAGE__->register_method(
 790     method => 'fetch_reservation',
 791     api_name => 'open-ils.circ.booking.reservation.retrieve'
 792 );
 793 sub fetch_reservation {
 794     my( $self, $conn, $auth, $id ) = @_;
 795     my $e = new_editor(authtoken=>$auth);
 796     return $e->event unless $e->checkauth;
 797     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
 798     my $g = $e->retrieve_booking_reservation($id)
 799         or return $e->event;
 800     return $g;
 801 }
 802
 803 __PACKAGE__->register_method(
 804     method   => 'fetch_grocery',
 805     api_name => 'open-ils.circ.money.grocery.retrieve'
 806 );
 807 sub fetch_grocery {
 808     my( $self, $conn, $auth, $id ) = @_;
 809     my $e = new_editor(authtoken=>$auth);
 810     return $e->event unless $e->checkauth;
 811     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
 812     my $g = $e->retrieve_money_grocery($id)
 813         or return $e->event;
 814     return $g;
 815 }
 816
 817
 818 __PACKAGE__->register_method(
 819     method        => "billing_items",
 820     api_name      => "open-ils.circ.money.billing.retrieve.all",
 821     authoritative => 1,
 822     signature     => {
 823         desc   => 'Returns a list of billing items for the given transaction ID.  ' .
 824                   'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
 825         params => [
 826             { desc => 'Authentication token', type => 'string'},
 827             { desc => 'Transaction ID',       type => 'number'}
 828         ],
 829         return => {
 830             desc => 'Transaction object, event on error'
 831         },
 832     }
 833 );
 834
 835 sub billing_items {
 836     my( $self, $client, $login, $transid ) = @_;
 837
 838     my( $trans, $evt ) = $U->fetch_billable_xact($transid);
 839     return $evt if $evt;
 840
 841     my $staff;
 842     ($staff, $evt ) = $apputils->checkses($login);
 843     return $evt if $evt;
 844
 845     if($staff->id ne $trans->usr) {
 846         $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
 847         return $evt if $evt;
 848     }
 849
 850     return $apputils->simplereq( 'open-ils.cstore',
 851         'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
 852 }
 853
 854
 855 __PACKAGE__->register_method(
 856     method   => "billing_items_create",
 857     api_name => "open-ils.circ.money.billing.create",
 858     notes    => <<"    NOTE");
 859     Creates a new billing line item
 860     PARAMS( login, bill_object (mb) )
 861     NOTE
 862
 863 sub billing_items_create {
 864     my( $self, $client, $login, $billing ) = @_;
 865
 866     my $e = new_editor(authtoken => $login, xact => 1);
 867     return $e->die_event unless $e->checkauth;
 868     return $e->die_event unless $e->allowed('CREATE_BILL');
 869
 870     my $xact = $e->retrieve_money_billable_transaction($billing->xact)
 871         or return $e->die_event;
 872
 873     # if the transaction was closed, re-open it
 874     if($xact->xact_finish) {
 875         $xact->clear_xact_finish;
 876         $e->update_money_billable_transaction($xact)
 877             or return $e->die_event;
 878     }
 879
 880     my $amt = $billing->amount;
 881     $amt =~ s/\$//og;
 882     $billing->amount($amt);
 883
 884     $e->create_money_billing($billing) or return $e->die_event;
 885     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id,$e));
 886     return $evt if $evt;
 887
 888     $evt = $U->check_open_xact($e, $xact->id, $xact);
 889     return $evt if $evt;
 890
 891     $e->commit;
 892
 893     return $billing->id;
 894 }
 895
 896
 897 __PACKAGE__->register_method(
 898     method        =>    'void_bill',
 899     api_name        => 'open-ils.circ.money.billing.void',
 900     signature    => q/
 901         Voids a bill
 902         @param authtoken Login session key
 903         @param billid Id for the bill to void.  This parameter may be repeated to reference other bills.
 904         @return 1 on success, Event on error
 905     /
 906 );
 907 sub void_bill {
 908     my( $s, $c, $authtoken, @billids ) = @_;
 909     my $editor = new_editor(authtoken=>$authtoken, xact=>1);
 910     my $rv = $CC->void_bills($editor, \@billids);
 911     if (ref($rv) eq 'HASH') {
 912         # We got an event.
 913         $editor->rollback();
 914     } else {
 915         # We should have gotten 1.
 916         $editor->commit();
 917     }
 918     return $rv;
 919 }
 920
 921
 922 __PACKAGE__->register_method(
 923     method        =>    'edit_bill_note',
 924     api_name        => 'open-ils.circ.money.billing.note.edit',
 925     signature    => q/
 926         Edits the note for a bill
 927         @param authtoken Login session key
 928         @param note The replacement note for the bills we're editing
 929         @param billid Id for the bill to edit the note of.  This parameter may be repeated to reference other bills.
 930         @return 1 on success, Event on error
 931     /
 932 );
 933 sub edit_bill_note {
 934     my( $s, $c, $authtoken, $note, @billids ) = @_;
 935
 936     my $e = new_editor( authtoken => $authtoken, xact => 1 );
 937     return $e->die_event unless $e->checkauth;
 938     return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
 939
 940     for my $billid (@billids) {
 941
 942         my $bill = $e->retrieve_money_billing($billid)
 943             or return $e->die_event;
 944
 945         $bill->note($note);
 946         # 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.
 947
 948         $e->update_money_billing($bill) or return $e->die_event;
 949     }
 950     $e->commit;
 951     return 1;
 952 }
 953
 954
 955 __PACKAGE__->register_method(
 956     method        =>    'edit_payment_note',
 957     api_name        => 'open-ils.circ.money.payment.note.edit',
 958     signature    => q/
 959         Edits the note for a payment
 960         @param authtoken Login session key
 961         @param note The replacement note for the payments we're editing
 962         @param paymentid Id for the payment to edit the note of.  This parameter may be repeated to reference other payments.
 963         @return 1 on success, Event on error
 964     /
 965 );
 966 sub edit_payment_note {
 967     my( $s, $c, $authtoken, $note, @paymentids ) = @_;
 968
 969     my $e = new_editor( authtoken => $authtoken, xact => 1 );
 970     return $e->die_event unless $e->checkauth;
 971     return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
 972
 973     for my $paymentid (@paymentids) {
 974
 975         my $payment = $e->retrieve_money_payment($paymentid)
 976             or return $e->die_event;
 977
 978         $payment->note($note);
 979         # 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.
 980
 981         $e->update_money_payment($payment) or return $e->die_event;
 982     }
 983
 984     $e->commit;
 985     return 1;
 986 }
 987
 988
 989 __PACKAGE__->register_method (
 990     method => 'fetch_mbts',
 991     authoritative => 1,
 992     api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
 993 );
 994 sub fetch_mbts {
 995     my( $self, $conn, $auth, $id) = @_;
 996
 997     my $e = new_editor(xact => 1, authtoken=>$auth);
 998     return $e->event unless $e->checkauth;
 999     my ($mbts) = $U->fetch_mbts($id, $e);
1000
1001     my $user = $e->retrieve_actor_user($mbts->usr)
1002         or return $e->die_event;
1003
1004     return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1005     $e->rollback;
1006     return $mbts
1007 }
1008
1009
1010 __PACKAGE__->register_method(
1011     method => 'desk_payments',
1012     api_name => 'open-ils.circ.money.org_unit.desk_payments'
1013 );
1014 sub desk_payments {
1015     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1016     my $e = new_editor(authtoken=>$auth);
1017     return $e->event unless $e->checkauth;
1018     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1019     my $data = $U->storagereq(
1020         'open-ils.storage.money.org_unit.desk_payments.atomic',
1021         $org, $start_date, $end_date );
1022
1023     $_->workstation( $_->workstation->name ) for(@$data);
1024     return $data;
1025 }
1026
1027
1028 __PACKAGE__->register_method(
1029     method => 'user_payments',
1030     api_name => 'open-ils.circ.money.org_unit.user_payments'
1031 );
1032
1033 sub user_payments {
1034     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1035     my $e = new_editor(authtoken=>$auth);
1036     return $e->event unless $e->checkauth;
1037     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1038     my $data = $U->storagereq(
1039         'open-ils.storage.money.org_unit.user_payments.atomic',
1040         $org, $start_date, $end_date );
1041     for(@$data) {
1042         $_->usr->card(
1043             $e->retrieve_actor_card($_->usr->card)->barcode);
1044         $_->usr->home_ou(
1045             $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1046     }
1047     return $data;
1048 }
1049
1050
1051 __PACKAGE__->register_method(
1052     method    => 'retrieve_credit_payable_balance',
1053     api_name  => 'open-ils.circ.credit.payable_balance.retrieve',
1054     authoritative => 1,
1055     signature => {
1056         desc   => q/Returns the total amount the patron can pay via credit card/,
1057         params => [
1058             { desc => 'Authentication token', type => 'string' },
1059             { desc => 'User id', type => 'number' }
1060         ],
1061         return => { desc => 'The ID of the new provider' }
1062     }
1063 );
1064
1065 sub retrieve_credit_payable_balance {
1066     my ( $self, $conn, $auth, $user_id ) = @_;
1067     my $e = new_editor(authtoken => $auth);
1068     return $e->event unless $e->checkauth;
1069
1070     my $user = $e->retrieve_actor_user($user_id)
1071         or return $e->event;
1072
1073     if($e->requestor->id != $user_id) {
1074         return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1075     }
1076
1077     my $circ_orgs = $e->json_query({
1078         "select" => {circ => ["circ_lib"]},
1079         from     => "circ",
1080         "where"  => {usr => $user_id, xact_finish => undef},
1081         distinct => 1
1082     });
1083
1084     my $groc_orgs = $e->json_query({
1085         "select" => {mg => ["billing_location"]},
1086         from     => "mg",
1087         "where"  => {usr => $user_id, xact_finish => undef},
1088         distinct => 1
1089     });
1090
1091     my %hash;
1092     for my $org ( @$circ_orgs, @$groc_orgs ) {
1093         my $o = $org->{billing_location};
1094         $o = $org->{circ_lib} unless $o;
1095         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.
1096         $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
1097     }
1098
1099     my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1100     $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1101
1102     my $xact_summaries =
1103       OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1104         'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1105
1106     my $sum = 0.0;
1107
1108     for my $xact (@$xact_summaries) {
1109
1110         # make two lists and grab them in batch XXX
1111         if ( $xact->xact_type eq 'circulation' ) {
1112             my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
1113             next unless grep { $_ == $circ->circ_lib } @credit_orgs;
1114
1115         } elsif ($xact->xact_type eq 'grocery') {
1116             my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
1117             next unless grep { $_ == $bill->billing_location } @credit_orgs;
1118         } elsif ($xact->xact_type eq 'reservation') {
1119             my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
1120             next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
1121         }
1122         $sum += $xact->balance_owed();
1123     }
1124
1125     return $sum;
1126 }
1127
1128
1129 1;