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::Utils::ScriptRunner;
   9 use OpenSRF::Utils::SettingsClient;
  10 use OpenILS::Application::AppUtils;
  11 use OpenSRF::Utils::Logger qw(:logger);
  12 use base 'OpenSRF::Application';
  13 use OpenILS::Utils::Editor q/:funcs/;
  14 use OpenILS::Application::Actor;
  15
  16 my $U = "OpenILS::Application::AppUtils";
  17 my $script;
  18 my $path;
  19 my $libs;
  20 my $runner;
  21 my %groups; # - user groups
  22
  23 my $fatal_key = 'result.fatalEvents';
  24 my $info_key = 'result.infoEvents';
  25
  26
  27 # --------------------------------------------------------------
  28 # Loads the config info
  29 # --------------------------------------------------------------
  30 sub initialize {
  31
  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' );
  36
  37         if(!($path and $script)) {
  38                 $logger->error("penalty:  server config missing script and/or script path");
  39                 return 0;
  40         }
  41
  42         $logger->info("penalty: Loading patron penalty script $script with path $path");
  43 }
  44
  45
  46 # --------------------------------------------------------------
  47 # Builds the script runner and shoves data into the script
  48 # context
  49 # --------------------------------------------------------------
  50 sub build_runner {
  51
  52         my %args = @_;
  53         my $patron = $args{patron};
  54         my $fines = $args{fines};
  55         my $circ_counts = $args{circ_counts};
  56
  57         my $pgroup = find_profile($patron);
  58         $patron->profile( $pgroup );
  59
  60         if($runner) {
  61                 $runner->refresh_context if $runner;
  62
  63         } else {
  64                 $runner = OpenILS::Utils::ScriptRunner->new unless $runner;
  65                 $runner->add_path( $_ );
  66         }
  67
  68         $runner->insert( 'environment.patron',  $patron, 1);
  69         $runner->insert( $fatal_key, [] );
  70         $runner->insert( $info_key, [] );
  71         $runner->insert( 'environment.patronOverdueCount', $circ_counts->{overdue});
  72         $runner->insert( 'environment.patronFines', $fines );
  73
  74         return $runner;
  75 }
  76
  77
  78 sub find_profile {
  79         my $patron = shift;
  80
  81         if(!%groups) {
  82                 my $groups = $U->storagereq(
  83                         'open-ils.storage.direct.permission.grp_tree.retrieve.all.atomic');
  84                 %groups = map { $_->id => $_ } @$groups;
  85         }
  86
  87         return $groups{$patron->profile};
  88 }
  89
  90
  91
  92 __PACKAGE__->register_method (
  93         method   => 'patron_penalty',
  94         api_name         => 'open-ils.penalty.patron_penalty.calculate',
  95         signature => q/
  96                 Calculates the patron's standing penalties
  97                 @param args An object of named params including:
  98                         patronid The id of the patron
  99                         update True if this call should update the database
 100                         background True if this call should return immediately,
 101                                 then go on to process the penalties.  This flag
 102                                 works only in conjunction with the 'update' flag.
 103                 @return An object with keys 'fatal_penalties' and
 104                 'info_penalties' who are themeselves arrays of 0 or
 105                 more penalties.  Returns event on error.
 106         /
 107 );
 108
 109 # --------------------------------------------------------------
 110 # modes:
 111 #  - update
 112 #  - background : modifier to 'update' which says to return
 113 #               immediately then continue processing.  If this flag is set
 114 #               then the caller will get no penalty info and will never
 115 #               know for sure if the call even succeeded.
 116 # --------------------------------------------------------------
 117 sub patron_penalty {
 118         my( $self, $conn, $args ) = @_;
 119
 120         my( $patron, $evt );
 121
 122         $conn->respond_complete(1) if $$args{background};
 123
 124         my $e = new_editor(xact => 1);
 125
 126         if( $patron = $$args{patron} ) { # - unflesh if necessary
 127                 $patron->home_ou( $patron->home_ou->id ) if ref($patron->home_ou);
 128                 $patron->profile( $patron->profile->id ) if ref($patron->profile);
 129
 130         } else {
 131                 $patron = $e->retrieve_actor_user($$args{patronid})
 132                         or return $e->event;
 133         }
 134
 135         # - fetch the circulation summary info for the user
 136         my $summary = $U->fetch_patron_circ_summary($patron->id);
 137
 138         # Note, that this ignores any negative balances
 139         my $fxacts = $e->search_money_open_billable_transaction_summary(
 140                 { usr => $patron->id, balance_owed => { ">" => 0 } });
 141         my $fines = 0;
 142         $fines += $_->balance_owed for @$fxacts;
 143
 144         # - retrieve the number of open circulations the user has by type
 145         # - we have to call this method directly because we don't have an auth session
 146         my $circ_counts = OpenILS::Application::Actor::_checked_out(1, $e, $patron->id);
 147
 148         # - build the script runner
 149         my $runner = build_runner(
 150                 patron          => $patron,
 151                 fines                   => $fines,
 152                 circ_counts     => $circ_counts,
 153                 );
 154
 155         # - Load up the script and run it
 156         $runner->add_path($path);
 157         $runner->run($script) or
 158                 throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
 159
 160         # array items are returned as a comma-separated list of strings
 161         my @fatals = split( /,/, $runner->retrieve($fatal_key) );
 162         my @infos = split( /,/, $runner->retrieve($info_key) );
 163         my $all = [ @fatals, @infos ];
 164
 165         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
 166
 167         $conn->respond_complete(
 168                 { fatal_penalties => \@fatals, info_penalties => \@infos });
 169
 170         # - update the penalty info in the db if necessary
 171         $evt = update_patron_penalties(
 172                 patron    => $patron,
 173                 penalties => $all ) if $$args{update};
 174
 175         # - The caller won't know it failed, so log it
 176         $logger->error("penalty: Error updating the patron ".
 177                 "penalties in the database: ".Dumper($evt)) if $evt;
 178
 179         return undef;
 180 }
 181
 182 # --------------------------------------------------------------
 183 # Removes existing penalties for the patron that are not passed
 184 # into this function.  Creates new penalty entries for the
 185 # provided penalties that don't already exist;
 186 # --------------------------------------------------------------
 187 sub update_patron_penalties {
 188
 189         my %args      = @_;
 190         my $patron    = $args{patron};
 191         my $penalties = $args{penalties};
 192
 193         my $session   = $U->start_db_session();
 194
 195         # - fetch the current penalties
 196         my $existing = $session->request(
 197                 'open-ils.storage.direct.actor.'.
 198                 'user_standing_penalty.search.usr.atomic', $patron->id )->gather(1);
 199
 200         my @deleted;
 201         my $patronid = $patron->id;
 202
 203         # If an existing penalty is not in the newly generated
 204         # list of penalties, remove it from the DB
 205         for my $e (@$existing) {
 206                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
 207
 208                         $logger->activity("penalty: removing user penalty ".
 209                                 $e->penalty_type . " from user $patronid");
 210
 211                         my $s = $session->request(
 212                                 'open-ils.storage.direct.actor.user_standing_penalty.delete', $e->id )->gather(1);
 213                         return $U->DB_UPDATE_FAILED($e) unless defined($s);
 214                 }
 215         }
 216
 217         # Add penalties that previously didn't exist
 218         for my $p (@$penalties) {
 219                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
 220
 221                         $logger->activity("penalty: adding user penalty $p to user $patronid");
 222
 223                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
 224                         $newp->penalty_type( $p );
 225                         $newp->usr( $patronid );
 226
 227                         my $s = $session->request(
 228                                 'open-ils.storage.direct.actor.user_standing_penalty.create', $newp )->gather(1);
 229                         return $U->DB_UPDATE_FAILED($p) unless $s;
 230                 }
 231         }
 232
 233         $U->commit_db_session($session);
 234         return undef;
 235 }
 236
 237
 238
 239
 240
 241 1;