Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm

   1 package OpenILS::Utils::Penalty;
   2 use strict; use warnings;
   3 use DateTime;
   4 use Data::Dumper;
   5 use OpenSRF::EX qw(:try);
   6 use OpenSRF::Utils::Cache;
   7 use OpenSRF::Utils qw/:datetime/;
   8 use OpenILS::Application::AppUtils;
   9 use OpenSRF::Utils::Logger qw(:logger);
  10 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  11 use OpenILS::Utils::Fieldmapper;
  12 use OpenILS::Const qw/:const/;
  13 my $U = "OpenILS::Application::AppUtils";
  14
  15 my $grp_penalty_thresholds = {};
  16
  17
  18 # calculate and update the well-known penalties
  19 sub calculate_penalties {
  20     my($class, $e, $user_id, $user) = @_;
  21
  22     $user = $user || $e->retrieve_actor_user($user_id);
  23     $user_id = $user->id;
  24     my $grp_id = (ref $user->profile) ? $user->profile->id : $user->profile;
  25
  26     my $penalties = $e->search_actor_user_standing_penalty({usr => $user_id});
  27     my $stats = $class->collect_user_stats($e, $user_id);
  28     my $overdue = $stats->{overdue};
  29     my $mon_owed = $stats->{money_owed};
  30     my $thresholds = $class->get_group_penalty_thresholds($e, $grp_id);
  31
  32     $logger->info("patron $user_id in group $grp_id has $overdue overdue circulations and owes $mon_owed");
  33
  34     for my $thresh (@$thresholds) {
  35         my $evt;
  36
  37         if($thresh->penalty == OILS_PENALTY_PATRON_EXCEEDS_FINES) {
  38             $evt = $class->check_apply_penalty(
  39                 $e, $user_id, $penalties, OILS_PENALTY_PATRON_EXCEEDS_FINES, $thresh->threshold, $mon_owed);
  40             return $evt if $evt;
  41         }
  42
  43         if($thresh->penalty == OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT) {
  44             $evt = $class->check_apply_penalty(
  45                 $e, $user_id, $penalties, OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT, $thresh->threshold, $overdue);
  46             return $evt if $evt;
  47         }
  48     }
  49 }
  50
  51 # if a given penalty does not already exist in the DB, this creates it.
  52 # If it does exist and should not, this removes it.
  53 sub check_apply_penalty {
  54     my($class, $e, $user_id, $all_penalties, $penalty_id, $threshold, $value) = @_;
  55     my ($existing) = grep { $_->standing_penalty == $penalty_id } @$all_penalties;
  56
  57     # penalty threshold has been exceeded and needs to be added
  58     if($value >= $threshold and not $existing) {
  59         my $newp = Fieldmapper::actor::user_standing_penalty->new;
  60         $newp->standing_penalty($penalty_id);
  61         $newp->usr($user_id);
  62         $e->create_actor_user_standing_penalty($newp) or return $e->die_event;
  63
  64     # patron is within penalty range and existing penalty must be removed
  65     } elsif($value < $threshold and $existing) {
  66         $e->delete_actor_user_standing_penalty($existing)
  67             or return $e->die_event;
  68     }
  69
  70     return undef;
  71 }
  72
  73
  74 sub collect_user_stats {
  75     my($class, $e, $user_id) = @_;
  76
  77     my $stor_ses = $U->start_db_session();
  78         my $money_owed = $stor_ses->request(
  79         'open-ils.storage.actor.user.total_owed', $user_id)->gather(1);
  80     my $checkouts = $stor_ses->request(
  81             'open-ils.storage.actor.user.checked_out.count', $user_id)->gather(1);
  82         $U->rollback_db_session($stor_ses);
  83
  84     return {
  85         overdue => $checkouts->{overdue} || 0,
  86         money_owed => $money_owed || 0
  87     };
  88 }
  89
  90 # get the ranged set of penalties for a give group
  91 sub get_group_penalty_thresholds {
  92     my($class, $e, $grp_id) = @_;
  93 #    return $grp_penalty_thresholds->{$grp_id} if $grp_penalty_thresholds->{$grp_id};
  94     my @thresholds;
  95     my $cur_grp = $grp_id;
  96     do {
  97         my $thresh = $e->search_permission_grp_penalty_threshold({grp => $cur_grp});
  98         for my $t (@$thresh) {
  99             push(@thresholds, $t) unless (grep { $_->name eq $t->name } @thresholds);
 100         }
 101     } while(defined ($cur_grp = $e->retrieve_permission_grp_tree($cur_grp)->parent));
 102
 103 #    return $grp_penalty_thresholds->{$grp_id} = \@thresholds;
 104     return \@thresholds;
 105 }
 106
 107
 108 # any penalties whose block_list has an item from @fatal_mask will be sorted
 109 # into the fatal_penalties set.  Others will be sorted into the info_penalties set
 110 sub retrieve_penalties {
 111     my($class, $e, $user_id, @fatal_mask) = @_;
 112     my $penalties = $e->search_actor_user_standing_penalty({usr => $user_id});
 113     my(@info, @fatal);
 114     for my $p (@$penalties) {
 115         my $pushed = 0;
 116         if($p->block_list) {
 117             for my $m (@fatal_mask) {
 118                 if($p->block_list =~ /$m/) {
 119                     push(@fatal, $p->name);
 120                     $pushed = 1;
 121                 }
 122             }
 123         }
 124         push(@info, $p->name) unless $pushed;
 125     }
 126
 127     return {fatal_penalties => \@fatal, info_penalties => \@info};
 128 }
 129
 130 1;