1 package OpenILS::Utils::Penalty;
2 use strict; use warnings;
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";
15 my $grp_penalty_thresholds = {};
18 # calculate and update the well-known penalties
19 sub calculate_penalties {
20 my($class, $e, $user_id, $user) = @_;
22 $user = $user || $e->retrieve_actor_user($user_id);
24 my $grp_id = (ref $user->profile) ? $user->profile->id : $user->profile;
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);
32 $logger->info("patron $user_id in group $grp_id has $overdue overdue circulations and owes $mon_owed");
34 for my $thresh (@$thresholds) {
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);
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);
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;
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);
62 $e->create_actor_user_standing_penalty($newp) or return $e->die_event;
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;
74 sub collect_user_stats {
75 my($class, $e, $user_id) = @_;
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);
85 overdue => $checkouts->{overdue} || 0,
86 money_owed => $money_owed || 0
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};
95 my $cur_grp = $grp_id;
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);
101 } while(defined ($cur_grp = $e->retrieve_permission_grp_tree($cur_grp)->parent));
103 # return $grp_penalty_thresholds->{$grp_id} = \@thresholds;
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});
114 for my $p (@$penalties) {
117 for my $m (@fatal_mask) {
118 if($p->block_list =~ /$m/) {
119 push(@fatal, $p->name);
124 push(@info, $p->name) unless $pushed;
127 return {fatal_penalties => \@fatal, info_penalties => \@info};