Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Money.pm

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