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