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 OpenILS::Utils::DateTime 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 = OpenILS::Utils::DateTime->interval_to_seconds($duration);
  54
  55         my $date = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($backdate));
  56         my $due_date = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($circ->due_date))->epoch;
  57         my $grace_period = extend_grace_period( $class, $circ->circ_lib, $circ->due_date, OpenILS::Utils::DateTime->interval_to_seconds($circ->grace_period), $e);
  58         if($date->epoch <= $due_date + $grace_period) {
  59             $logger->info("backdate $backdate is within grace period, voiding all");
  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( clean_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( clean_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 maybe_close_xact {
 363     my ($class, $e, $xact_id) = @_;
 364
 365     my $circ = $e->retrieve_action_circulation(
 366         [
 367             $xact_id,
 368             {
 369                 flesh => 1,
 370                 flesh_fields => {circ => ['target_copy','billings']}
 371             }
 372         ]
 373     ); # Flesh the copy, so we can monkey with the status if
 374        # necessary.
 375
 376     # Whether or not we close the transaction. We definitely close if no
 377     # circulation transaction is present, otherwise we check if the circulation
 378     # is in a state that allows itself to be closed.
 379     if (!$circ || can_close_circ($class, $e, $circ)) {
 380         my $billable_xact = $e->retrieve_money_billable_transaction($xact_id);
 381         $billable_xact->xact_finish("now");
 382         if (!$e->update_money_billable_transaction($billable_xact)) {
 383             return {
 384                 message => "update_money_billable_transaction() failed",
 385                 evt => $e->die_event
 386             };
 387         }
 388
 389         # If we have a circ, we need to check if the copy status is lost or
 390         # long overdue.  If it is then we check org_unit_settings for the copy
 391         # owning library and adjust and possibly adjust copy status to lost and
 392         # paid.
 393         if ($circ && ($circ->stop_fines eq 'LOST' || $circ->stop_fines eq 'LONGOVERDUE')) {
 394             # We need the copy to check settings and to possibly
 395             # change its status.
 396             my $copy = $circ->target_copy();
 397             # Library where we'll check settings.
 398             my $check_lib = $copy->circ_lib();
 399
 400             # check the copy status
 401             if (($copy->status() == OILS_COPY_STATUS_LOST || $copy->status() == OILS_COPY_STATUS_LONG_OVERDUE)
 402                     && $U->is_true($U->ou_ancestor_setting_value($check_lib, 'circ.use_lost_paid_copy_status', $e))) {
 403                 $copy->status(OILS_COPY_STATUS_LOST_AND_PAID);
 404                 if (!$e->update_asset_copy($copy)) {
 405                     return {
 406                         message => "update_asset_copy_failed()",
 407                         evt => $e->die_event
 408                     };
 409                 }
 410             }
 411         }
 412     }
 413 }
 414
 415
 416 sub seconds_to_interval_hash {
 417         my $interval = shift;
 418         my $limit = shift || 's';
 419         $limit =~ s/^(.)/$1/o;
 420
 421         my %output;
 422
 423         my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s);
 424         my ($year, $month, $week, $day, $hour, $minute, $second) =
 425                 ('years','months','weeks','days', 'hours', 'minutes', 'seconds');
 426
 427         if ($y = int($interval / (60 * 60 * 24 * 365))) {
 428                 $output{$year} = $y;
 429                 $ym = $interval % (60 * 60 * 24 * 365);
 430         } else {
 431                 $ym = $interval;
 432         }
 433         return %output if ($limit eq 'y');
 434
 435         if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
 436                 $output{$month} = $M;
 437                 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
 438         } else {
 439                 $Mm = $ym;
 440         }
 441         return %output if ($limit eq 'M');
 442
 443         if ($w = int($Mm / 604800)) {
 444                 $output{$week} = $w;
 445                 $wm = $Mm % 604800;
 446         } else {
 447                 $wm = $Mm;
 448         }
 449         return %output if ($limit eq 'w');
 450
 451         if ($d = int($wm / 86400)) {
 452                 $output{$day} = $d;
 453                 $dm = $wm % 86400;
 454         } else {
 455                 $dm = $wm;
 456         }
 457         return %output if ($limit eq 'd');
 458
 459         if ($h = int($dm / 3600)) {
 460                 $output{$hour} = $h;
 461                 $hm = $dm % 3600;
 462         } else {
 463                 $hm = $dm;
 464         }
 465         return %output if ($limit eq 'h');
 466
 467         if ($m = int($hm / 60)) {
 468                 $output{$minute} = $m;
 469                 $mm = $hm % 60;
 470         } else {
 471                 $mm = $hm;
 472         }
 473         return %output if ($limit eq 'm');
 474
 475         if ($s = int($mm)) {
 476                 $output{$second} = $s;
 477         } else {
 478                 $output{$second} = 0 unless (keys %output);
 479         }
 480         return %output;
 481 }
 482
 483 sub generate_fines {
 484     my ($class, $args) = @_;
 485     my $circs = $args->{circs};
 486     return unless $circs and @$circs;
 487     my $e = $args->{editor};
 488     # if a client connection is passed in, this will be chatty like
 489     # the old storage version
 490     my $conn = $args->{conn};
 491
 492     my $commit = 0;
 493     unless ($e) {
 494         # Transactions are opened/closed with each circ, reservation, etc.
 495         # The first $e->xact_begin (below) will cause a connect.
 496         $e = new_editor();
 497         $commit = 1;
 498     }
 499
 500     my %hoo = map { ( $_->id => $_ ) } @{ $e->retrieve_all_actor_org_unit_hours_of_operation };
 501
 502     my $handling_resvs = 0;
 503     for my $c (@$circs) {
 504
 505         my $ctype = ref($c);
 506
 507         if (!$ctype) { # we received only an idlist, not objects
 508             if ($handling_resvs) {
 509                 $c = $e->retrieve_booking_reservation($c);
 510             } elsif (not defined $c) {
 511                 # an undef value is the indicator that we are moving
 512                 # from processing circulations to reservations.
 513                 $handling_resvs = 1;
 514                 next;
 515             } else {
 516                 $c = $e->retrieve_action_circulation($c);
 517             }
 518             $ctype = ref($c);
 519         }
 520
 521         $ctype =~ s/^.+::(\w+)$/$1/;
 522
 523         my $due_date_method = 'due_date';
 524         my $target_copy_method = 'target_copy';
 525         my $circ_lib_method = 'circ_lib';
 526         my $recurring_fine_method = 'recurring_fine';
 527         my $is_reservation = 0;
 528         if ($ctype eq 'reservation') {
 529             $is_reservation = 1;
 530             $due_date_method = 'end_time';
 531             $target_copy_method = 'current_resource';
 532             $circ_lib_method = 'pickup_lib';
 533             $recurring_fine_method = 'fine_amount';
 534             next unless ($c->fine_interval);
 535         }
 536         #TODO: reservation grace periods
 537         my $grace_period = ($is_reservation ? 0 : interval_to_seconds($c->grace_period));
 538
 539         eval {
 540
 541             # Clean up after previous transaction.
 542             # This is a no-op if there is no open transaction.
 543             $e->xact_rollback if $commit;
 544
 545             $logger->info(sprintf("Processing $ctype %d...", $c->id));
 546
 547             # each (ils) transaction is processed in its own (db) transaction
 548             $e->xact_begin if $commit;
 549
 550             my $due_dt = $parser->parse_datetime( clean_ISO8601( $c->$due_date_method ) );
 551
 552             my $due = $due_dt->epoch;
 553             my $now = time;
 554
 555             my $fine_interval = $c->fine_interval;
 556             $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
 557             $fine_interval = interval_to_seconds( $fine_interval );
 558
 559             if ( $fine_interval == 0 || $c->$recurring_fine_method * 100 == 0 || $c->max_fine * 100 == 0 ) {
 560                 $conn->respond( "Fine Generator skipping circ due to 0 fine interval, 0 fine rate, or 0 max fine.\n" ) if $conn;
 561                 $logger->info( "Fine Generator skipping circ " . $c->id . " due to 0 fine interval, 0 fine rate, or 0 max fine." );
 562                 return;
 563             }
 564
 565             if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) {
 566                 my $tz_offset_s = 0;
 567                 if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) {
 568                     $tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m");
 569                 }
 570
 571                 $due -= ($due % $fine_interval) + $tz_offset_s;
 572                 $now -= ($now % $fine_interval) + $tz_offset_s;
 573             }
 574
 575             $conn->respond(
 576                 "ARG! Overdue $ctype ".$c->id.
 577                 " for item ".$c->$target_copy_method.
 578                 " (user ".$c->usr.").\n".
 579                 "\tItem was due on or before: ".localtime($due)."\n") if $conn;
 580
 581             my @fines = @{$e->search_money_billing([
 582                 { xact => $c->id,
 583                   btype => 1,
 584                   billing_ts => { '>' => $c->$due_date_method } },
 585                 { order_by => {mb => 'billing_ts DESC'},
 586                   flesh => 1,
 587                   flesh_fields => {mb => ['adjustments']} }
 588             ])};
 589
 590             my $f_idx = 0;
 591             my $fine = $fines[$f_idx] if (@fines);
 592             my $current_fine_total = 0;
 593             $current_fine_total += $_->amount * 100 for (grep { $_ and !$U->is_true($_->voided) } @fines);
 594             $current_fine_total -= $_->amount * 100 for (map { @{$_->adjustments} } @fines);
 595
 596             my $last_fine;
 597             if ($fine) {
 598                 $conn->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".clean_ISO8601( $fine->billing_ts ).")") if $conn;
 599                 $last_fine = $parser->parse_datetime( clean_ISO8601( $fine->billing_ts ) )->epoch;
 600             } else {
 601                 $logger->info( "Potential first billing for circ ".$c->id );
 602                 $last_fine = $due;
 603
 604                 $grace_period = extend_grace_period($class, $c->$circ_lib_method,$c->$due_date_method,$grace_period,undef,$hoo{$c->$circ_lib_method});
 605             }
 606
 607             return if ($last_fine > $now);
 608             # Generate fines for each past interval, including the one we are inside
 609             my $pending_fine_count = ceil( ($now - $last_fine) / $fine_interval );
 610
 611             if ( $last_fine == $due                         # we have no fines yet
 612                  && $grace_period                           # and we have a grace period
 613                  && $now < $due + $grace_period             # and some date math says were are within the grace period
 614             ) {
 615                 $conn->respond( "Still inside grace period of: ". seconds_to_interval( $grace_period )."\n" ) if $conn;
 616                 $logger->info( "Circ ".$c->id." is still inside grace period of: $grace_period [". seconds_to_interval( $grace_period ).']' );
 617                 return;
 618             }
 619
 620             $conn->respond( "\t$pending_fine_count pending fine(s)\n" ) if $conn;
 621             return unless ($pending_fine_count);
 622
 623             my $recurring_fine = $c->$recurring_fine_method * 100;
 624             my $max_fine = $c->max_fine * 100;
 625
 626             my $skip_closed_check = $U->ou_ancestor_setting_value(
 627                 $c->$circ_lib_method, 'circ.fines.charge_when_closed');
 628             $skip_closed_check = $U->is_true($skip_closed_check);
 629
 630             my $truncate_to_max_fine = $U->ou_ancestor_setting_value(
 631                 $c->$circ_lib_method, 'circ.fines.truncate_to_max_fine');
 632             $truncate_to_max_fine = $U->is_true($truncate_to_max_fine);
 633
 634             my $tz = $U->ou_ancestor_setting_value(
 635                 $c->$circ_lib_method, 'lib.timezone') || 'local';
 636
 637             my ($latest_period_end, $latest_amount) = ('',0);
 638             for (my $bill = 1; $bill <= $pending_fine_count; $bill++) {
 639
 640                 if ($current_fine_total >= $max_fine) {
 641                     if ($ctype eq 'circulation') {
 642                         $c->stop_fines('MAXFINES');
 643                         $c->stop_fines_time('now');
 644                         $e->update_action_circulation($c);
 645                     }
 646                     $conn->respond(
 647                         "\tMaximum fine level of ".$c->max_fine.
 648                         " reached for this $ctype.\n".
 649                         "\tNo more fines will be generated.\n" ) if $conn;
 650                     last;
 651                 }
 652
 653                 # Use org time zone (or default to 'local')
 654                 my $period_end = DateTime->from_epoch( epoch => $last_fine, time_zone => $tz );
 655                 my $current_bill_count = $bill;
 656                 while ( $current_bill_count ) {
 657                     $period_end->add( seconds_to_interval_hash( $fine_interval ) );
 658                     $current_bill_count--;
 659                 }
 660                 my $period_start = $period_end->clone->subtract( seconds_to_interval_hash( $fine_interval - 1 ) );
 661
 662                 my $timestamptz = $period_end->strftime('%FT%T%z');
 663                 if (!$skip_closed_check) {
 664                     my $dow = $period_end->day_of_week_0();
 665                     my $dow_open = "dow_${dow}_open";
 666                     my $dow_close = "dow_${dow}_close";
 667
 668                     if (my $h = $hoo{$c->$circ_lib_method}) {
 669                         next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00');
 670                     }
 671
 672                     my @cl = @{$e->search_actor_org_unit_closed_date(
 673                             { close_start   => { '<=' => $timestamptz },
 674                               close_end => { '>=' => $timestamptz },
 675                               org_unit  => $c->$circ_lib_method }
 676                     )};
 677                     next if (@cl);
 678                 }
 679
 680                 # The billing amount for this billing normally ought to be the recurring fine amount.
 681                 # However, if the recurring fine amount would cause total fines to exceed the max fine amount,
 682                 # we may wish to reduce the amount for this billing (if circ.fines.truncate_to_max_fine is true).
 683                 my $this_billing_amount = $recurring_fine;
 684                 if ( $truncate_to_max_fine && ($current_fine_total + $this_billing_amount) > $max_fine ) {
 685                     $this_billing_amount = ($max_fine - $current_fine_total);
 686                 }
 687                 $current_fine_total += $this_billing_amount;
 688                 $latest_amount += $this_billing_amount;
 689                 $latest_period_end = $timestamptz;
 690
 691                 my $bill = Fieldmapper::money::billing->new;
 692                 $bill->xact($c->id);
 693                 $bill->note("System Generated Overdue Fine");
 694                 $bill->billing_type("Overdue materials");
 695                 $bill->btype(1);
 696                 $bill->amount(sprintf('%0.2f', $this_billing_amount/100));
 697                 $bill->period_start($period_start->strftime('%FT%T%z'));
 698                 $bill->period_end($timestamptz);
 699                 $e->create_money_billing($bill);
 700
 701             }
 702
 703             $conn->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_period_end\n" )
 704                 if ($conn and $latest_period_end and $latest_amount);
 705
 706
 707             # Calculate penalties inline
 708             OpenILS::Utils::Penalty->calculate_penalties(
 709                 $e, $c->usr, $c->$circ_lib_method);
 710
 711             $e->xact_commit if $commit;
 712
 713         };
 714
 715         if ($@) {
 716             my $e = $@;
 717             $conn->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" ) if $conn;
 718             $logger->error("Error processing overdue $ctype [".$c->id."]:\n$e\n");
 719             last if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
 720         }
 721     }
 722
 723     # roll back any (potentially) orphaned transaction and disconnect.
 724     $e->rollback if $commit;
 725
 726     return undef;
 727 }
 728
 729 # -----------------------------------------------------------------
 730 # Given an editor and a xact, return a reference to an array of
 731 # hashrefs that map billing objects to payment objects.  Returns undef
 732 # if no bills are found for the given transaction.
 733 #
 734 # The bill amounts are adjusted to reflect the application of the
 735 # payments to the bills.  The original bill amounts are retained in
 736 # the mapping.
 737 #
 738 # The payment objects may or may not have their amounts adjusted
 739 # depending on whether or not they apply to more than one bill.  We
 740 # could really use a better logic here, perhaps, but if it was
 741 # consistent, it wouldn't be Evergreen.
 742 #
 743 # The data structure used in the array is a hashref that has the
 744 # following fields:
 745 #
 746 # bill => the adjusted bill object
 747 # adjustments => an arrayref of account adjustments that apply directly
 748 #                to the bill
 749 # payments => an arrayref of payment objects applied to the bill
 750 # bill_amount => original amount from the billing object
 751 # adjustment_amount => total of the account adjustments that apply
 752 #                      directly to the bill
 753 #
 754 # Each bill is only mapped to payments one time.  However, a single
 755 # payment may be mapped to more than one bill if the payment amount is
 756 # greater than the amount of each individual bill, such as a $3.00
 757 # payment for 30 $0.10 overdue bills.  There is an attempt made to
 758 # first pay bills with payments that match the billing amount.  This
 759 # is intended to catch payments for lost and/or long overdue bills so
 760 # that they will match up.
 761 #
 762 # This function is heavily adapted from code written by Jeff Godin of
 763 # Traverse Area District Library and submitted on LaunchPad bug
 764 # #1009049.
 765 # -----------------------------------------------------------------
 766 sub bill_payment_map_for_xact {
 767     my ($class, $e, $xact) = @_;
 768
 769     # Check for CStoreEditor and make a new one if we have to. This
 770     # allows one-off calls to this subroutine to pass undef as the
 771     # CStoreEditor and not have to create one of their own.
 772     $e = OpenILS::Utils::CStoreEditor->new unless ($e);
 773
 774     # find all bills in order
 775     my $bill_search = [
 776         { xact => $xact->id(), voided => 'f' },
 777         { order_by => { mb => { billing_ts => { direction => 'asc' } } } },
 778     ];
 779
 780     # At some point, we should get rid of the voided column on
 781     # money.payment and family.  It is not exposed in the client at
 782     # the moment, and should be replaced with a void_bill type.  The
 783     # descendants of money.payment don't expose the voided field in
 784     # the fieldmapper, only the mp object, based on the money.payment
 785     # view, does.  However, I want to leave that complication for
 786     # later.  I wonder if I'm not slowing things down too much with
 787     # the current account_adjustment logic.  It would probably be faster if
 788     # we had direct Pg access at this layer.  I can probably wrangle
 789     # something via the drivers or store interfaces, but I haven't
 790     # really figured those out, yet.
 791
 792     my $bills = $e->search_money_billing($bill_search);
 793
 794     # return undef if there are no bills.
 795     return undef unless ($bills && @$bills);
 796
 797     # map the bills into our bill_payment_map entry format:
 798     my @entries = map {
 799         {
 800             bill => $_,
 801             bill_amount => $_->amount(),
 802             payments => [],
 803             adjustments => [],
 804             adjustment_amount => 0
 805         }
 806     } @$bills;
 807
 808     # Find all unvoided payments in order.  Flesh account adjustments
 809     # so that we don't have to retrieve them later.
 810     my $payments = $e->search_money_payment(
 811         [
 812             { xact => $xact->id, voided=>'f' },
 813             {
 814                 order_by => { mp => { payment_ts => { direction => 'asc' } } },
 815                 flesh => 1,
 816                 flesh_fields => { mp => ['account_adjustment'] }
 817             }
 818         ]
 819     );
 820
 821     # If there were no payments, then we just return the bills.
 822     return \@entries unless ($payments && @$payments);
 823
 824     # Now, we go through the rigmarole of mapping payments to bills
 825     # and adjusting the bill balances.
 826
 827     # Apply the adjustments before "paying" other bills.
 828     foreach my $entry (@entries) {
 829         my $bill = $entry->{bill};
 830         # Find only the adjustments that apply to individual bills.
 831         my @adjustments = map {$_->account_adjustment()} grep {$_->payment_type() eq 'account_adjustment' && $_->account_adjustment()->billing() == $bill->id()} @$payments;
 832         if (@adjustments) {
 833             foreach my $adjustment (@adjustments) {
 834                 my $new_amount = $U->fpdiff($bill->amount(),$adjustment->amount());
 835                 if ($new_amount >= 0) {
 836                     push @{$entry->{adjustments}}, $adjustment;
 837                     $entry->{adjustment_amount} += $adjustment->amount();
 838                     $bill->amount($new_amount);
 839                     # Remove the used up adjustment from list of payments:
 840                     my @p = grep {$_->id() != $adjustment->id()} @$payments;
 841                     $payments = \@p;
 842                 } else {
 843                     # It should never happen that we have more adjustment
 844                     # payments on a single bill than the amount of the
 845                     # bill.  However, experience shows that the things
 846                     # that should never happen actually do happen with
 847                     # surprising regularity in a library setting.
 848
 849                     # Clone the adjustment to say how much of it actually
 850                     # applied to this bill.
 851                     my $new_adjustment = $adjustment->clone();
 852                     $new_adjustment->amount($bill->amount());
 853                     $new_adjustment->amount_collected($bill->amount());
 854                     push (@{$entry->{adjustments}}, $new_adjustment);
 855                     $entry->{adjustment_amount} += $new_adjustment->amount();
 856                     $bill->amount(0);
 857                     $adjustment->amount(-$new_amount);
 858                     # Could be a candidate for YAOUS about what to do
 859                     # with excess adjustment amounts on a bill.
 860                 }
 861                 last if ($bill->amount() == 0);
 862             }
 863         }
 864     }
 865
 866     # Try to map payments to bills by amounts starting with the
 867     # largest payments.
 868     # To avoid modifying the array we're iterating over (which can result in a
 869     # "Use of freed value in iteration" error), we create a copy of the
 870     # payments array and remove handled payments from that instead.
 871     my @handled_payments = @$payments;
 872     foreach my $payment (sort {$b->amount() <=> $a->amount()} @$payments) {
 873         my @bills2pay = grep {$_->{bill}->amount() == $payment->amount()} @entries;
 874         if (@bills2pay) {
 875             my $entry = $bills2pay[0];
 876             $entry->{bill}->amount(0);
 877             push @{$entry->{payments}}, $payment;
 878             # Remove the payment from the master list.
 879             my @p = grep {$_->id() != $payment->id()} @handled_payments;
 880             @handled_payments = @p;
 881         }
 882     }
 883     # Now, update our list of payments so that it only includes unhandled
 884     # (unmapped) payments.
 885     $payments = \@handled_payments;
 886
 887     # Map remaining bills to payments in whatever order.
 888     foreach  my $entry (grep {$_->{bill}->amount() > 0} @entries) {
 889         my $bill = $entry->{bill};
 890         # We could run out of payments before bills.
 891         if ($payments && @$payments) {
 892             while ($bill->amount() > 0) {
 893                 my $payment = shift @$payments;
 894                 last unless $payment;
 895                 my $new_amount = $U->fpdiff($bill->amount(),$payment->amount());
 896                 if ($new_amount < 0) {
 897                     # Clone the payment so we can say how much applied
 898                     # to this bill.
 899                     my $new_payment = $payment->clone();
 900                     $new_payment->amount($bill->amount());
 901                     $bill->amount(0);
 902                     push @{$entry->{payments}}, $new_payment;
 903                     # Reset the payment amount and put it back on the
 904                     # list for later use.
 905                     $payment->amount(-$new_amount);
 906                     unshift @$payments, $payment;
 907                 } else {
 908                     $bill->amount($new_amount);
 909                     push @{$entry->{payments}}, $payment;
 910                 }
 911             }
 912         }
 913     }
 914
 915     return \@entries;
 916 }
 917
 918
 919 # This subroutine actually handles voiding of bills.  It takes a
 920 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
 921 sub void_bills {
 922     my ($class, $e, $billids, $note) = @_;
 923
 924     my %users;
 925     my $bills;
 926     if (ref($billids->[0])) {
 927         $bills = $billids;
 928     } else {
 929         $bills = $e->search_money_billing([{id => $billids}])
 930             or return $e->die_event;
 931     }
 932     for my $bill (@$bills) {
 933
 934         my $xact = $e->retrieve_money_billable_transaction($bill->xact)
 935             or return $e->die_event;
 936
 937         if($U->is_true($bill->voided)) {
 938             # For now, it is not an error to attempt to re-void a bill, but
 939             # don't actually do anything
 940             #$e->rollback;
 941             #return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill)
 942             next;
 943         }
 944
 945         my $org = $U->xact_org($bill->xact, $e);
 946         $users{$xact->usr} = {} unless $users{$xact->usr};
 947         $users{$xact->usr}->{$org} = 1;
 948
 949         $bill->voided('t');
 950         $bill->voider($e->requestor->id);
 951         $bill->void_time('now');
 952         my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : "";
 953         $bill->note(sprintf("$n%s", $note));
 954
 955         $e->update_money_billing($bill) or return $e->die_event;
 956         my $evt = $U->check_open_xact($e, $bill->xact, $xact);
 957         return $evt if $evt;
 958     }
 959
 960     # calculate penalties for all user/org combinations
 961     for my $user_id (keys %users) {
 962         for my $org_id (keys %{$users{$user_id}}) {
 963             OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id)
 964         }
 965     }
 966
 967     return 1;
 968 }
 969
 970
 971 # This subroutine actually handles "adjusting" bills to zero.  It takes a
 972 # CStoreEditor, an arrayref of bill ids or bills, and an optional note.
 973 sub adjust_bills_to_zero {
 974     my ($class, $e, $billids, $note) = @_;
 975
 976     my %users;
 977
 978     # Let's get all the billing objects and handle them by
 979     # transaction.
 980     my $bills;
 981     if (ref($billids->[0])) {
 982         $bills = $billids;
 983     } else {
 984         $bills = $e->search_money_billing([{id => $billids}])
 985             or return $e->die_event;
 986     }
 987
 988     my @xactids = uniq map {$_->xact()} @$bills;
 989
 990     foreach my $xactid (@xactids) {
 991         my $mbt = $e->retrieve_money_billable_transaction(
 992             [
 993                 $xactid,
 994                 {
 995                     flesh=> 2,
 996                     flesh_fields=> {
 997                         mbt=>['grocery','circulation'],
 998                         circ=>['target_copy']
 999                     }
1000                 }
1001             ]
1002         ) or return $e->die_event;
1003         # Flesh grocery bills and circulations so we don't have to
1004         # retrieve them later.
1005         my ($circ, $grocery, $copy);
1006         $grocery = $mbt->grocery();
1007         $circ = $mbt->circulation();
1008         $copy = $circ->target_copy() if ($circ);
1009
1010
1011
1012         # Get the bill_payment_map for the transaction.
1013         my $bpmap = $class->bill_payment_map_for_xact($e, $mbt);
1014
1015         # Get the bills for this transaction from the main list of bills.
1016         my @xact_bills = grep {$_->xact() == $xactid} @$bills;
1017         # Handle each bill in turn.
1018         foreach my $bill (@xact_bills) {
1019             # As the total open amount on the transaction will change
1020             # as each bill is adjusted, we'll just recalculate it for
1021             # each bill.
1022             my $xact_total = 0;
1023             map {$xact_total += $_->{bill}->amount()} @$bpmap;
1024             last if $xact_total == 0;
1025
1026             # Get the bill_payment_map entry for this bill:
1027             my ($bpentry) = grep {$_->{bill}->id() == $bill->id()} @$bpmap;
1028
1029             # From here on out, use the bill object from the bill
1030             # payment map entry.
1031             $bill = $bpentry->{bill};
1032
1033             # The amount to adjust is the non-adjusted balance on the
1034             # bill. It should never be less than zero.
1035             my $amount_to_adjust = $U->fpdiff($bpentry->{bill_amount},$bpentry->{adjustment_amount});
1036
1037             # Check if this bill is already adjusted.  We don't allow
1038             # "double" adjustments regardless of settings.
1039             if ($amount_to_adjust <= 0) {
1040                 #my $event = OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
1041                 #$e->event($event);
1042                 #return $event;
1043                 next;
1044             }
1045
1046             if ($amount_to_adjust > $xact_total) {
1047                 $amount_to_adjust = $xact_total;
1048             }
1049
1050             # Create the account adjustment
1051             my $payobj = Fieldmapper::money::account_adjustment->new;
1052             $payobj->amount($amount_to_adjust);
1053             $payobj->amount_collected($amount_to_adjust);
1054             $payobj->xact($xactid);
1055             $payobj->accepting_usr($e->requestor->id);
1056             $payobj->payment_ts('now');
1057             $payobj->billing($bill->id());
1058             $payobj->note($note) if ($note);
1059             $e->create_money_account_adjustment($payobj) or return $e->die_event;
1060             # Adjust our bill_payment_map
1061             $bpentry->{adjustment_amount} += $amount_to_adjust;
1062             push @{$bpentry->{adjustments}}, $payobj;
1063             # Should come to zero:
1064             my $new_bill_amount = $U->fpdiff($bill->amount(),$amount_to_adjust);
1065             $bill->amount($new_bill_amount);
1066         }
1067
1068         my $org = $U->xact_org($xactid, $e);
1069         $users{$mbt->usr} = {} unless $users{$mbt->usr};
1070         $users{$mbt->usr}->{$org} = 1;
1071
1072         my $evt = $U->check_open_xact($e, $xactid, $mbt);
1073         return $evt if $evt;
1074     }
1075
1076     # calculate penalties for all user/org combinations
1077     for my $user_id (keys %users) {
1078         for my $org_id (keys %{$users{$user_id}}) {
1079             OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
1080         }
1081     }
1082
1083     return 1;
1084 }
1085
1086 # A helper function to check if the payments on a bill are inside the
1087 # range of a given interval.
1088 # TODO: here is one simple place we could do voids in the absence
1089 # of any payments
1090 sub _has_refundable_payments {
1091     my ($e, $xactid, $interval) = @_;
1092
1093     # for now, just short-circuit with no interval
1094     return 0 if (!$interval);
1095
1096     my $last_payment = $e->search_money_payment(
1097         {
1098             xact => $xactid,
1099             payment_type => {"!=" => 'account_adjustment'}
1100         },{
1101             limit => 1,
1102             order_by => { mp => "payment_ts DESC" }
1103         }
1104     );
1105
1106     if ($last_payment->[0]) {
1107         my $interval_secs = interval_to_seconds($interval);
1108         my $payment_ts = DateTime::Format::ISO8601->parse_datetime(clean_ISO8601($last_payment->[0]->payment_ts))->epoch;
1109         my $now = time;
1110         return 1 if ($payment_ts + $interval_secs >= $now);
1111     }
1112
1113     return 0;
1114 }
1115
1116 1;