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