ignoring expired, barred, etc on users for penatly creation
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Penalty.pm
1 package OpenILS::Application::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::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';
14
15 my $U = "OpenILS::Application::AppUtils";
16 my $script;
17 my $path;
18 my $libs;
19 my $runner;
20 my %groups; # - user groups
21
22 my $fatal_key = 'result.fatalEvents';
23 my $info_key = 'result.infoEvents';
24
25
26 # --------------------------------------------------------------
27 # Loads the config info
28 # --------------------------------------------------------------
29 sub initialize {
30
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' );
35
36         $path = (ref($path)) ? $path : [$path];
37
38         if(!($path and $script)) {
39                 $logger->error("penalty:  server config missing script and/or script path");
40                 return 0;
41         }
42
43         $logger->info("penalty: Loading patron penalty script $script with paths @$path");
44 }
45
46
47
48 __PACKAGE__->register_method (
49         method   => 'patron_penalty',
50         api_name         => 'open-ils.penalty.patron_penalty.calculate',
51         signature => q/
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.
62         /
63 );
64
65 # --------------------------------------------------------------
66 # modes: 
67 #  - update 
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 # --------------------------------------------------------------
73 sub patron_penalty {
74         my( $self, $conn, $args ) = @_;
75         
76         my( $patron, $evt );
77
78         $conn->respond_complete(1) if $$args{background};
79
80         return { fatal_penalties => [], info_penalties => [] }
81                 unless ($args->{patron} || $args->{patronid});
82
83         $args->{patron_id} = $args->{patronid};
84         $args->{fetch_patron_circ_info} = 1;
85         $args->{ignore_user_status} = 1;
86         my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
87
88         # - Load up the script and run it
89         $runner->add_path($_) for @$path;
90
91         $runner->load($script);
92         my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
93
94         my @fatals = @{$result->{fatalEvents}};
95         my @infos = @{$result->{infoEvents}};
96         my $all = [ @fatals, @infos ];
97
98         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
99
100         $conn->respond_complete(
101                 { fatal_penalties => \@fatals, info_penalties => \@infos });
102
103         # - update the penalty info in the db if necessary
104         $logger->debug("update penalty settings = " . $$args{update});
105
106         $evt = update_patron_penalties( 
107                 patron    => $args->{patron}, 
108                 penalties => $all ) if $$args{update};
109
110         # - The caller won't know it failed, so log it
111         $logger->error("penalty: Error updating the patron ".
112                 "penalties in the database: ".Dumper($evt)) if $evt;
113
114         $runner->cleanup;
115         return undef;
116 }
117
118 # --------------------------------------------------------------
119 # Removes existing penalties for the patron that are not passed 
120 # into this function.  Creates new penalty entries for the 
121 # provided penalties that don't already exist;
122 # --------------------------------------------------------------
123 sub update_patron_penalties {
124
125         my %args      = @_;
126         my $patron    = $args{patron};
127         my $penalties = $args{penalties};
128         my $pid = $patron->id;
129
130
131         $logger->debug("updating penalties for patron $pid => @$penalties");
132         my $editor = new_editor(xact =>1);
133
134
135         # - fetch the current penalties
136         my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
137
138         my @types;
139         push( @types, $_->penalty_type ) for @$existing;
140         $logger->info("penalty: user has existing penalties [@types]");
141
142         my @deleted;
143
144         # If an existing penalty is not in the newly generated 
145         # list of penalties, remove it from the DB
146         for my $e (@$existing) {
147                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
148
149                         $logger->activity("penalty: removing user penalty ".
150                                 $e->penalty_type . " from user $pid");
151
152                         $editor->delete_actor_user_standing_penalty($e)
153                                 or return $editor->event;
154                 }
155         }
156
157         # Add penalties that previously didn't exist
158         for my $p (@$penalties) {
159                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
160
161                         $logger->activity("penalty: adding user penalty $p to user $pid");
162
163                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
164                         $newp->penalty_type( $p );
165                         $newp->usr( $pid );
166
167                         $editor->create_actor_user_standing_penalty($newp)
168                                 or return $editor->event;
169                 }
170         }
171         
172         $editor->commit;
173         return undef;
174 }
175
176
177
178
179
180 1;