1 package OpenILS::Application::Circ::CircCommon;
2 use strict; use warnings;
4 use DateTime::Format::ISO8601;
5 use OpenILS::Application::AppUtils;
6 use OpenILS::Utils::DateTime qw/:datetime/;
8 use OpenSRF::Utils::Logger qw(:logger);
9 use OpenILS::Utils::CStoreEditor q/:funcs/;
10 use OpenILS::Const qw/:const/;
12 use List::MoreUtils qw(uniq);
14 my $U = "OpenILS::Application::AppUtils";
15 my $parser = DateTime::Format::ISO8601->new;
17 # -----------------------------------------------------------------
18 # Do not publish methods here. This code is shared across apps.
19 # -----------------------------------------------------------------
22 # -----------------------------------------------------------------
23 # Voids (or zeros) overdue fines on the given circ. if a backdate is
24 # provided, then we only void back to the backdate, unless the
25 # backdate is to within the grace period, in which case we void all
27 # -----------------------------------------------------------------
29 #compatibility layer - TODO
31 sub void_or_zero_overdues {
32 my($class, $e, $circ, $opts) = @_;
39 if( $opts->{backdate} ) {
40 my $backdate = $opts->{backdate};
41 $opts->{note} = 'System: OVERDUE REVERSED FOR BACKDATE' if !$opts->{note};
42 # ------------------------------------------------------------------
43 # Fines for overdue materials are assessed up to, but not including,
44 # one fine interval after the fines are applicable. Here, we add
45 # one fine interval to the backdate to ensure that we are not
46 # voiding fines that were applicable before the backdate.
47 # ------------------------------------------------------------------
49 # if there is a raw time component (e.g. from postgres),
50 # turn it into an interval that interval_to_seconds can parse
51 my $duration = $circ->fine_interval;
52 $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
53 my $interval = OpenILS::Utils::DateTime->interval_to_seconds($duration);
55 my $date = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($backdate));
56 my $due_date = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($circ->due_date))->epoch;
57 my $grace_period = extend_grace_period( $class, $circ->circ_lib, $circ->due_date, OpenILS::Utils::DateTime->interval_to_seconds($circ->grace_period), $e);
58 if($date->epoch <= $due_date + $grace_period) {
59 $logger->info("backdate $backdate is within grace period, voiding all");
61 $backdate = $U->epoch2ISO8601($date->epoch + $interval);
62 $logger->info("applying backdate $backdate in overdue voiding");
63 $$bill_search{billing_ts} = {'>=' => $backdate};
67 my $billids = $e->search_money_billing([$bill_search, {idlist=>1}]);
68 if ($billids && @$billids) {
69 # overdue settings come from transaction org unit
70 my $prohibit_neg_balance_overdues = (
71 $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.prohibit_negative_balance_on_overdues')
73 $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.prohibit_negative_balance_default')
75 my $neg_balance_interval_overdues = (
76 $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.negative_balance_interval_on_overdues')
78 $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.negative_balance_interval_default')
81 # if we prohibit negative overdue balances and all payments
82 # are outside the refund interval (if given), zero the transaction
83 if ($opts->{force_zero}
84 or (!$opts->{force_void}
86 $U->is_true($prohibit_neg_balance_overdues)
87 and !_has_refundable_payments($e, $circ->id, $neg_balance_interval_overdues)
91 $result = $class->adjust_bills_to_zero($e, $billids, $opts->{note}, $neg_balance_interval_overdues);
93 # otherwise, just void the usual way
94 $result = $class->void_bills($e, $billids, $opts->{note});
104 # ------------------------------------------------------------------
105 # remove charge from patron's account if lost item is returned
106 # ------------------------------------------------------------------
108 my ($class, $e, $circ, $btype) = @_;
110 my $bills = $e->search_money_billing(
118 $logger->debug("voiding lost item charge of ".scalar(@$bills));
119 for my $bill (@$bills) {
120 if( !$U->is_true($bill->voided) ) {
121 $logger->info("lost item returned - voiding bill ".$bill->id);
123 $bill->void_time('now');
124 $bill->voider($e->requestor->id);
125 my $note = ($bill->note) ? $bill->note . "\n" : '';
126 $bill->note("${note}System: VOIDED FOR LOST ITEM RETURNED");
129 unless $e->update_money_billing($bill);
135 # ------------------------------------------------------------------
136 # Void (or zero) all bills of a given type on a circulation.
138 # Takes an editor, a circ object, the btype number for the bills you
139 # want to void, and an optional note.
141 # Returns undef on success or the result from void_bills.
142 # ------------------------------------------------------------------
143 sub void_or_zero_bills_of_type {
144 my ($class, $e, $circ, $copy, $btype, $for_note) = @_;
146 my $billids = $e->search_money_billing(
147 {xact => $circ->id(), btype => $btype},
150 if ($billids && @$billids) {
151 # settings for lost come from copy circlib.
152 my $prohibit_neg_balance_lost = (
153 $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.prohibit_negative_balance_on_lost')
155 $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.prohibit_negative_balance_default')
157 my $neg_balance_interval_lost = (
158 $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.negative_balance_interval_on_lost')
160 $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.negative_balance_interval_default')
164 $U->is_true($prohibit_neg_balance_lost)
165 and !_has_refundable_payments($e, $circ->id, $neg_balance_interval_lost)
167 $result = $class->adjust_bills_to_zero($e, $billids, "System: ADJUSTED $for_note");
169 $result = $class->void_bills($e, $billids, "System: VOIDED $for_note");
180 my($class, $e, $xactid) = @_;
182 # -----------------------------------------------------------------
183 # make sure the transaction is not closed
184 my $xact = $e->retrieve_money_billable_transaction($xactid)
185 or return $e->die_event;
187 if( $xact->xact_finish ) {
188 my ($mbts) = $U->fetch_mbts($xactid, $e);
189 if( $mbts->balance_owed != 0 ) {
190 $logger->info("* re-opening xact $xactid, orig xact_finish is ".$xact->xact_finish);
191 $xact->clear_xact_finish;
192 $e->update_money_billable_transaction($xact)
193 or return $e->die_event;
202 my($class, $e, $amount, $btype, $type, $xactid, $note, $period_start, $period_end) = @_;
204 $logger->info("The system is charging $amount [$type] on xact $xactid");
205 $note ||= 'SYSTEM GENERATED';
207 # -----------------------------------------------------------------
208 # now create the billing
209 my $bill = Fieldmapper::money::billing->new;
210 $bill->xact($xactid);
211 $bill->amount($amount);
212 $bill->period_start($period_start);
213 $bill->period_end($period_end);
214 $bill->billing_type($type);
215 $bill->btype($btype);
217 $e->create_money_billing($bill) or return $e->die_event;
222 sub extend_grace_period {
223 my($class, $circ_lib, $due_date, $grace_period, $e, $h) = @_;
224 if ($grace_period >= 86400) { # Only extend grace periods greater than or equal to a full day
225 my $parser = DateTime::Format::ISO8601->new;
226 my $due_dt = $parser->parse_datetime( clean_ISO8601( $due_date ) );
227 my $due = $due_dt->epoch;
229 my $grace_extend = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend');
230 $e = new_editor() if (!$e);
231 $h = $e->retrieve_actor_org_unit_hours_of_operation($circ_lib) if (!$h);
232 if ($grace_extend and $h) {
233 my $new_grace_period = $grace_period;
235 $logger->info( "Circ lib has an hours-of-operation entry and grace period extension is enabled." );
240 my $dow_open = "dow_${i}_open";
241 my $dow_close = "dow_${i}_close";
242 if($h->$dow_open() eq '00:00:00' and $h->$dow_close() eq '00:00:00') {
251 $logger->info("Circ lib is closed all week according to hours-of-operation entry. Skipping grace period extension checks.");
253 # Extra nice grace periods
254 # AKA, merge closed dates trailing the grace period into the grace period
255 my $grace_extend_into_closed = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.into_closed');
256 $due += 86400 if $grace_extend_into_closed;
258 my $grace_extend_all = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.all');
260 if ( $grace_extend_all ) {
261 # Start checking the day after the item was due
262 # This is "The grace period only counts open days"
263 # NOTE: Adding 86400 seconds is not the same as adding one day. This uses seconds intentionally.
264 $due_dt = $due_dt->add( seconds => 86400 );
266 # Jump to the end of the grace period
267 # This is "If the grace period ends on a closed day extend it"
268 # NOTE: This adds grace period as a number of seconds intentionally
269 $due_dt = $due_dt->add( seconds => $grace_period );
272 my $count = 0; # Infinite loop protection
274 $closed = 0; # Starting assumption for day: We are not closed
275 $count++; # We limit the number of loops below.
277 # get the day of the week for the day we are looking at
278 my $dow = $due_dt->day_of_week_0;
280 # Check hours of operation first.
281 if ($h_closed{$dow}) {
283 $new_grace_period += 86400;
284 $due_dt->add( seconds => 86400 );
286 # Check for closed dates for this period
287 my $timestamptz = $due_dt->strftime('%FT%T%z');
288 my $cl = $e->search_actor_org_unit_closed_date(
289 { close_start => { '<=' => $timestamptz },
290 close_end => { '>=' => $timestamptz },
291 org_unit => $circ_lib }
296 my $cl_dt = $parser->parse_datetime( clean_ISO8601( $_->close_end ) );
297 while ($due_dt <= $cl_dt) {
298 $due_dt->add( seconds => 86400 );
299 $new_grace_period += 86400;
303 $due_dt->add( seconds => 86400 );
306 } while ( $count <= 366 and ( $closed or $due_dt->epoch <= $due + $new_grace_period ) );
307 if ($new_grace_period > $grace_period) {
308 $grace_period = $new_grace_period;
309 $logger->info( "Grace period for circ extended to $grace_period [" . seconds_to_interval( $grace_period ) . "]" );
314 return $grace_period;
317 # check if a circulation transaction can be closed
318 # takes a CStoreEditor and a circ transaction.
319 # Returns 1 if the circ should be closed, 0 if not.
321 my ($class, $e, $circ) = @_;
324 my $reason = $circ->stop_fines;
326 # We definitely want to close if this circulation was
327 # checked in or renewed.
328 if ($circ->checkin_time) {
330 } elsif ($reason eq OILS_STOP_FINES_LOST) {
331 # Check the copy circ_lib to see if they close
332 # transactions when lost are paid.
333 my $copy = $e->retrieve_asset_copy($circ->target_copy);
335 $can_close = !$U->is_true(
336 $U->ou_ancestor_setting_value(
338 'circ.lost.xact_open_on_zero',
344 } elsif ($reason eq OILS_STOP_FINES_LONGOVERDUE) {
345 # Check the copy circ_lib to see if they close
346 # transactions when long-overdue are paid.
347 my $copy = $e->retrieve_asset_copy($circ->target_copy);
349 $can_close = !$U->is_true(
350 $U->ou_ancestor_setting_value(
352 'circ.longoverdue.xact_open_on_zero',
362 sub maybe_close_xact {
363 my ($class, $e, $xact_id) = @_;
365 my $circ = $e->retrieve_action_circulation(
370 flesh_fields => {circ => ['target_copy','billings']}
373 ); # Flesh the copy, so we can monkey with the status if
376 # Whether or not we close the transaction. We definitely close if no
377 # circulation transaction is present, otherwise we check if the circulation
378 # is in a state that allows itself to be closed.
379 if (!$circ || can_close_circ($class, $e, $circ)) {
380 my $billable_xact = $e->retrieve_money_billable_transaction($xact_id);
381 $billable_xact->xact_finish("now");
382 if (!$e->update_money_billable_transaction($billable_xact)) {
384 message => "update_money_billable_transaction() failed",
389 # If we have a circ, we need to check if the copy status is lost or
390 # long overdue. If it is then we check org_unit_settings for the copy
391 # owning library and adjust and possibly adjust copy status to lost and
393 if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
394 # We need the copy to check settings and to possibly
396 my $copy = $circ->target_copy();
397 # Library where we'll check settings.
398 my $check_lib = $copy->circ_lib();
400 # check the copy status
401 if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
402 && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
403 $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
404 if (!$e->update_asset_copy($copy)) {
406 message => "update_asset_copy_failed()",
416 sub seconds_to_interval_hash {
417 my $interval = shift;
418 my $limit = shift || 's';
419 $limit =~ s/^(.)/$1/o;
423 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s);
424 my ($year, $month, $week, $day, $hour, $minute, $second) =
425 ('years','months','weeks','days', 'hours', 'minutes', 'seconds');
427 if ($y = int($interval / (60 * 60 * 24 * 365))) {
429 $ym = $interval % (60 * 60 * 24 * 365);
433 return %output if ($limit eq 'y');
435 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
436 $output{$month} = $M;
437 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
441 return %output if ($limit eq 'M');
443 if ($w = int($Mm / 604800)) {
449 return %output if ($limit eq 'w');
451 if ($d = int($wm / 86400)) {
457 return %output if ($limit eq 'd');
459 if ($h = int($dm / 3600)) {
465 return %output if ($limit eq 'h');
467 if ($m = int($hm / 60)) {
468 $output{$minute} = $m;
473 return %output if ($limit eq 'm');
476 $output{$second} = $s;
478 $output{$second} = 0 unless (keys %output);
484 my ($class, $args) = @_;
485 my $circs = $args->{circs};
486 return unless $circs and @$circs;
487 my $e = $args->{editor};
488 # if a client connection is passed in, this will be chatty like
489 # the old storage version
490 my $conn = $args->{conn};
494 # Transactions are opened/closed with each circ, reservation, etc.
495 # The first $e->xact_begin (below) will cause a connect.
500 my %hoo = map { ( $_->id => $_ ) } @{ $e->retrieve_all_actor_org_unit_hours_of_operation };
502 my $handling_resvs = 0;
503 for my $c (@$circs) {
507 if (!$ctype) { # we received only an idlist, not objects
508 if ($handling_resvs) {
509 $c = $e->retrieve_booking_reservation($c);
510 } elsif (not defined $c) {
511 # an undef value is the indicator that we are moving
512 # from processing circulations to reservations.
516 $c = $e->retrieve_action_circulation($c);
521 $ctype =~ s/^.+::(\w+)$/$1/;
523 my $due_date_method = 'due_date';
524 my $target_copy_method = 'target_copy';
525 my $circ_lib_method = 'circ_lib';
526 my $recurring_fine_method = 'recurring_fine';
527 my $is_reservation = 0;
528 if ($ctype eq 'reservation') {
530 $due_date_method = 'end_time';
531 $target_copy_method = 'current_resource';
532 $circ_lib_method = 'pickup_lib';
533 $recurring_fine_method = 'fine_amount';
534 next unless ($c->fine_interval);
536 #TODO: reservation grace periods
537 my $grace_period = ($is_reservation ? 0 : interval_to_seconds($c->grace_period));
541 # Clean up after previous transaction.
542 # This is a no-op if there is no open transaction.
543 $e->xact_rollback if $commit;
545 $logger->info(sprintf("Processing $ctype %d...", $c->id));
547 # each (ils) transaction is processed in its own (db) transaction
548 $e->xact_begin if $commit;
550 my $due_dt = $parser->parse_datetime( clean_ISO8601( $c->$due_date_method ) );
552 my $due = $due_dt->epoch;
555 my $fine_interval = $c->fine_interval;
556 $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
557 $fine_interval = interval_to_seconds( $fine_interval );
559 if ( $fine_interval == 0 || $c->$recurring_fine_method * 100 == 0 || $c->max_fine * 100 == 0 ) {
560 $conn->respond( "Fine Generator skipping circ due to 0 fine interval, 0 fine rate, or 0 max fine.\n" ) if $conn;
561 $logger->info( "Fine Generator skipping circ " . $c->id . " due to 0 fine interval, 0 fine rate, or 0 max fine." );
565 if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) {
567 if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) {
568 $tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m");
571 $due -= ($due % $fine_interval) + $tz_offset_s;
572 $now -= ($now % $fine_interval) + $tz_offset_s;
576 "ARG! Overdue $ctype ".$c->id.
577 " for item ".$c->$target_copy_method.
578 " (user ".$c->usr.").\n".
579 "\tItem was due on or before: ".localtime($due)."\n") if $conn;
581 my @fines = @{$e->search_money_billing([
584 billing_ts => { '>' => $c->$due_date_method } },
585 { order_by => {mb => 'billing_ts DESC'},
587 flesh_fields => {mb => ['adjustments']} }
591 my $fine = $fines[$f_idx] if (@fines);
592 my $current_fine_total = 0;
593 $current_fine_total += $_->amount * 100 for (grep { $_ and !$U->is_true($_->voided) } @fines);
594 $current_fine_total -= $_->amount * 100 for (map { @{$_->adjustments} } @fines);
598 $conn->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".clean_ISO8601( $fine->billing_ts ).")") if $conn;
599 $last_fine = $parser->parse_datetime( clean_ISO8601( $fine->billing_ts ) )->epoch;
601 $logger->info( "Potential first billing for circ ".$c->id );
604 $grace_period = extend_grace_period($class, $c->$circ_lib_method,$c->$due_date_method,$grace_period,undef,$hoo{$c->$circ_lib_method});
607 return if ($last_fine > $now);
608 # Generate fines for each past interval, including the one we are inside
609 my $pending_fine_count = ceil( ($now - $last_fine) / $fine_interval );
611 if ( $last_fine == $due # we have no fines yet
612 && $grace_period # and we have a grace period
613 && $now < $due + $grace_period # and some date math says were are within the grace period
615 $conn->respond( "Still inside grace period of: ". seconds_to_interval( $grace_period )."\n" ) if $conn;
616 $logger->info( "Circ ".$c->id." is still inside grace period of: $grace_period [". seconds_to_interval( $grace_period ).']' );
620 $conn->respond( "\t$pending_fine_count pending fine(s)\n" ) if $conn;
621 return unless ($pending_fine_count);
623 my $recurring_fine = $c->$recurring_fine_method * 100;
624 my $max_fine = $c->max_fine * 100;
626 my $skip_closed_check = $U->ou_ancestor_setting_value(
627 $c->$circ_lib_method, 'circ.fines.charge_when_closed');
628 $skip_closed_check = $U->is_true($skip_closed_check);
630 my $truncate_to_max_fine = $U->ou_ancestor_setting_value(
631 $c->$circ_lib_method, 'circ.fines.truncate_to_max_fine');
632 $truncate_to_max_fine = $U->is_true($truncate_to_max_fine);
634 my $tz = $U->ou_ancestor_setting_value(
635 $c->$circ_lib_method, 'lib.timezone') || 'local';
637 my ($latest_period_end, $latest_amount) = ('',0);
638 for (my $bill = 1; $bill <= $pending_fine_count; $bill++) {
640 if ($current_fine_total >= $max_fine) {
641 if ($ctype eq 'circulation') {
642 $c->stop_fines('MAXFINES');
643 $c->stop_fines_time('now');
644 $e->update_action_circulation($c);
647 "\tMaximum fine level of ".$c->max_fine.
648 " reached for this $ctype.\n".
649 "\tNo more fines will be generated.\n" ) if $conn;
653 # Use org time zone (or default to 'local')
654 my $period_end = DateTime->from_epoch( epoch => $last_fine, time_zone => $tz );
655 my $current_bill_count = $bill;
656 while ( $current_bill_count ) {
657 $period_end->add( seconds_to_interval_hash( $fine_interval ) );
658 $current_bill_count--;
660 my $period_start = $period_end->clone->subtract( seconds_to_interval_hash( $fine_interval - 1 ) );
662 my $timestamptz = $period_end->strftime('%FT%T%z');
663 if (!$skip_closed_check) {
664 my $dow = $period_end->day_of_week_0();
665 my $dow_open = "dow_${dow}_open";
666 my $dow_close = "dow_${dow}_close";
668 if (my $h = $hoo{$c->$circ_lib_method}) {
669 next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00');
672 my @cl = @{$e->search_actor_org_unit_closed_date(
673 { close_start => { '<=' => $timestamptz },
674 close_end => { '>=' => $timestamptz },
675 org_unit => $c->$circ_lib_method }
680 # The billing amount for this billing normally ought to be the recurring fine amount.
681 # However, if the recurring fine amount would cause total fines to exceed the max fine amount,
682 # we may wish to reduce the amount for this billing (if circ.fines.truncate_to_max_fine is true).
683 my $this_billing_amount = $recurring_fine;
684 if ( $truncate_to_max_fine && ($current_fine_total + $this_billing_amount) > $max_fine ) {
685 $this_billing_amount = ($max_fine - $current_fine_total);
687 $current_fine_total += $this_billing_amount;
688 $latest_amount += $this_billing_amount;
689 $latest_period_end = $timestamptz;
691 my $bill = Fieldmapper::money::billing->new;
693 $bill->note("System Generated Overdue Fine");
694 $bill->billing_type("Overdue materials");
696 $bill->amount(sprintf('%0.2f', $this_billing_amount/100));
697 $bill->period_start($period_start->strftime('%FT%T%z'));
698 $bill->period_end($timestamptz);
699 $e->create_money_billing($bill);
703 $conn->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_period_end\n" )
704 if ($conn and $latest_period_end and $latest_amount);
707 # Calculate penalties inline
708 OpenILS::Utils::Penalty->calculate_penalties(
709 $e, $c->usr, $c->$circ_lib_method);
711 $e->xact_commit if $commit;
717 $conn->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" ) if $conn;
718 $logger->error("Error processing overdue $ctype [".$c->id."]:\n$e\n");
719 last if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
723 # roll back any (potentially) orphaned transaction and disconnect.
724 $e->rollback if $commit;
729 # -----------------------------------------------------------------
730 # Given an editor and a xact, return a reference to an array of
731 # hashrefs that map billing objects to payment objects. Returns undef
732 # if no bills are found for the given transaction.
734 # The bill amounts are adjusted to reflect the application of the
735 # payments to the bills. The original bill amounts are retained in
738 # The payment objects may or may not have their amounts adjusted
739 # depending on whether or not they apply to more than one bill. We
740 # could really use a better logic here, perhaps, but if it was
741 # consistent, it wouldn't be Evergreen.
743 # The data structure used in the array is a hashref that has the
746 # bill => the adjusted bill object
747 # adjustments => an arrayref of account adjustments that apply directly
749 # payments => an arrayref of payment objects applied to the bill
750 # bill_amount => original amount from the billing object
751 # adjustment_amount => total of the account adjustments that apply
752 # directly to the bill
754 # Each bill is only mapped to payments one time. However, a single
755 # payment may be mapped to more than one bill if the payment amount is
756 # greater than the amount of each individual bill, such as a $3.00
757 # payment for 30 $0.10 overdue bills. There is an attempt made to
758 # first pay bills with payments that match the billing amount. This
759 # is intended to catch payments for lost and/or long overdue bills so
760 # that they will match up.
762 # This function is heavily adapted from code written by Jeff Godin of
763 # Traverse Area District Library and submitted on LaunchPad bug
765 # -----------------------------------------------------------------
766 sub bill_payment_map_for_xact {
767 my ($class, $e, $xact) = @_;
769 # Check for CStoreEditor and make a new one if we have to. This
770 # allows one-off calls to this subroutine to pass undef as the
771 # CStoreEditor and not have to create one of their own.
772 $e = OpenILS::Utils::CStoreEditor->new unless ($e);
774 # find all bills in order
776 { xact => $xact->id(), voided => 'f' },
777 { order_by => { mb => { billing_ts => { direction => 'asc' } } } },
780 # At some point, we should get rid of the voided column on
781 # money.payment and family. It is not exposed in the client at
782 # the moment, and should be replaced with a void_bill type. The
783 # descendants of money.payment don't expose the voided field in
784 # the fieldmapper, only the mp object, based on the money.payment
785 # view, does. However, I want to leave that complication for
786 # later. I wonder if I'm not slowing things down too much with
787 # the current account_adjustment logic. It would probably be faster if
788 # we had direct Pg access at this layer. I can probably wrangle
789 # something via the drivers or store interfaces, but I haven't
790 # really figured those out, yet.
792 my $bills = $e->search_money_billing($bill_search);
794 # return undef if there are no bills.
795 return undef unless ($bills && @$bills);
797 # map the bills into our bill_payment_map entry format:
801 bill_amount => $_->amount(),
804 adjustment_amount => 0
808 # Find all unvoided payments in order. Flesh account adjustments
809 # so that we don't have to retrieve them later.
810 my $payments = $e->search_money_payment(
812 { xact => $xact->id, voided=>'f' },
814 order_by => { mp => { payment_ts => { direction => 'asc' } } },
816 flesh_fields => { mp => ['account_adjustment'] }
821 # If there were no payments, then we just return the bills.
822 return \@entries unless ($payments && @$payments);
824 # Now, we go through the rigmarole of mapping payments to bills
825 # and adjusting the bill balances.
827 # Apply the adjustments before "paying" other bills.
828 foreach my $entry (@entries) {
829 my $bill = $entry->{bill};
830 # Find only the adjustments that apply to individual bills.
831 my @adjustments = map {$_->account_adjustment()} grep {$_->payment_type() eq 'account_adjustment' && $_->account_adjustment()->billing() == $bill->id()} @$payments;
833 foreach my $adjustment (@adjustments) {
834 my $new_amount = $U->fpdiff($bill->amount(),$adjustment->amount());
835 if ($new_amount >= 0) {
836 push @{$entry->{adjustments}}, $adjustment;
837 $entry->{adjustment_amount} += $adjustment->amount();
838 $bill->amount($new_amount);
839 # Remove the used up adjustment from list of payments:
840 my @p = grep {$_->id() != $adjustment->id()} @$payments;
843 # It should never happen that we have more adjustment
844 # payments on a single bill than the amount of the
845 # bill. However, experience shows that the things
846 # that should never happen actually do happen with
847 # surprising regularity in a library setting.
849 # Clone the adjustment to say how much of it actually
850 # applied to this bill.
851 my $new_adjustment = $adjustment->clone();
852 $new_adjustment->amount($bill->amount());
853 $new_adjustment->amount_collected($bill->amount());
854 push (@{$entry->{adjustments}}, $new_adjustment);
855 $entry->{adjustment_amount} += $new_adjustment->amount();
857 $adjustment->amount(-$new_amount);
858 # Could be a candidate for YAOUS about what to do
859 # with excess adjustment amounts on a bill.
861 last if ($bill->amount() == 0);
866 # Try to map payments to bills by amounts starting with the
868 # To avoid modifying the array we're iterating over (which can result in a
869 # "Use of freed value in iteration" error), we create a copy of the
870 # payments array and remove handled payments from that instead.
871 my @handled_payments = @$payments;
872 foreach my $payment (sort {$b->amount() <=> $a->amount()} @$payments) {
873 my @bills2pay = grep {$_->{bill}->amount() == $payment->amount()} @entries;
875 my $entry = $bills2pay[0];
876 $entry->{bill}->amount(0);
877 push @{$entry->{payments}}, $payment;
878 # Remove the payment from the master list.
879 my @p = grep {$_->id() != $payment->id()} @handled_payments;
880 @handled_payments = @p;
883 # Now, update our list of payments so that it only includes unhandled
884 # (unmapped) payments.
885 $payments = \@handled_payments;
887 # Map remaining bills to payments in whatever order.
888 foreach my $entry (grep {$_->{bill}->amount() > 0} @entries) {
889 my $bill = $entry->{bill};
890 # We could run out of payments before bills.
891 if ($payments && @$payments) {
892 while ($bill->amount() > 0) {
893 my $payment = shift @$payments;
894 last unless $payment;
895 my $new_amount = $U->fpdiff($bill->amount(),$payment->amount());
896 if ($new_amount < 0) {
897 # Clone the payment so we can say how much applied
899 my $new_payment = $payment->clone();
900 $new_payment->amount($bill->amount());
902 push @{$entry->{payments}}, $new_payment;
903 # Reset the payment amount and put it back on the
904 # list for later use.
905 $payment->amount(-$new_amount);
906 unshift @$payments, $payment;
908 $bill->amount($new_amount);
909 push @{$entry->{payments}}, $payment;
919 # This subroutine actually handles voiding of bills. It takes a
920 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
922 my ($class, $e, $billids, $note) = @_;
926 if (ref($billids->[0])) {
929 $bills = $e->search_money_billing([{id => $billids}])
930 or return $e->die_event;
932 for my $bill (@$bills) {
934 my $xact = $e->retrieve_money_billable_transaction($bill->xact)
935 or return $e->die_event;
937 if($U->is_true($bill->voided)) {
938 # For now, it is not an error to attempt to re-void a bill, but
939 # don't actually do anything
941 #return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill)
945 my $org = $U->xact_org($bill->xact, $e);
946 $users{$xact->usr} = {} unless $users{$xact->usr};
947 $users{$xact->usr}->{$org} = 1;
950 $bill->voider($e->requestor->id);
951 $bill->void_time('now');
952 my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : "";
953 $bill->note(sprintf("$n%s", $note));
955 $e->update_money_billing($bill) or return $e->die_event;
956 my $evt = $U->check_open_xact($e, $bill->xact, $xact);
960 # calculate penalties for all user/org combinations
961 for my $user_id (keys %users) {
962 for my $org_id (keys %{$users{$user_id}}) {
963 OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id)
971 # This subroutine actually handles "adjusting" bills to zero. It takes a
972 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
973 sub adjust_bills_to_zero {
974 my ($class, $e, $billids, $note) = @_;
978 # Let's get all the billing objects and handle them by
981 if (ref($billids->[0])) {
984 $bills = $e->search_money_billing([{id => $billids}])
985 or return $e->die_event;
988 my @xactids = uniq map {$_->xact()} @$bills;
990 foreach my $xactid (@xactids) {
991 my $mbt = $e->retrieve_money_billable_transaction(
997 mbt=>['grocery','circulation'],
998 circ=>['target_copy']
1002 ) or return $e->die_event;
1003 # Flesh grocery bills and circulations so we don't have to
1004 # retrieve them later.
1005 my ($circ, $grocery, $copy);
1006 $grocery = $mbt->grocery();
1007 $circ = $mbt->circulation();
1008 $copy = $circ->target_copy() if ($circ);
1012 # Get the bill_payment_map for the transaction.
1013 my $bpmap = $class->bill_payment_map_for_xact($e, $mbt);
1015 # Get the bills for this transaction from the main list of bills.
1016 my @xact_bills = grep {$_->xact() == $xactid} @$bills;
1017 # Handle each bill in turn.
1018 foreach my $bill (@xact_bills) {
1019 # As the total open amount on the transaction will change
1020 # as each bill is adjusted, we'll just recalculate it for
1023 map {$xact_total += $_->{bill}->amount()} @$bpmap;
1024 last if $xact_total == 0;
1026 # Get the bill_payment_map entry for this bill:
1027 my ($bpentry) = grep {$_->{bill}->id() == $bill->id()} @$bpmap;
1029 # From here on out, use the bill object from the bill
1030 # payment map entry.
1031 $bill = $bpentry->{bill};
1033 # The amount to adjust is the non-adjusted balance on the
1034 # bill. It should never be less than zero.
1035 my $amount_to_adjust = $U->fpdiff($bpentry->{bill_amount},$bpentry->{adjustment_amount});
1037 # Check if this bill is already adjusted. We don't allow
1038 # "double" adjustments regardless of settings.
1039 if ($amount_to_adjust <= 0) {
1040 #my $event = OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
1046 if ($amount_to_adjust > $xact_total) {
1047 $amount_to_adjust = $xact_total;
1050 # Create the account adjustment
1051 my $payobj = Fieldmapper::money::account_adjustment->new;
1052 $payobj->amount($amount_to_adjust);
1053 $payobj->amount_collected($amount_to_adjust);
1054 $payobj->xact($xactid);
1055 $payobj->accepting_usr($e->requestor->id);
1056 $payobj->payment_ts('now');
1057 $payobj->billing($bill->id());
1058 $payobj->note($note) if ($note);
1059 $e->create_money_account_adjustment($payobj) or return $e->die_event;
1060 # Adjust our bill_payment_map
1061 $bpentry->{adjustment_amount} += $amount_to_adjust;
1062 push @{$bpentry->{adjustments}}, $payobj;
1063 # Should come to zero:
1064 my $new_bill_amount = $U->fpdiff($bill->amount(),$amount_to_adjust);
1065 $bill->amount($new_bill_amount);
1068 my $org = $U->xact_org($xactid, $e);
1069 $users{$mbt->usr} = {} unless $users{$mbt->usr};
1070 $users{$mbt->usr}->{$org} = 1;
1072 my $evt = $U->check_open_xact($e, $xactid, $mbt);
1073 return $evt if $evt;
1076 # calculate penalties for all user/org combinations
1077 for my $user_id (keys %users) {
1078 for my $org_id (keys %{$users{$user_id}}) {
1079 OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
1086 # A helper function to check if the payments on a bill are inside the
1087 # range of a given interval.
1088 # TODO: here is one simple place we could do voids in the absence
1090 sub _has_refundable_payments {
1091 my ($e, $xactid, $interval) = @_;
1093 # for now, just short-circuit with no interval
1094 return 0 if (!$interval);
1096 my $last_payment = $e->search_money_payment(
1099 payment_type => {"!=" => 'account_adjustment'}
1102 order_by => { mp => "payment_ts DESC" }
1106 if ($last_payment->[0]) {
1107 my $interval_secs = interval_to_seconds($interval);
1108 my $payment_ts = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($last_payment->[0]->payment_ts))->epoch;
1110 return 1 if ($payment_ts + $interval_secs >= $now);