LP 1198465: Clean up terminology
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Circ / CircCommon.pm
1 package OpenILS::Application::Circ::CircCommon;
2 use strict; use warnings;
3 use DateTime;
4 use DateTime::Format::ISO8601;
5 use OpenILS::Application::AppUtils;
6 use OpenSRF::Utils qw/:datetime/;
7 use OpenILS::Event;
8 use OpenSRF::Utils::Logger qw(:logger);
9 use OpenILS::Utils::CStoreEditor q/:funcs/;
10 use OpenILS::Const qw/:const/;
11 use POSIX qw(ceil);
12 use List::MoreUtils qw(uniq);
13
14 my $U = "OpenILS::Application::AppUtils";
15 my $parser = DateTime::Format::ISO8601->new;
16
17 # -----------------------------------------------------------------
18 # Do not publish methods here.  This code is shared across apps.
19 # -----------------------------------------------------------------
20
21
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
26 # overdue fines.
27 # -----------------------------------------------------------------
28 sub void_overdues {
29 #compatibility layer - TODO
30 }
31 sub void_or_zero_overdues {
32     my($class, $e, $circ, $opts) = @_;
33
34     my $bill_search = { 
35         xact => $circ->id, 
36         btype => 1 
37     };
38
39     if( $opts->{backdate} ) {
40         my $backdate = $opts->{backdate};
41         # ------------------------------------------------------------------
42         # Fines for overdue materials are assessed up to, but not including,
43         # one fine interval after the fines are applicable.  Here, we add
44         # one fine interval to the backdate to ensure that we are not 
45         # voiding fines that were applicable before the backdate.
46         # ------------------------------------------------------------------
47
48         # if there is a raw time component (e.g. from postgres), 
49         # turn it into an interval that interval_to_seconds can parse
50         my $duration = $circ->fine_interval;
51         $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
52         my $interval = OpenSRF::Utils->interval_to_seconds($duration);
53
54         my $date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($backdate));
55         my $due_date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($circ->due_date))->epoch;
56         my $grace_period = extend_grace_period( $class, $circ->circ_lib, $circ->due_date, OpenSRF::Utils->interval_to_seconds($circ->grace_period), $e);
57         if($date->epoch <= $due_date + $grace_period) {
58             $logger->info("backdate $backdate is within grace period, voiding all");
59         } else {
60             $backdate = $U->epoch2ISO8601($date->epoch + $interval);
61             $logger->info("applying backdate $backdate in overdue voiding");
62             $$bill_search{billing_ts} = {'>=' => $backdate};
63         }
64     }
65
66     my $billids = $e->search_money_billing([$bill_search, {idlist=>1}]);
67     if ($billids && @$billids) {
68         # overdue settings come from transaction org unit
69         my $prohibit_neg_balance_overdues = (
70             $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.prohibit_negative_balance_on_overdues')
71             ||
72             $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.prohibit_negative_balance_default')
73         );
74         my $neg_balance_interval_overdues = (
75             $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.negative_balance_interval_on_overdues')
76             ||
77             $U->ou_ancestor_setting_value($circ->circ_lib(), 'bill.negative_balance_interval_default')
78         );
79         my $result;
80         # if we prohibit negative overdue balances and all payments
81         # are outside the refund interval (if given), zero the transaction
82         if ($opts->{force_zero}
83             or (!$opts->{force_void}
84                 and (
85                     $U->is_true($prohibit_neg_balance_overdues)
86                     and !_has_refundable_payments($e, $circ->id, $neg_balance_interval_overdues)
87                 )
88             )
89         ) {
90             $result = $class->adjust_bills_to_zero($e, $billids, $opts->{note}, $neg_balance_interval_overdues);
91         } else {
92             # otherwise, just void the usual way
93             $result = $class->void_bills($e, $billids, $opts->{note});
94         }
95         if (ref($result)) {
96             return $result;
97         }
98     }
99
100     return undef;
101 }
102
103 # ------------------------------------------------------------------
104 # remove charge from patron's account if lost item is returned
105 # ------------------------------------------------------------------
106 sub void_lost {
107     my ($class, $e, $circ, $btype) = @_;
108
109     my $bills = $e->search_money_billing(
110         {
111             xact => $circ->id,
112             btype => $btype,
113             voided => 'f'
114         }
115     );
116
117     $logger->debug("voiding lost item charge of  ".scalar(@$bills));
118     for my $bill (@$bills) {
119         if( !$U->is_true($bill->voided) ) {
120             $logger->info("lost item returned - voiding bill ".$bill->id);
121             $bill->voided('t');
122             $bill->void_time('now');
123             $bill->voider($e->requestor->id);
124             my $note = ($bill->note) ? $bill->note . "\n" : '';
125             $bill->note("${note}System: VOIDED FOR LOST ITEM RETURNED");
126
127             return $e->event
128                 unless $e->update_money_billing($bill);
129         }
130     }
131     return undef;
132 }
133
134 # ------------------------------------------------------------------
135 # Void (or zero) all bills of a given type on a circulation.
136 #
137 # Takes an editor, a circ object, the btype number for the bills you
138 # want to void, and an optional note.
139 #
140 # Returns undef on success or the result from void_bills.
141 # ------------------------------------------------------------------
142 sub void_or_zero_bills_of_type {
143     my ($class, $e, $circ, $copy, $btype, $for_note) = @_;
144
145     my $billids = $e->search_money_billing(
146         {xact => $circ->id(), btype => $btype},
147         {idlist=>1}
148     );
149     if ($billids && @$billids) {
150         # settings for lost come from copy circlib.
151         my $prohibit_neg_balance_lost = (
152             $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.prohibit_negative_balance_on_lost')
153             ||
154             $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.prohibit_negative_balance_default')
155         );
156         my $neg_balance_interval_lost = (
157             $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.negative_balance_interval_on_lost')
158             ||
159             $U->ou_ancestor_setting_value($copy->circ_lib(), 'bill.negative_balance_interval_default')
160         );
161         my $result;
162         if (
163             $U->is_true($prohibit_neg_balance_lost)
164             and !_has_refundable_payments($e, $circ->id, $neg_balance_interval_lost)
165         ) {
166             $result = $class->adjust_bills_to_zero($e, $billids, "System: ADJUSTED $for_note");
167         } else {
168             $result = $class->void_bills($e, $billids, "System: VOIDED $for_note");
169         }
170         if (ref($result)) {
171             return $result;
172         }
173     }
174
175     return undef;
176 }
177
178 sub reopen_xact {
179     my($class, $e, $xactid) = @_;
180
181     # -----------------------------------------------------------------
182     # make sure the transaction is not closed
183     my $xact = $e->retrieve_money_billable_transaction($xactid)
184         or return $e->die_event;
185
186     if( $xact->xact_finish ) {
187         my ($mbts) = $U->fetch_mbts($xactid, $e);
188         if( $mbts->balance_owed != 0 ) {
189             $logger->info("* re-opening xact $xactid, orig xact_finish is ".$xact->xact_finish);
190             $xact->clear_xact_finish;
191             $e->update_money_billable_transaction($xact)
192                 or return $e->die_event;
193         } 
194     }
195
196     return undef;
197 }
198
199
200 sub create_bill {
201     my($class, $e, $amount, $btype, $type, $xactid, $note, $billing_ts) = @_;
202
203     $logger->info("The system is charging $amount [$type] on xact $xactid");
204     $note ||= 'SYSTEM GENERATED';
205
206     # -----------------------------------------------------------------
207     # now create the billing
208     my $bill = Fieldmapper::money::billing->new;
209     $bill->xact($xactid);
210     $bill->amount($amount);
211     $bill->billing_ts($billing_ts);
212     $bill->billing_type($type); 
213     $bill->btype($btype); 
214     $bill->note($note);
215     $e->create_money_billing($bill) or return $e->die_event;
216
217     return undef;
218 }
219
220 sub extend_grace_period {
221     my($class, $circ_lib, $due_date, $grace_period, $e, $h) = @_;
222     if ($grace_period >= 86400) { # Only extend grace periods greater than or equal to a full day
223         my $parser = DateTime::Format::ISO8601->new;
224         my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $due_date ) );
225         my $due = $due_dt->epoch;
226
227         my $grace_extend = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend');
228         $e = new_editor() if (!$e);
229         $h = $e->retrieve_actor_org_unit_hours_of_operation($circ_lib) if (!$h);
230         if ($grace_extend and $h) { 
231             my $new_grace_period = $grace_period;
232
233             $logger->info( "Circ lib has an hours-of-operation entry and grace period extension is enabled." );
234
235             my $closed = 0;
236             my %h_closed = {};
237             for my $i (0 .. 6) {
238                 my $dow_open = "dow_${i}_open";
239                 my $dow_close = "dow_${i}_close";
240                 if($h->$dow_open() eq '00:00:00' and $h->$dow_close() eq '00:00:00') {
241                     $closed++;
242                     $h_closed{$i} = 1;
243                 } else {
244                     $h_closed{$i} = 0;
245                 }
246             }
247
248             if($closed == 7) {
249                 $logger->info("Circ lib is closed all week according to hours-of-operation entry. Skipping grace period extension checks.");
250             } else {
251                 # Extra nice grace periods
252                 # AKA, merge closed dates trailing the grace period into the grace period
253                 my $grace_extend_into_closed = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.into_closed');
254                 $due += 86400 if $grace_extend_into_closed;
255
256                 my $grace_extend_all = $U->ou_ancestor_setting_value($circ_lib, 'circ.grace.extend.all');
257
258                 if ( $grace_extend_all ) {
259                     # Start checking the day after the item was due
260                     # This is "The grace period only counts open days"
261                     # NOTE: Adding 86400 seconds is not the same as adding one day. This uses seconds intentionally.
262                     $due_dt = $due_dt->add( seconds => 86400 );
263                 } else {
264                     # Jump to the end of the grace period
265                     # This is "If the grace period ends on a closed day extend it"
266                     # NOTE: This adds grace period as a number of seconds intentionally
267                     $due_dt = $due_dt->add( seconds => $grace_period );
268                 }
269
270                 my $count = 0; # Infinite loop protection
271                 do {
272                     $closed = 0; # Starting assumption for day: We are not closed
273                     $count++; # We limit the number of loops below.
274
275                     # get the day of the week for the day we are looking at
276                     my $dow = $due_dt->day_of_week_0;
277
278                     # Check hours of operation first.
279                     if ($h_closed{$dow}) {
280                         $closed = 1;
281                         $new_grace_period += 86400;
282                         $due_dt->add( seconds => 86400 );
283                     } else {
284                         # Check for closed dates for this period
285                         my $timestamptz = $due_dt->strftime('%FT%T%z');
286                         my $cl = $e->search_actor_org_unit_closed_date(
287                                 { close_start => { '<=' => $timestamptz },
288                                   close_end   => { '>=' => $timestamptz },
289                                   org_unit    => $circ_lib }
290                         );
291                         if ($cl and @$cl) {
292                             $closed = 1;
293                             foreach (@$cl) {
294                                 my $cl_dt = $parser->parse_datetime( cleanse_ISO8601( $_->close_end ) );
295                                 while ($due_dt <= $cl_dt) {
296                                     $due_dt->add( seconds => 86400 );
297                                     $new_grace_period += 86400;
298                                 }
299                             }
300                         } else {
301                             $due_dt->add( seconds => 86400 );
302                         }
303                     }
304                 } while ( $count <= 366 and ( $closed or $due_dt->epoch <= $due + $new_grace_period ) );
305                 if ($new_grace_period > $grace_period) {
306                     $grace_period = $new_grace_period;
307                     $logger->info( "Grace period for circ extended to $grace_period [" . seconds_to_interval( $grace_period ) . "]" );
308                 }
309             }
310         }
311     }
312     return $grace_period;
313 }
314
315 # check if a circulation transaction can be closed
316 # takes a CStoreEditor and a circ transaction.
317 # Returns 1 if the circ should be closed, 0 if not.
318 sub can_close_circ {
319     my ($class, $e, $circ) = @_;
320     my $can_close = 0;
321
322     my $reason = $circ->stop_fines;
323
324     # We definitely want to close if this circulation was
325     # checked in or renewed.
326     if ($circ->checkin_time) {
327         $can_close = 1;
328     } elsif ($reason eq OILS_STOP_FINES_LOST) {
329         # Check the copy circ_lib to see if they close
330         # transactions when lost are paid.
331         my $copy = $e->retrieve_asset_copy($circ->target_copy);
332         if ($copy) {
333             $can_close = !$U->is_true(
334                 $U->ou_ancestor_setting_value(
335                     $copy->circ_lib,
336                     'circ.lost.xact_open_on_zero',
337                     $e
338                 )
339             );
340         }
341
342     } elsif ($reason eq OILS_STOP_FINES_LONGOVERDUE) {
343         # Check the copy circ_lib to see if they close
344         # transactions when long-overdue are paid.
345         my $copy = $e->retrieve_asset_copy($circ->target_copy);
346         if ($copy) {
347             $can_close = !$U->is_true(
348                 $U->ou_ancestor_setting_value(
349                     $copy->circ_lib,
350                     'circ.longoverdue.xact_open_on_zero',
351                     $e
352                 )
353             );
354         }
355     }
356
357     return $can_close;
358 }
359
360 sub seconds_to_interval_hash {
361         my $interval = shift;
362         my $limit = shift || 's';
363         $limit =~ s/^(.)/$1/o;
364
365         my %output;
366
367         my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s);
368         my ($year, $month, $week, $day, $hour, $minute, $second) =
369                 ('years','months','weeks','days', 'hours', 'minutes', 'seconds');
370
371         if ($y = int($interval / (60 * 60 * 24 * 365))) {
372                 $output{$year} = $y;
373                 $ym = $interval % (60 * 60 * 24 * 365);
374         } else {
375                 $ym = $interval;
376         }
377         return %output if ($limit eq 'y');
378
379         if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
380                 $output{$month} = $M;
381                 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
382         } else {
383                 $Mm = $ym;
384         }
385         return %output if ($limit eq 'M');
386
387         if ($w = int($Mm / 604800)) {
388                 $output{$week} = $w;
389                 $wm = $Mm % 604800;
390         } else {
391                 $wm = $Mm;
392         }
393         return %output if ($limit eq 'w');
394
395         if ($d = int($wm / 86400)) {
396                 $output{$day} = $d;
397                 $dm = $wm % 86400;
398         } else {
399                 $dm = $wm;
400         }
401         return %output if ($limit eq 'd');
402
403         if ($h = int($dm / 3600)) {
404                 $output{$hour} = $h;
405                 $hm = $dm % 3600;
406         } else {
407                 $hm = $dm;
408         }
409         return %output if ($limit eq 'h');
410
411         if ($m = int($hm / 60)) {
412                 $output{$minute} = $m;
413                 $mm = $hm % 60;
414         } else {
415                 $mm = $hm;
416         }
417         return %output if ($limit eq 'm');
418
419         if ($s = int($mm)) {
420                 $output{$second} = $s;
421         } else {
422                 $output{$second} = 0 unless (keys %output);
423         }
424         return %output;
425 }
426
427 sub generate_fines {
428     my ($class, $args) = @_;
429     my $circs = $args->{circs};
430     return unless $circs and @$circs;
431     my $e = $args->{editor};
432     # if a client connection is passed in, this will be chatty like
433     # the old storage version
434     my $conn = $args->{conn};
435
436     my $commit = 0;
437     unless ($e) {
438         # Transactions are opened/closed with each circ, reservation, etc.
439         # The first $e->xact_begin (below) will cause a connect.
440         $e = new_editor();
441         $commit = 1;
442     }
443
444     my %hoo = map { ( $_->id => $_ ) } @{ $e->retrieve_all_actor_org_unit_hours_of_operation };
445
446     my $handling_resvs = 0;
447     for my $c (@$circs) {
448
449         my $ctype = ref($c);
450
451         if (!$ctype) { # we received only an idlist, not objects
452             if ($handling_resvs) {
453                 $c = $e->retrieve_booking_reservation($c);
454             } elsif (not defined $c) {
455                 # an undef value is the indicator that we are moving
456                 # from processing circulations to reservations.
457                 $handling_resvs = 1;
458                 next;
459             } else {
460                 $c = $e->retrieve_action_circulation($c);
461             }
462             $ctype = ref($c);
463         }
464
465         $ctype =~ s/^.+::(\w+)$/$1/;
466     
467         my $due_date_method = 'due_date';
468         my $target_copy_method = 'target_copy';
469         my $circ_lib_method = 'circ_lib';
470         my $recurring_fine_method = 'recurring_fine';
471         my $is_reservation = 0;
472         if ($ctype eq 'reservation') {
473             $is_reservation = 1;
474             $due_date_method = 'end_time';
475             $target_copy_method = 'current_resource';
476             $circ_lib_method = 'pickup_lib';
477             $recurring_fine_method = 'fine_amount';
478             next unless ($c->fine_interval);
479         }
480         #TODO: reservation grace periods
481         my $grace_period = ($is_reservation ? 0 : interval_to_seconds($c->grace_period));
482
483         eval {
484
485             # Clean up after previous transaction.  
486             # This is a no-op if there is no open transaction.
487             $e->xact_rollback if $commit;
488
489             $logger->info(sprintf("Processing $ctype %d...", $c->id));
490
491             # each (ils) transaction is processed in its own (db) transaction
492             $e->xact_begin if $commit;
493
494             my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $c->$due_date_method ) );
495     
496             my $due = $due_dt->epoch;
497             my $now = time;
498
499             my $fine_interval = $c->fine_interval;
500             $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
501             $fine_interval = interval_to_seconds( $fine_interval );
502     
503             if ( $fine_interval == 0 || int($c->$recurring_fine_method * 100) == 0 || int($c->max_fine * 100) == 0 ) {
504                 $conn->respond( "Fine Generator skipping circ due to 0 fine interval, 0 fine rate, or 0 max fine.\n" ) if $conn;
505                 $logger->info( "Fine Generator skipping circ " . $c->id . " due to 0 fine interval, 0 fine rate, or 0 max fine." );
506                 return;
507             }
508
509             if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) {    
510                 my $tz_offset_s = 0;
511                 if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) {
512                     $tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m"); 
513                 }
514     
515                 $due -= ($due % $fine_interval) + $tz_offset_s;
516                 $now -= ($now % $fine_interval) + $tz_offset_s;
517             }
518     
519             $conn->respond(
520                 "ARG! Overdue $ctype ".$c->id.
521                 " for item ".$c->$target_copy_method.
522                 " (user ".$c->usr.").\n".
523                 "\tItem was due on or before: ".localtime($due)."\n") if $conn;
524     
525             my @fines = @{$e->search_money_billing([
526                 { xact => $c->id,
527                   btype => 1,
528                   billing_ts => { '>' => $c->$due_date_method } },
529                 { order_by => {mb => 'billing_ts DESC'}}
530             ])};
531
532             my $f_idx = 0;
533             my $fine = $fines[$f_idx] if (@fines);
534             my $current_fine_total = 0;
535             $current_fine_total += int($_->amount * 100) for (grep { $_ and !$U->is_true($_->voided) } @fines);
536     
537             my $last_fine;
538             if ($fine) {
539                 $conn->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".cleanse_ISO8601( $fine->billing_ts ).")") if $conn;
540                 $last_fine = $parser->parse_datetime( cleanse_ISO8601( $fine->billing_ts ) )->epoch;
541             } else {
542                 $logger->info( "Potential first billing for circ ".$c->id );
543                 $last_fine = $due;
544
545                 $grace_period = extend_grace_period($class, $c->$circ_lib_method,$c->$due_date_method,$grace_period,undef,$hoo{$c->$circ_lib_method});
546             }
547
548             return if ($last_fine > $now);
549             # Generate fines for each past interval, including the one we are inside
550             my $pending_fine_count = ceil( ($now - $last_fine) / $fine_interval );
551
552             if ( $last_fine == $due                         # we have no fines yet
553                  && $grace_period                           # and we have a grace period
554                  && $now < $due + $grace_period             # and some date math says were are within the grace period
555             ) {
556                 $conn->respond( "Still inside grace period of: ". seconds_to_interval( $grace_period )."\n" ) if $conn;
557                 $logger->info( "Circ ".$c->id." is still inside grace period of: $grace_period [". seconds_to_interval( $grace_period ).']' );
558                 return;
559             }
560
561             $conn->respond( "\t$pending_fine_count pending fine(s)\n" ) if $conn;
562             return unless ($pending_fine_count);
563
564             my $recurring_fine = int($c->$recurring_fine_method * 100);
565             my $max_fine = int($c->max_fine * 100);
566
567             my $skip_closed_check = $U->ou_ancestor_setting_value(
568                 $c->$circ_lib_method, 'circ.fines.charge_when_closed');
569             $skip_closed_check = $U->is_true($skip_closed_check);
570
571             my $truncate_to_max_fine = $U->ou_ancestor_setting_value(
572                 $c->$circ_lib_method, 'circ.fines.truncate_to_max_fine');
573             $truncate_to_max_fine = $U->is_true($truncate_to_max_fine);
574
575             my ($latest_billing_ts, $latest_amount) = ('',0);
576             for (my $bill = 1; $bill <= $pending_fine_count; $bill++) {
577     
578                 if ($current_fine_total >= $max_fine) {
579                     if ($ctype eq 'circulation') {
580                         $c->stop_fines('MAXFINES');
581                         $c->stop_fines_time('now');
582                         $e->update_action_circulation($c);
583                     }
584                     $conn->respond(
585                         "\tMaximum fine level of ".$c->max_fine.
586                         " reached for this $ctype.\n".
587                         "\tNo more fines will be generated.\n" ) if $conn;
588                     last;
589                 }
590                 
591                 # XXX Use org time zone (or default to 'local') once we have the ou setting built for that
592                 my $billing_ts = DateTime->from_epoch( epoch => $last_fine, time_zone => 'local' );
593                 my $current_bill_count = $bill;
594                 while ( $current_bill_count ) {
595                     $billing_ts->add( seconds_to_interval_hash( $fine_interval ) );
596                     $current_bill_count--;
597                 }
598
599                 my $timestamptz = $billing_ts->strftime('%FT%T%z');
600                 if (!$skip_closed_check) {
601                     my $dow = $billing_ts->day_of_week_0();
602                     my $dow_open = "dow_${dow}_open";
603                     my $dow_close = "dow_${dow}_close";
604
605                     if (my $h = $hoo{$c->$circ_lib_method}) {
606                         next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00');
607                     }
608     
609                     my @cl = @{$e->search_actor_org_unit_closed_date(
610                             { close_start   => { '<=' => $timestamptz },
611                               close_end => { '>=' => $timestamptz },
612                               org_unit  => $c->$circ_lib_method }
613                     )};
614                     next if (@cl);
615                 }
616
617                 # The billing amount for this billing normally ought to be the recurring fine amount.
618                 # However, if the recurring fine amount would cause total fines to exceed the max fine amount,
619                 # we may wish to reduce the amount for this billing (if circ.fines.truncate_to_max_fine is true).
620                 my $this_billing_amount = $recurring_fine;
621                 if ( $truncate_to_max_fine && ($current_fine_total + $this_billing_amount) > $max_fine ) {
622                     $this_billing_amount = ($max_fine - $current_fine_total);
623                 }
624                 $current_fine_total += $this_billing_amount;
625                 $latest_amount += $this_billing_amount;
626                 $latest_billing_ts = $timestamptz;
627
628                 my $bill = Fieldmapper::money::billing->new;
629                 $bill->xact($c->id);
630                 $bill->note("System Generated Overdue Fine");
631                 $bill->billing_type("Overdue materials");
632                 $bill->btype(1);
633                 $bill->amount(sprintf('%0.2f', $this_billing_amount/100));
634                 $bill->billing_ts($timestamptz);
635                 $e->create_money_billing($bill);
636
637             }
638
639             $conn->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_billing_ts\n" )
640                 if ($conn and $latest_billing_ts and $latest_amount);
641
642
643             # Calculate penalties inline
644             OpenILS::Utils::Penalty->calculate_penalties(
645                 $e, $c->usr, $c->$circ_lib_method);
646
647             $e->xact_commit if $commit;
648
649         };
650
651         if ($@) {
652             my $e = $@;
653             $conn->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" ) if $conn;
654             $logger->error("Error processing overdue $ctype [".$c->id."]:\n$e\n");
655             last if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
656         }
657     }
658
659     # roll back any (potentially) orphaned transaction and disconnect.
660     $e->rollback if $commit;
661
662     return undef;
663 }
664
665 # -----------------------------------------------------------------
666 # Given an editor and a xact, return a reference to an array of
667 # hashrefs that map billing objects to payment objects.  Returns undef
668 # if no bills are found for the given transaction.
669 #
670 # The bill amounts are adjusted to reflect the application of the
671 # payments to the bills.  The original bill amounts are retained in
672 # the mapping.
673 #
674 # The payment objects may or may not have their amounts adjusted
675 # depending on whether or not they apply to more than one bill.  We
676 # could really use a better logic here, perhaps, but if it was
677 # consistent, it wouldn't be Evergreen.
678 #
679 # The data structure used in the array is a hashref that has the
680 # following fields:
681 #
682 # bill => the adjusted bill object
683 # adjustments => an arrayref of adjustment payments that apply directly
684 #                to the bill
685 # payments => an arrayref of payment objects applied to the bill
686 # bill_amount => original amount from the billing object
687 # adjustment_amount => total of the adjustment payments that apply
688 #                      directly to the bill
689 #
690 # Each bill is only mapped to payments one time.  However, a single
691 # payment may be mapped to more than one bill if the payment amount is
692 # greater than the amount of each individual bill, such as a $3.00
693 # payment for 30 $0.10 overdue bills.  There is an attempt made to
694 # first pay bills with payments that match the billing amount.  This
695 # is intended to catch payments for lost and/or long overdue bills so
696 # that they will match up.
697 #
698 # This function is heavily adapted from code written by Jeff Godin of
699 # Traverse Area District Library and submitted on LaunchPad bug
700 # #1009049.
701 # -----------------------------------------------------------------
702 sub bill_payment_map_for_xact {
703     my ($class, $e, $xact) = @_;
704
705     # Check for CStoreEditor and make a new one if we have to. This
706     # allows one-off calls to this subroutine to pass undef as the
707     # CStoreEditor and not have to create one of their own.
708     $e = OpenILS::Utils::CStoreEditor->new unless ($e);
709
710     # find all bills in order
711     my $bill_search = [
712         { xact => $xact->id(), voided => 'f' },
713         { order_by => { mb => { billing_ts => { direction => 'asc' } } } },
714     ];
715
716     # At some point, we should get rid of the voided column on
717     # money.payment and family.  It is not exposed in the client at
718     # the moment, and should be replaced with a void_bill type.  The
719     # descendants of money.payment don't expose the voided field in
720     # the fieldmapper, only the mp object, based on the money.payment
721     # view, does.  However, I want to leave that complication for
722     # later.  I wonder if I'm not slowing things down too much with
723     # the current adjustment_payment logic.  It would probably be faster if
724     # we had direct Pg access at this layer.  I can probably wrangle
725     # something via the drivers or store interfaces, but I haven't
726     # really figured those out, yet.
727
728     my $bills = $e->search_money_billing($bill_search);
729
730     # return undef if there are no bills.
731     return undef unless ($bills && @$bills);
732
733     # map the bills into our bill_payment_map entry format:
734     my @entries = map {
735         {
736             bill => $_,
737             bill_amount => $_->amount(),
738             payments => [],
739             adjustments => [],
740             adjustment_amount => 0
741         }
742     } @$bills;
743
744     # Find all unvoided payments in order.  Flesh adjustment payments
745     # so that we don't have to retrieve them later.
746     my $payments = $e->search_money_payment(
747         [
748             { xact => $xact->id, voided=>'f' },
749             {
750                 order_by => { mp => { payment_ts => { direction => 'asc' } } },
751                 flesh => 1,
752                 flesh_fields => { mp => ['adjustment_payment'] }
753             }
754         ]
755     );
756
757     # If there were no payments, then we just return the bills.
758     return \@entries unless ($payments && @$payments);
759
760     # Now, we go through the rigmarole of mapping payments to bills
761     # and adjusting the bill balances.
762
763     # Apply the adjustments before "paying" other bills.
764     foreach my $entry (@entries) {
765         my $bill = $entry->{bill};
766         # Find only the adjustments that apply to individual bills.
767         my @adjustments = map {$_->adjustment_payment()} grep {$_->payment_type() eq 'adjustment_payment' && $_->adjustment_payment()->billing() == $bill->id()} @$payments;
768         if (@adjustments) {
769             foreach my $adjustment (@adjustments) {
770                 my $new_amount = $U->fpdiff($bill->amount(),$adjustment->amount());
771                 if ($new_amount >= 0) {
772                     push @{$entry->{adjustments}}, $adjustment;
773                     $entry->{adjustment_amount} += $adjustment->amount();
774                     $bill->amount($new_amount);
775                     # Remove the used up adjustment from list of payments:
776                     my @p = grep {$_->id() != $adjustment->id()} @$payments;
777                     $payments = \@p;
778                 } else {
779                     # It should never happen that we have more adjustment
780                     # payments on a single bill than the amount of the
781                     # bill.  However, experience shows that the things
782                     # that should never happen actually do happen with
783                     # surprising regularity in a library setting.
784
785                     # Clone the adjustment to say how much of it actually
786                     # applied to this bill.
787                     my $new_adjustment = $adjustment->clone();
788                     $new_adjustment->amount($bill->amount());
789                     $new_adjustment->amount_collected($bill->amount());
790                     push (@{$entry->{adjustments}}, $new_adjustment);
791                     $entry->{adjustment_amount} += $new_adjustment->amount();
792                     $bill->amount(0);
793                     $adjustment->amount(-$new_amount);
794                     # Could be a candidate for YAOUS about what to do
795                     # with excess adjustment amounts on a bill.
796                 }
797                 last if ($bill->amount() == 0);
798             }
799         }
800     }
801
802     # Try to map payments to bills by amounts starting with the
803     # largest payments:
804     foreach my $payment (sort {$b->amount() <=> $a->amount()} @$payments) {
805         my @bills2pay = grep {$_->{bill}->amount() == $payment->amount()} @entries;
806         if (@bills2pay) {
807             my $entry = $bills2pay[0];
808             $entry->{bill}->amount(0);
809             push @{$entry->{payments}}, $payment;
810             # Remove the payment from the master list.
811             my @p = grep {$_->id() != $payment->id()} @$payments;
812             $payments = \@p;
813         }
814     }
815
816     # Map remaining bills to payments in whatever order.
817     foreach  my $entry (grep {$_->{bill}->amount() > 0} @entries) {
818         my $bill = $entry->{bill};
819         # We could run out of payments before bills.
820         if ($payments && @$payments) {
821             while ($bill->amount() > 0) {
822                 my $payment = shift @$payments;
823                 last unless $payment;
824                 my $new_amount = $U->fpdiff($bill->amount(),$payment->amount());
825                 if ($new_amount < 0) {
826                     # Clone the payment so we can say how much applied
827                     # to this bill.
828                     my $new_payment = $payment->clone();
829                     $new_payment->amount($bill->amount());
830                     $bill->amount(0);
831                     push @{$entry->{payments}}, $new_payment;
832                     # Reset the payment amount and put it back on the
833                     # list for later use.
834                     $payment->amount(-$new_amount);
835                     unshift @$payments, $payment;
836                 } else {
837                     $bill->amount($new_amount);
838                     push @{$entry->{payments}}, $payment;
839                 }
840             }
841         }
842     }
843
844     return \@entries;
845 }
846
847
848 # This subroutine actually handles voiding of bills.  It takes a
849 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
850 sub void_bills {
851     my ($class, $e, $billids, $note) = @_;
852     return $e->die_event unless $e->checkauth;
853     return $e->die_event unless $e->allowed('VOID_BILLING');
854
855     my %users;
856     my $bills;
857     if (ref($billids->[0])) {
858         $bills = $billids;
859     } else {
860         $bills = $e->search_money_billing([{id => $billids}])
861             or return $e->die_event;
862     }
863     for my $bill (@$bills) {
864
865         my $xact = $e->retrieve_money_billable_transaction($bill->xact)
866             or return $e->die_event;
867
868         if($U->is_true($bill->voided)) {
869             # For now, it is not an error to attempt to re-void a bill, but
870             # don't actually do anything
871             #$e->rollback;
872             #return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill)
873             next;
874         }
875
876         my $org = $U->xact_org($bill->xact, $e);
877         $users{$xact->usr} = {} unless $users{$xact->usr};
878         $users{$xact->usr}->{$org} = 1;
879
880         $bill->voided('t');
881         $bill->voider($e->requestor->id);
882         $bill->void_time('now');
883         my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : "";
884         $bill->note(sprintf("$n%s", ($note) ? $note : "System: VOIDED FOR BACKDATE"));
885
886         $e->update_money_billing($bill) or return $e->die_event;
887         my $evt = $U->check_open_xact($e, $bill->xact, $xact);
888         return $evt if $evt;
889     }
890
891     # calculate penalties for all user/org combinations
892     for my $user_id (keys %users) {
893         for my $org_id (keys %{$users{$user_id}}) {
894             OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id)
895         }
896     }
897
898     return 1;
899 }
900
901
902 # This subroutine actually handles "adjusting" bills to zero.  It takes a
903 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
904 sub adjust_bills_to_zero {
905     my ($class, $e, $billids, $note) = @_;
906
907     # Get with the editor to see if we have permission to void bills.
908     return $e->die_event unless $e->checkauth;
909     return $e->die_event unless $e->allowed('VOID_BILLING');
910
911     my %users;
912
913     # Let's get all the billing objects and handle them by
914     # transaction.
915     my $bills;
916     if (ref($billids->[0])) {
917         $bills = $billids;
918     } else {
919         $bills = $e->search_money_billing([{id => $billids}])
920             or return $e->die_event;
921     }
922
923     my @xactids = uniq map {$_->xact()} @$bills;
924
925     foreach my $xactid (@xactids) {
926         my $mbt = $e->retrieve_money_billable_transaction(
927             [
928                 $xactid,
929                 {
930                     flesh=> 2,
931                     flesh_fields=> {
932                         mbt=>['grocery','circulation'],
933                         circ=>['target_copy']
934                     }
935                 }
936             ]
937         ) or return $e->die_event;
938         # Flesh grocery bills and circulations so we don't have to
939         # retrieve them later.
940         my ($circ, $grocery, $copy);
941         $grocery = $mbt->grocery();
942         $circ = $mbt->circulation();
943         $copy = $circ->target_copy() if ($circ);
944
945
946
947         # Get the bill_payment_map for the transaction.
948         my $bpmap = $class->bill_payment_map_for_xact($e, $mbt);
949
950         # Get the bills for this transaction from the main list of bills.
951         my @xact_bills = grep {$_->xact() == $xactid} @$bills;
952         # Handle each bill in turn.
953         foreach my $bill (@xact_bills) {
954             # As the total open amount on the transaction will change
955             # as each bill is adjusted, we'll just recalculate it for
956             # each bill.
957             my $xact_total = 0;
958             map {$xact_total += $_->{bill}->amount()} @$bpmap;
959             last if $xact_total == 0;
960
961             # Get the bill_payment_map entry for this bill:
962             my ($bpentry) = grep {$_->{bill}->id() == $bill->id()} @$bpmap;
963
964             # From here on out, use the bill object from the bill
965             # payment map entry.
966             $bill = $bpentry->{bill};
967
968             # The amount to adjust is the non-adjusted balance on the
969             # bill. It should never be less than zero.
970             my $amount_to_adjust = $U->fpdiff($bpentry->{bill_amount},$bpentry->{adjustment_amount});
971
972             # Check if this bill is already adjusted.  We don't allow
973             # "double" adjustments regardless of settings.
974             if ($amount_to_adjust <= 0) {
975                 #my $event = OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
976                 #$e->event($event);
977                 #return $event;
978                 next;
979             }
980
981             if ($amount_to_adjust > $xact_total) {
982                 $amount_to_adjust = $xact_total;
983             }
984
985             # Create the adjustment payment
986             my $payobj = Fieldmapper::money::adjustment_payment->new;
987             $payobj->amount($amount_to_adjust);
988             $payobj->amount_collected($amount_to_adjust);
989             $payobj->xact($xactid);
990             $payobj->accepting_usr($e->requestor->id);
991             $payobj->payment_ts('now');
992             $payobj->billing($bill->id());
993             $payobj->note($note) if ($note);
994             $e->create_money_adjustment_payment($payobj) or return $e->die_event;
995             # Adjust our bill_payment_map
996             $bpentry->{adjustment_amount} += $amount_to_adjust;
997             push @{$bpentry->{adjustments}}, $payobj;
998             # Should come to zero:
999             my $new_bill_amount = $U->fpdiff($bill->amount(),$amount_to_adjust);
1000             $bill->amount($new_bill_amount);
1001         }
1002
1003         my $org = $U->xact_org($xactid, $e);
1004         $users{$mbt->usr} = {} unless $users{$mbt->usr};
1005         $users{$mbt->usr}->{$org} = 1;
1006
1007         my $evt = $U->check_open_xact($e, $xactid, $mbt);
1008         return $evt if $evt;
1009     }
1010
1011     # calculate penalties for all user/org combinations
1012     for my $user_id (keys %users) {
1013         for my $org_id (keys %{$users{$user_id}}) {
1014             OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
1015         }
1016     }
1017
1018     return 1;
1019 }
1020
1021 # A helper function to check if the payments on a bill are inside the
1022 # range of a given interval.
1023 # TODO: here is one simple place we could do voids in the absence
1024 # of any payments
1025 sub _has_refundable_payments {
1026     my ($e, $xactid, $interval) = @_;
1027
1028     # for now, just short-circuit with no interval
1029     return 0 if (!$interval);
1030
1031     my $last_payment = $e->search_money_payment(
1032         {
1033             xact => $xactid,
1034             payment_type => {"!=" => 'adjustment_payment'}
1035         },{
1036             limit => 1,
1037             order_by => { mp => "payment_ts DESC" }
1038         }
1039     );
1040
1041     if ($last_payment->[0]) {
1042         my $interval_secs = interval_to_seconds($interval);
1043         my $payment_ts = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($last_payment->[0]->payment_ts))->epoch;
1044         my $now = time;
1045         return 1 if ($payment_ts + $interval_secs >= $now);
1046     }
1047
1048     return 0;
1049 }
1050
1051 1;