Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CircCommon.pm

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