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 my $apputils = "OpenILS::Application::AppUtils";
  21 my $U = "OpenILS::Application::AppUtils";
  22
  23 use OpenSRF::EX qw(:try);
  24 use OpenILS::Perm;
  25 use Data::Dumper;
  26 use OpenILS::Event;
  27 use OpenSRF::Utils::Logger qw/:logger/;
  28 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  29 use OpenILS::Utils::Penalty;
  30 use Business::Stripe;
  31 $Data::Dumper::Indent = 0;
  32 use OpenILS::Const qw/:const/;
  33
  34 sub get_processor_settings {
  35     my $e = shift;
  36     my $org_unit = shift;
  37     my $processor = lc shift;
  38
  39     # Get the names of every credit processor setting for our given processor.
  40     # They're a little different per processor.
  41     my $setting_names = $e->json_query({
  42         select => {coust => ["name"]},
  43         from => {coust => {}},
  44         where => {name => {like => "credit.processor.${processor}.%"}}
  45     }) or return $e->die_event;
  46
  47     # Make keys for a hash we're going to build out of the last dot-delimited
  48     # component of each setting name.
  49     ($_->{key} = $_->{name}) =~ s/.+\.(\w+)$/$1/ for @$setting_names;
  50
  51     # Return a hash with those short keys, and for values the value of
  52     # the corresponding OU setting within our scope.
  53     return {
  54         map {
  55             $_->{key} => $U->ou_ancestor_setting_value($org_unit, $_->{name})
  56         } @$setting_names
  57     };
  58 }
  59
  60 # process_stripe_or_bop_payment()
  61 # This is a helper method to make_payments() below (specifically,
  62 # the credit-card part). It's the first point in the Perl code where
  63 # we need to care about the distinction between Stripe and the
  64 # Paypal/PayflowPro/AuthorizeNet kinds of processors (the latter group
  65 # uses B::OP and handles payment card info, whereas Stripe doesn't use
  66 # B::OP and doesn't require us to know anything about the payment card
  67 # info).
  68 #
  69 # Return an event in all cases.  That means a success returns a SUCCESS
  70 # event.
  71 sub process_stripe_or_bop_payment {
  72     my ($e, $user_id, $this_ou, $total_paid, $cc_args) = @_;
  73
  74     # A few stanzas to determine which processor we're using and whether we're
  75     # really adequately set up for it.
  76     if (!$cc_args->{processor}) {
  77         if (!($cc_args->{processor} =
  78                 $U->ou_ancestor_setting_value(
  79                     $this_ou, 'credit.processor.default'
  80                 )
  81             )
  82         ) {
  83             return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
  84         }
  85     }
  86
  87     # Make sure the configured credit processor has a safe/correct name.
  88     return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED')
  89         unless $cc_args->{processor} =~ /^[a-z0-9_\-]+$/i;
  90
  91     # Get the settings for the processor and make sure they're serviceable.
  92     my $psettings = get_processor_settings($e, $this_ou, $cc_args->{processor});
  93     return $psettings if defined $U->event_code($psettings);
  94     return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED')
  95         unless $psettings->{enabled};
  96
  97     # Now we branch. Stripe is one thing, and everything else is another.
  98
  99     if ($cc_args->{processor} eq 'Stripe') { # Stripe
 100         my $stripe = Business::Stripe->new(-api_key => $psettings->{secretkey});
 101         $stripe->charges_create(
 102             amount => int($total_paid * 100.0), # Stripe takes amount in pennies
 103             card => $cc_args->{stripe_token},
 104             description => $cc_args->{note}
 105         );
 106
 107         if ($stripe->success) {
 108             $logger->info("Stripe payment succeeded");
 109             return OpenILS::Event->new(
 110                 "SUCCESS", payload => {
 111                     map { $_ => $stripe->success->{$_} } qw(
 112                         invoice customer balance_transaction id created card
 113                     )
 114                 }
 115             );
 116         } else {
 117             $logger->info("Stripe payment failed");
 118             return OpenILS::Event->new(
 119                 "CREDIT_PROCESSOR_DECLINED_TRANSACTION",
 120                 payload => $stripe->error  # XXX what happens if this contains
 121                                            # JSON::backportPP::* objects?
 122             );
 123         }
 124
 125     } else { # B::OP style (Paypal/PayflowPro/AuthorizeNet)
 126         return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number')
 127             unless $cc_args->{number};
 128
 129         return OpenILS::Application::Circ::CreditCard::process_payment({
 130             "processor" => $cc_args->{processor},
 131             "desc" => $cc_args->{note},
 132             "amount" => $total_paid,
 133             "patron_id" => $user_id,
 134             "cc" => $cc_args->{number},
 135             "expiration" => sprintf(
 136                 "%02d-%04d",
 137                 $cc_args->{expire_month},
 138                 $cc_args->{expire_year}
 139             ),
 140             "ou" => $this_ou,
 141             "first_name" => $cc_args->{billing_first},
 142             "last_name" => $cc_args->{billing_last},
 143             "address" => $cc_args->{billing_address},
 144             "city" => $cc_args->{billing_city},
 145             "state" => $cc_args->{billing_state},
 146             "zip" => $cc_args->{billing_zip},
 147             "cvv2" => $cc_args->{cvv2},
 148             %$psettings
 149         });
 150
 151     }
 152 }
 153
 154 __PACKAGE__->register_method(
 155     method => "make_payments",
 156     api_name => "open-ils.circ.money.payment",
 157     signature => {
 158         desc => q/Create payments for a given user and set of transactions,
 159             login must have CREATE_PAYMENT privileges.
 160             If any payments fail, all are reverted back./,
 161         params => [
 162             {desc => 'Authtoken', type => 'string'},
 163             {desc => q/Arguments Hash, supporting the following params:
 164                 {
 165                     payment_type
 166                     userid
 167                     patron_credit
 168                     note
 169                     cc_args: {
 170                         where_process   1 to use processor, !1 for out-of-band
 171                         approval_code   (for out-of-band payment)
 172                         type            (for out-of-band payment)
 173                         number          (for call to payment processor)
 174                         stripe_token    (for call to Stripe payment processor)
 175                         expire_month    (for call to payment processor)
 176                         expire_year     (for call to payment processor)
 177                         billing_first   (for out-of-band payments and for call to payment processor)
 178                         billing_last    (for out-of-band payments and for call to payment processor)
 179                         billing_address (for call to payment processor)
 180                         billing_city    (for call to payment processor)
 181                         billing_state   (for call to payment processor)
 182                         billing_zip     (for call to payment processor)
 183                         note            (if payments->{note} is blank, use this)
 184                     },
 185                     check_number
 186                     payments: [
 187                         [trans_id, amt],
 188                         [...]
 189                     ],
 190                 }/, type => 'hash'
 191             },
 192             {
 193                 desc => q/Last user transaction ID.  This is the actor.usr.last_xact_id value/,
 194                 type => 'string'
 195             }
 196         ],
 197         "return" => {
 198             "desc" =>
 199                 q{Array of payment IDs on success, event on failure.  Event possibilities include:
 200                 BAD_PARAMS
 201                     Bad parameters were given to this API method itself.
 202                     See note field.
 203                 INVALID_USER_XACT_ID
 204                     The last user transaction ID does not match the ID in the database.  This means
 205                     the user object has been updated since the last retrieval.  The client should
 206                     be instructed to reload the user object and related transactions before attempting
 207                     another payment
 208                 REFUND_EXCEEDS_BALANCE
 209                 REFUND_EXCEEDS_DESK_PAYMENTS
 210                 CREDIT_PROCESSOR_NOT_SPECIFIED
 211                     Evergreen has not been set up to process CC payments.
 212                 CREDIT_PROCESSOR_NOT_ALLOWED
 213                     Evergreen has been incorrectly setup for CC payments.
 214                 CREDIT_PROCESSOR_NOT_ENABLED
 215                     Evergreen has been set up for CC payments, but an admin
 216                     has not explicitly enabled them.
 217                 CREDIT_PROCESSOR_BAD_PARAMS
 218                     Evergreen has been incorrectly setup for CC payments;
 219                     specifically, the login and/or password for the CC
 220                     processor weren't provided.
 221                 CREDIT_PROCESSOR_INVALID_CC_NUMBER
 222                     You have supplied a credit card number that Evergreen
 223                     has judged to be invalid even before attempting to contact
 224                     the payment processor.
 225                 CREDIT_PROCESSOR_DECLINED_TRANSACTION
 226                     We contacted the CC processor to attempt the charge, but
 227                     they declined it.
 228                         The error_message field of the event payload will
 229                         contain the payment processor's response.  This
 230                         typically includes a message in plain English intended
 231                         for human consumption.  In PayPal's case, the message
 232                         is preceded by an integer, a colon, and a space, so
 233                         a caller might take the 2nd match from /^(\d+: )?(.+)$/
 234                         to present to the user.
 235                         The payload also contains other fields from the payment
 236                         processor, but these are generally not user-friendly
 237                         strings.
 238                 CREDIT_PROCESSOR_SUCCESS_WO_RECORD
 239                     A payment was processed successfully, but couldn't be
 240                     recorded in Evergreen.  This is _bad bad bad_, as it means
 241                     somebody made a payment but isn't getting credit for it.
 242                     See errors in the system log if this happens.  Info from
 243                     the credit card transaction will also be available in the
 244                     event payload, although this probably won't be suitable for
 245                     staff client/OPAC display.
 246 },
 247             "type" => "number"
 248         }
 249     }
 250 );
 251 sub make_payments {
 252     my($self, $client, $auth, $payments, $last_xact_id) = @_;
 253
 254     my $e = new_editor(authtoken => $auth, xact => 1);
 255     return $e->die_event unless $e->checkauth;
 256
 257     my $type = $payments->{payment_type};
 258     my $user_id = $payments->{userid};
 259     my $credit = $payments->{patron_credit} || 0;
 260     my $drawer = $e->requestor->wsid;
 261     my $note = $payments->{note};
 262     my $cc_args = $payments->{cc_args};
 263     my $check_number = $payments->{check_number};
 264     my $total_paid = 0;
 265     my $this_ou = $e->requestor->ws_ou || $e->requestor->home_ou;
 266     my %orgs;
 267
 268
 269     # unless/until determined by payment processor API
 270     my ($approval_code, $cc_processor, $cc_type, $cc_order_number) = (undef,undef,undef, undef);
 271
 272     my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event;
 273
 274     if($patron->last_xact_id ne $last_xact_id) {
 275         $e->rollback;
 276         return OpenILS::Event->new('INVALID_USER_XACT_ID');
 277     }
 278
 279     # A user is allowed to make credit card payments on his/her own behalf
 280     # All other scenarious require permission
 281     unless($type eq 'credit_card_payment' and $user_id == $e->requestor->id) {
 282         return $e->die_event unless $e->allowed('CREATE_PAYMENT', $patron->home_ou);
 283     }
 284
 285     # first collect the transactions and make sure the transaction
 286     # user matches the requested user
 287     my %xacts;
 288
 289     # We rewrite the payments array for sanity's sake, to avoid more
 290     # than one payment per transaction per call, which is not legitimate
 291     # but has been seen in the wild coming from the staff client.  This
 292     # is presumably a staff client (xulrunner) bug.
 293     my @unique_xact_payments;
 294     for my $pay (@{$payments->{payments}}) {
 295         my $xact_id = $pay->[0];
 296         if (exists($xacts{$xact_id})) {
 297             $e->rollback;
 298             return OpenILS::Event->new('MULTIPLE_PAYMENTS_FOR_XACT');
 299         }
 300
 301         my $xact = $e->retrieve_money_billable_transaction_summary($xact_id)
 302             or return $e->die_event;
 303
 304         if($xact->usr != $user_id) {
 305             $e->rollback;
 306             return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/);
 307         }
 308
 309         $xacts{$xact_id} = $xact;
 310         push @unique_xact_payments, $pay;
 311     }
 312     $payments->{payments} = \@unique_xact_payments;
 313
 314     my @payment_objs;
 315
 316     for my $pay (@{$payments->{payments}}) {
 317         my $transid = $pay->[0];
 318         my $amount = $pay->[1];
 319         $amount =~ s/\$//og; # just to be safe
 320         my $trans = $xacts{$transid};
 321
 322         $total_paid += $amount;
 323
 324         my $org_id = $U->xact_org($transid, $e);
 325
 326         if (!$orgs{$org_id}) {
 327             $orgs{$org_id} = 1;
 328
 329             # patron credit has to be allowed at all orgs receiving payment
 330             if ($type eq 'credit_payment' and $U->ou_ancestor_setting_value(
 331                     $org_id, 'circ.disable_patron_credit', $e)) {
 332                 $e->rollback;
 333                 return OpenILS::Event->new('PATRON_CREDIT_DISABLED');
 334             }
 335         }
 336
 337         # A negative payment is a refund.
 338         if( $amount < 0 ) {
 339
 340             # Negative credit card payments are not allowed
 341             if($type eq 'credit_card_payment') {
 342                 $e->rollback;
 343                 return OpenILS::Event->new(
 344                     'BAD_PARAMS',
 345                     note => q/Negative credit card payments not allowed/
 346                 );
 347             }
 348
 349             # If the refund causes the transaction balance to exceed 0 dollars,
 350             # we are in effect loaning the patron money.  This is not allowed.
 351             if( ($trans->balance_owed - $amount) > 0 ) {
 352                 $e->rollback;
 353                 return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
 354             }
 355
 356             # Otherwise, make sure the refund does not exceed desk payments
 357             # This is also not allowed
 358             my $desk_total = 0;
 359             my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
 360             $desk_total += $_->amount for @$desk_payments;
 361
 362             if( (-$amount) > $desk_total ) {
 363                 $e->rollback;
 364                 return OpenILS::Event->new(
 365                     'REFUND_EXCEEDS_DESK_PAYMENTS',
 366                     payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
 367             }
 368         }
 369
 370         my $payobj = "Fieldmapper::money::$type";
 371         $payobj = $payobj->new;
 372
 373         $payobj->amount($amount);
 374         $payobj->amount_collected($amount);
 375         $payobj->xact($transid);
 376         $payobj->note($note);
 377         if ((not $payobj->note) and ($type eq 'credit_card_payment')) {
 378             $payobj->note($cc_args->{note});
 379         }
 380
 381         if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); }
 382         if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); }
 383         if ($payobj->has_field('cc_type')) { $payobj->cc_type($cc_args->{type}); }
 384         if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); }
 385
 386         # Store the last 4 digits of the CC number
 387         if ($payobj->has_field('cc_number')) {
 388             $payobj->cc_number(substr($cc_args->{number}, -4));
 389         }
 390         if ($payobj->has_field('expire_month')) { $payobj->expire_month($cc_args->{expire_month}); $logger->info("LFW XXX expire_month is $cc_args->{expire_month}"); }
 391         if ($payobj->has_field('expire_year')) { $payobj->expire_year($cc_args->{expire_year}); }
 392
 393         # Note: It is important not to set approval_code
 394         # on the fieldmapper object yet.
 395
 396         push(@payment_objs, $payobj);
 397
 398     } # all payment objects have been created and inserted.
 399
 400     #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED  ###
 401     $e->rollback;
 402
 403     # After we try to externally process a credit card (if desired), we'll
 404     # open a new transaction.  We cannot leave one open while credit card
 405     # processing might be happening, as it can easily time out the database
 406     # transaction.
 407
 408     my $cc_payload;
 409
 410     if($type eq 'credit_card_payment') {
 411         $approval_code = $cc_args->{approval_code};
 412         # If an approval code was not given, we'll need
 413         # to call to the payment processor ourselves.
 414         if ($cc_args->{where_process} == 1) {
 415             my $response = process_stripe_or_bop_payment(
 416                 $e, $user_id, $this_ou, $total_paid, $cc_args
 417             );
 418
 419             if ($U->event_code($response)) { # non-success (success is 0)
 420                 $logger->info(
 421                     "Credit card payment for user $user_id failed: " .
 422                     $response->{textcode} . " " .
 423                     ($response->{payload}->{error_message} ||
 424                         $response->{payload}{message})
 425                 );
 426                 return $response;
 427             } else {
 428                 # We need to save this for later in case there's a failure on
 429                 # the EG side to store the processor's result.
 430
 431                 $cc_payload = $response->{"payload"};   # also used way later
 432
 433                 {
 434                     no warnings 'uninitialized';
 435                     $cc_type = $cc_payload->{card_type};
 436                     $approval_code = $cc_payload->{authorization} ||
 437                         $cc_payload->{id};
 438                     $cc_processor = $cc_payload->{processor} ||
 439                         $cc_args->{processor};
 440                     $cc_order_number = $cc_payload->{order_number} ||
 441                         $cc_payload->{invoice};
 442                 };
 443                 $logger->info("Credit card payment for user $user_id succeeded");
 444             }
 445         } else {
 446             return OpenILS::Event->new(
 447                 'BAD_PARAMS', note => 'Need approval code'
 448             ) if not $cc_args->{approval_code};
 449         }
 450     }
 451
 452     ### RE-OPEN TRANSACTION HERE ###
 453     $e->xact_begin;
 454     my @payment_ids;
 455
 456     # create payment records
 457     my $create_money_method = "create_money_" . $type;
 458     for my $payment (@payment_objs) {
 459         # update the transaction if it's done
 460         my $amount = $payment->amount;
 461         my $transid = $payment->xact;
 462         my $trans = $xacts{$transid};
 463         # making payment with existing patron credit.
 464         $credit -= $amount if $type eq 'credit_payment';
 465         if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) {
 466             # Any overpay on this transaction goes directly into patron
 467             # credit
 468             $cred = -$cred;
 469             $credit += $cred;
 470             my $circ = $e->retrieve_action_circulation(
 471                 [
 472                     $transid,
 473                     {
 474                         flesh => 1,
 475                         flesh_fields => {circ => ['target_copy','billings']}
 476                     }
 477                 ]
 478             ); # Flesh the copy, so we can monkey with the status if
 479                # necessary.
 480
 481             # Whether or not we close the transaction. We definitely
 482             # close if no circulation transaction is present,
 483             # otherwise we check if the circulation is in a state that
 484             # allows itself to be closed.
 485             if (!$circ || OpenILS::Application::Circ::CircCommon->can_close_circ($e, $circ)) {
 486                 $trans = $e->retrieve_money_billable_transaction($transid);
 487                 $trans->xact_finish("now");
 488                 if (!$e->update_money_billable_transaction($trans)) {
 489                     return _recording_failure(
 490                         $e, "update_money_billable_transaction() failed",
 491                         $payment, $cc_payload
 492                     )
 493                 }
 494
 495                 # If we have a circ, we need to check if the copy
 496                 # status is lost or long overdue.  If it is then we
 497                 # check org_unit_settings for the copy owning library
 498                 # and adjust and possibly adjust copy status to lost
 499                 # and paid.
 500                 if ($circ) {
 501                     # We need the copy to check settings and to possibly
 502                     # change its status.
 503                     my $copy = $circ->target_copy();
 504                     # Library where we'll check settings.
 505                     my $check_lib = $copy->circ_lib();
 506
 507                     # check the copy status
 508                     if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
 509                             && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
 510                         $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
 511                         if (!$e->update_asset_copy($copy)) {
 512                             return _recording_failure(
 513                                 $e, "update_asset_copy_failed()",
 514                                 $payment, $cc_payload
 515                             )
 516                         }
 517                     }
 518                 }
 519             }
 520         }
 521
 522         # Urgh, clean up this mega-function one day.
 523         if ($cc_processor eq 'Stripe' and $approval_code and $cc_payload) {
 524             $payment->expire_month($cc_payload->{card}{exp_month});
 525             $payment->expire_year($cc_payload->{card}{exp_year});
 526             $payment->cc_number($cc_payload->{card}{last4});
 527         }
 528
 529         $payment->approval_code($approval_code) if $approval_code;
 530         $payment->cc_order_number($cc_order_number) if $cc_order_number;
 531         $payment->cc_type($cc_type) if $cc_type;
 532         $payment->cc_processor($cc_processor) if $cc_processor;
 533         $payment->cc_first_name($cc_args->{'billing_first'}) if $cc_args->{'billing_first'};
 534         $payment->cc_last_name($cc_args->{'billing_last'}) if $cc_args->{'billing_last'};
 535         if (!$e->$create_money_method($payment)) {
 536             return _recording_failure(
 537                 $e, "$create_money_method failed", $payment, $cc_payload
 538             );
 539         }
 540
 541         push(@payment_ids, $payment->id);
 542     }
 543
 544     my $evt = _update_patron_credit($e, $patron, $credit);
 545     if ($evt) {
 546         return _recording_failure(
 547             $e, "_update_patron_credit() failed", undef, $cc_payload
 548         );
 549     }
 550
 551     for my $org_id (keys %orgs) {
 552         # calculate penalties for each of the affected orgs
 553         $evt = OpenILS::Utils::Penalty->calculate_penalties(
 554             $e, $user_id, $org_id
 555         );
 556         if ($evt) {
 557             return _recording_failure(
 558                 $e, "calculate_penalties() failed", undef, $cc_payload
 559             );
 560         }
 561     }
 562
 563     # update the user to create a new last_xact_id
 564     $e->update_actor_user($patron) or return $e->die_event;
 565     $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
 566     $e->commit;
 567
 568     # update the cached user object if a user is making a payment toward
 569     # his/her own account
 570     $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
 571         if $user_id == $e->requestor->id;
 572
 573     return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
 574 }
 575
 576 sub _recording_failure {
 577     my ($e, $msg, $payment, $payload) = @_;
 578
 579     if ($payload) { # If the payment processor already accepted a payment:
 580         $logger->error($msg);
 581         $logger->error("Payment processor payload: " . Dumper($payload));
 582         # payment shouldn't contain CC number
 583         $logger->error("Payment: " . Dumper($payment)) if $payment;
 584
 585         $e->rollback;
 586
 587         return new OpenILS::Event(
 588             "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
 589             "payload" => $payload
 590         );
 591     } else { # Otherwise, the problem is somewhat less severe:
 592         $logger->warn($msg);
 593         $logger->warn("Payment: " . Dumper($payment)) if $payment;
 594         return $e->die_event;
 595     }
 596 }
 597
 598 sub _update_patron_credit {
 599     my($e, $patron, $credit) = @_;
 600     return undef if $credit == 0;
 601     $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
 602     return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
 603     $e->update_actor_user($patron) or return $e->die_event;
 604     return undef;
 605 }
 606
 607
 608 __PACKAGE__->register_method(
 609     method    => "retrieve_payments",
 610     api_name    => "open-ils.circ.money.payment.retrieve.all_",
 611     notes        => "Returns a list of payments attached to a given transaction"
 612     );
 613 sub retrieve_payments {
 614     my( $self, $client, $login, $transid ) = @_;
 615
 616     my( $staff, $evt ) =
 617         $apputils->checksesperm($login, 'VIEW_TRANSACTION');
 618     return $evt if $evt;
 619
 620     # XXX the logic here is wrong.. we need to check the owner of the transaction
 621     # to make sure the requestor has access
 622
 623     # XXX grab the view, for each object in the view, grab the real object
 624
 625     return $apputils->simplereq(
 626         'open-ils.cstore',
 627         'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
 628 }
 629
 630
 631 __PACKAGE__->register_method(
 632     method    => "retrieve_payments2",
 633     authoritative => 1,
 634     api_name    => "open-ils.circ.money.payment.retrieve.all",
 635     notes        => "Returns a list of payments attached to a given transaction"
 636     );
 637
 638 sub retrieve_payments2 {
 639     my( $self, $client, $login, $transid ) = @_;
 640
 641     my $e = new_editor(authtoken=>$login);
 642     return $e->event unless $e->checkauth;
 643     return $e->event unless $e->allowed('VIEW_TRANSACTION');
 644
 645     my @payments;
 646     my $pmnts = $e->search_money_payment({ xact => $transid });
 647     for( @$pmnts ) {
 648         my $type = $_->payment_type;
 649         my $meth = "retrieve_money_$type";
 650         my $p = $e->$meth($_->id) or return $e->event;
 651         $p->payment_type($type);
 652         $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
 653             if $p->has_field('cash_drawer');
 654         push( @payments, $p );
 655     }
 656
 657     return \@payments;
 658 }
 659
 660 __PACKAGE__->register_method(
 661     method    => "format_payment_receipt",
 662     api_name  => "open-ils.circ.money.payment_receipt.print",
 663     signature => {
 664         desc   => 'Returns a printable receipt for the specified payments',
 665         params => [
 666             { desc => 'Authentication token',  type => 'string'},
 667             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 668         ],
 669         return => {
 670             desc => q/An action_trigger.event object or error event./,
 671             type => 'object',
 672         }
 673     }
 674 );
 675 __PACKAGE__->register_method(
 676     method    => "format_payment_receipt",
 677     api_name  => "open-ils.circ.money.payment_receipt.email",
 678     signature => {
 679         desc   => 'Emails a receipt for the specified payments to the user associated with the first payment',
 680         params => [
 681             { desc => 'Authentication token',  type => 'string'},
 682             { desc => 'Payment ID or array of payment IDs', type => 'number' },
 683         ],
 684         return => {
 685             desc => q/Undefined on success, otherwise an error event./,
 686             type => 'object',
 687         }
 688     }
 689 );
 690
 691 sub format_payment_receipt {
 692     my($self, $conn, $auth, $mp_id) = @_;
 693
 694     my $mp_ids;
 695     if (ref $mp_id ne 'ARRAY') {
 696         $mp_ids = [ $mp_id ];
 697     } else {
 698         $mp_ids = $mp_id;
 699     }
 700
 701     my $for_print = ($self->api_name =~ /print/);
 702     my $for_email = ($self->api_name =~ /email/);
 703
 704     # manually use xact (i.e. authoritative) so we can kill the cstore
 705     # connection before sending the action/trigger request.  This prevents our cstore
 706     # backend from sitting idle while A/T (which uses its own transactions) runs.
 707     my $e = new_editor(xact => 1, authtoken => $auth);
 708     return $e->die_event unless $e->checkauth;
 709
 710     my $payments = [];
 711     for my $id (@$mp_ids) {
 712
 713         my $payment = $e->retrieve_money_payment([
 714             $id,
 715             {   flesh => 2,
 716                 flesh_fields => {
 717                     mp => ['xact'],
 718                     mbt => ['usr']
 719                 }
 720             }
 721         ]) or return $e->die_event;
 722
 723         return $e->die_event unless
 724             $e->requestor->id == $payment->xact->usr->id or
 725             $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou);
 726
 727         push @$payments, $payment;
 728     }
 729
 730     $e->rollback;
 731
 732     if ($for_print) {
 733
 734         return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
 735
 736     } elsif ($for_email) {
 737
 738         for my $p (@$payments) {
 739             $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
 740         }
 741     }
 742
 743     return undef;
 744 }
 745
 746 __PACKAGE__->register_method(
 747     method    => "create_grocery_bill",
 748     api_name    => "open-ils.circ.money.grocery.create",
 749     notes        => <<"    NOTE");
 750     Creates a new grocery transaction using the transaction object provided
 751     PARAMS: (login_session, money.grocery (mg) object)
 752     NOTE
 753
 754 sub create_grocery_bill {
 755     my( $self, $client, $login, $transaction ) = @_;
 756
 757     my( $staff, $evt ) = $apputils->checkses($login);
 758     return $evt if $evt;
 759     $evt = $apputils->check_perms($staff->id,
 760         $transaction->billing_location, 'CREATE_TRANSACTION' );
 761     return $evt if $evt;
 762
 763
 764     $logger->activity("Creating grocery bill " . Dumper($transaction) );
 765
 766     $transaction->clear_id;
 767     my $session = $apputils->start_db_session;
 768     $apputils->set_audit_info($session, $login, $staff->id, $staff->wsid);
 769     my $transid = $session->request(
 770         'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
 771
 772     throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
 773
 774     $logger->debug("Created new grocery transaction $transid");
 775
 776     $apputils->commit_db_session($session);
 777
 778     my $e = new_editor(xact=>1);
 779     $evt = $U->check_open_xact($e, $transid);
 780     return $evt if $evt;
 781     $e->commit;
 782
 783     return $transid;
 784 }
 785
 786
 787 __PACKAGE__->register_method(
 788     method => 'fetch_reservation',
 789     api_name => 'open-ils.circ.booking.reservation.retrieve'
 790 );
 791 sub fetch_reservation {
 792     my( $self, $conn, $auth, $id ) = @_;
 793     my $e = new_editor(authtoken=>$auth);
 794     return $e->event unless $e->checkauth;
 795     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
 796     my $g = $e->retrieve_booking_reservation($id)
 797         or return $e->event;
 798     return $g;
 799 }
 800
 801 __PACKAGE__->register_method(
 802     method   => 'fetch_grocery',
 803     api_name => 'open-ils.circ.money.grocery.retrieve'
 804 );
 805 sub fetch_grocery {
 806     my( $self, $conn, $auth, $id ) = @_;
 807     my $e = new_editor(authtoken=>$auth);
 808     return $e->event unless $e->checkauth;
 809     return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
 810     my $g = $e->retrieve_money_grocery($id)
 811         or return $e->event;
 812     return $g;
 813 }
 814
 815
 816 __PACKAGE__->register_method(
 817     method        => "billing_items",
 818     api_name      => "open-ils.circ.money.billing.retrieve.all",
 819     authoritative => 1,
 820     signature     => {
 821         desc   => 'Returns a list of billing items for the given transaction ID.  ' .
 822                   'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
 823         params => [
 824             { desc => 'Authentication token', type => 'string'},
 825             { desc => 'Transaction ID',       type => 'number'}
 826         ],
 827         return => {
 828             desc => 'Transaction object, event on error'
 829         },
 830     }
 831 );
 832
 833 sub billing_items {
 834     my( $self, $client, $login, $transid ) = @_;
 835
 836     my( $trans, $evt ) = $U->fetch_billable_xact($transid);
 837     return $evt if $evt;
 838
 839     my $staff;
 840     ($staff, $evt ) = $apputils->checkses($login);
 841     return $evt if $evt;
 842
 843     if($staff->id ne $trans->usr) {
 844         $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
 845         return $evt if $evt;
 846     }
 847
 848     return $apputils->simplereq( 'open-ils.cstore',
 849         'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
 850 }
 851
 852
 853 __PACKAGE__->register_method(
 854     method   => "billing_items_create",
 855     api_name => "open-ils.circ.money.billing.create",
 856     notes    => <<"    NOTE");
 857     Creates a new billing line item
 858     PARAMS( login, bill_object (mb) )
 859     NOTE
 860
 861 sub billing_items_create {
 862     my( $self, $client, $login, $billing ) = @_;
 863
 864     my $e = new_editor(authtoken => $login, xact => 1);
 865     return $e->die_event unless $e->checkauth;
 866     return $e->die_event unless $e->allowed('CREATE_BILL');
 867
 868     my $xact = $e->retrieve_money_billable_transaction($billing->xact)
 869         or return $e->die_event;
 870
 871     # if the transaction was closed, re-open it
 872     if($xact->xact_finish) {
 873         $xact->clear_xact_finish;
 874         $e->update_money_billable_transaction($xact)
 875             or return $e->die_event;
 876     }
 877
 878     my $amt = $billing->amount;
 879     $amt =~ s/\$//og;
 880     $billing->amount($amt);
 881
 882     $e->create_money_billing($billing) or return $e->die_event;
 883     my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id,$e));
 884     return $evt if $evt;
 885
 886     $evt = $U->check_open_xact($e, $xact->id, $xact);
 887     return $evt if $evt;
 888
 889     $e->commit;
 890
 891     return $billing->id;
 892 }
 893
 894
 895 __PACKAGE__->register_method(
 896     method        =>    'void_bill',
 897     api_name        => 'open-ils.circ.money.billing.void',
 898     signature    => q/
 899         Voids a bill
 900         @param authtoken Login session key
 901         @param billid Id for the bill to void.  This parameter may be repeated to reference other bills.
 902         @return 1 on success, Event on error
 903     /
 904 );
 905 sub void_bill {
 906     my( $s, $c, $authtoken, @billids ) = @_;
 907
 908     my $e = new_editor( authtoken => $authtoken, xact => 1 );
 909     return $e->die_event unless $e->checkauth;
 910     return $e->die_event unless $e->allowed('VOID_BILLING');
 911
 912     my %users;
 913     for my $billid (@billids) {
 914
 915         my $bill = $e->retrieve_money_billing($billid)
 916             or return $e->die_event;
 917
 918         my $xact = $e->retrieve_money_billable_transaction($bill->xact)
 919             or return $e->die_event;
 920
 921         if($U->is_true($bill->voided)) {
 922             $e->rollback;
 923             return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
 924         }
 925
 926         my $org = $U->xact_org($bill->xact, $e);
 927         $users{$xact->usr} = {} unless $users{$xact->usr};
 928         $users{$xact->usr}->{$org} = 1;
 929
 930         $bill->voided('t');
 931         $bill->voider($e->requestor->id);
 932         $bill->void_time('now');
 933
 934         $e->update_money_billing($bill) or return $e->die_event;
 935         my $evt = $U->check_open_xact($e, $bill->xact, $xact);
 936         return $evt if $evt;
 937     }
 938
 939     # calculate penalties for all user/org combinations
 940     for my $user_id (keys %users) {
 941         for my $org_id (keys %{$users{$user_id}}) {
 942             OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
 943         }
 944     }
 945     $e->commit;
 946     return 1;
 947 }
 948
 949
 950 __PACKAGE__->register_method(
 951     method        =>    'edit_bill_note',
 952     api_name        => 'open-ils.circ.money.billing.note.edit',
 953     signature    => q/
 954         Edits the note for a bill
 955         @param authtoken Login session key
 956         @param note The replacement note for the bills we're editing
 957         @param billid Id for the bill to edit the note of.  This parameter may be repeated to reference other bills.
 958         @return 1 on success, Event on error
 959     /
 960 );
 961 sub edit_bill_note {
 962     my( $s, $c, $authtoken, $note, @billids ) = @_;
 963
 964     my $e = new_editor( authtoken => $authtoken, xact => 1 );
 965     return $e->die_event unless $e->checkauth;
 966     return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
 967
 968     for my $billid (@billids) {
 969
 970         my $bill = $e->retrieve_money_billing($billid)
 971             or return $e->die_event;
 972
 973         $bill->note($note);
 974         # 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.
 975
 976         $e->update_money_billing($bill) or return $e->die_event;
 977     }
 978     $e->commit;
 979     return 1;
 980 }
 981
 982
 983 __PACKAGE__->register_method(
 984     method        =>    'edit_payment_note',
 985     api_name        => 'open-ils.circ.money.payment.note.edit',
 986     signature    => q/
 987         Edits the note for a payment
 988         @param authtoken Login session key
 989         @param note The replacement note for the payments we're editing
 990         @param paymentid Id for the payment to edit the note of.  This parameter may be repeated to reference other payments.
 991         @return 1 on success, Event on error
 992     /
 993 );
 994 sub edit_payment_note {
 995     my( $s, $c, $authtoken, $note, @paymentids ) = @_;
 996
 997     my $e = new_editor( authtoken => $authtoken, xact => 1 );
 998     return $e->die_event unless $e->checkauth;
 999     return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
1000
1001     for my $paymentid (@paymentids) {
1002
1003         my $payment = $e->retrieve_money_payment($paymentid)
1004             or return $e->die_event;
1005
1006         $payment->note($note);
1007         # 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.
1008
1009         $e->update_money_payment($payment) or return $e->die_event;
1010     }
1011
1012     $e->commit;
1013     return 1;
1014 }
1015
1016
1017 __PACKAGE__->register_method (
1018     method => 'fetch_mbts',
1019     authoritative => 1,
1020     api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
1021 );
1022 sub fetch_mbts {
1023     my( $self, $conn, $auth, $id) = @_;
1024
1025     my $e = new_editor(xact => 1, authtoken=>$auth);
1026     return $e->event unless $e->checkauth;
1027     my ($mbts) = $U->fetch_mbts($id, $e);
1028
1029     my $user = $e->retrieve_actor_user($mbts->usr)
1030         or return $e->die_event;
1031
1032     return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
1033     $e->rollback;
1034     return $mbts
1035 }
1036
1037
1038 __PACKAGE__->register_method(
1039     method => 'desk_payments',
1040     api_name => 'open-ils.circ.money.org_unit.desk_payments'
1041 );
1042 sub desk_payments {
1043     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1044     my $e = new_editor(authtoken=>$auth);
1045     return $e->event unless $e->checkauth;
1046     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1047     my $data = $U->storagereq(
1048         'open-ils.storage.money.org_unit.desk_payments.atomic',
1049         $org, $start_date, $end_date );
1050
1051     $_->workstation( $_->workstation->name ) for(@$data);
1052     return $data;
1053 }
1054
1055
1056 __PACKAGE__->register_method(
1057     method => 'user_payments',
1058     api_name => 'open-ils.circ.money.org_unit.user_payments'
1059 );
1060
1061 sub user_payments {
1062     my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
1063     my $e = new_editor(authtoken=>$auth);
1064     return $e->event unless $e->checkauth;
1065     return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
1066     my $data = $U->storagereq(
1067         'open-ils.storage.money.org_unit.user_payments.atomic',
1068         $org, $start_date, $end_date );
1069     for(@$data) {
1070         $_->usr->card(
1071             $e->retrieve_actor_card($_->usr->card)->barcode);
1072         $_->usr->home_ou(
1073             $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
1074     }
1075     return $data;
1076 }
1077
1078
1079 __PACKAGE__->register_method(
1080     method    => 'retrieve_credit_payable_balance',
1081     api_name  => 'open-ils.circ.credit.payable_balance.retrieve',
1082     authoritative => 1,
1083     signature => {
1084         desc   => q/Returns the total amount the patron can pay via credit card/,
1085         params => [
1086             { desc => 'Authentication token', type => 'string' },
1087             { desc => 'User id', type => 'number' }
1088         ],
1089         return => { desc => 'The ID of the new provider' }
1090     }
1091 );
1092
1093 sub retrieve_credit_payable_balance {
1094     my ( $self, $conn, $auth, $user_id ) = @_;
1095     my $e = new_editor(authtoken => $auth);
1096     return $e->event unless $e->checkauth;
1097
1098     my $user = $e->retrieve_actor_user($user_id)
1099         or return $e->event;
1100
1101     if($e->requestor->id != $user_id) {
1102         return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
1103     }
1104
1105     my $circ_orgs = $e->json_query({
1106         "select" => {circ => ["circ_lib"]},
1107         from     => "circ",
1108         "where"  => {usr => $user_id, xact_finish => undef},
1109         distinct => 1
1110     });
1111
1112     my $groc_orgs = $e->json_query({
1113         "select" => {mg => ["billing_location"]},
1114         from     => "mg",
1115         "where"  => {usr => $user_id, xact_finish => undef},
1116         distinct => 1
1117     });
1118
1119     my %hash;
1120     for my $org ( @$circ_orgs, @$groc_orgs ) {
1121         my $o = $org->{billing_location};
1122         $o = $org->{circ_lib} unless $o;
1123         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.
1124         $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
1125     }
1126
1127     my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
1128     $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
1129
1130     my $xact_summaries =
1131       OpenILS::Application::AppUtils->simplereq('open-ils.actor',
1132         'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
1133
1134     my $sum = 0.0;
1135
1136     for my $xact (@$xact_summaries) {
1137
1138         # make two lists and grab them in batch XXX
1139         if ( $xact->xact_type eq 'circulation' ) {
1140             my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
1141             next unless grep { $_ == $circ->circ_lib } @credit_orgs;
1142
1143         } elsif ($xact->xact_type eq 'grocery') {
1144             my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
1145             next unless grep { $_ == $bill->billing_location } @credit_orgs;
1146         } elsif ($xact->xact_type eq 'reservation') {
1147             my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
1148             next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
1149         }
1150         $sum += $xact->balance_owed();
1151     }
1152
1153     return $sum;
1154 }
1155
1156
1157 1;