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