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 authtoken The login session key
  95                 @params args An object of named params including:
  96                         patronid The id of the patron
  97                         update True if this call should update the database
  98                         background True if this call should return immediately,
  99                                 then go on to process the penalties.  This flag
 100                                 works only in conjunction with the 'update' flag.
 101                 @return An object with keys 'fatal_penalties' and
 102                 'info_penalties' who are themeselves arrays of 0 or
 103                 more penalties.  Returns event on error.
 104         /
 105 );
 106
 107 # --------------------------------------------------------------
 108 # modes:
 109 #  - update
 110 #  - background : modifier to 'update' which says to return
 111 #               immediately then continue processing.  If this flag is set
 112 #               then the caller will get no penalty info and will never
 113 #               know for sure if the call even succeeded.
 114 # --------------------------------------------------------------
 115 sub patron_penalty {
 116         my( $self, $conn, $authtoken, $args ) = @_;
 117
 118         my( $requestor, $patron, $evt );
 119
 120         $conn->respond_complete(1) if $$args{background};
 121
 122         $patron = $$args{patron};
 123
 124         use JSON;
 125         $logger->info("penalty: ".JSON->perl2JSON($patron));
 126         $logger->info("penalty: ".$patron->profile);
 127         $logger->info("penalty: ".$patron->usrname);
 128
 129         if(!$patron) {
 130                 ( $patron, $evt ) = $U->fetch_user($$args{patronid});
 131                 return $evt if $evt;
 132         }
 133
 134         ( $requestor, $evt ) = $U->checkses($authtoken);
 135         return $evt if $evt;
 136
 137         $evt = $U->check_perms( $requestor->id,  $patron->home_ou, 'VIEW_USER');
 138         return $evt if $evt;
 139
 140         # - fetch the circulation summary info for the user
 141         my $summary = $U->fetch_patron_circ_summary($patron->id);
 142
 143         # - build the script runner
 144         my $runner = build_runner(
 145                 patron                  => $patron,
 146                 patron_summary => $summary
 147                 );
 148
 149         # - Load up the script and run it
 150         $runner->add_path($path);
 151         $runner->load($script);
 152         $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
 153
 154         # array items are returned as a comma-separated list of strings
 155         my @fatals = split( /,/, $runner->retrieve($fatal_key) );
 156         my @infos = split( /,/, $runner->retrieve($info_key) );
 157         my $all = [ @fatals, @infos ];
 158
 159         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
 160
 161         $conn->respond_complete(
 162                 { fatal_penalties => \@fatals, info_penalties => \@infos });
 163
 164         # - update the penalty info in the db if necessary
 165         $evt = update_patron_penalties(
 166                 patron    => $patron,
 167                 penalties => $all,
 168                 requestor => $requestor ) if $$args{update};
 169
 170         # - The caller won't know it failed, so log it
 171         $logger->error("penalty: Error updating the patron ".
 172                 "penalties in the database: ".Dumper($evt)) if $evt;
 173
 174         return undef;
 175 }
 176
 177 # --------------------------------------------------------------
 178 # Removes existing penalties for the patron that are not passed
 179 # into this function.  Creates new penalty entries for the
 180 # provided penalties that don't already exist;
 181 # --------------------------------------------------------------
 182 sub update_patron_penalties {
 183
 184         my %args      = @_;
 185         my $patron    = $args{patron};
 186         my $penalties = $args{penalties};
 187         my $requestor = $args{requestor};
 188
 189         my $session   = $U->start_db_session();
 190
 191         # - fetch the current penalties
 192         my $existing = $session->request(
 193                 'open-ils.storage.direct.actor.'.
 194                 'user_standing_penalty.search.usr.atomic', $patron->id )->gather(1);
 195
 196         my @deleted;
 197         my $reqid = $requestor->id;
 198         my $patronid = $patron->id;
 199
 200         # If an existing penalty is not in the newly generated
 201         # list of penalties, remove it from the DB
 202         for my $e (@$existing) {
 203                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
 204
 205                         $logger->activity("user $reqid removing user penalty ".
 206                                 $e->penalty_type . " from user $patronid");
 207
 208                         my $s = $session->request(
 209                                 'open-ils.storage.direct.actor.user_standing_penalty.delete', $e->id )->gather(1);
 210                         return $U->DB_UPDATE_FAILED($e) unless defined($s);
 211                 }
 212         }
 213
 214         # Add penalties that previously didn't exist
 215         for my $p (@$penalties) {
 216                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
 217
 218                         $logger->activity("user $reqid adding user penalty $p to user $patronid");
 219
 220                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
 221                         $newp->penalty_type( $p );
 222                         $newp->usr( $patronid );
 223
 224                         my $s = $session->request(
 225                                 'open-ils.storage.direct.actor.user_standing_penalty.create', $newp )->gather(1);
 226                         return $U->DB_UPDATE_FAILED($p) unless $s;
 227                 }
 228         }
 229
 230         $U->commit_db_session($session);
 231         return undef;
 232 }
 233
 234
 235
 236
 237
 238 1;