1 package OpenILS::Application::Circ::CircCommon;
2 use strict; use warnings;
4 use DateTime::Format::ISO8601;
5 use OpenILS::Application::AppUtils;
6 use OpenSRF::Utils 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 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 my($class, $e, $circ, $backdate, $note) = @_;
37 # ------------------------------------------------------------------
38 # Fines for overdue materials are assessed up to, but not including,
39 # one fine interval after the fines are applicable. Here, we add
40 # one fine interval to the backdate to ensure that we are not
41 # voiding fines that were applicable before the backdate.
42 # ------------------------------------------------------------------
44 # if there is a raw time component (e.g. from postgres),
45 # turn it into an interval that interval_to_seconds can parse
46 my $duration = $circ->fine_interval;
47 $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
48 my $interval = OpenSRF::Utils->interval_to_seconds($duration);
50 my $date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($backdate));
51 my $due_date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($circ->due_date))->epoch;
52 my $grace_period = extend_grace_period( $class, $circ->circ_lib, $circ->due_date, OpenSRF::Utils->interval_to_seconds($circ->grace_period), $e);
53 if($date->epoch <= $due_date + $grace_period) {
54 $logger->info("backdate $backdate is within grace period, voiding all");
56 $backdate = $U->epoch2ISO8601($date->epoch + $interval);
57 $logger->info("applying backdate $backdate in overdue voiding");
58 $$bill_search{billing_ts} = {'>=' => $backdate};
62 my $billids = $e->search_money_billing([$bill_search, {idlist=>1}]);
63 if ($billids && @$billids) {
64 my $result = $class->real_void_bills($e, $billids, $note);
73 # ------------------------------------------------------------------
74 # remove charge from patron's account if lost item is returned
75 # ------------------------------------------------------------------
77 my ($class, $e, $circ, $btype) = @_;
79 my $bills = $e->search_money_billing(
87 $logger->debug("voiding lost item charge of ".scalar(@$bills));
88 for my $bill (@$bills) {
89 if( !$U->is_true($bill->voided) ) {
90 $logger->info("lost item returned - voiding bill ".$bill->id);
92 $bill->void_time('now');
93 $bill->voider($e->requestor->id);
94 my $note = ($bill->note) ? $bill->note . "\n" : '';
95 $bill->note("${note}System: VOIDED FOR LOST ITEM RETURNED");
98 unless $e->update_money_billing($bill);
104 # ------------------------------------------------------------------
105 # Void all bills of a given type on a circulation.
107 # Takes an editor, a circ object, the btype number for the bills you
108 # want to void, and an optional note.
110 # Returns undef on success or the result from real_void_bills.
111 # ------------------------------------------------------------------
112 sub void_bills_of_type {
113 my ($class, $e, $circ, $btype, $note) = @_;
115 # Get a bill payment map.
116 my $bpmap = $class->bill_payment_map_for_xact($e, $circ);
117 if ($bpmap && @$bpmap) {
118 # Filter out the unvoided bills of the type we're looking for:
119 my @bills = map {$_->{bill}} grep { $_->{bill}->btype() == $btype && $_->{bill_amount} > $_->{void_amount} } @$bpmap;
121 my $result = $class->real_void_bills($e, \@bills, $note);
132 my($class, $e, $xactid) = @_;
134 # -----------------------------------------------------------------
135 # make sure the transaction is not closed
136 my $xact = $e->retrieve_money_billable_transaction($xactid)
137 or return $e->die_event;
139 if( $xact->xact_finish ) {
140 my ($mbts) = $U->fetch_mbts($xactid, $e);
141 if( $mbts->balance_owed != 0 ) {
142 $logger->info("* re-opening xact $xactid, orig xact_finish is ".$xact->xact_finish);
143 $xact->clear_xact_finish;
144 $e->update_money_billable_transaction($xact)
145 or return $e->die_event;
154 my($class, $e, $amount, $btype, $type, $xactid, $note) = @_;
156 $logger->info("The system is charging $amount [$type] on xact $xactid");
157 $note ||= 'SYSTEM GENERATED';
159 # -----------------------------------------------------------------
160 # now create the billing
161 my $bill = Fieldmapper::money::billing->new;
162 $bill->xact($xactid);
163 $bill->amount($amount);
164 $bill->billing_type($type);
165 $bill->btype($btype);
167 $e->create_money_billing($bill) or return $e->die_event;
172 sub extend_grace_period {
173 my($class, $circ_lib, $due_date, $grace_period, $e, $h) = @_;
174 if ($grace_period >= 86400) { # Only extend grace periods greater than or equal to a full day
175 my $parser = DateTime::Format::ISO8601->new;
176 my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $due_date ) );
177 my $due = $due_dt->epoch;
179 my $grace_extend = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend');
180 $e = new_editor() if (!$e);
181 $h = $e->retrieve_actor_org_unit_hours_of_operation($circ_lib) if (!$h);
182 if ($grace_extend and $h) {
183 my $new_grace_period = $grace_period;
185 $logger->info( "Circ lib has an hours-of-operation entry and grace period extension is enabled." );
190 my $dow_open = "dow_${i}_open";
191 my $dow_close = "dow_${i}_close";
192 if($h->$dow_open() eq '00:00:00' and $h->$dow_close() eq '00:00:00') {
201 $logger->info("Circ lib is closed all week according to hours-of-operation entry. Skipping grace period extension checks.");
203 # Extra nice grace periods
204 # AKA, merge closed dates trailing the grace period into the grace period
205 my $grace_extend_into_closed = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.into_closed');
206 $due += 86400 if $grace_extend_into_closed;
208 my $grace_extend_all = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.all');
210 if ( $grace_extend_all ) {
211 # Start checking the day after the item was due
212 # This is "The grace period only counts open days"
213 # NOTE: Adding 86400 seconds is not the same as adding one day. This uses seconds intentionally.
214 $due_dt = $due_dt->add( seconds => 86400 );
216 # Jump to the end of the grace period
217 # This is "If the grace period ends on a closed day extend it"
218 # NOTE: This adds grace period as a number of seconds intentionally
219 $due_dt = $due_dt->add( seconds => $grace_period );
222 my $count = 0; # Infinite loop protection
224 $closed = 0; # Starting assumption for day: We are not closed
225 $count++; # We limit the number of loops below.
227 # get the day of the week for the day we are looking at
228 my $dow = $due_dt->day_of_week_0;
230 # Check hours of operation first.
231 if ($h_closed{$dow}) {
233 $new_grace_period += 86400;
234 $due_dt->add( seconds => 86400 );
236 # Check for closed dates for this period
237 my $timestamptz = $due_dt->strftime('%FT%T%z');
238 my $cl = $e->search_actor_org_unit_closed_date(
239 { close_start => { '<=' => $timestamptz },
240 close_end => { '>=' => $timestamptz },
241 org_unit => $circ_lib }
246 my $cl_dt = $parser->parse_datetime( cleanse_ISO8601( $_->close_end ) );
247 while ($due_dt <= $cl_dt) {
248 $due_dt->add( seconds => 86400 );
249 $new_grace_period += 86400;
253 $due_dt->add( seconds => 86400 );
256 } while ( $count <= 366 and ( $closed or $due_dt->epoch <= $due + $new_grace_period ) );
257 if ($new_grace_period > $grace_period) {
258 $grace_period = $new_grace_period;
259 $logger->info( "Grace period for circ extended to $grace_period [" . seconds_to_interval( $grace_period ) . "]" );
264 return $grace_period;
267 # check if a circulation transaction can be closed
268 # takes a CStoreEditor and a circ transaction.
269 # Returns 1 if the circ should be closed, 0 if not.
271 my ($class, $e, $circ) = @_;
274 my $reason = $circ->stop_fines;
276 # We definitely want to close if this circulation was
277 # checked in or renewed.
278 if ($circ->checkin_time) {
280 } elsif ($reason eq OILS_STOP_FINES_LOST) {
281 # Check the copy circ_lib to see if they close
282 # transactions when lost are paid.
283 my $copy = $e->retrieve_asset_copy($circ->target_copy);
285 $can_close = !$U->is_true(
286 $U->ou_ancestor_setting_value(
288 'circ.lost.xact_open_on_zero',
294 } elsif ($reason eq OILS_STOP_FINES_LONGOVERDUE) {
295 # Check the copy circ_lib to see if they close
296 # transactions when long-overdue are paid.
297 my $copy = $e->retrieve_asset_copy($circ->target_copy);
299 $can_close = !$U->is_true(
300 $U->ou_ancestor_setting_value(
302 'circ.longoverdue.xact_open_on_zero',
312 sub seconds_to_interval_hash {
313 my $interval = shift;
314 my $limit = shift || 's';
315 $limit =~ s/^(.)/$1/o;
319 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s);
320 my ($year, $month, $week, $day, $hour, $minute, $second) =
321 ('years','months','weeks','days', 'hours', 'minutes', 'seconds');
323 if ($y = int($interval / (60 * 60 * 24 * 365))) {
325 $ym = $interval % (60 * 60 * 24 * 365);
329 return %output if ($limit eq 'y');
331 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
332 $output{$month} = $M;
333 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
337 return %output if ($limit eq 'M');
339 if ($w = int($Mm / 604800)) {
345 return %output if ($limit eq 'w');
347 if ($d = int($wm / 86400)) {
353 return %output if ($limit eq 'd');
355 if ($h = int($dm / 3600)) {
361 return %output if ($limit eq 'h');
363 if ($m = int($hm / 60)) {
364 $output{$minute} = $m;
369 return %output if ($limit eq 'm');
372 $output{$second} = $s;
374 $output{$second} = 0 unless (keys %output);
380 my ($class, $args) = @_;
381 my $circs = $args->{circs};
382 return unless $circs and @$circs;
383 my $e = $args->{editor};
384 # if a client connection is passed in, this will be chatty like
385 # the old storage version
386 my $conn = $args->{conn};
390 # Transactions are opened/closed with each circ, reservation, etc.
391 # The first $e->xact_begin (below) will cause a connect.
396 my %hoo = map { ( $_->id => $_ ) } @{ $e->retrieve_all_actor_org_unit_hours_of_operation };
398 my $handling_resvs = 0;
399 for my $c (@$circs) {
403 if (!$ctype) { # we received only an idlist, not objects
404 if ($handling_resvs) {
405 $c = $e->retrieve_booking_reservation($c);
406 } elsif (not defined $c) {
407 # an undef value is the indicator that we are moving
408 # from processing circulations to reservations.
412 $c = $e->retrieve_action_circulation($c);
417 $ctype =~ s/^.+::(\w+)$/$1/;
419 my $due_date_method = 'due_date';
420 my $target_copy_method = 'target_copy';
421 my $circ_lib_method = 'circ_lib';
422 my $recurring_fine_method = 'recurring_fine';
423 my $is_reservation = 0;
424 if ($ctype eq 'reservation') {
426 $due_date_method = 'end_time';
427 $target_copy_method = 'current_resource';
428 $circ_lib_method = 'pickup_lib';
429 $recurring_fine_method = 'fine_amount';
430 next unless ($c->fine_interval);
432 #TODO: reservation grace periods
433 my $grace_period = ($is_reservation ? 0 : interval_to_seconds($c->grace_period));
437 # Clean up after previous transaction.
438 # This is a no-op if there is no open transaction.
439 $e->xact_rollback if $commit;
441 $logger->info(sprintf("Processing $ctype %d...", $c->id));
443 # each (ils) transaction is processed in its own (db) transaction
444 $e->xact_begin if $commit;
446 my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $c->$due_date_method ) );
448 my $due = $due_dt->epoch;
451 my $fine_interval = $c->fine_interval;
452 $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
453 $fine_interval = interval_to_seconds( $fine_interval );
455 if ( $fine_interval == 0 || int($c->$recurring_fine_method * 100) == 0 || int($c->max_fine * 100) == 0 ) {
456 $conn->respond( "Fine Generator skipping circ due to 0 fine interval, 0 fine rate, or 0 max fine.\n" ) if $conn;
457 $logger->info( "Fine Generator skipping circ " . $c->id . " due to 0 fine interval, 0 fine rate, or 0 max fine." );
461 if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) {
463 if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) {
464 $tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m");
467 $due -= ($due % $fine_interval) + $tz_offset_s;
468 $now -= ($now % $fine_interval) + $tz_offset_s;
472 "ARG! Overdue $ctype ".$c->id.
473 " for item ".$c->$target_copy_method.
474 " (user ".$c->usr.").\n".
475 "\tItem was due on or before: ".localtime($due)."\n") if $conn;
477 my @fines = @{$e->search_money_billing([
480 billing_ts => { '>' => $c->$due_date_method } },
481 { order_by => {mb => 'billing_ts DESC'}}
485 my $fine = $fines[$f_idx] if (@fines);
486 my $current_fine_total = 0;
487 $current_fine_total += int($_->amount * 100) for (grep { $_ and !$U->is_true($_->voided) } @fines);
491 $conn->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".cleanse_ISO8601( $fine->billing_ts ).")") if $conn;
492 $last_fine = $parser->parse_datetime( cleanse_ISO8601( $fine->billing_ts ) )->epoch;
494 $logger->info( "Potential first billing for circ ".$c->id );
497 $grace_period = extend_grace_period($class, $c->$circ_lib_method,$c->$due_date_method,$grace_period,undef,$hoo{$c->$circ_lib_method});
500 return if ($last_fine > $now);
501 # Generate fines for each past interval, including the one we are inside
502 my $pending_fine_count = ceil( ($now - $last_fine) / $fine_interval );
504 if ( $last_fine == $due # we have no fines yet
505 && $grace_period # and we have a grace period
506 && $now < $due + $grace_period # and some date math says were are within the grace period
508 $conn->respond( "Still inside grace period of: ". seconds_to_interval( $grace_period )."\n" ) if $conn;
509 $logger->info( "Circ ".$c->id." is still inside grace period of: $grace_period [". seconds_to_interval( $grace_period ).']' );
513 $conn->respond( "\t$pending_fine_count pending fine(s)\n" ) if $conn;
514 return unless ($pending_fine_count);
516 my $recurring_fine = int($c->$recurring_fine_method * 100);
517 my $max_fine = int($c->max_fine * 100);
519 my $skip_closed_check = $U->ou_ancestor_setting_value(
520 $c->$circ_lib_method, 'circ.fines.charge_when_closed');
521 $skip_closed_check = $U->is_true($skip_closed_check);
523 my $truncate_to_max_fine = $U->ou_ancestor_setting_value(
524 $c->$circ_lib_method, 'circ.fines.truncate_to_max_fine');
525 $truncate_to_max_fine = $U->is_true($truncate_to_max_fine);
527 my ($latest_billing_ts, $latest_amount) = ('',0);
528 for (my $bill = 1; $bill <= $pending_fine_count; $bill++) {
530 if ($current_fine_total >= $max_fine) {
531 if ($ctype eq 'circulation') {
532 $c->stop_fines('MAXFINES');
533 $c->stop_fines_time('now');
534 $e->update_action_circulation($c);
537 "\tMaximum fine level of ".$c->max_fine.
538 " reached for this $ctype.\n".
539 "\tNo more fines will be generated.\n" ) if $conn;
543 # XXX Use org time zone (or default to 'local') once we have the ou setting built for that
544 my $billing_ts = DateTime->from_epoch( epoch => $last_fine, time_zone => 'local' );
545 my $current_bill_count = $bill;
546 while ( $current_bill_count ) {
547 $billing_ts->add( seconds_to_interval_hash( $fine_interval ) );
548 $current_bill_count--;
551 my $timestamptz = $billing_ts->strftime('%FT%T%z');
552 if (!$skip_closed_check) {
553 my $dow = $billing_ts->day_of_week_0();
554 my $dow_open = "dow_${dow}_open";
555 my $dow_close = "dow_${dow}_close";
557 if (my $h = $hoo{$c->$circ_lib_method}) {
558 next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00');
561 my @cl = @{$e->search_actor_org_unit_closed_date(
562 { close_start => { '<=' => $timestamptz },
563 close_end => { '>=' => $timestamptz },
564 org_unit => $c->$circ_lib_method }
569 # The billing amount for this billing normally ought to be the recurring fine amount.
570 # However, if the recurring fine amount would cause total fines to exceed the max fine amount,
571 # we may wish to reduce the amount for this billing (if circ.fines.truncate_to_max_fine is true).
572 my $this_billing_amount = $recurring_fine;
573 if ( $truncate_to_max_fine && ($current_fine_total + $this_billing_amount) > $max_fine ) {
574 $this_billing_amount = ($max_fine - $current_fine_total);
576 $current_fine_total += $this_billing_amount;
577 $latest_amount += $this_billing_amount;
578 $latest_billing_ts = $timestamptz;
580 my $bill = Fieldmapper::money::billing->new;
582 $bill->note("System Generated Overdue Fine");
583 $bill->billing_type("Overdue materials");
585 $bill->amount(sprintf('%0.2f', $this_billing_amount/100));
586 $bill->billing_ts($timestamptz);
587 $e->create_money_billing($bill);
591 $conn->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_billing_ts\n" )
592 if ($conn and $latest_billing_ts and $latest_amount);
595 # Calculate penalties inline
596 OpenILS::Utils::Penalty->calculate_penalties(
597 $e, $c->usr, $c->$circ_lib_method);
599 $e->xact_commit if $commit;
605 $conn->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" ) if $conn;
606 $logger->error("Error processing overdue $ctype [".$c->id."]:\n$e\n");
607 last if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
611 # roll back any (potentially) orphaned transaction and disconnect.
612 $e->rollback if $commit;
617 # -----------------------------------------------------------------
618 # Given an editor and a xact, return a reference to an array of
619 # hashrefs that map billing objects to payment objects. Returns undef
620 # if no bills are found for the given transaction.
622 # The bill amounts are adjusted to reflect the application of the
623 # payments to the bills. The original bill amounts are retained in
626 # The payment objects may or may not have their amounts adjusted
627 # depending on whether or not they apply to more than one bill. We
628 # could really use a better logic here, perhaps, but if it was
629 # consistent, it wouldn't be Evergreen.
631 # The data structure used in the array is a hashref that has the
634 # bill => the adjusted bill object
635 # voids => an arrayref of void payments that apply directly to the
637 # payments => an arrayref of payment objects applied to the bill
638 # bill_amount => original amount from the billing object
639 # void_amount => total of the void payments that apply directly to the
642 # Each bill is only mapped to payments one time. However, a single
643 # payment may be mapped to more than one bill if the payment amount is
644 # greater than the amount of each individual bill, such as a $3.00
645 # payment for 30 $0.10 overdue bills. There is an attempt made to
646 # first pay bills with payments that match the billing amount. This
647 # is intended to catch payments for lost and/or long overdue bills so
648 # that they will match up.
650 # This function is heavily adapted from code written by Jeff Godin of
651 # Traverse Area District Library and submitted on LaunchPad bug
653 # -----------------------------------------------------------------
654 sub bill_payment_map_for_xact {
655 my ($class, $e, $xact) = @_;
657 # Check for CStoreEditor and make a new one if we have to. This
658 # allows one-off calls to this subroutine to pass undef as the
659 # CStoreEditor and not have to create one of their own.
660 $e = OpenILS::Utils::CStoreEditor->new unless ($e);
662 # find all bills in order
664 {xact => $xact->id()},
665 { order_by => { mb => { billing_ts => { direction => 'asc' } } } },
668 # At some point, we should get rid of the voided column on
669 # money.payment and family. It is not exposed in the client at
670 # the moment, and should be replaced with a void_bill type. The
671 # descendants of money.payment don't expose the voided field in
672 # the fieldmapper, only the mp object, based on the money.payment
673 # view, does. However, I want to leave that complication for
674 # later. I wonder if I'm not slowing things down too much with
675 # the current adjustment_payment logic. It would probably be faster if
676 # we had direct Pg access at this layer. I can probably wrangle
677 # something via the drivers or store interfaces, but I haven't
678 # really figured those out, yet.
680 my $bills = $e->search_money_billing($bill_search);
682 # return undef if there are no bills.
683 return undef unless ($bills && @$bills);
685 # map the bills into our bill_payment_map entry format:
689 bill_amount => $_->amount(),
696 # Find all unvoided payments in order. Flesh voids so that we
697 # don't have to retrieve them later.
698 my $payments = $e->search_money_payment(
700 { xact => $xact->id, voided=>'f' },
702 order_by => { mp => { payment_ts => { direction => 'asc' } } },
704 flesh_fields => { mp => ['adjustment_payment'] }
709 # If there were no payments, then we just return the bills.
710 return \@entries unless ($payments && @$payments);
712 # Now, we go through the rigmarole of mapping payments to bills
713 # and adjusting the bill balances.
715 # Apply the voids before "paying" other bills.
716 foreach my $entry (@entries) {
717 my $bill = $entry->{bill};
718 # Find only the voids that apply to individual bills.
719 my @voids = map {$_->adjustment_payment()} grep {$_->payment_type() eq 'adjustment_payment' && $_->adjustment_payment()->billing() == $bill->id()} @$payments;
721 foreach my $void (@voids) {
722 my $new_amount = $U->fpdiff($bill->amount(),$void->amount());
723 if ($new_amount >= 0) {
724 push @{$entry->{voids}}, $void;
725 $entry->{void_amount} += $void->amount();
726 $bill->amount($new_amount);
727 # Remove the used up void from list of payments:
728 my @p = grep {$_->id() != $void->id()} @$payments;
731 # It should never happen that we have more void
732 # payments on a single bill than the amount of the
733 # bill. However, experience shows that the things
734 # that should never happen actually do happen with
735 # surprising regularity in a library setting.
737 # Clone the void to say how much of it actually
738 # applied to this bill.
739 my $new_void = $void->clone();
740 $new_void->amount($bill->amount());
741 $new_void->amount_collected($bill->amount());
742 push (@{$entry->{voids}}, $new_void);
743 $entry->{void_amount} += $new_void->amount();
745 $void->amount(-$new_amount);
746 # Could be a candidate for YAOUS about what to do
747 # with excess void amounts on a bill.
749 last if ($bill->amount() == 0);
754 # Try to map payments to bills by amounts starting with the
756 foreach my $payment (sort {$b->amount() <=> $a->amount()} @$payments) {
757 my @bills2pay = grep {$_->{bill}->amount() == $payment->amount()} @entries;
759 my $entry = $bills2pay[0];
760 $entry->{bill}->amount(0);
761 push @{$entry->{payments}}, $payment;
762 # Remove the payment from the master list.
763 my @p = grep {$_->id() != $payment->id()} @$payments;
768 # Map remaining bills to payments in whatever order.
769 foreach my $entry (grep {$_->{bill}->amount() > 0} @entries) {
770 my $bill = $entry->{bill};
771 # We could run out of payments before bills.
772 if ($payments && @$payments) {
773 while ($bill->amount() > 0) {
774 my $payment = shift @$payments;
775 last unless $payment;
776 my $new_amount = $U->fpdiff($bill->amount(),$payment->amount());
777 if ($new_amount < 0) {
778 # Clone the payment so we can say how much applied
780 my $new_payment = $payment->clone();
781 $new_payment->amount($bill->amount());
783 push @{$entry->{payments}}, $new_payment;
784 # Reset the payment amount and put it back on the
785 # list for later use.
786 $payment->amount(-$new_amount);
787 unshift @$payments, $payment;
789 $bill->amount($new_amount);
790 push @{$entry->{payments}}, $payment;
800 # This subroutine actually handles voiding of bills. It takes a
801 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
802 sub real_void_bills {
803 my ($class, $e, $billids, $note) = @_;
804 return $e->die_event unless $e->checkauth;
805 return $e->die_event unless $e->allowed('VOID_BILLING');
808 for my $billid (@$billids) {
810 my $bill = $e->retrieve_money_billing($billid)
811 or return $e->die_event;
813 my $xact = $e->retrieve_money_billable_transaction($bill->xact)
814 or return $e->die_event;
816 if($U->is_true($bill->voided)) {
817 # For now, it is not an error to attempt to re-void a bill, but
818 # don't actually do anything
820 #return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill)
824 my $org = $U->xact_org($bill->xact, $e);
825 $users{$xact->usr} = {} unless $users{$xact->usr};
826 $users{$xact->usr}->{$org} = 1;
829 $bill->voider($e->requestor->id);
830 $bill->void_time('now');
831 my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : "";
832 $bill->note(sprintf("$n%s", ($note) ? $note : "System: VOIDED FOR BACKDATE"));
834 $e->update_money_billing($bill) or return $e->die_event;
835 my $evt = $U->check_open_xact($e, $bill->xact, $xact);
839 # calculate penalties for all user/org combinations
840 for my $user_id (keys %users) {
841 for my $org_id (keys %{$users{$user_id}}) {
842 OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id)
850 # This subroutine actually handles "adjusting" bills to zero. It takes a
851 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
852 sub adjust_bills_to_zero {
853 my ($class, $e, $billids, $note) = @_;
855 # Get with the editor to see if we have permission to void bills.
856 return $e->die_event unless $e->checkauth;
857 return $e->die_event unless $e->allowed('VOID_BILLING');
861 # Let's get all the billing objects and handle them by
864 if (ref($billids->[0])) {
867 $bills = $e->search_money_billing([{id => $billids}])
868 or return $e->die_event;
871 my @xactids = uniq map {$_->xact()} @$bills;
873 foreach my $xactid (@xactids) {
874 my $mbt = $e->retrieve_money_billable_transaction(
880 mbt=>['grocery','circulation'],
881 circ=>['target_copy']
885 ) or return $e->die_event;
886 # Flesh grocery bills and circulations so we don't have to
887 # retrieve them later.
888 my ($circ, $grocery, $copy);
889 $grocery = $mbt->grocery();
890 $circ = $mbt->circulation();
891 $copy = $circ->target_copy() if ($circ);
893 # Retrieve settings based on transaction location and copy
894 # location if we have a circulation.
895 my ($prohibit_neg_balance_default, $prohibit_neg_balance_overdues,
896 $prohibit_neg_balance_lost, $neg_balance_interval_default,
897 $neg_balance_interval_overdues, $neg_balance_interval_lost);
899 # defaults and overdue settings come from transaction org unit.
900 $prohibit_neg_balance_default = $U->ou_ancestor_setting(
901 $circ->circ_lib(), 'bill.prohibit_negative_balance_default');
902 $prohibit_neg_balance_overdues = (
903 $U->ou_ancestor_setting($circ->circ_lib(), 'bill.prohibit_negative_balance_on_overdues')
905 $U->ou_ancestor_setting($circ->circ_lib(), 'bill.prohibit_netgative_balance_default')
907 $neg_balance_interval_default = $U->ou_ancestor_setting(
908 $circ->circ_lib(), 'bill.negative_balance_interval_default');
909 $neg_balance_interval_overdues = (
910 $U->ou_ancestor_setting($circ->circ_lib(), 'bill.negative_balance_interval_on_overdues')
912 $U->ou_ancestor_setting($circ->circ_lib(), 'bill.negative_balance_interval_default')
914 # settings for lost come from copy circlib.
915 $prohibit_neg_balance_lost = (
916 $U->ou_ancestor_setting($copy->circ_lib(), 'bill.prohibit_negative_balance_on_lost')
918 $U->ou_ancestor_setting($copy->circ_lib(), 'bill.prohibit_negative_balance_default')
920 $neg_balance_interval_lost = (
921 $U->ou_ancestor_setting($copy->circ_lib(), 'bill.negative_balance_interval_on_lost')
923 $U->ou_ancestor_setting($copy->circ_lib(), 'bill.negative_balance_interval_default')
926 # We only care about defaults, and they come from the
928 $prohibit_neg_balance_default = $U->ou_ancestor_setting(
929 $grocery->billing_location(), 'bill.prohibit_negative_balance_default');
930 $neg_balance_interval_default = $U->ou_ancestor_setting(
931 $grocery->billing_location(), 'bill.negative_balance_interval_default');
934 # Get the bill_payment_map for the transaction.
935 my $bpmap = $class->bill_payment_map_for_xact($e, $mbt);
937 # Get the bills for this transaction from the main list of bills.
938 my @xact_bills = grep {$_->xact() == $xactid} @$bills;
939 # Handle each bill in turn.
940 foreach my $bill (@xact_bills) {
941 # As the total open amount on the transaction will change
942 # as each bill is voided, we'll just recalculate it for
945 map {$xact_total += $_->{bill}->amount()} @$bpmap;
947 # Get the bill_payment_map entry for this bill:
948 my ($bpentry) = grep {$_->{bill}->id() == $bill->id()} @$bpmap;
950 # From here on out, use the bill object from the bill
952 $bill = $bpentry->{bill};
954 # The amount to void is the non-voided balance on the
955 # bill. It should never be less than zero.
956 my $amount_to_void = $U->fpdiff($bpentry->{bill_amount},$bpentry->{void_amount});
958 # Check if this bill is already voided. We don't allow
959 # "double" voids regardless of settings. The old code
960 # made it impossible to void an already voided bill, so
961 # we're doing the same.
962 if ($amount_to_void <= 0) {
963 my $event = OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
968 # If we're voiding a circulation-related bill we have
971 if ($amount_to_void > $xact_total) {
972 my $btype = $bill->btype();
975 $amount_to_void = $xact_total unless(_check_payment_interval($bpentry, $neg_balance_interval_overdues));
976 $amount_to_void = $xact_total if ($U->is_true($prohibit_neg_balance_overdues));
977 } elsif ($btype == 3 || $btype == 10) {
978 # Lost or Long Overdue
979 $amount_to_void = $xact_total unless(_check_payment_interval($bpentry, $neg_balance_interval_lost));
980 $amount_to_void = $xact_total if ($U->is_true($prohibit_neg_balance_lost));
982 # Any other bill that we're trying to void.
983 $amount_to_void = $xact_total unless(_check_payment_interval($bpentry, $neg_balance_interval_default));
984 $amount_to_void = $xact_total if ($U->is_true($prohibit_neg_balance_default));
988 # Grocery bills are simple by comparison.
989 if ($amount_to_void > $xact_total) {
990 $amount_to_void = $xact_total unless(_check_payment_interval($bpentry, $neg_balance_interval_default));
991 $amount_to_void = $xact_total if ($U->is_true($prohibit_neg_balance_default));
995 # Create the void payment if necessary:
996 if ($amount_to_void > 0) {
997 my $payobj = Fieldmapper::money::adjustment_payment->new;
998 $payobj->amount($amount_to_void);
999 $payobj->amount_collected($amount_to_void);
1000 $payobj->xact($xactid);
1001 $payobj->accepting_usr($e->requestor->id);
1002 $payobj->payment_ts('now');
1003 $payobj->billing($bill->id());
1004 $payobj->note($note) if ($note);
1005 $e->create_money_adjustment_payment($payobj) or return $e->die_event;
1006 # Adjust our bill_payment_map
1007 $bpentry->{void_amount} += $amount_to_void;
1008 push @{$bpentry->{voids}}, $payobj;
1009 # Should come to zero:
1010 my $new_bill_amount = $U->fpdiff($bill->amount(),$amount_to_void);
1011 $bill->amount($new_bill_amount);
1015 my $org = $U->xact_org($xactid, $e);
1016 $users{$mbt->usr} = {} unless $users{$mbt->usr};
1017 $users{$mbt->usr}->{$org} = 1;
1019 my $evt = $U->check_open_xact($e, $xactid, $mbt);
1020 return $evt if $evt;
1023 # calculate penalties for all user/org combinations
1024 for my $user_id (keys %users) {
1025 for my $org_id (keys %{$users{$user_id}}) {
1026 OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
1033 # A helper function to check if the payments on a bill are within the
1034 # range of a given interval. The first argument is the entry hash
1035 # from the bill payment map for the bill to check and the second
1036 # argument is the interval. It returns true (1) if any of the bills
1037 # are within range of the interval, or false (0) otherwise. It also
1038 # returns true if the interval argument is undefined or empty, or if
1039 # the bill has no payments whatsoever. It will return false if the
1040 # entry has no payments other than voids.
1041 sub _check_payment_interval {
1042 my ($entry, $interval) = @_;
1043 my $result = ($interval ? 0 : 1);
1045 # A check to see if we were given the settings hash or the value:
1046 if (ref($interval) eq 'HASH') {
1047 $interval = $interval->{value};
1050 if ($interval && $entry && $entry->{payments} && @{$entry->{payments}}) {
1051 my $interval_secs = interval_to_seconds($interval);
1052 my @pay_dates = map {$_->payment_ts()} sort {$b->payment_ts() cmp $a->payment_ts()} grep {$_->payment_type() ne 'adjustment_payment'} @{$entry->{payments}};
1054 # Since we've sorted the payment dates from highest to
1055 # lowest, we really only need to check the 0th one.
1056 my $payment_date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($pay_dates[0]))->epoch;
1058 $result = 1 if ($payment_date + $interval_secs >= $now);
1060 } elsif ($interval && (!$entry->{payments} || !@{$entry->{payments}})) {