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