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