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