1 package OpenILS::Application::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::Circ::ScriptBuilder;
9 use OpenSRF::Utils::SettingsClient;
10 use OpenILS::Application::AppUtils;
11 use OpenSRF::Utils::Logger qw(:logger);
12 use OpenILS::Utils::CStoreEditor qw/:funcs/;
13 use base 'OpenSRF::Application';
15 my $U = "OpenILS::Application::AppUtils";
20 my %groups; # - user groups
22 my $fatal_key = 'result.fatalEvents';
23 my $info_key = 'result.infoEvents';
26 # --------------------------------------------------------------
27 # Loads the config info
28 # --------------------------------------------------------------
31 my $conf = OpenSRF::Utils::SettingsClient->new;
32 my @pfx = ( "apps", "open-ils.penalty","app_settings" );
33 $path = $conf->config_value( @pfx, 'script_path');
34 $script = $conf->config_value( @pfx, 'patron_penalty' );
36 $path = (ref($path)) ? $path : [$path];
38 if(!($path and $script)) {
39 $logger->error("penalty: server config missing script and/or script path");
43 $logger->info("penalty: Loading patron penalty script $script with paths @$path");
48 __PACKAGE__->register_method (
49 method => 'patron_penalty',
50 api_name => 'open-ils.penalty.patron_penalty.calculate',
52 Calculates the patron's standing penalties
53 @param args An object of named params including:
54 patronid The id of the patron
55 update True if this call should update the database
56 background True if this call should return immediately,
57 then go on to process the penalties. This flag
58 works only in conjunction with the 'update' flag.
59 @return An object with keys 'fatal_penalties' and
60 'info_penalties' who are themeselves arrays of 0 or
61 more penalties. Returns event on error.
65 # --------------------------------------------------------------
68 # - background : modifier to 'update' which says to return
69 # immediately then continue processing. If this flag is set
70 # then the caller will get no penalty info and will never
71 # know for sure if the call even succeeded.
72 # --------------------------------------------------------------
74 my( $self, $conn, $args ) = @_;
78 $conn->respond_complete(1) if $$args{background};
80 return { fatal_penalties => [], info_penalties => [] }
81 unless ($args->{patron} || $args->{patronid});
83 $args->{patron_id} = $args->{patronid};
84 $args->{fetch_patron_circ_info} = 1;
85 $args->{fetch_patron_money_info} = 1;
86 $args->{ignore_user_status} = 1;
87 my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
89 # - Load up the script and run it
90 $runner->add_path($_) for @$path;
92 $runner->load($script);
93 my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
95 my @fatals = @{$result->{fatalEvents}};
96 my @infos = @{$result->{infoEvents}};
97 my $all = [ @fatals, @infos ];
99 $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
101 $conn->respond_complete(
102 { fatal_penalties => \@fatals, info_penalties => \@infos });
104 # - update the penalty info in the db if necessary
105 $logger->debug("update penalty settings = " . $$args{update});
107 $evt = update_patron_penalties(
108 patron => $args->{patron},
109 penalties => $all ) if $$args{update};
111 # - The caller won't know it failed, so log it
112 $logger->error("penalty: Error updating the patron ".
113 "penalties in the database: ".Dumper($evt)) if $evt;
119 # --------------------------------------------------------------
120 # Removes existing penalties for the patron that are not passed
121 # into this function. Creates new penalty entries for the
122 # provided penalties that don't already exist;
123 # --------------------------------------------------------------
124 sub update_patron_penalties {
127 my $patron = $args{patron};
128 my $penalties = $args{penalties};
129 my $pid = $patron->id;
132 $logger->debug("updating penalties for patron $pid => @$penalties");
133 my $editor = new_editor(xact =>1);
136 # - fetch the current penalties
137 my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
140 push( @types, $_->penalty_type ) for @$existing;
141 $logger->info("penalty: user has existing penalties [@types]");
145 # If an existing penalty is not in the newly generated
146 # list of penalties, remove it from the DB
147 for my $e (@$existing) {
148 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
150 $logger->activity("penalty: removing user penalty ".
151 $e->penalty_type . " from user $pid");
153 $editor->delete_actor_user_standing_penalty($e)
154 or return $editor->event;
158 # Add penalties that previously didn't exist
159 for my $p (@$penalties) {
160 if( ! grep { $_->penalty_type eq $p } @$existing ) {
162 $logger->activity("penalty: adding user penalty $p to user $pid");
164 my $newp = Fieldmapper::actor::user_standing_penalty->new;
165 $newp->penalty_type( $p );
168 $editor->create_actor_user_standing_penalty($newp)
169 or return $editor->event;