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