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 OpenILS::Application;
14 use base 'OpenILS::Application';
16 my $U = "OpenILS::Application::AppUtils";
21 my %groups; # - user groups
23 my $fatal_key = 'result.fatalEvents';
24 my $info_key = 'result.infoEvents';
27 # --------------------------------------------------------------
28 # Loads the config info
29 # --------------------------------------------------------------
32 my $conf = OpenSRF::Utils::SettingsClient->new;
33 my @pfx = ( "apps", "open-ils.penalty","app_settings" );
34 $path = $conf->config_value( @pfx, 'script_path');
35 $script = $conf->config_value( @pfx, 'patron_penalty' );
37 $path = (ref($path)) ? $path : [$path];
39 if(!($path and $script)) {
40 $logger->error("penalty: server config missing script and/or script path");
44 $logger->info("penalty: Loading patron penalty script $script with paths @$path");
49 __PACKAGE__->register_method (
50 method => 'patron_penalty',
51 api_name => 'open-ils.penalty.patron_penalty.calculate',
53 Calculates the patron's standing penalties
54 @param args An object of named params including:
55 patronid The id of the patron
56 update True if this call should update the database
57 background True if this call should return immediately,
58 then go on to process the penalties. This flag
59 works only in conjunction with the 'update' flag.
60 @return An object with keys 'fatal_penalties' and
61 'info_penalties' who are themeselves arrays of 0 or
62 more penalties. Returns event on error.
66 # --------------------------------------------------------------
69 # - background : modifier to 'update' which says to return
70 # immediately then continue processing. If this flag is set
71 # then the caller will get no penalty info and will never
72 # know for sure if the call even succeeded.
73 # --------------------------------------------------------------
75 my( $self, $conn, $args ) = @_;
79 $conn->respond_complete(1) if $$args{background};
81 return { fatal_penalties => [], info_penalties => [] }
82 unless ($args->{patron} || $args->{patronid});
84 $args->{patron_id} = $args->{patronid};
85 $args->{fetch_patron_circ_info} = 1;
86 $args->{fetch_patron_money_info} = 1;
87 $args->{ignore_user_status} = 1;
89 $args->{editor} = undef; # just to be safe
90 my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
92 # - Load up the script and run it
93 $runner->add_path($_) for @$path;
95 $runner->load($script);
96 my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
98 my @fatals = @{$result->{fatalEvents}};
99 my @infos = @{$result->{infoEvents}};
100 my $all = [ @fatals, @infos ];
102 $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
104 $conn->respond_complete(
105 { fatal_penalties => \@fatals, info_penalties => \@infos });
107 # - update the penalty info in the db if necessary
108 $logger->debug("update penalty settings = " . $$args{update});
110 $evt = update_patron_penalties(
111 patron => $args->{patron},
112 penalties => $all) if $$args{update};
114 # - The caller won't know it failed, so log it
115 $logger->error("penalty: Error updating the patron ".
116 "penalties in the database: ".Dumper($evt)) if $evt;
122 # --------------------------------------------------------------
123 # Removes existing penalties for the patron that are not passed
124 # into this function. Creates new penalty entries for the
125 # provided penalties that don't already exist;
126 # --------------------------------------------------------------
127 sub update_patron_penalties {
130 my $patron = $args{patron};
131 my $penalties = $args{penalties};
132 my $editor = new_editor(xact=>1);
133 my $pid = $patron->id;
135 $logger->debug("updating penalties for patron $pid => @$penalties");
137 # - fetch the current penalties
138 my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
141 push( @types, $_->penalty_type ) for @$existing;
142 $logger->info("penalty: user has existing penalties [@types]");
146 # If an existing penalty is not in the newly generated
147 # list of penalties, remove it from the DB
148 for my $e (@$existing) {
149 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
151 $logger->activity("penalty: removing user penalty ".
152 $e->penalty_type . " from user $pid");
154 $editor->delete_actor_user_standing_penalty($e)
155 or return $editor->die_event;
159 # Add penalties that previously didn't exist
160 for my $p (@$penalties) {
161 if( ! grep { $_->penalty_type eq $p } @$existing ) {
163 $logger->activity("penalty: adding user penalty $p to user $pid");
165 my $newp = Fieldmapper::actor::user_standing_penalty->new;
166 $newp->penalty_type( $p );
169 $editor->create_actor_user_standing_penalty($newp)
170 or return $editor->die_event;