holding on to editor object created by script code so
[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->{fetch_patron_money_info} = 1;
86         $args->{ignore_user_status} = 1;
87
88         my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
89         
90         # - Load up the script and run it
91         $runner->add_path($_) for @$path;
92
93         $runner->load($script);
94         my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
95
96         my @fatals = @{$result->{fatalEvents}};
97         my @infos = @{$result->{infoEvents}};
98         my $all = [ @fatals, @infos ];
99
100         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
101
102         $conn->respond_complete(
103                 { fatal_penalties => \@fatals, info_penalties => \@infos });
104
105         # - update the penalty info in the db if necessary
106         $logger->debug("update penalty settings = " . $$args{update});
107
108         $evt = update_patron_penalties( 
109                 patron    => $args->{patron}, 
110                 penalties => $all,
111                 editor          => $args->{editor},
112                 ) if $$args{update};
113
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;
117
118         $runner->cleanup;
119         return undef;
120 }
121
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 {
128
129         my %args      = @_;
130         my $patron    = $args{patron};
131         my $penalties = $args{penalties};
132         my $editor              = $args{editor} || new_editor(xact=>1);
133         my $pid = $patron->id;
134
135         $logger->debug("updating penalties for patron $pid => @$penalties");
136
137
138         # - fetch the current penalties
139         my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
140
141         my @types;
142         push( @types, $_->penalty_type ) for @$existing;
143         $logger->info("penalty: user has existing penalties [@types]");
144
145         my @deleted;
146
147         # If an existing penalty is not in the newly generated 
148         # list of penalties, remove it from the DB
149         for my $e (@$existing) {
150                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
151
152                         $logger->activity("penalty: removing user penalty ".
153                                 $e->penalty_type . " from user $pid");
154
155                         $editor->delete_actor_user_standing_penalty($e)
156                                 or return $editor->event;
157                 }
158         }
159
160         # Add penalties that previously didn't exist
161         for my $p (@$penalties) {
162                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
163
164                         $logger->activity("penalty: adding user penalty $p to user $pid");
165
166                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
167                         $newp->penalty_type( $p );
168                         $newp->usr( $pid );
169
170                         $editor->create_actor_user_standing_penalty($newp)
171                                 or return $editor->event;
172                 }
173         }
174         
175         $editor->commit;
176         return undef;
177 }
178
179
180
181
182
183 1;